From 02626a96daf11e8eafde52c1c3bdcbbfddd4c9a9 Mon Sep 17 00:00:00 2001 From: morsch Date: Tue, 24 Nov 2009 14:07:27 +0000 Subject: [PATCH] Pythia version 6.4.21 --- PYTHIA6/libpythia6.4.21.pkg | 23 + PYTHIA6/pythia6.4.21/AliPythia64Rndm.cxx | 94 + PYTHIA6/pythia6.4.21/AliPythia64Rndm.h | 44 + PYTHIA6/pythia6.4.21/main.c | 1 + PYTHIA6/pythia6.4.21/pdf_alice.F | 84 + PYTHIA6/pythia6.4.21/pydummy.f | 7 + PYTHIA6/pythia6.4.21/pythia-6.4.21.f | 78920 ++++++++++++++++ PYTHIA6/pythia6.4.21/pythia64LinkDef.h | 8 + PYTHIA6/pythia6.4.21/pythia6_common_address.c | 130 + .../pythia6_common_block_address.F | 84 + .../pythia6.4.21/tpythia6_called_from_cc.F | 20 + 11 files changed, 79415 insertions(+) create mode 100644 PYTHIA6/libpythia6.4.21.pkg create mode 100644 PYTHIA6/pythia6.4.21/AliPythia64Rndm.cxx create mode 100644 PYTHIA6/pythia6.4.21/AliPythia64Rndm.h create mode 100644 PYTHIA6/pythia6.4.21/main.c create mode 100644 PYTHIA6/pythia6.4.21/pdf_alice.F create mode 100644 PYTHIA6/pythia6.4.21/pydummy.f create mode 100644 PYTHIA6/pythia6.4.21/pythia-6.4.21.f create mode 100644 PYTHIA6/pythia6.4.21/pythia64LinkDef.h create mode 100644 PYTHIA6/pythia6.4.21/pythia6_common_address.c create mode 100644 PYTHIA6/pythia6.4.21/pythia6_common_block_address.F create mode 100644 PYTHIA6/pythia6.4.21/tpythia6_called_from_cc.F diff --git a/PYTHIA6/libpythia6.4.21.pkg b/PYTHIA6/libpythia6.4.21.pkg new file mode 100644 index 00000000000..5031d77cfa7 --- /dev/null +++ b/PYTHIA6/libpythia6.4.21.pkg @@ -0,0 +1,23 @@ +#-*- Mode: Makefile -*- +SRCS= pythia6.4.21/AliPythia64Rndm.cxx +HDRS= $(SRCS:.cxx=.h) + +DHDR:=pythia6.4.21/pythia64LinkDef.h + +EXPORT:= + +CSRCS:= \ +pythia6.4.21/main.c pythia6.4.21/pythia6_common_address.c + + +FSRCS:= \ +pythia6.4.21/pythia6_common_block_address.F \ +pythia6.4.21/tpythia6_called_from_cc.F\ +pythia6.4.21/pythia-6.4.21.f \ +pythia6.4.21/pydummy.f \ +pythia6.4.21/pdf_alice.F + +ifeq (win32gcc,$(ALICE_TARGET)) +PACKSOFLAGS:= $(SOFLAGS) -L$(ALICE_ROOT)/lib/tgt_$(ALICE_TARGET) \ + -lmicrocern -llhapdf +endif diff --git a/PYTHIA6/pythia6.4.21/AliPythia64Rndm.cxx b/PYTHIA6/pythia6.4.21/AliPythia64Rndm.cxx new file mode 100644 index 00000000000..e24999cf2cd --- /dev/null +++ b/PYTHIA6/pythia6.4.21/AliPythia64Rndm.cxx @@ -0,0 +1,94 @@ +/************************************************************************** + * Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. * + * * + * Author: The ALICE Off-line Project. * + * Contributors are mentioned in the code where appropriate. * + * * + * Permission to use, copy, modify and distribute this software and its * + * documentation strictly for non-commercial purposes is hereby granted * + * without fee, provided that the above copyright notice appears in all * + * copies and that both the copyright notice and this permission notice * + * appear in the supporting documentation. The authors make no claims * + * about the suitability of this software for any purpose. It is * + * provided "as is" without express or implied warranty. * + **************************************************************************/ + +/* $Id: AliPythiaRndm.cxx 34124 2009-08-06 09:32:43Z hristov $ */ + +//----------------------------------------------------------------------------- +// Class: AliPythiaRndm +// Responsibilities: Interface to Root random number generator +// from Fortran (re-implements FINCTION PYR from PYTHIA) +// Very similar to AliHijingRndm +// Collaborators: AliPythia and AliGenPythia classes +// Example: +// +// root> AliPythia::Instance(); +// root> AliPythiaRndm::SetPythiaRandom(new TRandom3()); +// root> AliPythiaRndm::GetPythiaRandom()->SetSeed(0); +// root> cout<<"Seed "<< AliPythiaRndm::GetPythiaRandom()->GetSeed() < +#include + +#include "AliPythiaRndm.h" + +TRandom * AliPythiaRndm::fgPythiaRandom=0; + +ClassImp(AliPythiaRndm) + + +//_______________________________________________________________________ +void AliPythiaRndm::SetPythiaRandom(TRandom *ran) { + // + // Sets the pointer to an existing random numbers generator + // + if(ran) fgPythiaRandom=ran; + else fgPythiaRandom=gRandom; +} + +//_______________________________________________________________________ +TRandom * AliPythiaRndm::GetPythiaRandom() { + // + // Retrieves the pointer to the random numbers generator + // + if (!fgPythiaRandom) fgPythiaRandom=gRandom; + return fgPythiaRandom; +} + +//_______________________________________________________________________ +#define pyr pyr_ +#define pygauss pygauss_ +#define pyrset pyrset_ +#define pyrget pyrget_ + +extern "C" { + Double_t pyr(Int_t*) + { + // Wrapper to FUNCTION PYR from PYTHIA + // Uses static method to retrieve the pointer to the (C++) generator + Double_t r; + do r=AliPythiaRndm::GetPythiaRandom()->Rndm(); + while(0 >= r || r >= 1); + return r; + } + + Double_t pygauss(Double_t x0, Double_t sig) + { + Double_t s = 2.; + Double_t v1 = 0.; + Double_t v2 = 0.; + + while (s > 1.) { + v1 = 2. * pyr(0) - 1.; + v2 = 2. * pyr(0) - 1.; + s = v1 * v1 + v2 * v2; + } + return v1 * TMath::Sqrt(-2. * TMath::Log(s) / s) * sig + x0; + } + + void pyrset(Int_t*,Int_t*) {} + void pyrget(Int_t*,Int_t*) {} +} diff --git a/PYTHIA6/pythia6.4.21/AliPythia64Rndm.h b/PYTHIA6/pythia6.4.21/AliPythia64Rndm.h new file mode 100644 index 00000000000..bd099510aca --- /dev/null +++ b/PYTHIA6/pythia6.4.21/AliPythia64Rndm.h @@ -0,0 +1,44 @@ +#ifndef ALIPYTHIARNDM_H +#define ALIPYTHIARNDM_H +/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. * + * See cxx source for full Copyright notice */ + +/* $Id: AliPythiaRndm.h 8920 2004-01-13 11:29:51Z hristov $ */ + +#include +#include + +class TRandom; + +class AliPythiaRndm { + public: + AliPythiaRndm() { + // Default constructor. The static data member is initialized + // in the implementation file + } + AliPythiaRndm(const AliPythiaRndm & /*rn*/) { + // Copy constructor: no copy allowed for the object + ::Fatal("Copy constructor","Not allowed\n"); + } + virtual ~AliPythiaRndm() { + // Destructor + fgPythiaRandom=0; + } + AliPythiaRndm & operator=(const AliPythiaRndm& /*rn*/) { + // Assignment operator: no assignment allowed + ::Fatal("Assignment operator","Not allowed\n"); + return (*this); + } + + static void SetPythiaRandom(TRandom *ran=0); + static TRandom * GetPythiaRandom(); + +private: + + static TRandom * fgPythiaRandom; //! pointer to the random number generator + + ClassDef(AliPythiaRndm,0) //Random Number generator wrapper (non persistent) +}; + +#endif + diff --git a/PYTHIA6/pythia6.4.21/main.c b/PYTHIA6/pythia6.4.21/main.c new file mode 100644 index 00000000000..2fcfee9112e --- /dev/null +++ b/PYTHIA6/pythia6.4.21/main.c @@ -0,0 +1 @@ +void MAIN__() {} diff --git a/PYTHIA6/pythia6.4.21/pdf_alice.F b/PYTHIA6/pythia6.4.21/pdf_alice.F new file mode 100644 index 00000000000..ca1ca70bff2 --- /dev/null +++ b/PYTHIA6/pythia6.4.21/pdf_alice.F @@ -0,0 +1,84 @@ +C... ALICE interface to PDFLIB with possibility to select nuclear structure +C... functions. +C... +C... The MSTP array in the PYPARS common block is used to enable and +C... select the nuclear structure functions. +C... MSTP(52) : (D=1) choice of proton and nuclear structure-function library +C... =1: internal PYTHIA acording to MSTP(51) +C... =2: PDFLIB proton s.f., with MSTP(51) = 1000xNGROUP+NSET +C... MSTP( 51) = 1000xNPGROUP+NPSET +C... MSTP(151) = 1000xNAGROUP+NASET +C... MSTP(192) : Mass number of nucleus side 1 +C... MSTP(193) : Mass number of nucleus side 2 +C... +C... +C... MINT(124) : side (1 or 2) + + + SUBROUTINE PDFSET_ALICE(PARM, VALUE) +C... + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) +C...Interface to PDFLIB. + COMMON/LW50512/QCDL4,QCDL5 + SAVE /LW50512/ + DOUBLE PRECISION QCDL4,QCDL5 + COMMON/LW50513/XMIN,XMAX,Q2MIN,Q2MAX + SAVE /LW50513/ + DOUBLE PRECISION XMIN,XMAX,Q2MIN,Q2MAX +C... + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + DOUBLE PRECISION VALUE(20) + CHARACTER*20 PARM(20) + write(6,*) MSTP(52) + write(6,*) PARM + write(6,*) VALUE + + IF (MSTP(192) .GT. 0 .AND. MSTP(193) .GT. 0) THEN + PARM(5)='NATYPE' + VALUE(5)=4 + PARM(6)='NAGROUP' + VALUE(6)=MSTP(191)/1000 + PARM(7)='NASET' + VALUE(7)=MOD(MSTP(191),1000) + CALL PDFSET(PARM,VALUE, + > MSTU(11),MSTP(51),MSTP(53),MSTP(55), + > QCDL4,QCDL5, + > XMIN,XMAX,Q2MIN,Q2MAX) + IF (MSTP(194) .EQ. 0) THEN + CALL SETLHAPARM("EKS98") + ELSE + CALL SETLHAPARM("EPS08") + ENDIF + ELSE + write(6,*) "-> pdfset" + CALL PDFSET(PARM,VALUE, + > MSTU(11),MSTP(51),MSTP(53),MSTP(55), + > QCDL4,QCDL5, + > XMIN,XMAX,Q2MIN,Q2MAX) + ENDIF + write(6,*) "done" + END + + + + SUBROUTINE STRUCTM_ALICE + + (XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GL) +C... + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) +C write(6,*) "structm_alice->" + IF (MSTP(192) .GT. 0 .AND. MSTP(193) .GT. 0) THEN + A=MSTP(191+MINT(124)) +C write(6,*) mint(124), "-> structa ", A + CALL STRUCTA(XX,QQ,A,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GL) + ELSE +C write(6,*) mint(124), "-> structm " + CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GL) + ENDIF + END + + diff --git a/PYTHIA6/pythia6.4.21/pydummy.f b/PYTHIA6/pythia6.4.21/pydummy.f new file mode 100644 index 00000000000..683b2c9d9b3 --- /dev/null +++ b/PYTHIA6/pythia6.4.21/pydummy.f @@ -0,0 +1,7 @@ + + SUBROUTINE PYQUEN() +C DUMMY + common /pyqpar/ T0u,tau0u,nfu,ienglu,ianglu + common /parimp/ b1,psib1,rb1,rb2,noquen + RETURN + END diff --git a/PYTHIA6/pythia6.4.21/pythia-6.4.21.f b/PYTHIA6/pythia6.4.21/pythia-6.4.21.f new file mode 100644 index 00000000000..80ab12bcc58 --- /dev/null +++ b/PYTHIA6/pythia6.4.21/pythia-6.4.21.f @@ -0,0 +1,78920 @@ +C********************************************************************* +C********************************************************************* +C* ** +C* Jul 2009 ** +C* ** +C* The Lund Monte Carlo ** +C* ** +C* PYTHIA version 6.4 ** +C* ** +C* Torbjorn Sjostrand ** +C* Department of Theoretical Physics ** +C* Lund University ** +C* Solvegatan 14A, S-223 62 Lund, Sweden ** +C* E-mail torbjorn@thep.lu.se ** +C* ** +C* SUSY and Technicolor parts by ** +C* Stephen Mrenna ** +C* Computing Division ** +C* Generators and Detector Simulation Group ** +C* Fermi National Accelerator Laboratory ** +C* MS 234, Batavia, IL 60510, USA ** +C* phone + 1 - 630 - 840 - 2556 ** +C* E-mail mrenna@fnal.gov ** +C* ** +C* New multiple interactions and more SUSY parts by ** +C* Peter Skands ** +C* Theoretical Physics Department ** +C* Fermi National Accelerator Laboratory ** +C* MS 106, Batavia, IL 60510, USA ** +C* and ** +C* CERN/PH, CH-1211 Geneva, Switzerland ** +C* phone +41 - 22 - 767 24 59 ** +C* E-mail skands@fnal.gov ** +C* ** +C* Several parts are written by Hans-Uno Bengtsson ** +C* PYSHOW is written together with Mats Bengtsson ** +C* PYMAEL is written by Emanuel Norrbin ** +C* advanced popcorn baryon production written by Patrik Eden ** +C* code for virtual photons mainly written by Christer Friberg ** +C* code for low-mass strings mainly written by Emanuel Norrbin ** +C* Bose-Einstein code mainly written by Leif Lonnblad ** +C* CTEQ parton distributions are by the CTEQ collaboration ** +C* GRV 94 parton distributions are by Glueck, Reya and Vogt ** +C* SaS photon parton distributions together with Gerhard Schuler ** +C* g + g and q + qbar -> t + tbar + H code by Zoltan Kunszt ** +C* MSSM Higgs mass calculation code by M. Carena, ** +C* J.R. Espinosa, M. Quiros and C.E.M. Wagner ** +C* UED implementation by M. Elkacimi, D. Goujdami, H. Przysiezniak ** +C* PYGAUS adapted from CERN library (K.S. Kolbig) ** +C* NRQCD/colour octet production of onium by S. Wolf ** +C* ** +C* The latest program version and documentation is found on WWW ** +C* http://www.thep.lu.se/~torbjorn/Pythia.html ** +C* ** +C* Copyright Torbjorn Sjostrand, Lund (and CERN) 2008 ** +C* ** +C********************************************************************* +C********************************************************************* +C * +C List of subprograms in order of appearance, with main purpose * +C (S = subroutine, F = function, B = block data) * +C * +C B PYDATA to contain all default values * +C S PYCKBD to check that BLOCK DATA has been correctly loaded * +C S PYTEST to test the proper functioning of the package * +C S PYHEPC to convert between /PYJETS/ and /HEPEVT/ records * +C * +C S PYINIT to administer the initialization procedure * +C S PYEVNT to administer the generation of an event * +C S PYEVNW ditto, for new multiple interactions scenario * +C S PYSTAT to print cross-section and other information * +C S PYUPEV to administer the generation of an LHA hard process * +C S PYUPIN to provide initialization needed for LHA input * +C S PYLHEF to produce a Les Houches Event File from run * +C S PYINRE to initialize treatment of resonances * +C S PYINBM to read in beam, target and frame choices * +C S PYINKI to initialize kinematics of incoming particles * +C S PYINPR to set up the selection of included processes * +C S PYXTOT to give total, elastic and diffractive cross-sect. * +C S PYMAXI to find differential cross-section maxima * +C S PYPILE to select multiplicity of pileup events * +C S PYSAVE to save alternatives for gamma-p and gamma-gamma * +C S PYGAGA to handle lepton -> lepton + gamma branchings * +C S PYRAND to select subprocess and kinematics for event * +C S PYSCAT to set up kinematics and colour flow of event * +C S PYEVOL handler for pT-ordered ISR and multiple interactions * +C S PYSSPA to simulate initial state spacelike showers * +C S PYPTIS to do pT-ordered initial state spacelike showers * +C S PYMEMX auxiliary to PYSSPA/PYPTIS for ME correction maximum * +C S PYMEWT auxiliary to PYSSPA/.. for matrix element correction * +C S PYPTMI to do pT-ordered multiple interactions * +C F PYFCMP to give companion quark x*f distribution * +C F PYPCMP to calculate momentum integral for companion quarks * +C S PYUPRE to rearranges contents of the HEPEUP commonblock * +C S PYADSH to administrate sequential final-state showers * +C S PYVETO to allow the generation of an event to be aborted * +C S PYRESD to perform resonance decays * +C S PYMULT to generate multiple interactions - old scheme * +C S PYREMN to add on target remnants - old scheme * +C S PYMIGN to generate multiple interactions - new scheme * +C S PYMIHK to connect colours in mult. int. - new scheme * +C S PYCTTR to translate PYTHIA colour information to LHA1 tags * +C S PYMIHG to collapse two pairs of LHA1 colour tags. * +C S PYMIRM to add on target remnants in mult. int.- new scheme * +C S PYFSCR to perform final state colour reconnections - -"- * +C S PYDIFF to set up kinematics for diffractive events * +C S PYDISG to set up kinematics, remnant and showers for DIS * +C S PYDOCU to compute cross-sections and handle documentation * +C S PYFRAM to perform boosts between different frames * +C S PYWIDT to calculate full and partial widths of resonances * +C S PYOFSH to calculate partial width into off-shell channels * +C S PYRECO to handle colour reconnection in W+W- events * +C S PYKLIM to calculate borders of allowed kinematical region * +C S PYKMAP to construct value of kinematical variable * +C S PYSIGH to calculate differential cross-sections * +C S PYSGQC auxiliary to PYSIGH for QCD processes * +C S PYSGHF auxiliary to PYSIGH for heavy flavour processes * +C S PYSGWZ auxiliary to PYSIGH for W and Z processes * +C S PYSGHG auxiliary to PYSIGH for Higgs processes * +C S PYSGSU auxiliary to PYSIGH for supersymmetry processes * +C S PYSGTC auxiliary to PYSIGH for technicolor processes * +C S PYSGEX auxiliary to PYSIGH for various exotic processes * +C S PYPDFU to evaluate parton distributions * +C S PYPDFL to evaluate parton distributions at low x and Q^2 * +C S PYPDEL to evaluate electron parton distributions * +C S PYPDGA to evaluate photon parton distributions (generic) * +C S PYGGAM to evaluate photon parton distributions (SaS sets) * +C S PYGVMD to evaluate VMD part of photon parton distributions * +C S PYGANO to evaluate anomalous part of photon PDFs * +C S PYGBEH to evaluate Bethe-Heitler part of photon PDFs * +C S PYGDIR to evaluate direct contribution to photon PDFs * +C S PYPDPI to evaluate pion parton distributions * +C S PYPDPR to evaluate proton parton distributions * +C F PYCTEQ to evaluate the CTEQ 3 proton parton distributions * +C S PYGRVL to evaluate the GRV 94L proton parton distributions * +C S PYGRVM to evaluate the GRV 94M proton parton distributions * +C S PYGRVD to evaluate the GRV 94D proton parton distributions * +C F PYGRVV auxiliary to the PYGRV* routines * +C F PYGRVW auxiliary to the PYGRV* routines * +C F PYGRVS auxiliary to the PYGRV* routines * +C F PYCT5L to evaluate the CTEQ 5L proton parton distributions * +C F PYCT5M to evaluate the CTEQ 5M1 proton parton distributions * +C S PYPDPO to evaluate old proton parton distributions * +C F PYHFTH to evaluate threshold factor for heavy flavour * +C S PYSPLI to find flavours left in hadron when one removed * +C F PYGAMM to evaluate ordinary Gamma function Gamma(x) * +C S PYWAUX to evaluate auxiliary functions W1(s) and W2(s) * +C S PYI3AU to evaluate auxiliary function I3(s,t,u,v) * +C F PYSPEN to evaluate Spence (dilogarithm) function Sp(x) * +C S PYQQBH to evaluate matrix element for g + g -> Q + Qbar + H * +C S PYSTBH to evaluate matrix element for t + b + H processes * +C S PYTBHB auxiliary to PYSTBH * +C S PYTBHG auxiliary to PYSTBH * +C S PYTBHQ auxiliary to PYSTBH * +C F PYTBHS auxiliary to PYSTBH * +C * +C S PYMSIN to initialize the supersymmetry simulation * +C S PYSLHA to interface to SUSY spectrum and decay calculators * +C S PYAPPS to determine MSSM parameters from SUGRA input * +C S PYSUGI to determine MSSM parameters using ISASUSY * +C S PYFEYN to determine MSSM Higgs parameters using FEYNHIGGS * +C F PYRNMQ to determine running squark masses * +C S PYTHRG to calculate sfermion third-gen. mass eigenstates * +C S PYINOM to calculate neutralino/chargino mass eigenstates * +C F PYRNM3 to determine running M3, gluino mass * +C S PYEIG4 to calculate eigenvalues and -vectors in 4*4 matrix * +C S PYHGGM to determine Higgs mass spectrum * +C S PYSUBH to determine Higgs masses in the MSSM * +C S PYPOLE to determine Higgs masses in the MSSM * +C S PYRGHM auxiliary to PYPOLE * +C S PYGFXX auxiliary to PYRGHM * +C F PYFINT auxiliary to PYPOLE * +C F PYFISB auxiliary to PYFINT * +C S PYSFDC to calculate sfermion decay partial widths * +C S PYGLUI to calculate gluino decay partial widths * +C S PYTBBN to calculate 3-body decay of gluino to neutralino * +C S PYTBBC to calculate 3-body decay of gluino to chargino * +C S PYNJDC to calculate neutralino decay partial widths * +C S PYCJDC to calculate chargino decay partial widths * +C F PYXXZ6 auxiliary for ino 3-body decays * +C F PYXXGA auxiliary for ino -> ino + gamma decay * +C F PYX2XG auxiliary for ino -> ino + gauge boson decay * +C F PYX2XH auxiliary for ino -> ino + Higgs decay * +C S PYHEXT to calculate non-SM Higgs decay partial widths * +C F PYH2XX auxiliary for H -> ino + ino decay * +C F PYGAUS to perform Gaussian integration * +C F PYGAU2 copy of PYGAUS to allow two-dimensional integration * +C F PYSIMP to perform Simpson integration * +C F PYLAMF to evaluate the lambda kinematics function * +C S PYTBDY to perform 3-body decay of gauginos * +C S PYTECM to calculate techni_rho/omega masses * +C S PYXDIN to initialize Universal Extra Dimensions * +C S PYUEDC to compute UED mass radiative corrections * +C S PYXUED to compute UED cross sections * +C S PYGRAM to generate UED G* (excited graviton) mass spectrum * +C F PYGRAW to compute UED partial widths to G* * +C F PYWDKK to compute UED differential partial widths to G* * +C S PYEICG to calculate eigenvalues of a 4*4 complex matrix * +C S PYCMQR auxiliary to PYEICG * +C S PYCMQ2 auxiliary to PYEICG * +C S PYCDIV auxiliary to PYCMQR * +C S PYCSRT auxiliary to PYCMQR * +C S PYTHAG auxiliary to PYCMQR * +C S PYCBAL auxiliary to PYEICG * +C S PYCBA2 auxiliary to PYEICG * +C S PYCRTH auxiliary to PYEICG * +C S PYLDCM auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 * +C S PYBKSB auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 * +C S PYWIDX to calculate decay widths from within PYWIDT * +C S PYRVSF to calculate R-violating sfermion decay widths * +C S PYRVNE to calculate R-violating neutralino decay widths * +C S PYRVCH to calculate R-violating chargino decay widths * +C S PYRVGL to calculate R-violating gluino decay widths * +C F PYRVSB auxiliary to PYRVSF * +C S PYRVGW to calculate R-Violating 3-body widths * +C F PYRVI1 auxiliary to PYRVGW, to do PS integration for res. * +C F PYRVI2 auxiliary to PYRVGW, to do PS integration for LR-int.* +C F PYRVI3 auxiliary to PYRVGW, to do PS X integral for int. * +C F PYRVG1 auxiliary to PYRVI1, general matrix element, res. * +C F PYRVG2 auxiliary to PYRVI2, general matrix element, LR-int. * +C F PYRVG3 auxiliary to PYRVI3, to do PS Y integral for int. * +C F PYRVG4 auxiliary to PYRVG3, general matrix element, int. * +C F PYRVR auxiliary to PYRVG1, Breit-Wigner * +C F PYRVS auxiliary to PYRVG2 & PYRVG4 * +C * +C S PY1ENT to fill one entry (= parton or particle) * +C S PY2ENT to fill two entries * +C S PY3ENT to fill three entries * +C S PY4ENT to fill four entries * +C S PY2FRM to interface to generic two-fermion generator * +C S PY4FRM to interface to generic four-fermion generator * +C S PY6FRM to interface to generic six-fermion generator * +C S PY4JET to generate a shower from a given 4-parton config * +C S PY4JTW to evaluate the weight od a shower history for above * +C S PY4JTS to set up the parton configuration for above * +C S PYJOIN to connect entries with colour flow information * +C S PYGIVE to fill (or query) commonblock variables * +C S PYONOF to allow easy control of particle decay modes * +C S PYTUNE to select a predefined 'tune' for min-bias and UE * +C S PYEXEC to administrate fragmentation and decay chain * +C S PYPREP to rearrange showered partons along strings * +C S PYSTRF to do string fragmentation of jet system * +C S PYJURF to find boost to string junction rest frame * +C S PYINDF to do independent fragmentation of one or many jets * +C S PYDECY to do the decay of a particle * +C S PYDCYK to select parton and hadron flavours in decays * +C S PYKFDI to select parton and hadron flavours in fragm * +C S PYNMES to select number of popcorn mesons * +C S PYKFIN to calculate falvour prod. ratios from input params. * +C S PYPTDI to select transverse momenta in fragm * +C S PYZDIS to select longitudinal scaling variable in fragm * +C S PYSHOW to do m-ordered timelike parton shower evolution * +C S PYPTFS to do pT-ordered timelike parton shower evolution * +C F PYMAEL auxiliary to PYSHOW & PYPTFS: gluon emission ME's * +C S PYBOEI to include Bose-Einstein effects (crudely) * +C S PYBESQ auxiliary to PYBOEI * +C F PYMASS to give the mass of a particle or parton * +C F PYMRUN to give the running MSbar mass of a quark * +C S PYNAME to give the name of a particle or parton * +C F PYCHGE to give three times the electric charge * +C F PYCOMP to compress standard KF flavour code to internal KC * +C S PYERRM to write error messages and abort faulty run * +C F PYALEM to give the alpha_electromagnetic value * +C F PYALPS to give the alpha_strong value * +C F PYANGL to give the angle from known x and y components * +C F PYR to provide a random number generator * +C S PYRGET to save the state of the random number generator * +C S PYRSET to set the state of the random number generator * +C S PYROBO to rotate and/or boost an event * +C S PYEDIT to remove unwanted entries from record * +C S PYLIST to list event record or particle data * +C S PYLOGO to write a logo * +C S PYUPDA to update particle data * +C F PYK to provide integer-valued event information * +C F PYP to provide real-valued event information * +C S PYSPHE to perform sphericity analysis * +C S PYTHRU to perform thrust analysis * +C S PYCLUS to perform three-dimensional cluster analysis * +C S PYCELL to perform cluster analysis in (eta, phi, E_T) * +C S PYJMAS to give high and low jet mass of event * +C S PYFOWO to give Fox-Wolfram moments * +C S PYTABU to analyze events, with tabular output * +C * +C S PYEEVT to administrate the generation of an e+e- event * +C S PYXTEE to give the total cross-section at given CM energy * +C S PYRADK to generate initial state photon radiation * +C S PYXKFL to select flavour of primary qqbar pair * +C S PYXJET to select (matrix element) jet multiplicity * +C S PYX3JT to select kinematics of three-jet event * +C S PYX4JT to select kinematics of four-jet event * +C S PYXDIF to select angular orientation of event * +C S PYONIA to perform generation of onium decay to gluons * +C * +C S PYBOOK to book a histogram * +C S PYFILL to fill an entry in a histogram * +C S PYFACT to multiply histogram contents by a factor * +C S PYOPER to perform operations between histograms * +C S PYHIST to print and reset all histograms * +C S PYPLOT to print a single histogram * +C S PYNULL to reset contents of a single histogram * +C S PYDUMP to dump histogram contents onto a file * +C * +C S PYSTOP routine to handle Fortran STOP condition * +C * +C S PYKCUT dummy routine for user kinematical cuts * +C S PYEVWT dummy routine for weighting events * +C S UPINIT dummy routine to initialize user processes * +C S UPEVNT dummy routine to generate a user process event * +C S UPVETO dummy routine to abort event at parton level * +C S PDFSET dummy routine to be removed when using PDFLIB * +C S STRUCTM dummy routine to be removed when using PDFLIB * +C S STRUCTP dummy routine to be removed when using PDFLIB * +C S SUGRA dummy routine to be removed when linking with ISAJET * +C F VISAJE dummy functn. to be removed when linking with ISAJET * +C S SSMSSM dummy routine to be removed when linking with ISAJET * +C S FHSETFLAGS dummy routine -"- FEYNHIGGS * +C S FHSETPARA dummy routine -"- FEYNHIGGS * +C S FHHIGGSCORR dummy routine -"- FEYNHIGGS * +C S PYTAUD dummy routine for interface to tau decay libraries * +C S PYTIME dummy routine for giving date and time * +C * +C********************************************************************* + +C...PYDATA +C...Default values for switches and parameters, +C...and particle, decay and process data. + + BLOCK DATA PYDATA + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYDAT4/CHAF(500,2) + CHARACTER CHAF*16 + COMMON/PYDATR/MRPY(6),RRPY(100) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINT6/PROC(0:500) + CHARACTER PROC*28 + COMMON/PYINT7/SIGT(0:6,0:6,0:5) + COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) + COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), + &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) + COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) + COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) + COMMON/PYPUED/IUED(0:99),RUED(0:99) + COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) + COMMON/PYLH3P/MODSEL(200),PARMIN(100),PAREXT(200),RMSOFT(0:100), + & AU(3,3),AD(3,3),AE(3,3) + COMMON/PYLH3C/CPRO(2),CVER(2) + CHARACTER CPRO*12,CVER*12 + SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/,/PYSUBS/, + &/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/, + &/PYINT6/,/PYINT7/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYTCSM/,/PYPUED/, + &/PYBINS/,/PYLH3P/,/PYLH3C/ + +C...PYDAT1, containing status codes and most parameters. + DATA MSTU/ + & 0, 0, 0, 4000,10000, 500, 8000, 0, 0, 2, + 1 6, 0, 1, 0, 0, 1, 0, 0, 0, 0, + 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0, + 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0, + 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0, + 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 7 30*0, + 1 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 2 1, 5, 3, 5, 0, 0, 0, 0, 0, 0, + & 80*0/ + DATA (PARU(I),I=1,100)/ + & 3.141592653589793D0, 6.283185307179586D0, + & 0.197327D0, 5.06773D0, 0.389380D0, 2.56819D0, 4*0D0, + 1 0.001D0, 0.09D0, 0.01D0, 2D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 2 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 3 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 4 2.0D0, 1.0D0, 0.25D0, 2.5D0, 0.05D0, + 4 0D0, 0D0, 0.0001D0, 0D0, 0D0, + 5 2.5D0,1.5D0,7.0D0,1.0D0,0.5D0,2.0D0,3.2D0, 0D0, 0D0, 0D0, + 6 40*0D0/ + DATA (PARU(I),I=101,200)/ + & 0.00729735D0, 0.232D0, 0.007764D0, 1.0D0, 1.16639D-5, + & 0D0, 0D0, 0D0, 0D0, 0D0, + 1 0.20D0, 0.25D0, 1.0D0, 4.0D0, 10D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 2 -0.693D0, -1.0D0, 0.387D0, 1.0D0, -0.08D0, + 2 -1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0, + 3 1.0D0,-1.0D0, 1.0D0,-1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 4 5.0D0, 1.0D0, 1.0D0, 0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, + 5 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 6 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 7 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0, + 8 1.0D0, 1.0D0, 1.0D0, 0.0D0, 0.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0, + 9 0D0, 0D0, 0D0, 0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0/ + DATA MSTJ/ + & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, + 1 4, 2, 0, 1, 0, 2, 2, 20, 0, 0, + 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0, + 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 3, + 5 0, 3, 0, 2, 0, 0, 1, 0, 0, 0, + 6 40*0, + & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2, + 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, + 2 80*0/ + DATA PARJ/ + & 0.10D0, 0.30D0, 0.40D0, 0.05D0, 0.50D0, + & 0.50D0, 0.50D0, 0.6D0, 1.2D0, 0.6D0, + 1 0.50D0,0.60D0,0.75D0, 0D0, 0D0, 0D0, 0D0, 1.0D0, 1.0D0, 0D0, + 2 0.36D0, 1.0D0,0.01D0, 2.0D0,1.0D0,0.4D0, 0D0, 0D0, 0D0, 0D0, + 3 0.10D0, 1.0D0, 0.8D0, 1.5D0,0D0,2.0D0,0.2D0, 0D0,0.08D0,1D0, + 4 0.3D0, 0.58D0, 0.5D0, 0.9D0,0.5D0,1.0D0,1.0D0,1.5D0,1D0,10D0, + 5 0.77D0, 0.77D0, 0.77D0, -0.05D0, -0.005D0, + 5 0D0, 0D0, 0D0, 1.0D0, 0D0, + 6 4.5D0, 0.7D0, 0D0,0.003D0, 0.5D0, 0.5D0, 0D0, 0D0, 0D0, 0D0, + 7 10D0, 1000D0, 100D0, 1000D0, 0D0, 0.7D0,10D0, 0D0,0D0,0.5D0, + 8 0.29D0, 1.0D0, 1.0D0, 0D0, 10D0, 10D0, 0D0, 0D0, 0D0,1D-4, + 9 0.02D0, 1.0D0, 0.2D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + & 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 1 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 2 1.0D0, 0.25D0,91.187D0,2.489D0, 0.01D0, + 2 2.0D0, 1.0D0, 0.25D0,0.002D0, 0D0, + 3 0D0, 0D0, 0D0, 0D0, 0.01D0, 0.99D0, 0D0, 0D0, 0.2D0, 0D0, + 4 10*0D0, + 5 10*0D0, + 6 10*0D0, + 7 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, -0.693D0, + 8 -1.0D0, 0.387D0, 1.0D0, -0.08D0, -1.0D0, + 8 1.0D0, 1.0D0, -0.693D0, -1.0D0, 0.387D0, + 9 1.0D0, -0.08D0, -1.0D0, 1.0D0, 1.0D0, + 9 5*0D0/ + +C...PYDAT2, with particle data and flavour treatment parameters. + DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, + &-3,0,-3,6*0,3,9*0,3,2*0,3,4*0,-1,41*0,2,-1,20*0,3*3,7*0,3*3,3*0, + &3*3,3*0,3*3,6*0,3*3,3*0,3*3,4*0,-2,-3,2*1,2*0,4,2*3,6,2*-2,2*-3, + &0,2*1,2*0,2*3,-2,2*-3,2*0,-3,2*1,2*0,3,0,2*4,2*3,2*6,3,2*1,2*0, + &2*3,2*0,4,2*3,2*6,2*3,6,2*-2,2*-3,0,-3,0,2*1,2*0,2*3,0,3,2*-2, + &2*-3,2*0,2*-3,0,2*1,2*0,2*3,2*0,2*3,-2,2*-3,2*0,2*-3,2*0,-3,2*0, + &2*3,4*0,2*3,2*0,2*3,2*0,2*3,4*0,2*3,2*0,2*3,3*0,3,2*0,3,0,3,0,3, + &2*0,3,0,3,3*0,-1,2,-1,2,-1,2,-3,0,-3,0,-3,4*0,3,2*0,3,0,-1,2,-1, + &2,-1,2,-3,0,-3,0,-3,2*0,3,3*0,3,8*0,-1,2,-3,6*0,3,2*6,0,3,4*0,3, + &7*0,3, +C...UED singlet and doublet quarks, leptons, and KK g, gamma, Z, and W + &81*0,-1,2,-1,2,-1,2,-1,2,-1,2,-1,2, + &3*-3,0,-3,0,-3,0,-3, + &3*0,3, + &25*0/ + DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,20*0,1,107*0,-1,0,2*-1, + &2*0,-1,3*0,2*-1,3*0,2*-1,4*0,-1,5*0,2*-1,4*0,2*-1,5*0,2*-1,6*0, + &-1,7*0,2*-1,5*0,2*-1,6*0,2*-1,7*0,2*-1,8*0,-1,56*0,6*1,6*0,2,7*0, + &6*1,9*0,2,3*0,2,0,5*2,2*1,17*0,6*2, + &83*0,12*1,9*0,2,3*0,25*0/ + DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,3*0, + &2*1,39*0,1,0,2*1,20*0,3*1,4*0,6*1,3*0,9*1,3*0,12*1,4*0,100*1,2*0, + &2*1,2*0,4*1,2*0,6*1,2*0,8*1,3*0,1,0,2*1,0,3*1,0,4*1,3*0,12*1,3*0, + &1,2*0,1,0,12*1,0,1,3*0,1,8*0,4*1,5*0,3*1,0,1,3*0,2*1,7*0,1, + &81*0,21*1,3*0,1,25*0/ + DATA (KCHG(I,4),I= 1, 290)/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, + &16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36, + &37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57, + &58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78, + &79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99, + &100,110,111,113,115,130,211,213,215,221,223,225,310,311,313,315, + &321,323,325,331,333,335,411,413,415,421,423,425,431,433,435,441, + &443,445,511,513,515,521,523,525,531,533,535,541,543,545,551,553, + &555,990,1103,1114,2101,2103,2112,2114,2203,2212,2214,2224,3101, + &3103,3112,3114,3122,3201,3203,3212,3214,3222,3224,3303,3312,3314, + &3322,3324,3334,4101,4103,4112,4114,4122,4132,4201,4203,4212,4214, + &4222,4224,4232,4301,4303,4312,4314,4322,4324,4332,4334,4403,4412, + &4414,4422,4424,4432,4434,4444,5101,5103,5112,5114,5122,5132,5142, + &5201,5203,5212,5214,5222,5224,5232,5242,5301,5303,5312,5314,5322, + &5324,5332,5334,5342,5401,5403,5412,5414,5422,5424,5432,5434,5442, + &5444,5503,5512,5514,5522,5524,5532,5534,5542,5544,5554,10111, + &10113,10211,10213,10221,10223,10311,10313,10321,10323,10331, + &10333,10411,10413,10421,10423,10431,10433,10441,10443,10511, + &10513,10521,10523,10531,10533,10541,10543,10551,10553,20113, + &20213,20223,20313,20323,20333,20413,20423,20433,20443,20513/ + DATA (KCHG(I,4),I= 291, 500)/20523,20533,20543,20553,100443, + &100553,1000001,1000002,1000003,1000004,1000005,1000006,1000011, + &1000012,1000013,1000014,1000015,1000016,1000021,1000022,1000023, + &1000024,1000025,1000035,1000037,1000039,2000001,2000002,2000003, + &2000004,2000005,2000006,2000011,2000012,2000013,2000014,2000015, + &2000016,3000111,3000211,3000221,3000331,3000113,3000213,3000223, + &3100021,3100111,3200111,3100113,3200113,3300113,3400113,4000001, + &4000002,4000011,4000012,5000039,9900012,9900014,9900016,9900023, + &9900024,9900041,9900042,9900110,9900210,9900220,9900330,9900440, + &9902110,9902210,9900443,9900441,9910441,9900553,9900551,9910551, + &3000115,3000215, + &81*0, +C...UED singlet and doublet quarks and leptons, and KK g, gamma, Z, and W. + &6100001,6100002,6100003,6100004,6100005,6100006, + &5100001,5100002,5100003,5100004,5100005,5100006, + &6100011,6100013,6100015, + &5100012,5100011,5100014,5100013,5100016,5100015, + &5100021,5100022,5100023,5100024, + &25*0/ + DATA (PMAS(I,1),I= 1, 217)/2*0.33D0,0.5D0,1.5D0,4.8D0,175D0, + &2*400D0,2*0D0,0.00051D0,0D0,0.10566D0,0D0,1.777D0,0D0,400D0, + &5*0D0,91.188D0,80.45D0,115D0,6*0D0,500D0,900D0,500D0,3*300D0, + &3*0D0,5000D0,200D0,40*0D0,1D0,2D0,5D0,16*0D0,0.13498D0,0.7685D0, + &1.318D0,0.49767D0,0.13957D0,0.7669D0,1.318D0,0.54745D0,0.78194D0, + &1.275D0,2*0.49767D0,0.8961D0,1.432D0,0.4936D0,0.8916D0,1.425D0, + &0.95777D0,1.0194D0,1.525D0,1.8693D0,2.01D0,2.46D0,1.8645D0, + &2.0067D0,2.46D0,1.9685D0,2.1124D0,2.5735D0,2.9798D0,3.09688D0, + &3.5562D0,5.2792D0,5.3248D0,5.83D0,5.2789D0,5.3248D0,5.83D0, + &5.3693D0,5.4163D0,6.07D0,6.594D0,6.602D0,7.35D0,9.4D0,9.4603D0, + &9.9132D0,0D0,0.77133D0,1.234D0,0.57933D0,0.77133D0,0.93957D0, + &1.233D0,0.77133D0,0.93827D0,1.232D0,1.231D0,0.80473D0,0.92953D0, + &1.19744D0,1.3872D0,1.11568D0,0.80473D0,0.92953D0,1.19255D0, + &1.3837D0,1.18937D0,1.3828D0,1.09361D0,1.3213D0,1.535D0,1.3149D0, + &1.5318D0,1.67245D0,1.96908D0,2.00808D0,2.4521D0,2.5D0,2.2849D0, + &2.4703D0,1.96908D0,2.00808D0,2.4535D0,2.5D0,2.4529D0,2.5D0, + &2.4656D0,2.15432D0,2.17967D0,2.55D0,2.63D0,2.55D0,2.63D0,2.704D0, + &2.8D0,3.27531D0,3.59798D0,3.65648D0,3.59798D0,3.65648D0, + &3.78663D0,3.82466D0,4.91594D0,5.38897D0,5.40145D0,5.8D0,5.81D0, + &5.641D0,5.84D0,7.00575D0,5.38897D0,5.40145D0,5.8D0,5.81D0,5.8D0/ + DATA (PMAS(I,1),I= 218, 500)/5.81D0,5.84D0,7.00575D0,5.56725D0, + &5.57536D0,5.96D0,5.97D0,5.96D0,5.97D0,6.12D0,6.13D0,7.19099D0, + &6.67143D0,6.67397D0,7.03724D0,7.0485D0,7.03724D0,7.0485D0, + &7.21101D0,7.219D0,8.30945D0,8.31325D0,10.07354D0,10.42272D0, + &10.44144D0,10.42272D0,10.44144D0,10.60209D0,10.61426D0, + &11.70767D0,11.71147D0,15.11061D0,0.9835D0,1.231D0,0.9835D0, + &1.231D0,1D0,1.17D0,1.429D0,1.29D0,1.429D0,1.29D0,2*1.4D0,2.272D0, + &2.424D0,2.272D0,2.424D0,2.5D0,2.536D0,3.4151D0,3.46D0,5.68D0, + &5.73D0,5.68D0,5.73D0,5.92D0,5.97D0,7.25D0,7.3D0,9.8598D0,9.875D0, + &2*1.23D0,1.282D0,2*1.402D0,1.427D0,2*2.372D0,2.56D0,3.5106D0, + &2*5.78D0,6.02D0,7.3D0,9.8919D0,3.686D0,10.0233D0,32*500D0, + &3*110D0,350D0,3*210D0,500D0,125D0,250D0,400D0,2*350D0,300D0, + &4*400D0,1000D0,3*500D0,1200D0,750D0,2*200D0,7*0D0,3*3.1D0, + &3*9.5D0,2*250D0, + &81*0, +C...UED + &586.,588.,586.,588.,586.,586.,6*598., + &3*505.,6*516.,640.,501.,536.,536.,25*0.D0/ + DATA (PMAS(I,2),I= 1, 500)/5*0D0,1.39816D0,16*0D0,2.47813D0, + &2.07115D0,0.00367D0,6*0D0,14.54029D0,0D0,16.66099D0,8.38842D0, + &3.3752D0,4.17669D0,3*0D0,417.29147D0,0.39162D0,60*0D0,0.151D0, + &0.107D0,2*0D0,0.149D0,0.107D0,0D0,0.00843D0,0.185D0,2*0D0, + &0.0505D0,0.109D0,0D0,0.0498D0,0.098D0,0.0002D0,0.00443D0,0.076D0, + &2*0D0,0.023D0,2*0D0,0.023D0,2*0D0,0.015D0,0.0013D0,0D0,0.002D0, + &2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,5*0D0,0.12D0, + &3*0D0,0.12D0,2*0D0,2*0.12D0,3*0D0,0.0394D0,4*0D0,0.036D0,0D0, + &0.0358D0,2*0D0,0.0099D0,0D0,0.0091D0,74*0D0,0.06D0,0.142D0, + &0.06D0,0.142D0,0D0,0.36D0,0.287D0,0.09D0,0.287D0,0.09D0,0.25D0, + &0.08D0,0.05D0,0.02D0,0.05D0,0.02D0,0.05D0,0D0,0.014D0,0.01D0, + &8*0.05D0,0D0,0.01D0,2*0.4D0,0.025D0,2*0.174D0,0.053D0,3*0.05D0, + &0.0009D0,4*0.05D0,3*0D0,19*1D0,0D0,7*1D0,0D0,1D0,0D0,1D0,0D0, + &0.0208D0,0.01195D0,0.03705D0,0.09511D0,1.89978D0,1.60746D0, + &0.13396D0,200.47294D0,0.02296D0,0.18886D0,94.66794D0,6.08718D0, + &0D0,2.17482D0,2.59359D0,2.59687D0,0.42896D0,0.41912D0,0.14153D0, + &2*0.00098D0,0.00097D0,26.7245D0,21.74916D0,0.88159D0,0.88001D0, + &7*0D0,6*0.01D0,0.25499D0,0.28446D0,131*0D0/ + DATA (PMAS(I,3),I= 1, 500)/5*0D0,13.98156D0,16*0D0,24.78129D0, + &20.71149D0,0.03669D0,6*0D0,145.40294D0,0D0,166.60993D0, + &83.88423D0,33.75195D0,41.76694D0,3*0D0,4172.91467D0,3.91621D0, + &60*0D0,0.4D0,0.25D0,2*0D0,0.4D0,0.25D0,0D0,0.1D0,0.17D0,2*0D0, + &0.2D0,0.12D0,0D0,0.2D0,0.12D0,0.002D0,0.015D0,0.2D0,2*0D0,0.12D0, + &2*0D0,0.12D0,2*0D0,0.05D0,0.005D0,0D0,0.01D0,2*0D0,0.05D0,2*0D0, + &0.05D0,2*0D0,0.05D0,2*0D0,0.05D0,5*0D0,0.14D0,3*0D0,0.14D0,2*0D0, + &2*0.14D0,3*0D0,0.04D0,4*0D0,0.035D0,0D0,0.035D0,2*0D0,0.05D0,0D0, + &0.05D0,74*0D0,0.05D0,0.25D0,0.05D0,0.25D0,0D0,0.2D0,0.4D0, + &0.005D0,0.4D0,0.01D0,0.35D0,0.001D0,0.1D0,0.08D0,0.1D0,0.08D0, + &0.1D0,0D0,0.05D0,0.02D0,6*0.1D0,0.05D0,0.1D0,0D0,0.02D0,2*0.3D0, + &0.05D0,2*0.3D0,0.02D0,2*0.1D0,0.03D0,0.001D0,4*0.1D0,3*0D0, + &19*10D0,0.00001D0,7*10D0,0.00001D0,10D0,0.00001D0,10D0,0.00001D0, + &0.20797D0,0.11949D0,0.37048D0,0.95114D0,18.99785D0,16.07463D0, + &1.33964D0,450D0,0.22959D0,1.88863D0,360D0,60.8718D0,0D0, + &21.74824D0,25.93594D0,25.96873D0,4.28961D0,4.19124D0,1.41528D0, + &0.00977D0,0.00976D0,0.00973D0,267.24501D0,217.49162D0,8.81592D0, + &8.80013D0,13*0D0,2.54987D0,2.84456D0, + &81*0, +C...UED + &12*0.2D0,9*0.1D0,0.2,10.,0.07,0.3,25*0.D0/ + DATA (PMAS(I,4),I= 1, 500)/12*0D0,658654D0,0D0,0.0872D0,68*0D0, + &0.1D0,0.387D0,16*0D0,0.00003D0,2*0D0,15500D0,7804.5D0,5*0D0, + &26.762D0,3*0D0,3709D0,5*0D0,0.317D0,2*0D0,0.1244D0,2*0D0,0.14D0, + &5*0D0,0.468D0,2*0D0,0.462D0,2*0D0,0.483D0,2*0D0,0.15D0,18*0D0, + &44.34D0,0D0,78.88D0,4*0D0,23.96D0,2*0D0,49.1D0,0D0,87.1D0,0D0, + &24.6D0,4*0D0,0.0618D0,0.029D0,6*0D0,0.106D0,6*0D0,0.019D0,2*0D0, + &7*0.1D0,4*0D0,0.342D0,2*0.387D0,6*0D0,2*0.387D0,6*0D0,0.387D0, + &0D0,0.387D0,2*0D0,8*0.387D0,0D0,9*0.387D0,120*0D0,131*0D0/ + + DATA PARF/ + & 0.5D0,0.25D0, 0.5D0,0.25D0, 1D0, 0.5D0, 0D0, 0D0, 0D0, 0D0, + 1 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, + 2 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, + 3 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, + 4 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, + 5 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, + 6 0.75D0, 0.5D0, 0D0,0.1667D0,0.0833D0,0.1667D0,0D0,0D0,0D0, 0D0, + 7 0D0, 0D0, 1D0,0.3333D0,0.6667D0,0.3333D0,0D0,0D0,0D0, 0D0, + 8 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 9 0.0099D0, 0.0056D0, 0.199D0, 1.23D0, 4.17D0, 165D0, 4*0D0, + & 0.325D0,0.325D0,0.5D0,1.6D0, 5.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 1 0D0,0.11D0,0.16D0,0.048D0,0.50D0,0.45D0,0.55D0,0.60D0,0D0,0D0, + 2 0.2D0, 0.1D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 3 60*0D0, + 4 0.2D0, 0.5D0, 8*0D0, + 5 1800*0D0/ + DATA ((VCKM(I,J),J=1,4),I=1,4)/ + & 0.95113D0, 0.04884D0, 0.00003D0, 0.00000D0, + & 0.04884D0, 0.94940D0, 0.00176D0, 0.00000D0, + & 0.00003D0, 0.00176D0, 0.99821D0, 0.00000D0, + & 0.00000D0, 0.00000D0, 0.00000D0, 1.00000D0/ + +C...PYDAT3, with particle decay parameters and data. + DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0, + &4*1,3*0,2*1,40*0,3*1,16*0,3*1,2*0,9*1,0,32*1,2*0,1,3*0,1,2*0,2*1, + &2*0,3*1,2*0,4*1,0,5*1,2*0,4*1,2*0,5*1,2*0,6*1,0,7*1,2*0,5*1,2*0, + &6*1,2*0,7*1,2*0,8*1,0,75*1,0,7*1,0,1,0,1,0,26*1,7*0,8*1, + &81*0, +C...UED + &5*1,0,5*1,0,13*1,25*0/ + DATA (MDCY(I,2),I= 1, 351)/1,9,17,25,33,41,56,66,2*0,76,80,82, + &87,89,143,145,150,2*0,153,162,174,190,210,6*0,289,0,311,334,420, + &503,3*0,530,539,40*0,540,541,545,16*0,554,556,561,570,579,581, + &583,590,598,604,613,615,617,620,630,636,639,650,656,667,673,736, + &739,747,808,810,818,851,853,857,858,861,863,899,900,908,944,945, + &953,992,993,997,1028,1029,1033,1034,1043,2*0,1045,3*0,1046,2*0, + &1049,1052,2*0,1053,1055,1058,2*0,1062,1063,1066,1069,0,1072,1077, + &1079,1082,1084,2*0,1088,1089,1090,1166,2*0,1170,1171,1172,1173, + &1174,2*0,1178,1179,1181,1182,1184,1188,0,1189,1193,1197,1201, + &1205,1209,1213,2*0,1217,1218,1219,1236,1245,2*0,1254,1255,1256, + &1257,1258,1267,2*0,1276,1277,1278,1279,1280,1289,1290,2*0,1299, + &1308,1317,1326,1335,1344,1353,1362,0,1371,1380,1389,1398,1407, + &1416,1425,1434,1443,1452,1453,1454,1455,1456,1461,1464,1466,1471, + &1473,1478,1485,1489,1491,1493,1495,1497,1499,1501,1503,1504,1506, + &1508,1510,1512,1514,1516,1518,1520,1522,1523,1525,1527,1541,1543, + &1545,1549,1551,1553,1555,1557,1559,1561,1563,1565,1567,1578,1592, + &1637,1661,1706,1730,1775,1802,1833,1859,1891,1917,1949,1975,2162, + &2331,2595,2826,3106,3402,0,3657,3706,3734,3783,3811,3860,3888,0, + &3924,0,3960,0,3996,4004,4012,4020,4217,4243,4270,4023,4029,4036, + &4043,4050,4056,4062,4071,4075,4079,4082,4084,4104,4126,4148,4170/ + DATA (MDCY(I,2),I= 352, 500)/4185,4197,4204,7*0,4211,4212,4213, + &4214,4215,4216,4296,4322, + &81*0, +C...UED + %5001,5003,5005,5007,5009,5011,5013,5016,5019,5022,5025,5028, + &5031,5032,5033, + &5034,5035,5036,5037,5038,5039,5040,5064,5065,5083, + &25*0/ + DATA (MDCY(I,3),I= 1, 500)/5*8,15,2*10,2*0,4,2,5,2,54,2,5,3, + &2*0,9,12,16,20,79,6*0,22,0,23,86,83,27,3*0,9,1,40*0,1,4,9,16*0,2, + &5,2*9,2*2,7,8,6,9,2*2,3,10,6,3,11,6,11,6,63,3,8,61,2,8,33,2,4,1, + &3,2,36,1,8,36,1,8,39,1,4,31,1,4,1,9,2,2*0,1,3*0,3,2*0,3,1,2*0,2, + &3,4,2*0,1,3*3,0,5,2,3,2,4,2*0,2*1,76,4,2*0,4*1,4,2*0,1,2,1,2,4,1, + &0,7*4,2*0,2*1,17,2*9,2*0,4*1,2*9,2*0,4*1,9,1,9,2*0,8*9,0,9*9,4*1, + &5,3,2,5,2,5,7,4,7*2,1,9*2,1,2*2,14,2*2,4,9*2,11,14,45,24,45,24, + &45,27,31,26,32,26,32,26,187,169,264,231,280,296,255,0,49,28,49, + &28,49,28,36,0,36,0,36,0,3*8,3,26,27,26,6,3*7,2*6,9,2*4,3,2,20, + &3*22,15,12,2*7,7*0,6*1,26,30, + &81*0, +C...UED + &6*2,6*3,9*1,24,1,18,6,25*0/ + DATA (MDME(I,1),I= 1,8000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, + &7*1,-1,1,7*-1,8*1,2*-1,8*1,2*-1,73*1,-1,2*1,-1,5*1,0,2*-1,6*1,0, + &2*-1,3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,-1,6*1, + &2*-1,3*1,-1,5*1,62*1,6*1,2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1, + &3*1,4*-1,6*1,2*-1,3*1,-1,12*1,62*1,6*1,2*-1,3*1,-1,9*1,62*1, + &3*1,-1,3*1,-1,1,18*1,4*1,2*-1,2*1,-1,1249*1,2*-1,377*1,2*-1, + &1921*1,2*-1,6*1,2*-1,133*1,2*-1,6*1,2*-1,10*1,-1,3*1,-1,3*1,5*-1, + &3*1,-1,16*1,2*-1,6*1,2*-1,16*1,2*-1,6*1,2*-1,13*1,-1,3*1,-1,3*1, + &5*-1,3*1,-1, + &649*0, +C...UED + &10*1,2*0,15*1,3*0,9*1,5*1,0,5*1,0,5*1,0,5*1,0, + &1,24*1,2912*0/ + DATA (MDME(I,2),I= 1,8000)/43*102,4*0,102,0,6*53,3*102,4*0,102, + &2*0,3*102,4*0,102,2*0,6*102,42,6*102,2*42,2*0,8*41,2*0,36*41, + &8*102,0,102,0,102,2*0,21*102,8*32,8*0,16*32,4*0,8*32,9*0,62*53, + &8*32,14*0,16*32,7*0,8*32,16*0,62*53,8*32,13*0,62*53,4*32,5*0, + &18*53,6*32,4*0,12,2*42,2*11,9*42,0,2,3,15*0,4*42,5*0,3,12*0,2, + &3*0,1,0,3,16*0,2*3,15*0,2*42,2*3,18*0,2*3,3*0,1,11*0,22*42,41*0, + &2*3,9*0,16*42,45*0,3,10*0,10*42,20*0,2*13,6*0,12,2*0,12,0,12, + &14*42,16*0,48,3*13,2*42,9*0,14*42,16*0,48,3*13,2*42,9*0,14*42, + &19*0,48,3*13,2*42,6*0,2*11,28*42,5*0,32,3*0,4*32,2*4,0,32,45*0, + &14*42,52*0,10*13,2*42,2*11,4*0,2*42,2*11,6*0,2*42,2*11,0,2*42, + &2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11, + &2*0,3*42,8*0,48,3*13,20*42,4*0,18*42,4*0,9*42,0,162*42,50*0,2*12, + &17*0,2*32,33*0,12,9*0,32,2*0,12,11*0,4*32,2*4,5*0,2404*53,4*32, + &3*0,6*32,3*0,4*32,3*0,50*32,3*53,12*0,8*32,12*0,66*51,6*32,9*0, + &9*32,17*0,6*51,10*0,8*32,15*0,16*32,14*0,8*32,18*0,8*32,18*0, + &16*32, +C...UED + &653*0,30*0,9*0,12*0,37*0,2912*0/ + DATA (BRAT(I) ,I= 1, 348)/43*0D0,0.00003D0,0.001765D0, + &0.998205D0,35*0D0,1D0,6*0D0,0.1783D0,0.1735D0,0.1131D0,0.2494D0, + &0.003D0,0.09D0,0.0027D0,0.01D0,0.0014D0,0.0012D0,2*0.00025D0, + &0.0071D0,0.012D0,0.0004D0,0.00075D0,0.00006D0,2*0.00078D0, + &0.0034D0,0.08D0,0.011D0,0.0191D0,0.00006D0,0.005D0,0.0133D0, + &0.0067D0,0.0005D0,0.0035D0,0.0006D0,0.0015D0,0.00021D0,0.0002D0, + &0.00075D0,0.0001D0,0.0002D0,0.0011D0,3*0.0002D0,0.00022D0, + &0.0004D0,0.0001D0,2*0.00205D0,2*0.00069D0,0.00025D0,0.00051D0, + &0.00025D0,35*0D0,0.153995D0,0.11942D0,0.153984D0,0.119259D0, + &0.152272D0,3*0D0,0.033576D0,0.066806D0,0.033576D0,0.066806D0, + &0.0335D0,0.066806D0,2*0D0,0.321369D0,0.016494D0,2*0D0,0.016502D0, + &0.320615D0,2*0D0,0.00001D0,0.000591D0,6*0D0,2*0.108166D0, + &0.108087D0,0D0,0.000001D0,0D0,0.000353D0,0.04359D0,0.795274D0, + &4*0D0,0.000339D0,0.095746D0,0D0,0.060724D0,0.003054D0,0.000919D0, + &64*0D0,0.145835D0,0.113276D0,0.145835D0,0.113271D0,0.145781D0, + &0.049002D0,2*0D0,0.032025D0,0.063642D0,0.032025D0,0.063642D0, + &0.032022D0,0.063642D0,8*0D0,0.251225D0,0.0129D0,0.000006D0,0D0, + &0.0129D0,0.250764D0,0.00038D0,0D0,0.000008D0,0.000465D0, + &0.215418D0,5*0D0,2*0.085312D0,0.08531D0,7*0D0,0.000029D0, + &0.000536D0,5*0D0,0.000074D0,0D0,0.000417D0,0.000015D0,0.000061D0/ + DATA (BRAT(I) ,I= 349, 655)/0.306789D0,0.689189D0,0D0,0.00289D0, + &69*0D0,0.000001D0,0.000072D0,0.001333D0,4*0D0,0.000001D0, + &0.000184D0,0D0,0.003108D0,0.000015D0,0.000003D0,2*0D0,0.995284D0, + &66*0D0,0.000014D0,0.082234D0,2*0D0,0.000013D0,0.003746D0,0D0, + &0.913992D0,18*0D0,3*0.215119D0,0.214724D0,2*0D0,0.06996D0, + &0.069959D0,0D0,2*1D0,2*0.08D0,0.76D0,0.08D0,2*0.105D0,0.04D0, + &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,0.988D0,0.012D0, + &0.998739D0,0.00079D0,0.00038D0,0.000046D0,0.000045D0,2*0.34725D0, + &0.144D0,0.104D0,0.0245D0,2*0.01225D0,0.0028D0,0.0057D0,0.2112D0, + &0.1256D0,2*0.1939D0,2*0.1359D0,0.002D0,0.001D0,0.0006D0, + &0.999877D0,0.000123D0,0.99955D0,0.00045D0,2*0.34725D0,0.144D0, + &0.104D0,0.049D0,0.0028D0,0.0057D0,0.3923D0,0.321D0,0.2317D0, + &0.0478D0,0.0049D0,0.0013D0,0.0003D0,0.0007D0,0.89D0,0.08693D0, + &0.0221D0,0.00083D0,2*0.00007D0,0.564D0,0.282D0,0.072D0,0.028D0, + &0.023D0,2*0.0115D0,0.005D0,0.003D0,0.6861D0,0.3139D0,2*0.5D0, + &0.665D0,0.333D0,0.002D0,0.333D0,0.166D0,0.168D0,0.084D0,0.087D0, + &0.043D0,0.059D0,2*0.029D0,0.002D0,0.6352D0,0.2116D0,0.0559D0, + &0.0173D0,0.0482D0,0.0318D0,0.666D0,0.333D0,0.001D0,0.332D0, + &0.166D0,0.168D0,0.084D0,0.086D0,0.043D0,0.059D0,2*0.029D0, + &2*0.002D0,0.437D0,0.208D0,0.302D0,0.0302D0,0.0212D0,0.0016D0/ + DATA (BRAT(I) ,I= 656, 831)/0.48947D0,0.34D0,3*0.043D0,0.027D0, + &0.0126D0,0.0013D0,0.0003D0,0.00025D0,0.00008D0,0.444D0,2*0.222D0, + &0.104D0,2*0.004D0,0.07D0,0.065D0,2*0.005D0,2*0.011D0,5*0.001D0, + &0.07D0,0.065D0,2*0.005D0,2*0.011D0,5*0.001D0,0.026D0,0.019D0, + &0.066D0,0.041D0,0.045D0,0.076D0,0.0073D0,2*0.0047D0,0.026D0, + &0.001D0,0.0006D0,0.0066D0,0.005D0,2*0.003D0,2*0.0006D0,2*0.001D0, + &0.006D0,0.005D0,0.012D0,0.0057D0,0.067D0,0.008D0,0.0022D0, + &0.027D0,0.004D0,0.019D0,0.012D0,0.002D0,0.009D0,0.0218D0,0.001D0, + &0.022D0,0.087D0,0.001D0,0.0019D0,0.0015D0,0.0028D0,0.683D0, + &0.306D0,0.011D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0,0.06D0,0.08D0, + &0.04D0,0.034D0,0.027D0,2*0.002D0,2*0.004D0,2*0.002D0,0.034D0, + &0.027D0,2*0.002D0,2*0.004D0,2*0.002D0,0.0365D0,0.045D0,0.073D0, + &0.062D0,3*0.021D0,0.0061D0,0.015D0,0.025D0,0.0088D0,0.074D0, + &0.0109D0,0.0041D0,0.002D0,0.0035D0,0.0011D0,0.001D0,0.0027D0, + &2*0.0016D0,0.0018D0,0.011D0,0.0063D0,0.0052D0,0.018D0,0.016D0, + &0.0034D0,0.0036D0,0.0009D0,0.0006D0,0.015D0,0.0923D0,0.018D0, + &0.022D0,0.0077D0,0.009D0,0.0075D0,0.024D0,0.0085D0,0.067D0, + &0.0511D0,0.017D0,0.0004D0,0.0028D0,0.619D0,0.381D0,0.3D0,0.15D0, + &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.01D0,2*0.02D0,0.03D0, + &2*0.005D0,2*0.02D0,0.03D0,2*0.005D0,0.015D0,0.037D0,0.028D0/ + DATA (BRAT(I) ,I= 832, 997)/0.079D0,0.095D0,0.052D0,0.0078D0, + &4*0.001D0,0.028D0,0.033D0,0.026D0,0.05D0,0.01D0,4*0.005D0,0.25D0, + &0.0952D0,0.94D0,0.06D0,2*0.4D0,2*0.1D0,1D0,0.0602D0,0.0601D0, + &0.8797D0,0.135D0,0.865D0,0.02D0,0.055D0,2*0.005D0,0.008D0, + &0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0, + &0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0, + &0.0185D0,0.0135D0,0.025D0,0.0004D0,0.0007D0,0.0008D0,0.0014D0, + &0.0019D0,0.0025D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0, + &1D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0, + &0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0, + &2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0, + &0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0,0.0135D0, + &0.025D0,0.0004D0,0.0007D0,0.0008D0,0.0014D0,0.0019D0,0.0025D0, + &0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0, + &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.02D0,0.055D0, + &2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0, + &0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0, + &0.018D0,0.015D0,0.0185D0,0.0135D0,0.025D0,2*0.0002D0,0.0007D0, + &2*0.0004D0,0.0014D0,0.001D0,0.0009D0,0.0025D0,0.4291D0,0.08D0, + &0.07D0,0.02D0,0.015D0,0.005D0,1D0,2*0.3D0,2*0.2D0,0.047D0/ + DATA (BRAT(I) ,I= 998,1188)/0.122D0,0.006D0,0.012D0,0.035D0, + &0.012D0,0.035D0,0.003D0,0.007D0,0.15D0,0.037D0,0.008D0,0.002D0, + &0.05D0,0.015D0,0.003D0,0.001D0,0.014D0,0.042D0,0.014D0,0.042D0, + &0.24D0,0.065D0,0.012D0,0.003D0,0.001D0,0.002D0,0.001D0,0.002D0, + &0.014D0,0.003D0,1D0,2*0.3D0,2*0.2D0,1D0,0.0252D0,0.0248D0, + &0.0267D0,0.015D0,0.045D0,0.015D0,0.045D0,0.7743D0,0.029D0,0.22D0, + &0.78D0,1D0,0.331D0,0.663D0,0.006D0,0.663D0,0.331D0,0.006D0,1D0, + &0.999D0,0.001D0,0.88D0,2*0.06D0,0.639D0,0.358D0,0.002D0,0.001D0, + &1D0,0.88D0,2*0.06D0,0.516D0,0.483D0,0.001D0,0.88D0,2*0.06D0, + &0.9988D0,0.0001D0,0.0006D0,0.0004D0,0.0001D0,0.667D0,0.333D0, + &0.9954D0,0.0011D0,0.0035D0,0.333D0,0.667D0,0.676D0,0.234D0, + &0.085D0,0.005D0,2*1D0,0.018D0,2*0.005D0,0.003D0,0.002D0, + &2*0.006D0,0.018D0,2*0.005D0,0.003D0,0.002D0,2*0.006D0,0.0066D0, + &0.025D0,0.016D0,0.0088D0,2*0.005D0,0.0058D0,0.005D0,0.0055D0, + &4*0.004D0,2*0.002D0,2*0.004D0,0.003D0,0.002D0,2*0.003D0, + &3*0.002D0,2*0.001D0,0.002D0,2*0.001D0,2*0.002D0,0.0013D0, + &0.0018D0,5*0.001D0,4*0.003D0,2*0.005D0,2*0.002D0,2*0.001D0, + &2*0.002D0,2*0.001D0,0.2432D0,0.057D0,2*0.035D0,0.15D0,2*0.075D0, + &0.03D0,2*0.015D0,2*0.08D0,0.76D0,0.08D0,4*1D0,2*0.08D0,0.76D0, + &0.08D0,1D0,2*0.5D0,1D0,2*0.5D0,2*0.08D0,0.76D0,0.08D0,1D0/ + DATA (BRAT(I) ,I=1189,1381)/2*0.08D0,0.76D0,3*0.08D0,0.76D0, + &3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0, + &3*0.08D0,0.76D0,0.08D0,2*1D0,2*0.105D0,0.04D0,0.0077D0,0.02D0, + &0.0235D0,0.0285D0,0.0435D0,0.0011D0,0.0022D0,0.0044D0,0.4291D0, + &0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0, + &0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0, + &0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,4*1D0,2*0.105D0,0.04D0, + &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, + &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,4*1D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,1D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0, + &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0/ + DATA (BRAT(I) ,I=1382,1582)/0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, + &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, + &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, + &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, + &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, + &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, + &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, + &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, + &0.015D0,0.005D0,4*1D0,0.52D0,0.26D0,0.11D0,2*0.055D0,0.333D0, + &0.334D0,0.333D0,0.667D0,0.333D0,0.28D0,0.14D0,0.313D0,0.157D0, + &0.11D0,0.667D0,0.333D0,0.28D0,0.14D0,0.313D0,0.157D0,0.11D0, + &0.36D0,0.18D0,0.03D0,2*0.015D0,2*0.2D0,4*0.25D0,0.667D0,0.333D0, + &0.667D0,0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,4*0.5D0,0.007D0, + &0.993D0,1D0,0.667D0,0.333D0,0.667D0,0.333D0,0.667D0,0.333D0, + &0.667D0,0.333D0,8*0.5D0,0.02D0,0.98D0,1D0,4*0.5D0,3*0.146D0, + &3*0.05D0,0.15D0,2*0.05D0,4*0.024D0,0.066D0,0.667D0,0.333D0, + &0.667D0,0.333D0,4*0.25D0,0.667D0,0.333D0,0.667D0,0.333D0,2*0.5D0, + &0.273D0,0.727D0,0.667D0,0.333D0,0.667D0,0.333D0,4*0.5D0,0.35D0, + &0.65D0,2*0.0083D0,0.1866D0,0.324D0,0.184D0,0.027D0,0.001D0, + &0.093D0,0.087D0,0.078D0,0.0028D0,3*0.014D0,0.008D0,0.024D0/ + DATA (BRAT(I) ,I=1583,4150)/0.008D0,0.024D0,0.425D0,0.02D0, + &0.185D0,0.088D0,0.043D0,0.067D0,0.066D0,2404*0D0,0.024396D0, + &0.045285D0,0.83119D0,2*0D0,0.000349D0,0.09878D0,0D0,0.019884D0, + &0.02341D0,0.362776D0,0.550787D0,2*0D0,0.000152D0,0.042991D0, + &0.013695D0,0.025421D0,0.466595D0,2*0D0,0.000196D0,0.055451D0, + &0.438642D0,0.445781D0,0D0,0.554219D0,4*0.00335D0,0.522257D0, + &0.464343D0,6*0D0,1D0,6*0D0,1D0,4*0.013853D0,0.562703D0, + &0.376702D0,0.00518D0,4*0.006254D0,0.974985D0,7*0D0,4*0.148299D0, + &0.015351D0,0D0,0.182109D0,0.167099D0,0.042247D0,0.850973D0, + &0.005411D0,0.045025D0,0.098591D0,0.849898D0,0.021617D0, + &0.030018D0,0.098466D0,0.294448D0,0.10945D0,0.596102D0,0.389906D0, + &0.610094D0,3*0.0633D0,0.063299D0,0.063295D0,0.056281D0,2*0D0, + &6*0.020495D0,2*0D0,0.327919D0,0.04099D0,0.045236D0,0.090112D0, + &0.19874D0,0.010204D0,0.000003D0,0.010205D0,0.198356D0,0.000151D0, + &0.000006D0,0.000367D0,0.081967D0,0.19874D0,0.010204D0,0.000003D0, + &0.010205D0,0.198356D0,0.000151D0,0.000006D0,0.000367D0, + &0.081967D0,4*0D0,0.198776D0,0.010206D0,0.000003D0,0.010207D0, + &0.19839D0,0.000151D0,0.000006D0,0.000367D0,0.081893D0,0.198776D0, + &0.010206D0,0.000003D0,0.010207D0,0.19839D0,0.000151D0,0.000006D0, + &0.000367D0,0.081893D0,4*0D0,0.199344D0,0.010234D0,0.000003D0/ + DATA (BRAT(I) ,I=4151,4281)/0.010236D0,0.198928D0,0.000149D0, + &0.000006D0,0.000368D0,0.080733D0,0.199344D0,0.010234D0, + &0.000003D0,0.010236D0,0.198928D0,0.000149D0,0.000006D0, + &0.000368D0,0.080733D0,4*0D0,0.184738D0,0.104588D0,0.184738D0, + &0.104587D0,0.184731D0,0.09582D0,0.022902D0,0.008429D0,0.015602D0, + &0.022902D0,0.008429D0,0.015602D0,0.022902D0,0.008429D0, + &0.015602D0,0.28959D0,0.01487D0,0.000008D0,0.01487D0,0.289061D0, + &0.000492D0,0.000009D0,0.000536D0,0.27911D0,2*0.037151D0, + &0.03715D0,0.090266D0,2*0.001805D0,0.090266D0,0.001805D0, + &0.812263D0,0.00179D0,0.090428D0,0.001809D0,0.001808D0,0.090428D0, + &0.001808D0,0.81372D0,0D0,6*1D0,0.095602D0,2*0.338272D0, + &0.156896D0,0.019193D0,0.017993D0,0.001168D0,0.001462D0, + &0.009608D0,0.003306D0,0.002132D0,0.003127D0,0.002132D0, + &0.003127D0,0.00213D0,3*0D0,0.001411D0,0.00045D0,0.001411D0, + &0.00045D0,0.001411D0,0.00045D0,2*0D0,0.097996D0,0.399787D0, + &0.262464D0,0.185427D0,0.022683D0,0.007648D0,0.004259D0, + &0.005925D0,0.000304D0,2*0D0,0.000304D0,0.005914D0,0.000002D0, + &2*0D0,0.000011D0,0.001258D0,5*0D0,3*0.002005D0,0D0,0.272178D0, + &0.022112D0,0.255165D0,0.015534D0,2*0.108965D0,0.031557D0, + &0.005562D0,0.044965D0,0.004674D0,0.007637D0,0.020597D0/ + DATA (BRAT(I) ,I=4282,8000)/0.007636D0,0.020595D0,0.007616D0, + &3*0D0,0.017298D0,0.004782D0,0.017298D0,0.004782D0,0.017297D0, + &0.004782D0,2*0D0,0.055332D0,2*0.319757D0,0.121576D0,2*0.001556D0, + &4*0D0,0.0277D0,0.021481D0,0.027699D0,0.021477D0,0.027658D0,3*0D0, + &0.006071D0,0.01208D0,0.006071D0,0.01208D0,0.006069D0,0.01208D0, + &2*0D0,0.035891D0,0.209476D0,0.129084D0,0.286631D0,0.10742D0, + &0.109486D0,4*0D0,0.035282D0,0.001812D0,2*0D0,0.001812D0, + &0.035215D0,0.000021D0,0D0,0.000001D0,0.000065D0,0.011965D0,5*0D0, + &2*0.011947D0,0.011946D0,0D0, + &649*0.D0, +C....UED + &0.001D0,0.999D0,0.001D0,0.999D0,0.001D0,0.999D0, + &0.001D0,0.999D0,0.001D0,0.999D0,0.001D0,0.999D0, + &0.33D0,0.66D0,0.01D0,0.33D0,0.66D0,0.01D0,0.33D0,0.66D0,0.01D0, + &0.33D0,0.66D0,0.01D0,0.98D0,0.D0,0.02D0,0.33D0,0.66D0,0.01D0, + &9*1.D0, + &24*0.0416667, + &1., + &3*0.D0,6*0.08333D0, + &3*0.D0,6*0.08333D0, + &6*0.166667D0, + &2912*0.D0/ + DATA (KFDP(I,1),I= 1, 377)/21,22,23,4*-24,25,21,22,23,4*24,25, + &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23, + &4*24,25,37,1000022,1000023,1000025,1000035,1000021,1000039,21,22, + &23,4*-24,25,2*-37,21,22,23,4*24,25,2*37,22,23,-24,25,23,24,-12, + &22,23,-24,25,23,24,-12,-14,48*16,22,23,-24,25,23,24,22,23,-24,25, + &-37,23,24,37,1,2,3,4,5,6,7,8,21,1,2,3,4,5,6,7,8,11,13,15,17,1,2, + &3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1,4*-3,4*-5,4*-7,-11,-13, + &-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,1000022, + &2*1000023,3*1000025,4*1000035,2*1000024,2*1000037,1000001, + &2000001,1000001,-1000001,1000002,2000002,1000002,-1000002, + &1000003,2000003,1000003,-1000003,1000004,2000004,1000004, + &-1000004,1000005,2000005,1000005,-1000005,1000006,2000006, + &1000006,-1000006,1000011,2000011,1000011,-1000011,1000012, + &2000012,1000012,-1000012,1000013,2000013,1000013,-1000013, + &1000014,2000014,1000014,-1000014,1000015,2000015,1000015, + &-1000015,1000016,2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,12, + &13,14,15,16,17,18,24,37,2*23,25,35,4*-1,4*-3,4*-5,4*-7,-11,-13, + &-15,-17,3*24,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,23,25,24, + &37,23,25,36,1000022,2*1000023,3*1000025,4*1000035,2*1000024, + &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002/ + DATA (KFDP(I,1),I= 378, 580)/1000002,-1000002,1000003,2000003, + &1000003,-1000003,1000004,2000004,1000004,-1000004,1000005, + &2000005,1000005,-1000005,1000006,2000006,1000006,-1000006, + &1000011,2000011,1000011,-1000011,1000012,2000012,1000012, + &-1000012,1000013,2000013,1000013,-1000013,1000014,2000014, + &1000014,-1000014,1000015,2000015,1000015,-1000015,1000016, + &2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23, + &24,23,25,24,37,1000022,2*1000023,3*1000025,4*1000035,2*1000024, + &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002, + &1000002,-1000002,1000003,2000003,1000003,-1000003,1000004, + &2000004,1000004,-1000004,1000005,2000005,1000005,-1000005, + &1000006,2000006,1000006,-1000006,1000011,2000011,1000011, + &-1000011,1000012,2000012,1000012,-1000012,1000013,2000013, + &1000013,-1000013,1000014,2000014,1000014,-1000014,1000015, + &2000015,1000015,-1000015,1000016,2000016,1000016,-1000016,-1,-3, + &-5,-7,-11,-13,-15,-17,24,2*1000022,2*1000023,2*1000025,2*1000035, + &1000006,2000006,1000006,2000006,-1000001,-1000003,-1000011, + &-1000013,-1000015,-2000015,1,2,3,4,5,6,11,13,15,2,82,-11,-13,2*2, + &-12,-14,-16,2*-2,2*-4,-2,-4,2*22,211,111,221,13,11,213,-213,221, + &223,321,130,310,111,331,111,211,-12,12,-14,14,211,111,22,-13,-11/ + DATA (KFDP(I,1),I= 581, 992)/2*211,213,113,221,223,321,211,331, + &22,111,211,2*22,211,22,111,211,22,211,221,111,11,211,111,2*211, + &321,130,310,221,111,211,111,130,310,321,2*311,321,311,323,313, + &323,313,321,3*311,-13,3*211,12,14,311,2*321,311,321,313,323,313, + &323,311,4*321,211,111,3*22,111,321,130,-213,113,213,211,22,111, + &11,13,211,321,130,310,221,211,111,11*-11,11*-13,-311,-313,-311, + &-313,-20313,2*-311,-313,-311,-313,2*111,2*221,2*331,2*113,2*223, + &2*333,-311,-313,2*-321,211,-311,-321,333,-311,-313,-321,211, + &2*-321,2*-311,-321,211,113,421,2*411,421,411,423,413,423,413,421, + &411,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311,-313,2*-311, + &-321,-10323,-321,-323,-321,-311,2*-313,211,111,333,3*-321,-311, + &-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211,-321,3*-311, + &211,113,321,2*421,411,421,413,423,413,423,411,421,-15,5*-11, + &5*-13,221,331,333,221,331,333,10221,211,213,211,213,321,323,321, + &323,2212,221,331,333,221,2*2,2*431,421,411,423,413,82,11,13,82, + &443,82,6*12,6*14,2*16,3*-411,3*-413,2*-411,2*-413,2*441,2*443, + &2*20443,2*2,2*4,2,4,511,521,511,523,513,523,513,521,511,6*12, + &6*14,2*16,3*-421,3*-423,2*-421,2*-423,2*441,2*443,2*20443,2*2, + &2*4,2,4,521,511,521,513,523,513,523,511,521,6*12,6*14,2*16, + &3*-431,3*-433,2*-431,2*-433,3*441,3*443,3*20443,2*2,2*4,2,4,531/ + DATA (KFDP(I,1),I= 993,1402)/521,511,523,513,16,2*4,2*12,2*14, + &2*16,4*2,4*4,2*-11,2*-13,2*-1,2*-3,2*-11,2*-13,2*-1,541,511,521, + &513,523,21,11,13,15,1,2,3,4,21,22,553,21,2112,2212,2*2112,2212, + &2112,2*2212,2112,-12,3122,3212,3112,2212,2*2112,-12,2*3122,3222, + &3112,2212,2112,2212,3122,3222,3212,3122,3112,-12,-14,-12,3322, + &3312,2*3122,3212,3322,3312,3122,3322,3312,-12,2*4122,7*-11,7*-13, + &2*2224,2*2212,2*2214,2*3122,2*3212,2*3214,5*3222,4*3224,2*3322, + &3324,2*2224,7*2212,5*2214,2*2112,2*2114,2*3122,2*3212,2*3214, + &2*3222,2*3224,4*2,3,2*2,1,2*2,-11,-13,2*2,4*4122,-11,-13,2*2, + &3*4132,3*4232,-11,-13,2*2,4332,-11,-13,2*2,-11,-13,2*2,-11,-13, + &2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,2*5122,-12, + &-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2, + &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,4*5122,-12,-14,-16,2*-2, + &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,2*5132,2*5232,-12,-14,-16, + &2*-2,2*-4,-2,-4,5332,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16, + &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2, + &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2, + &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12, + &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16, + &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2/ + DATA (KFDP(I,1),I=1403,1713)/2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2, + &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12, + &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,221,223,221, + &223,211,111,321,130,310,213,113,-213,321,311,321,311,323,313, + &2*311,321,311,321,313,323,321,211,111,321,130,310,2*211,313,-313, + &323,-323,421,411,423,413,411,421,413,423,411,421,423,413,443, + &2*82,521,511,523,513,511,521,513,523,521,511,523,513,511,521,513, + &523,553,2*21,213,-213,113,213,10211,10111,-10211,2*221,213,2*113, + &-213,2*321,2*311,113,323,2*313,323,313,-313,323,-323,423,2*413, + &2*423,413,443,82,523,2*513,2*523,2*513,523,553,21,11,13,82,4*443, + &10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553,10551,20553,555, + &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, + &1000002,2000002,1000002,2000002,1000021,3*-12,3*-14,3*-16,12,11, + &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6, + &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000001, + &2000001,1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3, + &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, + &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11, + &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6, + &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000003/ + DATA (KFDP(I,1),I=1714,1984)/2000003,1000003,2000003,1000021, + &3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024,-1000037,1000022, + &1000023,1000025,1000035,1000006,2000006,1000006,2000006,1000021, + &3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13,14,13,16,15,16, + &15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037,1000022,1000023, + &1000025,1000035,1000005,2000005,1000005,2000005,1000021,1000022, + &1000016,-1000015,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024, + &-1000037,1000022,1000023,1000025,1000035,1000012,2000012,1000012, + &2*12,2*14,2*16,3*-14,3*-16,3*-2,3*-4,3*-6,1000039,1000024, + &1000037,1000022,1000023,1000025,1000035,1000011,2000011,1000011, + &2000011,3*-13,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037, + &1000022,1000023,1000025,1000035,1000014,2000014,1000014,2000014, + &2*12,2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,1000024, + &1000037,1000022,1000023,1000025,1000035,1000013,2000013,1000013, + &2000013,3*-11,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037, + &1000022,1000023,1000025,1000035,1000016,2000016,1000016,2000016, + &2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,1000039,1000024, + &1000037,1000022,1000023,1000025,1000035,1000015,2000015,1000015, + &2000015,3*-11,3*-13,3*-1,3*-3,3*-5,1000039,1000001,-1000001, + &2000001,-2000001,1000002,-1000002,2000002,-2000002,1000003/ + DATA (KFDP(I,1),I=1985,2321)/-1000003,2000003,-2000003,1000004, + &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, + &1000006,-1000006,2000006,-2000006,6*1000022,6*1000023,6*1000025, + &6*1000035,1000024,-1000024,1000024,-1000024,1000024,-1000024, + &1000037,-1000037,1000037,-1000037,1000037,-1000037,-12,12,-11,11, + &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12, + &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13, + &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14, + &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15, + &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16, + &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2, + &-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039,4,1,-12,12,-12,12,-12,12, + &-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14,14,-14,14,-14,14, + &-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12,12,-11,11,-12,12, + &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11, + &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13,-14,14, + &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13, + &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15,-16,16, + &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15, + &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2,-4,4,-4/ + DATA (KFDP(I,1),I=2322,2573)/4,-4,4,-6,6,-6,6,-6,6,5*1000039, + &16*1000022,1000024,-1000024,1000024,-1000024,1000024,-1000024, + &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000037, + &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037, + &1000037,-1000037,1000037,-1000037,1000024,-1000024,1000037, + &-1000037,1000001,-1000001,2000001,-2000001,1000002,-1000002, + &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004, + &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, + &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011, + &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013, + &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015, + &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016, + &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14, + &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16, + &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, + &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12, + &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, + &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14, + &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, + &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16/ + DATA (KFDP(I,1),I=2574,2892)/16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4, + &-4,4,-6,6,-6,6,-6,6,2*1000039,6*1000022,6*1000023,6*1000025, + &6*1000035,1000022,1000023,1000025,1000035,1000002,2000002, + &-1000001,-2000001,1000004,2000004,-1000003,-2000003,1000006, + &2000006,-1000005,-2000005,1000012,2000012,-1000011,-2000011, + &1000014,2000014,-1000013,-2000013,1000016,2000016,-1000015, + &-2000015,2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11, + &-12,12,-11,-12,12,-11,-14,-13,-14,-13,-14,-13,-14,14,-13,-14,14, + &-13,-14,14,-13,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15, + &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12, + &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-14,2*-13,14, + &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14, + &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16,2*-15,16,-16,2*-15,16, + &-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16, + &-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1,2,-1,3*2,-1,2*4,-3, + &3*4,-3,2*6,5*1000039,16*1000022,16*1000023,1000024,-1000024, + &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000024, + &-1000024,1000024,-1000024,1000037,-1000037,1000037,-1000037, + &1000037,-1000037,1000037,-1000037,1000037,-1000037,1000037, + &-1000037,1000024,-1000024,1000037,-1000037,1000001,-1000001/ + DATA (KFDP(I,1),I=2893,3182)/2000001,-2000001,1000002,-1000002, + &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004, + &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, + &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011, + &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013, + &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015, + &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016, + &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14, + &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16, + &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, + &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12, + &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, + &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14, + &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, + &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16, + &16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039, + &16*1000022,16*1000023,16*1000025,1000024,-1000024,1000024, + &-1000024,1000024,-1000024,1000024,-1000024,1000024,-1000024, + &1000024,-1000024,1000037,-1000037,1000037,-1000037,1000037, + &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037/ + DATA (KFDP(I,1),I=3183,3459)/1000024,-1000024,1000037,-1000037, + &1000001,-1000001,2000001,-2000001,1000002,-1000002,2000002, + &-2000002,1000003,-1000003,2000003,-2000003,1000004,-1000004, + &2000004,-2000004,1000005,-1000005,2000005,-2000005,1000006, + &-1000006,2000006,-2000006,1000011,-1000011,2000011,-2000011, + &1000012,-1000012,2000012,-2000012,1000013,-1000013,2000013, + &-2000013,1000014,-1000014,2000014,-2000014,1000015,-1000015, + &2000015,-2000015,1000016,-1000016,2000016,-2000016,5*1000021,-12, + &12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14, + &14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12, + &12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, + &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14, + &14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, + &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16, + &16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, + &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2, + &-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,2*1000039,15*1000024, + &6*1000022,6*1000023,6*1000025,6*1000035,1000022,1000023,1000025, + &1000035,1000002,2000002,-1000001,-2000001,1000004,2000004, + &-1000003,-2000003,1000006,2000006,-1000005,-2000005,1000012/ + DATA (KFDP(I,1),I=3460,3782)/2000012,-1000011,-2000011,1000014, + &2000014,-1000013,-2000013,1000016,2000016,-1000015,-2000015, + &2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11, + &-12,12,-11,-14,14,-13,-14,14,-13,-14,14,-13,-14,14,-13,-14,14, + &-13,-14,14,-13,-16,16,-15,-16,16,-15,-16,16,-15,-16,16,-15,-16, + &16,-15,-16,16,-15,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12, + &2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12, + &2*-11,12,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14, + &2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16, + &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16, + &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1, + &2,-1,3*2,-1,2*4,-3,3*4,-3,2*6,1000039,-1000024,-1000037,1000022, + &1000023,1000025,1000035,4*1000001,1000002,2000002,1000002, + &2000002,1000021,3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13, + &14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037, + &1000022,1000023,1000025,1000035,4*1000002,1000001,2000001, + &1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039, + &-1000024,-1000037,1000022,1000023,1000025,1000035,4*1000003, + &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11, + &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6/ + DATA (KFDP(I,1),I=3783,4156)/1000039,1000024,1000037,1000022, + &1000023,1000025,1000035,4*1000004,1000003,2000003,1000003, + &2000003,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024, + &-1000037,1000022,1000023,1000025,1000035,4*1000005,1000006, + &2000006,1000006,2000006,1000021,3*-12,3*-14,3*-16,12,11,12,11,12, + &11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039, + &1000024,1000037,1000022,1000023,1000025,1000035,4*1000006, + &1000005,2000005,1000005,2000005,1000021,3*-11,3*-13,3*-15,2*-1, + &-3,1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, + &4*1000011,1000012,2000012,1000012,2000012,2*12,2*14,2*16,3*-14, + &3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037,1000022,1000023, + &1000025,1000035,4*1000013,1000014,2000014,1000014,2000014,2*12, + &2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037, + &1000022,1000023,1000025,1000035,4*1000015,1000016,2000016, + &1000016,2000016,2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,3,4,5, + &6,11,13,15,21,2*4,2,4,24,-11,-13,-15,3,4,5,6,11,13,15,21,5,6,21, + &1,2,3,4,5,6,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4, + &5,6,1,2,3,4,5,6,1,2,3,4,5,6,21,3100111,3200111,21,22,23,-24,21, + &22,23,24,22,23,-24,23,24,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18, + &21,22,23,24,9*11,9*-11,11,-11,11,-11,9*13,9*-13,13,-13,13,-13, + &9*15/ + DATA (KFDP(I,1),I=4157,8000)/9*-15,15,-15,15,-15,1,2,3,4,5,6,11, + &12,9900012,13,14,9900014,15,16,9900016,3*-1,3*-3,3*-5,-11,-13,-15, + &3*-11,2*-13,-15,24,3*-11,2*-13,-15,9900024,3*443,3*553,2*24, + &2*3000211,2*22,2*23,22,23,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17, + &18,2*24,3*3000211,2*24,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,22,23, + &22,23,24,3000211,24,3000211,22,23,1,2,3,4,5,6,7,8,11,12,13,14,15, + &16,17,18,2*24,-24,23,2*22,24,-24,2*23,1,2,3,4,5,6,7,8,11,12,13, + &14,15,16,17,18,2*22,23,2*24,23,22,2*24,23,4*-1,4*-3,4*-5,4*-7, + &-11,-13,-15,-17, + &649*0, +C...UED + &5100023,5100022,5100023,5100022,5100023,5100022, + &5100023,5100022,5100023,5100022,5100023,5100022, + &5100023,-5100024,5100022,5100023,5100024,5100022, + &5100023,-5100024,5100022,5100023,5100024,5100022, + &5100023,-5100024,5100022,5100023,5100024,5100022, + &9*5100022, + &6100001,6100002,6100003,6100004,6100005,6100006, + &5100001,5100002,5100003,5100004,5100005,5100006, + &-6100001,-6100002,-6100003,-6100004,-6100005,-6100006, + &-5100001,-5100002,-5100003,-5100004,-5100005,-5100006, + &39, + &6100011,6100013,6100015, + &5100011,5100013,5100015, + %5100012,5100014,5100016, + &-6100011,-6100013,-6100015, + &-5100011,-5100013,-5100015, + %-5100012,-5100014,-5100016, + &-5100011,-5100013,-5100015, + &5100012,5100014,5100016, + &2912*0/ + DATA (KFDP(I,2),I= 1, 339)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4, + &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,5,6*1000006,3*7, + &2,4,6,8,7,4,6,3*8,1,3,5,7,8,5,7,2*11,12,11,12,2*11,2*13,14,13,14, + &13,11,13,-211,-213,-211,-213,-211,-213,-211,-213,2*-211,-321, + &-323,-321,2*-323,3*-321,4*-211,-213,-211,-213,-211,-213,-211, + &-213,-211,-213,3*-211,-213,4*-211,-323,-321,2*-211,2*-321,3*-211, + &2*15,16,15,16,15,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21, + &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8, + &-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8, + &12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23, + &-24,2*1000022,1000023,1000022,1000023,1000025,1000022,1000023, + &1000025,1000035,-1000024,-1000037,-1000024,-1000037,-1000001, + &2*-2000001,2000001,-1000002,2*-2000002,2000002,-1000003, + &2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005, + &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011, + &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013, + &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015, + &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6, + &-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,-37,22,25,2*36,2,4,6,8, + &2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22,25,-1,-2,-3,-4,-5,-6/ + DATA (KFDP(I,2),I= 340, 533)/-7,-8,-11,-13,-15,-17,21,22,2*23, + &-24,2*25,-37,-24,3*36,2*1000022,1000023,1000022,1000023,1000025, + &1000022,1000023,1000025,1000035,-1000024,-1000037,-1000024, + &-1000037,-1000001,2*-2000001,2000001,-1000002,2*-2000002,2000002, + &-1000003,2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005, + &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011, + &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013, + &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015, + &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6, + &-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25,-37,-24,2*1000022, + &1000023,1000022,1000023,1000025,1000022,1000023,1000025,1000035, + &-1000024,-1000037,-1000024,-1000037,-1000001,2*-2000001,2000001, + &-1000002,2*-2000002,2000002,-1000003,2*-2000003,2000003,-1000004, + &2*-2000004,2000004,-1000005,2*-2000005,2000005,-1000006, + &2*-2000006,2000006,-1000011,2*-2000011,2000011,-1000012, + &2*-2000012,2000012,-1000013,2*-2000013,2000013,-1000014, + &2*-2000014,2000014,-1000015,2*-2000015,2000015,-1000016, + &2*-2000016,2000016,2,4,6,8,12,14,16,18,25,1000024,1000037, + &1000024,1000037,1000024,1000037,1000024,1000037,2*-1000005, + &2*-2000005,1000002,1000004,1000012,1000014,2*1000016,-3,-4,-5,-6/ + DATA (KFDP(I,2),I= 534, 938)/-7,-8,-13,-15,-17,11,-82,12,14,-1, + &-3,11,13,15,1,4,3,4,1,3,22,11,-211,2*22,-13,-11,-211,211,111,211, + &-321,130,310,22,2*111,-211,11,-11,13,-13,-211,111,22,14,12,111, + &22,111,3*211,-311,22,211,22,111,-211,211,11,-211,13,22,-211,111, + &-211,22,111,-11,-211,111,2*-211,-321,130,310,221,111,-211,111, + &2*0,-211,111,22,-211,111,-211,111,-211,211,-213,113,223,221,14, + &111,211,111,-11,-13,211,111,22,211,111,211,111,2*211,213,113,223, + &221,22,-211,111,113,223,22,111,-321,310,211,111,2*-211,221,22, + &-11,-13,-211,-321,130,310,221,-211,111,11*12,11*14,2*211,2*213, + &211,20213,2*321,2*323,211,213,211,213,211,213,211,213,211,213, + &211,213,3*211,213,211,2*321,8*211,2*113,3*211,111,22,211,111,211, + &111,4*211,8*12,8*14,2*211,2*213,2*111,221,2*113,223,333,20213, + &211,2*321,323,2*311,313,-211,111,113,2*211,321,2*211,311,321,310, + &211,-211,4*211,321,4*211,113,2*211,-321,111,22,-211,111,-211,111, + &-211,211,-211,211,16,5*12,5*14,3*211,3*213,211,2*111,2*113, + &2*-311,2*-313,-2112,3*321,323,2*-1,22,111,321,311,321,311,-82, + &-11,-13,-82,22,-82,6*-11,6*-13,2*-15,211,213,20213,211,213,20213, + &431,433,431,433,311,313,311,313,311,313,-1,-4,-3,-4,-1,-3,22, + &-211,111,-211,111,-211,211,-211,211,6*-11,6*-13,2*-15,211,213, + &20213,211,213,20213,431,433,431,433,321,323,321,323,321,323,-1/ + DATA (KFDP(I,2),I= 939,1352)/-4,-3,-4,-1,-3,22,211,111,211,111, + &4*211,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,431,433,431, + &433,221,331,333,221,331,333,221,331,333,-1,-4,-3,-4,-1,-3,22, + &-321,-311,-321,-311,-15,-3,-1,2*-11,2*-13,2*-15,-1,-4,-3,-4,-3, + &-4,-1,-4,2*12,2*14,2,3,2,3,2*12,2*14,2,1,22,411,421,411,421,21, + &-11,-13,-15,-1,-2,-3,-4,2*21,22,21,2*-211,111,22,111,211,22,211, + &-211,11,2*-211,111,-211,111,22,11,22,111,-211,211,111,211,22,211, + &111,211,-211,22,11,13,11,-211,2*111,2*22,111,211,-321,-211,111, + &11,2*-211,7*12,7*14,-321,-323,-311,-313,-311,-313,211,213,211, + &213,211,213,111,221,331,113,223,111,221,113,223,321,323,321,-211, + &-213,111,221,331,113,223,333,10221,111,221,331,113,223,211,213, + &211,213,321,323,321,323,321,323,311,313,311,313,2*-1,-3,-1,2203, + &3201,3203,2203,2101,2103,12,14,-1,-3,2*111,2*211,12,14,-1,-3,22, + &111,2*22,111,22,12,14,-1,-3,22,12,14,-1,-3,12,14,-1,-3,12,14,-1, + &-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,2*-211,11,13, + &15,-211,-213,-20213,-431,-433,3*3122,1,4,3,4,1,3,11,13,15,1,4,3, + &4,1,3,11,13,15,1,4,3,4,1,3,2*111,2*211,11,13,15,1,4,3,4,1,3,11, + &13,15,1,4,3,4,1,3,4*22,11,13,15,1,4,3,4,1,3,22,11,13,15,1,4,3,4, + &1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1, + &3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3/ + DATA (KFDP(I,2),I=1353,1815)/11,13,15,1,4,3,4,1,3,11,13,15,1,4,3, + &4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4, + &1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1, + &3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3, + &2*111,2*211,-211,111,-321,130,310,-211,111,211,-211,111,-213,113, + &-211,111,223,211,111,213,113,211,111,223,-211,111,-321,130,310, + &2*-211,-311,311,-321,321,211,111,211,111,-211,111,-211,111,311, + &2*321,311,22,2*-82,-211,111,-211,111,211,111,211,111,-321,-311, + &-321,-311,411,421,411,421,22,2*21,-211,2*211,111,-211,111,2*211, + &111,-211,211,111,211,-321,2*-311,-321,22,-211,111,211,111,-311, + &311,-321,321,211,111,-211,111,321,311,22,-82,-211,111,211,111, + &-321,-311,411,421,22,21,-11,-13,-82,211,111,221,111,4*22,-11,-13, + &-15,-1,-2,-3,-4,2*21,211,111,3*22,1,2*2,4*1,2*-24,2*-37,2*1,3,5, + &1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3, + &-5,2,2*1,4*2,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3, + &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4, + &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,2*24,2*37,4,1,3,5,1,3,5,1,3,5,-3, + &2*-5,5,2*6,4*5,2*-24,2*-37,5,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3, + &4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6,2*5,4*6,2*24,2*37,6,4,-15, + &16,1,3,5,1,3,5,1,3,5,-3,2*-5,11,2*12,4*11,2*-24,-37,13,15,11,15/ + DATA (KFDP(I,2),I=1816,2317)/11,13,11,13,15,11,13,15,1,3,5,1,3,5, + &1,3,5,12,2*11,4*12,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5, + &13,2*14,4*13,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3, + &5,1,3,5,1,3,5,14,2*13,4*14,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3, + &5,1,3,5,15,2*16,4*15,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11, + &13,15,1,3,5,1,3,5,1,3,5,16,2*15,4*16,2*24,2*37,11,13,15,11,13,15, + &1,3,5,1,3,5,1,3,5,21,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5, + &5,-5,5,-6,6,-6,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6, + &1,-1,3,-3,5,-5,1,-1,3,-3,5,-5,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3, + &-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2, + &-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5, + &-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4, + &-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1, + &-3,3,-1,1,-1,1,-3,3,22,23,25,35,36,-1,-3,-13,13,-13,13,-13,13, + &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15, + &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1, + &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6, + &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5, + &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4, + &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3/ + DATA (KFDP(I,2),I=2318,2770)/3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22, + &23,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,-24,24,11, + &-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15,-15,1,-1,3, + &-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5,5,-5, + &5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13,13,-14,14,-14, + &14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13, + &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15, + &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1, + &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6, + &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5, + &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4, + &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3, + &3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,24,37,24,-11,-13,-15,-1,-3,24, + &-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,4*37, + &2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13,2*14,2*-15,2*16,-1, + &-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15,16,2*-15,16,-15, + &6*-11,-15,16,2*-15,16,2*-15,16,-15,6*-11,6*-13,-1,-2,-1,2,-1,-2, + &-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5, + &-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4, + &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1/ + DATA (KFDP(I,2),I=2771,3221)/2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4, + &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1, + &2*4,-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,22,23,25,35,36,22,23,11,13, + &15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4, + &25,35,36,-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13, + &-13,15,-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3, + &-4,4,-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13, + &-13,13,-14,14,-14,14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13, + &13,-13,13,-13,13,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15, + &15,-15,15,-15,15,-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1, + &-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6, + &-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3, + &-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2, + &-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5, + &-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22,23,25,35,36, + &22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14, + &16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36, + &-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15, + &-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4, + &-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13/ + DATA (KFDP(I,2),I=3222,3669)/13,-14,14,-14,14,-15,15,-15,15,-16, + &16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13,-15,15,-15,15,-15,15, + &-11,11,-11,11,-11,11,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11, + &-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3, + &3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2, + &2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5, + &5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4, + &4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1, + &1,-1,1,-3,3,24,37,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,24,-11, + &-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11, + &-13,-15,-1,-3,4*37,2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13, + &2*14,2*-15,2*16,-1,-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15, + &16,2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-15,16,2*-15,16, + &2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-13,14,2*-13,14,2*-13, + &14,-13,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3, + &-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2, + &-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5, + &6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4, + &-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1,2*4, + &-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,1,2*2,4*1,23,25,35,36,2*-24/ + DATA (KFDP(I,2),I=3670,4183)/2*-37,2*1,3,5,1,3,5,1,3,5,1,2,3,4,5, + &6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3,-5,2,2*1,4*2,23,25,35, + &36,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3,23,25,35,36, + &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4, + &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,23,25,35,36,2*24,2*37,4,1,3,5,1, + &3,5,1,3,5,-3,2*-5,5,2*6,4*5,23,25,35,36,2*-24,2*-37,5,1,3,5,1,3, + &5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6, + &2*5,4*6,23,25,35,36,2*24,2*37,6,1,3,5,1,3,5,1,3,5,-3,2*-5,11, + &2*12,4*11,23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11, + &13,15,1,3,5,1,3,5,1,3,5,13,2*14,4*13,23,25,35,36,2*-24,2*-37,13, + &15,11,15,11,13,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5,15,2*16,4*15, + &23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3, + &5,1,3,5,1,3,5,-3,-4,-5,-6,-11,-13,-15,21,-1,-3,2*-5,5,12,14,16, + &-3,-4,-5,-6,-11,-13,-15,21,-5,-6,21,-1,-2,-3,-4,-5,-6,-1,-2,-3, + &-4,-5,-6,21,-1,-2,-3,-4,-5,-6,21,-1,-2,-3,-4,-5,-6,21,-1,-2,-3, + &-4,-5,-6,-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6,3*21,3*1,4*2,1,2*11, + &2*12,11,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18, + &21,22,23,-24,3*-1,3*-3,3*-5,3*1,3*3,3*5,-13,13,-15,15,3*-1,3*-3, + &3*-5,3*1,3*3,3*5,-11,11,-15,15,3*-1,3*-3,3*-5,3*1,3*3,3*5,-11,11, + &-13,13,-1,-2,-3,-4,-5,-6,-11,-12,9900012,-13,-14,9900014,-15,-16/ + DATA (KFDP(I,2),I=4184,8000)/9900016,2,4,6,2,4,6,2,4,6,9900012, + &9900014,9900016,-11,-13,-15,-13,2*-15,24,-11,-13,-15,-13,2*-15, + &9900024,6*21,-24,-3000211,-24,-3000211,3000111,3000221,3000111, + &3000221,2*23,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17, + &-18,23,3000111,23,3000111,22,3000221,22,2,4,6,8,2,4,6,8,2,4,6,8, + &2,4,6,8,12,14,16,18,2*3000111,2*3000221,-3000211,2*-24,-3000211, + &2*23,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24, + &-3000211,3000211,3000221,3000113,3000223,-3000213,3000213, + &3000113,3000223,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16, + &-17,-18,24,3000211,24,3000111,3000221,3000211,3000213,3000113, + &3000223,3000213,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18, + &649*0, +C...UED + &1,1,2,2,3,3,4,4,5,5,6,6, + &1,2,1,2,1,2,3,4,3,4,3,4,5,6,5,6,5,6, + &11,13,15,12,11,14,13,16,15, + &-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6, + &1,2,3,4,5,6,1,2,3,4,5,6, + &22, + &-11,-13,-15,-11,-13,-15,-12,-14,-16, + &11,13,15,11,13,15,12,14,16, + &12,14,16,-11,-13,-15, + &2912*0/ + DATA (KFDP(I,3),I= 1,1021)/81*0,14,6*0,2*16,2*0,6*111,310,130, + &2*0,3*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221, + &2*113,221,2*113,2*213,-213,113,2*111,310,130,310,130,2*310,130, + &402*0,4*3,4*4,1,4,3,2*2,0,-11,8*0,-211,5*0,2*111,211,-211,211, + &-211,10*0,111,4*0,2*111,-211,-11,11,-13,22,111,3*0,22,3*0,111, + &211,4*0,111,11*0,111,-211,6*0,-211,3*111,7*0,111,-211,5*0,2*221, + &3*0,111,5*0,111,11*0,-311,-313,-311,-321,-313,-323,111,221,331, + &113,223,-311,-313,-311,-321,-313,-323,111,221,331,113,223,22*0, + &111,113,2*211,-211,-311,211,111,3*211,-211,7*211,7*0,111,-211, + &111,-211,-321,-323,-311,-321,-313,-323,-211,-213,-321,-323,-311, + &-321,-313,-323,-211,-213,22*0,111,113,-311,2*-211,211,-211,310, + &-211,2*111,211,2*-211,-321,-211,2*211,-211,111,-211,2*211,6*0, + &111,-211,111,-211,0,221,331,333,321,311,221,331,333,321,311,20*0, + &3,13*0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413, + &-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211, + &111,-211,-421,-423,-10423,-10421,-20423,-425,-421,-423,-10423, + &-10421,-20423,-425,-421,-423,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211, + &111,-211,-431,-433,-10433,-10431,-20433,-435,-431,-433,-10433, + &-10431,-20433,-435,-431,-433,19*0,-4,-1,-4,-3,2*-2,8*0,441,443, + &441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531,533,531,533,3,2,3,2/ + DATA (KFDP(I,3),I=1022,2223)/511,513,511,513,1,2,13*0,2*21,11*0, + &2112,6*0,2212,12*0,2*3122,3212,10*0,3322,2*0,3122,3212,3214,2112, + &2114,2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,6*0, + &4*3,4*0,4*3,6*0,4*3,0,28*3,2*0,3*4122,8*0,4,1,4,3,2*2,4*4,1,4,3, + &2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3, + &2*2,0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2, + &4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4, + &3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2, + &4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4, + &3,2*2,31*0,211,111,45*0,-211,2*111,-211,3*111,-211,111,211,30*0, + &-211,111,13*0,2*21,-211,111,199*0,2*5,210*0,-1,-3,-5,-2,-4,-6,-1, + &-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-2,2,-4,4,-6, + &6,-2,2,-4,4,-6,6,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3, + &-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, + &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, + &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, + &-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,-3,3, + &-5,5,-5,5,5*0,11,12,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11, + &-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11, + &-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/ + DATA (KFDP(I,3),I=2224,2783)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, + &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, + &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, + &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3, + &-5,5,-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14, + &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12, + &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15, + &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, + &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5, + &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, + &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, + &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, + &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5, + &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,3*0,12,14,16,2,4,0,12,14,16,2, + &4,0,12,14,16,2,4,0,12,14,16,2,4,28*0,2,4,12,-11,11,14,-13,13,16, + &-15,15,12,-11,11,14,-13,13,16,-15,15,12,11,14,13,16,15,12,-11,11, + &14,-13,13,16,-15,15,12,11,14,13,16,15,12,11,14,13,16,15,2*2,1,-1, + &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, + &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5, + &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1/ + DATA (KFDP(I,3),I=2784,3354)/2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, + &2*6,5,-5,3,-3,5,-5,1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,7*0, + &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14, + &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12, + &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15, + &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, + &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5, + &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, + &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, + &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, + &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5, + &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14,-16, + &-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0, + &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16, + &-2,2,-4,4,2*0,-12,12,-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4, + &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, + &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1, + &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, + &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3, + &-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/ + DATA (KFDP(I,3),I=3355,8000)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, + &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5, + &-5,5,-3,3,-5,5,-5,5,3*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4, + &4*0,12,14,16,2,4,0,12,14,16,2,4,0,12,14,16,2,4,0,12,14,16,2,4, + &28*0,2,4,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16, + &-15,15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15, + &15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15,15, + &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1, + &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, + &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5, + &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,3,-3,5,-5, + &1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,351*0,-5,95*0,2,4,6,2,4, + &6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900014,2*9900016,2,4,6,2,4, + &6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900016,2,4,6,2,4, + &6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900014,3831*0/ + DATA (KFDP(I,4),I= 1,8000)/94*0,4*111,6*0,111,2*0,-211,0,-211, + &3*0,111,2*-211,0,111,0,2*111,113,221,2*111,-213,-211,211,113, + &6*111,310,2*130,402*0,13*81,41*0,-11,10*0,111,-211,4*0,111,62*0, + &111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111, + &-211,2*211,2*-211,13*0,-211,111,-211,111,4*0,-211,111,-211,111, + &34*0,111,-211,3*111,3*-211,2*111,3*-211,14*0,-321,-311,3*0,-321, + &-311,20*0,-3,43*0,6*1,39*0,6*2,42*0,6*3,14*0,8*4,4*0,4*-5,4*0, + &2*-5,67*0,-211,111,5*0,-211,111,52*0,2101,2103,2*2101,6*0,4*81, + &4*0,4*81,6*0,4*81,0,28*81,13*0,6*2101,18*81,4*0,18*81,4*0,9*81,0, + &162*81,31*0,-211,111,6516*0/ + DATA (KFDP(I,5),I= 1,8000)/96*0,2*111,17*0,111,7*0,2*111,0, + &3*111,0,111,597*0,-211,2*111,-211,111,-211,111,65*0,111,-211, + &3*111,-211,111,7193*0/ + +C...PYDAT4, with particle names (character strings). + DATA (CHAF(I,1),I= 1, 202)/'d','u','s','c','b','t','b''','t''', + &2*' ','e-','nu_e','mu-','nu_mu','tau-','nu_tau','tau''-', + &'nu''_tau',2*' ','g','gamma','Z0','W+','h0',6*' ','Z''0','Z"0', + &'W''+','H0','A0','H+',' ','Graviton',' ','R0','LQ_ue',38*' ', + &'specflav','rndmflav','phasespa','c-hadron','b-hadron',2*' ', + &'junction',' ','system','cluster','string','indep.','CMshower', + &'SPHEaxis','THRUaxis','CLUSjet','CELLjet','table',' ','reggeon', + &'pi0','rho0','a_20','K_L0','pi+','rho+','a_2+','eta','omega', + &'f_2','K_S0','K0','K*0','K*_20','K+','K*+','K*_2+','eta''','phi', + &'f''_2','D+','D*+','D*_2+','D0','D*0','D*_20','D_s+','D*_s+', + &'D*_2s+','eta_c','J/psi','chi_2c','B0','B*0','B*_20','B+','B*+', + &'B*_2+','B_s0','B*_s0','B*_2s0','B_c+','B*_c+','B*_2c+','eta_b', + &'Upsilon','chi_2b','pomeron','dd_1','Delta-','ud_0','ud_1','n0', + &'Delta0','uu_1','p+','Delta+','Delta++','sd_0','sd_1','Sigma-', + &'Sigma*-','Lambda0','su_0','su_1','Sigma0','Sigma*0','Sigma+', + &'Sigma*+','ss_1','Xi-','Xi*-','Xi0','Xi*0','Omega-','cd_0', + &'cd_1','Sigma_c0','Sigma*_c0','Lambda_c+','Xi_c0','cu_0','cu_1', + &'Sigma_c+','Sigma*_c+','Sigma_c++','Sigma*_c++','Xi_c+','cs_0', + &'cs_1','Xi''_c0','Xi*_c0','Xi''_c+','Xi*_c+','Omega_c0', + &'Omega*_c0','cc_1','Xi_cc+','Xi*_cc+','Xi_cc++','Xi*_cc++'/ + DATA (CHAF(I,1),I= 203, 332)/'Omega_cc+','Omega*_cc+', + &'Omega*_ccc++','bd_0','bd_1','Sigma_b-','Sigma*_b-','Lambda_b0', + &'Xi_b-','Xi_bc0','bu_0','bu_1','Sigma_b0','Sigma*_b0','Sigma_b+', + &'Sigma*_b+','Xi_b0','Xi_bc+','bs_0','bs_1','Xi''_b-','Xi*_b-', + &'Xi''_b0','Xi*_b0','Omega_b-','Omega*_b-','Omega_bc0','bc_0', + &'bc_1','Xi''_bc0','Xi*_bc0','Xi''_bc+','Xi*_bc+','Omega''_bc0', + &'Omega*_bc0','Omega_bcc+','Omega*_bcc+','bb_1','Xi_bb-', + &'Xi*_bb-','Xi_bb0','Xi*_bb0','Omega_bb-','Omega*_bb-', + &'Omega_bbc0','Omega*_bbc0','Omega*_bbb-','a_00','b_10','a_0+', + &'b_1+','f_0','h_1','K*_00','K_10','K*_0+','K_1+','f''_0','h''_1', + &'D*_0+','D_1+','D*_00','D_10','D*_0s+','D_1s+','chi_0c','h_1c', + &'B*_00','B_10','B*_0+','B_1+','B*_0s0','B_1s0','B*_0c+','B_1c+', + &'chi_0b','h_1b','a_10','a_1+','f_1','K*_10','K*_1+','f''_1', + &'D*_1+','D*_10','D*_1s+','chi_1c','B*_10','B*_1+','B*_1s0', + &'B*_1c+','chi_1b','psi''','Upsilon''','~d_L','~u_L','~s_L', + &'~c_L','~b_1','~t_1','~e_L-','~nu_eL','~mu_L-','~nu_muL', + &'~tau_1-','~nu_tauL','~g','~chi_10','~chi_20','~chi_1+', + &'~chi_30','~chi_40','~chi_2+','~Gravitino','~d_R','~u_R','~s_R', + &'~c_R','~b_2','~t_2','~e_R-','~nu_eR','~mu_R-','~nu_muR', + &'~tau_2-','~nu_tauR','pi_tc0','pi_tc+','pi''_tc0','eta_tc0'/ + DATA (CHAF(I,1),I= 333, 500)/'rho_tc0','rho_tc+','omega_tc', + &'V8_tc','pi_22_1_tc','pi_22_8_tc','rho_11_tc','rho_12_tc', + &'rho_21_tc','rho_22_tc','d*','u*','e*-','nu*_e0','Graviton*', + &'nu_Re','nu_Rmu','nu_Rtau','Z_R0','W_R+','H_L++','H_R++', + &'rho_diff0','pi_diffr+','omega_di','phi_diff','J/psi_di', + &'n_diffr0','p_diffr+','cc~[3S18]','cc~[1S08]','cc~[3P08]', + &'bb~[3S18]','bb~[1S08]','bb~[3P08]','a_tc0','a_tc+', + &81*' ', +C...UED + &'d*_S','u*_S','s*_S','c*_S','b*_S','t*_S', + &'d*_D','u*_D','s*_D','c*_D','b*_D','t*_D', + &'e*_S-','mu*_S-','tau*_S-', + &'nu*_eD','e*_D-','nu*_muD','mu*_D-','nu*_tauD','tau*_D-', + &'g*','gamma*','Z*0','W*+',25*' '/ + DATA (CHAF(I,2),I= 1, 205)/'dbar','ubar','sbar','cbar','bbar', + &'tbar','b''bar','t''bar',2*' ','e+','nu_ebar','mu+','nu_mubar', + &'tau+','nu_taubar','tau''+','nu''_taubar',5*' ','W-',9*' ', + &'W''-',2*' ','H-',3*' ','Rbar0','LQ_uebar',39*' ','rndmflavbar', + &' ','c-hadronbar','b-hadronbar',20*' ','pi-','rho-','a_2-',4*' ', + &'Kbar0','K*bar0','K*_2bar0','K-','K*-','K*_2-',3*' ','D-','D*-', + &'D*_2-','Dbar0','D*bar0','D*_2bar0','D_s-','D*_s-','D*_2s-', + &3*' ','Bbar0','B*bar0','B*_2bar0','B-','B*-','B*_2-','B_sbar0', + &'B*_sbar0','B*_2sbar0','B_c-','B*_c-','B*_2c-',4*' ','dd_1bar', + &'Deltabar+','ud_0bar','ud_1bar','nbar0','Deltabar0','uu_1bar', + &'pbar-','Deltabar-','Deltabar--','sd_0bar','sd_1bar','Sigmabar+', + &'Sigma*bar+','Lambdabar0','su_0bar','su_1bar','Sigmabar0', + &'Sigma*bar0','Sigmabar-','Sigma*bar-','ss_1bar','Xibar+', + &'Xi*bar+','Xibar0','Xi*bar0','Omegabar+','cd_0bar','cd_1bar', + &'Sigma_cbar0','Sigma*_cbar0','Lambda_cbar-','Xi_cbar0','cu_0bar', + &'cu_1bar','Sigma_cbar-','Sigma*_cbar-','Sigma_cbar--', + &'Sigma*_cbar--','Xi_cbar-','cs_0bar','cs_1bar','Xi''_cbar0', + &'Xi*_cbar0','Xi''_cbar-','Xi*_cbar-','Omega_cbar0', + &'Omega*_cbar0','cc_1bar','Xi_ccbar-','Xi*_ccbar-','Xi_ccbar--', + &'Xi*_ccbar--','Omega_ccbar-','Omega*_ccbar-','Omega*_cccbar-'/ + DATA (CHAF(I,2),I= 206, 325)/'bd_0bar','bd_1bar','Sigma_bbar+', + &'Sigma*_bbar+','Lambda_bbar0','Xi_bbar+','Xi_bcbar0','bu_0bar', + &'bu_1bar','Sigma_bbar0','Sigma*_bbar0','Sigma_bbar-', + &'Sigma*_bbar-','Xi_bbar0','Xi_bcbar-','bs_0bar','bs_1bar', + &'Xi''_bbar+','Xi*_bbar+','Xi''_bbar0','Xi*_bbar0','Omega_bbar+', + &'Omega*_bbar+','Omega_bcbar0','bc_0bar','bc_1bar','Xi''_bcbar0', + &'Xi*_bcbar0','Xi''_bcbar-','Xi*_bcbar-','Omega''_bcba', + &'Omega*_bcbar0','Omega_bccbar-','Omega*_bccbar-','bb_1bar', + &'Xi_bbbar+','Xi*_bbbar+','Xi_bbbar0','Xi*_bbbar0','Omega_bbbar+', + &'Omega*_bbbar+','Omega_bbcbar0','Omega*_bbcbar0', + &'Omega*_bbbbar+',2*' ','a_0-','b_1-',2*' ','K*_0bar0','K_1bar0', + &'K*_0-','K_1-',2*' ','D*_0-','D_1-','D*_0bar0','D_1bar0', + &'D*_0s-','D_1s-',2*' ','B*_0bar0','B_1bar0','B*_0-','B_1-', + &'B*_0sbar0','B_1sbar0','B*_0c-','B_1c-',3*' ','a_1-',' ', + &'K*_1bar0','K*_1-',' ','D*_1-','D*_1bar0','D*_1s-',' ', + &'B*_1bar0','B*_1-','B*_1sbar0','B*_1c-',3*' ','~d_Lbar', + &'~u_Lbar','~s_Lbar','~c_Lbar','~b_1bar','~t_1bar','~e_L+', + &'~nu_eLbar','~mu_L+','~nu_muLbar','~tau_1+','~nu_tauLbar',3*' ', + &'~chi_1-',2*' ','~chi_2-',' ','~d_Rbar','~u_Rbar','~s_Rbar', + &'~c_Rbar','~b_2bar','~t_2bar','~e_R+','~nu_eRbar','~mu_R+'/ + DATA (CHAF(I,2),I= 326, 500)/'~nu_muRbar','~tau_2+', + &'~nu_tauRbar',' ','pi_tc-',3*' ','rho_tc-',8*' ','d*bar','u*bar', + &'e*bar+','nu*_ebar0',5*' ','W_R-','H_L--','H_R--',' ', + &'pi_diffr-',3*' ','n_diffrbar0','p_diffrbar-',7*' ','a_tc-', + &81*' ', +C...UED + &'d*_Sbar','u*_Sbar','s*_Sbar','c*_Sbar','b*_Sbar','t*_Sbar', + &'d*_Dbar','u*_Dbar','s*_Dbar','c*_Dbar','b*_Dbar','t*_Dbar', + &'e*_Sbar+','mu*_Sbar+','tau*_Sbar+', + &'nu*_eDbar','e*_Dbar+', + &'nu*_muDbar','mu*_Dbar+', + &'nu*_tauDbar','tau*_Dbar+', + &'g*','gamma*','Z*0','W*-',25*' '/ + +C...PYDATR, with initial values for the random number generator. + DATA MRPY/19780503,0,0,97,33,0/ + +C...Default values for allowed processes and kinematics constraints. + DATA MSEL/1/ + DATA MSUB/500*0/ + DATA ((KFIN(I,J),J=-40,40),I=1,2)/16*0,4*1,4*0,6*1,5*0,5*1,0, + &5*1,5*0,6*1,4*0,4*1,16*0,16*0,4*1,4*0,6*1,5*0,5*1,0,5*1,5*0, + &6*1,4*0,4*1,16*0/ + DATA CKIN/ + & 2.0D0, -1.0D0, 0.0D0, -1.0D0, 1.0D0, + & 1.0D0, -10D0, 10D0, -40D0, 40D0, + 1 -40D0, 40D0, -40D0, 40D0, -40D0, + 1 40D0, -1.0D0, 1.0D0, -1.0D0, 1.0D0, + 2 0.0D0, 1.0D0, 0.0D0, 1.0D0, -1.0D0, + 2 1.0D0, -1.0D0, 1.0D0, 0D0, 0D0, + 3 2.0D0, -1.0D0, 0D0, 0D0, 0.0D0, + 3 -1.0D0, 0.0D0, -1.0D0, 4.0D0, -1.0D0, + 4 12.0D0, -1.0D0, 12.0D0, -1.0D0, 12.0D0, + 4 -1.0D0, 12.0D0, -1.0D0, 0D0, 0D0, + 5 0.0D0, -1.0D0, 0.0D0, -1.0D0, 0.0D0, + 5 -1.0D0, 0D0, 0D0, 0D0, 0D0, + 6 0.0001D0, 0.99D0, 0.0001D0, 0.99D0, 0D0, + 6 -1D0, 0D0, -1D0, 0D0, -1D0, + 7 0D0, -1D0, 0.0001D0, 0.99D0, 0.0001D0, + 7 0.99D0, 2D0, -1D0, 0D0, 0D0, + 8 120*0D0/ + +C...Default values for main switches and parameters. Reset information. + DATA (MSTP(I),I=1,100)/ + & 3, 1, 2, 0, 0, 0, 0, 0, 0, 0, + 1 1, 0, 1, 30, 0, 1, 4, 3, 4, 3, + 2 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, + 3 1, 8, 0, 1, 0, 2, 1, 5, 2, 0, + 4 2, 1, 3, 7, 3, 1, 1, 0, 1, 0, + 5 7, 1, 3, 1, 5, 1, 1, 5, 1, 7, + 6 2, 3, 2, 2, 1, 5, 2, 3, 0, 0, + 7 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, + 8 1, 4, 100, 1, 1, 2, 4, 1, 1, 0, + 9 1, 3, 1, 3, 1, 0, 0, 0, 0, 0/ + DATA (MSTP(I),I=101,200)/ + & 3, 1, 0, 0, 0, 0, 0, 0, 0, 0, + 1 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, + 2 0, 1, 2, 1, 1, 100, 0, 0, 10, 0, + 3 0, 4, 0, 1, 0, 0, 0, 0, 0, 0, + 4 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, + 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 7 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, + 8 6, 421, 2009, 07, 13, 0, 0, 0, 0, 0, + 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ + DATA (PARP(I),I=1,100)/ + & 0.25D0, 10D0, 8*0D0, + 1 0D0, 0D0, 1.0D0, 0.01D0, 0.5D0, 1.0D0, 1.0D0, 0.4D0, 2*0D0, + 2 10*0D0, + 3 1.5D0,2.0D0,0.075D0,1.0D0,0.2D0,0D0,1.0D0,0.70D0,0.006D0,0D0, + 4 0.02D0,2.0D0,0.10D0,1000D0,2054D0,123D0,246D0,50D0,0D0,0.054D0, + 5 10*0D0, + 6 0.25D0, 1.0D0,0.25D0, 1.0D0, 2.0D0,1D-3, 4.0D0,1D-3,2*0D0, + 7 4.0D0, 0.25D0, 5*0D0, 0.025D0, 2.0D0, 0.1D0, + 8 1.90D0, 2.0D0, 0.5D0, 0.4D0, 0.90D0, + 8 0.95D0, 0.7D0, 0.5D0, 1800D0, 0.25D0, + 9 2.0D0,0.40D0,5.0D0,1.0D0,0.0D0,3.0D0,1.0D0,0.75D0,1.0D0,5.0D0/ + DATA (PARP(I),I=101,200)/ + & 0.5D0, 0.28D0, 1.0D0, 0.8D0, 0D0, 0D0, 0D0, 0D0, 0D0, 1D0, + 1 2.0D0, 3*0D0, 1.5D0, 0.5D0, 0.6D0, 2.5D0, 2.0D0, 1.0D0, + 2 1.0D0, 0.4D0, 8*0D0, + 3 0.01D0, 9*0D0, + 4 1.16D0, 0.0119D0, 0.01D0, 0.01D0, 0.05D0, + 4 9.28D0, 0.15D0, 0.02D0, 0.48D0, 0.09D0, + 5 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, + 6 2.20D0, 23.6D0, 18.4D0, 11.5D0, 0.5D0, 0D0, 0D0, 0D0, 2*0D0, + 7 0D0, 0D0, 0D0, 1.0D0, 6*0D0, + 8 0.1D0, 0.01D0, 0.01D0, 0.01D0, 0.1D0, 0.01D0, 0.01D0, 0.01D0, + 8 0.3D0, 0.64D0, + 9 0.64D0, 5.0D0, 1.0D4, 1.0D4, 6*0D0/ + DATA MSTI/200*0/ + DATA PARI/200*0D0/ + DATA MINT/400*0/ + DATA VINT/400*0D0/ + +C...Constants for the generation of the various processes. + DATA (ISET(I),I=1,100)/ + & 1, 1, 1, -1, 3, -1, -1, 3, -2, 2, + 1 2, 2, 2, 2, 2, 2, -1, 2, 2, 2, + 2 -1, 2, 2, 2, 2, 2, -1, 2, 2, 2, + 3 2, 2, 2, 2, 2, 2, -1, -1, -1, -1, + 4 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 5 -1, -1, 2, 2, -1, -1, -1, 2, -1, -1, + 6 -1, -1, -1, -1, -1, -1, -1, 2, 2, 2, + 7 4, 4, 4, -1, -1, 4, 4, -1, -1, 2, + 8 2, 2, 2, 2, 2, 2, 2, 2, 2, -2, + 9 0, 0, 0, 0, 0, 9, -2, -2, 8, -2/ + DATA (ISET(I),I=101,200)/ + & -1, 1, 1, 1, 1, 2, 2, 2, -2, 2, + 1 2, 2, 2, 2, 2, -1, -1, -1, -2, -2, + 2 5, 5, 5, 5, -2, -2, -2, -2, -2, -2, + 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 4 1, 1, 1, 1, 1, 1, 1, 1, 1, -2, + 5 1, 1, 1, -2, -2, 1, 1, 1, -2, -2, + 6 2, 2, 2, 2, 2, 2, 2, 2, 2, -2, + 7 2, 2, 5, 5, -2, 2, 2, 5, 5, -2, + 8 5, 5, 2, 2, 2, 5, 5, 2, 2, 2, + 9 1, 1, 1, 2, 2, -2, -2, -2, -2, -2/ + DATA (ISET(I),I=201,300)/ + & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 1 2, 2, 2, 2, -2, 2, 2, 2, 2, 2, + 2 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 4 2, 2, 2, 2, -1, 2, 2, 2, 2, 2, + 5 2, 2, 2, 2, -1, 2, -1, 2, 2, -2, + 6 2, 2, 2, 2, 2, -1, -1, -1, -1, -1, + 7 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 8 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 9 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/ + DATA (ISET(I),I=301,500)/ + & 2, 9*-2, 9*2, 21*-2, + 4 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, + 5 5, 5, 1, 1, -1, -1, -1, -1, -1, -1, + 6 2, 2, 2, 2, 2, 2, 2, 2, -1, 2, + 7 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 8 2, 2, 2, 2, 2, 2, 2, 2, -2, -2, + 9 1, 1, 2, 2, 2, 5*-2, + & 5, 5, 18*-2, + 2 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 21*-2, + 6 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 7 2, 2, 2, 2, 2, 2, 2, 2, 2, 21*-2/ + DATA ((KFPR(I,J),J=1,2),I=1,50)/ + & 23, 0, 24, 0, 25, 0, 24, 0, 25, 0, + & 24, 0, 23, 0, 25, 0, 0, 0, 0, 0, + 1 0, 0, 0, 0, 21, 21, 21, 22, 21, 23, + 1 21, 24, 21, 25, 22, 22, 22, 23, 22, 24, + 2 22, 25, 23, 23, 23, 24, 23, 25, 24, 24, + 2 24, 25, 25, 25, 0, 21, 0, 22, 0, 23, + 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, + 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, + 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, + 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23/ + DATA ((KFPR(I,J),J=1,2),I=51,100)/ + 5 0, 24, 0, 25, 0, 0, 0, 0, 0, 0, + 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 6 0, 0, 0, 0, 21, 21, 24, 24, 23, 24, + 7 23, 23, 24, 24, 23, 24, 23, 25, 22, 22, + 7 23, 23, 24, 24, 24, 25, 25, 25, 0, 211, + 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 8 443, 21,10441, 21,20443, 21, 445, 21, 0, 0, + 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ + DATA ((KFPR(I,J),J=1,2),I=101,150)/ + & 23, 0, 25, 0, 25, 0,10441, 0, 445, 0, + & 443, 22, 443, 21, 443, 22, 0, 0, 22, 25, + 1 21, 25, 0, 25, 21, 25, 22, 22, 21, 22, + 1 22, 23, 23, 23, 24, 24, 0, 0, 0, 0, + 2 25, 6, 25, 6, 25, 0, 25, 0, 0, 0, + 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 3 0, 21, 0, 21, 0, 22, 0, 22, 0, 0, + 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 4 32, 0, 34, 0, 37, 0, 41, 0, 42, 0, + 4 4000011, 0, 4000001, 0, 4000002, 0, 3000331, 0, 0, 0/ + DATA ((KFPR(I,J),J=1,2),I=151,200)/ + 5 35, 0, 35, 0, 35, 0, 0, 0, 0, 0, + 5 36, 0, 36, 0, 36, 0, 0, 0, 0, 0, + 6 6, 37, 42, 0, 42, 42, 42, 42, 11, 0, + 6 11, 0, 0, 4000001, 0, 4000002, 0, 4000011, 0, 0, + 7 23, 35, 24, 35, 35, 0, 35, 0, 0, 0, + 7 23, 36, 24, 36, 36, 0, 36, 0, 0, 0, + 8 35, 6, 35, 6, 21, 35, 0, 35, 21, 35, + 8 36, 6, 36, 6, 21, 36, 0, 36, 21, 36, + 9 3000113, 0, 3000213, 0, 3000223, 0, 11, 0, 11, 0, + 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ + DATA ((KFPR(I,J),J=1,2),I=201,240)/ + & 1000011, 1000011, 2000011, 2000011, 1000011, + & 2000011, 1000013, 1000013, 2000013, 2000013, + & 1000013, 2000013, 1000015, 1000015, 2000015, + & 2000015, 1000015, 2000015, 1000011, 1000012, + 1 1000015, 1000016, 2000015, 1000016, 1000012, + 1 1000012, 1000016, 1000016, 0, 0, + 1 1000022, 1000022, 1000023, 1000023, 1000025, + 1 1000025, 1000035, 1000035, 1000022, 1000023, + 2 1000022, 1000025, 1000022, 1000035, 1000023, + 2 1000025, 1000023, 1000035, 1000025, 1000035, + 2 1000024, 1000024, 1000037, 1000037, 1000024, + 2 1000037, 1000022, 1000024, 1000023, 1000024, + 3 1000025, 1000024, 1000035, 1000024, 1000022, + 3 1000037, 1000023, 1000037, 1000025, 1000037, + 3 1000035, 1000037, 1000021, 1000022, 1000021, + 3 1000023, 1000021, 1000025, 1000021, 1000035/ + DATA ((KFPR(I,J),J=1,2),I=241,280)/ + 4 1000021, 1000024, 1000021, 1000037, 1000021, + 4 1000021, 1000021, 1000021, 0, 0, + 4 1000002, 1000022, 2000002, 1000022, 1000002, + 4 1000023, 2000002, 1000023, 1000002, 1000025, + 5 2000002, 1000025, 1000002, 1000035, 2000002, + 5 1000035, 1000001, 1000024, 2000005, 1000024, + 5 1000001, 1000037, 2000005, 1000037, 1000002, + 5 1000021, 2000002, 1000021, 0, 0, + 6 1000006, 1000006, 2000006, 2000006, 1000006, + 6 2000006, 1000006, 1000006, 2000006, 2000006, + 6 0, 0, 0, 0, 0, + 6 0, 0, 0, 0, 0, + 7 1000002, 1000002, 2000002, 2000002, 1000002, + 7 2000002, 1000002, 1000002, 2000002, 2000002, + 7 1000002, 2000002, 1000002, 1000002, 2000002, + 7 2000002, 1000002, 1000002, 2000002, 2000002/ + DATA ((KFPR(I,J),J=1,2),I=281,350)/ + 8 1000005, 1000002, 2000005, 2000002, 1000005, + 8 2000002, 1000005, 1000002, 2000005, 2000002, + 8 1000005, 2000002, 1000005, 1000005, 2000005, + 8 2000005, 1000005, 1000005, 2000005, 2000005, + 9 1000005, 1000005, 2000005, 2000005, 1000005, + 9 2000005, 1000005, 1000021, 2000005, 1000021, + 9 1000005, 2000005, 37, 25, 37, + 9 35, 36, 25, 36, 35, + & 37, 37, 18*0, +C...UED: 311-319 + & 5100021, 5100021, + & 5100002, 5100021, + & 5100002, 5100001, + & 5100002, -5100002, + & 5100002, -5100002, + & 5100002, -6100001, + & 5100002, -5100001, + & 5100002, 6100001, + & 5100001, -5100001, + & 42*0, + 4 9900041, 0, 9900042, 0, 9900041, + 4 11, 9900042, 11, 9900041, 13, + 4 9900042, 13, 9900041, 15, 9900042, + 4 15, 9900041, 9900041, 9900042, 9900042/ + DATA ((KFPR(I,J),J=1,2),I=351,400)/ + 5 9900041, 0, 9900042, 0, 9900023, + 5 0, 9900024, 0, 0, 0, + 5 0, 0, 0, 0, 0, + 5 0, 0, 0, 0, 0, + 6 24, 24, 24, 3000211, 3000211, + 6 3000211, 22, 3000111, 22, 3000221, + 6 23, 3000111, 23, 3000221, 24, + 6 3000211, 0, 0, 24, 23, + 7 24, 3000111, 3000211, 23, 3000211, + 7 3000111, 22, 3000211, 23, 3000211, + 7 24, 3000111, 24, 3000221, 22, + 7 24, 22, 23, 23, 23, + 8 0, 0, 0, 0, 21, 21, 0, 21, 0, 0, + 8 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, + 9 5000039, 0, 5000039, 0, 21, + 9 5000039, 0, 5000039, 21, 5000039, + 9 10*0/ + DATA ((KFPR(I,J),J=1,2),I=401,500)/ + & 37, 6, 37, 6, 36*0, + 2 443, 21, 9900443, 21, 9900441, + 2 21, 9910441, 21, 0, 9900443, + 2 0, 9900441, 0, 9910441, 21, + 2 9900443, 21, 9900441, 21, 9910441, + 3 10441, 21, 20443, 21, 445, 21, 0, 10441, 0, 20443, + 3 0, 445, 21, 10441, 21, 20443, 21, 445, 42*0, + 6 553, 21, 9900553, 21, 9900551, + 6 21, 9910551, 21, 0, 9900553, + 6 0, 9900551, 0, 9910551, 21, + 6 9900553, 21, 9900551, 21, 9910551, + 7 10551, 21, 20553, 21, 555, 21, 0, 10551, 0, 20553, + 7 0, 555, 21, 10551, 21, 20553, 21, 555, 42*0/ + DATA COEF/10000*0D0/ + DATA (((ICOL(I,J,K),K=1,2),J=1,4),I=1,40)/ + &4,0,3,0,2,0,1,0,3,0,4,0,1,0,2,0,2,0,0,1,4,0,0,3,3,0,0,4,1,0,0,2, + &3,0,0,4,1,4,3,2,4,0,0,3,4,2,1,3,2,0,4,1,4,0,2,3,4,0,3,4,2,0,1,2, + &3,2,1,0,1,4,3,0,4,3,3,0,2,1,1,0,3,2,1,4,1,0,0,2,2,4,3,1,2,0,0,1, + &3,2,1,4,1,4,3,2,4,2,1,3,4,2,1,3,3,4,4,3,1,2,2,1,2,0,3,1,2,0,0,0, + &4,2,1,0,0,0,1,0,3,0,0,3,1,2,0,0,4,0,0,4,0,0,1,2,2,0,0,1,4,4,3,3, + &2,2,1,1,4,4,3,3,3,3,4,4,1,1,2,2,3,2,1,3,1,2,0,0,4,2,1,4,0,0,1,2, + &4,0,0,0,4,0,1,3,0,0,3,0,2,4,3,0,3,4,0,0,1,0,0,1,0,0,3,4,2,0,0,2, + &3,0,0,0,1,0,0,0,0,0,3,0,2,0,0,0,2,0,3,1,2,0,0,0,3,2,1,0,1,0,0,0, + &4,4,3,3,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + &0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ + +C...Treatment of resonances. + DATA (MWID(I) ,I= 1, 500)/5*0,3*1,8*0,1,5*0,3*1,6*0,1,0,4*1, + &3*0,2*1,254*0,19*2,0,7*2,0,2,0,2,0,26*1,7*0,6*2,2*1, + &81*0,21*1,4*1,25*0/ + +C...Character constants: name of processes. + DATA PROC(0)/ 'All included subprocesses '/ + DATA (PROC(I),I=1,20)/ + &'f + fbar -> gamma*/Z0 ', 'f + fbar'' -> W+/- ', + &'f + fbar -> h0 ', 'gamma + W+/- -> W+/- ', + &'Z0 + Z0 -> h0 ', 'Z0 + W+/- -> W+/- ', + &' ', 'W+ + W- -> h0 ', + &' ', 'f + f'' -> f + f'' (QFD) ', + 1'f + f'' -> f + f'' (QCD) ','f + fbar -> f'' + fbar'' ', + 1'f + fbar -> g + g ', 'f + fbar -> g + gamma ', + 1'f + fbar -> g + Z0 ', 'f + fbar'' -> g + W+/- ', + 1'f + fbar -> g + h0 ', 'f + fbar -> gamma + gamma ', + 1'f + fbar -> gamma + Z0 ', 'f + fbar'' -> gamma + W+/- '/ + DATA (PROC(I),I=21,40)/ + 2'f + fbar -> gamma + h0 ', 'f + fbar -> Z0 + Z0 ', + 2'f + fbar'' -> Z0 + W+/- ', 'f + fbar -> Z0 + h0 ', + 2'f + fbar -> W+ + W- ', 'f + fbar'' -> W+/- + h0 ', + 2'f + fbar -> h0 + h0 ', 'f + g -> f + g ', + 2'f + g -> f + gamma ', 'f + g -> f + Z0 ', + 3'f + g -> f'' + W+/- ', 'f + g -> f + h0 ', + 3'f + gamma -> f + g ', 'f + gamma -> f + gamma ', + 3'f + gamma -> f + Z0 ', 'f + gamma -> f'' + W+/- ', + 3'f + gamma -> f + h0 ', 'f + Z0 -> f + g ', + 3'f + Z0 -> f + gamma ', 'f + Z0 -> f + Z0 '/ + DATA (PROC(I),I=41,60)/ + 4'f + Z0 -> f'' + W+/- ', 'f + Z0 -> f + h0 ', + 4'f + W+/- -> f'' + g ', 'f + W+/- -> f'' + gamma ', + 4'f + W+/- -> f'' + Z0 ', 'f + W+/- -> f'' + W+/- ', + 4'f + W+/- -> f'' + h0 ', 'f + h0 -> f + g ', + 4'f + h0 -> f + gamma ', 'f + h0 -> f + Z0 ', + 5'f + h0 -> f'' + W+/- ', 'f + h0 -> f + h0 ', + 5'g + g -> f + fbar ', 'g + gamma -> f + fbar ', + 5'g + Z0 -> f + fbar ', 'g + W+/- -> f + fbar'' ', + 5'g + h0 -> f + fbar ', 'gamma + gamma -> f + fbar ', + 5'gamma + Z0 -> f + fbar ', 'gamma + W+/- -> f + fbar'' '/ + DATA (PROC(I),I=61,80)/ + 6'gamma + h0 -> f + fbar ', 'Z0 + Z0 -> f + fbar ', + 6'Z0 + W+/- -> f + fbar'' ', 'Z0 + h0 -> f + fbar ', + 6'W+ + W- -> f + fbar ', 'W+/- + h0 -> f + fbar'' ', + 6'h0 + h0 -> f + fbar ', 'g + g -> g + g ', + 6'gamma + gamma -> W+ + W- ', 'gamma + W+/- -> Z0 + W+/- ', + 7'Z0 + Z0 -> Z0 + Z0 ', 'Z0 + Z0 -> W+ + W- ', + 7'Z0 + W+/- -> Z0 + W+/- ', 'Z0 + Z0 -> Z0 + h0 ', + 7'W+ + W- -> gamma + gamma ', 'W+ + W- -> Z0 + Z0 ', + 7'W+/- + W+/- -> W+/- + W+/- ', 'W+/- + h0 -> W+/- + h0 ', + 7'h0 + h0 -> h0 + h0 ', 'q + gamma -> q'' + pi+/- '/ + DATA (PROC(I),I=81,100)/ + 8'q + qbar -> Q + Qbar, mass ', 'g + g -> Q + Qbar, massive ', + 8'f + q -> f'' + Q, massive ', 'g + gamma -> Q + Qbar, mass ', + 8'gamma + gamma -> F + Fbar, m', 'g + g -> J/Psi + g ', + 8'g + g -> chi_0c + g ', 'g + g -> chi_1c + g ', + 8'g + g -> chi_2c + g ', ' ', + 9'Elastic scattering ', 'Single diffractive (XB) ', + 9'Single diffractive (AX) ', 'Double diffractive ', + 9'Low-pT scattering ', 'Semihard QCD 2 -> 2 ', + 9' ', ' ', + 9'q + gamma* -> q ', ' '/ + DATA (PROC(I),I=101,120)/ + &'g + g -> gamma*/Z0 ', 'g + g -> h0 ', + &'gamma + gamma -> h0 ', 'g + g -> chi_0c ', + &'g + g -> chi_2c ', 'g + g -> J/Psi + gamma ', + &'gamma + g -> J/Psi + g ', 'gamma+gamma -> J/Psi + gamma', + &' ', 'f + fbar -> gamma + h0 ', + 1'q + qbar -> g + h0 ', 'q + g -> q + h0 ', + 1'g + g -> g + h0 ', 'g + g -> gamma + gamma ', + 1'g + g -> g + gamma ', 'g + g -> gamma + Z0 ', + 1'g + g -> Z0 + Z0 ', 'g + g -> W+ + W- ', + 1' ', ' '/ + DATA (PROC(I),I=121,140)/ + 2'g + g -> Q + Qbar + h0 ', 'q + qbar -> Q + Qbar + h0 ', + 2'f + f'' -> f + f'' + h0 ', + 2'f + f'' -> f" + f"'' + h0 ', + 2' ', ' ', + 2' ', ' ', + 2' ', ' ', + 3'f + gamma*_T -> f + g ', 'f + gamma*_L -> f + g ', + 3'f + gamma*_T -> f + gamma ', 'f + gamma*_L -> f + gamma ', + 3'g + gamma*_T -> f + fbar ', 'g + gamma*_L -> f + fbar ', + 3'gamma*_T+gamma*_T -> f+fbar ', 'gamma*_T+gamma*_L -> f+fbar ', + 3'gamma*_L+gamma*_T -> f+fbar ', 'gamma*_L+gamma*_L -> f+fbar '/ + DATA (PROC(I),I=141,160)/ + 4'f + fbar -> gamma*/Z0/Z''0 ', 'f + fbar'' -> W''+/- ', + 4'f + fbar'' -> H+/- ', 'f + fbar'' -> R ', + 4'q + l -> LQ ', 'e + gamma -> e* ', + 4'd + g -> d* ', 'u + g -> u* ', + 4'g + g -> eta_tc ', ' ', + 5'f + fbar -> H0 ', 'g + g -> H0 ', + 5'gamma + gamma -> H0 ', ' ', + 5' ', 'f + fbar -> A0 ', + 5'g + g -> A0 ', 'gamma + gamma -> A0 ', + 5' ', ' '/ + DATA (PROC(I),I=161,180)/ + 6'f + g -> f'' + H+/- ', 'q + g -> LQ + lbar ', + 6'g + g -> LQ + LQbar ', 'q + qbar -> LQ + LQbar ', + 6'f + fbar -> f'' + fbar'' (g/Z)', + 6'f +fbar'' -> f" + fbar"'' (W) ', + 6'q + q'' -> q" + d* ', 'q + q'' -> q" + u* ', + 6'q + qbar -> e + e* ', ' ', + 7'f + fbar -> Z0 + H0 ', 'f + fbar'' -> W+/- + H0 ', + 7'f + f'' -> f + f'' + H0 ', + 7'f + f'' -> f" + f"'' + H0 ', + 7' ', 'f + fbar -> Z0 + A0 ', + 7'f + fbar'' -> W+/- + A0 ', + 7'f + f'' -> f + f'' + A0 ', + 7'f + f'' -> f" + f"'' + A0 ', + 7' '/ + DATA (PROC(I),I=181,200)/ + 8'g + g -> Q + Qbar + H0 ', 'q + qbar -> Q + Qbar + H0 ', + 8'q + qbar -> g + H0 ', 'q + g -> q + H0 ', + 8'g + g -> g + H0 ', 'g + g -> Q + Qbar + A0 ', + 8'q + qbar -> Q + Qbar + A0 ', 'q + qbar -> g + A0 ', + 8'q + g -> q + A0 ', 'g + g -> g + A0 ', + 9'f + fbar -> rho_tc0 ', 'f + f'' -> rho_tc+/- ', + 9'f + fbar -> omega_tc0 ', 'f+fbar -> f''+fbar'' (ETC) ', + 9'f+fbar'' -> f"+fbar"'' (ETC)',' ', + 9' ', ' ', + 9' ', ' '/ + DATA (PROC(I),I=201,220)/ + &'f + fbar -> ~e_L + ~e_Lbar ', 'f + fbar -> ~e_R + ~e_Rbar ', + &'f + fbar -> ~e_R + ~e_Lbar ', 'f + fbar -> ~mu_L + ~mu_Lbar', + &'f + fbar -> ~mu_R + ~mu_Rbar', 'f + fbar -> ~mu_L + ~mu_Rbar', + &'f+fbar -> ~tau_1 + ~tau_1bar', 'f+fbar -> ~tau_2 + ~tau_2bar', + &'f+fbar -> ~tau_1 + ~tau_2bar', 'q + qbar'' -> ~l_L + ~nulbar ', + 1'q+qbar''-> ~tau_1 + ~nutaubar', 'q+qbar''-> ~tau_2 + ~nutaubar', + 1'f + fbar -> ~nul + ~nulbar ', 'f+fbar -> ~nutau + ~nutaubar', + 1' ', 'f + fbar -> ~chi1 + ~chi1 ', + 1'f + fbar -> ~chi2 + ~chi2 ', 'f + fbar -> ~chi3 + ~chi3 ', + 1'f + fbar -> ~chi4 + ~chi4 ', 'f + fbar -> ~chi1 + ~chi2 '/ + DATA (PROC(I),I=221,240)/ + 2'f + fbar -> ~chi1 + ~chi3 ', 'f + fbar -> ~chi1 + ~chi4 ', + 2'f + fbar -> ~chi2 + ~chi3 ', 'f + fbar -> ~chi2 + ~chi4 ', + 2'f + fbar -> ~chi3 + ~chi4 ', 'f+fbar -> ~chi+-1 + ~chi-+1 ', + 2'f+fbar -> ~chi+-2 + ~chi-+2 ', 'f+fbar -> ~chi+-1 + ~chi-+2 ', + 2'q + qbar'' -> ~chi1 + ~chi+-1', 'q + qbar'' -> ~chi2 + ~chi+-1', + 3'q + qbar'' -> ~chi3 + ~chi+-1', 'q + qbar'' -> ~chi4 + ~chi+-1', + 3'q + qbar'' -> ~chi1 + ~chi+-2', 'q + qbar'' -> ~chi2 + ~chi+-2', + 3'q + qbar'' -> ~chi3 + ~chi+-2', 'q + qbar'' -> ~chi4 + ~chi+-2', + 3'q + qbar -> ~chi1 + ~g ', 'q + qbar -> ~chi2 + ~g ', + 3'q + qbar -> ~chi3 + ~g ', 'q + qbar -> ~chi4 + ~g '/ + DATA (PROC(I),I=241,260)/ + 4'q + qbar'' -> ~chi+-1 + ~g ', 'q + qbar'' -> ~chi+-2 + ~g ', + 4'q + qbar -> ~g + ~g ', 'g + g -> ~g + ~g ', + 4' ', 'qj + g -> ~qj_L + ~chi1 ', + 4'qj + g -> ~qj_R + ~chi1 ', 'qj + g -> ~qj_L + ~chi2 ', + 4'qj + g -> ~qj_R + ~chi2 ', 'qj + g -> ~qj_L + ~chi3 ', + 5'qj + g -> ~qj_R + ~chi3 ', 'qj + g -> ~qj_L + ~chi4 ', + 5'qj + g -> ~qj_R + ~chi4 ', 'qj + g -> ~qk_L + ~chi+-1 ', + 5'qj + g -> ~qk_R + ~chi+-1 ', 'qj + g -> ~qk_L + ~chi+-2 ', + 5'qj + g -> ~qk_R + ~chi+-2 ', 'qj + g -> ~qj_L + ~g ', + 5'qj + g -> ~qj_R + ~g ', ' '/ + DATA (PROC(I),I=261,300)/ + 6'f + fbar -> ~t_1 + ~t_1bar ', 'f + fbar -> ~t_2 + ~t_2bar ', + 6'f + fbar -> ~t_1 + ~t_2bar ', 'g + g -> ~t_1 + ~t_1bar ', + 6'g + g -> ~t_2 + ~t_2bar ', ' ', + 6' ', ' ', + 6' ', ' ', + 7'qi + qj -> ~qi_L + ~qj_L ', 'qi + qj -> ~qi_R + ~qj_R ', + 7'qi + qj -> ~qi_L + ~qj_R ', 'qi+qjbar -> ~qi_L + ~qj_Lbar', + 7'qi+qjbar -> ~qi_R + ~qj_Rbar', 'qi+qjbar -> ~qi_L + ~qj_Rbar', + 7'f + fbar -> ~qi_L + ~qi_Lbar', 'f + fbar -> ~qi_R + ~qi_Rbar', + 7'g + g -> ~qi_L + ~qi_Lbar ', 'g + g -> ~qi_R + ~qi_Rbar ', + 8'b + qj -> ~b_1 + ~qj_L ', 'b + qj -> ~b_2 + ~qj_R ', + 8'b + qj -> ~b_1 + ~qj_R ', 'b + qjbar -> ~b_1 + ~qj_Lbar', + 8'b + qjbar -> ~b_2 + ~qj_Rbar', 'b + qjbar -> ~b_1 + ~qj_Rbar', + 8'f + fbar -> ~b_1 + ~b_1bar ', 'f + fbar -> ~b_2 + ~b_2bar ', + 8'g + g -> ~b_1 + ~b_1bar ', 'g + g -> ~b_2 + ~b_2bar ', + 9'b + b -> ~b_1 + ~b_1 ', 'b + b -> ~b_2 + ~b_2 ', + 9'b + b -> ~b_1 + ~b_2 ', 'b + g -> ~b_1 + ~g ', + 9'b + g -> ~b_2 + ~g ', 'b + bbar -> ~b_1 + ~b_2bar ', + 9'f + fbar'' -> H+/- + h0 ', 'f + fbar -> H+/- + H0 ', + 9'f + fbar -> A0 + h0 ', 'f + fbar -> A0 + H0 '/ + DATA (PROC(I),I=301,340)/ + &'f + fbar -> H+ + H- ', + &9*' ', 'g + g -> g* + g* ', + &'q + g -> q*_D + g* ', 'qi + qj -> q*_Di + q*_Dj ', + &'g + g -> q*_D + q*_Dbar ', 'q + qbar -> q*_D + q*_Dbar ', + &'qi + qbarj -> q*Di + q*Sbarj', 'qi + qjbar -> q*Di + q*Dbarj', + &'qi + qj -> q*_Di + q*_Sj ', 'qi + qibar -> q*Dj + q*Dbarj', + &21*' '/ + DATA (PROC(I),I=341,380)/ + 4'l + l -> H_L++/-- ', 'l + l -> H_R++/-- ', + 4'l + gamma -> H_L++/-- e-/+ ', 'l + gamma -> H_R++/-- e-/+ ', + 4'l + gamma -> H_L++/-- mu-/+ ', 'l + gamma -> H_R++/-- mu-/+ ', + 4'l + gamma -> H_L++/-- tau-/+', 'l + gamma -> H_R++/-- tau-/+', + 4'f + fbar -> H_L++ + H_L-- ', 'f + fbar -> H_R++ + H_R-- ', + 5'f + f -> f'' + f'' + H_L++/-- ', + 5'f + f -> f'' + f'' + H_R++/-- ','f + fbar -> Z_R0 ', + 5'f + fbar'' -> W_R+/- ',5*' ', + 6' ', 'f + fbar -> W_L+ W_L- ', + 6'f + fbar -> W_L+/- pi_T-/+ ', 'f + fbar -> pi_T+ pi_T- ', + 6'f + fbar -> gamma pi_T0 ', 'f + fbar -> gamma pi_T0'' ', + 6'f + fbar -> Z0 pi_T0 ', 'f + fbar -> Z0 pi_T0'' ', + 6'f + fbar -> W+/- pi_T-/+ ', ' ', + 7'f + fbar'' -> W_L+/- Z_L0 ', 'f + fbar'' -> W_L+/- pi_T0 ', + 7'f + fbar'' -> pi_T+/- Z_L0 ', 'f + fbar'' -> pi_T+/- pi_T0 ', + 7'f + fbar'' -> gamma pi_T+/- ', 'f + fbar'' -> Z0 pi_T+/- ', + 7'f + fbar'' -> W+/- pi_T0 ', + 7'f + fbar'' -> W+/- pi_T0'' ', + 7'f + fbar'' -> gamma W+/-(ETC)','f + fbar -> gamma Z0 (ETC)', + 7'f + fbar -> Z0 Z0 (ETC) '/ + DATA (PROC(I),I=381,420)/ + 8'f + f'' -> f + f'' (ETC) ','f + fbar -> f'' + fbar'' (ETC)', + 8'f + fbar -> g + g (ETC) ', 'f + g -> f + g (ETC) ', + 8'g + g -> f + fbar (ETC) ', 'g + g -> g + g (ETC) ', + 8'q + qbar -> Q + Qbar (ETC) ', 'g + g -> Q + Qbar (ETC) ', + 8' ', ' ', + 9'f + fbar -> G* ', 'g + g -> G* ', + 9'q + qbar -> g + G* ', 'q + g -> q + G* ', + 9'g + g -> g + G* ', ' ', + 9 4*' ', + &'g + g -> t + b + H+/- ', 'q + qbar -> t + b + H+/- ', + & 18*' '/ + DATA (PROC(I),I=421,460)/ + 2'g + g -> cc~[3S1(1)] + g ', 'g + g -> cc~[3S1(8)] + g ', + 2'g + g -> cc~[1S0(8)] + g ', 'g + g -> cc~[3PJ(8)] + g ', + 2'g + q -> q + cc~[3S1(8)] ', 'g + q -> q + cc~[1S0(8)] ', + 2'g + q -> q + cc~[3PJ(8)] ', 'q + q~ -> g + cc~[3S1(8)] ', + 2'q + q~ -> g + cc~[1S0(8)] ', 'q + q~ -> g + cc~[3PJ(8)] ', + 3'g + g -> cc~[3P0(1)] + g ', 'g + g -> cc~[3P1(1)] + g ', + 3'g + g -> cc~[3P2(1)] + g ', 'q + g -> q + cc~[3P0(1)] ', + 3'q + g -> q + cc~[3P1(1)] ', 'q + g -> q + cc~[3P2(1)] ', + 3'q + q~ -> g + cc~[3P0(1)] ', 'q + q~ -> g + cc~[3P1(1)] ', + 3'q + q~ -> g + cc~[3P2(1)] ', + 3 21 *' '/ + DATA (PROC(I),I=461,500)/ + 6'g + g -> bb~[3S1(1)] + g ', 'g + g -> bb~[3S1(8)] + g ', + 6'g + g -> bb~[1S0(8)] + g ', 'g + g -> bb~[3PJ(8)] + g ', + 6'g + q -> q + bb~[3S1(8)] ', 'g + q -> q + bb~[1S0(8)] ', + 6'g + q -> q + bb~[3PJ(8)] ', 'q + q~ -> g + bb~[3S1(8)] ', + 6'q + q~ -> g + bb~[1S0(8)] ', 'q + q~ -> g + bb~[3PJ(8)] ', + 7'g + g -> bb~[3P0(1)] + g ', 'g + g -> bb~[3P1(1)] + g ', + 7'g + g -> bb~[3P2(1)] + g ', 'q + g -> q + bb~[3P0(1)] ', + 7'q + g -> q + bb~[3P1(1)] ', 'q + g -> q + bb~[3P2(1)] ', + 7'q + q~ -> g + bb~[3P0(1)] ', 'q + q~ -> g + bb~[3P1(1)] ', + 7'q + q~ -> g + bb~[3P2(1)] ', + 7 21 *' '/ + +C...Cross sections and slope offsets. + DATA SIGT/294*0D0/ + +C...Supersymmetry switches and parameters. + DATA IMSS/0, + & 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, + 1 89*0/ + DATA RMSS/0D0, + & 80D0,160D0,500D0,800D0,2D0,250D0,200D0,800D0,700D0,800D0, + 1 700D0,500D0,250D0,200D0,800D0,400D0,0D0,0.1D0,850D0,0.041D0, + 2 1D0,800D0,1D4,1D4,1D4,0D0,0D0,0D0,24D17,0D0, + 3 10*0D0, + 4 0D0,1D0,8*0D0, + 5 49*0D0/ +C...Initial values for R-violating SUSY couplings. +C...Should not be changed here. See PYMSIN. + DATA RVLAM/27*0D0/ + DATA RVLAMP/27*0D0/ + DATA RVLAMB/27*0D0/ + +C...Technicolor switches and parameters + DATA ITCM/0, + & 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 1 89*0/ + DATA RTCM/0D0, + & 82D0,1.333D0,.333D0,0.408D0,1D0,1D0,.0182D0,1D0,0D0,1.333D0, + 1 .05D0,200D0,200D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0, + 2 .283D0,.707D0,0D0,0D0,0D0,1.667D0,250D0,250D0,.707D0,0D0, + 3 .707D0,0D0,1D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0, + 4 1000D0, 1D0, 1D0, 1D0, 1D0, 0D0, 1D0, 3*200D0, + 4 200D0, 48*0D0/ + +C...UED switches and parameters. +C... IUED(0) empty IUED vector element +C... IUED(1) UED ON(=1)/OFF(=0) switch +C... IUED(2) ON(=1)/OFF(=0) switch for gravity mediated decays +C... IUED(3) NFLAVOURS Number of KK excitation quark flavours +C... IUED(4) N the number of large extra dimensions +C... IUED(5) Selects whether the code takes Lambda (=0) +C... or Lambda*R (=1) as input. +C... IUED(6) With radiative corrections to the masses (=1) +C... or without (=0) +C... +C... RUED(0) empty RUED vector element +C... RUED(1) RINV (1/R) the curvature of the extra dimension +C... RUED(2) XMD the (4+N)-dimensional Planck scale +C... RUED(3) LAMUED (Lambda cutoff scale) +C... RUED(4) LAMUED/RINV (feasible values are order of 10-20) +C... + DATA IUED/0,0,0,5,6,0,1,93*0/ + DATA RUED/0.D0,1000D0,5000D0,20000.,20.,95*0D0/ + +C...Data for histogramming routines. + DATA IHIST/1000,20000,55,1/ + DATA INDX/1000*0/ + +C...Data for SUSY Les Houches Accord. + DATA CPRO/'PYTHIA ','PYTHIA '/ + DATA CVER/'6.4 ','6.4 '/ + DATA MODSEL/200*0/ + DATA PARMIN/100*0D0/ + DATA RMSOFT/101*0D0/ + DATA AU/9*0D0/ + DATA AD/9*0D0/ + DATA AE/9*0D0/ + + END + +C********************************************************************* + +C...PYCKBD +C...Check that BLOCK DATA PYDATA has been loaded. +C...Should not be required, except that some compilers/linkers +C...are pretty buggy in this respect. + + SUBROUTINE PYCKBD + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/ + +C...Check a few variables to see they have been sensibly initialized. + IF(MSTU(4).LT.10.OR.MSTU(4).GT.900000.OR.PMAS(2,1).LT.0.001D0 + &.OR.PMAS(2,1).GT.1D0.OR.CKIN(5).LT.0.01D0.OR.MSTP(1).LT.1.OR. + &MSTP(1).GT.5) THEN +C...If not, abort the run right away. + WRITE(*,*) 'Fatal error: BLOCK DATA PYDATA has not been loaded!' + WRITE(*,*) 'The program execution is stopped now!' + CALL PYSTOP(8) + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYTEST +C...A simple program (disguised as subroutine) to run at installation +C...as a check that the program works as intended. + + SUBROUTINE PYTEST(MTEST) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/ +C...Local arrays. + DIMENSION PSUM(5),PINI(6),PFIN(6) + +C...Save defaults for values that are changed. + MSTJ1=MSTJ(1) + MSTJ3=MSTJ(3) + MSTJ11=MSTJ(11) + MSTJ42=MSTJ(42) + MSTJ43=MSTJ(43) + MSTJ44=MSTJ(44) + PARJ17=PARJ(17) + PARJ22=PARJ(22) + PARJ43=PARJ(43) + PARJ54=PARJ(54) + MST101=MSTJ(101) + MST104=MSTJ(104) + MST105=MSTJ(105) + MST107=MSTJ(107) + MST116=MSTJ(116) + +C...First part: loop over simple events to be generated. + IF(MTEST.GE.1) CALL PYTABU(20) + NERR=0 + DO 180 IEV=1,500 + +C...Reset parameter values. Switch on some nonstandard features. + MSTJ(1)=1 + MSTJ(3)=0 + MSTJ(11)=1 + MSTJ(42)=2 + MSTJ(43)=4 + MSTJ(44)=2 + PARJ(17)=0.1D0 + PARJ(22)=1.5D0 + PARJ(43)=1D0 + PARJ(54)=-0.05D0 + MSTJ(101)=5 + MSTJ(104)=5 + MSTJ(105)=0 + MSTJ(107)=1 + IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3 + +C...Ten events each for some single jets configurations. + IF(IEV.LE.50) THEN + ITY=(IEV+9)/10 + MSTJ(3)=-1 + IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2 + IF(ITY.EQ.1) CALL PY1ENT(1,1,15D0,0D0,0D0) + IF(ITY.EQ.2) CALL PY1ENT(1,3101,15D0,0D0,0D0) + IF(ITY.EQ.3) CALL PY1ENT(1,-2203,15D0,0D0,0D0) + IF(ITY.EQ.4) CALL PY1ENT(1,-4,30D0,0D0,0D0) + IF(ITY.EQ.5) CALL PY1ENT(1,21,15D0,0D0,0D0) + +C...Ten events each for some simple jet systems; string fragmentation. + ELSEIF(IEV.LE.130) THEN + ITY=(IEV-41)/10 + IF(ITY.EQ.1) CALL PY2ENT(1,1,-1,40D0) + IF(ITY.EQ.2) CALL PY2ENT(1,4,-4,30D0) + IF(ITY.EQ.3) CALL PY2ENT(1,2,2103,100D0) + IF(ITY.EQ.4) CALL PY2ENT(1,21,21,40D0) + IF(ITY.EQ.5) CALL PY3ENT(1,2101,21,-3203,30D0,0.6D0,0.8D0) + IF(ITY.EQ.6) CALL PY3ENT(1,5,21,-5,40D0,0.9D0,0.8D0) + IF(ITY.EQ.7) CALL PY3ENT(1,21,21,21,60D0,0.7D0,0.5D0) + IF(ITY.EQ.8) CALL PY4ENT(1,2,21,21,-2,40D0, + & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) + +C...Seventy events with independent fragmentation and momentum cons. + ELSEIF(IEV.LE.200) THEN + ITY=1+(IEV-131)/16 + MSTJ(2)=1+MOD(IEV-131,4) + MSTJ(3)=1+MOD((IEV-131)/4,4) + IF(ITY.EQ.1) CALL PY2ENT(1,4,-5,40D0) + IF(ITY.EQ.2) CALL PY3ENT(1,3,21,-3,40D0,0.9D0,0.4D0) + IF(ITY.EQ.3) CALL PY4ENT(1,2,21,21,-2,40D0, + & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) + IF(ITY.GE.4) CALL PY4ENT(1,2,-3,3,-2,40D0, + & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) + +C...A hundred events with random jets (check invariant mass). + ELSEIF(IEV.LE.300) THEN + 100 DO 110 J=1,5 + PSUM(J)=0D0 + 110 CONTINUE + NJET=2D0+6D0*PYR(0) + DO 130 I=1,NJET + KFL=21 + IF(I.EQ.1) KFL=INT(1D0+4D0*PYR(0)) + IF(I.EQ.NJET) KFL=-INT(1D0+4D0*PYR(0)) + EJET=5D0+20D0*PYR(0) + THETA=ACOS(2D0*PYR(0)-1D0) + PHI=6.2832D0*PYR(0) + IF(I.LT.NJET) CALL PY1ENT(-I,KFL,EJET,THETA,PHI) + IF(I.EQ.NJET) CALL PY1ENT(I,KFL,EJET,THETA,PHI) + IF(I.EQ.1.OR.I.EQ.NJET) MSTJ(93)=1 + IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+PYMASS(KFL) + DO 120 J=1,4 + PSUM(J)=PSUM(J)+P(I,J) + 120 CONTINUE + 130 CONTINUE + IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT. + & (PSUM(5)+PARJ(32))**2) GOTO 100 + +C...Fifty e+e- continuum events with matrix elements. + ELSEIF(IEV.LE.350) THEN + MSTJ(101)=2 + CALL PYEEVT(0,40D0) + +C...Fifty e+e- continuum event with varying shower options. + ELSEIF(IEV.LE.400) THEN + MSTJ(42)=1+MOD(IEV,2) + MSTJ(43)=1+MOD(IEV/2,4) + MSTJ(44)=MOD(IEV/8,3) + CALL PYEEVT(0,90D0) + +C...Fifty e+e- continuum events with coherent shower. + ELSEIF(IEV.LE.450) THEN + CALL PYEEVT(0,500D0) + +C...Fifty Upsilon decays to ggg or gammagg with coherent shower. + ELSE + CALL PYONIA(5,9.46D0) + ENDIF + +C...Generate event. Find total momentum, energy and charge. + DO 140 J=1,4 + PINI(J)=PYP(0,J) + 140 CONTINUE + PINI(6)=PYP(0,6) + CALL PYEXEC + DO 150 J=1,4 + PFIN(J)=PYP(0,J) + 150 CONTINUE + PFIN(6)=PYP(0,6) + +C...Check conservation of energy, momentum and charge; +C...usually exact, but only approximate for single jets. + MERR=0 + IF(IEV.LE.50) THEN + IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.10D0) + & MERR=MERR+1 + EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3) + IF(EPZREM.LT.0D0.OR.EPZREM.GT.2D0*PARJ(31)) MERR=MERR+1 + IF(ABS(PFIN(6)-PINI(6)).GT.2.1D0) MERR=MERR+1 + ELSE + DO 160 J=1,4 + IF(ABS(PFIN(J)-PINI(J)).GT.0.0001D0*PINI(4)) MERR=MERR+1 + 160 CONTINUE + IF(ABS(PFIN(6)-PINI(6)).GT.0.1D0) MERR=MERR+1 + ENDIF + IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), + & (PFIN(J),J=1,4),PFIN(6) + +C...Check that all KF codes are known ones, and that partons/particles +C...satisfy energy-momentum-mass relation. Store particle statistics. + DO 170 I=1,N + IF(K(I,1).GT.20) GOTO 170 + IF(PYCOMP(K(I,2)).EQ.0) THEN + WRITE(MSTU(11),5100) I + MERR=MERR+1 + ENDIF + PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 + IF(ABS(PD).GT.MAX(0.1D0,0.001D0*P(I,4)**2).OR.P(I,4).LT.0D0) + & THEN + WRITE(MSTU(11),5200) I + MERR=MERR+1 + ENDIF + 170 CONTINUE + IF(MTEST.GE.1) CALL PYTABU(21) + +C...List all erroneous events and some normal ones. + IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN + IF(MERR.GE.1) WRITE(MSTU(11),6400) + CALL PYLIST(2) + ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN + CALL PYLIST(1) + ENDIF + +C...Stop execution if too many errors. + IF(MERR.NE.0) NERR=NERR+1 + IF(NERR.GE.10) THEN + WRITE(MSTU(11),6300) + CALL PYLIST(1) + CALL PYSTOP(9) + ENDIF + 180 CONTINUE + +C...Summarize result of run. + IF(MTEST.GE.1) CALL PYTABU(22) + +C...Reset commonblock variables changed during run. + MSTJ(1)=MSTJ1 + MSTJ(3)=MSTJ3 + MSTJ(11)=MSTJ11 + MSTJ(42)=MSTJ42 + MSTJ(43)=MSTJ43 + MSTJ(44)=MSTJ44 + PARJ(17)=PARJ17 + PARJ(22)=PARJ22 + PARJ(43)=PARJ43 + PARJ(54)=PARJ54 + MSTJ(101)=MST101 + MSTJ(104)=MST104 + MSTJ(105)=MST105 + MSTJ(107)=MST107 + MSTJ(116)=MST116 + +C...Second part: complete events of various kinds. +C...Common initial values. Loop over initiating conditions. + MSTP(122)=MAX(0,MIN(2,MTEST)) + MDCY(PYCOMP(111),1)=0 + DO 230 IPROC=1,8 + +C...Reset process type, kinematics cuts, and the flags used. + MSEL=0 + DO 190 ISUB=1,500 + MSUB(ISUB)=0 + 190 CONTINUE + CKIN(1)=2D0 + CKIN(3)=0D0 + MSTP(2)=1 + MSTP(11)=0 + MSTP(33)=0 + MSTP(81)=1 + MSTP(82)=1 + MSTP(111)=1 + MSTP(131)=0 + MSTP(133)=0 + PARP(131)=0.01D0 + +C...Prompt photon production at fixed target. + IF(IPROC.EQ.1) THEN + PZSUM=300D0 + PESUM=SQRT(PZSUM**2+PYMASS(211)**2)+PYMASS(2212) + PQSUM=2D0 + MSEL=10 + CKIN(3)=5D0 + CALL PYINIT('FIXT','pi+','p',PZSUM) + +C...QCD processes at ISR energies. + ELSEIF(IPROC.EQ.2) THEN + PESUM=63D0 + PZSUM=0D0 + PQSUM=2D0 + MSEL=1 + CKIN(3)=5D0 + CALL PYINIT('CMS','p','p',PESUM) + +C...W production + multiple interactions at CERN Collider. + ELSEIF(IPROC.EQ.3) THEN + PESUM=630D0 + PZSUM=0D0 + PQSUM=0D0 + MSEL=12 + CKIN(1)=20D0 + MSTP(82)=4 + MSTP(2)=2 + MSTP(33)=3 + CALL PYINIT('CMS','p','pbar',PESUM) + +C...W/Z gauge boson pairs + pileup events at the Tevatron. + ELSEIF(IPROC.EQ.4) THEN + PESUM=1800D0 + PZSUM=0D0 + PQSUM=0D0 + MSUB(22)=1 + MSUB(23)=1 + MSUB(25)=1 + CKIN(1)=200D0 + MSTP(111)=0 + MSTP(131)=1 + MSTP(133)=2 + PARP(131)=0.04D0 + CALL PYINIT('CMS','p','pbar',PESUM) + +C...Higgs production at LHC. + ELSEIF(IPROC.EQ.5) THEN + PESUM=15400D0 + PZSUM=0D0 + PQSUM=2D0 + MSUB(3)=1 + MSUB(102)=1 + MSUB(123)=1 + MSUB(124)=1 + PMAS(25,1)=300D0 + CKIN(1)=200D0 + MSTP(81)=0 + MSTP(111)=0 + CALL PYINIT('CMS','p','p',PESUM) + +C...Z' production at SSC. + ELSEIF(IPROC.EQ.6) THEN + PESUM=40000D0 + PZSUM=0D0 + PQSUM=2D0 + MSEL=21 + PMAS(32,1)=600D0 + CKIN(1)=400D0 + MSTP(81)=0 + MSTP(111)=0 + CALL PYINIT('CMS','p','p',PESUM) + +C...W pair production at 1 TeV e+e- collider. + ELSEIF(IPROC.EQ.7) THEN + PESUM=1000D0 + PZSUM=0D0 + PQSUM=0D0 + MSUB(25)=1 + MSUB(69)=1 + MSTP(11)=1 + CALL PYINIT('CMS','e+','e-',PESUM) + +C...Deep inelastic scattering at a LEP+LHC ep collider. + ELSEIF(IPROC.EQ.8) THEN + P(1,1)=0D0 + P(1,2)=0D0 + P(1,3)=8000D0 + P(2,1)=0D0 + P(2,2)=0D0 + P(2,3)=-80D0 + PESUM=8080D0 + PZSUM=7920D0 + PQSUM=0D0 + MSUB(10)=1 + CKIN(3)=50D0 + MSTP(111)=0 + CALL PYINIT('3MOM','p','e-',PESUM) + ENDIF + +C...Generate 20 events of each required type. + DO 220 IEV=1,20 + CALL PYEVNT + PESUMM=PESUM + IF(IPROC.EQ.4) PESUMM=MSTI(41)*PESUM + +C...Check conservation of energy/momentum/flavour. + PINI(1)=0D0 + PINI(2)=0D0 + PINI(3)=PZSUM + PINI(4)=PESUMM + PINI(6)=PQSUM + DO 200 J=1,4 + PFIN(J)=PYP(0,J) + 200 CONTINUE + PFIN(6)=PYP(0,6) + MERR=0 + DEVE=ABS(PFIN(4)-PINI(4))+ABS(PFIN(3)-PINI(3)) + DEVT=ABS(PFIN(1)-PINI(1))+ABS(PFIN(2)-PINI(2)) + DEVQ=ABS(PFIN(6)-PINI(6)) + IF(DEVE.GT.2D-3*PESUM.OR.DEVT.GT.MAX(0.01D0,1D-4*PESUM).OR. + & DEVQ.GT.0.1D0) MERR=1 + IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), + & (PFIN(J),J=1,4),PFIN(6) + +C...Check that all KF codes are known ones, and that partons/particles +C...satisfy energy-momentum-mass relation. + DO 210 I=1,N + IF(K(I,1).GT.20) GOTO 210 + IF(PYCOMP(K(I,2)).EQ.0) THEN + WRITE(MSTU(11),5100) I + MERR=MERR+1 + ENDIF + PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2* + & SIGN(1D0,P(I,5)) + IF(ABS(PD).GT.MAX(0.1D0,0.002D0*P(I,4)**2,0.002D0*P(I,5)**2) + & .OR.(P(I,5).GE.0D0.AND.P(I,4).LT.0D0)) THEN + WRITE(MSTU(11),5200) I + MERR=MERR+1 + ENDIF + 210 CONTINUE + +C...Listing of erroneous events, and first event of each type. + IF(MERR.GE.1) NERR=NERR+1 + IF(NERR.GE.10) THEN + WRITE(MSTU(11),6300) + CALL PYLIST(1) + CALL PYSTOP(9) + ENDIF + IF(MTEST.GE.1.AND.(MERR.GE.1.OR.IEV.EQ.1)) THEN + IF(MERR.GE.1) WRITE(MSTU(11),6400) + CALL PYLIST(1) + ENDIF + 220 CONTINUE + +C...List statistics for each process type. + IF(MTEST.GE.1) CALL PYSTAT(1) + 230 CONTINUE + +C...Summarize result of run. + IF(NERR.EQ.0) WRITE(MSTU(11),6500) + IF(NERR.GT.0) WRITE(MSTU(11),6600) NERR + +C...Format statements for output. + 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ', + &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X, + &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X, + &4(1X,F12.5),1X,F8.2) + 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code') + 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ', + &'kinematics') + 6300 FORMAT(/5X,'This is the tenth error experienced! Something is ', + &'wrong.'/5X,'Execution will be stopped after listing of event.') + 6400 FORMAT(5X,'Faulty event follows:') + 6500 FORMAT(//5X,'End result of PYTEST: no errors detected.') + 6600 FORMAT(//5X,'End result of PYTEST:',I2,' errors detected.'/ + &5X,'This should not have happened!') + + RETURN + END + +C********************************************************************* + +C...PYHEPC +C...Converts PYTHIA event record contents to or from +C...the standard event record commonblock. + + SUBROUTINE PYHEPC(MCONV) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ +C...HEPEVT commonblock. + PARAMETER (NMXHEP=4000) + COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), + &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) + DOUBLE PRECISION PHEP,VHEP + SAVE /HEPEVT/ + +C...Store HEPEVT commonblock size (for interfacing issues). + MSTU(8)=NMXHEP + +C...Conversion from PYTHIA to standard, the easy part. + IF(MCONV.EQ.1) THEN + NEVHEP=0 + IF(N.GT.NMXHEP) CALL PYERRM(8, + & '(PYHEPC:) no more space in /HEPEVT/') + NHEP=MIN(N,NMXHEP) + DO 150 I=1,NHEP + ISTHEP(I)=0 + IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1 + IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2 + IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3 + IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1) + IDHEP(I)=K(I,2) + JMOHEP(1,I)=K(I,3) + JMOHEP(2,I)=0 + IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN + JDAHEP(1,I)=K(I,4) + JDAHEP(2,I)=K(I,5) + ELSE + JDAHEP(1,I)=0 + JDAHEP(2,I)=0 + ENDIF + DO 100 J=1,5 + PHEP(J,I)=P(I,J) + 100 CONTINUE + DO 110 J=1,4 + VHEP(J,I)=V(I,J) + 110 CONTINUE + +C...Check if new event (from pileup). + IF(I.EQ.1) THEN + INEW=1 + ELSE + IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I + ENDIF + +C...Fill in missing mother information. + IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN + IMO1=I-2 + 120 IF(IMO1.GT.INEW.AND.K(IMO1+1,1).EQ.21.AND.K(IMO1+1,3).EQ.0) + & THEN + IMO1=IMO1-1 + GOTO 120 + ENDIF + JMOHEP(1,I)=IMO1 + JMOHEP(2,I)=IMO1+1 + ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN + I1=K(I,3)-1 + 130 I1=I1+1 + IF(I1.GE.I) CALL PYERRM(8, + & '(PYHEPC:) translation of inconsistent event history') + IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 130 + KC=PYCOMP(K(I1,2)) + IF(I1.LT.I.AND.KC.EQ.0) GOTO 130 + IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 130 + JMOHEP(2,I)=I1 + ELSEIF(K(I,2).EQ.94) THEN + NJET=2 + IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3 + IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4 + JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5)) + IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)= + & MOD(K(I+1,4)/MSTU(5),MSTU(5)) + ENDIF + +C...Fill in missing daughter information. + IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN + DO 140 I1=JDAHEP(1,I),JDAHEP(2,I) + I2=MOD(K(I1,4)/MSTU(5),MSTU(5)) + JDAHEP(1,I2)=I + 140 CONTINUE + ENDIF + IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 150 + I1=JMOHEP(1,I) + IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 150 + IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 150 + IF(JDAHEP(1,I1).EQ.0) THEN + JDAHEP(1,I1)=I + ELSE + JDAHEP(2,I1)=I + ENDIF + 150 CONTINUE + DO 160 I=1,NHEP + IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 160 + IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I) + 160 CONTINUE + +C...Conversion from standard to PYTHIA, the easy part. + ELSE + IF(NHEP.GT.MSTU(4)) CALL PYERRM(8, + & '(PYHEPC:) no more space in /PYJETS/') + N=MIN(NHEP,MSTU(4)) + NKQ=0 + KQSUM=0 + DO 190 I=1,N + K(I,1)=0 + IF(ISTHEP(I).EQ.1) K(I,1)=1 + IF(ISTHEP(I).EQ.2) K(I,1)=11 + IF(ISTHEP(I).EQ.3) K(I,1)=21 + K(I,2)=IDHEP(I) + K(I,3)=JMOHEP(1,I) + K(I,4)=JDAHEP(1,I) + K(I,5)=JDAHEP(2,I) + DO 170 J=1,5 + P(I,J)=PHEP(J,I) + 170 CONTINUE + DO 180 J=1,4 + V(I,J)=VHEP(J,I) + 180 CONTINUE + V(I,5)=0D0 + IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN + I1=JDAHEP(1,I) + IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))* + & PHEP(5,I)/PHEP(4,I) + ENDIF + +C...Fill in missing information on colour connection in jet systems. + IF(ISTHEP(I).EQ.1) THEN + KC=PYCOMP(K(I,2)) + KQ=0 + IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) + IF(KQ.NE.0) NKQ=NKQ+1 + IF(KQ.NE.2) KQSUM=KQSUM+KQ + IF(KQ.NE.0.AND.KQSUM.NE.0) THEN + K(I,1)=2 + ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN + IF(K(I+1,2).EQ.21) K(I,1)=2 + ENDIF + ENDIF + 190 CONTINUE + IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL PYERRM(8, + & '(PYHEPC:) input parton configuration not colour singlet') + ENDIF + + END + +C********************************************************************* + +C...PYINIT +C...Initializes the generation procedure; finds maxima of the +C...differential cross-sections to be used for weighting. + + SUBROUTINE PYINIT(FRAME,BEAM,TARGET,WIN) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYDAT4/CHAF(500,2) + CHARACTER CHAF*16 + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYPUED/IUED(0:99),RUED(0:99) + SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, + &/PYINT1/,/PYINT2/,/PYINT5/,/PYPUED/ +C...Local arrays and character variables. + DIMENSION ALAMIN(20),NFIN(20) + CHARACTER*(*) FRAME,BEAM,TARGET + CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHLH(2)*6 + +C...Interface to PDFLIB. + COMMON/W50511/NPTYPE,NGROUP,NSET,MODE,NFL,LO,TMAS + COMMON/W50512/QCDL4,QCDL5 + SAVE /W50511/,/W50512/ + DOUBLE PRECISION VALUE(20),TMAS,QCDL4,QCDL5 + CHARACTER*20 PARM(20) + DATA VALUE/20*0D0/,PARM/20*' '/ + +C...Data:Lambda and n_f values for parton distributions.. + DATA ALAMIN/0.177D0,0.239D0,0.247D0,0.2322D0,0.248D0,0.248D0, + &0.192D0,0.326D0,2*0.2D0,0.2D0,0.2D0,0.29D0,0.2D0,0.4D0,5*0.2D0/, + &NFIN/20*4/ + DATA CHLH/'lepton','hadron'/ + +C...Check that BLOCK DATA PYDATA has been loaded. + CALL PYCKBD + +C...Reset MINT and VINT arrays. Write headers. + MSTI(53)=0 + DO 100 J=1,400 + MINT(J)=0 + VINT(J)=0D0 + 100 CONTINUE + IF(MSTU(12).NE.12345) CALL PYLIST(0) + IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) + +C...Reset error counters. + MSTU(23)=0 + MSTU(27)=0 + MSTU(30)=0 + +C...Reset processes that should not be on. + MSUB(96)=0 + MSUB(97)=0 + +C...Select global FSR/ISR/UE parameter set = 'tune' +C...See routine PYTUNE for details + IF (MSTP(5).NE.0) THEN + MSTP5=MSTP(5) + CALL PYTUNE(MSTP5) + ENDIF + +C...Call user process initialization routine. + IF(FRAME(1:1).EQ.'u'.OR.FRAME(1:1).EQ.'U') THEN + MSEL=0 + CALL UPINIT + MSEL=0 + ENDIF + +C...Maximum 4 generations; set maximum number of allowed flavours. + MSTP(1)=MIN(4,MSTP(1)) + MSTU(114)=MIN(MSTU(114),2*MSTP(1)) + MSTP(58)=MIN(MSTP(58),2*MSTP(1)) + +C...Sum up Cabibbo-Kobayashi-Maskawa factors for each quark/lepton. + DO 120 I=-20,20 + VINT(180+I)=0D0 + IA=IABS(I) + IF(IA.GE.1.AND.IA.LE.2*MSTP(1)) THEN + DO 110 J=1,MSTP(1) + IB=2*J-1+MOD(IA,2) + IF(IB.GE.6.AND.MSTP(9).EQ.0) GOTO 110 + IPM=(5-ISIGN(1,I))/2 + IDC=J+MDCY(IA,2)+2 + IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) VINT(180+I)= + & VINT(180+I)+VCKM((IA+1)/2,(IB+1)/2) + 110 CONTINUE + ELSEIF(IA.GE.11.AND.IA.LE.10+2*MSTP(1)) THEN + VINT(180+I)=1D0 + ENDIF + 120 CONTINUE + +C...Initialize parton distributions: PDFLIB. + IF(MSTP(52).EQ.2) THEN + PARM(1)='NPTYPE' + VALUE(1)=1 + PARM(2)='NGROUP' + VALUE(2)=MSTP(51)/1000 + PARM(3)='NSET' + VALUE(3)=MOD(MSTP(51),1000) + PARM(4)='TMAS' + VALUE(4)=PMAS(6,1) + CALL PDFSET_ALICE(PARM,VALUE) + MINT(93)=1000000+MSTP(51) + ENDIF + +C...Choose Lambda value to use in alpha-strong. + MSTU(111)=MSTP(2) + IF(MSTP(3).GE.2) THEN + ALAM=0.2D0 + NF=4 + IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.20) THEN + ALAM=ALAMIN(MSTP(51)) + NF=NFIN(MSTP(51)) + ELSEIF(MSTP(52).EQ.2.AND.NFL.EQ.5) THEN + ALAM=QCDL5 + NF=5 + ELSEIF(MSTP(52).EQ.2) THEN + ALAM=QCDL4 + NF=4 + ENDIF + PARP(1)=ALAM + PARP(61)=ALAM + PARP(72)=ALAM + PARU(112)=ALAM + MSTU(112)=NF + IF(MSTP(3).EQ.3) PARJ(81)=ALAM + ENDIF + +C...Initialize the UED masses and widths + IF (IUED(1).EQ.1) CALL PYXDIN + +C...Initialize the SUSY generation: couplings, masses, +C...decay modes, branching ratios, and so on. + CALL PYMSIN +C...Initialize widths and partial widths for resonances. + CALL PYINRE +C...Set Z0 mass and width for e+e- routines. + PARJ(123)=PMAS(23,1) + PARJ(124)=PMAS(23,2) + +C...Identify beam and target particles and frame of process. + CHFRAM=FRAME//' ' + CHBEAM=BEAM//' ' + CHTARG=TARGET//' ' + CALL PYINBM(CHFRAM,CHBEAM,CHTARG,WIN) + IF(MINT(65).EQ.1) GOTO 170 + +C...For gamma-p or gamma-gamma allow many (3 or 6) alternatives. +C...For e-gamma allow 2 alternatives. + MINT(121)=1 + IF(MSTP(14).EQ.10.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN + IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. + & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3 + IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=6 + IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. + & (IABS(MINT(11)).EQ.11.OR.IABS(MINT(12)).EQ.11)) MINT(121)=2 + ELSEIF(MSTP(14).EQ.20.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN + IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. + & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3 + IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=9 + ELSEIF(MSTP(14).EQ.25.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN + IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. + & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=2 + IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=4 + ELSEIF(MSTP(14).EQ.30.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN + IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. + & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=4 + IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=13 + ENDIF + MINT(123)=MSTP(14) + IF((MSTP(14).EQ.10.OR.MSTP(14).EQ.20.OR.MSTP(14).EQ.25.OR. + &MSTP(14).EQ.30).AND.MSEL.NE.1.AND.MSEL.NE.2) MINT(123)=0 + IF(MSTP(14).GE.11.AND.MSTP(14).LE.19) THEN + IF(MSTP(14).EQ.11) MINT(123)=0 + IF(MSTP(14).EQ.12.OR.MSTP(14).EQ.14) MINT(123)=5 + IF(MSTP(14).EQ.13.OR.MSTP(14).EQ.17) MINT(123)=6 + IF(MSTP(14).EQ.15) MINT(123)=2 + IF(MSTP(14).EQ.16.OR.MSTP(14).EQ.18) MINT(123)=7 + IF(MSTP(14).EQ.19) MINT(123)=3 + ELSEIF(MSTP(14).GE.21.AND.MSTP(14).LE.24) THEN + IF(MSTP(14).EQ.21) MINT(123)=0 + IF(MSTP(14).EQ.22.OR.MSTP(14).EQ.23) MINT(123)=4 + IF(MSTP(14).EQ.24) MINT(123)=1 + ELSEIF(MSTP(14).GE.26.AND.MSTP(14).LE.29) THEN + IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28) MINT(123)=8 + IF(MSTP(14).EQ.27.OR.MSTP(14).EQ.29) MINT(123)=9 + ENDIF + +C...Set up kinematics of process. + CALL PYINKI(0) + +C...Set up kinematics for photons inside leptons. + IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(1,WTGAGA) + +C...Precalculate flavour selection weights. + CALL PYKFIN + +C...Loop over gamma-p or gamma-gamma alternatives. + CKIN3=CKIN(3) + MSAV48=0 + DO 160 IGA=1,MINT(121) + CKIN(3)=CKIN3 + MINT(122)=IGA + +C...Select partonic subprocesses to be included in the simulation. + CALL PYINPR + MINT(101)=1 + MINT(102)=1 + MINT(103)=MINT(11) + MINT(104)=MINT(12) + +C...Count number of subprocesses on. + MINT(48)=0 + DO 130 ISUB=1,500 + IF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND. + & MSUB(ISUB).EQ.1.AND.MINT(121).GT.1) THEN + MSUB(ISUB)=0 + ELSEIF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND. + & MSUB(ISUB).EQ.1) THEN + WRITE(MSTU(11),5200) ISUB,CHLH(MINT(41)),CHLH(MINT(42)) + CALL PYSTOP(1) + ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).EQ.-1) THEN + WRITE(MSTU(11),5300) ISUB + CALL PYSTOP(1) + ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).LE.-2) THEN + WRITE(MSTU(11),5400) ISUB + CALL PYSTOP(1) + ELSEIF(MSUB(ISUB).EQ.1) THEN + MINT(48)=MINT(48)+1 + ENDIF + 130 CONTINUE + +C...Stop or raise warning flag if no subprocesses on. + IF(MINT(121).EQ.1.AND.MINT(48).EQ.0) THEN + IF(MSTP(127).NE.1) THEN + WRITE(MSTU(11),5500) + CALL PYSTOP(1) + ELSE + WRITE(MSTU(11),5700) + MSTI(53)=1 + ENDIF + ENDIF + MINT(49)=MINT(48)-MSUB(91)-MSUB(92)-MSUB(93)-MSUB(94) + MSAV48=MSAV48+MINT(48) + +C...Reset variables for cross-section calculation. + DO 150 I=0,500 + DO 140 J=1,3 + NGEN(I,J)=0 + XSEC(I,J)=0D0 + 140 CONTINUE + 150 CONTINUE + +C...Find parametrized total cross-sections. + CALL PYXTOT + VINT(318)=VINT(317) + +C...Maxima of differential cross-sections. + IF(MSTP(121).LE.1) CALL PYMAXI + +C...Initialize possibility of pileup events. + IF(MINT(121).GT.1) MSTP(131)=0 + IF(MSTP(131).NE.0) CALL PYPILE(1) + +C...Initialize multiple interactions with variable impact parameter. + IF(MINT(50).EQ.1) THEN + PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) + IF(MOD(MSTP(81),10).EQ.0.AND.(CKIN(3).GT.PTMN.OR. + & ((MSEL.NE.1.AND.MSEL.NE.2)))) MSTP(82)=MIN(1,MSTP(82)) + IF((MINT(49).NE.0.OR.MSTP(131).NE.0).AND.MSTP(82).GE.2) THEN + MINT(35)=1 + CALL PYMULT(1) + MINT(35)=3 + CALL PYMIGN(1) + ENDIF + ENDIF + +C...Save results for gamma-p and gamma-gamma alternatives. + IF(MINT(121).GT.1) CALL PYSAVE(1,IGA) + 160 CONTINUE + +C...Initialization finished. + IF(MSAV48.EQ.0) THEN + IF(MSTP(127).NE.1) THEN + WRITE(MSTU(11),5500) + CALL PYSTOP(1) + ELSE + WRITE(MSTU(11),5700) + MSTI(53)=1 + ENDIF + ENDIF + 170 IF(MSTP(122).GE.1) WRITE(MSTU(11),5600) + +C...Formats for initialization information. + 5100 FORMAT('1',18('*'),1X,'PYINIT: initialization of PYTHIA ', + &'routines',1X,17('*')) + 5200 FORMAT(1X,'Error: process number ',I3,' not meaningful for ',A6, + &'-',A6,' interactions.'/1X,'Execution stopped!') + 5300 FORMAT(1X,'Error: requested subprocess',I4,' not implemented.'/ + &1X,'Execution stopped!') + 5400 FORMAT(1X,'Error: requested subprocess',I4,' not existing.'/ + &1X,'Execution stopped!') + 5500 FORMAT(1X,'Error: no subprocess switched on.'/ + &1X,'Execution stopped.') + 5600 FORMAT(/1X,22('*'),1X,'PYINIT: initialization completed',1X, + &22('*')) + 5700 FORMAT(1X,'Error: no subprocess switched on.'/ + &1X,'Execution will stop if you try to generate events.') + + RETURN + END + +C********************************************************************* + +C...PYEVNT +C...Administers the generation of a high-pT event via calls to +C...a number of subroutines. + + SUBROUTINE PYEVNT + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP + PARAMETER (MAXNUR=1000) +C...Commonblocks. + COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR) + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYCTAG/NCT,MCT(4000,2) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + SAVE /PYJETS/,/PYDAT1/,/PYCTAG/,/PYDAT2/,/PYDAT3/,/PYPARS/, + &/PYINT1/,/PYINT2/,/PYINT4/,/PYINT5/ +C...Local array. + DIMENSION VTX(4) + +C...Optionally let PYEVNW do the whole job. + IF(MSTP(81).GE.20) THEN + CALL PYEVNW + RETURN + ENDIF + +C...Stop if no subprocesses on. + IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN + WRITE(MSTU(11),5100) + CALL PYSTOP(1) + ENDIF + +C...Initial values for some counters. + MSTU(1)=0 + MSTU(2)=0 + N=0 + MINT(5)=MINT(5)+1 + MINT(7)=0 + MINT(8)=0 + MINT(30)=0 + MINT(83)=0 + MINT(84)=MSTP(126) + MSTU(24)=0 + MSTU70=0 + MSTJ14=MSTJ(14) +C...Normally, use K(I,4:5) colour info rather than /PYCTAG/. + NCT=0 + MINT(33)=0 + +C...Let called routines know call is from PYEVNT (not PYEVNW). + MINT(35)=1 + IF (MSTP(81).GE.10) MINT(35)=2 + +C...If variable energies: redo incoming kinematics and cross-section. + MSTI(61)=0 + IF(MSTP(171).EQ.1) THEN + CALL PYINKI(1) + IF(MSTI(61).EQ.1) THEN + MINT(5)=MINT(5)-1 + RETURN + ENDIF + IF(MINT(121).GT.1) CALL PYSAVE(3,1) + CALL PYXTOT + ENDIF + +C...Loop over number of pileup events; check space left. + IF(MSTP(131).LE.0) THEN + NPILE=1 + ELSE + CALL PYPILE(2) + NPILE=MINT(81) + ENDIF + DO 270 IPILE=1,NPILE + IF(MINT(84)+100.GE.MSTU(4)) THEN + CALL PYERRM(11, + & '(PYEVNT:) no more space in PYJETS for pileup events') + IF(MSTU(21).GE.1) GOTO 280 + ENDIF + MINT(82)=IPILE + +C...Generate variables of hard scattering. + MINT(51)=0 + MSTI(52)=0 + 100 CONTINUE + IF(MINT(51).NE.0.OR.MSTU(24).NE.0) MSTI(52)=MSTI(52)+1 + MINT(31)=0 + MINT(39)=0 + MINT(51)=0 + MINT(57)=0 + CALL PYRAND + IF(MSTI(61).EQ.1) THEN + MINT(5)=MINT(5)-1 + RETURN + ENDIF + IF(MINT(51).EQ.2) RETURN + ISUB=MINT(1) + IF(MSTP(111).EQ.-1) GOTO 260 + +C...Loopback point if PYPREP fails, especially for junction topologies. + NPREP=0 + MNT31S=MINT(31) + 110 NPREP=NPREP+1 + MINT(31)=MNT31S + + IF((ISUB.LE.90.OR.ISUB.GE.95).AND.ISUB.NE.99) THEN +C...Hard scattering (including low-pT): +C...reconstruct kinematics and colour flow of hard scattering. + MINT31=MINT(31) + 120 MINT(31)=MINT31 + MINT(51)=0 + CALL PYSCAT + IF(MINT(51).EQ.1) GOTO 100 + IPU1=MINT(84)+1 + IPU2=MINT(84)+2 + IF(ISUB.EQ.95) GOTO 140 + +C...Reset statistics on activity in event. + DO 130 J=351,359 + MINT(J)=0 + VINT(J)=0D0 + 130 CONTINUE + +C...Showering of initial state partons (optional). + NFIN=N + ALAMSV=PARJ(81) + PARJ(81)=PARP(72) + IF(MSTP(61).GE.1.AND.MINT(47).GE.2.AND.MINT(111).NE.12) + & CALL PYSSPA(IPU1,IPU2) + PARJ(81)=ALAMSV + IF(MINT(51).EQ.1) GOTO 100 + +C...pT-ordered FSR off ISR (optional, must have at least 2 partons) + IF (NPART.GE.2.AND.(MSTJ(41).EQ.11.OR.MSTJ(41).EQ.12)) THEN + PTMAX=0.5*SQRT(PARP(71))*VINT(55) + CALL PYPTFS(3,PTMAX,0D0,PTGEN) + ENDIF + +C...Showering of final state partons (optional). + ALAMSV=PARJ(81) + PARJ(81)=PARP(72) + IF(MSTP(71).GE.1.AND.ISET(ISUB).GE.2.AND.ISET(ISUB).LE.10) + & THEN + IPU3=MINT(84)+3 + IPU4=MINT(84)+4 + IF(ISET(ISUB).EQ.5) IPU4=-3 + QMAX=VINT(55) + IF(ISET(ISUB).EQ.2) QMAX=SQRT(PARP(71))*VINT(55) + CALL PYSHOW(IPU3,IPU4,QMAX) + ELSEIF(ISET(ISUB).EQ.11) THEN + CALL PYADSH(NFIN) + ENDIF + PARJ(81)=ALAMSV + +C...Allow possibility for user to abort event generation. + IVETO=0 + IF(IPILE.EQ.1.AND.MSTP(143).EQ.1) CALL PYVETO(IVETO) + IF(IVETO.EQ.1) GOTO 100 + +C...Decay of final state resonances. + MINT(32)=0 + IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10) CALL PYRESD(0) + IF(MINT(51).EQ.1) GOTO 100 + MINT(52)=N + + +C...Multiple interactions - PYTHIA 6.3 intermediate style. + 140 IF(MSTP(81).GE.10.AND.MINT(50).EQ.1) THEN + IF(ISUB.EQ.95) MINT(31)=MINT(31)+1 + CALL PYMIGN(6) + IF(MINT(51).EQ.1) GOTO 100 + MINT(53)=N + +C...Beam remnant flavour and colour assignments - new scheme. + CALL PYMIHK + IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) + & GOTO 120 + IF(MINT(51).EQ.1) GOTO 100 + +C...Primordial kT and beam remnant momentum sharing - new scheme. + CALL PYMIRM + IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) + & GOTO 120 + IF(MINT(51).EQ.1) GOTO 100 + IF(ISUB.EQ.95) MINT(31)=MINT(31)-1 + +C...Multiple interactions - PYTHIA 6.2 style. + ELSEIF(MINT(111).NE.12) THEN + IF (MSTP(81).GE.1.AND.MINT(50).EQ.1.AND.ISUB.NE.95) THEN + CALL PYMULT(6) + MINT(53)=N + ENDIF + +C...Hadron remnants and primordial kT. + CALL PYREMN(IPU1,IPU2) + IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) GOTO + & 110 + IF(MINT(51).EQ.1) GOTO 100 + ENDIF + + ELSEIF(ISUB.NE.99) THEN +C...Diffractive and elastic scattering. + CALL PYDIFF + + ELSE +C...DIS scattering (photon flux external). + CALL PYDISG + IF(MINT(51).EQ.1) GOTO 100 + ENDIF + +C...Check that no odd resonance left undecayed. + MINT(54)=N + IF(MSTP(111).GE.1) THEN + NFIX=N + DO 150 I=MINT(84)+1,NFIX + IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND. + & K(I,2).NE.22) THEN + KCA=PYCOMP(K(I,2)) + IF(MWID(KCA).NE.0.AND.MDCY(KCA,1).GE.1) THEN + CALL PYRESD(I) + IF(MINT(51).EQ.1) GOTO 100 + ENDIF + ENDIF + 150 CONTINUE + ENDIF + +C...Boost hadronic subsystem to overall rest frame. +C..(Only relevant when photon inside lepton beam.) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(4,WTGAGA) + +C...Recalculate energies from momenta and masses (if desired). + IF(MSTP(113).GE.1) THEN + DO 160 I=MINT(83)+1,N + IF(K(I,1).GT.0.AND.K(I,1).LE.10) P(I,4)=SQRT(P(I,1)**2+ + & P(I,2)**2+P(I,3)**2+P(I,5)**2) + 160 CONTINUE + NRECAL=N + ENDIF + +C...Colour reconnection before string formation + IF (MSTP(95).GE.2) CALL PYFSCR(MINT(84)+1) + +C...Rearrange partons along strings, check invariant mass cuts. + MSTU(28)=0 + IF(MSTP(111).LE.0) MSTJ(14)=-1 + CALL PYPREP(MINT(84)+1) + MSTJ(14)=MSTJ14 + IF(MINT(51).EQ.1.AND.MSTU(24).EQ.1) THEN + MSTU(24)=0 + GOTO 100 + ENDIF + IF (MINT(51).EQ.1.AND.NPREP.LE.5) GOTO 110 + IF (MINT(51).EQ.1) GOTO 100 + IF(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100 + IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN + DO 190 I=MINT(84)+1,N + IF(K(I,2).EQ.94) THEN + DO 180 I1=I+1,MIN(N,I+10) + IF(K(I1,3).EQ.I) THEN + K(I1,3)=MOD(K(I1,4)/MSTU(5),MSTU(5)) + IF(K(I1,3).EQ.0) THEN + DO 170 II=MINT(84)+1,I-1 + IF(K(II,2).EQ.K(I1,2)) THEN + IF(MOD(K(II,4),MSTU(5)).EQ.I1.OR. + & MOD(K(II,5),MSTU(5)).EQ.I1) K(I1,3)=II + ENDIF + 170 CONTINUE + IF(K(I+1,3).EQ.0) K(I+1,3)=K(I,3) + ENDIF + ENDIF + 180 CONTINUE + ENDIF + 190 CONTINUE + CALL PYEDIT(12) + CALL PYEDIT(14) + IF(MSTP(125).EQ.0) CALL PYEDIT(15) + IF(MSTP(125).EQ.0) MINT(4)=0 + DO 210 I=MINT(83)+1,N + IF(K(I,1).EQ.11.AND.K(I,4).EQ.0.AND.K(I,5).EQ.0) THEN + DO 200 I1=I+1,N + IF(K(I1,3).EQ.I.AND.K(I,4).EQ.0) K(I,4)=I1 + IF(K(I1,3).EQ.I) K(I,5)=I1 + 200 CONTINUE + ENDIF + 210 CONTINUE + ENDIF + +C...Introduce separators between sections in PYLIST event listing. + IF(IPILE.EQ.1.AND.MSTP(125).LE.0) THEN + MSTU70=1 + MSTU(71)=N + ELSEIF(IPILE.EQ.1) THEN + MSTU70=3 + MSTU(71)=2 + MSTU(72)=MINT(4) + MSTU(73)=N + ENDIF + +C...Go back to lab frame (needed for vertices, also in fragmentation). + CALL PYFRAM(1) + +C...Set nonvanishing production vertex (optional). + IF(MSTP(151).EQ.1) THEN + DO 220 J=1,4 + VTX(J)=PARP(150+J)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0))))* + & SIN(PARU(2)*PYR(0)) + 220 CONTINUE + DO 240 I=MINT(83)+1,N + DO 230 J=1,4 + V(I,J)=V(I,J)+VTX(J) + 230 CONTINUE + 240 CONTINUE + ENDIF + +C...Perform hadronization (if desired). + IF(MSTP(111).GE.1) THEN + CALL PYEXEC + IF(MSTU(24).NE.0) GOTO 100 + ENDIF + IF(MSTP(113).GE.1) THEN + DO 250 I=NRECAL,N + IF(P(I,5).GT.0D0) P(I,4)=SQRT(P(I,1)**2+ + & P(I,2)**2+P(I,3)**2+P(I,5)**2) + 250 CONTINUE + ENDIF + IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) CALL PYEDIT(14) + +C...Store event information and calculate Monte Carlo estimates of +C...subprocess cross-sections. + 260 IF(IPILE.EQ.1) CALL PYDOCU + +C...Set counters for current pileup event and loop to next one. + MSTI(41)=IPILE + IF(IPILE.GE.2.AND.IPILE.LE.10) MSTI(40+IPILE)=ISUB + IF(MSTU70.LT.10) THEN + MSTU70=MSTU70+1 + MSTU(70+MSTU70)=N + ENDIF + MINT(83)=N + MINT(84)=N+MSTP(126) + IF(IPILE.LT.NPILE) CALL PYFRAM(2) + 270 CONTINUE + +C...Generic information on pileup events. Reconstruct missing history. + IF(MSTP(131).EQ.1.AND.MSTP(133).GE.1) THEN + PARI(91)=VINT(132) + PARI(92)=VINT(133) + PARI(93)=VINT(134) + IF(MSTP(133).GE.2) PARI(93)=PARI(93)*XSEC(0,3)/VINT(131) + ENDIF + CALL PYEDIT(16) + +C...Transform to the desired coordinate frame. + 280 CALL PYFRAM(MSTP(124)) + MSTU(70)=MSTU70 + PARU(21)=VINT(1) + +C...Error messages + 5100 FORMAT(1X,'Error: no subprocess switched on.'/ + &1X,'Execution stopped.') + + RETURN + END + +C********************************************************************* + +C...PYEVNW +C...Administers the generation of a high-pT event via calls to +C...a number of subroutines for the new multiple interactions and +C...showering framework. + + SUBROUTINE PYEVNW + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP + PARAMETER (MAXNUR=1000) +C...Commonblocks. + COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR) +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYCTAG/NCT,MCT(4000,2) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINTM/KFIVAL(2,3),NMI(2),IMI(2,800,2),NVC(2,-6:6), + & XASSOC(2,-6:6,240),XPSVC(-6:6,-1:240),PVCTOT(2,-1:1), + & XMI(2,240),PT2MI(240),IMISEP(0:240) + SAVE /PYJETS/,/PYCTAG/,/PYDAT1/,/PYDAT2/,/PYDAT3/, + & /PYPARS/,/PYINT1/,/PYINT2/,/PYINT4/,/PYINT5/,/PYINTM/ +C...Local arrays. + DIMENSION VTX(4) + +C...Stop if no subprocesses on. + IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN + WRITE(MSTU(11),5100) + CALL PYSTOP(1) + ENDIF + +C...Initial values for some counters. + MSTU(1)=0 + MSTU(2)=0 + N=0 + MINT(5)=MINT(5)+1 + MINT(7)=0 + MINT(8)=0 + MINT(30)=0 + MINT(83)=0 + MINT(84)=MSTP(126) + MSTU(24)=0 + MSTU70=0 + MSTJ14=MSTJ(14) +C...Normally, use K(I,4:5) colour info rather than /PYCT/. + NCT=0 + MINT(33)=0 +C...Zero counters for pT-ordered showers (failsafe) + NPART=0 + NPARTD=0 + +C...Let called routines know call is from PYEVNW (not PYEVNT). + MINT(35)=3 + +C...If variable energies: redo incoming kinematics and cross-section. + MSTI(61)=0 + IF(MSTP(171).EQ.1) THEN + CALL PYINKI(1) + IF(MSTI(61).EQ.1) THEN + MINT(5)=MINT(5)-1 + RETURN + ENDIF + IF(MINT(121).GT.1) CALL PYSAVE(3,1) + CALL PYXTOT + ENDIF + +C...Loop over number of pileup events; check space left. + IF(MSTP(131).LE.0) THEN + NPILE=1 + ELSE + CALL PYPILE(2) + NPILE=MINT(81) + ENDIF + DO 300 IPILE=1,NPILE + IF(MINT(84)+100.GE.MSTU(4)) THEN + CALL PYERRM(11, + & '(PYEVNW:) no more space in PYJETS for pileup events') + IF(MSTU(21).GE.1) GOTO 310 + ENDIF + MINT(82)=IPILE + +C...Generate variables of hard scattering. + MINT(51)=0 + MSTI(52)=0 + LOOPHS =0 + 100 CONTINUE + LOOPHS = LOOPHS + 1 + IF(MINT(51).NE.0.OR.MSTU(24).NE.0) MSTI(52)=MSTI(52)+1 + IF(LOOPHS.GE.10) THEN + CALL PYERRM(19,'(PYEVNW:) failed to evolve shower or ' + & //'multiple interactions. Returning.') + MINT(51)=1 + RETURN + ENDIF + MINT(31)=0 + MINT(39)=0 + MINT(36)=0 + MINT(51)=0 + MINT(57)=0 + CALL PYRAND + IF(MSTI(61).EQ.1) THEN + MINT(5)=MINT(5)-1 + RETURN + ENDIF + IF(MINT(51).EQ.2) RETURN + ISUB=MINT(1) + IF(MSTP(111).EQ.-1) GOTO 290 + +C...Loopback point if PYPREP fails, especially for junction topologies. + NPREP=0 + MNT31S=MINT(31) + 110 NPREP=NPREP+1 + MINT(31)=MNT31S + + IF((ISUB.LE.90.OR.ISUB.GE.95).AND.ISUB.NE.99) THEN +C...Hard scattering (including low-pT): +C...reconstruct kinematics and colour flow of hard scattering. + MINT31=MINT(31) + 120 MINT(31)=MINT31 + MINT(51)=0 + CALL PYSCAT + IF(MINT(51).EQ.1) GOTO 100 + NPARTD=N + NFIN=N + +C...Intertwined initial state showers and multiple interactions. +C...Force no IS showers if no pdfs defined: MSTP(61) -> 0 for PYEVOL. +C...Force no MI if cross section not known: MSTP(81) -> 0 for PYEVOL. + MSTP61=MSTP(61) + IF (MINT(47).LT.2) MSTP(61)=0 + MSTP81=MSTP(81) + IF (MINT(50).EQ.0) MSTP(81)=0 + IF ((MSTP(61).GE.1.OR.MOD(MSTP(81),10).GE.0).AND. + & MINT(111).NE.12) THEN +C...Absolute max pT2 scale for evolution: phase space limit. + PT2MXS=0.25D0*VINT(2) +C...Check if more constrained by ISR and MI max scales: + PT2MXS=MIN(PT2MXS,MAX(VINT(56),VINT(62))) +C...Loopback point in case of failure in evolution. + LOOP=0 + 130 LOOP=LOOP+1 + MINT(51)=0 + IF(LOOP.GT.100) THEN + CALL PYERRM(9,'(PYEVNW:) failed to evolve shower or ' + & //'multiple interactions. Trying new point.') + MINT(51)=1 + RETURN + ENDIF + +C...Pre-initialization of interleaved MI/ISR/JI evolution, only done +C...once per event. (E.g. compute constants and save variables to be +C...restored later in case of failure.) + IF (LOOP.EQ.1) CALL PYEVOL(-1,DUMMY1,DUMMY2) + +C...Initialize interleaved MI/ISR/JI evolution. +C...PT2MAX: absolute upper limit for evolution - Initialization may +C... return a PT2MAX which is lower than this. +C...PT2MIN: absolute lower limit for evolution - Initialization may +C... return a PT2MIN which is larger than this (e.g. Lambda_QCD). + PT2MAX=PT2MXS + PT2MIN=0D0 + CALL PYEVOL(0,PT2MAX,PT2MIN) +C...If failed to initialize evolution, generate a new hard process + IF (MINT(51).EQ.1) GOTO 100 + +C...Perform interleaved MI/ISR/JI evolution from PT2MAX to PT2MIN. +C...In principle factorized, so can be stopped and restarted. +C...Example: stop/start at pT=10 GeV. (Commented out for now.) +C PT2MED=MAX(10D0**2,PT2MIN) +C CALL PYEVOL(1,PT2MAX,PT2MED) +C IF (MINT(51).EQ.1) GOTO 160 +C PT2MAX=PT2MED + CALL PYEVOL(1,PT2MAX,PT2MIN) +C...If fatal error (e.g., massive hard-process initiator, but no available +C...phase space for creation), generate a new hard process + IF (MINT(51).EQ.2) GOTO 100 +C...If smaller error, just try running evolution again + IF (MINT(51).EQ.1) GOTO 130 + +C...Finalize interleaved MI/ISR/JI evolution. + CALL PYEVOL(2,PT2MAX,PT2MIN) + IF (MINT(51).EQ.1) GOTO 130 + + ENDIF + MSTP(61)=MSTP61 + MSTP(81)=MSTP81 + IF(MINT(51).EQ.1) GOTO 100 +C...(MINT(52) is actually obsolete in this routine. Set anyway +C...to ensure PYDOCU stable.) + MINT(52)=N + MINT(53)=N + +C...Beam remnants - new scheme. + 140 IF(MINT(50).EQ.1) THEN + IF (ISUB.EQ.95) MINT(31)=1 + +C...Beam remnant flavour and colour assignments - new scheme. + CALL PYMIHK + IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) + & GOTO 120 + IF(MINT(51).EQ.1) GOTO 100 + +C...Primordial kT and beam remnant momentum sharing - new scheme. + CALL PYMIRM + IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) + & GOTO 120 + IF(MINT(51).EQ.1) GOTO 100 + IF (ISUB.EQ.95) MINT(31)=0 + ELSEIF(MINT(111).NE.12) THEN +C...Hadron remnants and primordial kT - old model. +C...Happens e.g. for direct photon on one side. + IPU1=IMI(1,1,1) + IPU2=IMI(2,1,1) + CALL PYREMN(IPU1,IPU2) + IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) GOTO + & 110 + IF(MINT(51).EQ.1) GOTO 100 +C...PYREMN does not set colour tags for BRs, so needs to be done now. + DO 160 I=MINT(53)+1,N + DO 150 KCS=4,5 + IDA=MOD(K(I,KCS),MSTU(5)) + IF (IDA.NE.0) THEN + MCT(I,KCS-3)=MCT(IDA,6-KCS) + ELSE + MCT(I,KCS-3)=0 + ENDIF + 150 CONTINUE + 160 CONTINUE +C...Instruct PYPREP to use colour tags + MINT(33)=1 + + DO 360 MQGST=1,2 + DO 350 I=MINT(84)+1,N + +C...Look for coloured string endpoint, or (later) leftover gluon. + IF (K(I,1).NE.3) GOTO 350 + KC=PYCOMP(K(I,2)) + IF(KC.EQ.0) GOTO 350 + KQ=KCHG(KC,2) + IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 350 + +C... Pick up loose string end with no previous tag. + KCS=4 + IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5 + IF(MCT(I,KCS-3).NE.0) GOTO 350 + + CALL PYCTTR(I,KCS,I) + IF(MINT(51).NE.0) RETURN + + 350 CONTINUE + 360 CONTINUE +C...Now delete any colour processing information if set (since partons +C...otherwise not FS showered!) + DO 170 I=MINT(84)+1,N + IF (I.LE.N) THEN + K(I,4)=MOD(K(I,4),MSTU(5)**2) + K(I,5)=MOD(K(I,5),MSTU(5)**2) + ENDIF + 170 CONTINUE + ENDIF + +C...Showering of final state partons (optional). + ALAMSV=PARJ(81) + PARJ(81)=PARP(72) + IF(MSTP(71).GE.1.AND.ISET(ISUB).GE.1.AND.ISET(ISUB).LE.10) + & THEN + QMAX=VINT(55) + IF(ISET(ISUB).EQ.2) QMAX=SQRT(PARP(71))*VINT(55) + CALL PYPTFS(1,QMAX,0D0,PTGEN) +C...External processes: handle successive showers. + ELSEIF(ISET(ISUB).EQ.11) THEN + CALL PYADSH(NFIN) + ENDIF + PARJ(81)=ALAMSV + +C...Allow possibility for user to abort event generation. + IVETO=0 + IF(IPILE.EQ.1.AND.MSTP(143).EQ.1) CALL PYVETO(IVETO) ! sm + IF(IVETO.EQ.1) THEN +C...........No reason to count this as an error + LOOPHS = LOOPHS-1 + GOTO 100 + ENDIF + + +C...Decay of final state resonances. + MINT(32)=0 + IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10) THEN + CALL PYRESD(0) + IF(MINT(51).NE.0) GOTO 100 + ENDIF + + IF(MINT(51).EQ.1) GOTO 100 + + ELSEIF(ISUB.NE.99) THEN +C...Diffractive and elastic scattering. + CALL PYDIFF + + ELSE +C...DIS scattering (photon flux external). + CALL PYDISG + IF(MINT(51).EQ.1) GOTO 100 + ENDIF + +C...Check that no odd resonance left undecayed. + MINT(54)=N + IF(MSTP(111).GE.1) THEN + NFIX=N + DO 180 I=MINT(84)+1,NFIX + IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND. + & K(I,2).NE.22) THEN + KCA=PYCOMP(K(I,2)) + IF(MWID(KCA).NE.0.AND.MDCY(KCA,1).GE.1) THEN + CALL PYRESD(I) + IF(MINT(51).EQ.1) GOTO 100 + ENDIF + ENDIF + 180 CONTINUE + ENDIF + +C...Boost hadronic subsystem to overall rest frame. +C..(Only relevant when photon inside lepton beam.) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(4,WTGAGA) + +C...Recalculate energies from momenta and masses (if desired). + IF(MSTP(113).GE.1) THEN + DO 190 I=MINT(83)+1,N + IF(K(I,1).GT.0.AND.K(I,1).LE.10) P(I,4)=SQRT(P(I,1)**2+ + & P(I,2)**2+P(I,3)**2+P(I,5)**2) + 190 CONTINUE + NRECAL=N + ENDIF + +C...Colour reconnection before string formation + CALL PYFSCR(MINT(84)+1) + +C...Rearrange partons along strings, check invariant mass cuts. + MSTU(28)=0 + IF(MSTP(111).LE.0) MSTJ(14)=-1 + CALL PYPREP(MINT(84)+1) + MSTJ(14)=MSTJ14 + IF(MINT(51).EQ.1.AND.MSTU(24).EQ.1) THEN + MSTU(24)=0 + GOTO 100 + ENDIF + IF(MINT(51).EQ.1) GOTO 110 + IF(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100 + IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN + DO 220 I=MINT(84)+1,N + IF(K(I,2).EQ.94) THEN + DO 210 I1=I+1,MIN(N,I+10) + IF(K(I1,3).EQ.I) THEN + K(I1,3)=MOD(K(I1,4)/MSTU(5),MSTU(5)) + IF(K(I1,3).EQ.0) THEN + DO 200 II=MINT(84)+1,I-1 + IF(K(II,2).EQ.K(I1,2)) THEN + IF(MOD(K(II,4),MSTU(5)).EQ.I1.OR. + & MOD(K(II,5),MSTU(5)).EQ.I1) K(I1,3)=II + ENDIF + 200 CONTINUE + IF(K(I+1,3).EQ.0) K(I+1,3)=K(I,3) + ENDIF + ENDIF + 210 CONTINUE +CC...Also collapse particles decaying to themselves (if same KS) + ELSEIF (K(I,1).GT.0.AND.K(I,4).EQ.K(I,5).AND.K(I,4).GT.0 + & .AND.K(I,4).LT.N) THEN + IDA=K(I,4) + IF (K(IDA,1).EQ.K(I,1).AND.K(IDA,2).EQ.K(I,2)) THEN + K(I,1)=0 + ENDIF + ENDIF + 220 CONTINUE + CALL PYEDIT(12) + CALL PYEDIT(14) + IF(MSTP(125).EQ.0) CALL PYEDIT(15) + IF(MSTP(125).EQ.0) MINT(4)=0 + DO 240 I=MINT(83)+1,N + IF(K(I,1).EQ.11.AND.K(I,4).EQ.0.AND.K(I,5).EQ.0) THEN + DO 230 I1=I+1,N + IF(K(I1,3).EQ.I.AND.K(I,4).EQ.0) K(I,4)=I1 + IF(K(I1,3).EQ.I) K(I,5)=I1 + 230 CONTINUE + ENDIF + 240 CONTINUE + ENDIF + +C...Introduce separators between sections in PYLIST event listing. + IF(IPILE.EQ.1.AND.MSTP(125).LE.0) THEN + MSTU70=1 + MSTU(71)=N + ELSEIF(IPILE.EQ.1) THEN + MSTU70=3 + MSTU(71)=2 + MSTU(72)=MINT(4) + MSTU(73)=N + ENDIF + +C...Go back to lab frame (needed for vertices, also in fragmentation). + CALL PYFRAM(1) + +C...Set nonvanishing production vertex (optional). + IF(MSTP(151).EQ.1) THEN + DO 250 J=1,4 + VTX(J)=PARP(150+J)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0))))* + & SIN(PARU(2)*PYR(0)) + 250 CONTINUE + DO 270 I=MINT(83)+1,N + DO 260 J=1,4 + V(I,J)=V(I,J)+VTX(J) + 260 CONTINUE + 270 CONTINUE + ENDIF + +C...Perform hadronization (if desired). + IF(MSTP(111).GE.1) THEN + CALL PYEXEC + IF(MSTU(24).NE.0) GOTO 100 + ENDIF + IF(MSTP(113).GE.1) THEN + DO 280 I=NRECAL,N + IF(P(I,5).GT.0D0) P(I,4)=SQRT(P(I,1)**2+ + & P(I,2)**2+P(I,3)**2+P(I,5)**2) + 280 CONTINUE + ENDIF + IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) CALL PYEDIT(14) + +C...Store event information and calculate Monte Carlo estimates of +C...subprocess cross-sections. + 290 IF(IPILE.EQ.1) CALL PYDOCU + +C...Set counters for current pileup event and loop to next one. + MSTI(41)=IPILE + IF(IPILE.GE.2.AND.IPILE.LE.10) MSTI(40+IPILE)=ISUB + IF(MSTU70.LT.10) THEN + MSTU70=MSTU70+1 + MSTU(70+MSTU70)=N + ENDIF + MINT(83)=N + MINT(84)=N+MSTP(126) + IF(IPILE.LT.NPILE) CALL PYFRAM(2) + 300 CONTINUE + +C...Generic information on pileup events. Reconstruct missing history. + IF(MSTP(131).EQ.1.AND.MSTP(133).GE.1) THEN + PARI(91)=VINT(132) + PARI(92)=VINT(133) + PARI(93)=VINT(134) + IF(MSTP(133).GE.2) PARI(93)=PARI(93)*XSEC(0,3)/VINT(131) + ENDIF + CALL PYEDIT(16) + +C...Transform to the desired coordinate frame. + 310 CALL PYFRAM(MSTP(124)) + MSTU(70)=MSTU70 + PARU(21)=VINT(1) + +C...Error messages + 5100 FORMAT(1X,'Error: no subprocess switched on.'/ + &1X,'Execution stopped.') + + RETURN + END + + +C*********************************************************************** + +C...PYSTAT +C...Prints out information about cross-sections, decay widths, branching +C...ratios, kinematical limits, status codes and parameter values. + + SUBROUTINE PYSTAT(MSTAT) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement to help give large particle numbers. + PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, + &KEXCIT=4000000,KDIMEN=5000000) + PARAMETER (EPS=1D-3) +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINT6/PROC(0:500) + CHARACTER PROC*28, CHTMP*16 + COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) + COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) + SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, + &/PYINT2/,/PYINT4/,/PYINT5/,/PYINT6/,/PYMSSM/,/PYMSRV/ +C...Local arrays, character variables and data. + DIMENSION WDTP(0:400),WDTE(0:400,0:5),NMODES(0:20),PBRAT(10) + CHARACTER PROGA(6)*28,CHAU*16,CHKF*16,CHD1*16,CHD2*16,CHD3*16, + &CHIN(2)*12,STATE(-1:5)*4,CHKIN(21)*18,DISGA(2)*28, + &PROGG9(13)*28,PROGG4(4)*28,PROGG2(2)*28,PROGP4(4)*28 + CHARACTER*24 CHD0, CHDC(10) + CHARACTER*6 DNAME(3) + DATA PROGA/ + &'VMD/hadron * VMD ','VMD/hadron * direct ', + &'VMD/hadron * anomalous ','direct * direct ', + &'direct * anomalous ','anomalous * anomalous '/ + DATA DISGA/'e * VMD','e * anomalous'/ + DATA PROGG9/ + &'direct * direct ','direct * VMD ', + &'direct * anomalous ','VMD * direct ', + &'VMD * VMD ','VMD * anomalous ', + &'anomalous * direct ','anomalous * VMD ', + &'anomalous * anomalous ','DIS * VMD ', + &'DIS * anomalous ','VMD * DIS ', + &'anomalous * DIS '/ + DATA PROGG4/ + &'direct * direct ','direct * resolved ', + &'resolved * direct ','resolved * resolved '/ + DATA PROGG2/ + &'direct * hadron ','resolved * hadron '/ + DATA PROGP4/ + &'VMD * hadron ','direct * hadron ', + &'anomalous * hadron ','DIS * hadron '/ + DATA STATE/'----','off ','on ','on/+','on/-','on/1','on/2'/, + &CHKIN/' m_hard (GeV/c^2) ',' p_T_hard (GeV/c) ', + &'m_finite (GeV/c^2)',' y*_subsystem ',' y*_large ', + &' y*_small ',' eta*_large ',' eta*_small ', + &'cos(theta*)_large ','cos(theta*)_small ',' x_1 ', + &' x_2 ',' x_F ',' cos(theta_hard) ', + &'m''_hard (GeV/c^2) ',' tau ',' y* ', + &'cos(theta_hard^-) ','cos(theta_hard^+) ',' x_T^2 ', + &' tau'' '/ + DATA DNAME /'q ','lepton','nu '/ + +C...Cross-sections. + IF(MSTAT.LE.1) THEN + IF(MINT(121).GT.1) CALL PYSAVE(5,0) + WRITE(MSTU(11),5000) + WRITE(MSTU(11),5100) + WRITE(MSTU(11),5200) 0,PROC(0),NGEN(0,3),NGEN(0,1),XSEC(0,3) + DO 100 I=1,500 + IF(MSUB(I).NE.1) GOTO 100 + WRITE(MSTU(11),5200) I,PROC(I),NGEN(I,3),NGEN(I,1),XSEC(I,3) + 100 CONTINUE + IF(MINT(121).GT.1) THEN + WRITE(MSTU(11),5300) + DO 110 IGA=1,MINT(121) + CALL PYSAVE(3,IGA) + IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN + WRITE(MSTU(11),5200) IGA,DISGA(IGA),NGEN(0,3),NGEN(0,1), + & XSEC(0,3) + ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN + WRITE(MSTU(11),5200) IGA,PROGG9(IGA),NGEN(0,3),NGEN(0,1), + & XSEC(0,3) + ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.30) THEN + WRITE(MSTU(11),5200) IGA,PROGP4(IGA),NGEN(0,3),NGEN(0,1), + & XSEC(0,3) + ELSEIF(MINT(121).EQ.4) THEN + WRITE(MSTU(11),5200) IGA,PROGG4(IGA),NGEN(0,3),NGEN(0,1), + & XSEC(0,3) + ELSEIF(MINT(121).EQ.2) THEN + WRITE(MSTU(11),5200) IGA,PROGG2(IGA),NGEN(0,3),NGEN(0,1), + & XSEC(0,3) + ELSE + WRITE(MSTU(11),5200) IGA,PROGA(IGA),NGEN(0,3),NGEN(0,1), + & XSEC(0,3) + ENDIF + 110 CONTINUE + CALL PYSAVE(5,0) + ENDIF + WRITE(MSTU(11),5400) MSTU(23),MSTU(30),MSTU(27), + & 1D0-DBLE(NGEN(0,3))/MAX(1D0,DBLE(NGEN(0,2))) + +C...Decay widths and branching ratios. + ELSEIF(MSTAT.EQ.2) THEN + WRITE(MSTU(11),5500) + WRITE(MSTU(11),5600) + DO 140 KC=1,500 + KF=KCHG(KC,4) + CALL PYNAME(KF,CHKF) + IOFF=0 + IF(KC.LE.22) THEN + IF(KC.GT.2*MSTP(1).AND.KC.LE.10) GOTO 140 + IF(KC.GT.10+2*MSTP(1).AND.KC.LE.20) GOTO 140 + IF(KC.LE.5.OR.(KC.GE.11.AND.KC.LE.16)) IOFF=1 + IF(KC.EQ.18.AND.PMAS(18,1).LT.1D0) IOFF=1 + IF(KC.EQ.21.OR.KC.EQ.22) IOFF=1 + ELSE + IF(MWID(KC).LE.0) GOTO 140 + IF(IMSS(1).LE.0.AND.(KF/KSUSY1.EQ.1.OR. + & KF/KSUSY1.EQ.2)) GOTO 140 + ENDIF +C...Off-shell branchings. + IF(IOFF.EQ.1) THEN + NGP=0 + IF(KC.LE.20) NGP=(MOD(KC,10)+1)/2 + IF(NGP.LE.MSTP(1)) WRITE(MSTU(11),5700) KF,CHKF(1:10), + & PMAS(KC,1),0D0,0D0,STATE(MDCY(KC,1)),0D0 + DO 120 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + NGP1=0 + IF(IABS(KFDP(IDC,1)).LE.20) NGP1= + & (MOD(IABS(KFDP(IDC,1)),10)+1)/2 + NGP2=0 + IF(IABS(KFDP(IDC,2)).LE.20) NGP2= + & (MOD(IABS(KFDP(IDC,2)),10)+1)/2 + CALL PYNAME(KFDP(IDC,1),CHD1) + CALL PYNAME(KFDP(IDC,2),CHD2) + IF(KFDP(IDC,3).EQ.0) THEN + IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND. + & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5800) IDC,CHD1(1:10), + & CHD2(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0 + ELSE + CALL PYNAME(KFDP(IDC,3),CHD3) + IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND. + & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5900) IDC,CHD1(1:10), + & CHD2(1:10),CHD3(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0 + ENDIF + 120 CONTINUE +C...On-shell decays. + ELSE + CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE) + BRFIN=1D0 + IF(WDTE(0,0).LE.0D0) BRFIN=0D0 + WRITE(MSTU(11),5700) KF,CHKF(1:10),PMAS(KC,1),WDTP(0),1D0, + & STATE(MDCY(KC,1)),BRFIN + DO 130 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + NGP1=0 + IF(IABS(KFDP(IDC,1)).LE.20) NGP1= + & (MOD(IABS(KFDP(IDC,1)),10)+1)/2 + NGP2=0 + IF(IABS(KFDP(IDC,2)).LE.20) NGP2= + & (MOD(IABS(KFDP(IDC,2)),10)+1)/2 + BRPRI=0D0 + IF(WDTP(0).GT.0D0) BRPRI=WDTP(J)/WDTP(0) + BRFIN=0D0 + IF(WDTE(0,0).GT.0D0) BRFIN=WDTE(J,0)/WDTE(0,0) + CALL PYNAME(KFDP(IDC,1),CHD1) + CALL PYNAME(KFDP(IDC,2),CHD2) + IF(KFDP(IDC,3).EQ.0) THEN + IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1)) + & WRITE(MSTU(11),5800) IDC,CHD1(1:10), + & CHD2(1:10),WDTP(J),BRPRI, + & STATE(MDME(IDC,1)),BRFIN + ELSE + CALL PYNAME(KFDP(IDC,3),CHD3) + IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1)) + & WRITE(MSTU(11),5900) IDC,CHD1(1:10), + & CHD2(1:10),CHD3(1:10),WDTP(J),BRPRI, + & STATE(MDME(IDC,1)),BRFIN + ENDIF + 130 CONTINUE + ENDIF + 140 CONTINUE + WRITE(MSTU(11),6000) + +C...Allowed incoming partons/particles at hard interaction. + ELSEIF(MSTAT.EQ.3) THEN + WRITE(MSTU(11),6100) + CALL PYNAME(MINT(11),CHAU) + CHIN(1)=CHAU(1:12) + CALL PYNAME(MINT(12),CHAU) + CHIN(2)=CHAU(1:12) + WRITE(MSTU(11),6200) CHIN(1),CHIN(2) + DO 150 I=-20,22 + IF(I.EQ.0) GOTO 150 + IA=IABS(I) + IF(IA.GT.MSTP(58).AND.IA.LE.10) GOTO 150 + IF(IA.GT.10+2*MSTP(1).AND.IA.LE.20) GOTO 150 + CALL PYNAME(I,CHAU) + WRITE(MSTU(11),6300) CHAU,STATE(KFIN(1,I)),CHAU, + & STATE(KFIN(2,I)) + 150 CONTINUE + WRITE(MSTU(11),6400) + +C...User-defined limits on kinematical variables. + ELSEIF(MSTAT.EQ.4) THEN + WRITE(MSTU(11),6500) + WRITE(MSTU(11),6600) + SHRMAX=CKIN(2) + IF(SHRMAX.LT.0D0) SHRMAX=VINT(1) + WRITE(MSTU(11),6700) CKIN(1),CHKIN(1),SHRMAX + PTHMIN=MAX(CKIN(3),CKIN(5)) + PTHMAX=CKIN(4) + IF(PTHMAX.LT.0D0) PTHMAX=0.5D0*SHRMAX + WRITE(MSTU(11),6800) CKIN(3),PTHMIN,CHKIN(2),PTHMAX + WRITE(MSTU(11),6900) CHKIN(3),CKIN(6) + DO 160 I=4,14 + WRITE(MSTU(11),6700) CKIN(2*I-1),CHKIN(I),CKIN(2*I) + 160 CONTINUE + SPRMAX=CKIN(32) + IF(SPRMAX.LT.0D0) SPRMAX=VINT(1) + WRITE(MSTU(11),6700) CKIN(31),CHKIN(15),SPRMAX + WRITE(MSTU(11),7000) + +C...Status codes and parameter values. + ELSEIF(MSTAT.EQ.5) THEN + WRITE(MSTU(11),7100) + WRITE(MSTU(11),7200) + DO 170 I=1,100 + WRITE(MSTU(11),7300) I,MSTP(I),PARP(I),100+I,MSTP(100+I), + & PARP(100+I) + 170 CONTINUE + +C...List of all processes implemented in the program. + ELSEIF(MSTAT.EQ.6) THEN + WRITE(MSTU(11),7400) + WRITE(MSTU(11),7500) + DO 180 I=1,500 + IF(ISET(I).LT.0) GOTO 180 + WRITE(MSTU(11),7600) I,PROC(I),ISET(I),KFPR(I,1),KFPR(I,2) + 180 CONTINUE + WRITE(MSTU(11),7700) + + ELSEIF(MSTAT.EQ.7) THEN + WRITE (MSTU(11),8000) + NMODES(0)=0 + NMODES(10)=0 + NMODES(9)=0 + DO 290 ILR=1,2 + DO 280 KFSM=1,16 + KFSUSY=ILR*KSUSY1+KFSM + NRVDC=0 +C...SDOWN DECAYS + IF (KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5) THEN + NRVDC=3 + DO 190 I=1,NRVDC + PBRAT(I)=0D0 + NMODES(I)=0 + 190 CONTINUE + CALL PYNAME(KFSUSY,CHTMP) + CHD0=CHTMP//' ' + CHDC(1)=DNAME(3) // ' + ' // DNAME(1) + CHDC(2)=DNAME(2) // ' + ' // DNAME(1) + CHDC(3)=DNAME(1) // ' + ' // DNAME(1) + KC=PYCOMP(KFSUSY) + DO 200 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + ID1=IABS(KFDP(IDC,1)) + ID2=IABS(KFDP(IDC,2)) + IF (KFDP(IDC,3).EQ.0) THEN + IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 + & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN + PBRAT(1)=PBRAT(1)+BRAT(IDC) + NMODES(1)=NMODES(1)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND + & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6)) THEN + PBRAT(2)=PBRAT(2)+BRAT(IDC) + NMODES(2)=NMODES(2)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND + & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN + PBRAT(3)=PBRAT(3)+BRAT(IDC) + NMODES(3)=NMODES(3)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ENDIF + ENDIF + 200 CONTINUE + ENDIF +C...SUP DECAYS + IF (KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6) THEN + NRVDC=2 + DO 210 I=1,NRVDC + NMODES(I)=0 + PBRAT(I)=0D0 + 210 CONTINUE + CALL PYNAME(KFSUSY,CHTMP) + CHD0=CHTMP//' ' + CHDC(1)=DNAME(2) // ' + ' // DNAME(1) + CHDC(2)=DNAME(1) // ' + ' // DNAME(1) + KC=PYCOMP(KFSUSY) + DO 220 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + ID1=IABS(KFDP(IDC,1)) + ID2=IABS(KFDP(IDC,2)) + IF (KFDP(IDC,3).EQ.0) THEN + IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2 + & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN + PBRAT(1)=PBRAT(1)+BRAT(IDC) + NMODES(1)=NMODES(1)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2 + & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN + PBRAT(2)=PBRAT(2)+BRAT(IDC) + NMODES(2)=NMODES(2)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ENDIF + ENDIF + 220 CONTINUE + ENDIF +C...SLEPTON DECAYS + IF (KFSM.EQ.11.OR.KFSM.EQ.13.OR.KFSM.EQ.15) THEN + NRVDC=2 + DO 230 I=1,NRVDC + PBRAT(I)=0D0 + NMODES(I)=0 + 230 CONTINUE + CALL PYNAME(KFSUSY,CHTMP) + CHD0=CHTMP//' ' + CHDC(1)=DNAME(3) // ' + ' // DNAME(2) + CHDC(2)=DNAME(1) // ' + ' // DNAME(1) + KC=PYCOMP(KFSUSY) + DO 240 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + ID1=IABS(KFDP(IDC,1)) + ID2=IABS(KFDP(IDC,2)) + IF (KFDP(IDC,3).EQ.0) THEN + IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 + & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN + PBRAT(1)=PBRAT(1)+BRAT(IDC) + NMODES(1)=NMODES(1)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ENDIF + IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND.(ID2 + & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN + PBRAT(2)=PBRAT(2)+BRAT(IDC) + NMODES(2)=NMODES(2)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ENDIF + ENDIF + 240 CONTINUE + ENDIF +C...SNEUTRINO DECAYS + IF ((KFSM.EQ.12.OR.KFSM.EQ.14.OR.KFSM.EQ.16).AND.ILR.EQ.1) + & THEN + NRVDC=2 + DO 250 I=1,NRVDC + PBRAT(I)=0D0 + NMODES(I)=0 + 250 CONTINUE + CALL PYNAME(KFSUSY,CHTMP) + CHD0=CHTMP//' ' + CHDC(1)=DNAME(2) // ' + ' // DNAME(2) + CHDC(2)=DNAME(1) // ' + ' // DNAME(1) + KC=PYCOMP(KFSUSY) + DO 260 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + ID1=IABS(KFDP(IDC,1)) + ID2=IABS(KFDP(IDC,2)) + IF (KFDP(IDC,3).EQ.0) THEN + IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2 + & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN + PBRAT(1)=PBRAT(1)+BRAT(IDC) + NMODES(1)=NMODES(1)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ENDIF + IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2 + & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN + NMODES(2)=NMODES(2)+1 + PBRAT(2)=PBRAT(2)+BRAT(IDC) + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ENDIF + ENDIF + 260 CONTINUE + ENDIF + IF (NRVDC.NE.0) THEN + DO 270 I=1,NRVDC + WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I) + NMODES(0)=NMODES(0)+NMODES(I) + 270 CONTINUE + ENDIF + 280 CONTINUE + 290 CONTINUE + DO 370 KFSM=21,37 + KFSUSY=KSUSY1+KFSM + NRVDC=0 +C...NEUTRALINO DECAYS + IF (KFSM.EQ.22.OR.KFSM.EQ.23.OR.KFSM.EQ.25.OR.KFSM.EQ.35) THEN + NRVDC=4 + DO 300 I=1,NRVDC + PBRAT(I)=0D0 + NMODES(I)=0 + 300 CONTINUE + CALL PYNAME(KFSUSY,CHTMP) + CHD0=CHTMP//' ' + CHDC(1)=DNAME(3) // ' + ' // DNAME(2) // ' + ' // DNAME(2) + CHDC(2)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) + CHDC(3)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) + CHDC(4)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) + KC=PYCOMP(KFSUSY) + DO 310 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + ID1=IABS(KFDP(IDC,1)) + ID2=IABS(KFDP(IDC,2)) + ID3=IABS(KFDP(IDC,3)) + IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 + & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.11.OR + & .ID3.EQ.13.OR.ID3.EQ.15)) THEN + PBRAT(1)=PBRAT(1)+BRAT(IDC) + NMODES(1)=NMODES(1)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND + & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 + & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(2)=PBRAT(2)+BRAT(IDC) + NMODES(2)=NMODES(2)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND + & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1 + & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(3)=PBRAT(3)+BRAT(IDC) + NMODES(3)=NMODES(3)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND + & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 + & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(4)=PBRAT(4)+BRAT(IDC) + NMODES(4)=NMODES(4)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ENDIF + 310 CONTINUE + ENDIF +C...CHARGINO DECAYS + IF (KFSM.EQ.24.OR.KFSM.EQ.37) THEN + NRVDC=5 + DO 320 I=1,NRVDC + PBRAT(I)=0D0 + NMODES(I)=0 + 320 CONTINUE + CALL PYNAME(KFSUSY,CHTMP) + CHD0=CHTMP//' ' + CHDC(1)=DNAME(3) // ' + ' // DNAME(3) // ' + ' // DNAME(2) + CHDC(2)=DNAME(2) // ' + ' // DNAME(2) // ' + ' // DNAME(2) + CHDC(3)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) + CHDC(4)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) + CHDC(5)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) + KC=PYCOMP(KFSUSY) + DO 330 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + ID1=IABS(KFDP(IDC,1)) + ID2=IABS(KFDP(IDC,2)) + ID3=IABS(KFDP(IDC,3)) + IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 + & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.12.OR + & .ID3.EQ.14.OR.ID3.EQ.16)) THEN + PBRAT(1)=PBRAT(1)+BRAT(IDC) + NMODES(1)=NMODES(1)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND + & .(ID2.EQ.12.OR.ID2.EQ.14.OR.ID2.EQ.16).AND.(ID3.EQ + & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN + PBRAT(1)=PBRAT(1)+BRAT(IDC) + NMODES(1)=NMODES(1)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND + & .(ID2.EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ + & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN + PBRAT(2)=PBRAT(2)+BRAT(IDC) + NMODES(2)=NMODES(2)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND + & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ + & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN + PBRAT(3)=PBRAT(3)+BRAT(IDC) + NMODES(3)=NMODES(3)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND + & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ + & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(3)=PBRAT(3)+BRAT(IDC) + NMODES(3)=NMODES(3)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND + & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ + & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN + PBRAT(4)=PBRAT(4)+BRAT(IDC) + NMODES(4)=NMODES(4)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND + & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ + & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(4)=PBRAT(4)+BRAT(IDC) + NMODES(4)=NMODES(4)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND + & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ + & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(5)=PBRAT(5)+BRAT(IDC) + NMODES(5)=NMODES(5)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND + & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ + & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(5)=PBRAT(5)+BRAT(IDC) + NMODES(5)=NMODES(5)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ENDIF + 330 CONTINUE + ENDIF +C...GLUINO DECAYS + IF (KFSM.EQ.21) THEN + NRVDC=3 + DO 340 I=1,NRVDC + PBRAT(I)=0D0 + NMODES(I)=0 + 340 CONTINUE + CALL PYNAME(KFSUSY,CHTMP) + CHD0=CHTMP//' ' + CHDC(1)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) + CHDC(2)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) + CHDC(3)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) + KC=PYCOMP(KFSUSY) + DO 350 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + ID1=IABS(KFDP(IDC,1)) + ID2=IABS(KFDP(IDC,2)) + ID3=IABS(KFDP(IDC,3)) + IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 + & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1.OR + & .ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(1)=PBRAT(1)+BRAT(IDC) + NMODES(1)=NMODES(1)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND + & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1 + & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(2)=PBRAT(2)+BRAT(IDC) + NMODES(2)=NMODES(2)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND + & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 + & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN + PBRAT(3)=PBRAT(3)+BRAT(IDC) + NMODES(3)=NMODES(3)+1 + IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 + IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 + ENDIF + 350 CONTINUE + ENDIF + + IF (NRVDC.NE.0) THEN + DO 360 I=1,NRVDC + WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I) + NMODES(0)=NMODES(0)+NMODES(I) + 360 CONTINUE + ENDIF + 370 CONTINUE + WRITE (MSTU(11),8100) NMODES(0), NMODES(10), NMODES(9) + + IF (IMSS(51).GE.1.OR.IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN + WRITE (MSTU(11),8500) + DO 400 IRV=1,3 + DO 390 JRV=1,3 + DO 380 KRV=1,3 + WRITE (MSTU(11),8700) IRV,JRV,KRV,RVLAM(IRV,JRV,KRV) + & ,RVLAMP(IRV,JRV,KRV),RVLAMB(IRV,JRV,KRV) + 380 CONTINUE + 390 CONTINUE + 400 CONTINUE + WRITE (MSTU(11),8600) + ENDIF + ENDIF + +C...Formats for printouts. + 5000 FORMAT('1',9('*'),1X,'PYSTAT: Statistics on Number of ', + &'Events and Cross-sections',1X,9('*')) + 5100 FORMAT(/1X,78('=')/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',12X, + &'Subprocess',12X,'I',6X,'Number of points',6X,'I',4X,'Sigma',3X, + &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',34('-'),'I',28('-'), + &'I',4X,'(mb)',4X,'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',1X, + &'N:o',1X,'Type',25X,'I',4X,'Generated',9X,'Tried',1X,'I',12X, + &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/1X,'I',34X,'I',28X, + &'I',12X,'I') + 5200 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I12,1X,I13,1X,'I',1X,1P, + &D10.3,1X,'I') + 5300 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/ + &1X,'I',34X,'I',28X,'I',12X,'I') + 5400 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')// + &1X,'********* Total number of errors, excluding junctions =', + &1X,I8,' *************'/ + &1X,'********* Total number of errors, including junctions =', + &1X,I8,' *************'/ + &1X,'********* Total number of warnings = ', + &1X,I8,' *************'/ + &1X,'********* Fraction of events that fail fragmentation ', + &'cuts =',1X,F8.5,' *********'/) + 5500 FORMAT('1',27('*'),1X,'PYSTAT: Decay Widths and Branching ', + &'Ratios',1X,27('*')) + 5600 FORMAT(/1X,98('=')/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/ + &1X,'I',5X,'Mother --> Branching/Decay Channel',8X,'I',1X, + &'Width (GeV)',1X,'I',7X,'B.R.',1X,'I',1X,'Stat',1X,'I',2X, + &'Eff. B.R.',1X,'I'/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/ + &1X,98('=')) + 5700 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,'I',1X, + &I8,2X,A10,3X,'(m =',F10.3,')',2X,'-->',5X,'I',2X,1P,D10.3,0P,1X, + &'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,1P,D10.3,0P,1X,'I') + 5800 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,15X,'I',2X, + &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X, + &1P,D10.3,0P,1X,'I') + 5900 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,1X,'+',1X,A10,2X,'I',2X, + &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X, + &1P,D10.3,0P,1X,'I') + 6000 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,98('=')) + 6100 FORMAT('1',7('*'),1X,'PYSTAT: Allowed Incoming Partons/', + &'Particles at Hard Interaction',1X,7('*')) + 6200 FORMAT(/1X,78('=')/1X,'I',38X,'I',37X,'I'/1X,'I',1X, + &'Beam particle:',1X,A12,10X,'I',1X,'Target particle:',1X,A12,7X, + &'I'/1X,'I',38X,'I',37X,'I'/1X,'I',1X,'Content',6X,'State',19X, + &'I',1X,'Content',6X,'State',18X,'I'/1X,'I',38X,'I',37X,'I'/1X, + &78('=')/1X,'I',38X,'I',37X,'I') + 6300 FORMAT(1X,'I',1X,A9,5X,A4,19X,'I',1X,A9,5X,A4,18X,'I') + 6400 FORMAT(1X,'I',38X,'I',37X,'I'/1X,78('=')) + 6500 FORMAT('1',12('*'),1X,'PYSTAT: User-Defined Limits on ', + &'Kinematical Variables',1X,12('*')) + 6600 FORMAT(/1X,78('=')/1X,'I',76X,'I') + 6700 FORMAT(1X,'I',16X,1P,D10.3,0P,1X,'<',1X,A,1X,'<',1X,1P,D10.3,0P, + &16X,'I') + 6800 FORMAT(1X,'I',3X,1P,D10.3,0P,1X,'(',1P,D10.3,0P,')',1X,'<',1X,A, + &1X,'<',1X,1P,D10.3,0P,16X,'I') + 6900 FORMAT(1X,'I',29X,A,1X,'=',1X,1P,D10.3,0P,16X,'I') + 7000 FORMAT(1X,'I',76X,'I'/1X,78('=')) + 7100 FORMAT('1',12('*'),1X,'PYSTAT: Summary of Status Codes and ', + &'Parameter Values',1X,12('*')) + 7200 FORMAT(/3X,'I',4X,'MSTP(I)',9X,'PARP(I)',20X,'I',4X,'MSTP(I)',9X, + &'PARP(I)'/) + 7300 FORMAT(1X,I3,5X,I6,6X,1P,D10.3,0P,18X,I3,5X,I6,6X,1P,D10.3) + 7400 FORMAT('1',13('*'),1X,'PYSTAT: List of implemented processes', + &1X,13('*')) + 7500 FORMAT(/1X,65('=')/1X,'I',34X,'I',28X,'I'/1X,'I',12X, + &'Subprocess',12X,'I',1X,'ISET',2X,'KFPR(I,1)',2X,'KFPR(I,2)',1X, + &'I'/1X,'I',34X,'I',28X,'I'/1X,65('=')/1X,'I',34X,'I',28X,'I') + 7600 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I4,1X,I10,1X,I10,1X,'I') + 7700 FORMAT(1X,'I',34X,'I',28X,'I'/1X,65('=')) + 8000 FORMAT(1X/ 1X/ + & 17X,'Sums over R-Violating branching ratios',1X/ 1X + & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I'/1X,'I',4X + & ,'Mother --> Sum over final state flavours',4X,'I',2X + & ,'BR(sum)',2X,'I',2X,'N',2X,'I'/1X,'I',50X,'I',11X,'I',5X,'I' + & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I') + 8100 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I'/1X,70('=')/1X,'I',1X + & ,'Total number of R-Violating modes :',3X,I5,24X,'I'/ + & 1X,'I',1X,'Total number with non-vanishing BR :',2X,I5,24X + & ,'I'/1X,'I',1X,'Total number with BR > 0.001 :',8X,I5,24X,'I' + & /1X,70('=')) + 8200 FORMAT(1X,'I',1X,A9,1X,'-->',1X,A24,11X, + & 'I',2X,1P,D8.2,0P,1X,'I',2X,I2,1X,'I') + 8300 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I') + 8500 FORMAT(1X/ 1X/ + & 1X,'R-Violating couplings',1X/ 1X / + & 1X,55('=')/ + & 1X,'I',1X,'IJK',1X,'I',2X,'LAMBDA(IJK)',2X,'I',2X + & ,'LAMBDA''(IJK)',1X,'I',1X,"LAMBDA''(IJK)",1X,'I'/1X,'I',5X + & ,'I',15X,'I',15X,'I',15X,'I') + 8600 FORMAT(1X,55('=')) + 8700 FORMAT(1X,'I',1X,I1,I1,I1,1X,'I',1X,1P,D13.3,0P,1X,'I',1X,1P + & ,D13.3,0P,1X,'I',1X,1P,D13.3,0P,1X,'I') + + RETURN + END + +C********************************************************************* + +C...PYUPEV +C...Administers the hard-process generation required for output to the +C...Les Houches event record. + + SUBROUTINE PYUPEV + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP + +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYCTAG/NCT,MCT(4000,2) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT4/MWID(500),WIDS(500,5) + SAVE /PYJETS/,/PYCTAG/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/, + &/PYINT1/,/PYINT2/,/PYINT4/ + +C...HEPEUP for output. + INTEGER MAXNUP + PARAMETER (MAXNUP=500) + INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP + DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP + COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), + &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), + &VTIMUP(MAXNUP),SPINUP(MAXNUP) + SAVE /HEPEUP/ + +C...Stop if no subprocesses on. + IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN + WRITE(MSTU(11),5100) + STOP + ENDIF + +C...Special flags for hard-process generation only. + MSTP71=MSTP(71) + MSTP(71)=0 + MST128=MSTP(128) + MSTP(128)=1 + +C...Initial values for some counters. + N=0 + MINT(5)=MINT(5)+1 + MINT(7)=0 + MINT(8)=0 + MINT(30)=0 + MINT(83)=0 + MINT(84)=MSTP(126) + MSTU(24)=0 + MSTU70=0 + MSTJ14=MSTJ(14) +C...Normally, use K(I,4:5) colour info rather than /PYCTAG/. + MINT(33)=0 + +C...If variable energies: redo incoming kinematics and cross-section. + MSTI(61)=0 + IF(MSTP(171).EQ.1) THEN + CALL PYINKI(1) + IF(MSTI(61).EQ.1) THEN + MINT(5)=MINT(5)-1 + RETURN + ENDIF + IF(MINT(121).GT.1) CALL PYSAVE(3,1) + CALL PYXTOT + ENDIF + +C...Do not allow pileup events. + MINT(82)=1 + +C...Generate variables of hard scattering. + MINT(51)=0 + MSTI(52)=0 + 100 CONTINUE + IF(MINT(51).NE.0.OR.MSTU(24).NE.0) MSTI(52)=MSTI(52)+1 + MINT(31)=0 + MINT(51)=0 + MINT(57)=0 + CALL PYRAND + IF(MSTI(61).EQ.1) THEN + MINT(5)=MINT(5)-1 + RETURN + ENDIF + IF(MINT(51).EQ.2) RETURN + ISUB=MINT(1) + + IF((ISUB.LE.90.OR.ISUB.GE.95).AND.ISUB.NE.99) THEN +C...Hard scattering (including low-pT): +C...reconstruct kinematics and colour flow of hard scattering. + MINT31=MINT(31) + 110 MINT(31)=MINT31 + MINT(51)=0 + CALL PYSCAT + IF(MINT(51).EQ.1) GOTO 100 + IPU1=MINT(84)+1 + IPU2=MINT(84)+2 + +C...Decay of final state resonances. + MINT(32)=0 + IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10.AND.ISUB.NE.95) + & CALL PYRESD(0) + IF(MINT(51).EQ.1) GOTO 100 + MINT(52)=N + +C...Longitudinal boost of hard scattering. + BETAZ=(VINT(41)-VINT(42))/(VINT(41)+VINT(42)) + CALL PYROBO(MINT(84)+1,N,0D0,0D0,0D0,0D0,BETAZ) + + ELSEIF(ISUB.NE.99) THEN +C...Diffractive and elastic scattering. + CALL PYDIFF + + ELSE +C...DIS scattering (photon flux external). + CALL PYDISG + IF(MINT(51).EQ.1) GOTO 100 + ENDIF + +C...Check that no odd resonance left undecayed. + MINT(54)=N + NFIX=N + DO 120 I=MINT(84)+1,NFIX + IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND. + & K(I,2).NE.22) THEN + KCA=PYCOMP(K(I,2)) + IF(MWID(KCA).NE.0.AND.MDCY(KCA,1).GE.1) THEN + CALL PYRESD(I) + IF(MINT(51).EQ.1) GOTO 100 + ENDIF + ENDIF + 120 CONTINUE + +C...Boost hadronic subsystem to overall rest frame. +C..(Only relevant when photon inside lepton beam.) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(4,WTGAGA) + +C...Store event information and calculate Monte Carlo estimates of +C...subprocess cross-sections. + 130 CALL PYDOCU + +C...Transform to the desired coordinate frame. + 140 CALL PYFRAM(MSTP(124)) + MSTU(70)=MSTU70 + PARU(21)=VINT(1) + +C...Restore special flags for hard-process generation only. + MSTP(71)=MSTP71 + MSTP(128)=MST128 + +C...Trace colour tags; convert to LHA style labels. + NCT=100 + DO 150 I=MINT(84)+1,N + MCT(I,1)=0 + MCT(I,2)=0 + 150 CONTINUE + DO 160 I=MINT(84)+1,N + KQ=KCHG(PYCOMP(K(I,2)),2)*ISIGN(1,K(I,2)) + IF(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.K(I,1).EQ.14) THEN + IF(K(I,4).NE.0.AND.(KQ.EQ.1.OR.KQ.EQ.2).AND.MCT(I,1).EQ.0) + & THEN + IMO=MOD(K(I,4)/MSTU(5),MSTU(5)) + IDA=MOD(K(I,4),MSTU(5)) + IF(IMO.NE.0.AND.MOD(K(IMO,5)/MSTU(5),MSTU(5)).EQ.I.AND. + & MCT(IMO,2).NE.0) THEN + MCT(I,1)=MCT(IMO,2) + ELSEIF(IMO.NE.0.AND.MOD(K(IMO,4),MSTU(5)).EQ.I.AND. + & MCT(IMO,1).NE.0) THEN + MCT(I,1)=MCT(IMO,1) + ELSEIF(IDA.NE.0.AND.MOD(K(IDA,5),MSTU(5)).EQ.I.AND. + & MCT(IDA,2).NE.0) THEN + MCT(I,1)=MCT(IDA,2) + ELSE + NCT=NCT+1 + MCT(I,1)=NCT + ENDIF + ENDIF + IF(K(I,5).NE.0.AND.(KQ.EQ.-1.OR.KQ.EQ.2).AND.MCT(I,2).EQ.0) + & THEN + IMO=MOD(K(I,5)/MSTU(5),MSTU(5)) + IDA=MOD(K(I,5),MSTU(5)) + IF(IMO.NE.0.AND.MOD(K(IMO,4)/MSTU(5),MSTU(5)).EQ.I.AND. + & MCT(IMO,1).NE.0) THEN + MCT(I,2)=MCT(IMO,1) + ELSEIF(IMO.NE.0.AND.MOD(K(IMO,5),MSTU(5)).EQ.I.AND. + & MCT(IMO,2).NE.0) THEN + MCT(I,2)=MCT(IMO,2) + ELSEIF(IDA.NE.0.AND.MOD(K(IDA,4),MSTU(5)).EQ.I.AND. + & MCT(IDA,1).NE.0) THEN + MCT(I,2)=MCT(IDA,1) + ELSE + NCT=NCT+1 + MCT(I,2)=NCT + ENDIF + ENDIF + ENDIF + 160 CONTINUE + +C...Put event in HEPEUP commonblock. + NUP=N-MINT(84) + IDPRUP=MINT(1) + XWGTUP=1D0 + SCALUP=VINT(53) + AQEDUP=VINT(57) + AQCDUP=VINT(58) + DO 180 I=1,NUP + IDUP(I)=K(I+MINT(84),2) + IF(I.LE.2) THEN + ISTUP(I)=-1 + MOTHUP(1,I)=0 + MOTHUP(2,I)=0 + ELSEIF(K(I+4,3).EQ.0) THEN + ISTUP(I)=1 + MOTHUP(1,I)=1 + MOTHUP(2,I)=2 + ELSE + ISTUP(I)=1 + MOTHUP(1,I)=K(I+MINT(84),3)-MINT(84) + MOTHUP(2,I)=0 + ENDIF + IF(I.GE.3.AND.K(I+MINT(84),3).GT.0) + & ISTUP(K(I+MINT(84),3)-MINT(84))=2 + ICOLUP(1,I)=MCT(I+MINT(84),1) + ICOLUP(2,I)=MCT(I+MINT(84),2) + DO 170 J=1,5 + PUP(J,I)=P(I+MINT(84),J) + 170 CONTINUE + VTIMUP(I)=V(I,5) + SPINUP(I)=9D0 + 180 CONTINUE + +C...Optionally write out event to disk. Minimal size for time/spin fields. + IF(MSTP(162).GT.0) THEN + WRITE(MSTP(162),5200) NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP + DO 190 I=1,NUP + IF(VTIMUP(I).EQ.0D0) THEN + WRITE(MSTP(162),5300) IDUP(I),ISTUP(I),MOTHUP(1,I), + & MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),(PUP(J,I),J=1,5), + & ' 0. 9.' + ELSE + WRITE(MSTP(162),5400) IDUP(I),ISTUP(I),MOTHUP(1,I), + & MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),(PUP(J,I),J=1,5), + & VTIMUP(I),' 9.' + ENDIF + 190 CONTINUE + +C...Optional extra line with parton-density information. + IF(MSTP(165).GE.1) WRITE(MSTP(162),5500) MSTI(15),MSTI(16), + & PARI(33),PARI(34),PARI(23),PARI(29),PARI(30) + ENDIF + +C...Error messages and other print formats. + 5100 FORMAT(1X,'Error: no subprocess switched on.'/ + &1X,'Execution stopped.') + 5200 FORMAT(1P,2I6,4E14.6) + 5300 FORMAT(1P,I8,5I5,5E18.10,A6) + 5400 FORMAT(1P,I8,5I5,5E18.10,E12.4,A3) + 5500 FORMAT(1P,'#pdf ',2I5,5E18.10) + + RETURN + END + +C********************************************************************* + +C...PYUPIN +C...Fills the HEPRUP commonblock with info on incoming beams and allowed +C...processes, and optionally stores that information on file. + + SUBROUTINE PYUPIN + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + SAVE /PYJETS/,/PYSUBS/,/PYPARS/,/PYINT5/ + +C...User process initialization commonblock. + INTEGER MAXPUP + PARAMETER (MAXPUP=100) + INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP + DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP + COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), + &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), + &LPRUP(MAXPUP) + SAVE /HEPRUP/ + +C...Store info on incoming beams. + IDBMUP(1)=K(1,2) + IDBMUP(2)=K(2,2) + EBMUP(1)=P(1,4) + EBMUP(2)=P(2,4) + PDFGUP(1)=0 + PDFGUP(2)=0 + PDFSUP(1)=MSTP(51) + PDFSUP(2)=MSTP(51) + +C...Event weighting strategy. + IDWTUP=3 + +C...Info on individual processes. + NPRUP=0 + DO 100 ISUB=1,500 + IF(MSUB(ISUB).EQ.1) THEN + NPRUP=NPRUP+1 + XSECUP(NPRUP)=1D9*XSEC(ISUB,3) + XERRUP(NPRUP)=XSECUP(NPRUP)/SQRT(MAX(1D0,DBLE(NGEN(ISUB,3)))) + XMAXUP(NPRUP)=1D0 + LPRUP(NPRUP)=ISUB + ENDIF + 100 CONTINUE + +C...Write info to file. + IF(MSTP(161).GT.0) THEN + WRITE(MSTP(161),5100) IDBMUP(1),IDBMUP(2),EBMUP(1),EBMUP(2), + & PDFGUP(1),PDFGUP(2),PDFSUP(1),PDFSUP(2),IDWTUP,NPRUP + DO 110 IPR=1,NPRUP + WRITE(MSTP(161),5200) XSECUP(IPR),XERRUP(IPR),XMAXUP(IPR), + & LPRUP(IPR) + 110 CONTINUE + ENDIF + +C...Formats for printout. + 5100 FORMAT(1P,2I8,2E14.6,6I6) + 5200 FORMAT(1P,3E14.6,I6) + + RETURN + END + + +C********************************************************************* + +C...Combine the two old-style Pythia initialization and event files +C...into a single Les Houches Event File. + + SUBROUTINE PYLHEF + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + +C...PYTHIA commonblock: only used to provide read/write units and version. + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + SAVE /PYPARS/ + +C...User process initialization commonblock. + INTEGER MAXPUP + PARAMETER (MAXPUP=100) + INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP + DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP + COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), + &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), + &LPRUP(MAXPUP) + SAVE /HEPRUP/ + +C...User process event common block. + INTEGER MAXNUP + PARAMETER (MAXNUP=500) + INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP + DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP + COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), + &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), + &VTIMUP(MAXNUP),SPINUP(MAXNUP) + SAVE /HEPEUP/ + +C...Lines to read in assumed never longer than 200 characters. + PARAMETER (MAXLEN=200) + CHARACTER*(MAXLEN) STRING + +C...Format for reading lines. + CHARACTER*6 STRFMT + STRFMT='(A000)' + WRITE(STRFMT(3:5),'(I3)') MAXLEN + +C...Rewind initialization and event files. + REWIND MSTP(161) + REWIND MSTP(162) + +C...Write header info. + WRITE(MSTP(163),'(A)') '' + WRITE(MSTP(163),'(A)') '' + +C...Read first line of initialization info and get number of processes. + READ(MSTP(161),'(A)',END=400,ERR=400) STRING + READ(STRING,*,ERR=400) IDBMUP(1),IDBMUP(2),EBMUP(1), + &EBMUP(2),PDFGUP(1),PDFGUP(2),PDFSUP(1),PDFSUP(2),IDWTUP,NPRUP + +C...Copy initialization lines, omitting trailing blanks. +C...Embed in ... block. + WRITE(MSTP(163),'(A)') '' + DO 140 IPR=0,NPRUP + IF(IPR.GT.0) READ(MSTP(161),'(A)',END=400,ERR=400) STRING + LEN=MAXLEN+1 + 120 LEN=LEN-1 + IF(LEN.GT.1.AND.STRING(LEN:LEN).EQ.' ') GOTO 120 + WRITE(MSTP(163),'(A)',ERR=400) STRING(1:LEN) + 140 CONTINUE + WRITE(MSTP(163),'(A)') '' + +C...Begin event loop. Read first line of event info or already done. + READ(MSTP(162),'(A)',END=320,ERR=400) STRING + 200 CONTINUE + +C...Look at first line to know number of particles in event. + READ(STRING,*,ERR=400) NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP + +C...Begin an block. Copy event lines, omitting trailing blanks. + WRITE(MSTP(163),'(A)') '' + DO 240 I=0,NUP + IF(I.GT.0) READ(MSTP(162),'(A)',END=400,ERR=400) STRING + LEN=MAXLEN+1 + 220 LEN=LEN-1 + IF(LEN.GT.1.AND.STRING(LEN:LEN).EQ.' ') GOTO 220 + WRITE(MSTP(163),'(A)',ERR=400) STRING(1:LEN) + 240 CONTINUE + +C...Copy trailing comment lines - with a # in the first column - as is. + 260 READ(MSTP(162),'(A)',END=300,ERR=400) STRING + IF(STRING(1:1).EQ.'#') THEN + LEN=MAXLEN+1 + 280 LEN=LEN-1 + IF(LEN.GT.1.AND.STRING(LEN:LEN).EQ.' ') GOTO 280 + WRITE(MSTP(163),'(A)',ERR=400) STRING(1:LEN) + GOTO 260 + ENDIF + +C..End the block. Loop back to look for next event. + WRITE(MSTP(163),'(A)') '' + GOTO 200 + +C...Successfully reached end of event loop: write closing tag +C...and remove temporary intermediate files (unless asked not to). + 300 WRITE(MSTP(163),'(A)') '' + 320 WRITE(MSTP(163),'(A)') '' + IF(MSTP(164).EQ.1) RETURN + CLOSE(MSTP(161),ERR=400,STATUS='DELETE') + CLOSE(MSTP(162),ERR=400,STATUS='DELETE') + RETURN + +C...Error exit. + 400 WRITE(*,*) ' PYLHEF file joining failed!' + + RETURN + END + +C********************************************************************* + +C...PYINRE +C...Calculates full and effective widths of gauge bosons, stores +C...masses and widths, rescales coefficients to be used for +C...resonance production generation. + + SUBROUTINE PYINRE + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement to help give large particle numbers. + PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, + &KEXCIT=4000000,KDIMEN=5000000) +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYDAT4/CHAF(500,2) + CHARACTER CHAF*16 + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYINT6/PROC(0:500) + CHARACTER PROC*28 + COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) + SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, + &/PYINT1/,/PYINT2/,/PYINT4/,/PYINT6/,/PYMSSM/ +C...Local arrays and data. + DIMENSION WDTP(0:400),WDTE(0:400,0:5),WDTPM(0:400), + &WDTEM(0:400,0:5),KCORD(500),PMORD(500) + +C...Born level couplings in MSSM Higgs doublet sector. + XW=PARU(102) + XWV=XW + IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 + XW1=1D0-XW + IF(MSTP(4).EQ.2) THEN + TANBE=PARU(141) + RATBE=((1D0-TANBE**2)/(1D0+TANBE**2))**2 + SQMZ=PMAS(23,1)**2 + SQMW=PMAS(24,1)**2 + SQMH=PMAS(25,1)**2 + SQMA=SQMH*(SQMZ-SQMH)/(SQMZ*RATBE-SQMH) + SQMHP=0.5D0*(SQMA+SQMZ+SQRT((SQMA+SQMZ)**2-4D0*SQMA*SQMZ*RATBE)) + SQMHC=SQMA+SQMW + IF(SQMH.GE.SQMZ.OR.MIN(SQMA,SQMHP,SQMHC).LE.0D0) THEN + WRITE(MSTU(11),5000) + CALL PYSTOP(101) + ENDIF + PMAS(35,1)=SQRT(SQMHP) + PMAS(36,1)=SQRT(SQMA) + PMAS(37,1)=SQRT(SQMHC) + ALSU=0.5D0*ATAN(2D0*TANBE*(SQMA+SQMZ)/((1D0-TANBE**2)* + & (SQMA-SQMZ))) + BESU=ATAN(TANBE) + PARU(142)=1D0 + PARU(143)=1D0 + PARU(161)=-SIN(ALSU)/COS(BESU) + PARU(162)=COS(ALSU)/SIN(BESU) + PARU(163)=PARU(161) + PARU(164)=SIN(BESU-ALSU) + PARU(165)=PARU(164) + PARU(168)=SIN(BESU-ALSU)+0.5D0*COS(2D0*BESU)*SIN(BESU+ALSU)/XW + PARU(171)=COS(ALSU)/COS(BESU) + PARU(172)=SIN(ALSU)/SIN(BESU) + PARU(173)=PARU(171) + PARU(174)=COS(BESU-ALSU) + PARU(175)=PARU(174) + PARU(176)=COS(2D0*ALSU)*COS(BESU+ALSU)-2D0*SIN(2D0*ALSU)* + & SIN(BESU+ALSU) + PARU(177)=COS(2D0*BESU)*COS(BESU+ALSU) + PARU(178)=COS(BESU-ALSU)-0.5D0*COS(2D0*BESU)*COS(BESU+ALSU)/XW + PARU(181)=TANBE + PARU(182)=1D0/TANBE + PARU(183)=PARU(181) + PARU(184)=0D0 + PARU(185)=PARU(184) + PARU(186)=COS(BESU-ALSU) + PARU(187)=SIN(BESU-ALSU) + PARU(188)=PARU(186) + PARU(189)=PARU(187) + PARU(190)=0D0 + PARU(195)=COS(BESU-ALSU) + ENDIF + +C...Reset effective widths of gauge bosons. + DO 110 I=1,500 + DO 100 J=1,5 + WIDS(I,J)=1D0 + 100 CONTINUE + 110 CONTINUE + +C...Order resonances by increasing mass (except Z0 and W+/-). + NRES=0 + DO 140 KC=1,500 + KF=KCHG(KC,4) + IF(KF.EQ.0) GOTO 140 + IF(MWID(KC).EQ.0) GOTO 140 + IF(KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18) THEN + IF(MSTP(1).LE.3) GOTO 140 + ENDIF + IF(KF/KSUSY1.EQ.1.OR.KF/KSUSY1.EQ.2) THEN + IF(IMSS(1).LE.0) GOTO 140 + ENDIF + NRES=NRES+1 + PMRES=PMAS(KC,1) + IF(KC.EQ.23.OR.KC.EQ.24) PMRES=0D0 + DO 120 I1=NRES-1,1,-1 + IF(PMRES.GE.PMORD(I1)) GOTO 130 + KCORD(I1+1)=KCORD(I1) + PMORD(I1+1)=PMORD(I1) + 120 CONTINUE + 130 KCORD(I1+1)=KC + PMORD(I1+1)=PMRES + 140 CONTINUE + +C...Loop over possible resonances. + DO 180 I=1,NRES + KC=KCORD(I) + KF=KCHG(KC,4) + +C...Check that no fourth generation channels on by mistake. + IF(MSTP(1).LE.3) THEN + DO 150 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + KFA1=IABS(KFDP(IDC,1)) + KFA2=IABS(KFDP(IDC,2)) + IF(KFA1.EQ.7.OR.KFA1.EQ.8.OR.KFA1.EQ.17.OR.KFA1.EQ.18.OR. + & KFA2.EQ.7.OR.KFA2.EQ.8.OR.KFA2.EQ.17.OR.KFA2.EQ.18) + & MDME(IDC,1)=-1 + 150 CONTINUE + ENDIF + +C...Check that no supersymmetric channels on by mistake. + IF(IMSS(1).LE.0) THEN + DO 160 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + KFA1S=IABS(KFDP(IDC,1))/KSUSY1 + KFA2S=IABS(KFDP(IDC,2))/KSUSY1 + IF(KFA1S.EQ.1.OR.KFA1S.EQ.2.OR.KFA2S.EQ.1.OR.KFA2S.EQ.2) + & MDME(IDC,1)=-1 + 160 CONTINUE + ENDIF + +C...Find mass and evaluate width. + PMR=PMAS(KC,1) + IF(KF.EQ.25.OR.KF.EQ.35.OR.KF.EQ.36) MINT(62)=1 + IF(MWID(KC).EQ.3) MINT(63)=1 + CALL PYWIDT(KF,PMR**2,WDTP,WDTE) + MINT(51)=0 + +C...Evaluate suppression factors due to non-simulated channels. + IF(KCHG(KC,3).EQ.0) THEN + WDTP0I=0D0 + IF(WDTP(0).GT.0D0) WDTP0I=1D0/WDTP(0) + WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))**2+ + & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ + & 2D0*WDTE(0,4)*WDTE(0,5))*WDTP0I**2 + WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*WDTP0I + WIDS(KC,3)=0D0 + WIDS(KC,4)=0D0 + WIDS(KC,5)=0D0 + ELSE + IF(MWID(KC).EQ.3) MINT(63)=1 + CALL PYWIDT(-KF,PMR**2,WDTPM,WDTEM) + MINT(51)=0 + WDTP0I=0D0 + IF(WDTP(0).GT.0D0) WDTP0I=1D0/WDTP(0) + WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))*(WDTEM(0,1)+WDTEM(0,3))+ + & (WDTE(0,1)+WDTE(0,2))*(WDTEM(0,4)+WDTEM(0,5))+ + & (WDTE(0,4)+WDTE(0,5))*(WDTEM(0,1)+WDTEM(0,3))+ + & WDTE(0,4)*WDTEM(0,5)+WDTE(0,5)*WDTEM(0,4))*WDTP0I**2 + WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*WDTP0I + WIDS(KC,3)=(WDTEM(0,1)+WDTEM(0,3)+WDTEM(0,4))*WDTP0I + WIDS(KC,4)=((WDTE(0,1)+WDTE(0,2))**2+ + & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ + & 2D0*WDTE(0,4)*WDTE(0,5))*WDTP0I**2 + WIDS(KC,5)=((WDTEM(0,1)+WDTEM(0,3))**2+ + & 2D0*(WDTEM(0,1)+WDTEM(0,3))*(WDTEM(0,4)+WDTEM(0,5))+ + & 2D0*WDTEM(0,4)*WDTEM(0,5))*WDTP0I**2 + ENDIF + +C...Set resonance widths and branching ratios; +C...also on/off switch for decays. + IF(MWID(KC).EQ.1.OR.MWID(KC).EQ.3) THEN + PMAS(KC,2)=WDTP(0) + PMAS(KC,3)=MIN(0.9D0*PMAS(KC,1),10D0*PMAS(KC,2)) + IF(MSTP(41).EQ.0.OR.MSTP(41).EQ.1) MDCY(KC,1)=MSTP(41) + DO 170 J=1,MDCY(KC,3) + IDC=J+MDCY(KC,2)-1 + BRAT(IDC)=0D0 + IF(WDTP(0).GT.0D0) BRAT(IDC)=WDTP(J)/WDTP(0) + 170 CONTINUE + ENDIF + 180 CONTINUE + +C...Flavours of leptoquark: redefine charge and name. + KFLQQ=KFDP(MDCY(42,2),1) + KFLQL=KFDP(MDCY(42,2),2) + KCHG(42,1)=KCHG(PYCOMP(KFLQQ),1)*ISIGN(1,KFLQQ)+ + &KCHG(PYCOMP(KFLQL),1)*ISIGN(1,KFLQL) + LL=1 + IF(IABS(KFLQL).EQ.13) LL=2 + IF(IABS(KFLQL).EQ.15) LL=3 + CHAF(42,1)='LQ_'//CHAF(IABS(KFLQQ),1)(1:1)// + &CHAF(IABS(KFLQL),1)(1:LL)//' ' + CHAF(42,2)=CHAF(42,2)(1:4+LL)//'bar ' + +C...Special cases in treatment of gamma*/Z0: redefine process name. + IF(MSTP(43).EQ.1) THEN + PROC(1)='f + fbar -> gamma*' + PROC(15)='f + fbar -> g + gamma*' + PROC(19)='f + fbar -> gamma + gamma*' + PROC(30)='f + g -> f + gamma*' + PROC(35)='f + gamma -> f + gamma*' + ELSEIF(MSTP(43).EQ.2) THEN + PROC(1)='f + fbar -> Z0' + PROC(15)='f + fbar -> g + Z0' + PROC(19)='f + fbar -> gamma + Z0' + PROC(30)='f + g -> f + Z0' + PROC(35)='f + gamma -> f + Z0' + ELSEIF(MSTP(43).EQ.3) THEN + PROC(1)='f + fbar -> gamma*/Z0' + PROC(15)='f + fbar -> g + gamma*/Z0' + PROC(19)='f+ fbar -> gamma + gamma*/Z0' + PROC(30)='f + g -> f + gamma*/Z0' + PROC(35)='f + gamma -> f + gamma*/Z0' + ENDIF + +C...Special cases in treatment of gamma*/Z0/Z'0: redefine process name. + IF(MSTP(44).EQ.1) THEN + PROC(141)='f + fbar -> gamma*' + ELSEIF(MSTP(44).EQ.2) THEN + PROC(141)='f + fbar -> Z0' + ELSEIF(MSTP(44).EQ.3) THEN + PROC(141)='f + fbar -> Z''0' + ELSEIF(MSTP(44).EQ.4) THEN + PROC(141)='f + fbar -> gamma*/Z0' + ELSEIF(MSTP(44).EQ.5) THEN + PROC(141)='f + fbar -> gamma*/Z''0' + ELSEIF(MSTP(44).EQ.6) THEN + PROC(141)='f + fbar -> Z0/Z''0' + ELSEIF(MSTP(44).EQ.7) THEN + PROC(141)='f + fbar -> gamma*/Z0/Z''0' + ENDIF + +C...Special cases in treatment of WW -> WW: redefine process name. + IF(MSTP(45).EQ.1) THEN + PROC(77)='W+ + W+ -> W+ + W+' + ELSEIF(MSTP(45).EQ.2) THEN + PROC(77)='W+ + W- -> W+ + W-' + ELSEIF(MSTP(45).EQ.3) THEN + PROC(77)='W+/- + W+/- -> W+/- + W+/-' + ENDIF + +C...Format for error information. + 5000 FORMAT(1X,'Error: unphysical input tan^2(beta) and m_H ', + &'combination'/1X,'Execution stopped!') + + RETURN + END + +C********************************************************************* + +C...PYINBM +C...Identifies the two incoming particles and the choice of frame. + + SUBROUTINE PYINBM(CHFRAM,CHBEAM,CHTARG,WIN) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP + +C...User process initialization commonblock. + INTEGER MAXPUP + PARAMETER (MAXPUP=100) + INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP + DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP + COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), + &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), + &LPRUP(MAXPUP) + SAVE /HEPRUP/ + +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ + +C...Local arrays, character variables and data. + CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHCOM(3)*12,CHALP(2)*26, + &CHIDNT(3)*12,CHTEMP*12,CHCDE(39)*12,CHINIT*76,CHNAME*16 + DIMENSION LEN(3),KCDE(39),PM(2) + DATA CHALP/'abcdefghijklmnopqrstuvwxyz', + &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ + DATA CHCDE/ 'e- ','e+ ','nu_e ', + &'nu_ebar ','mu- ','mu+ ','nu_mu ', + &'nu_mubar ','tau- ','tau+ ','nu_tau ', + &'nu_taubar ','pi+ ','pi- ','n0 ', + &'nbar0 ','p+ ','pbar- ','gamma ', + &'lambda0 ','sigma- ','sigma0 ','sigma+ ', + &'xi- ','xi0 ','omega- ','pi0 ', + &'reggeon ','pomeron ','gamma/e- ','gamma/e+ ', + &'gamma/mu- ','gamma/mu+ ','gamma/tau- ','gamma/tau+ ', + &'k+ ','k- ','ks0 ','kl0 '/ + DATA KCDE/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16, + &211,-211,2112,-2112,2212,-2212,22,3122,3112,3212,3222, + &3312,3322,3334,111,110,990,6*22,321,-321,310,130/ + +C...Store initial energy. Default frame. + VINT(290)=WIN + MINT(111)=0 + +C...Special user process initialization; convert to normal input. + IF(CHFRAM(1:1).EQ.'u'.OR.CHFRAM(1:1).EQ.'U') THEN + MINT(111)=11 + IF(PDFGUP(1).EQ.-9.OR.PDFGUP(2).EQ.-9) MINT(111)=12 + CALL PYNAME(IDBMUP(1),CHNAME) + CHBEAM=CHNAME(1:12) + CALL PYNAME(IDBMUP(2),CHNAME) + CHTARG=CHNAME(1:12) + ENDIF + +C...Convert character variables to lowercase and find their length. + CHCOM(1)=CHFRAM + CHCOM(2)=CHBEAM + CHCOM(3)=CHTARG + DO 130 I=1,3 + LEN(I)=12 + DO 110 LL=12,1,-1 + IF(LEN(I).EQ.LL.AND.CHCOM(I)(LL:LL).EQ.' ') LEN(I)=LL-1 + DO 100 LA=1,26 + IF(CHCOM(I)(LL:LL).EQ.CHALP(2)(LA:LA)) CHCOM(I)(LL:LL)= + & CHALP(1)(LA:LA) + 100 CONTINUE + 110 CONTINUE + CHIDNT(I)=CHCOM(I) + +C...Fix up bar, underscore and charge in particle name (if needed). + DO 120 LL=1,10 + IF(CHIDNT(I)(LL:LL).EQ.'~') THEN + CHTEMP=CHIDNT(I) + CHIDNT(I)=CHTEMP(1:LL-1)//'bar'//CHTEMP(LL+1:10)//' ' + ENDIF + 120 CONTINUE + IF(CHIDNT(I)(1:2).EQ.'nu'.AND.CHIDNT(I)(3:3).NE.'_') THEN + CHTEMP=CHIDNT(I) + CHIDNT(I)='nu_'//CHTEMP(3:7) + ELSEIF(CHIDNT(I)(1:2).EQ.'n ') THEN + CHIDNT(I)(1:3)='n0 ' + ELSEIF(CHIDNT(I)(1:4).EQ.'nbar') THEN + CHIDNT(I)(1:5)='nbar0' + ELSEIF(CHIDNT(I)(1:2).EQ.'p ') THEN + CHIDNT(I)(1:3)='p+ ' + ELSEIF(CHIDNT(I)(1:4).EQ.'pbar'.OR. + & CHIDNT(I)(1:2).EQ.'p-') THEN + CHIDNT(I)(1:5)='pbar-' + ELSEIF(CHIDNT(I)(1:6).EQ.'lambda') THEN + CHIDNT(I)(7:7)='0' + ELSEIF(CHIDNT(I)(1:3).EQ.'reg') THEN + CHIDNT(I)(1:7)='reggeon' + ELSEIF(CHIDNT(I)(1:3).EQ.'pom') THEN + CHIDNT(I)(1:7)='pomeron' + ENDIF + 130 CONTINUE + +C...Identify free initialization. + IF(CHCOM(1)(1:2).EQ.'no') THEN + MINT(65)=1 + RETURN + ENDIF + +C...Identify incoming beam and target particles. + DO 160 I=1,2 + DO 140 J=1,39 + IF(CHIDNT(I+1).EQ.CHCDE(J)) MINT(10+I)=KCDE(J) + 140 CONTINUE + PM(I)=PYMASS(MINT(10+I)) + VINT(2+I)=PM(I) + MINT(140+I)=0 + IF(MINT(10+I).EQ.22.AND.CHIDNT(I+1)(6:6).EQ.'/') THEN + CHTEMP=CHIDNT(I+1)(7:12)//' ' + DO 150 J=1,12 + IF(CHTEMP.EQ.CHCDE(J)) MINT(140+I)=KCDE(J) + 150 CONTINUE + PM(I)=PYMASS(MINT(140+I)) + VINT(302+I)=PM(I) + ENDIF + 160 CONTINUE + IF(MINT(11).EQ.0) WRITE(MSTU(11),5000) CHBEAM(1:LEN(2)) + IF(MINT(12).EQ.0) WRITE(MSTU(11),5100) CHTARG(1:LEN(3)) + IF(MINT(11).EQ.0.OR.MINT(12).EQ.0) CALL PYSTOP(7) + +C...Identify choice of frame and input energies. + CHINIT=' ' + +C...Events defined in the CM frame. + IF(CHCOM(1)(1:2).EQ.'cm') THEN + MINT(111)=1 + S=WIN**2 + IF(MSTP(122).GE.1) THEN + IF(CHCOM(2)(1:1).NE.'e') THEN + LOFFS=(31-(LEN(2)+LEN(3)))/2 + CHINIT(LOFFS+1:76)='PYTHIA will be initialized for a '// + & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// + & ' collider'//' ' + ELSE + LOFFS=(30-(LEN(2)+LEN(3)))/2 + CHINIT(LOFFS+1:76)='PYTHIA will be initialized for an '// + & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// + & ' collider'//' ' + ENDIF + WRITE(MSTU(11),5200) CHINIT + WRITE(MSTU(11),5300) WIN + ENDIF + +C...Events defined in fixed target frame. + ELSEIF(CHCOM(1)(1:3).EQ.'fix') THEN + MINT(111)=2 + S=PM(1)**2+PM(2)**2+2D0*PM(2)*SQRT(PM(1)**2+WIN**2) + IF(MSTP(122).GE.1) THEN + LOFFS=(29-(LEN(2)+LEN(3)))/2 + CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// + & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// + & ' fixed target'//' ' + WRITE(MSTU(11),5200) CHINIT + WRITE(MSTU(11),5400) WIN + WRITE(MSTU(11),5500) SQRT(S) + ENDIF + +C...Frame defined by user three-vectors. + ELSEIF(CHCOM(1)(1:1).EQ.'3') THEN + MINT(111)=3 + P(1,5)=PM(1) + P(2,5)=PM(2) + P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2) + P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2) + S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- + & (P(1,3)+P(2,3))**2 + IF(MSTP(122).GE.1) THEN + LOFFS=(22-(LEN(2)+LEN(3)))/2 + CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// + & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// + & ' user configuration'//' ' + WRITE(MSTU(11),5200) CHINIT + WRITE(MSTU(11),5600) + WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) + WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) + WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) + ENDIF + +C...Frame defined by user four-vectors. + ELSEIF(CHCOM(1)(1:1).EQ.'4') THEN + MINT(111)=4 + PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2 + P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1) + PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2 + P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2) + S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- + & (P(1,3)+P(2,3))**2 + IF(MSTP(122).GE.1) THEN + LOFFS=(22-(LEN(2)+LEN(3)))/2 + CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// + & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// + & ' user configuration'//' ' + WRITE(MSTU(11),5200) CHINIT + WRITE(MSTU(11),5600) + WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) + WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) + WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) + ENDIF + +C...Frame defined by user five-vectors. + ELSEIF(CHCOM(1)(1:1).EQ.'5') THEN + MINT(111)=5 + S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- + & (P(1,3)+P(2,3))**2 + IF(MSTP(122).GE.1) THEN + LOFFS=(22-(LEN(2)+LEN(3)))/2 + CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// + & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// + & ' user configuration'//' ' + WRITE(MSTU(11),5200) CHINIT + WRITE(MSTU(11),5600) + WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) + WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) + WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) + ENDIF + +C...Frame defined by HEPRUP common block. + ELSEIF(MINT(111).GE.11) THEN + S=(EBMUP(1)+EBMUP(2))**2-(SQRT(MAX(0D0,EBMUP(1)**2-PM(1)**2))- + & SQRT(MAX(0D0,EBMUP(2)**2-PM(2)**2)))**2 + IF(MSTP(122).GE.1) THEN + LOFFS=(22-(LEN(2)+LEN(3)))/2 + CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// + & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// + & ' user configuration'//' ' + WRITE(MSTU(11),5200) CHINIT + WRITE(MSTU(11),6000) EBMUP(1),EBMUP(2) + WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) + ENDIF + +C...Unknown frame. Error for too low CM energy. + ELSE + WRITE(MSTU(11),5800) CHFRAM(1:LEN(1)) + CALL PYSTOP(7) + ENDIF + IF(S.LT.PARP(2)**2) THEN + WRITE(MSTU(11),5900) SQRT(S) + CALL PYSTOP(7) + ENDIF + +C...Formats for initialization and error information. + 5000 FORMAT(1X,'Error: unrecognized beam particle ''',A,'''D0'/ + &1X,'Execution stopped!') + 5100 FORMAT(1X,'Error: unrecognized target particle ''',A,'''D0'/ + &1X,'Execution stopped!') + 5200 FORMAT(/1X,78('=')/1X,'I',76X,'I'/1X,'I',A76,'I') + 5300 FORMAT(1X,'I',18X,'at',1X,F10.3,1X,'GeV center-of-mass energy', + &19X,'I'/1X,'I',76X,'I'/1X,78('=')) + 5400 FORMAT(1X,'I',22X,'at',1X,F10.3,1X,'GeV/c lab-momentum',22X,'I') + 5500 FORMAT(1X,'I',76X,'I'/1X,'I',11X,'corresponding to',1X,F10.3,1X, + &'GeV center-of-mass energy',12X,'I'/1X,'I',76X,'I'/1X,78('=')) + 5600 FORMAT(1X,'I',76X,'I'/1X,'I',18X,'px (GeV/c)',3X,'py (GeV/c)',3X, + &'pz (GeV/c)',6X,'E (GeV)',9X,'I') + 5700 FORMAT(1X,'I',8X,A8,4(2X,F10.3,1X),8X,'I') + 5800 FORMAT(1X,'Error: unrecognized coordinate frame ''',A,'''D0'/ + &1X,'Execution stopped!') + 5900 FORMAT(1X,'Error: too low CM energy,',F8.3,' GeV for event ', + &'generation.'/1X,'Execution stopped!') + 6000 FORMAT(1X,'I',12X,'with',1X,F10.3,1X,'GeV on',1X,F10.3,1X, + &'GeV beam energies',13X,'I') + + RETURN + END + +C********************************************************************* + +C...PYINKI +C...Sets up kinematics, including rotations and boosts to/from CM frame. + + SUBROUTINE PYINKI(MODKI) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP + +C...User process initialization commonblock. + INTEGER MAXPUP + PARAMETER (MAXPUP=100) + INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP + DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP + COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), + &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), + &LPRUP(MAXPUP) + SAVE /HEPRUP/ + +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ + +C...Set initial flavour state. + N=2 + DO 100 I=1,2 + K(I,1)=1 + K(I,2)=MINT(10+I) + IF(MINT(140+I).NE.0) K(I,2)=MINT(140+I) + 100 CONTINUE + +C...Reset boost. Do kinematics for various cases. + DO 110 J=6,10 + VINT(J)=0D0 + 110 CONTINUE + +C...Set up kinematics for events defined in CM frame. + IF(MINT(111).EQ.1) THEN + WIN=VINT(290) + IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290) + S=WIN**2 + P(1,5)=VINT(3) + P(2,5)=VINT(4) + IF(MINT(141).NE.0) P(1,5)=VINT(303) + IF(MINT(142).NE.0) P(2,5)=VINT(304) + P(1,1)=0D0 + P(1,2)=0D0 + P(2,1)=0D0 + P(2,2)=0D0 + P(1,3)=SQRT(((S-P(1,5)**2-P(2,5)**2)**2-(2D0*P(1,5)*P(2,5))**2)/ + & (4D0*S)) + P(2,3)=-P(1,3) + P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) + P(2,4)=SQRT(P(2,3)**2+P(2,5)**2) + +C...Set up kinematics for fixed target events. + ELSEIF(MINT(111).EQ.2) THEN + WIN=VINT(290) + IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290) + P(1,5)=VINT(3) + P(2,5)=VINT(4) + IF(MINT(141).NE.0) P(1,5)=VINT(303) + IF(MINT(142).NE.0) P(2,5)=VINT(304) + P(1,1)=0D0 + P(1,2)=0D0 + P(2,1)=0D0 + P(2,2)=0D0 + P(1,3)=WIN + P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) + P(2,3)=0D0 + P(2,4)=P(2,5) + S=P(1,5)**2+P(2,5)**2+2D0*P(2,4)*P(1,4) + VINT(10)=P(1,3)/(P(1,4)+P(2,4)) + CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10)) + +C...Set up kinematics for events in user-defined frame. + ELSEIF(MINT(111).EQ.3) THEN + P(1,5)=VINT(3) + P(2,5)=VINT(4) + IF(MINT(141).NE.0) P(1,5)=VINT(303) + IF(MINT(142).NE.0) P(2,5)=VINT(304) + P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2) + P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2) + DO 120 J=1,3 + VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) + 120 CONTINUE + CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) + VINT(7)=PYANGL(P(1,1),P(1,2)) + CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) + VINT(6)=PYANGL(P(1,3),P(1,1)) + CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) + S=P(1,5)**2+P(2,5)**2+2D0*(P(1,4)*P(2,4)-P(1,3)*P(2,3)) + +C...Set up kinematics for events with user-defined four-vectors. + ELSEIF(MINT(111).EQ.4) THEN + PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2 + P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1) + PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2 + P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2) + DO 130 J=1,3 + VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) + 130 CONTINUE + CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) + VINT(7)=PYANGL(P(1,1),P(1,2)) + CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) + VINT(6)=PYANGL(P(1,3),P(1,1)) + CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) + S=(P(1,4)+P(2,4))**2 + +C...Set up kinematics for events with user-defined five-vectors. + ELSEIF(MINT(111).EQ.5) THEN + DO 140 J=1,3 + VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) + 140 CONTINUE + CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) + VINT(7)=PYANGL(P(1,1),P(1,2)) + CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) + VINT(6)=PYANGL(P(1,3),P(1,1)) + CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) + S=(P(1,4)+P(2,4))**2 + +C...Set up kinematics for events with external user processes. + ELSEIF(MINT(111).GE.11) THEN + P(1,5)=VINT(3) + P(2,5)=VINT(4) + IF(MINT(141).NE.0) P(1,5)=VINT(303) + IF(MINT(142).NE.0) P(2,5)=VINT(304) + P(1,1)=0D0 + P(1,2)=0D0 + P(2,1)=0D0 + P(2,2)=0D0 + P(1,3)=SQRT(MAX(0D0,EBMUP(1)**2-P(1,5)**2)) + P(2,3)=-SQRT(MAX(0D0,EBMUP(2)**2-P(2,5)**2)) + P(1,4)=EBMUP(1) + P(2,4)=EBMUP(2) + VINT(10)=(P(1,3)+P(2,3))/(P(1,4)+P(2,4)) + CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10)) + S=(P(1,4)+P(2,4))**2 + ENDIF + +C...Return or error for too low CM energy. + IF(MODKI.EQ.1.AND.S.LT.PARP(2)**2) THEN + IF(MSTP(172).LE.1) THEN + CALL PYERRM(23, + & '(PYINKI:) too low invariant mass in this event') + ELSE + MSTI(61)=1 + RETURN + ENDIF + ENDIF + +C...Save information on incoming particles. + VINT(1)=SQRT(S) + VINT(2)=S + IF(MINT(111).GE.4) THEN + IF(MINT(141).EQ.0) THEN + VINT(3)=P(1,5) + IF(MINT(11).EQ.22.AND.P(1,5).LT.0) VINT(307)=P(1,5)**2 + ELSE + VINT(303)=P(1,5) + ENDIF + IF(MINT(142).EQ.0) THEN + VINT(4)=P(2,5) + IF(MINT(12).EQ.22.AND.P(2,5).LT.0) VINT(308)=P(2,5)**2 + ELSE + VINT(304)=P(2,5) + ENDIF + ENDIF + VINT(5)=P(1,3) + IF(MODKI.EQ.0) VINT(289)=S + DO 150 J=1,5 + V(1,J)=0D0 + V(2,J)=0D0 + VINT(290+J)=P(1,J) + VINT(295+J)=P(2,J) + 150 CONTINUE + +C...Store pT cut-off and related constants to be used in generation. + IF(MODKI.EQ.0) VINT(285)=CKIN(3) + IF(MSTP(82).LE.1) THEN + PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) + ELSE + PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) + ENDIF + VINT(149)=4D0*PTMN**2/S + VINT(154)=PTMN + + RETURN + END + +C********************************************************************* + +C...PYINPR +C...Selects partonic subprocesses to be included in the simulation. + + SUBROUTINE PYINPR + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP + +C...User process initialization commonblock. + INTEGER MAXPUP + PARAMETER (MAXPUP=100) + INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP + DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP + COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), + &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), + &LPRUP(MAXPUP) + SAVE /HEPRUP/ + +C...Commonblocks and character variables. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT6/PROC(0:500) + CHARACTER PROC*28 + SAVE /PYDAT1/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, + &/PYINT6/ + CHARACTER CHIPR*10 + +C...Reset processes to be included. + IF(MSEL.NE.0) THEN + DO 100 I=1,500 + MSUB(I)=0 + 100 CONTINUE + ENDIF + +C...Set running pTmin scale. + IF(MSTP(82).LE.1) THEN + PTMRUN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) + ELSE + PTMRUN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) + ENDIF + +C...Begin by assuming incoming photon to enter subprocess. + IF(MINT(11).EQ.22) MINT(15)=22 + IF(MINT(12).EQ.22) MINT(16)=22 + +C...For e-gamma with MSTP(14)=10 allow mixture of VMD and anomalous. + IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN + MSUB(10)=1 + MINT(123)=MINT(122)+1 + +C...For gamma-p or gamma-gamma with MSTP(14) = 10, 20, 25 or 30 +C...allow mixture. +C...Here also set a few parameters otherwise normally not touched. + ELSEIF(MINT(121).GT.1) THEN + +C...Parton distributions dampened at small Q2; go to low energies, +C...alpha_s <1; no minimum pT cut-off a priori. + IF(MSTP(18).EQ.2) THEN + MSTP(57)=3 + PARP(2)=2D0 + PARU(115)=1D0 + CKIN(5)=0.2D0 + CKIN(6)=0.2D0 + ENDIF + +C...Define pT cut-off parameters and whether run involves low-pT. + PTMVMD=PTMRUN + VINT(154)=PTMVMD + PTMDIR=PTMVMD + IF(MSTP(18).EQ.2) PTMDIR=PARP(15) + PTMANO=PTMVMD + IF(MSTP(15).EQ.5) PTMANO=0.60D0+ + & 0.125D0*LOG(1D0+0.10D0*VINT(1))**2 + IPTL=1 + IF(VINT(285).GT.MAX(PTMVMD,PTMDIR,PTMANO)) IPTL=0 + IF(MSEL.EQ.2) IPTL=1 + +C...Set up for p/gamma * gamma; real or virtual photons. + IF(MINT(121).EQ.3.OR.MINT(121).EQ.6.OR.(MINT(121).EQ.4.AND. + & MSTP(14).EQ.30)) THEN + +C...Set up for p/VMD * VMD. + IF(MINT(122).EQ.1) THEN + MINT(123)=2 + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + IF(IPTL.EQ.1) MSUB(95)=1 + IF(MSEL.EQ.2) THEN + MSUB(91)=1 + MSUB(92)=1 + MSUB(93)=1 + MSUB(94)=1 + ENDIF + IF(IPTL.EQ.1) CKIN(3)=0D0 + +C...Set up for p/VMD * direct gamma. + ELSEIF(MINT(122).EQ.2) THEN + MINT(123)=0 + IF(MINT(121).EQ.6) MINT(123)=5 + MSUB(131)=1 + MSUB(132)=1 + MSUB(135)=1 + MSUB(136)=1 + IF(IPTL.EQ.1) CKIN(3)=PTMDIR + +C...Set up for p/VMD * anomalous gamma. + ELSEIF(MINT(122).EQ.3) THEN + MINT(123)=3 + IF(MINT(121).EQ.6) MINT(123)=7 + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + IF(IPTL.EQ.1) MSUB(95)=1 + IF(MSEL.EQ.2) THEN + MSUB(91)=1 + MSUB(92)=1 + MSUB(93)=1 + MSUB(94)=1 + ENDIF + IF(IPTL.EQ.1) CKIN(3)=0D0 + +C...Set up for DIS * p. + ELSEIF(MINT(122).EQ.4.AND.(IABS(MINT(11)).GT.100.OR. + & IABS(MINT(12)).GT.100)) THEN + MINT(123)=8 + IF(IPTL.EQ.1) MSUB(99)=1 + +C...Set up for direct * direct gamma (switch off leptons). + ELSEIF(MINT(122).EQ.4) THEN + MINT(123)=0 + MSUB(137)=1 + MSUB(138)=1 + MSUB(139)=1 + MSUB(140)=1 + DO 110 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 + IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) + 110 CONTINUE + IF(IPTL.EQ.1) CKIN(3)=PTMDIR + +C...Set up for direct * anomalous gamma. + ELSEIF(MINT(122).EQ.5) THEN + MINT(123)=6 + MSUB(131)=1 + MSUB(132)=1 + MSUB(135)=1 + MSUB(136)=1 + IF(IPTL.EQ.1) CKIN(3)=PTMANO + +C...Set up for anomalous * anomalous gamma. + ELSEIF(MINT(122).EQ.6) THEN + MINT(123)=3 + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + IF(IPTL.EQ.1) MSUB(95)=1 + IF(MSEL.EQ.2) THEN + MSUB(91)=1 + MSUB(92)=1 + MSUB(93)=1 + MSUB(94)=1 + ENDIF + IF(IPTL.EQ.1) CKIN(3)=0D0 + ENDIF + +C...Set up for gamma* * gamma*; virtual photons = dir, VMD, anom. + ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN + +C...Set up for direct * direct gamma (switch off leptons). + IF(MINT(122).EQ.1) THEN + MINT(123)=0 + MSUB(137)=1 + MSUB(138)=1 + MSUB(139)=1 + MSUB(140)=1 + DO 120 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 + IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) + 120 CONTINUE + IF(IPTL.EQ.1) CKIN(3)=PTMDIR + +C...Set up for direct * VMD and VMD * direct gamma. + ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.4) THEN + MINT(123)=5 + MSUB(131)=1 + MSUB(132)=1 + MSUB(135)=1 + MSUB(136)=1 + IF(IPTL.EQ.1) CKIN(3)=PTMDIR + +C...Set up for direct * anomalous and anomalous * direct gamma. + ELSEIF(MINT(122).EQ.3.OR.MINT(122).EQ.7) THEN + MINT(123)=6 + MSUB(131)=1 + MSUB(132)=1 + MSUB(135)=1 + MSUB(136)=1 + IF(IPTL.EQ.1) CKIN(3)=PTMANO + +C...Set up for VMD*VMD. + ELSEIF(MINT(122).EQ.5) THEN + MINT(123)=2 + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + IF(IPTL.EQ.1) MSUB(95)=1 + IF(MSEL.EQ.2) THEN + MSUB(91)=1 + MSUB(92)=1 + MSUB(93)=1 + MSUB(94)=1 + ENDIF + IF(IPTL.EQ.1) CKIN(3)=0D0 + +C...Set up for VMD * anomalous and anomalous * VMD gamma. + ELSEIF(MINT(122).EQ.6.OR.MINT(122).EQ.8) THEN + MINT(123)=7 + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + IF(IPTL.EQ.1) MSUB(95)=1 + IF(MSEL.EQ.2) THEN + MSUB(91)=1 + MSUB(92)=1 + MSUB(93)=1 + MSUB(94)=1 + ENDIF + IF(IPTL.EQ.1) CKIN(3)=0D0 + +C...Set up for anomalous * anomalous gamma. + ELSEIF(MINT(122).EQ.9) THEN + MINT(123)=3 + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + IF(IPTL.EQ.1) MSUB(95)=1 + IF(MSEL.EQ.2) THEN + MSUB(91)=1 + MSUB(92)=1 + MSUB(93)=1 + MSUB(94)=1 + ENDIF + IF(IPTL.EQ.1) CKIN(3)=0D0 + +C...Set up for DIS * VMD and VMD * DIS gamma. + ELSEIF(MINT(122).EQ.10.OR.MINT(122).EQ.12) THEN + MINT(123)=8 + IF(IPTL.EQ.1) MSUB(99)=1 + +C...Set up for DIS * anomalous and anomalous * DIS gamma. + ELSEIF(MINT(122).EQ.11.OR.MINT(122).EQ.13) THEN + MINT(123)=9 + IF(IPTL.EQ.1) MSUB(99)=1 + ENDIF + +C...Set up for gamma* * p; virtual photons = dir, res. + ELSEIF(MINT(121).EQ.2) THEN + +C...Set up for direct * p. + IF(MINT(122).EQ.1) THEN + MINT(123)=0 + MSUB(131)=1 + MSUB(132)=1 + MSUB(135)=1 + MSUB(136)=1 + IF(IPTL.EQ.1) CKIN(3)=PTMDIR + +C...Set up for resolved * p. + ELSEIF(MINT(122).EQ.2) THEN + MINT(123)=1 + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + IF(IPTL.EQ.1) MSUB(95)=1 + IF(MSEL.EQ.2) THEN + MSUB(91)=1 + MSUB(92)=1 + MSUB(93)=1 + MSUB(94)=1 + ENDIF + IF(IPTL.EQ.1) CKIN(3)=0D0 + ENDIF + +C...Set up for gamma* * gamma*; virtual photons = dir, res. + ELSEIF(MINT(121).EQ.4) THEN + +C...Set up for direct * direct gamma (switch off leptons). + IF(MINT(122).EQ.1) THEN + MINT(123)=0 + MSUB(137)=1 + MSUB(138)=1 + MSUB(139)=1 + MSUB(140)=1 + DO 130 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 + IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) + 130 CONTINUE + IF(IPTL.EQ.1) CKIN(3)=PTMDIR + +C...Set up for direct * resolved and resolved * direct gamma. + ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.3) THEN + MINT(123)=5 + MSUB(131)=1 + MSUB(132)=1 + MSUB(135)=1 + MSUB(136)=1 + IF(IPTL.EQ.1) CKIN(3)=PTMDIR + +C...Set up for resolved * resolved gamma. + ELSEIF(MINT(122).EQ.4) THEN + MINT(123)=2 + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + IF(IPTL.EQ.1) MSUB(95)=1 + IF(MSEL.EQ.2) THEN + MSUB(91)=1 + MSUB(92)=1 + MSUB(93)=1 + MSUB(94)=1 + ENDIF + IF(IPTL.EQ.1) CKIN(3)=0D0 + ENDIF + +C...End of special set up for gamma-p and gamma-gamma. + ENDIF + CKIN(1)=2D0*CKIN(3) + ENDIF + +C...Flavour information for individual beams. + DO 140 I=1,2 + MINT(40+I)=1 + IF(MINT(123).GE.1.AND.MINT(10+I).EQ.22) MINT(40+I)=2 + IF(IABS(MINT(10+I)).GT.100) MINT(40+I)=2 + MINT(44+I)=MINT(40+I) + IF(MSTP(11).GE.1.AND.(IABS(MINT(10+I)).EQ.11.OR. + & IABS(MINT(10+I)).EQ.13.OR.IABS(MINT(10+I)).EQ.15)) MINT(44+I)=3 + 140 CONTINUE + +C...If two real gammas, whereof one direct, pick the first. +C...For two virtual photons, keep requested order. + IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN + IF(MSTP(14).LE.10.AND.MINT(123).GE.4.AND.MINT(123).LE.6) THEN + MINT(41)=1 + MINT(45)=1 + ELSEIF(MSTP(14).EQ.12.OR.MSTP(14).EQ.13.OR.MSTP(14).EQ.22.OR. + & MSTP(14).EQ.26.OR.MSTP(14).EQ.27) THEN + MINT(41)=1 + MINT(45)=1 + ELSEIF(MSTP(14).EQ.14.OR.MSTP(14).EQ.17.OR.MSTP(14).EQ.23.OR. + & MSTP(14).EQ.28.OR.MSTP(14).EQ.29) THEN + MINT(42)=1 + MINT(46)=1 + ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.2 + & .OR.MINT(122).EQ.3.OR.MINT(122).EQ.10.OR.MINT(122).EQ.11)) THEN + MINT(41)=1 + MINT(45)=1 + ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.4 + & .OR.MINT(122).EQ.7.OR.MINT(122).EQ.12.OR.MINT(122).EQ.13)) THEN + MINT(42)=1 + MINT(46)=1 + ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.2) THEN + MINT(41)=1 + MINT(45)=1 + ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.3) THEN + MINT(42)=1 + MINT(46)=1 + ENDIF + ELSEIF(MINT(11).EQ.22.OR.MINT(12).EQ.22) THEN + IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28.OR.MINT(122).EQ.4) THEN + IF(MINT(11).EQ.22) THEN + MINT(41)=1 + MINT(45)=1 + ELSE + MINT(42)=1 + MINT(46)=1 + ENDIF + ENDIF + IF(MINT(123).GE.4.AND.MINT(123).LE.7) CALL PYERRM(26, + & '(PYINPR:) unallowed MSTP(14) code for single photon') + ENDIF + +C...Flavour information on combination of incoming particles. + MINT(43)=2*MINT(41)+MINT(42)-2 + MINT(44)=MINT(43) + IF(MINT(123).LE.0) THEN + IF(MINT(11).EQ.22) MINT(43)=MINT(43)+2 + IF(MINT(12).EQ.22) MINT(43)=MINT(43)+1 + ELSEIF(MINT(123).LE.3) THEN + IF(MINT(11).EQ.22) MINT(44)=MINT(44)-2 + IF(MINT(12).EQ.22) MINT(44)=MINT(44)-1 + ELSEIF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN + MINT(43)=4 + MINT(44)=1 + ENDIF + MINT(47)=2*MIN(2,MINT(45))+MIN(2,MINT(46))-2 + IF(MIN(MINT(45),MINT(46)).EQ.3) MINT(47)=5 + IF(MINT(45).EQ.1.AND.MINT(46).EQ.3) MINT(47)=6 + IF(MINT(45).EQ.3.AND.MINT(46).EQ.1) MINT(47)=7 + MINT(50)=0 + IF(MINT(41).EQ.2.AND.MINT(42).EQ.2.AND.MINT(111).NE.12) MINT(50)=1 + MINT(107)=0 + MINT(108)=0 + IF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN + IF((MINT(122).GE.4.AND.MINT(122).LE.6).OR.MINT(122).EQ.12) + & MINT(107)=2 + IF((MINT(122).GE.7.AND.MINT(122).LE.9).OR.MINT(122).EQ.13) + & MINT(107)=3 + IF(MINT(122).EQ.10.OR.MINT(122).EQ.11) MINT(107)=4 + IF(MINT(122).EQ.2.OR.MINT(122).EQ.5.OR.MINT(122).EQ.8.OR. + & MINT(122).EQ.10) MINT(108)=2 + IF(MINT(122).EQ.3.OR.MINT(122).EQ.6.OR.MINT(122).EQ.9.OR. + & MINT(122).EQ.11) MINT(108)=3 + IF(MINT(122).EQ.12.OR.MINT(122).EQ.13) MINT(108)=4 + ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.25) THEN + IF(MINT(122).GE.3) MINT(107)=1 + IF(MINT(122).EQ.2.OR.MINT(122).EQ.4) MINT(108)=1 + ELSEIF(MINT(121).EQ.2) THEN + IF(MINT(122).EQ.2.AND.MINT(11).EQ.22) MINT(107)=1 + IF(MINT(122).EQ.2.AND.MINT(12).EQ.22) MINT(108)=1 + ELSE + IF(MINT(11).EQ.22) THEN + MINT(107)=MINT(123) + IF(MINT(123).GE.4) MINT(107)=0 + IF(MINT(123).EQ.7) MINT(107)=2 + IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.27) MINT(107)=4 + IF(MSTP(14).EQ.28) MINT(107)=2 + IF(MSTP(14).EQ.29) MINT(107)=3 + IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4) + & MINT(107)=4 + ENDIF + IF(MINT(12).EQ.22) THEN + MINT(108)=MINT(123) + IF(MINT(123).GE.4) MINT(108)=MINT(123)-3 + IF(MINT(123).EQ.7) MINT(108)=3 + IF(MSTP(14).EQ.26) MINT(108)=2 + IF(MSTP(14).EQ.27) MINT(108)=3 + IF(MSTP(14).EQ.28.OR.MSTP(14).EQ.29) MINT(108)=4 + IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4) + & MINT(108)=4 + ENDIF + IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.(MSTP(14).EQ.14.OR. + & MSTP(14).EQ.17.OR.MSTP(14).EQ.18.OR.MSTP(14).EQ.23)) THEN + MINTTP=MINT(107) + MINT(107)=MINT(108) + MINT(108)=MINTTP + ENDIF + ENDIF + IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0 + IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0 + +C...Select default processes according to incoming beams +C...(already done for gamma-p and gamma-gamma with +C...MSTP(14) = 10, 20, 25 or 30). + IF(MINT(121).GT.1) THEN + ELSEIF(MSEL.EQ.1.OR.MSEL.EQ.2) THEN + + IF(MINT(43).EQ.1) THEN +C...Lepton + lepton -> gamma/Z0 or W. + IF(MINT(11)+MINT(12).EQ.0) MSUB(1)=1 + IF(MINT(11)+MINT(12).NE.0) MSUB(2)=1 + + ELSEIF(MINT(43).LE.3.AND.MINT(123).EQ.0.AND. + & (MINT(11).EQ.22.OR.MINT(12).EQ.22)) THEN +C...Unresolved photon + lepton: Compton scattering. + MSUB(133)=1 + MSUB(134)=1 + + ELSEIF((MINT(123).EQ.8.OR.MINT(123).EQ.9).AND.(MINT(11).EQ.22 + & .OR.MINT(12).EQ.22)) THEN +C...DIS as pure gamma* + f -> f process. + MSUB(99)=1 + + ELSEIF(MINT(43).LE.3) THEN +C...Lepton + hadron: deep inelastic scattering. + MSUB(10)=1 + + ELSEIF(MINT(123).EQ.0.AND.MINT(11).EQ.22.AND. + & MINT(12).EQ.22) THEN +C...Two unresolved photons: fermion pair production, +C...exclude lepton pairs. + DO 150 ISUB=137,140 + MSUB(ISUB)=1 + 150 CONTINUE + DO 160 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 + IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) + 160 CONTINUE + PTMDIR=PTMRUN + IF(MSTP(18).EQ.2) PTMDIR=PARP(15) + IF(CKIN(3).LT.PTMRUN.OR.MSEL.EQ.2) CKIN(3)=PTMDIR + CKIN(1)=MAX(CKIN(1),2D0*CKIN(3)) + + ELSEIF((MINT(123).EQ.0.AND.(MINT(11).EQ.22.OR.MINT(12).EQ.22)) + & .OR.(MINT(123).GE.4.AND.MINT(123).LE.6.AND.MINT(11).EQ.22.AND. + & MINT(12).EQ.22)) THEN +C...Unresolved photon + hadron: photon-parton scattering. + DO 170 ISUB=131,136 + MSUB(ISUB)=1 + 170 CONTINUE + + ELSEIF(MSEL.EQ.1) THEN +C...High-pT QCD processes: + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + PTMN=PTMRUN + VINT(154)=PTMN + IF(CKIN(3).LT.PTMN) MSUB(95)=1 + IF(MSUB(95).EQ.1.AND.MINT(50).EQ.0) MSUB(95)=0 + + ELSE +C...All QCD processes: + MSUB(11)=1 + MSUB(12)=1 + MSUB(13)=1 + MSUB(28)=1 + MSUB(53)=1 + MSUB(68)=1 + MSUB(91)=1 + MSUB(92)=1 + MSUB(93)=1 + MSUB(94)=1 + MSUB(95)=1 + ENDIF + + ELSEIF(MSEL.GE.4.AND.MSEL.LE.8) THEN +C...Heavy quark production. + MSUB(81)=1 + MSUB(82)=1 + MSUB(84)=1 + DO 180 J=1,MIN(8,MDCY(21,3)) + MDME(MDCY(21,2)+J-1,1)=0 + 180 CONTINUE + MDME(MDCY(21,2)+MSEL-1,1)=1 + MSUB(85)=1 + DO 190 J=1,MIN(12,MDCY(22,3)) + MDME(MDCY(22,2)+J-1,1)=0 + 190 CONTINUE + MDME(MDCY(22,2)+MSEL-1,1)=1 + + ELSEIF(MSEL.EQ.10) THEN +C...Prompt photon production: + MSUB(14)=1 + MSUB(18)=1 + MSUB(29)=1 + + ELSEIF(MSEL.EQ.11) THEN +C...Z0/gamma* production: + MSUB(1)=1 + + ELSEIF(MSEL.EQ.12) THEN +C...W+/- production: + MSUB(2)=1 + + ELSEIF(MSEL.EQ.13) THEN +C...Z0 + jet: + MSUB(15)=1 + MSUB(30)=1 + + ELSEIF(MSEL.EQ.14) THEN +C...W+/- + jet: + MSUB(16)=1 + MSUB(31)=1 + + ELSEIF(MSEL.EQ.15) THEN +C...Z0 & W+/- pair production: + MSUB(19)=1 + MSUB(20)=1 + MSUB(22)=1 + MSUB(23)=1 + MSUB(25)=1 + + ELSEIF(MSEL.EQ.16) THEN +C...h0 production: + MSUB(3)=1 + MSUB(102)=1 + MSUB(103)=1 + MSUB(123)=1 + MSUB(124)=1 + + ELSEIF(MSEL.EQ.17) THEN +C...h0 & Z0 or W+/- pair production: + MSUB(24)=1 + MSUB(26)=1 + + ELSEIF(MSEL.EQ.18) THEN +C...h0 production; interesting processes in e+e-. + MSUB(24)=1 + MSUB(103)=1 + MSUB(123)=1 + MSUB(124)=1 + + ELSEIF(MSEL.EQ.19) THEN +C...h0, H0 and A0 production; interesting processes in e+e-. + MSUB(24)=1 + MSUB(103)=1 + MSUB(123)=1 + MSUB(124)=1 + MSUB(153)=1 + MSUB(171)=1 + MSUB(173)=1 + MSUB(174)=1 + MSUB(158)=1 + MSUB(176)=1 + MSUB(178)=1 + MSUB(179)=1 + + ELSEIF(MSEL.EQ.21) THEN +C...Z'0 production: + MSUB(141)=1 + + ELSEIF(MSEL.EQ.22) THEN +C...W'+/- production: + MSUB(142)=1 + + ELSEIF(MSEL.EQ.23) THEN +C...H+/- production: + MSUB(143)=1 + + ELSEIF(MSEL.EQ.24) THEN +C...R production: + MSUB(144)=1 + + ELSEIF(MSEL.EQ.25) THEN +C...LQ (leptoquark) production. + MSUB(145)=1 + MSUB(162)=1 + MSUB(163)=1 + MSUB(164)=1 + + ELSEIF(MSEL.GE.35.AND.MSEL.LE.38) THEN +C...Production of one heavy quark (W exchange): + MSUB(83)=1 + DO 200 J=1,MIN(8,MDCY(21,3)) + MDME(MDCY(21,2)+J-1,1)=0 + 200 CONTINUE + MDME(MDCY(21,2)+MSEL-31,1)=1 + +CMRENNA++Define SUSY alternatives. + ELSEIF(MSEL.EQ.39) THEN +C...Turn on all SUSY processes. + IF(MINT(43).EQ.4) THEN +C...Hadron-hadron processes. + DO 210 I=201,301 + IF(ISET(I).GE.0) MSUB(I)=1 + 210 CONTINUE + ELSEIF(MINT(43).EQ.1) THEN +C...Lepton-lepton processes: QED production of squarks. + DO 220 I=201,214 + MSUB(I)=1 + 220 CONTINUE + MSUB(210)=0 + MSUB(211)=0 + MSUB(212)=0 + DO 230 I=216,228 + MSUB(I)=1 + 230 CONTINUE + DO 240 I=261,263 + MSUB(I)=1 + 240 CONTINUE + MSUB(277)=1 + MSUB(278)=1 + ENDIF + + ELSEIF(MSEL.EQ.40) THEN +C...Gluinos and squarks. + IF(MINT(43).EQ.4) THEN + MSUB(243)=1 + MSUB(244)=1 + MSUB(258)=1 + MSUB(259)=1 + MSUB(261)=1 + MSUB(262)=1 + MSUB(264)=1 + MSUB(265)=1 + DO 250 I=271,296 + MSUB(I)=1 + 250 CONTINUE + ELSEIF(MINT(43).EQ.1) THEN + MSUB(277)=1 + MSUB(278)=1 + ENDIF + + ELSEIF(MSEL.EQ.41) THEN +C...Stop production. + MSUB(261)=1 + MSUB(262)=1 + MSUB(263)=1 + IF(MINT(43).EQ.4) THEN + MSUB(264)=1 + MSUB(265)=1 + ENDIF + + ELSEIF(MSEL.EQ.42) THEN +C...Slepton production. + DO 260 I=201,214 + MSUB(I)=1 + 260 CONTINUE + IF(MINT(43).NE.4) THEN + MSUB(210)=0 + MSUB(211)=0 + MSUB(212)=0 + ENDIF + + ELSEIF(MSEL.EQ.43) THEN +C...Neutralino/Chargino + Gluino/Squark. + IF(MINT(43).EQ.4) THEN + DO 270 I=237,242 + MSUB(I)=1 + 270 CONTINUE + DO 280 I=246,254 + MSUB(I)=1 + 280 CONTINUE + MSUB(256)=1 + ENDIF + + ELSEIF(MSEL.EQ.44) THEN +C...Neutralino/Chargino pair production. + IF(MINT(43).EQ.4) THEN + DO 290 I=216,236 + MSUB(I)=1 + 290 CONTINUE + ELSEIF(MINT(43).EQ.1) THEN + DO 300 I=216,228 + MSUB(I)=1 + 300 CONTINUE + ENDIF + + ELSEIF(MSEL.EQ.45) THEN +C...Sbottom production. + MSUB(287)=1 + MSUB(288)=1 + IF(MINT(43).EQ.4) THEN + DO 310 I=281,296 + MSUB(I)=1 + 310 CONTINUE + ENDIF + + ELSEIF(MSEL.EQ.50) THEN +C...Pair production of technipions and gauge bosons. + DO 320 I=361,368 + MSUB(I)=1 + 320 CONTINUE + IF(MINT(43).EQ.4) THEN + DO 330 I=370,377 + MSUB(I)=1 + 330 CONTINUE + ENDIF + + ELSEIF(MSEL.EQ.51) THEN +C...QCD 2 -> 2 processes with compositeness/technicolor modifications. + DO 340 I=381,386 + MSUB(I)=1 + 340 CONTINUE + + ELSEIF(MSEL.EQ.61) THEN +C...Charmonium production in colour octet model, with recoiling parton. + DO 342 I=421,439 + MSUB(I)=1 + 342 CONTINUE + + ELSEIF(MSEL.EQ.62) THEN +C...Bottomonium production in colour octet model, with recoiling parton. + DO 344 I=461,479 + MSUB(I)=1 + 344 CONTINUE + + ELSEIF(MSEL.EQ.63) THEN +C...Charmonium and bottomonium production in colour octet model. + DO 346 I=421,439 + MSUB(I)=1 + MSUB(I+40)=1 + 346 CONTINUE + ENDIF + +C...Find heaviest new quark flavour allowed in processes 81-84. + KFLQM=1 + DO 350 I=1,MIN(8,MDCY(21,3)) + IDC=I+MDCY(21,2)-1 + IF(MDME(IDC,1).LE.0) GOTO 350 + KFLQM=I + 350 CONTINUE + IF(MSTP(7).GE.1.AND.MSTP(7).LE.8.AND.(MSEL.LE.3.OR.MSEL.GE.9)) + &KFLQM=MSTP(7) + MINT(55)=KFLQM + KFPR(81,1)=KFLQM + KFPR(81,2)=KFLQM + KFPR(82,1)=KFLQM + KFPR(82,2)=KFLQM + KFPR(83,1)=KFLQM + KFPR(84,1)=KFLQM + KFPR(84,2)=KFLQM + +C...Find heaviest new fermion flavour allowed in process 85. + KFLFM=1 + DO 360 I=1,MIN(12,MDCY(22,3)) + IDC=I+MDCY(22,2)-1 + IF(MDME(IDC,1).LE.0) GOTO 360 + KFLFM=KFDP(IDC,1) + 360 CONTINUE + IF(((MSTP(7).GE.1.AND.MSTP(7).LE.8).OR.(MSTP(7).GE.11.AND. + &MSTP(7).LE.18)).AND.(MSEL.LE.3.OR.MSEL.GE.9)) KFLFM=MSTP(7) + MINT(56)=KFLFM + KFPR(85,1)=KFLFM + KFPR(85,2)=KFLFM + +C...Import relevant information on external user processes. + IF(MINT(111).GE.11) THEN + IPYPR=0 + DO 390 IUP=1,NPRUP +C...Find next empty PYTHIA process number slot and enable it. + 370 IPYPR=IPYPR+1 + IF(IPYPR.GT.500) CALL PYERRM(26, + & '(PYINPR.) no more empty slots for user processes') + IF(ISET(IPYPR).GE.0.AND.ISET(IPYPR).LE.9) GOTO 370 + IF(IPYPR.GE.91.AND.IPYPR.LE.100) GOTO 370 + ISET(IPYPR)=11 +C...Overwrite KFPR with references back to process number and ID. + KFPR(IPYPR,1)=IUP + KFPR(IPYPR,2)=LPRUP(IUP) +C...Process title. + WRITE(CHIPR,'(I10)') LPRUP(IUP) + ICHIN=1 + DO 380 ICH=1,9 + IF(CHIPR(ICH:ICH).EQ.' ') ICHIN=ICH+1 + 380 CONTINUE + PROC(IPYPR)='User process '//CHIPR(ICHIN:10)//' ' +C...Switch on process. + MSUB(IPYPR)=1 + 390 CONTINUE + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYXTOT +C...Parametrizes total, elastic and diffractive cross-sections +C...for different energies and beams. Donnachie-Landshoff for +C...total and Schuler-Sjostrand for elastic and diffractive. +C...Process code IPROC: +C...= 1 : p + p; +C...= 2 : pbar + p; +C...= 3 : pi+ + p; +C...= 4 : pi- + p; +C...= 5 : pi0 + p; +C...= 6 : phi + p; +C...= 7 : J/psi + p; +C...= 11 : rho + rho; +C...= 12 : rho + phi; +C...= 13 : rho + J/psi; +C...= 14 : phi + phi; +C...= 15 : phi + J/psi; +C...= 16 : J/psi + J/psi; +C...= 21 : gamma + p (DL); +C...= 22 : gamma + p (VDM). +C...= 23 : gamma + pi (DL); +C...= 24 : gamma + pi (VDM); +C...= 25 : gamma + gamma (DL); +C...= 26 : gamma + gamma (VDM). + + SUBROUTINE PYXTOT + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINT7/SIGT(0:6,0:6,0:5) + SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT5/,/PYINT7/ +C...Local arrays. + DIMENSION NPROC(30),XPAR(30),YPAR(30),IHADA(20),IHADB(20), + &PMHAD(4),BHAD(4),BETP(4),IFITSD(20),IFITDD(20),CEFFS(10,8), + &CEFFD(10,9),SIGTMP(6,0:5) + +C...Common constants. + DATA EPS/0.0808D0/, ETA/-0.4525D0/, ALP/0.25D0/, CRES/2D0/, + &PMRC/1.062D0/, SMP/0.880D0/, FACEL/0.0511D0/, FACSD/0.0336D0/, + &FACDD/0.0084D0/ + +C...Number of multiple processes to be evaluated (= 0 : undefined). + DATA NPROC/7*1,3*0,6*1,4*0,4*3,2*6,4*0/ +C...X and Y parameters of sigmatot = X * s**epsilon + Y * s**(-eta). + DATA XPAR/2*21.70D0,3*13.63D0,10.01D0,0.970D0,3*0D0, + &8.56D0,6.29D0,0.609D0,4.62D0,0.447D0,0.0434D0,4*0D0, + &0.0677D0,0.0534D0,0.0425D0,0.0335D0,2.11D-4,1.31D-4,4*0D0/ + DATA YPAR/ + &56.08D0,98.39D0,27.56D0,36.02D0,31.79D0,-1.51D0,-0.146D0,3*0D0, + &13.08D0,-0.62D0,-0.060D0,0.030D0,-0.0028D0,0.00028D0,4*0D0, + &0.129D0,0.115D0,0.081D0,0.072D0,2.15D-4,1.70D-4,4*0D0/ + +C...Beam and target hadron class: +C...= 1 : p/n ; = 2 : pi/rho/omega; = 3 : phi; = 4 : J/psi. + DATA IHADA/2*1,3*2,3,4,3*0,3*2,2*3,4,4*0/ + DATA IHADB/7*1,3*0,2,3,4,3,2*4,4*0/ +C...Characteristic class masses, slope parameters, beta = sqrt(X). + DATA PMHAD/0.938D0,0.770D0,1.020D0,3.097D0/ + DATA BHAD/2.3D0,1.4D0,1.4D0,0.23D0/ + DATA BETP/4.658D0,2.926D0,2.149D0,0.208D0/ + +C...Fitting constants used in parametrizations of diffractive results. + DATA IFITSD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/ + DATA IFITDD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/ + DATA ((CEFFS(J1,J2),J2=1,8),J1=1,10)/ + &0.213D0, 0.0D0, -0.47D0, 150D0, 0.213D0, 0.0D0, -0.47D0, 150D0, + &0.213D0, 0.0D0, -0.47D0, 150D0, 0.267D0, 0.0D0, -0.47D0, 100D0, + &0.213D0, 0.0D0, -0.47D0, 150D0, 0.232D0, 0.0D0, -0.47D0, 110D0, + &0.213D0, 7.0D0, -0.55D0, 800D0, 0.115D0, 0.0D0, -0.47D0, 110D0, + &0.267D0, 0.0D0, -0.46D0, 75D0, 0.267D0, 0.0D0, -0.46D0, 75D0, + &0.232D0, 0.0D0, -0.46D0, 85D0, 0.267D0, 0.0D0, -0.48D0, 100D0, + &0.115D0, 0.0D0, -0.50D0, 90D0, 0.267D0, 6.0D0, -0.56D0, 420D0, + &0.232D0, 0.0D0, -0.48D0, 110D0, 0.232D0, 0.0D0, -0.48D0, 110D0, + &0.115D0, 0.0D0, -0.52D0, 120D0, 0.232D0, 6.0D0, -0.56D0, 470D0, + &0.115D0, 5.5D0, -0.58D0, 570D0, 0.115D0, 5.5D0, -0.58D0, 570D0/ + DATA ((CEFFD(J1,J2),J2=1,9),J1=1,10)/ + &3.11D0, -7.34D0, 9.71D0, 0.068D0, -0.42D0, 1.31D0, + &-1.37D0, 35.0D0, 118D0, 3.11D0, -7.10D0, 10.6D0, + &0.073D0, -0.41D0, 1.17D0, -1.41D0, 31.6D0, 95D0, + &3.12D0, -7.43D0, 9.21D0, 0.067D0, -0.44D0, 1.41D0, + &-1.35D0, 36.5D0, 132D0, 3.13D0, -8.18D0, -4.20D0, + &0.056D0, -0.71D0, 3.12D0, -1.12D0, 55.2D0, 1298D0, + &3.11D0, -6.90D0, 11.4D0, 0.078D0, -0.40D0, 1.05D0, + &-1.40D0, 28.4D0, 78D0, 3.11D0, -7.13D0, 10.0D0, + &0.071D0, -0.41D0, 1.23D0, -1.34D0, 33.1D0, 105D0, + &3.12D0, -7.90D0, -1.49D0, 0.054D0, -0.64D0, 2.72D0, + &-1.13D0, 53.1D0, 995D0, 3.11D0, -7.39D0, 8.22D0, + &0.065D0, -0.44D0, 1.45D0, -1.36D0, 38.1D0, 148D0, + &3.18D0, -8.95D0, -3.37D0, 0.057D0, -0.76D0, 3.32D0, + &-1.12D0, 55.6D0, 1472D0, 4.18D0, -29.2D0, 56.2D0, + &0.074D0, -1.36D0, 6.67D0, -1.14D0, 116.2D0, 6532D0/ + +C...Parameters. Combinations of the energy. + AEM=PARU(101) + PMTH=PARP(102) + S=VINT(2) + SRT=VINT(1) + SEPS=S**EPS + SETA=S**ETA + SLOG=LOG(S) + +C...Ratio of gamma/pi (for rescaling in parton distributions). + VINT(281)=(XPAR(22)*SEPS+YPAR(22)*SETA)/ + &(XPAR(5)*SEPS+YPAR(5)*SETA) + VINT(317)=1D0 + IF(MINT(50).NE.1) RETURN + +C...Order flavours of incoming particles: KF1 < KF2. + IF(IABS(MINT(11)).LE.IABS(MINT(12))) THEN + KF1=IABS(MINT(11)) + KF2=IABS(MINT(12)) + IORD=1 + ELSE + KF1=IABS(MINT(12)) + KF2=IABS(MINT(11)) + IORD=2 + ENDIF + ISGN12=ISIGN(1,MINT(11)*MINT(12)) + +C...Find process number (for lookup tables). + IF(KF1.GT.1000) THEN + IPROC=1 + IF(ISGN12.LT.0) IPROC=2 + ELSEIF(KF1.GT.100.AND.KF2.GT.1000) THEN + IPROC=3 + IF(ISGN12.LT.0) IPROC=4 + IF(KF1.EQ.111) IPROC=5 + ELSEIF(KF1.GT.100) THEN + IPROC=11 + ELSEIF(KF2.GT.1000) THEN + IPROC=21 + IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=22 + ELSEIF(KF2.GT.100) THEN + IPROC=23 + IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=24 + ELSE + IPROC=25 + IF(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7) IPROC=26 + ENDIF + +C... Number of multiple processes to be stored; beam/target side. + NPR=NPROC(IPROC) + MINT(101)=1 + MINT(102)=1 + IF(NPR.EQ.3) THEN + MINT(100+IORD)=4 + ELSEIF(NPR.EQ.6) THEN + MINT(101)=4 + MINT(102)=4 + ENDIF + N1=0 + IF(MINT(101).EQ.4) N1=4 + N2=0 + IF(MINT(102).EQ.4) N2=4 + +C...Do not do any more for user-set or undefined cross-sections. + IF(MSTP(31).LE.0) RETURN + IF(NPR.EQ.0) CALL PYERRM(26, + &'(PYXTOT:) cross section for this process not yet implemented') + +C...Parameters. Combinations of the energy. + AEM=PARU(101) + PMTH=PARP(102) + S=VINT(2) + SRT=VINT(1) + SEPS=S**EPS + SETA=S**ETA + SLOG=LOG(S) + +C...Loop over multiple processes (for VDM). + DO 110 I=1,NPR + IF(NPR.EQ.1) THEN + IPR=IPROC + ELSEIF(NPR.EQ.3) THEN + IPR=I+4 + IF(KF2.LT.1000) IPR=I+10 + ELSEIF(NPR.EQ.6) THEN + IPR=I+10 + ENDIF + +C...Evaluate hadron species, mass, slope contribution and fit number. + IHA=IHADA(IPR) + IHB=IHADB(IPR) + PMA=PMHAD(IHA) + PMB=PMHAD(IHB) + BHA=BHAD(IHA) + BHB=BHAD(IHB) + ISD=IFITSD(IPR) + IDD=IFITDD(IPR) + +C...Skip if energy too low relative to masses. + DO 100 J=0,5 + SIGTMP(I,J)=0D0 + 100 CONTINUE + IF(SRT.LT.PMA+PMB+PARP(104)) GOTO 110 + +C...Total cross-section. Elastic slope parameter and cross-section. + SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA + BEL=2D0*BHA+2D0*BHB+4D0*SEPS-4.2D0 + SIGTMP(I,1)=FACEL*SIGTMP(I,0)**2/BEL + +C...Diffractive scattering A + B -> X + B. + BSD=2D0*BHB + SQML=(PMA+PMTH)**2 + SQMU=S*CEFFS(ISD,1)+CEFFS(ISD,2) + SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/ + & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP) + BXB=CEFFS(ISD,3)+CEFFS(ISD,4)/S + SUM2=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)/ + & (BSD+2D0*ALP*LOG(S/((PMA+PMTH)*(PMA+PMRC)))+BXB) + SIGTMP(I,2)=FACSD*XPAR(IPR)*BETP(IHB)*MAX(0D0,SUM1+SUM2) + +C...Diffractive scattering A + B -> A + X. + BSD=2D0*BHA + SQML=(PMB+PMTH)**2 + SQMU=S*CEFFS(ISD,5)+CEFFS(ISD,6) + SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/ + & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP) + BAX=CEFFS(ISD,7)+CEFFS(ISD,8)/S + SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/ + & (BSD+2D0*ALP*LOG(S/((PMB+PMTH)*(PMB+PMRC)))+BAX) + SIGTMP(I,3)=FACSD*XPAR(IPR)*BETP(IHA)*MAX(0D0,SUM1+SUM2) + +C...Order single diffractive correctly. + IF(IORD.EQ.2) THEN + SIGSAV=SIGTMP(I,2) + SIGTMP(I,2)=SIGTMP(I,3) + SIGTMP(I,3)=SIGSAV + ENDIF + +C...Double diffractive scattering A + B -> X1 + X2. + YEFF=LOG(S*SMP/((PMA+PMTH)*(PMB+PMTH))**2) + DEFF=CEFFD(IDD,1)+CEFFD(IDD,2)/SLOG+CEFFD(IDD,3)/SLOG**2 + SUM1=(DEFF+YEFF*(LOG(MAX(1D-10,YEFF/DEFF))-1D0))/(2D0*ALP) + IF(YEFF.LE.0) SUM1=0D0 + SQMU=S*(CEFFD(IDD,4)+CEFFD(IDD,5)/SLOG+CEFFD(IDD,6)/SLOG**2) + SLUP=LOG(MAX(1.1D0,S/(ALP*(PMA+PMTH)**2*(PMB+PMTH)*(PMB+PMRC)))) + SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMB+PMTH)*(PMB+PMRC)))) + SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)*LOG(SLUP/SLDN)/ + & (2D0*ALP) + SLUP=LOG(MAX(1.1D0,S/(ALP*(PMB+PMTH)**2*(PMA+PMTH)*(PMA+PMRC)))) + SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMA+PMTH)*(PMA+PMRC)))) + SUM3=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*LOG(SLUP/SLDN)/ + & (2D0*ALP) + BXX=CEFFD(IDD,7)+CEFFD(IDD,8)/SRT+CEFFD(IDD,9)/S + SLRR=LOG(S/(ALP*(PMA+PMTH)*(PMA+PMRC)*(PMB+PMTH)*(PMB+PMRC))) + SUM4=CRES**2*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)* + & LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/MAX(0.1D0,2D0*ALP*SLRR+BXX) + SIGTMP(I,4)=FACDD*XPAR(IPR)*MAX(0D0,SUM1+SUM2+SUM3+SUM4) + +C...Non-diffractive by unitarity. + SIGTMP(I,5)=SIGTMP(I,0)-SIGTMP(I,1)-SIGTMP(I,2)-SIGTMP(I,3)- + & SIGTMP(I,4) + 110 CONTINUE + +C...Put temporary results in output array: only one process. + IF(MINT(101).EQ.1.AND.MINT(102).EQ.1) THEN + DO 120 J=0,5 + SIGT(0,0,J)=SIGTMP(1,J) + 120 CONTINUE + +C...Beam multiple processes. + ELSEIF(MINT(101).EQ.4.AND.MINT(102).EQ.1) THEN + IF(MINT(107).EQ.2) THEN + VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2 + ELSE + VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ + & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307))) + ENDIF + IF(MSTP(20).GT.0) THEN + VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)))**MSTP(20) + ENDIF + DO 140 I=1,4 + IF(MINT(107).EQ.2) THEN + CONV=(AEM/PARP(160+I))*VINT(317) + ELSEIF(VINT(154).GT.PARP(15)) THEN + CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2* + & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) + ELSE + CONV=0D0 + ENDIF + I1=MAX(1,I-1) + DO 130 J=0,5 + SIGT(I,0,J)=CONV*SIGTMP(I1,J) + 130 CONTINUE + 140 CONTINUE + DO 150 J=0,5 + SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J) + 150 CONTINUE + +C...Target multiple processes. + ELSEIF(MINT(101).EQ.1.AND.MINT(102).EQ.4) THEN + IF(MINT(108).EQ.2) THEN + VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2 + ELSE + VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ + & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308))) + ENDIF + IF(MSTP(20).GT.0) THEN + VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(308)))**MSTP(20) + ENDIF + DO 170 I=1,4 + IF(MINT(108).EQ.2) THEN + CONV=(AEM/PARP(160+I))*VINT(317) + ELSEIF(VINT(154).GT.PARP(15)) THEN + CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2* + & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) + ELSE + CONV=0D0 + ENDIF + IV=MAX(1,I-1) + DO 160 J=0,5 + SIGT(0,I,J)=CONV*SIGTMP(IV,J) + 160 CONTINUE + 170 CONTINUE + DO 180 J=0,5 + SIGT(0,0,J)=SIGT(0,1,J)+SIGT(0,2,J)+SIGT(0,3,J)+SIGT(0,4,J) + 180 CONTINUE + +C...Both beam and target multiple processes. + ELSE + IF(MINT(107).EQ.2) THEN + VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2 + ELSE + VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ + & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307))) + ENDIF + IF(MINT(108).EQ.2) THEN + VINT(317)=VINT(317)*(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2 + ELSE + VINT(317)=VINT(317)*16D0*PARP(15)**2*VINT(154)**2/ + & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308))) + ENDIF + IF(MSTP(20).GT.0) THEN + VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)+ + & VINT(308)))**MSTP(20) + ENDIF + DO 210 I1=1,4 + DO 200 I2=1,4 + IF(MINT(107).EQ.2) THEN + CONV=(AEM/PARP(160+I1))*VINT(317) + ELSEIF(VINT(154).GT.PARP(15)) THEN + CONV=(AEM/PARU(1))*(KCHG(I1,1)/3D0)**2*PARP(18)**2* + & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) + ELSE + CONV=0D0 + ENDIF + IF(MINT(108).EQ.2) THEN + CONV=CONV*(AEM/PARP(160+I2)) + ELSEIF(VINT(154).GT.PARP(15)) THEN + CONV=CONV*(AEM/PARU(1))*(KCHG(I2,1)/3D0)**2*PARP(18)**2* + & (1D0/PARP(15)**2-1D0/VINT(154)**2) + ELSE + CONV=0D0 + ENDIF + IF(I1.LE.2) THEN + IV=MAX(1,I2-1) + ELSEIF(I2.LE.2) THEN + IV=MAX(1,I1-1) + ELSEIF(I1.EQ.I2) THEN + IV=2*I1-2 + ELSE + IV=5 + ENDIF + DO 190 J=0,5 + JV=J + IF(I2.GT.I1.AND.(J.EQ.2.OR.J.EQ.3)) JV=5-J + SIGT(I1,I2,J)=CONV*SIGTMP(IV,JV) + 190 CONTINUE + 200 CONTINUE + 210 CONTINUE + DO 230 J=0,5 + DO 220 I=1,4 + SIGT(I,0,J)=SIGT(I,1,J)+SIGT(I,2,J)+SIGT(I,3,J)+SIGT(I,4,J) + SIGT(0,I,J)=SIGT(1,I,J)+SIGT(2,I,J)+SIGT(3,I,J)+SIGT(4,I,J) + 220 CONTINUE + SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J) + 230 CONTINUE + ENDIF + +C...Scale up uniformly for Donnachie-Landshoff parametrization. + IF(IPROC.EQ.21.OR.IPROC.EQ.23.OR.IPROC.EQ.25) THEN + RFAC=(XPAR(IPROC)*SEPS+YPAR(IPROC)*SETA)/SIGT(0,0,0) + DO 260 I1=0,N1 + DO 250 I2=0,N2 + DO 240 J=0,5 + SIGT(I1,I2,J)=RFAC*SIGT(I1,I2,J) + 240 CONTINUE + 250 CONTINUE + 260 CONTINUE + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYMAXI +C...Finds optimal set of coefficients for kinematical variable selection +C...and the maximum of the part of the differential cross-section used +C...in the event weighting. + + SUBROUTINE PYMAXI + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement to help give large particle numbers. + PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, + &KEXCIT=4000000,KDIMEN=5000000) + +C...User process initialization commonblock. + INTEGER MAXPUP + PARAMETER (MAXPUP=100) + INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP + DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP + COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), + &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), + &LPRUP(MAXPUP) + SAVE /HEPRUP/ + +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINT6/PROC(0:500) + CHARACTER PROC*28 + COMMON/PYINT7/SIGT(0:6,0:6,0:5) + COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) + COMMON/PYTCCO/COEFX(194:380,2) + COMMON/TCPARA/IRES,JRES,XMAS(3),XWID(3),YMAS(2),YWID(2) + SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, + &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT6/,/PYINT7/,/PYTCCO/, + &/PYTCSM/,/TCPARA/ +C...Local arrays, character variables and data. + LOGICAL IOK + CHARACTER CVAR(4)*4 + DIMENSION NPTS(4),MVARPT(500,4),VINTPT(500,30),SIGSPT(500), + &NAREL(9),WTREL(9),WTMAT(9,9),WTRELN(9),COEFU(9),COEFO(9), + &IACCMX(4),SIGSMX(4),SIGSSM(3),PMMN(2),WTRSAV(9),TEMPC(9), + &IQ(9),IP(9) + DATA CVAR/'tau ','tau''','y* ','cth '/ + DATA SIGSSM/3*0D0/ + +C...Initial values and loop over subprocesses. + NPOSI=0 + VINT(143)=1D0 + VINT(144)=1D0 + XSEC(0,1)=0D0 + ITECH=0 + DO 460 ISUB=1,500 + MINT(1)=ISUB + MINT(51)=0 + +C...Find maximum weight factors for photon flux. + IF(MSUB(ISUB).EQ.1.OR.(ISUB.GE.91.AND.ISUB.LE.100)) THEN + IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(2,WTGAGA) + ENDIF + +C...Select subprocess to study: skip cases not applicable. + IF(ISET(ISUB).EQ.11) THEN + IF(MSUB(ISUB).NE.1) GOTO 460 +C...User process intialization: cross section model dependent. + IF(IABS(IDWTUP).EQ.1) THEN + IF(IDWTUP.GT.0.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL + & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process') + XSEC(ISUB,1)=1.00000001D-9*ABS(XMAXUP(KFPR(ISUB,1))) + ELSE + IF((IDWTUP.EQ.2.OR.IDWTUP.EQ.3).AND. + & XSECUP(KFPR(ISUB,1)).LT.0D0) CALL + & PYERRM(26,'(PYMAXI:) Negative XSECUP for user process') + IF(IDWTUP.EQ.2.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL + & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process') + XSEC(ISUB,1)=1.00000001D-9*ABS(XSECUP(KFPR(ISUB,1))) + ENDIF + IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= + & WTGAGA*XSEC(ISUB,1) + NPOSI=NPOSI+1 + GOTO 450 + ELSEIF(ISUB.GE.91.AND.ISUB.LE.95) THEN + CALL PYSIGH(NCHN,SIGS) + XSEC(ISUB,1)=SIGS + IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= + & WTGAGA*XSEC(ISUB,1) + IF(MSUB(ISUB).NE.1) GOTO 460 + NPOSI=NPOSI+1 + GOTO 450 + ELSEIF(ISUB.EQ.99.AND.MSUB(ISUB).EQ.1) THEN + CALL PYSIGH(NCHN,SIGS) + XSEC(ISUB,1)=SIGS + IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= + & WTGAGA*XSEC(ISUB,1) + IF(XSEC(ISUB,1).EQ.0D0) THEN + MSUB(ISUB)=0 + ELSE + NPOSI=NPOSI+1 + ENDIF + GOTO 450 + ELSEIF(ISUB.EQ.96) THEN + IF(MINT(50).EQ.0) GOTO 460 + IF(MSUB(95).NE.1.AND.MOD(MSTP(81),10).LE.0.AND.MSTP(131).LE.0) + & GOTO 460 + IF(MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 460 + ELSEIF(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.ISUB.EQ.28.OR. + & ISUB.EQ.53.OR.ISUB.EQ.68) THEN + IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460 + ELSEIF(ISUB.GE.381.AND.ISUB.LE.386) THEN + IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460 + ELSE + IF(MSUB(ISUB).NE.1) GOTO 460 + ENDIF + ISTSB=ISET(ISUB) + IF(ISUB.EQ.96) ISTSB=2 + IF(MSTP(122).GE.2) WRITE(MSTU(11),5000) ISUB + MWTXS=0 + IF(MSTP(142).GE.1.AND.ISUB.NE.96.AND.MSUB(91)+MSUB(92)+MSUB(93)+ + & MSUB(94)+MSUB(95).EQ.0) MWTXS=1 + +C...Find resonances (explicit or implicit in cross-section). + MINT(72)=0 + KFR1=0 + IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN + KFR1=KFPR(ISUB,1) + ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165 + & .OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN + KFR1=23 + ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172 + & .OR.ISUB.EQ.177) THEN + KFR1=24 + ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN + KFR1=25 + IF(MSTP(46).EQ.5) THEN + KFR1=89 + PMAS(89,1)=PARP(45) + PMAS(89,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) + ENDIF + ENDIF + CKMX=CKIN(2) + IF(CKMX.LE.0D0) CKMX=VINT(1) + KCR1=PYCOMP(KFR1) + IF(KFR1.NE.0) THEN + IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. + & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 + ENDIF + IF(KFR1.NE.0) THEN + TAUR1=PMAS(KCR1,1)**2/VINT(2) + GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) + MINT(72)=1 + MINT(73)=KFR1 + VINT(73)=TAUR1 + VINT(74)=GAMR1 + ENDIF + KFR2=0 + KFR3=0 + IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.ISUB.EQ.195.OR. + $ (ISUB.GE.361.AND.ISUB.LE.380)) + $ THEN + KFR2=23 + IF(ISUB.EQ.141) THEN + KCR2=PYCOMP(KFR2) + IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. + & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) THEN + KFR2=0 + ELSE + TAUR2=PMAS(KCR2,1)**2/VINT(2) + GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) + MINT(72)=2 + MINT(74)=KFR2 + VINT(75)=TAUR2 + VINT(76)=GAMR2 + ENDIF + ELSEIF(ITECH.EQ.0) THEN + ALPRHT=2.16D0*(3D0/DBLE(ITCM(1))) + ITECH=1 + KFR1=KTECHN+113 + KCR1=PYCOMP(KFR1) + KFR2=KTECHN+223 + KCR2=PYCOMP(KFR2) + KFR3=KTECHN+115 + KCR3=PYCOMP(KFR3) + IRES=0 +C...Order the resonances + IF(PMAS(KCR3,1).LT.PMAS(KCR2,1)) THEN + KCT=KCR3 + KCR3=KCR2 + KCR2=KCT + ENDIF + IF(PMAS(KCR3,1).LT.PMAS(KCR1,1)) THEN + KCT=KCR3 + KCR3=KCR1 + KCR1=KCT + ENDIF + IF(PMAS(KCR2,1).LT.PMAS(KCR1,1)) THEN + KCT=KCR2 + KCR2=KCR1 + KCR1=KCT + ENDIF + DO 101 I=1,3 + IF(I.EQ.1) THEN + SHN0=PMAS(KCR1,1)**2 + ELSEIF(I.EQ.2) THEN + IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LE.1D-6) GOTO 101 + SHN0=PMAS(KCR2,1)**2 + ELSEIF(I.EQ.3) THEN + IF(ABS(PMAS(KCR3,1)-PMAS(KCR3,1)).LE.1D-6) GOTO 101 + SHN0=PMAS(KCR3,1)**2 + ENDIF + AEM=PYALEM(SHN0) + FAR=SQRT(AEM/ALPRHT) + SHN=SHN0*(1D0-FAR) + CALL PYTECM(SHN,S1,WIDO,1) + RES=SHN-S1 + SHN=S1*.99D0 + SHSTEP=2D0 + 102 SHN=SHN+SHSTEP + CALL PYTECM(SHN,S1,WIDO,1) + IF(RES.LT.0D0.AND.SHN-S1.GE.0D0) THEN + IOK=.FALSE. + IF(IRES.GT.0) THEN + IF(ABS(SQRT(S1)-XMAS(IRES)).GT.1D-6) IOK=.TRUE. + ELSEIF(IRES.EQ.0) THEN + IOK=.TRUE. + ENDIF + IF(IOK) THEN + IRES=IRES+1 + XMAS(IRES)=SQRT(S1) + XWID(IRES)=WIDO + ENDIF + ENDIF + RES=SHN-S1 + IF(IRES.LT.3.AND.SHN.LT.SHN0*(1D0+FAR)) GOTO 102 + 101 CONTINUE + JRES=0 + KFR1=KTECHN+213 + KCR1=PYCOMP(KFR1) + KFR2=KTECHN+215 + KCR2=PYCOMP(KFR2) + IF(PMAS(KCR2,1).LT.PMAS(KCR1,1)) THEN + KCT=KCR2 + KCR2=KCR1 + KCR1=KCT + ENDIF + DO 103 I=1,2 + IF(I.EQ.1) THEN + SHN0=PMAS(KCR1,1)**2 + ELSEIF(I.EQ.2) THEN + IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LE.1D-6) GOTO 103 + SHN0=PMAS(KCR2,1)**2 + ENDIF + AEM=PYALEM(SHN0) + FAR=SQRT(AEM/ALPRHT) + SHN=SHN0*(1D0-FAR) + CALL PYTECM(SHN,S1,WIDO,2) + RES=SHN-S1 + SHN=S1*.99D0 + SHSTEP=2D0 + 104 SHN=SHN+SHSTEP + CALL PYTECM(SHN,S1,WIDO,2) + IF(RES.LT.0D0.AND.SHN-S1.GE.0D0) THEN + IOK=.FALSE. + IF(JRES.GT.0) THEN + IF(ABS(SQRT(S1)-XMAS(IRES)).GT.1D-6) IOK=.TRUE. + ELSEIF(JRES.EQ.0) THEN + IOK=.TRUE. + ENDIF + IF(IOK) THEN + JRES=JRES+1 + YMAS(JRES)=SQRT(S1) + YWID(JRES)=WIDO + ENDIF + ENDIF + RES=SHN-S1 + IF(JRES.LT.2.AND.SHN.LT.SHN0*(1D0+FAR)) GOTO 104 + 103 CONTINUE + ENDIF + IF(ISUB.EQ.194.OR.(ISUB.GE.361.AND.ISUB.LE.368).OR. + & ISUB.EQ.379.OR.ISUB.EQ.380) THEN + MINT(72)=IRES + IF(IRES.GE.1) THEN + VINT(73)=XMAS(1)**2/VINT(2) + VINT(74)=XMAS(1)*XWID(1)/VINT(2) + TAUR1=VINT(73) + GAMR1=VINT(74) + XM1=XMAS(1) + XG1=XWID(1) + KFR1=1 + ENDIF + IF(IRES.GE.2) THEN + VINT(75)=XMAS(2)**2/VINT(2) + VINT(76)=XMAS(2)*XWID(2)/VINT(2) + TAUR2=VINT(75) + GAMR2=VINT(76) + XM2=XMAS(2) + XG2=XWID(2) + KFR2=2 + ENDIF + IF(IRES.EQ.3) THEN + VINT(77)=XMAS(3)**2/VINT(2) + VINT(78)=XMAS(3)*XWID(3)/VINT(2) + TAUR3=VINT(77) + GAMR3=VINT(78) + XM3=XMAS(3) + XG3=XWID(3) + KFR3=3 + ENDIF +C...Charged current: rho+- and a+- + ELSEIF(ISUB.EQ.195.OR.ISUB.GE.370.AND.ISUB.LE.378) THEN + MINT(72)=IRES + IF(JRES.GE.1) THEN + VINT(73)=YMAS(1)**2/VINT(2) + VINT(74)=YMAS(1)*YWID(1)/VINT(2) + KFR1=1 + TAUR1=VINT(73) + GAMR1=VINT(74) + XM1=YMAS(1) + XG1=YWID(1) + ENDIF + IF(JRES.GE.2) THEN + VINT(75)=YMAS(2)**2/VINT(2) + VINT(76)=YMAS(2)*YWID(2)/VINT(2) + KFR2=2 + TAUR2=VINT(73) + GAMR2=VINT(74) + XM2=YMAS(2) + XG2=YWID(2) + ENDIF + KFR3=0 + ENDIF + IF(ISUB.NE.141) THEN + IF(KFR1.NE.0.AND.(CKIN(1).GT.(XM1+20D0*XG1) + & .OR.CKMX.LT.(XM1-20D0*XG1))) KFR1=0 + IF(KFR2.NE.0.AND.(CKIN(1).GT.(XM2+20D0*XG2) + & .OR.CKMX.LT.(XM2-20D0*XG2))) KFR2=0 + IF(KFR3.NE.0.AND.(CKIN(1).GT.(XM3+20D0*XG3) + & .OR.CKMX.LT.(XM3-20D0*XG3))) KFR3=0 + IF(KFR3.NE.0.AND.KFR2.NE.0.AND.KFR1.NE.0) THEN + + ELSEIF(KFR1.NE.0.AND.KFR2.NE.0) THEN + MINT(72)=2 + ELSEIF(KFR1.NE.0.AND.KFR3.NE.0) THEN + MINT(72)=2 + MINT(74)=KFR3 + VINT(75)=TAUR3 + VINT(76)=GAMR3 + ELSEIF(KFR2.NE.0.AND.KFR3.NE.0) THEN + MINT(72)=2 + MINT(73)=KFR2 + VINT(73)=TAUR2 + VINT(74)=GAMR2 + MINT(74)=KFR3 + VINT(75)=TAUR3 + VINT(76)=GAMR3 + ELSEIF(KFR1.NE.0) THEN + MINT(72)=1 + ELSEIF(KFR2.NE.0) THEN + MINT(72)=1 + MINT(73)=KFR2 + VINT(73)=TAUR2 + VINT(74)=GAMR2 + ELSEIF(KFR3.NE.0) THEN + MINT(72)=1 + MINT(73)=KFR3 + VINT(73)=TAUR3 + VINT(74)=GAMR3 + ELSE + MINT(72)=0 + ENDIF + ELSE + IF(KFR2.NE.0.AND.KFR1.NE.0) THEN + + ELSEIF(KFR2.NE.0) THEN + KFR1=KFR2 + TAUR1=TAUR2 + GAMR1=GAMR2 + MINT(72)=1 + MINT(73)=KFR1 + VINT(73)=TAUR1 + VINT(74)=GAMR1 + KFR2=0 + ELSE + MINT(72)=0 + ENDIF + ENDIF + ENDIF + +C...Find product masses and minimum pT of process. + SQM3=0D0 + SQM4=0D0 + MINT(71)=0 + VINT(71)=CKIN(3) + VINT(80)=1D0 + IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN + NBW=0 + DO 110 I=1,2 + PMMN(I)=0D0 + IF(KFPR(ISUB,I).EQ.0) THEN + ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT. + & PARP(41)) THEN + IF(I.EQ.1) SQM3=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 + IF(I.EQ.2) SQM4=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 + ELSE + NBW=NBW+1 +C...This prevents SUSY/t particles from becoming too light. + KFLW=KFPR(ISUB,I) + IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN + KCW=PYCOMP(KFLW) + PMMN(I)=PMAS(KCW,1) + DO 100 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 + IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN + PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ + & PMAS(PYCOMP(KFDP(IDC,2)),1) + IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ + & PMAS(PYCOMP(KFDP(IDC,3)),1) + PMMN(I)=MIN(PMMN(I),PMSUM) + ENDIF + 100 CONTINUE + ELSEIF(KFLW.EQ.6) THEN + PMMN(I)=PMAS(24,1)+PMAS(5,1) + ENDIF + ENDIF + 110 CONTINUE + IF(NBW.GE.1) THEN + CKIN41=CKIN(41) + CKIN43=CKIN(43) + CKIN(41)=MAX(PMMN(1),CKIN(41)) + CKIN(43)=MAX(PMMN(2),CKIN(43)) + CALL PYOFSH(3,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) + CKIN(41)=CKIN41 + CKIN(43)=CKIN43 + IF(MINT(51).EQ.1) THEN + WRITE(MSTU(11),5100) ISUB + MSUB(ISUB)=0 + GOTO 460 + ENDIF + SQM3=PQM3**2 + SQM4=PQM4**2 + ENDIF + IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) MINT(71)=1 + IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) + IF(ISUB.EQ.96.AND.MSTP(82).LE.1) THEN + VINT(71)=PARP(81)*(VINT(1)/PARP(89))**PARP(90) + ELSEIF(ISUB.EQ.96) THEN + VINT(71)=0.08D0*PARP(82)*(VINT(1)/PARP(89))**PARP(90) + ENDIF + ENDIF + VINT(63)=SQM3 + VINT(64)=SQM4 + +C...Prepare for additional variable choices in 2 -> 3. + IF(ISTSB.EQ.5) THEN + VINT(201)=0D0 + IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1) + VINT(206)=VINT(201) + IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(206)=PMAS(5,1) + VINT(204)=PMAS(23,1) + IF(ISUB.EQ.124.OR.ISUB.EQ.351) VINT(204)=PMAS(24,1) + IF(ISUB.EQ.352) VINT(204)=PMAS(PYCOMP(9900024),1) + IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182 + & .OR.ISUB.EQ.186.OR.ISUB.EQ.187.OR.ISUB.EQ.401.OR.ISUB.EQ.402) + & VINT(204)=VINT(201) + VINT(209)=VINT(204) + IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(209)=VINT(206) + ENDIF + +C...Number of points for each variable: tau, tau', y*, cos(theta-hat). + IPEAK7=0 + NPTS(1)=2+2*MINT(72) + IF(MINT(47).EQ.1) THEN + IF(ISTSB.EQ.1.OR.ISTSB.EQ.2) NPTS(1)=1 + ELSEIF(MINT(47).GE.5) THEN + IF(ISTSB.LE.2.OR.ISTSB.GT.5) THEN + NPTS(1)=NPTS(1)+1 + IPEAK7=1 + ENDIF + ENDIF + NPTS(2)=1 + IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN + IF(MINT(47).GE.2) NPTS(2)=2 + IF(MINT(47).GE.5) NPTS(2)=3 + ENDIF + NPTS(3)=1 + IF(MINT(47).EQ.4.OR.MINT(47).EQ.5) THEN + NPTS(3)=3 + IF(MINT(45).EQ.3) NPTS(3)=NPTS(3)+1 + IF(MINT(46).EQ.3) NPTS(3)=NPTS(3)+1 + ENDIF + NPTS(4)=1 + IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) NPTS(4)=5 + NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4) + +C...Reset coefficients of cross-section weighting. + DO 120 J=1,20 + COEF(ISUB,J)=0D0 + 120 CONTINUE + IF(ISUB.EQ.194.OR.ISUB.EQ.195.OR.(ISUB.GE.361 + & .AND.ISUB.LE.380)) THEN + DO 125 J=1,2 + COEFX(ISUB,J)=0D0 + 125 CONTINUE + ENDIF + COEF(ISUB,1)=1D0 + COEF(ISUB,8)=0.5D0 + COEF(ISUB,9)=0.5D0 + COEF(ISUB,13)=1D0 + COEF(ISUB,18)=1D0 + MCTH=0 + MTAUP=0 + METAUP=0 + VINT(23)=0D0 + VINT(26)=0D0 + SIGSAM=0D0 + +C...Find limits and select tau, y*, cos(theta-hat) and tau' values, +C...in grid of phase space points. + CALL PYKLIM(1) + METAU=MINT(51) + NACC=0 + DO 150 ITRY=1,NTRY + MINT(51)=0 + IF(METAU.EQ.1) GOTO 150 + IF(MOD(ITRY-1,NPTS(2)*NPTS(3)*NPTS(4)).EQ.0) THEN + MTAU=1+(ITRY-1)/(NPTS(2)*NPTS(3)*NPTS(4)) + IF(MINT(72).LE.2.AND.MTAU.GT.2+2*MINT(72)) THEN + MTAU=7 + ELSEIF(MINT(72).EQ.3.AND.IPEAK7.EQ.0.AND.MTAU.GE.7) THEN + MTAU=MTAU+1 + ENDIF + RTAU=0.5D0 +C...Special case when both resonances have same mass, +C...as is often the case in process 194. +c IF(MINT(72).GE.2) THEN +c IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LT. +c & 0.01D0*(PMAS(KCR2,1)+PMAS(KCR1,1))) THEN +c IF(MTAU.EQ.3.OR.MTAU.EQ.4) THEN +c RTAU=0.4D0 +c ELSEIF(MTAU.EQ.5.OR.MTAU.EQ.6) THEN +c RTAU=0.6D0 +c ENDIF +c ENDIF +c ENDIF + CALL PYKMAP(1,MTAU,RTAU) + IF(ISTSB.GE.3.AND.ISTSB.LE.5) CALL PYKLIM(4) + METAUP=MINT(51) + ENDIF + IF(METAUP.EQ.1) GOTO 150 + IF(ISTSB.GE.3.AND.ISTSB.LE.5.AND.MOD(ITRY-1,NPTS(3)*NPTS(4)) + & .EQ.0) THEN + MTAUP=1+MOD((ITRY-1)/(NPTS(3)*NPTS(4)),NPTS(2)) + CALL PYKMAP(4,MTAUP,0.5D0) + ENDIF + IF(MOD(ITRY-1,NPTS(3)*NPTS(4)).EQ.0) THEN + CALL PYKLIM(2) + MEYST=MINT(51) + ENDIF + IF(MEYST.EQ.1) GOTO 150 + IF(MOD(ITRY-1,NPTS(4)).EQ.0) THEN + MYST=1+MOD((ITRY-1)/NPTS(4),NPTS(3)) + IF(MYST.EQ.4.AND.MINT(45).NE.3) MYST=5 + CALL PYKMAP(2,MYST,0.5D0) + CALL PYKLIM(3) + MECTH=MINT(51) + ENDIF + IF(MECTH.EQ.1) GOTO 150 + IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN + MCTH=1+MOD(ITRY-1,NPTS(4)) + CALL PYKMAP(3,MCTH,0.5D0) + ENDIF + IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1D0-VINT(23)**2) + +C...Store position and limits. + MINT(51)=0 + CALL PYKLIM(0) + IF(MINT(51).EQ.1) GOTO 150 + NACC=NACC+1 + MVARPT(NACC,1)=MTAU + MVARPT(NACC,2)=MTAUP + MVARPT(NACC,3)=MYST + MVARPT(NACC,4)=MCTH + DO 130 J=1,30 + VINTPT(NACC,J)=VINT(10+J) + 130 CONTINUE + +C...Normal case: calculate cross-section. + IF(ISTSB.NE.5) THEN + CALL PYSIGH(NCHN,SIGS) + IF(MWTXS.EQ.1) THEN + CALL PYEVWT(WTXS) + SIGS=WTXS*SIGS + ENDIF + +C..2 -> 3: find highest value out of a number of tries. + ELSE + SIGS=0D0 + DO 140 IKIN3=1,MSTP(129) + CALL PYKMAP(5,0,0D0) + IF(MINT(51).EQ.1) GOTO 140 + CALL PYSIGH(NCHN,SIGTMP) + IF(MWTXS.EQ.1) THEN + CALL PYEVWT(WTXS) + SIGTMP=WTXS*SIGTMP + ENDIF + IF(SIGTMP.GT.SIGS) SIGS=SIGTMP + 140 CONTINUE + ENDIF + +C...Store cross-section. + SIGSPT(NACC)=SIGS + IF(SIGS.GT.SIGSAM) SIGSAM=SIGS + IF(MSTP(122).GE.2) WRITE(MSTU(11),5200) MTAU,MYST,MCTH,MTAUP, + & VINT(21),VINT(22),VINT(23),VINT(26),SIGS + 150 CONTINUE + IF(NACC.EQ.0) THEN + WRITE(MSTU(11),5100) ISUB + MSUB(ISUB)=0 + GOTO 460 + ELSEIF(SIGSAM.EQ.0D0) THEN + WRITE(MSTU(11),5300) ISUB + MSUB(ISUB)=0 + GOTO 460 + ENDIF + IF(ISUB.NE.96) NPOSI=NPOSI+1 + +C...Calculate integrals in tau over maximal phase space limits. + TAUMIN=VINT(11) + TAUMAX=VINT(31) + ATAU1=LOG(TAUMAX/TAUMIN) + IF(NPTS(1).GE.2) THEN + ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) + ENDIF + IF(NPTS(1).GE.4) THEN + ATAU3=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1 + ATAU4=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/ + & GAMR1 + ENDIF + IF(NPTS(1).GE.6) THEN + ATAU5=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2 + ATAU6=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/ + & GAMR2 + ENDIF + IF(NPTS(1).GE.8) THEN + ATAU8=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR3)/(TAUMAX+TAUR3))/TAUR3 + ATAU9=(ATAN((TAUMAX-TAUR3)/GAMR3)-ATAN((TAUMIN-TAUR3)/GAMR3))/ + & GAMR3 + ENDIF + IF(IPEAK7.EQ.1) THEN + ATAU7=LOG(MAX(2D-10,1D0-TAUMIN)/MAX(2D-10,1D0-TAUMAX)) + ENDIF + +C...Reset. Sum up cross-sections in points calculated. + DO 320 IVAR=1,4 + IF(NPTS(IVAR).EQ.1) GOTO 320 + IF(ISUB.EQ.96.AND.IVAR.EQ.4) GOTO 320 + NBIN=NPTS(IVAR) + DO 170 J1=1,NBIN + NAREL(J1)=0 + WTREL(J1)=0D0 + COEFU(J1)=0D0 + DO 160 J2=1,NBIN + WTMAT(J1,J2)=0D0 + 160 CONTINUE + 170 CONTINUE + DO 180 IACC=1,NACC + IBIN=MVARPT(IACC,IVAR) + IF(IVAR.EQ.1) THEN + IF(IBIN.GT.7.AND.IPEAK7.EQ.0) THEN + IBIN=IBIN-1 + ELSEIF(IBIN.EQ.7.AND.IPEAK7.EQ.1.AND.MSTP(72).LT.3) THEN + IBIN=3+2*MINT(72) + ENDIF + ENDIF + IF(IVAR.EQ.3.AND.IBIN.EQ.5.AND.MINT(45).NE.3) IBIN=4 + NAREL(IBIN)=NAREL(IBIN)+1 + WTREL(IBIN)=WTREL(IBIN)+SIGSPT(IACC) + +C...Sum up tau cross-section pieces in points used. + IF(IVAR.EQ.1) THEN + TAU=VINTPT(IACC,11) + WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 + WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAU1/ATAU2)/TAU + IF(NBIN.GE.4) THEN + WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAU1/ATAU3)/(TAU+TAUR1) + WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ATAU1/ATAU4)*TAU/ + & ((TAU-TAUR1)**2+GAMR1**2) + ENDIF + IF(NBIN.GE.6) THEN + WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ATAU1/ATAU5)/(TAU+TAUR2) + WTMAT(IBIN,6)=WTMAT(IBIN,6)+(ATAU1/ATAU6)*TAU/ + & ((TAU-TAUR2)**2+GAMR2**2) + ENDIF + IF(MINT(72).LE.2.AND.IPEAK7.EQ.1) THEN + WTMAT(IBIN,3+2*MINT(72))=WTMAT(IBIN,3+2*MINT(72)) + & +(ATAU1/ATAU7)*TAU/MAX(2D-10,1D0-TAU) + ELSEIF(MINT(72).EQ.3.AND.IPEAK7.EQ.1) THEN + WTMAT(IBIN,7)=WTMAT(IBIN,7) + & +(ATAU1/ATAU7)*TAU/MAX(2D-10,1D0-TAU) + ENDIF + IF(MINT(72).EQ.3) THEN + WTMAT(IBIN,7+IPEAK7)=WTMAT(IBIN,7+IPEAK7) + & +(ATAU1/ATAU8)/(TAU+TAUR3) + WTMAT(IBIN,8+IPEAK7)=WTMAT(IBIN,8+IPEAK7) + & +(ATAU1/ATAU9)*TAU/((TAU-TAUR3)**2+GAMR3**2) + ENDIF +C...Sum up tau' cross-section pieces in points used. + ELSEIF(IVAR.EQ.2) THEN + TAU=VINTPT(IACC,11) + TAUP=VINTPT(IACC,16) + TAUPMN=VINTPT(IACC,6) + TAUPMX=VINTPT(IACC,26) + ATAUP1=LOG(TAUPMX/TAUPMN) + ATAUP2=((1D0-TAU/TAUPMX)**4-(1D0-TAU/TAUPMN)**4)/(4D0*TAU) + WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 + WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAUP1/ATAUP2)* + & (1D0-TAU/TAUP)**3/TAUP + IF(NBIN.GE.3) THEN + ATAUP3=LOG(MAX(2D-10,1D0-TAUPMN)/MAX(2D-10,1D0-TAUPMX)) + WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAUP1/ATAUP3)* + & TAUP/MAX(2D-10,1D0-TAUP) + ENDIF + +C...Sum up y* cross-section pieces in points used. + ELSEIF(IVAR.EQ.3) THEN + YST=VINTPT(IACC,12) + YSTMIN=VINTPT(IACC,2) + YSTMAX=VINTPT(IACC,22) + AYST0=YSTMAX-YSTMIN + AYST1=0.5D0*(YSTMAX-YSTMIN)**2 + AYST2=AYST1 + AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) + WTMAT(IBIN,1)=WTMAT(IBIN,1)+(AYST0/AYST1)*(YST-YSTMIN) + WTMAT(IBIN,2)=WTMAT(IBIN,2)+(AYST0/AYST2)*(YSTMAX-YST) + WTMAT(IBIN,3)=WTMAT(IBIN,3)+(AYST0/AYST3)/COSH(YST) + IF(MINT(45).EQ.3) THEN + TAUE=VINTPT(IACC,11) + IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINTPT(IACC,16) + YST0=-0.5D0*LOG(TAUE) + AYST4=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)/ + & MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) + WTMAT(IBIN,4)=WTMAT(IBIN,4)+(AYST0/AYST4)/ + & MAX(1D-10,1D0-EXP(YST-YST0)) + ENDIF + IF(MINT(46).EQ.3) THEN + TAUE=VINTPT(IACC,11) + IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINTPT(IACC,16) + YST0=-0.5D0*LOG(TAUE) + AYST5=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)/ + & MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) + WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(AYST0/AYST5)/ + & MAX(1D-10,1D0-EXP(-YST-YST0)) + ENDIF + +C...Sum up cos(theta-hat) cross-section pieces in points used. + ELSE + RM34=MAX(1D-20,2D0*SQM3*SQM4/(VINTPT(IACC,11)*VINT(2))**2) + RSQM=1D0+RM34 + CTHMAX=SQRT(1D0-4D0*VINT(71)**2/(TAUMAX*VINT(2))) + CTHMIN=-CTHMAX + IF(CTHMAX.GT.0.9999D0) RM34=MAX(RM34,2D0*VINT(71)**2/ + & (TAUMAX*VINT(2))) + ACTH1=CTHMAX-CTHMIN + ACTH2=LOG(MAX(RM34,RSQM-CTHMIN)/MAX(RM34,RSQM-CTHMAX)) + ACTH3=LOG(MAX(RM34,RSQM+CTHMAX)/MAX(RM34,RSQM+CTHMIN)) + ACTH4=1D0/MAX(RM34,RSQM-CTHMAX)-1D0/MAX(RM34,RSQM-CTHMIN) + ACTH5=1D0/MAX(RM34,RSQM+CTHMIN)-1D0/MAX(RM34,RSQM+CTHMAX) + CTH=VINTPT(IACC,13) + WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 + WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ACTH1/ACTH2)/ + & MAX(RM34,RSQM-CTH) + WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ACTH1/ACTH3)/ + & MAX(RM34,RSQM+CTH) + WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ACTH1/ACTH4)/ + & MAX(RM34,RSQM-CTH)**2 + WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ACTH1/ACTH5)/ + & MAX(RM34,RSQM+CTH)**2 + ENDIF + 180 CONTINUE + +C...Check that equation system solvable. + IF(MSTP(122).GE.2) WRITE(MSTU(11),5400) CVAR(IVAR) + MSOLV=1 + WTRELS=0D0 + DO 190 IBIN=1,NBIN + IF(MSTP(122).GE.2) WRITE(MSTU(11),5500) (WTMAT(IBIN,IRED), + & IRED=1,NBIN),WTREL(IBIN) + IF(NAREL(IBIN).EQ.0) MSOLV=0 + WTRELS=WTRELS+WTREL(IBIN) + 190 CONTINUE + IF(ABS(WTRELS).LT.1D-20) MSOLV=0 + +C...Solve to find relative importance of cross-section pieces. + IF(MSOLV.EQ.1) THEN + DO 200 IBIN=1,NBIN + WTRELN(IBIN)=MAX(0.1D0,WTREL(IBIN)/WTRELS) + WTRSAV(IBIN)=WTREL(IBIN) + 200 CONTINUE +C...Auxiliary vectors to record order of permutations + DO I=1,NBIN + IP(I) = I + IQ(I) = I + ENDDO + DO 230 IRED=1,NBIN-1 + MROW=IRED + RESMAX=ABS(WTREL(MROW)) +C...Find row with largest residual + DO JBIN=IRED+1,NBIN + IF(RESMAX.LT.ABS(WTREL(JBIN))) THEN + MROW=JBIN + RESMAX=ABS(WTREL(MROW)) + ENDIF + ENDDO + IF(RESMAX.LT.1D-20) THEN + MSOLV=0 + GOTO 260 + ENDIF + MCOL = IRED + AMAX = ABS(WTMAT(MROW,MCOL)) +C...Find column with largest entry + DO JBIN=IRED+1,NBIN + IF (AMAX.LT.ABS(WTMAT(MROW,JBIN))) THEN + MCOL = JBIN + AMAX = ABS(WTMAT(MROW,MCOL)) + ENDIF + ENDDO +C...Swap rows if necessary + IF(MROW.NE.IRED) THEN + DO JBIN=1,NBIN + TMPE=WTMAT(IRED,JBIN) + WTMAT(IRED,JBIN)=WTMAT(MROW,JBIN) + WTMAT(MROW,JBIN)=TMPE + ENDDO + TMPE=WTREL(IRED) + WTREL(IRED)=WTREL(MROW) + WTREL(MROW)=TMPE + MTMP=IQ(IRED) + IQ(IRED)=IQ(MROW) + IQ(MROW)=MTMP + ENDIF +C...Swap columns if necessary + IF(MCOL.NE.IRED) THEN + DO JBIN=1,NBIN + TMPE=WTMAT(JBIN,IRED) + WTMAT(JBIN,IRED)=WTMAT(JBIN,MCOL) + WTMAT(JBIN,MCOL)=TMPE + ENDDO + MTMP=IP(IRED) + IP(IRED)=IP(MCOL) + IP(MCOL)=MTMP + ENDIF +C...Begin eliminating equations + DO 220 IBIN=IRED+1,NBIN + IF(ABS(WTMAT(IRED,IRED)).LT.1D-20) THEN + MSOLV=0 + GOTO 260 + ENDIF +C RQT=WTMAT(IBIN,IRED)/WTMAT(IRED,IRED) + RQTU=WTMAT(IBIN,IRED) + RQTL=WTMAT(IRED,IRED) +C...Switch order of operations + WTREL(IBIN)=WTREL(IBIN)-RQTU* + $ (WTREL(IRED)/RQTL) + DO 210 ICOE=IRED,NBIN + WTMAT(IBIN,ICOE)=WTMAT(IBIN,ICOE)- + $ RQTU*(WTMAT(IRED,ICOE)/RQTL) + 210 CONTINUE + 220 CONTINUE + 230 CONTINUE + DO 250 IRED=NBIN,1,-1 + DO 240 ICOE=IRED+1,NBIN + WTREL(IRED)=WTREL(IRED)-WTMAT(IRED,ICOE)*COEFU(ICOE) + 240 CONTINUE + IF(ABS(WTMAT(IRED,IRED)).LT.1D-20) THEN + MSOLV=0 + GOTO 260 + ENDIF + COEFU(IRED)=WTREL(IRED)/WTMAT(IRED,IRED) + TEMPC(IRED)=COEFU(IRED) + 250 CONTINUE +C...Return to original order + DO IBIN=1,NBIN + MTMP=IP(IBIN) + COEFU(MTMP)=TEMPC(IBIN) + ENDDO + ENDIF + +C...Share evenly if failure. + 260 IF(MSOLV.EQ.0) THEN + DO 270 IBIN=1,NBIN + COEFU(IBIN)=1D0 + WTRELN(IBIN)=0.1D0 + IF(WTRELS.GT.0D0) WTRELN(IBIN)=MAX(0.1D0, + & WTRSAV(IBIN)/WTRELS) + 270 CONTINUE + ENDIF + +C...Normalize coefficients, with piece shared democratically. + COEFSU=0D0 + WTRELS=0D0 + DO 280 IBIN=1,NBIN + COEFU(IBIN)=MAX(0D0,COEFU(IBIN)) + COEFSU=COEFSU+COEFU(IBIN) + WTRELS=WTRELS+WTRELN(IBIN) + 280 CONTINUE + IF(COEFSU.GT.0D0) THEN + DO 290 IBIN=1,NBIN + COEFO(IBIN)=PARP(122)/NBIN+(1D0-PARP(122))*0.5D0* + & (COEFU(IBIN)/COEFSU+WTRELN(IBIN)/WTRELS) + 290 CONTINUE + ELSE + DO 300 IBIN=1,NBIN + COEFO(IBIN)=1D0/NBIN + 300 CONTINUE + ENDIF + IF(IVAR.EQ.1) IOFF=0 + IF(IVAR.EQ.2) IOFF=17 + IF(IVAR.EQ.3) IOFF=7 + IF(IVAR.EQ.4) IOFF=12 + DO 310 IBIN=1,NBIN + ICOF=IOFF+IBIN + IF(IVAR.EQ.1) THEN + IF(IBIN.EQ.NBIN.AND.(MINT(72).LE.2.AND.IPEAK7.EQ.1)) THEN + ICOF=7 + ENDIF + ENDIF + IF(IVAR.EQ.3.AND.IBIN.EQ.4.AND.MINT(45).NE.3) ICOF=ICOF+1 + IF(IVAR.EQ.1.AND.IBIN.GE.7+IPEAK7.AND.MINT(72).EQ.3) THEN + COEFX(ISUB,IBIN-6-IPEAK7)=COEFO(IBIN) + ELSE + COEF(ISUB,ICOF)=COEFO(IBIN) + ENDIF + 310 CONTINUE + + IF(MSTP(122).GE.2) WRITE(MSTU(11),5600) CVAR(IVAR), + & (COEFO(IBIN),IBIN=1,NBIN) + + 320 CONTINUE + +C...Find two most promising maxima among points previously determined. + DO 330 J=1,4 + IACCMX(J)=0 + SIGSMX(J)=0D0 + 330 CONTINUE + NMAX=0 + DO 390 IACC=1,NACC + DO 340 J=1,30 + VINT(10+J)=VINTPT(IACC,J) + 340 CONTINUE + IF(ISTSB.NE.5) THEN + CALL PYSIGH(NCHN,SIGS) + IF(MWTXS.EQ.1) THEN + CALL PYEVWT(WTXS) + SIGS=WTXS*SIGS + ENDIF + ELSE + SIGS=0D0 + DO 350 IKIN3=1,MSTP(129) + CALL PYKMAP(5,0,0D0) + IF(MINT(51).EQ.1) GOTO 350 + CALL PYSIGH(NCHN,SIGTMP) + IF(MWTXS.EQ.1) THEN + CALL PYEVWT(WTXS) + SIGTMP=WTXS*SIGTMP + ENDIF + IF(SIGTMP.GT.SIGS) SIGS=SIGTMP + 350 CONTINUE + ENDIF + IEQ=0 + DO 360 IMV=1,NMAX + IF(ABS(SIGS-SIGSMX(IMV)).LT.1D-4*(SIGS+SIGSMX(IMV))) IEQ=IMV + 360 CONTINUE + IF(IEQ.EQ.0) THEN + DO 370 IMV=NMAX,1,-1 + IIN=IMV+1 + IF(SIGS.LE.SIGSMX(IMV)) GOTO 380 + IACCMX(IMV+1)=IACCMX(IMV) + SIGSMX(IMV+1)=SIGSMX(IMV) + 370 CONTINUE + IIN=1 + 380 IACCMX(IIN)=IACC + SIGSMX(IIN)=SIGS + IF(NMAX.LE.1) NMAX=NMAX+1 + ENDIF + 390 CONTINUE + +C...Read out starting position for search. + IF(MSTP(122).GE.2) WRITE(MSTU(11),5700) + SIGSAM=SIGSMX(1) + DO 440 IMAX=1,NMAX + IACC=IACCMX(IMAX) + MTAU=MVARPT(IACC,1) + MTAUP=MVARPT(IACC,2) + MYST=MVARPT(IACC,3) + MCTH=MVARPT(IACC,4) + VTAU=0.5D0 + VYST=0.5D0 + VCTH=0.5D0 + VTAUP=0.5D0 + +C...Starting point and step size in parameter space. + DO 430 IRPT=1,2 + DO 420 IVAR=1,4 + IF(NPTS(IVAR).EQ.1) GOTO 420 + IF(IVAR.EQ.1) VVAR=VTAU + IF(IVAR.EQ.2) VVAR=VTAUP + IF(IVAR.EQ.3) VVAR=VYST + IF(IVAR.EQ.4) VVAR=VCTH + IF(IVAR.EQ.1) MVAR=MTAU + IF(IVAR.EQ.2) MVAR=MTAUP + IF(IVAR.EQ.3) MVAR=MYST + IF(IVAR.EQ.4) MVAR=MCTH + IF(IRPT.EQ.1) VDEL=0.1D0 + IF(IRPT.EQ.2) VDEL=MAX(0.01D0,MIN(0.05D0,VVAR-0.02D0, + & 0.98D0-VVAR)) + IF(IRPT.EQ.1) VMAR=0.02D0 + IF(IRPT.EQ.2) VMAR=0.002D0 + IMOV0=1 + IF(IRPT.EQ.1.AND.IVAR.EQ.1) IMOV0=0 + DO 410 IMOV=IMOV0,8 + +C...Define new point in parameter space. + IF(IMOV.EQ.0) THEN + INEW=2 + VNEW=VVAR + ELSEIF(IMOV.EQ.1) THEN + INEW=3 + VNEW=VVAR+VDEL + ELSEIF(IMOV.EQ.2) THEN + INEW=1 + VNEW=VVAR-VDEL + ELSEIF(SIGSSM(3).GE.MAX(SIGSSM(1),SIGSSM(2)).AND. + & VVAR+2D0*VDEL.LT.1D0-VMAR) THEN + VVAR=VVAR+VDEL + SIGSSM(1)=SIGSSM(2) + SIGSSM(2)=SIGSSM(3) + INEW=3 + VNEW=VVAR+VDEL + ELSEIF(SIGSSM(1).GE.MAX(SIGSSM(2),SIGSSM(3)).AND. + & VVAR-2D0*VDEL.GT.VMAR) THEN + VVAR=VVAR-VDEL + SIGSSM(3)=SIGSSM(2) + SIGSSM(2)=SIGSSM(1) + INEW=1 + VNEW=VVAR-VDEL + ELSEIF(SIGSSM(3).GE.SIGSSM(1)) THEN + VDEL=0.5D0*VDEL + VVAR=VVAR+VDEL + SIGSSM(1)=SIGSSM(2) + INEW=2 + VNEW=VVAR + ELSE + VDEL=0.5D0*VDEL + VVAR=VVAR-VDEL + SIGSSM(3)=SIGSSM(2) + INEW=2 + VNEW=VVAR + ENDIF + +C...Convert to relevant variables and find derived new limits. + ILERR=0 + IF(IVAR.EQ.1) THEN + VTAU=VNEW + CALL PYKMAP(1,MTAU,VTAU) + IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN + CALL PYKLIM(4) + IF(MINT(51).EQ.1) ILERR=1 + ENDIF + ENDIF + IF(IVAR.LE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5.AND. + & ILERR.EQ.0) THEN + IF(IVAR.EQ.2) VTAUP=VNEW + CALL PYKMAP(4,MTAUP,VTAUP) + ENDIF + IF(IVAR.LE.2.AND.ILERR.EQ.0) THEN + CALL PYKLIM(2) + IF(MINT(51).EQ.1) ILERR=1 + ENDIF + IF(IVAR.LE.3.AND.ILERR.EQ.0) THEN + IF(IVAR.EQ.3) VYST=VNEW + CALL PYKMAP(2,MYST,VYST) + CALL PYKLIM(3) + IF(MINT(51).EQ.1) ILERR=1 + ENDIF + IF((ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6).AND. + & ILERR.EQ.0) THEN + IF(IVAR.EQ.4) VCTH=VNEW + CALL PYKMAP(3,MCTH,VCTH) + ENDIF + IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2) + +C...Evaluate cross-section. Save new maximum. Final maximum. + IF(ILERR.NE.0) THEN + SIGS=0. + ELSEIF(ISTSB.NE.5) THEN + CALL PYSIGH(NCHN,SIGS) + IF(MWTXS.EQ.1) THEN + CALL PYEVWT(WTXS) + SIGS=WTXS*SIGS + ENDIF + ELSE + SIGS=0D0 + DO 400 IKIN3=1,MSTP(129) + CALL PYKMAP(5,0,0D0) + IF(MINT(51).EQ.1) GOTO 400 + CALL PYSIGH(NCHN,SIGTMP) + IF(MWTXS.EQ.1) THEN + CALL PYEVWT(WTXS) + SIGTMP=WTXS*SIGTMP + ENDIF + IF(SIGTMP.GT.SIGS) SIGS=SIGTMP + 400 CONTINUE + ENDIF + SIGSSM(INEW)=SIGS + IF(SIGS.GT.SIGSAM) SIGSAM=SIGS + IF(MSTP(122).GE.2) WRITE(MSTU(11),5800) IMAX,IVAR,MVAR, + & IMOV,VNEW,VINT(21),VINT(22),VINT(23),VINT(26),SIGS + 410 CONTINUE + 420 CONTINUE + 430 CONTINUE + 440 CONTINUE + IF(MSTP(121).EQ.1) SIGSAM=PARP(121)*SIGSAM + XSEC(ISUB,1)=1.05D0*SIGSAM +C...Add extra headroom for UED + IF(ISUB.GT.310.AND.ISUB.LT.320) XSEC(ISUB,1)=XSEC(ISUB,1)*1.1D0 + IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= + & WTGAGA*XSEC(ISUB,1) + 450 CONTINUE + IF(MSTP(173).EQ.1.AND.ISUB.NE.96) XSEC(ISUB,1)= + & PARP(174)*XSEC(ISUB,1) + IF(ISUB.NE.96) XSEC(0,1)=XSEC(0,1)+XSEC(ISUB,1) + 460 CONTINUE + MINT(51)=0 + +C...Print summary table. + IF(MINT(121).EQ.1.AND.NPOSI.EQ.0) THEN + IF(MSTP(127).NE.1) THEN + WRITE(MSTU(11),5900) + CALL PYSTOP(1) + ELSE + WRITE(MSTU(11),6400) + MSTI(53)=1 + ENDIF + ENDIF + IF(MSTP(122).GE.1) THEN + WRITE(MSTU(11),6000) + WRITE(MSTU(11),6100) + DO 470 ISUB=1,500 + IF(MSUB(ISUB).NE.1.AND.ISUB.NE.96) GOTO 470 + IF(ISUB.EQ.96.AND.MINT(50).EQ.0) GOTO 470 + IF(ISUB.EQ.96.AND.MSUB(95).NE.1.AND.MOD(MSTP(81),10).LE.0) + & GOTO 470 + IF(ISUB.EQ.96.AND.MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 470 + IF(MSUB(95).EQ.1.AND.(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13 + & .OR.ISUB.EQ.28.OR.ISUB.EQ.53.OR.ISUB.EQ.68)) GOTO 470 + IF(MSUB(95).EQ.1.AND.ISUB.GE.381.AND.ISUB.LE.386) GOTO 470 + WRITE(MSTU(11),6200) ISUB,PROC(ISUB),XSEC(ISUB,1) + 470 CONTINUE + WRITE(MSTU(11),6300) + ENDIF + +C...Format statements for maximization results. + 5000 FORMAT(/1X,'Coefficient optimization and maximum search for ', + &'subprocess no',I4/1X,'Coefficient modes tau',10X,'y*',9X, + &'cth',9X,'tau''',7X,'sigma') + 5100 FORMAT(1X,'Warning: requested subprocess ',I3,' has no allowed ', + &'phase space.'/1X,'Process switched off!') + 5200 FORMAT(1X,4I4,F12.8,F12.6,F12.7,F12.8,1P,D12.4) + 5300 FORMAT(1X,'Warning: requested subprocess ',I3,' has vanishing ', + &'cross-section.'/1X,'Process switched off!') + 5400 FORMAT(1X,'Coefficients of equation system to be solved for ',A4) + 5500 FORMAT(1X,1P,10D11.3) + 5600 FORMAT(1X,'Result for ',A4,':',9F9.4) + 5700 FORMAT(1X,'Maximum search for given coefficients'/2X,'MAX VAR ', + &'MOD MOV VNEW',7X,'tau',7X,'y*',8X,'cth',7X,'tau''',7X,'sigma') + 5800 FORMAT(1X,4I4,F8.4,F11.7,F9.3,F11.6,F11.7,1P,D12.4) + 5900 FORMAT(1X,'Error: no requested process has non-vanishing ', + &'cross-section.'/1X,'Execution stopped!') + 6000 FORMAT(/1X,8('*'),1X,'PYMAXI: summary of differential ', + &'cross-section maximum search',1X,8('*')) + 6100 FORMAT(/11X,58('=')/11X,'I',38X,'I',17X,'I'/11X,'I ISUB ', + &'Subprocess name',15X,'I Maximum value I'/11X,'I',38X,'I', + &17X,'I'/11X,58('=')/11X,'I',38X,'I',17X,'I') + 6200 FORMAT(11X,'I',2X,I3,3X,A28,2X,'I',2X,1P,D12.4,3X,'I') + 6300 FORMAT(11X,'I',38X,'I',17X,'I'/11X,58('=')) + 6400 FORMAT(1X,'Error: no requested process has non-vanishing ', + &'cross-section.'/ + &1X,'Execution will stop if you try to generate events.') + + RETURN + END + +C********************************************************************* + +C...PYPILE +C...Initializes multiplicity distribution and selects mutliplicity +C...of pileup events, i.e. several events occuring at the same +C...beam crossing. + + SUBROUTINE PYPILE(MPILE) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT7/SIGT(0:6,0:6,0:5) + SAVE /PYDAT1/,/PYPARS/,/PYINT1/,/PYINT7/ +C...Local arrays and saved variables. + DIMENSION WTI(0:200) + SAVE IMIN,IMAX,WTI,WTS + +C...Sum of allowed cross-sections for pileup events. + IF(MPILE.EQ.1) THEN + VINT(131)=SIGT(0,0,5) + IF(MSTP(132).GE.2) VINT(131)=VINT(131)+SIGT(0,0,4) + IF(MSTP(132).GE.3) VINT(131)=VINT(131)+SIGT(0,0,2)+SIGT(0,0,3) + IF(MSTP(132).GE.4) VINT(131)=VINT(131)+SIGT(0,0,1) + IF(MSTP(133).LE.0) RETURN + +C...Initialize multiplicity distribution at maximum. + XNAVE=VINT(131)*PARP(131) + IF(XNAVE.GT.120D0) WRITE(MSTU(11),5000) XNAVE + INAVE=MAX(1,MIN(200,NINT(XNAVE))) + WTI(INAVE)=1D0 + WTS=WTI(INAVE) + WTN=WTI(INAVE)*INAVE + +C...Find shape of multiplicity distribution below maximum. + IMIN=INAVE + DO 100 I=INAVE-1,1,-1 + IF(MSTP(133).EQ.1) WTI(I)=WTI(I+1)*(I+1)/XNAVE + IF(MSTP(133).GE.2) WTI(I)=WTI(I+1)*I/XNAVE + IF(WTI(I).LT.1D-6) GOTO 110 + WTS=WTS+WTI(I) + WTN=WTN+WTI(I)*I + IMIN=I + 100 CONTINUE + +C...Find shape of multiplicity distribution above maximum. + 110 IMAX=INAVE + DO 120 I=INAVE+1,200 + IF(MSTP(133).EQ.1) WTI(I)=WTI(I-1)*XNAVE/I + IF(MSTP(133).GE.2) WTI(I)=WTI(I-1)*XNAVE/(I-1) + IF(WTI(I).LT.1D-6) GOTO 130 + WTS=WTS+WTI(I) + WTN=WTN+WTI(I)*I + IMAX=I + 120 CONTINUE + 130 VINT(132)=XNAVE + VINT(133)=WTN/WTS + IF(MSTP(133).EQ.1.AND.IMIN.EQ.1) VINT(134)= + & WTS/(WTS+WTI(1)/XNAVE) + IF(MSTP(133).EQ.1.AND.IMIN.GT.1) VINT(134)=1D0 + IF(MSTP(133).GE.2) VINT(134)=XNAVE + +C...Pick multiplicity of pileup events. + ELSE + IF(MSTP(133).LE.0) THEN + MINT(81)=MAX(1,MSTP(134)) + ELSE + WTR=WTS*PYR(0) + DO 140 I=IMIN,IMAX + MINT(81)=I + WTR=WTR-WTI(I) + IF(WTR.LE.0D0) GOTO 150 + 140 CONTINUE + 150 CONTINUE + ENDIF + ENDIF + +C...Format statement for error message. + 5000 FORMAT(1X,'Warning: requested average number of events per bunch', + &'crossing too large, ',1P,D12.4) + + RETURN + END + +C********************************************************************* + +C...PYSAVE +C...Saves and restores parameter and cross section values for the +C...3 gamma-p and 6 (or 4, or 9, or 13) gamma-gamma alternatives. +C...Also makes random choice between alternatives. + + SUBROUTINE PYSAVE(ISAVE,IGA) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINT7/SIGT(0:6,0:6,0:5) + SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT5/,/PYINT7/ +C...Local arrays and saved variables. + DIMENSION NCP(15),NSUBCP(15,20),MSUBCP(15,20),COEFCP(15,20,20), + &NGENCP(15,0:20,3),XSECCP(15,0:20,3),SIGTCP(15,0:6,0:6,0:5), + &INTCP(15,20),RECP(15,20) + SAVE NCP,NSUBCP,MSUBCP,COEFCP,NGENCP,XSECCP,SIGTCP,INTCP,RECP + +C...Save list of subprocesses and cross-section information. + IF(ISAVE.EQ.1) THEN + ICP=0 + DO 120 I=1,500 + IF(MSUB(I).EQ.0.AND.I.NE.96.AND.I.NE.97) GOTO 120 + ICP=ICP+1 + NSUBCP(IGA,ICP)=I + MSUBCP(IGA,ICP)=MSUB(I) + DO 100 J=1,20 + COEFCP(IGA,ICP,J)=COEF(I,J) + 100 CONTINUE + DO 110 J=1,3 + NGENCP(IGA,ICP,J)=NGEN(I,J) + XSECCP(IGA,ICP,J)=XSEC(I,J) + 110 CONTINUE + 120 CONTINUE + NCP(IGA)=ICP + DO 130 J=1,3 + NGENCP(IGA,0,J)=NGEN(0,J) + XSECCP(IGA,0,J)=XSEC(0,J) + 130 CONTINUE + DO 160 I1=0,6 + DO 150 I2=0,6 + DO 140 J=0,5 + SIGTCP(IGA,I1,I2,J)=SIGT(I1,I2,J) + 140 CONTINUE + 150 CONTINUE + 160 CONTINUE + +C...Save various common process variables. + DO 170 J=1,10 + INTCP(IGA,J)=MINT(40+J) + 170 CONTINUE + INTCP(IGA,11)=MINT(101) + INTCP(IGA,12)=MINT(102) + INTCP(IGA,13)=MINT(107) + INTCP(IGA,14)=MINT(108) + INTCP(IGA,15)=MINT(123) + RECP(IGA,1)=CKIN(3) + RECP(IGA,2)=VINT(318) + +C...Save cross-section information only. + ELSEIF(ISAVE.EQ.2) THEN + DO 190 ICP=1,NCP(IGA) + I=NSUBCP(IGA,ICP) + DO 180 J=1,3 + NGENCP(IGA,ICP,J)=NGEN(I,J) + XSECCP(IGA,ICP,J)=XSEC(I,J) + 180 CONTINUE + 190 CONTINUE + DO 200 J=1,3 + NGENCP(IGA,0,J)=NGEN(0,J) + XSECCP(IGA,0,J)=XSEC(0,J) + 200 CONTINUE + +C...Choose between allowed alternatives. + ELSEIF(ISAVE.EQ.3.OR.ISAVE.EQ.4) THEN + IF(ISAVE.EQ.4) THEN + XSUMCP=0D0 + DO 210 IG=1,MINT(121) + XSUMCP=XSUMCP+XSECCP(IG,0,1) + 210 CONTINUE + XSUMCP=XSUMCP*PYR(0) + DO 220 IG=1,MINT(121) + IGA=IG + XSUMCP=XSUMCP-XSECCP(IG,0,1) + IF(XSUMCP.LE.0D0) GOTO 230 + 220 CONTINUE + 230 CONTINUE + ENDIF + +C...Restore cross-section information. + DO 240 I=1,500 + MSUB(I)=0 + 240 CONTINUE + DO 270 ICP=1,NCP(IGA) + I=NSUBCP(IGA,ICP) + MSUB(I)=MSUBCP(IGA,ICP) + DO 250 J=1,20 + COEF(I,J)=COEFCP(IGA,ICP,J) + 250 CONTINUE + DO 260 J=1,3 + NGEN(I,J)=NGENCP(IGA,ICP,J) + XSEC(I,J)=XSECCP(IGA,ICP,J) + 260 CONTINUE + 270 CONTINUE + DO 280 J=1,3 + NGEN(0,J)=NGENCP(IGA,0,J) + XSEC(0,J)=XSECCP(IGA,0,J) + 280 CONTINUE + DO 310 I1=0,6 + DO 300 I2=0,6 + DO 290 J=0,5 + SIGT(I1,I2,J)=SIGTCP(IGA,I1,I2,J) + 290 CONTINUE + 300 CONTINUE + 310 CONTINUE + +C...Restore various common process variables. + DO 320 J=1,10 + MINT(40+J)=INTCP(IGA,J) + 320 CONTINUE + MINT(101)=INTCP(IGA,11) + MINT(102)=INTCP(IGA,12) + MINT(107)=INTCP(IGA,13) + MINT(108)=INTCP(IGA,14) + MINT(123)=INTCP(IGA,15) + CKIN(3)=RECP(IGA,1) + CKIN(1)=2D0*CKIN(3) + VINT(318)=RECP(IGA,2) + +C...Sum up cross-section info (for PYSTAT). + ELSEIF(ISAVE.EQ.5) THEN + DO 330 I=1,500 + MSUB(I)=0 + NGEN(I,1)=0 + NGEN(I,3)=0 + XSEC(I,3)=0D0 + 330 CONTINUE + NGEN(0,1)=0 + NGEN(0,2)=0 + NGEN(0,3)=0 + XSEC(0,3)=0 + DO 350 IG=1,MINT(121) + DO 340 ICP=1,NCP(IG) + I=NSUBCP(IG,ICP) + IF(MSUBCP(IG,ICP).EQ.1) MSUB(I)=1 + NGEN(I,1)=NGEN(I,1)+NGENCP(IG,ICP,1) + NGEN(I,3)=NGEN(I,3)+NGENCP(IG,ICP,3) + XSEC(I,3)=XSEC(I,3)+XSECCP(IG,ICP,3) + 340 CONTINUE + NGEN(0,1)=NGEN(0,1)+NGENCP(IG,0,1) + NGEN(0,2)=NGEN(0,2)+NGENCP(IG,0,2) + NGEN(0,3)=NGEN(0,3)+NGENCP(IG,0,3) + XSEC(0,3)=XSEC(0,3)+XSECCP(IG,0,3) + 350 CONTINUE + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYGAGA +C...For lepton beams it gives photon-hadron or photon-photon systems +C...to be treated with the ordinary machinery and combines this with a +C...description of the lepton -> lepton + photon branching. + + SUBROUTINE PYGAGA(IGAGA,WTGAGA) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, + &/PYINT5/ +C...Local variables and data statement. + DIMENSION PMS(2),XMIN(2),XMAX(2),Q2MIN(2),Q2MAX(2),PMC(3), + &X(2),Q2(2),Y(2),THETA(2),PHI(2),PT(2),BETA(3) + SAVE PMS,XMIN,XMAX,Q2MIN,Q2MAX,PMC,X,Q2,THETA,PHI,PT,W2MIN + DATA EPS/1D-4/ + +C...Initialize generation of photons inside leptons. + IF(IGAGA.EQ.1) THEN + +C...Save quantities on incoming lepton system. + VINT(301)=VINT(1) + VINT(302)=VINT(2) + PMS(1)=VINT(303)**2 + IF(MINT(141).EQ.0) PMS(1)=SIGN(VINT(3)**2,VINT(3)) + PMS(2)=VINT(304)**2 + IF(MINT(142).EQ.0) PMS(2)=SIGN(VINT(4)**2,VINT(4)) + PMC(3)=VINT(302)-PMS(1)-PMS(2) + W2MIN=MAX(CKIN(77),2D0*CKIN(3),2D0*CKIN(5))**2 + +C...Calculate range of x and Q2 values allowed in generation. + DO 100 I=1,2 + PMC(I)=VINT(302)+PMS(I)-PMS(3-I) + IF(MINT(140+I).NE.0) THEN + XMIN(I)=MAX(CKIN(59+2*I),EPS) + XMAX(I)=MIN(CKIN(60+2*I),1D0-2D0*VINT(301)*SQRT(PMS(I))/ + & PMC(I),1D0-EPS) + YMIN=MAX(CKIN(71+2*I),EPS) + YMAX=MIN(CKIN(72+2*I),1D0-EPS) + IF(CKIN(64+2*I).GT.0D0) XMIN(I)=MAX(XMIN(I), + & (YMIN*PMC(3)-CKIN(64+2*I))/PMC(I)) + XMAX(I)=MIN(XMAX(I),(YMAX*PMC(3)-CKIN(63+2*I))/PMC(I)) + THEMIN=MAX(CKIN(67+2*I),0D0) + THEMAX=MIN(CKIN(68+2*I),PARU(1)) + IF(CKIN(68+2*I).LT.0D0) THEMAX=PARU(1) + Q2MIN(I)=MAX(CKIN(63+2*I),XMIN(I)**2*PMS(I)/(1D0-XMIN(I))+ + & ((1D0-XMAX(I))*(VINT(302)-2D0*PMS(3-I))- + & 2D0*PMS(I)/(1D0-XMAX(I)))*SIN(THEMIN/2D0)**2,0D0) + Q2MAX(I)=XMAX(I)**2*PMS(I)/(1D0-XMAX(I))+ + & ((1D0-XMIN(I))*(VINT(302)-2D0*PMS(3-I))- + & 2D0*PMS(I)/(1D0-XMIN(I)))*SIN(THEMAX/2D0)**2 + IF(CKIN(64+2*I).GT.0D0) Q2MAX(I)=MIN(CKIN(64+2*I),Q2MAX(I)) +C...W limits when lepton on one side only. + IF(MINT(143-I).EQ.0) THEN + XMIN(I)=MAX(XMIN(I),(W2MIN-PMS(3-I))/PMC(I)) + IF(CKIN(78).GT.0D0) XMAX(I)=MIN(XMAX(I), + & (CKIN(78)**2-PMS(3-I))/PMC(I)) + ENDIF + ENDIF + 100 CONTINUE + +C...W limits when lepton on both sides. + IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN + IF(CKIN(78).GT.0D0) XMAX(1)=MIN(XMAX(1), + & (CKIN(78)**2+PMC(3)-PMC(2)*XMIN(2))/PMC(1)) + IF(CKIN(78).GT.0D0) XMAX(2)=MIN(XMAX(2), + & (CKIN(78)**2+PMC(3)-PMC(1)*XMIN(1))/PMC(2)) + IF(IABS(MINT(141)).NE.IABS(MINT(142))) THEN + XMIN(1)=MAX(XMIN(1),(PMS(1)-PMS(2)+VINT(302)*(W2MIN- + & PMS(1)-PMS(2))/(PMC(2)*XMAX(2)+PMS(1)-PMS(2)))/PMC(1)) + XMIN(2)=MAX(XMIN(2),(PMS(2)-PMS(1)+VINT(302)*(W2MIN- + & PMS(1)-PMS(2))/(PMC(1)*XMAX(1)+PMS(2)-PMS(1)))/PMC(2)) + ELSE + XMIN(1)=MAX(XMIN(1),W2MIN/(VINT(302)*XMAX(2))) + XMIN(2)=MAX(XMIN(2),W2MIN/(VINT(302)*XMAX(1))) + ENDIF + ENDIF + +C...Q2 and W values and photon flux weight factors for initialization. + ELSEIF(IGAGA.EQ.2) THEN + ISUB=MINT(1) + MINT(15)=0 + MINT(16)=0 + +C...W value for photon on one or both sides, and for processes +C...with gamma-gamma cross section peaked at small shat. + IF(MINT(141).NE.0.AND.MINT(142).EQ.0) THEN + VINT(2)=VINT(302)+PMS(1)-PMC(1)*(1D0-XMAX(1)) + ELSEIF(MINT(141).EQ.0.AND.MINT(142).NE.0) THEN + VINT(2)=VINT(302)+PMS(2)-PMC(2)*(1D0-XMAX(2)) + ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN + VINT(2)=MAX(CKIN(77)**2,12D0*MAX(CKIN(3),CKIN(5))**2) + IF(CKIN(78).GT.0D0) VINT(2)=MIN(VINT(2),CKIN(78)**2) + ELSE + VINT(2)=XMAX(1)*XMAX(2)*VINT(302) + IF(CKIN(78).GT.0D0) VINT(2)=MIN(VINT(2),CKIN(78)**2) + ENDIF + VINT(1)=SQRT(MAX(0D0,VINT(2))) + +C...Upper estimate of photon flux weight factor. +C...Initialization Q2 scale. Flag incoming unresolved photon. + WTGAGA=1D0 + DO 110 I=1,2 + IF(MINT(140+I).NE.0) THEN + WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* + & LOG(XMAX(I)/XMIN(I))*LOG(Q2MAX(I)/Q2MIN(I)) + IF(ISUB.EQ.99.AND.MINT(106+I).EQ.4.AND.MINT(109-I).EQ.3) + & THEN + Q2INIT=5D0+Q2MIN(3-I) + ELSEIF(ISUB.EQ.99.AND.MINT(106+I).EQ.4) THEN + Q2INIT=PMAS(PYCOMP(113),1)**2+Q2MIN(3-I) + ELSEIF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN + Q2INIT=MAX(CKIN(1),2D0*CKIN(3),2D0*CKIN(5))**2/3D0 + ELSEIF((ISUB.EQ.138.AND.I.EQ.2).OR. + & (ISUB.EQ.139.AND.I.EQ.1)) THEN + Q2INIT=VINT(2)/3D0 + ELSEIF(ISUB.EQ.140) THEN + Q2INIT=VINT(2)/2D0 + ELSE + Q2INIT=Q2MIN(I) + ENDIF + VINT(2+I)=-SQRT(MAX(Q2MIN(I),MIN(Q2MAX(I),Q2INIT))) + IF(MSTP(14).EQ.0.OR.(ISUB.GE.131.AND.ISUB.LE.140)) + & MINT(14+I)=22 + VINT(306+I)=VINT(2+I)**2 + ENDIF + 110 CONTINUE + VINT(320)=WTGAGA + +C...Update pTmin and cross section information. + IF(MSTP(82).LE.1) THEN + PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) + ELSE + PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) + ENDIF + VINT(149)=4D0*PTMN**2/VINT(2) + VINT(154)=PTMN + CALL PYXTOT + VINT(318)=VINT(317) + +C...Generate photons inside leptons and +C...calculate photon flux weight factors. + ELSEIF(IGAGA.EQ.3) THEN + ISUB=MINT(1) + MINT(15)=0 + MINT(16)=0 + +C...Generate phase space point and check against cuts. + LOOP=0 + 120 LOOP=LOOP+1 + DO 130 I=1,2 + IF(MINT(140+I).NE.0) THEN +C...Pick x and Q2 + X(I)=XMIN(I)*(XMAX(I)/XMIN(I))**PYR(0) + Q2(I)=Q2MIN(I)*(Q2MAX(I)/Q2MIN(I))**PYR(0) +C...Cuts on internal consistency in x and Q2. + IF(Q2(I).LT.X(I)**2*PMS(I)/(1D0-X(I))) GOTO 120 + IF(Q2(I).GT.(1D0-X(I))*(VINT(302)-2D0*PMS(3-I))- + & (2D0-X(I)**2)*PMS(I)/(1D0-X(I))) GOTO 120 +C...Cuts on y and theta. + Y(I)=(PMC(I)*X(I)+Q2(I))/PMC(3) + IF(Y(I).LT.CKIN(71+2*I).OR.Y(I).GT.CKIN(72+2*I)) GOTO 120 + RAT=((1D0-X(I))*Q2(I)-X(I)**2*PMS(I))/ + & ((1D0-X(I))**2*(VINT(302)-2D0*PMS(3-I)-2D0*PMS(I))) + THETA(I)=2D0*ASIN(SQRT(MAX(0D0,MIN(1D0,RAT)))) + IF(THETA(I).LT.CKIN(67+2*I)) GOTO 120 + IF(CKIN(68+2*I).GT.0D0.AND.THETA(I).GT.CKIN(68+2*I)) + & GOTO 120 + +C...Phi angle isotropic. Reconstruct pT. + PHI(I)=PARU(2)*PYR(0) + PT(I)=SQRT(((1D0-X(I))*PMC(I))**2/(4D0*VINT(302))- + & PMS(I))*SIN(THETA(I)) + +C...Store info on variables selected, for documentation purposes. + VINT(2+I)=-SQRT(Q2(I)) + VINT(304+I)=X(I) + VINT(306+I)=Q2(I) + VINT(308+I)=Y(I) + VINT(310+I)=THETA(I) + VINT(312+I)=PHI(I) + ELSE + VINT(304+I)=1D0 + VINT(306+I)=0D0 + VINT(308+I)=1D0 + VINT(310+I)=0D0 + VINT(312+I)=0D0 + ENDIF + 130 CONTINUE + +C...Cut on W combines info from two sides. + IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN + W2=-Q2(1)-Q2(2)+0.5D0*X(1)*PMC(1)*X(2)*PMC(2)/VINT(302)- + & 2D0*PT(1)*PT(2)*COS(PHI(1)-PHI(2))+2D0* + & SQRT((0.5D0*X(1)*PMC(1)/VINT(301))**2+Q2(1)-PT(1)**2)* + & SQRT((0.5D0*X(2)*PMC(2)/VINT(301))**2+Q2(2)-PT(2)**2) + IF(W2.LT.W2MIN) GOTO 120 + IF(CKIN(78).GT.0D0.AND.W2.GT.CKIN(78)**2) GOTO 120 + PMS1=-Q2(1) + PMS2=-Q2(2) + ELSEIF(MINT(141).NE.0) THEN + W2=(VINT(302)+PMS(1))*X(1)+PMS(2)*(1D0-X(1)) + PMS1=-Q2(1) + PMS2=PMS(2) + ELSEIF(MINT(142).NE.0) THEN + W2=(VINT(302)+PMS(2))*X(2)+PMS(1)*(1D0-X(2)) + PMS1=PMS(1) + PMS2=-Q2(2) + ENDIF + +C...Store kinematics info for photon(s) in subsystem cm frame. + VINT(2)=W2 + VINT(1)=SQRT(W2) + VINT(291)=0D0 + VINT(292)=0D0 + VINT(293)=0.5D0*SQRT((W2-PMS1-PMS2)**2-4D0*PMS1*PMS2)/VINT(1) + VINT(294)=0.5D0*(W2+PMS1-PMS2)/VINT(1) + VINT(295)=SIGN(SQRT(ABS(PMS1)),PMS1) + VINT(296)=0D0 + VINT(297)=0D0 + VINT(298)=-VINT(293) + VINT(299)=0.5D0*(W2+PMS2-PMS1)/VINT(1) + VINT(300)=SIGN(SQRT(ABS(PMS2)),PMS2) + +C...Assign weight for photon flux; different for transverse and +C...longitudinal photons. Flag incoming unresolved photon. + WTGAGA=1D0 + DO 140 I=1,2 + IF(MINT(140+I).NE.0) THEN + WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* + & LOG(XMAX(I)/XMIN(I))*LOG(Q2MAX(I)/Q2MIN(I)) + IF(MSTP(16).EQ.0) THEN + XY=X(I) + ELSE + WTGAGA=WTGAGA*X(I)/Y(I) + XY=Y(I) + ENDIF + IF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN + WTGAGA=WTGAGA*(1D0-XY) + ELSEIF(I.EQ.1.AND.(ISUB.EQ.139.OR.ISUB.EQ.140)) THEN + WTGAGA=WTGAGA*(1D0-XY) + ELSEIF(I.EQ.2.AND.(ISUB.EQ.138.OR.ISUB.EQ.140)) THEN + WTGAGA=WTGAGA*(1D0-XY) + ELSE + WTGAGA=WTGAGA*(0.5D0*(1D0+(1D0-XY)**2)- + & PMS(I)*XY**2/Q2(I)) + ENDIF + IF(MINT(106+I).EQ.0) MINT(14+I)=22 + ENDIF + 140 CONTINUE + VINT(319)=WTGAGA + MINT(143)=LOOP + +C...Update pTmin and cross section information. + IF(MSTP(82).LE.1) THEN + PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) + ELSE + PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) + ENDIF + VINT(149)=4D0*PTMN**2/VINT(2) + VINT(154)=PTMN + CALL PYXTOT + +C...Reconstruct kinematics of photons inside leptons. + ELSEIF(IGAGA.EQ.4) THEN + +C...Make place for incoming particles and scattered leptons. + MOVE=3 + IF(MINT(141).NE.0.AND.MINT(142).NE.0) MOVE=4 + MINT(4)=MINT(4)+MOVE + DO 160 I=MINT(84)-MOVE,MINT(83)+1,-1 + IF(K(I,1).EQ.21) THEN + DO 150 J=1,5 + K(I+MOVE,J)=K(I,J) + P(I+MOVE,J)=P(I,J) + V(I+MOVE,J)=V(I,J) + 150 CONTINUE + IF(K(I,3).GT.MINT(83).AND.K(I,3).LE.MINT(84)) + & K(I+MOVE,3)=K(I,3)+MOVE + IF(K(I,4).GT.MINT(83).AND.K(I,4).LE.MINT(84)) + & K(I+MOVE,4)=K(I,4)+MOVE + IF(K(I,5).GT.MINT(83).AND.K(I,5).LE.MINT(84)) + & K(I+MOVE,5)=K(I,5)+MOVE + ENDIF + 160 CONTINUE + DO 170 I=MINT(84)+1,N + IF(K(I,3).GT.MINT(83).AND.K(I,3).LE.MINT(84)) + & K(I,3)=K(I,3)+MOVE + 170 CONTINUE + +C...Fill in incoming particles. + DO 190 I=MINT(83)+1,MINT(83)+MOVE + DO 180 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 180 CONTINUE + 190 CONTINUE + DO 200 I=1,2 + K(MINT(83)+I,1)=21 + IF(MINT(140+I).NE.0) THEN + K(MINT(83)+I,2)=MINT(140+I) + P(MINT(83)+I,5)=VINT(302+I) + ELSE + K(MINT(83)+I,2)=MINT(10+I) + P(MINT(83)+I,5)=VINT(2+I) + ENDIF + P(MINT(83)+I,3)=0.5D0*SQRT((PMC(3)**2-4D0*PMS(1)*PMS(2))/ + & VINT(302))*(-1D0)**(I+1) + P(MINT(83)+I,4)=0.5D0*PMC(I)/VINT(301) + 200 CONTINUE + +C...New mother-daughter relations in documentation section. + IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN + K(MINT(83)+1,4)=MINT(83)+3 + K(MINT(83)+1,5)=MINT(83)+5 + K(MINT(83)+2,4)=MINT(83)+4 + K(MINT(83)+2,5)=MINT(83)+6 + K(MINT(83)+3,3)=MINT(83)+1 + K(MINT(83)+5,3)=MINT(83)+1 + K(MINT(83)+4,3)=MINT(83)+2 + K(MINT(83)+6,3)=MINT(83)+2 + ELSEIF(MINT(141).NE.0) THEN + K(MINT(83)+1,4)=MINT(83)+3 + K(MINT(83)+1,5)=MINT(83)+4 + K(MINT(83)+2,4)=MINT(83)+5 + K(MINT(83)+3,3)=MINT(83)+1 + K(MINT(83)+4,3)=MINT(83)+1 + K(MINT(83)+5,3)=MINT(83)+2 + ELSEIF(MINT(142).NE.0) THEN + K(MINT(83)+1,4)=MINT(83)+4 + K(MINT(83)+2,4)=MINT(83)+3 + K(MINT(83)+2,5)=MINT(83)+5 + K(MINT(83)+3,3)=MINT(83)+2 + K(MINT(83)+4,3)=MINT(83)+1 + K(MINT(83)+5,3)=MINT(83)+2 + ENDIF + +C...Fill scattered lepton(s). + DO 210 I=1,2 + IF(MINT(140+I).NE.0) THEN + LSC=MINT(83)+MIN(I+2,MOVE) + K(LSC,1)=21 + K(LSC,2)=MINT(140+I) + P(LSC,1)=PT(I)*COS(PHI(I)) + P(LSC,2)=PT(I)*SIN(PHI(I)) + P(LSC,4)=(1D0-X(I))*P(MINT(83)+I,4) + P(LSC,3)=SQRT(P(LSC,4)**2-PMS(I))*COS(THETA(I))* + & (-1D0)**(I-1) + P(LSC,5)=VINT(302+I) + ENDIF + 210 CONTINUE + +C...Find incoming four-vectors to subprocess. + K(N+1,1)=21 + IF(MINT(141).NE.0) THEN + DO 220 J=1,4 + P(N+1,J)=P(MINT(83)+1,J)-P(MINT(83)+3,J) + 220 CONTINUE + ELSE + DO 230 J=1,4 + P(N+1,J)=P(MINT(83)+1,J) + 230 CONTINUE + ENDIF + K(N+2,1)=21 + IF(MINT(142).NE.0) THEN + DO 240 J=1,4 + P(N+2,J)=P(MINT(83)+2,J)-P(MINT(83)+MOVE,J) + 240 CONTINUE + ELSE + DO 250 J=1,4 + P(N+2,J)=P(MINT(83)+2,J) + 250 CONTINUE + ENDIF + +C...Define boost and rotation between hadronic subsystem and +C...collision rest frame; boost hadronic subsystem to this frame. + DO 260 J=1,3 + BETA(J)=(P(N+1,J)+P(N+2,J))/(P(N+1,4)+P(N+2,4)) + 260 CONTINUE + CALL PYROBO(N+1,N+2,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) + BPHI=PYANGL(P(N+1,1),P(N+1,2)) + CALL PYROBO(N+1,N+2,0D0,-BPHI,0D0,0D0,0D0) + BTHETA=PYANGL(P(N+1,3),P(N+1,1)) + CALL PYROBO(MINT(83)+MOVE+1,N,BTHETA,BPHI,BETA(1),BETA(2), + & BETA(3)) + +C...Add on scattered leptons to final state. + DO 280 I=1,2 + IF(MINT(140+I).NE.0) THEN + LSC=MINT(83)+MIN(I+2,MOVE) + N=N+1 + DO 270 J=1,5 + K(N,J)=K(LSC,J) + P(N,J)=P(LSC,J) + V(N,J)=V(LSC,J) + 270 CONTINUE + K(N,1)=1 + K(N,3)=LSC + ENDIF + 280 CONTINUE + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYRAND +C...Generates quantities characterizing the high-pT scattering at the +C...parton level according to the matrix elements. Chooses incoming, +C...reacting partons, their momentum fractions and one of the possible +C...subprocesses. + + SUBROUTINE PYRAND + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement to help give large particle numbers. + PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, + &KEXCIT=4000000,KDIMEN=5000000) + +C...User process initialization and event commonblocks. + INTEGER MAXPUP + PARAMETER (MAXPUP=100) + INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP + DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP + COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), + &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), + &LPRUP(MAXPUP) + INTEGER MAXNUP + PARAMETER (MAXNUP=500) + INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP + DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP + COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), + &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), + &VTIMUP(MAXNUP),SPINUP(MAXNUP) + SAVE /HEPRUP/,/HEPEUP/ + +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINT7/SIGT(0:6,0:6,0:5) + COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) + COMMON/PYTCCO/COEFX(194:380,2) + COMMON/TCPARA/IRES,JRES,XMAS(3),XWID(3),YMAS(2),YWID(2) + SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, + &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/,/PYMSSM/,/PYTCCO/, + &/TCPARA/ +C...Local arrays. + DIMENSION XPQ(-25:25),PMM(2),PDIF(4),BHAD(4),PMMN(2) + +C...Parameters and data used in elastic/diffractive treatment. + DATA EPS/0.0808D0/, ALP/0.25D0/, CRES/2D0/, PMRC/1.062D0/, + &SMP/0.880D0/, BHAD/2.3D0,1.4D0,1.4D0,0.23D0/ + +C...Initial values, specifically for (first) semihard interaction. + MINT(10)=0 + MINT(17)=0 + MINT(18)=0 + VINT(143)=1D0 + VINT(144)=1D0 + VINT(157)=0D0 + VINT(158)=0D0 + MFAIL=0 + IF(MSTP(171).EQ.1.AND.MSTP(172).EQ.2) MFAIL=1 + ISUB=0 + ISTSB=0 + LOOP=0 + 100 LOOP=LOOP+1 + MINT(51)=0 + MINT(143)=1 + VINT(97)=1D0 + +C...Start by assuming incoming photon is entering subprocess. + IF(MINT(11).EQ.22) THEN + MINT(15)=22 + VINT(307)=VINT(3)**2 + ENDIF + IF(MINT(12).EQ.22) THEN + MINT(16)=22 + VINT(308)=VINT(4)**2 + ENDIF + MINT(103)=MINT(11) + MINT(104)=MINT(12) + +C...Choice of process type - first event of pileup. + INMULT=0 + IF(MINT(82).EQ.1.AND.ISUB.GE.91.AND.ISUB.LE.96) THEN + ELSEIF(MINT(82).EQ.1) THEN + +C...For gamma-p or gamma-gamma first pick between alternatives. + IGA=0 + IF(MINT(121).GT.1) CALL PYSAVE(4,IGA) + MINT(122)=IGA + +C...For real gamma + gamma with different nature, flip at random. + IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4.AND. + & MSTP(14).LE.10.AND.PYR(0).GT.0.5D0) THEN + MINTSV=MINT(41) + MINT(41)=MINT(42) + MINT(42)=MINTSV + MINTSV=MINT(45) + MINT(45)=MINT(46) + MINT(46)=MINTSV + MINTSV=MINT(107) + MINT(107)=MINT(108) + MINT(108)=MINTSV + IF(MINT(47).EQ.2.OR.MINT(47).EQ.3) MINT(47)=5-MINT(47) + ENDIF + +C...Pick process type, possibly by user process machinery. +C...(If the latter, also event will be picked here.) + IF(MINT(111).GE.11.AND.IABS(IDWTUP).EQ.2.AND.LOOP.GE.2) THEN + CALL UPEVNT + CALL PYUPRE + ELSEIF(MINT(111).GE.11.AND.IABS(IDWTUP).GE.3) THEN + CALL UPEVNT + CALL PYUPRE + ISUB=0 + 110 ISUB=ISUB+1 + IF((ISET(ISUB).NE.11.OR.KFPR(ISUB,2).NE.IDPRUP).AND. + & ISUB.LT.500) GOTO 110 + ELSE + RSUB=XSEC(0,1)*PYR(0) + DO 120 I=1,500 + IF(MSUB(I).NE.1.OR.I.EQ.96) GOTO 120 + ISUB=I + RSUB=RSUB-XSEC(I,1) + IF(RSUB.LE.0D0) GOTO 130 + 120 CONTINUE + 130 IF(ISUB.EQ.95) ISUB=96 + IF(ISUB.EQ.96) INMULT=1 + IF(ISET(ISUB).EQ.11) THEN + IDPRUP=KFPR(ISUB,2) + CALL UPEVNT + CALL PYUPRE + ENDIF + ENDIF + +C...Choice of inclusive process type - pileup events. + ELSEIF(MINT(82).GE.2.AND.ISUB.EQ.0) THEN + RSUB=VINT(131)*PYR(0) + ISUB=96 + IF(RSUB.GT.SIGT(0,0,5)) ISUB=94 + IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)) ISUB=93 + IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)+SIGT(0,0,3)) ISUB=92 + IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)+SIGT(0,0,3)+SIGT(0,0,2)) + & ISUB=91 + IF(ISUB.EQ.96) INMULT=1 + ENDIF + +C...Choice of photon energy and flux factor inside lepton. + IF(MINT(141).NE.0.OR.MINT(142).NE.0) THEN + CALL PYGAGA(3,WTGAGA) + IF(ISUB.GE.131.AND.ISUB.LE.140) THEN + CKIN(3)=MAX(VINT(285),VINT(154)) + CKIN(1)=2D0*CKIN(3) + ENDIF +C...When necessary set direct/resolved photon by hand. + ELSEIF(MINT(15).EQ.22.OR.MINT(16).EQ.22) THEN + IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0 + IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0 + ENDIF + +C...Restrict direct*resolved processes to pTmin >= Q, +C...to avoid doublecounting with DIS. + IF(MSTP(18).EQ.3.AND.ISUB.GE.131.AND.ISUB.LE.136) THEN + IF(MINT(15).EQ.22) THEN + CKIN(3)=MAX(VINT(285),VINT(154),ABS(VINT(3))) + ELSE + CKIN(3)=MAX(VINT(285),VINT(154),ABS(VINT(4))) + ENDIF + CKIN(1)=2D0*CKIN(3) + ENDIF + +C...Set up for multiple interactions (may include impact parameter). + IF(INMULT.EQ.1) THEN + IF(MINT(35).LE.1) CALL PYMULT(2) + IF(MINT(35).GE.2) CALL PYMIGN(2) + ENDIF + +C...Loopback point for minimum bias in photon physics. + LOOP2=0 + 140 LOOP2=LOOP2+1 + IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)+MINT(143) + IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)+MINT(143) + IF(ISUB.EQ.96.AND.LOOP2.EQ.1.AND.MINT(82).EQ.1) + &NGEN(97,1)=NGEN(97,1)+MINT(143) + MINT(1)=ISUB + ISTSB=ISET(ISUB) + +C...Random choice of flavour for some SUSY processes. + IF(ISUB.GE.201.AND.ISUB.LE.301) THEN +C...~e_L ~nu_e or ~mu_L ~nu_mu. + IF(ISUB.EQ.210) THEN + KFPR(ISUB,1)=KSUSY1+11+2*INT(0.5D0+PYR(0)) + KFPR(ISUB,2)=KFPR(ISUB,1)+1 +C...~nu_e ~nu_e(bar) or ~nu_mu ~nu_mu(bar). + ELSEIF(ISUB.EQ.213) THEN + KFPR(ISUB,1)=KSUSY1+12+2*INT(0.5D0+PYR(0)) + KFPR(ISUB,2)=KFPR(ISUB,1) +C...~q ~chi/~g; ~q = ~d, ~u, ~s, ~c or ~b. + ELSEIF(ISUB.GE.246.AND.ISUB.LE.259.AND.ISUB.NE.255.AND. + & ISUB.NE.257) THEN + IF(ISUB.GE.258) THEN + RKF=4D0 + ELSE + RKF=5D0 + ENDIF + IF(MOD(ISUB,2).EQ.0) THEN + KFPR(ISUB,1)=KSUSY1+1+INT(RKF*PYR(0)) + ELSE + KFPR(ISUB,1)=KSUSY2+1+INT(RKF*PYR(0)) + ENDIF +C...~q1 ~q2; ~q = ~d, ~u, ~s, or ~c. + ELSEIF(ISUB.GE.271.AND.ISUB.LE.276) THEN + IF(ISUB.EQ.271.OR.ISUB.EQ.274) THEN + KSU1=KSUSY1 + KSU2=KSUSY1 + ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.275) THEN + KSU1=KSUSY2 + KSU2=KSUSY2 + ELSEIF(PYR(0).LT.0.5D0) THEN + KSU1=KSUSY1 + KSU2=KSUSY2 + ELSE + KSU1=KSUSY2 + KSU2=KSUSY1 + ENDIF + KFPR(ISUB,1)=KSU1+1+INT(4D0*PYR(0)) + KFPR(ISUB,2)=KSU2+1+INT(4D0*PYR(0)) +C...~q ~q(bar); ~q = ~d, ~u, ~s, or ~c. + ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.279) THEN + KFPR(ISUB,1)=KSUSY1+1+INT(4D0*PYR(0)) + KFPR(ISUB,2)=KFPR(ISUB,1) + ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.280) THEN + KFPR(ISUB,1)=KSUSY2+1+INT(4D0*PYR(0)) + KFPR(ISUB,2)=KFPR(ISUB,1) +C...~q1 ~q2; ~q = ~d, ~u, ~s, or ~c. + ELSEIF(ISUB.GE.281.AND.ISUB.LE.286) THEN + IF(ISUB.EQ.281.OR.ISUB.EQ.284) THEN + KSU1=KSUSY1 + KSU2=KSUSY1 + ELSEIF(ISUB.EQ.282.OR.ISUB.EQ.285) THEN + KSU1=KSUSY2 + KSU2=KSUSY2 + ELSEIF(PYR(0).LT.0.5D0) THEN + KSU1=KSUSY1 + KSU2=KSUSY2 + ELSE + KSU1=KSUSY2 + KSU2=KSUSY1 + ENDIF + IF(ISUB.EQ.281.OR.ISUB.LE.283) THEN + RKF=5D0 + ELSE + RKF=4D0 + ENDIF + KFPR(ISUB,2)=KSU2+1+INT(RKF*PYR(0)) + ENDIF + ENDIF + +C...Random choice of flavours for some UED processes +c...The production processes can generate a doublet pair, +c...a singlet pair, or a doublet + singlet. + IF(ISUB.EQ.313)THEN +C...q + q -> q*_Di + q*_Dj, q*_Si + q*_Sj + IF(PYR(0).LE.0.1)THEN + KFPR(ISUB,1)=5100001 + ELSE + KFPR(ISUB,1)=5100002 + ENDIF + KFPR(ISUB,2)=KFPR(ISUB,1) + ELSEIF(ISUB.EQ.314.OR.ISUB.EQ.315)THEN +C...g + g -> q*_D + q*_Dbar, q*_S + q*_Sbar +C...q + qbar -> q*_D + q*_Dbar, q*_S + q*_Sbar + IF(PYR(0).LE.0.1)THEN + KFPR(ISUB,1)=5100001 + ELSE + KFPR(ISUB,1)=5100002 + ENDIF + KFPR(ISUB,2)=-KFPR(ISUB,1) + ELSEIF(ISUB.EQ.316)THEN +C...qi + qbarj -> q*_Di + q*_Sbarj + IF(PYR(0).LE.0.5)THEN + KFPR(ISUB,1)=5100001 +c Changed from private pythia6410_ued code +c KFPR(ISUB,2)=-5010001 + KFPR(ISUB,2)=-6100002 + ELSE + KFPR(ISUB,1)=5100002 +c Changed from private pythia6410_ued code +c KFPR(ISUB,2)=-5010002 + KFPR(ISUB,2)=-6100001 + ENDIF + ELSEIF(ISUB.EQ.317)THEN +C...qi + qbarj -> q*_Di + q*_Dbarj, q*_Si + q*_Dbarj + IF(PYR(0).LE.0.5)THEN + KFPR(ISUB,1)=5100001 + KFPR(ISUB,2)=-5100002 + ELSE + KFPR(ISUB,1)=5100002 + KFPR(ISUB,2)=-5100001 + ENDIF + ELSEIF(ISUB.EQ.318)THEN +C...qi + qj -> q*_Di + q*_Sj + IF(PYR(0).LE.0.5)THEN + KFPR(ISUB,1)=5100001 + KFPR(ISUB,2)=6100002 + ELSE + KFPR(ISUB,1)=5100002 + KFPR(ISUB,2)=6100001 + ENDIF + ENDIF + +C...Find resonances (explicit or implicit in cross-section). + MINT(72)=0 + KFR1=0 + IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN + KFR1=KFPR(ISUB,1) + ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165.OR. + & ISUB.EQ.171.OR.ISUB.EQ.176) THEN + KFR1=23 + ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172.OR. + & ISUB.EQ.177) THEN + KFR1=24 + ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN + KFR1=25 + IF(MSTP(46).EQ.5) THEN + KFR1=89 + PMAS(89,1)=PARP(45) + PMAS(89,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) + ENDIF + ENDIF + CKMX=CKIN(2) + IF(CKMX.LE.0D0) CKMX=VINT(1) + KCR1=PYCOMP(KFR1) + IF(KFR1.NE.0) THEN + IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. + & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 + ENDIF + IF(KFR1.NE.0) THEN + TAUR1=PMAS(KCR1,1)**2/VINT(2) + GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) + MINT(72)=1 + MINT(73)=KFR1 + VINT(73)=TAUR1 + VINT(74)=GAMR1 + ENDIF + KFR2=0 + KFR3=0 + IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.ISUB.EQ.195.OR. + $(ISUB.GE.361.AND.ISUB.LE.380)) + $THEN + KFR2=23 + IF(ISUB.EQ.141) THEN + KCR2=PYCOMP(KFR2) + IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. + & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) THEN + KFR2=0 + ELSE + TAUR2=PMAS(KCR2,1)**2/VINT(2) + GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) + MINT(72)=2 + MINT(74)=KFR2 + VINT(75)=TAUR2 + VINT(76)=GAMR2 + ENDIF +C...3 resonances at work: rho, omega, a + ELSEIF(ISUB.EQ.194.OR.(ISUB.GE.361.AND.ISUB.LE.368) + & .OR.ISUB.EQ.379.OR.ISUB.EQ.380) THEN + MINT(72)=IRES + IF(IRES.GE.1) THEN + VINT(73)=XMAS(1)**2/VINT(2) + VINT(74)=XMAS(1)*XWID(1)/VINT(2) + TAUR1=VINT(73) + GAMR1=VINT(74) + KFR1=1 + ENDIF + IF(IRES.GE.2) THEN + VINT(75)=XMAS(2)**2/VINT(2) + VINT(76)=XMAS(2)*XWID(2)/VINT(2) + TAUR2=VINT(75) + GAMR2=VINT(76) + KFR2=2 + ENDIF + IF(IRES.EQ.3) THEN + VINT(77)=XMAS(3)**2/VINT(2) + VINT(78)=XMAS(3)*XWID(3)/VINT(2) + TAUR3=VINT(77) + GAMR3=VINT(78) + KFR3=3 + ENDIF +C...Charged current: rho+- and a+- + ELSEIF(ISUB.EQ.195.OR.ISUB.GE.370.AND.ISUB.LE.378) THEN + MINT(72)=IRES + IF(JRES.GE.1) THEN + VINT(73)=YMAS(1)**2/VINT(2) + VINT(74)=YMAS(1)*YWID(1)/VINT(2) + KFR1=1 + TAUR1=VINT(73) + GAMR1=VINT(74) + ENDIF + IF(JRES.GE.2) THEN + VINT(75)=YMAS(2)**2/VINT(2) + VINT(76)=YMAS(2)*YWID(2)/VINT(2) + KFR2=2 + TAUR2=VINT(73) + GAMR2=VINT(74) + ENDIF + KFR3=0 + ENDIF + IF(ISUB.NE.141) THEN + IF(KFR3.NE.0.AND.KFR2.NE.0.AND.KFR1.NE.0) THEN + + ELSEIF(KFR1.NE.0.AND.KFR2.NE.0) THEN + MINT(72)=2 + ELSEIF(KFR1.NE.0.AND.KFR3.NE.0) THEN + MINT(72)=2 + MINT(74)=KFR3 + VINT(75)=TAUR3 + VINT(76)=GAMR3 + ELSEIF(KFR2.NE.0.AND.KFR3.NE.0) THEN + MINT(72)=2 + MINT(73)=KFR2 + VINT(73)=TAUR2 + VINT(74)=GAMR2 + MINT(74)=KFR3 + VINT(75)=TAUR3 + VINT(76)=GAMR3 + ELSEIF(KFR1.NE.0) THEN + MINT(72)=1 + ELSEIF(KFR2.NE.0) THEN + MINT(72)=1 + MINT(73)=KFR2 + VINT(73)=TAUR2 + VINT(74)=GAMR2 + ELSEIF(KFR3.NE.0) THEN + MINT(72)=1 + MINT(73)=KFR3 + VINT(73)=TAUR3 + VINT(74)=GAMR3 + ELSE + MINT(72)=0 + ENDIF + ELSE + IF(KFR2.NE.0.AND.KFR1.NE.0) THEN + + ELSEIF(KFR2.NE.0) THEN + KFR1=KFR2 + TAUR1=TAUR2 + GAMR1=GAMR2 + MINT(72)=1 + MINT(73)=KFR1 + VINT(73)=TAUR1 + VINT(74)=GAMR1 + KFR2=0 + ELSE + MINT(72)=0 + ENDIF + ENDIF + ENDIF + +C...Find product masses and minimum pT of process, +C...optionally with broadening according to a truncated Breit-Wigner. + VINT(63)=0D0 + VINT(64)=0D0 + MINT(71)=0 + VINT(71)=CKIN(3) + IF(MINT(82).GE.2) VINT(71)=0D0 + VINT(80)=1D0 + IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN + NBW=0 + DO 160 I=1,2 + PMMN(I)=0D0 + IF(KFPR(ISUB,I).EQ.0) THEN + ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT. + & PARP(41)) THEN + VINT(62+I)=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 + ELSE + NBW=NBW+1 +C...This prevents SUSY/t particles from becoming too light. + KFLW=KFPR(ISUB,I) + IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN + KCW=PYCOMP(KFLW) + PMMN(I)=PMAS(KCW,1) + DO 150 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 + IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN + PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ + & PMAS(PYCOMP(KFDP(IDC,2)),1) + IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ + & PMAS(PYCOMP(KFDP(IDC,3)),1) + PMMN(I)=MIN(PMMN(I),PMSUM) + ENDIF + 150 CONTINUE + ELSEIF(KFLW.EQ.6) THEN + PMMN(I)=PMAS(24,1)+PMAS(5,1) + ENDIF + ENDIF + 160 CONTINUE + IF(NBW.GE.1) THEN + CKIN41=CKIN(41) + CKIN43=CKIN(43) + CKIN(41)=MAX(PMMN(1),CKIN(41)) + CKIN(43)=MAX(PMMN(2),CKIN(43)) + CALL PYOFSH(4,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) + CKIN(41)=CKIN41 + CKIN(43)=CKIN43 + IF(MINT(51).EQ.1) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(MFAIL.EQ.1) THEN + MSTI(61)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + VINT(63)=PQM3**2 + VINT(64)=PQM4**2 + ENDIF + IF(MIN(VINT(63),VINT(64)).LT.CKIN(6)**2) MINT(71)=1 + IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) + ENDIF + +C...Prepare for additional variable choices in 2 -> 3. + IF(ISTSB.EQ.5) THEN + VINT(201)=0D0 + IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1) + VINT(206)=VINT(201) + IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(206)=PMAS(5,1) + VINT(204)=PMAS(23,1) + IF(ISUB.EQ.124.OR.ISUB.EQ.174.OR.ISUB.EQ.179.OR.ISUB.EQ.351) + & VINT(204)=PMAS(24,1) + IF(ISUB.EQ.352) VINT(204)=PMAS(PYCOMP(9900024),1) + IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182.OR. + & ISUB.EQ.186.OR.ISUB.EQ.187.OR.ISUB.EQ.401.OR.ISUB.EQ.402) + & VINT(204)=VINT(201) + VINT(209)=VINT(204) + IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(209)=VINT(206) + ENDIF + +C...Select incoming VDM particle (rho/omega/phi/J/psi). + IF(ISTSB.NE.0.AND.(MINT(101).GE.2.OR.MINT(102).GE.2).AND. + &(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7)) THEN + VRN=PYR(0)*SIGT(0,0,5) + IF(MINT(101).LE.1) THEN + I1MN=0 + I1MX=0 + ELSE + I1MN=1 + I1MX=MINT(101) + ENDIF + IF(MINT(102).LE.1) THEN + I2MN=0 + I2MX=0 + ELSE + I2MN=1 + I2MX=MINT(102) + ENDIF + DO 180 I1=I1MN,I1MX + KFV1=110*I1+3 + DO 170 I2=I2MN,I2MX + KFV2=110*I2+3 + VRN=VRN-SIGT(I1,I2,5) + IF(VRN.LE.0D0) GOTO 190 + 170 CONTINUE + 180 CONTINUE + 190 IF(MINT(101).GE.2) MINT(103)=KFV1 + IF(MINT(102).GE.2) MINT(104)=KFV2 + ENDIF + + IF(ISTSB.EQ.0) THEN +C...Elastic scattering or single or double diffractive scattering. + +C...Select incoming particle (rho/omega/phi/J/psi for VDM) and mass. + MINT(103)=MINT(11) + MINT(104)=MINT(12) + PMM(1)=VINT(3) + PMM(2)=VINT(4) + IF(MINT(101).GE.2.OR.MINT(102).GE.2) THEN + JJ=ISUB-90 + VRN=PYR(0)*SIGT(0,0,JJ) + IF(MINT(101).LE.1) THEN + I1MN=0 + I1MX=0 + ELSE + I1MN=1 + I1MX=MINT(101) + ENDIF + IF(MINT(102).LE.1) THEN + I2MN=0 + I2MX=0 + ELSE + I2MN=1 + I2MX=MINT(102) + ENDIF + DO 210 I1=I1MN,I1MX + KFV1=110*I1+3 + DO 200 I2=I2MN,I2MX + KFV2=110*I2+3 + VRN=VRN-SIGT(I1,I2,JJ) + IF(VRN.LE.0D0) GOTO 220 + 200 CONTINUE + 210 CONTINUE + 220 IF(MINT(101).GE.2) THEN + MINT(103)=KFV1 + PMM(1)=PYMASS(KFV1) + ENDIF + IF(MINT(102).GE.2) THEN + MINT(104)=KFV2 + PMM(2)=PYMASS(KFV2) + ENDIF + ENDIF + VINT(67)=PMM(1) + VINT(68)=PMM(2) + +C...Select mass for GVMD states (rejecting previous assignment). + Q0S=4D0*PARP(15)**2 + Q1S=4D0*VINT(154)**2 + LOOP3=0 + 230 LOOP3=LOOP3+1 + DO 240 JT=1,2 + IF(MINT(106+JT).EQ.3) THEN + PS=VINT(2+JT)**2 + PMM(JT)=SQRT((Q0S+PS)*(Q1S+PS)/ + & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS) + IF(MINT(102+JT).GE.333) PMM(JT)=PMM(JT)- + & PMAS(PYCOMP(113),1)+PMAS(PYCOMP(MINT(102+JT)),1) + ENDIF + 240 CONTINUE + IF(PMM(1)+PMM(2)+PARP(104).GE.VINT(1)) THEN + IF(LOOP3.LT.100.AND.(MINT(107).EQ.3.OR.MINT(108).EQ.3)) + & GOTO 230 + GOTO 100 + ENDIF + +C...Side/sides of diffractive system. + MINT(17)=0 + MINT(18)=0 + IF(ISUB.EQ.92.OR.ISUB.EQ.94) MINT(17)=1 + IF(ISUB.EQ.93.OR.ISUB.EQ.94) MINT(18)=1 + +C...Find masses of particles and minimal masses of diffractive states. + DO 250 JT=1,2 + PDIF(JT)=PMM(JT) + VINT(68+JT)=PDIF(JT) + IF(MINT(16+JT).EQ.1) PDIF(JT)=PDIF(JT)+PARP(102) + 250 CONTINUE + SH=VINT(2) + SQM1=PMM(1)**2 + SQM2=PMM(2)**2 + SQM3=PDIF(1)**2 + SQM4=PDIF(2)**2 + SMRES1=(PMM(1)+PMRC)**2 + SMRES2=(PMM(2)+PMRC)**2 + +C...Find elastic slope and lower limit diffractive slope. + IHA=MAX(2,IABS(MINT(103))/110) + IF(IHA.GE.5) IHA=1 + IHB=MAX(2,IABS(MINT(104))/110) + IF(IHB.GE.5) IHB=1 + IF(ISUB.EQ.91) THEN + BMN=2D0*BHAD(IHA)+2D0*BHAD(IHB)+4D0*SH**EPS-4.2D0 + ELSEIF(ISUB.EQ.92) THEN + BMN=MAX(2D0,2D0*BHAD(IHB)) + ELSEIF(ISUB.EQ.93) THEN + BMN=MAX(2D0,2D0*BHAD(IHA)) + ELSEIF(ISUB.EQ.94) THEN + BMN=2D0*ALP*4D0 + ENDIF + +C...Determine maximum possible t range and coefficient of generation. + SQLA12=(SH-SQM1-SQM2)**2-4D0*SQM1*SQM2 + SQLA34=(SH-SQM3-SQM4)**2-4D0*SQM3*SQM4 + THA=SH-(SQM1+SQM2+SQM3+SQM4)+(SQM1-SQM2)*(SQM3-SQM4)/SH + THB=SQRT(MAX(0D0,SQLA12))*SQRT(MAX(0D0,SQLA34))/SH + THC=(SQM3-SQM1)*(SQM4-SQM2)+(SQM1+SQM4-SQM2-SQM3)* + & (SQM1*SQM4-SQM2*SQM3)/SH + THL=-0.5D0*(THA+THB) + THU=THC/THL + THRND=EXP(MAX(-50D0,BMN*(THL-THU)))-1D0 + +C...Select diffractive mass/masses according to dm^2/m^2. + LOOP3=0 + 260 LOOP3=LOOP3+1 + DO 270 JT=1,2 + IF(MINT(16+JT).EQ.0) THEN + PDIF(2+JT)=PDIF(JT) + ELSE + PMMIN=PDIF(JT) + PMMAX=MAX(VINT(2+JT),VINT(1)-PDIF(3-JT)) + PDIF(2+JT)=PMMIN*(PMMAX/PMMIN)**PYR(0) + ENDIF + 270 CONTINUE + SQM3=PDIF(3)**2 + SQM4=PDIF(4)**2 + +C..Additional mass factors, including resonance enhancement. + IF(PDIF(3)+PDIF(4).GE.VINT(1)) THEN + IF(LOOP3.LT.100) GOTO 260 + GOTO 100 + ENDIF + IF(ISUB.EQ.92) THEN + FSD=(1D0-SQM3/SH)*(1D0+CRES*SMRES1/(SMRES1+SQM3)) + IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 260 + ELSEIF(ISUB.EQ.93) THEN + FSD=(1D0-SQM4/SH)*(1D0+CRES*SMRES2/(SMRES2+SQM4)) + IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 260 + ELSEIF(ISUB.EQ.94) THEN + FDD=(1D0-(PDIF(3)+PDIF(4))**2/SH)*(SH*SMP/ + & (SH*SMP+SQM3*SQM4))*(1D0+CRES*SMRES1/(SMRES1+SQM3))* + & (1D0+CRES*SMRES2/(SMRES2+SQM4)) + IF(FDD.LT.PYR(0)*(1D0+CRES)**2) GOTO 260 + ENDIF + +C...Select t according to exp(Bmn*t) and correct to right slope. + TH=THU+LOG(1D0+THRND*PYR(0))/BMN + IF(ISUB.GE.92) THEN + IF(ISUB.EQ.92) THEN + BADD=2D0*ALP*LOG(SH/SQM3) + IF(BHAD(IHB).LT.1D0) BADD=MAX(0D0,BADD+2D0*BHAD(IHB)-2D0) + ELSEIF(ISUB.EQ.93) THEN + BADD=2D0*ALP*LOG(SH/SQM4) + IF(BHAD(IHA).LT.1D0) BADD=MAX(0D0,BADD+2D0*BHAD(IHA)-2D0) + ELSEIF(ISUB.EQ.94) THEN + BADD=2D0*ALP*(LOG(EXP(4D0)+SH/(ALP*SQM3*SQM4))-4D0) + ENDIF + IF(EXP(MAX(-50D0,BADD*(TH-THU))).LT.PYR(0)) GOTO 260 + ENDIF + +C...Check whether m^2 and t choices are consistent. + SQLA34=(SH-SQM3-SQM4)**2-4D0*SQM3*SQM4 + THA=SH-(SQM1+SQM2+SQM3+SQM4)+(SQM1-SQM2)*(SQM3-SQM4)/SH + THB=SQRT(MAX(0D0,SQLA12))*SQRT(MAX(0D0,SQLA34))/SH + IF(THB.LE.1D-8) GOTO 260 + THC=(SQM3-SQM1)*(SQM4-SQM2)+(SQM1+SQM4-SQM2-SQM3)* + & (SQM1*SQM4-SQM2*SQM3)/SH + THLM=-0.5D0*(THA+THB) + THUM=THC/THLM + IF(TH.LT.THLM.OR.TH.GT.THUM) GOTO 260 + +C...Information to output. + VINT(21)=1D0 + VINT(22)=0D0 + VINT(23)=MIN(1D0,MAX(-1D0,(THA+2D0*TH)/THB)) + VINT(45)=TH + VINT(59)=2D0*SQRT(MAX(0D0,-(THC+THA*TH+TH**2)))/THB + VINT(63)=PDIF(3)**2 + VINT(64)=PDIF(4)**2 + VINT(283)=PMM(1)**2/4D0 + VINT(284)=PMM(2)**2/4D0 + +C...Note: in the following, by In is meant the integral over the +C...quantity multiplying coefficient cn. +C...Choose tau according to h1(tau)/tau, where +C...h1(tau) = c1 + I1/I2*c2*1/tau + I1/I3*c3*1/(tau+tau_R) + +C...I1/I4*c4*tau/((s*tau-m^2)^2+(m*Gamma)^2) + +C...I1/I5*c5*1/(tau+tau_R') + +C...I1/I6*c6*tau/((s*tau-m'^2)^2+(m'*Gamma')^2) + +C...I1/I7*c7*tau/(1.-tau), and +C...c1 + c2 + c3 + c4 + c5 + c6 + c7 = 1. + ELSEIF(ISTSB.GE.1.AND.ISTSB.LE.5) THEN + CALL PYKLIM(1) + IF(MINT(51).NE.0) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(MFAIL.EQ.1) THEN + MSTI(61)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + RTAU=PYR(0) + MTAU=1 + IF(RTAU.GT.COEF(ISUB,1)) MTAU=2 + IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)) MTAU=3 + IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)) MTAU=4 + IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)) + & MTAU=5 + IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+ + & COEF(ISUB,5)) MTAU=6 + IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+ + & COEF(ISUB,5)+COEF(ISUB,6)) MTAU=7 +C...Additional check to handle techni-processes with extra resonance +C....Only modify tau treatment + IF(ISUB.EQ.194.OR.ISUB.EQ.195.OR.(ISUB.GE.361.AND.ISUB.LE.380)) + & THEN + IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3) + & +COEF(ISUB,4)+COEF(ISUB,5)+COEF(ISUB,6)+COEF(ISUB,7)) MTAU=8 + IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3) + & +COEF(ISUB,4)+COEF(ISUB,5)+COEF(ISUB,6)+COEF(ISUB,7) + & +COEFX(ISUB,1)) MTAU=9 + ENDIF + CALL PYKMAP(1,MTAU,PYR(0)) + +C...2 -> 3, 4 processes: +C...Choose tau' according to h4(tau,tau')/tau', where +C...h4(tau,tau') = c1 + I1/I2*c2*(1 - tau/tau')^3/tau' + +C...I1/I3*c3*1/(1 - tau'), and c1 + c2 + c3 = 1. + IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN + CALL PYKLIM(4) + IF(MINT(51).NE.0) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(MFAIL.EQ.1) THEN + MSTI(61)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + RTAUP=PYR(0) + MTAUP=1 + IF(RTAUP.GT.COEF(ISUB,18)) MTAUP=2 + IF(RTAUP.GT.COEF(ISUB,18)+COEF(ISUB,19)) MTAUP=3 + CALL PYKMAP(4,MTAUP,PYR(0)) + ENDIF + +C...Choose y* according to h2(y*), where +C...h2(y*) = I0/I1*c1*(y*-y*min) + I0/I2*c2*(y*max-y*) + +C...I0/I3*c3*1/cosh(y*) + I0/I4*c4*1/(1-exp(y*-y*max)) + +C...I0/I5*c5*1/(1-exp(-y*-y*min)), I0 = y*max-y*min, +C...and c1 + c2 + c3 + c4 + c5 = 1. + CALL PYKLIM(2) + IF(MINT(51).NE.0) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(MFAIL.EQ.1) THEN + MSTI(61)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + RYST=PYR(0) + MYST=1 + IF(RYST.GT.COEF(ISUB,8)) MYST=2 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)) MYST=4 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)+ + & COEF(ISUB,11)) MYST=5 + CALL PYKMAP(2,MYST,PYR(0)) + +C...2 -> 2 processes: +C...Choose cos(theta-hat) (cth) according to h3(cth), where +C...h3(cth) = c0 + I0/I1*c1*1/(A - cth) + I0/I2*c2*1/(A + cth) + +C...I0/I3*c3*1/(A - cth)^2 + I0/I4*c4*1/(A + cth)^2, +C...A = 1 + 2*(m3*m4/sh)^2 (= 1 for massless products), +C...and c0 + c1 + c2 + c3 + c4 = 1. + CALL PYKLIM(3) + IF(MINT(51).NE.0) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(MFAIL.EQ.1) THEN + MSTI(61)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN + RCTH=PYR(0) + MCTH=1 + IF(RCTH.GT.COEF(ISUB,13)) MCTH=2 + IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)) MCTH=3 + IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)) MCTH=4 + IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)+ + & COEF(ISUB,16)) MCTH=5 + CALL PYKMAP(3,MCTH,PYR(0)) + ENDIF + +C...2 -> 3 : select pT1, phi1, pT2, phi2, y3 for 3 outgoing. + IF(ISTSB.EQ.5) THEN + CALL PYKMAP(5,0,0D0) + IF(MINT(51).NE.0) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(MFAIL.EQ.1) THEN + MSTI(61)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + ENDIF + +C...DIS as f + gamma* -> f process: set dummy values. + ELSEIF(ISTSB.EQ.8) THEN + VINT(21)=0.9D0 + VINT(22)=0D0 + VINT(23)=0D0 + VINT(47)=0D0 + VINT(48)=0D0 + +C...Low-pT or multiple interactions (first semihard interaction). + ELSEIF(ISTSB.EQ.9) THEN + IF(MINT(35).LE.1) CALL PYMULT(3) + IF(MINT(35).GE.2) CALL PYMIGN(3) + ISUB=MINT(1) + +C...Study user-defined process: kinematics plus weight. + ELSEIF(ISTSB.EQ.11) THEN + IF(IDWTUP.GT.0.AND.XWGTUP.LT.0D0) CALL + & PYERRM(26,'(PYRAND:) Negative XWGTUP for user process') + MSTI(51)=0 + IF(NUP.LE.0) THEN + MINT(51)=2 + MSTI(51)=1 + IF(MINT(82).EQ.1) THEN + NGEN(0,1)=NGEN(0,1)-1 + NGEN(ISUB,1)=NGEN(ISUB,1)-1 + ENDIF + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + RETURN + ENDIF + +C...Extract cross section event weight. + IF(IABS(IDWTUP).EQ.1.OR.IABS(IDWTUP).EQ.4) THEN + SIGS=1D-9*XWGTUP + ELSE + SIGS=1D-9*XSECUP(KFPR(ISUB,1)) + ENDIF + IF(IABS(IDWTUP).GE.1.AND.IABS(IDWTUP).LE.3) THEN + VINT(97)=SIGN(1D0,XWGTUP) + ELSE + VINT(97)=1D-9*XWGTUP + ENDIF + +C...Construct 'trivial' kinematical variables needed. + KFL1=IDUP(1) + KFL2=IDUP(2) + VINT(41)=PUP(4,1)/EBMUP(1) + VINT(42)=PUP(4,2)/EBMUP(2) + IF (VINT(41).GT.1.000001.OR.VINT(42).GT.1.000001) THEN + CALL PYERRM(9,'(PYRAND:) x > 1 in external event '// + & '(listing follows):') + CALL PYLIST(7) + ENDIF + VINT(21)=VINT(41)*VINT(42) + VINT(22)=0.5D0*LOG(VINT(41)/VINT(42)) + VINT(44)=VINT(21)*VINT(2) + VINT(43)=SQRT(MAX(0D0,VINT(44))) + VINT(55)=SCALUP + IF(SCALUP.LE.0D0) VINT(55)=VINT(43) + VINT(56)=VINT(55)**2 + VINT(57)=AQEDUP + VINT(58)=AQCDUP + +C...Construct other kinematical variables needed (approximately). + VINT(23)=0D0 + VINT(26)=VINT(21) + VINT(45)=-0.5D0*VINT(44) + VINT(46)=-0.5D0*VINT(44) + VINT(49)=VINT(43) + VINT(50)=VINT(44) + VINT(51)=VINT(55) + VINT(52)=VINT(56) + VINT(53)=VINT(55) + VINT(54)=VINT(56) + VINT(25)=0D0 + VINT(48)=0D0 + IF(ISTUP(1).NE.-1.OR.ISTUP(2).NE.-1) CALL PYERRM(26, + & '(PYRAND:) unacceptable ISTUP code for incoming particles') + DO 280 IUP=3,NUP + IF(ISTUP(IUP).LT.1.OR.ISTUP(IUP).GT.3) CALL PYERRM(26, + & '(PYRAND:) unacceptable ISTUP code for particles') + IF(ISTUP(IUP).EQ.1) VINT(25)=VINT(25)+2D0*(PUP(5,IUP)**2+ + & PUP(1,IUP)**2+PUP(2,IUP)**2)/VINT(2) + IF(ISTUP(IUP).EQ.1) VINT(48)=VINT(48)+0.5D0*(PUP(1,IUP)**2+ + & PUP(2,IUP)**2) + 280 CONTINUE + VINT(47)=SQRT(VINT(48)) + ENDIF + +C...Choose azimuthal angle. + VINT(24)=0D0 + IF(ISTSB.NE.11) VINT(24)=PARU(2)*PYR(0) + +C...Check against user cuts on kinematics at parton level. + MINT(51)=0 + IF((ISUB.LE.90.OR.ISUB.GT.100).AND.ISTSB.LE.10) CALL PYKLIM(0) + IF(MINT(51).NE.0) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(MFAIL.EQ.1) THEN + MSTI(61)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + IF(MINT(82).EQ.1.AND.MSTP(141).GE.1.AND.ISTSB.LE.10) THEN + MCUT=0 + IF(MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+MSUB(95).EQ.0) + & CALL PYKCUT(MCUT) + IF(MCUT.NE.0) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(MFAIL.EQ.1) THEN + MSTI(61)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + ENDIF + + IF(ISTSB.LE.10) THEN +C... If internal process, call PYSIGH + CALL PYSIGH(NCHN,SIGS) + ELSE +C... If external process, still have to set MI starting scale + IF (MSTP(86).EQ.1) THEN +C... Limit phase space by xT2 of hard interaction +C... (gives undercounting of MI when ext proc != dijets) + XT2GMX = VINT(25) + ELSE +C... All accessible phase space allowed +C... (gives double counting of MI when ext proc = dijets) + XT2GMX = (1D0-VINT(41))*(1D0-VINT(42)) + ENDIF + VINT(62)=0.25D0*XT2GMX*VINT(2) + VINT(61)=SQRT(MAX(0D0,VINT(62))) + ENDIF + + SIGSOR=SIGS + SIGLPT=SIGT(0,0,5)*VINT(315)*VINT(316) + +C...Multiply cross section by lepton -> photon flux factor. + IF(MINT(141).NE.0.OR.MINT(142).NE.0) THEN + SIGS=WTGAGA*SIGS + DO 290 ICHN=1,NCHN + SIGH(ICHN)=WTGAGA*SIGH(ICHN) + 290 CONTINUE + SIGLPT=WTGAGA*SIGLPT + ENDIF + +C...Multiply cross-section by user-defined weights. + IF(MSTP(173).EQ.1) THEN + SIGS=PARP(173)*SIGS + DO 300 ICHN=1,NCHN + SIGH(ICHN)=PARP(173)*SIGH(ICHN) + 300 CONTINUE + SIGLPT=PARP(173)*SIGLPT + ENDIF + WTXS=1D0 + SIGSWT=SIGS + VINT(99)=1D0 + VINT(100)=1D0 + IF(MINT(82).EQ.1.AND.MSTP(142).GE.1) THEN + IF(ISUB.NE.96.AND.MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+ + & MSUB(95).EQ.0) CALL PYEVWT(WTXS) + SIGSWT=WTXS*SIGS + VINT(99)=WTXS + IF(MSTP(142).EQ.1) VINT(100)=1D0/WTXS + ENDIF + +C...Calculations for Monte Carlo estimate of all cross-sections. + IF(MINT(82).EQ.1.AND.ISUB.LE.90.OR.ISUB.GE.96) THEN + IF(MSTP(142).LE.1) THEN + XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS + ELSE + XSEC(ISUB,2)=XSEC(ISUB,2)+SIGSWT + ENDIF + ELSEIF(MINT(82).EQ.1) THEN + XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS + ENDIF + IF((ISUB.EQ.95.OR.ISUB.EQ.96).AND.LOOP2.EQ.1.AND. + &MINT(82).EQ.1) XSEC(97,2)=XSEC(97,2)+SIGLPT + +C...Multiple interactions: store results of cross-section calculation. + IF(MINT(50).EQ.1.AND.MSTP(82).GE.3) THEN + VINT(153)=SIGSOR + IF(MINT(35).LE.1) CALL PYMULT(4) + IF(MINT(35).GE.2) CALL PYMIGN(4) + ENDIF + +C...Ratio of actual to maximum cross section. + IF(ISTSB.NE.11) THEN + VIOL=SIGSWT/XSEC(ISUB,1) + IF(ISUB.EQ.96.AND.MSTP(173).EQ.1) VIOL=VIOL/PARP(174) + ELSEIF(IDWTUP.EQ.1.OR.IDWTUP.EQ.2) THEN + VIOL=XWGTUP/XMAXUP(KFPR(ISUB,1)) + ELSEIF(IDWTUP.EQ.-1.OR.IDWTUP.EQ.-2) THEN + VIOL=ABS(XWGTUP)/ABS(XMAXUP(KFPR(ISUB,1))) + ELSE + VIOL=1D0 + ENDIF + +C...Check that weight not negative. + IF(MSTP(123).LE.0) THEN + IF(VIOL.LT.-1D-3) THEN + WRITE(MSTU(11),5000) VIOL,NGEN(0,3)+1 + IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21), + & VINT(22),VINT(23),VINT(26) + CALL PYSTOP(2) + ENDIF + ELSE + IF(VIOL.LT.MIN(-1D-3,VINT(109))) THEN + VINT(109)=VIOL + IF(MSTP(123).LE.2) WRITE(MSTU(11),5200) VIOL,NGEN(0,3)+1 + IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21), + & VINT(22),VINT(23),VINT(26) + ENDIF + ENDIF + +C...Weighting using estimate of maximum of differential cross-section. + RATND=1D0 + IF(MFAIL.EQ.0.AND.ISUB.NE.95.AND.ISUB.NE.96) THEN + IF(VIOL.LT.PYR(0)) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(ISUB.GE.91.AND.ISUB.LE.94) ISUB=0 + GOTO 100 + ENDIF + ELSEIF(MFAIL.EQ.0) THEN + RATND=SIGLPT/XSEC(95,1) + VIOL=VIOL/RATND + IF(LOOP2.EQ.1.AND.RATND.LT.PYR(0)) THEN + IF(VIOL.GT.PYR(0).AND.MINT(82).EQ.1.AND.MSUB(95).EQ.1.AND. + & (ISUB.LE.90.OR.ISUB.GE.95)) NGEN(95,1)=NGEN(95,1)+MINT(143) + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + ISUB=0 + GOTO 100 + ENDIF + IF(VIOL.LT.PYR(0)) THEN + GOTO 140 + ENDIF + ELSEIF(ISUB.NE.95.AND.ISUB.NE.96) THEN + IF(VIOL.LT.PYR(0)) THEN + MSTI(61)=1 + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + RETURN + ENDIF + ELSE + RATND=SIGLPT/XSEC(95,1) + IF(LOOP.EQ.1.AND.RATND.LT.PYR(0)) THEN + MSTI(61)=1 + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + RETURN + ENDIF + VIOL=VIOL/RATND + IF(VIOL.LT.PYR(0)) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + GOTO 100 + ENDIF + ENDIF + +C...Check for possible violation of estimated maximum of differential +C...cross-section used in weighting. + IF(MSTP(123).LE.0) THEN + IF(VIOL.GT.1D0) THEN + WRITE(MSTU(11),5300) VIOL,NGEN(0,3)+1 + IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), + & VINT(22),VINT(23),VINT(26) + CALL PYSTOP(2) + ENDIF + ELSEIF(MSTP(123).EQ.1) THEN + IF(VIOL.GT.VINT(108)) THEN + VINT(108)=VIOL + IF(VIOL.GT.1.0001D0) THEN + MINT(10)=1 + WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 + IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), + & VINT(22),VINT(23),VINT(26) + ENDIF + ENDIF + ELSEIF(VIOL.GT.VINT(108)) THEN + VINT(108)=VIOL + IF(VIOL.GT.1D0) THEN + MINT(10)=1 + IF(MSTP(123).EQ.2) WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 + IF(ISTSB.EQ.11.AND.(IABS(IDWTUP).EQ.1.OR.IABS(IDWTUP).EQ.2)) + & THEN + XMAXUP(KFPR(ISUB,1))=VIOL*XMAXUP(KFPR(ISUB,1)) + IF(KFPR(ISUB,1).LE.9) THEN + IF(MSTP(123).EQ.2) WRITE(MSTU(11),5800) KFPR(ISUB,1), + & XMAXUP(KFPR(ISUB,1)) + ELSEIF(KFPR(ISUB,1).LE.99) THEN + IF(MSTP(123).EQ.2) WRITE(MSTU(11),5900) KFPR(ISUB,1), + & XMAXUP(KFPR(ISUB,1)) + ELSE + IF(MSTP(123).EQ.2) WRITE(MSTU(11),6000) KFPR(ISUB,1), + & XMAXUP(KFPR(ISUB,1)) + ENDIF + ENDIF + IF(ISTSB.NE.11.OR.IABS(IDWTUP).EQ.1) THEN + XDIF=XSEC(ISUB,1)*(VIOL-1D0) + XSEC(ISUB,1)=XSEC(ISUB,1)+XDIF + IF(MSUB(ISUB).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GT.96)) + & XSEC(0,1)=XSEC(0,1)+XDIF + IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), + & VINT(22),VINT(23),VINT(26) + IF(ISUB.LE.9) THEN + IF(MSTP(123).EQ.2) WRITE(MSTU(11),5500) ISUB,XSEC(ISUB,1) + ELSEIF(ISUB.LE.99) THEN + IF(MSTP(123).EQ.2) WRITE(MSTU(11),5600) ISUB,XSEC(ISUB,1) + ELSE + IF(MSTP(123).EQ.2) WRITE(MSTU(11),5700) ISUB,XSEC(ISUB,1) + ENDIF + ENDIF + VINT(108)=1D0 + ENDIF + ENDIF + +C...Multiple interactions: choose impact parameter (if not already done). + IF(MINT(39).EQ.0) VINT(148)=1D0 + IF(MINT(50).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GE.96).AND. + &MSTP(82).GE.3) THEN + IF(MINT(35).LE.1) CALL PYMULT(5) + IF(MINT(35).GE.2) CALL PYMIGN(5) + IF(VINT(150).LT.PYR(0)) THEN + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + IF(MFAIL.EQ.1) THEN + MSTI(61)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + ENDIF + IF(MINT(82).EQ.1) NGEN(0,2)=NGEN(0,2)+1 + IF(MINT(82).EQ.1.AND.MSUB(95).EQ.1) THEN + IF(ISUB.LE.90.OR.ISUB.GE.95) NGEN(95,1)=NGEN(95,1)+MINT(143) + IF(ISUB.LE.90.OR.ISUB.GE.96) NGEN(96,2)=NGEN(96,2)+1 + ENDIF + IF(ISUB.LE.90.OR.ISUB.GE.96) MINT(31)=MINT(31)+1 + +C...Choose flavour of reacting partons (and subprocess). + IF(ISTSB.GE.11) GOTO 320 + RSIGS=SIGS*PYR(0) + QT2=VINT(48) + RQQBAR=PARP(87)*(1D0-(QT2/(QT2+(PARP(88)*PARP(82)* + &(VINT(1)/PARP(89))**PARP(90))**2))**2) + IF(ISUB.NE.95.AND.(ISUB.NE.96.OR.MSTP(82).LE.1.OR. + &PYR(0).GT.RQQBAR)) THEN + DO 310 ICHN=1,NCHN + KFL1=ISIG(ICHN,1) + KFL2=ISIG(ICHN,2) + MINT(2)=ISIG(ICHN,3) + RSIGS=RSIGS-SIGH(ICHN) + IF(RSIGS.LE.0D0) GOTO 320 + 310 CONTINUE + +C...Multiple interactions: choose qqbar preferentially at small pT. + ELSEIF(ISUB.EQ.96) THEN + MINT(105)=MINT(103) + MINT(109)=MINT(107) + CALL PYSPLI(MINT(11),21,KFL1,KFLDUM) + MINT(105)=MINT(104) + MINT(109)=MINT(108) + CALL PYSPLI(MINT(12),21,KFL2,KFLDUM) + MINT(1)=11 + MINT(2)=1 + IF(KFL1.EQ.KFL2.AND.PYR(0).LT.0.5D0) MINT(2)=2 + +C...Low-pT: choose string drawing configuration. + ELSE + KFL1=21 + KFL2=21 + RSIGS=6D0*PYR(0) + MINT(2)=1 + IF(RSIGS.GT.1D0) MINT(2)=2 + IF(RSIGS.GT.2D0) MINT(2)=3 + ENDIF + +C...Reassign QCD process. Partons before initial state radiation. + 320 IF(MINT(2).GT.10) THEN + MINT(1)=MINT(2)/10 + MINT(2)=MOD(MINT(2),10) + ENDIF + IF(MINT(82).EQ.1.AND.MSTP(111).GE.0) NGEN(MINT(1),2)= + &NGEN(MINT(1),2)+1 + MINT(15)=KFL1 + MINT(16)=KFL2 + MINT(13)=MINT(15) + MINT(14)=MINT(16) + VINT(141)=VINT(41) + VINT(142)=VINT(42) + VINT(151)=0D0 + VINT(152)=0D0 + +C...Calculate x value of photon for parton inside photon inside e. + DO 350 JT=1,2 + MINT(18+JT)=0 + VINT(154+JT)=0D0 + MSPLI=0 + IF(JT.EQ.1.AND.MINT(43).LE.2) MSPLI=1 + IF(JT.EQ.2.AND.MOD(MINT(43),2).EQ.1) MSPLI=1 + IF(IABS(MINT(14+JT)).LE.8.OR.MINT(14+JT).EQ.21) MSPLI=MSPLI+1 + IF(MSPLI.EQ.2) THEN + KFLH=MINT(14+JT) + XHRD=VINT(140+JT) + Q2HRD=VINT(54) + MINT(105)=MINT(102+JT) + MINT(109)=MINT(106+JT) + VINT(120)=VINT(2+JT) +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JT +C.... + IF(MSTP(57).LE.1) THEN + CALL PYPDFU(22,XHRD,Q2HRD,XPQ) + ELSE + CALL PYPDFL(22,XHRD,Q2HRD,XPQ) + ENDIF + WTMX=4D0*XPQ(KFLH) + IF(MSTP(13).EQ.2) THEN + Q2PMS=Q2HRD/PMAS(11,1)**2 + WTMX=WTMX*LOG(MAX(2D0,Q2PMS*(1D0-XHRD)/XHRD**2)) + ENDIF + 330 XE=XHRD**PYR(0) + XG=MIN(1D0-1D-10,XHRD/XE) + IF(MSTP(57).LE.1) THEN + CALL PYPDFU(22,XG,Q2HRD,XPQ) + ELSE + CALL PYPDFL(22,XG,Q2HRD,XPQ) + ENDIF + WT=(1D0+(1D0-XE)**2)*XPQ(KFLH) + IF(MSTP(13).EQ.2) WT=WT*LOG(MAX(2D0,Q2PMS*(1D0-XE)/XE**2)) + IF(WT.LT.PYR(0)*WTMX) GOTO 330 + MINT(18+JT)=1 + VINT(154+JT)=XE + DO 340 KFLS=-25,25 + XSFX(JT,KFLS)=XPQ(KFLS) + 340 CONTINUE + ENDIF + 350 CONTINUE + +C...Pick scale where photon is resolved. + Q0S=PARP(15)**2 + Q1S=VINT(154)**2 + VINT(283)=0D0 + IF(MINT(107).EQ.3) THEN + IF(MSTP(66).EQ.1) THEN + VINT(283)=Q0S*(VINT(54)/Q0S)**PYR(0) + ELSEIF(MSTP(66).EQ.2) THEN + PS=VINT(3)**2 + Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* + & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) + Q2INT=SQRT(Q0S*Q2EFF) + VINT(283)=Q2INT*(VINT(54)/Q2INT)**PYR(0) + ELSEIF(MSTP(66).EQ.3) THEN + VINT(283)=Q0S*(Q1S/Q0S)**PYR(0) + ELSEIF(MSTP(66).GE.4) THEN + PS=0.25D0*VINT(3)**2 + VINT(283)=(Q0S+PS)*(Q1S+PS)/ + & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS + ENDIF + ENDIF + VINT(284)=0D0 + IF(MINT(108).EQ.3) THEN + IF(MSTP(66).EQ.1) THEN + VINT(284)=Q0S*(VINT(54)/Q0S)**PYR(0) + ELSEIF(MSTP(66).EQ.2) THEN + PS=VINT(4)**2 + Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* + & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) + Q2INT=SQRT(Q0S*Q2EFF) + VINT(284)=Q2INT*(VINT(54)/Q2INT)**PYR(0) + ELSEIF(MSTP(66).EQ.3) THEN + VINT(284)=Q0S*(Q1S/Q0S)**PYR(0) + ELSEIF(MSTP(66).GE.4) THEN + PS=0.25D0*VINT(4)**2 + VINT(284)=(Q0S+PS)*(Q1S+PS)/ + & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS + ENDIF + ENDIF + IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) + +C...Format statements for differential cross-section maximum violations. + 5000 FORMAT(/1X,'Error: negative cross-section fraction',1P,D11.3,1X, + &'in event',1X,I7,'D0'/1X,'Execution stopped!') + 5100 FORMAT(1X,'ISUB = ',I3,'; Point of violation:'/1X,'tau =',1P, + &D11.3,', y* =',D11.3,', cthe = ',0P,F11.7,', tau'' =',1P,D11.3) + 5200 FORMAT(/1X,'Warning: negative cross-section fraction',1P,D11.3,1X, + &'in event',1X,I7) + 5300 FORMAT(/1X,'Error: maximum violated by',1P,D11.3,1X, + &'in event',1X,I7,'D0'/1X,'Execution stopped!') + 5400 FORMAT(/1X,'Advisory warning: maximum violated by',1P,D11.3,1X, + &'in event',1X,I7) + 5500 FORMAT(1X,'XSEC(',I1,',1) increased to',1P,D11.3) + 5600 FORMAT(1X,'XSEC(',I2,',1) increased to',1P,D11.3) + 5700 FORMAT(1X,'XSEC(',I3,',1) increased to',1P,D11.3) + 5800 FORMAT(1X,'XMAXUP(',I1,') increased to',1P,D11.3) + 5900 FORMAT(1X,'XMAXUP(',I2,') increased to',1P,D11.3) + 6000 FORMAT(1X,'XMAXUP(',I3,') increased to',1P,D11.3) + + RETURN + END + +C********************************************************************* + +C...PYSCAT +C...Finds outgoing flavours and event type; sets up the kinematics +C...and colour flow of the hard scattering + + SUBROUTINE PYSCAT + +C...Double precision and integer declarations + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement to help give large particle numbers. + PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, + &KEXCIT=4000000,KDIMEN=5000000) +C...Parameter statement for maximum size of showers. + PARAMETER (MAXNUR=1000) + +C...User process event common block. + INTEGER MAXNUP + PARAMETER (MAXNUP=500) + INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP + DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP + COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), + &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), + &VTIMUP(MAXNUP),SPINUP(MAXNUP) + SAVE /HEPEUP/ + +C...Commonblocks. + COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR) + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), + &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) + COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) + COMMON/PYPUED/IUED(0:99),RUED(0:99) + SAVE /PYPART/,/PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/, + &/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYSSMT/, + &/PYTCSM/,/PYPUED/ +C...Local arrays and saved variables + DIMENSION WDTP(0:400),WDTE(0:400,0:5),PMQ(2),Z(2),CTHE(2), + &PHI(2),KUPPO(100),VINTSV(41:66),ILAB(100) + INTEGER IOKFLA(6),IIFLAV +C...UED related declarations: +C...equivalences between ordered particles (451->475) +C...and UED particle code (5 000 000 + id) + DIMENSION IUEDEQ(475),MUED(2) + DATA (IUEDEQ(I),I=451,475)/ + & 6100001,6100002,6100003,6100004,6100005,6100006, + & 5100001,5100002,5100003,5100004,5100005,5100006, + & 6100011,6100013,6100015, + & 5100012,5100011,5100014,5100013,5100016,5100015, + & 5100021,5100022,5100023,5100024/ + SAVE VINTSV + +C...Read out process + ISUB=MINT(1) + ISUBSV=ISUB + +C...Restore information for low-pT processes + IF(ISUB.EQ.95.AND.MINT(57).GE.1) THEN + DO 100 J=41,66 + 100 VINT(J)=VINTSV(J) + ENDIF + +C...Convert H' or A process into equivalent H one + IHIGG=1 + KFHIGG=25 + IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND. + &ISUB.LE.190)) THEN + IHIGG=2 + IF(MOD(ISUB-1,10).GE.5) IHIGG=3 + KFHIGG=33+IHIGG + IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3 + IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102 + IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103 + IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24 + IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26 + IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123 + IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124 + IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121 + IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122 + IF(ISUB.EQ.183.OR.ISUB.EQ.188) ISUB=111 + IF(ISUB.EQ.184.OR.ISUB.EQ.189) ISUB=112 + IF(ISUB.EQ.185.OR.ISUB.EQ.190) ISUB=113 + ENDIF + + IF(ISUB.EQ.401.OR.ISUB.EQ.402) KFHIGG=KFPR(ISUB,1) + +C...Convert bottomonium process into equivalent charmonium ones. + IF(ISUB.GE.461.AND.ISUB.LE.479) ISUB=ISUB-40 + +C...Choice of subprocess, number of documentation lines + IDOC=6+ISET(ISUB) + IF(ISUB.EQ.95) IDOC=8 + IF(ISET(ISUB).EQ.5) IDOC=9 + IF(ISET(ISUB).EQ.11) IDOC=4+NUP + MINT(3)=IDOC-6 + IF(IDOC.GE.9.AND.ISET(ISUB).LE.4) IDOC=IDOC+2 + MINT(4)=IDOC + IPU1=MINT(84)+1 + IPU2=MINT(84)+2 + IPU3=MINT(84)+3 + IPU4=MINT(84)+4 + IPU5=MINT(84)+5 + IPU6=MINT(84)+6 + +C...Reset K, P and V vectors. Store incoming particles + DO 120 JT=1,MSTP(126)+100 + I=MINT(83)+JT + IF(I.GT.MSTU(4)) GOTO 120 + DO 110 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 110 CONTINUE + 120 CONTINUE + DO 140 JT=1,2 + I=MINT(83)+JT + K(I,1)=21 + K(I,2)=MINT(10+JT) + DO 130 J=1,5 + P(I,J)=VINT(285+5*JT+J) + 130 CONTINUE + 140 CONTINUE + MINT(6)=2 + KFRES=0 + +C...Store incoming partons in their CM-frame. Save pdf value. + SH=VINT(44) + SHR=SQRT(SH) + SHP=VINT(26)*VINT(2) + SHPR=SQRT(SHP) + SHUSER=SHR + IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) SHUSER=SHPR + DO 150 JT=1,2 + I=MINT(84)+JT + K(I,1)=14 + K(I,2)=MINT(14+JT) + K(I,3)=MINT(83)+2+JT + P(I,3)=0.5D0*SHUSER*(-1D0)**(JT-1) + P(I,4)=0.5D0*SHUSER + IF(MINT(14+JT).GE.-40.AND.MINT(14+JT).LE.40) THEN + VINT(38+JT)=XSFX(JT,MINT(14+JT)) + ELSE + VINT(38+JT)=1D0 + ENDIF + 150 CONTINUE + +C...Copy incoming partons to documentation lines + DO 170 JT=1,2 + I1=MINT(83)+4+JT + I2=MINT(84)+JT + K(I1,1)=21 + K(I1,2)=K(I2,2) + K(I1,3)=I1-2 + DO 160 J=1,5 + P(I1,J)=P(I2,J) + 160 CONTINUE + 170 CONTINUE + +C...Choose new quark/lepton flavour for relevant annihilation graphs + IF(ISUB.EQ.12.OR.ISUB.EQ.53.OR.ISUB.EQ.54.OR.ISUB.EQ.58.OR. + &ISUB.EQ.314.OR.ISUB.EQ.319.OR.ISUB.EQ.316.OR. + &(ISUB.GE.135.AND.ISUB.LE.140).OR.ISUB.EQ.382.OR.ISUB.EQ.385) THEN + IGLGA=21 + IF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) IGLGA=22 + CALL PYWIDT(IGLGA,SH,WDTP,WDTE) + 180 RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*PYR(0) + DO 190 I=1,MDCY(IGLGA,3) + KFLF=KFDP(I+MDCY(IGLGA,2)-1,1) + RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4)) + IF(RKFL.LE.0D0) GOTO 200 + 190 CONTINUE + 200 CONTINUE + IF((ISUB.EQ.53.OR.ISUB.EQ.385.OR.ISUB.EQ.314.OR.ISUB.EQ.319 + & .OR.ISUB.EQ.316).AND.MINT(2).LE.2) THEN + IF(KFLF.GE.4) GOTO 180 + ELSEIF((ISUB.EQ.53.OR.ISUB.EQ.385.OR.ISUB.EQ.314.OR.ISUB.EQ.319. + & OR.ISUB.EQ.316).AND.MINT(2).LE.4) THEN + KFLF=4 + MINT(2)=MINT(2)-2 + ELSEIF(ISUB.EQ.53.OR.ISUB.EQ.385.OR.ISUB.EQ.314.OR.ISUB.EQ.319. + & OR.ISUB.EQ.316) THEN + KFLF=5 + MINT(2)=MINT(2)-4 + ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.1.AND.IABS(MINT(15)).LE.2 + & .AND.IABS(KFLF).GE.3) THEN + FACQQB=VINT(58)**2*4D0/9D0*(VINT(45)**2+VINT(46)**2)/ + & VINT(44)**2 + FACCIB=VINT(46)**2/RTCM(41)**4 + IF(FACQQB/(FACQQB+FACCIB).LT.PYR(0)) GOTO 180 + ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.2) THEN + KFLF=5 + MINT(2)=1 + ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.1) THEN + IF(KFLF.EQ.5) GOTO 180 + ELSEIF(ISUB.EQ.54.OR.ISUB.EQ.135.OR.ISUB.EQ.136) THEN + IF((KCHG(PYCOMP(KFLF),1)/2D0)**2.LT.PYR(0)) GOTO 180 + ELSEIF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) THEN + IF((KCHG(PYCOMP(KFLF),1)/3D0)**2.LT.PYR(0)) GOTO 180 + ENDIF + ENDIF + +C...Final state flavours and colour flow: default values + JS=1 + MINT(21)=MINT(15) + MINT(22)=MINT(16) + MINT(23)=0 + MINT(24)=0 + KCC=20 + KCS=ISIGN(1,MINT(15)) + + IF(ISET(ISUB).EQ.11) THEN +C...User-defined processes: find products + MINT(3)=0 + DO 210 IUP=3,NUP + IF(ISTUP(IUP).LT.1.OR.ISTUP(IUP).GT.3) THEN + ELSEIF(NUP.EQ.5.AND.IUP.GE.4.AND.MOTHUP(1,4).EQ.3) THEN + MINT(21+IUP)=IDUP(IUP) + ELSEIF(ISTUP(IUP).EQ.1.AND.(ISTUP(MOTHUP(1,IUP)).EQ.2.OR. + & ISTUP(MOTHUP(1,IUP)).EQ.3).AND.IDUP(MOTHUP(1,IUP)).NE.0) THEN + ELSEIF(IDUP(IUP).EQ.0) THEN + ELSE + MINT(3)=MINT(3)+1 + IF(MINT(3).LE.6) MINT(20+MINT(3))=IDUP(IUP) + ENDIF + 210 CONTINUE + + ELSEIF(ISUB.LE.10) THEN + IF(ISUB.EQ.1) THEN +C...f + fbar -> gamma*/Z0 + KFRES=23 + + ELSEIF(ISUB.EQ.2) THEN +C...f + fbar' -> W+/- + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + KFRES=ISIGN(24,KCH1+KCH2) + + ELSEIF(ISUB.EQ.3) THEN +C...f + fbar -> h0 (or H0, or A0) + KFRES=KFHIGG + + ELSEIF(ISUB.EQ.4) THEN +C...gamma + W+/- -> W+/- + + ELSEIF(ISUB.EQ.5) THEN +C...Z0 + Z0 -> h0 + XH=SH/SHP + MINT(21)=MINT(15) + MINT(22)=MINT(16) + PMQ(1)=PYMASS(MINT(21)) + PMQ(2)=PYMASS(MINT(22)) + 220 JT=INT(1.5D0+PYR(0)) + ZMIN=2D0*PMQ(JT)/SHPR + ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ + & (SHPR*(SHPR-PMQ(3-JT))) + ZMAX=MIN(1D0-XH,ZMAX) + Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) + IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. + & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 220 + SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 220 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) + CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) + Z(3-JT)=1D0-XH/(1D0-Z(JT)) + SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 220 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) + CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) + PHIR=PARU(2)*PYR(0) + CPHI=COS(PHIR) + ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* + & SQRT(1D0-CTHE(2)**2)*CPHI + Z1=2D0-Z(JT) + Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) + Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP + Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* + & PMQ(3-JT)**2/SHP)) + ZMIN=2D0*PMQ(3-JT)/SHPR + ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) + ZMAX=MIN(1D0-XH,ZMAX) + IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 220 + KCC=22 + KFRES=25 + + ELSEIF(ISUB.EQ.6) THEN +C...Z0 + W+/- -> W+/- + + ELSEIF(ISUB.EQ.7) THEN +C...W+ + W- -> Z0 + + ELSEIF(ISUB.EQ.8) THEN +C...W+ + W- -> h0 + XH=SH/SHP + 230 DO 260 JT=1,2 + I=MINT(14+JT) + IA=IABS(I) + IF(IA.LE.10) THEN + RVCKM=VINT(180+I)*PYR(0) + DO 240 J=1,MSTP(1) + IB=2*J-1+MOD(IA,2) + IPM=(5-ISIGN(1,I))/2 + IDC=J+MDCY(IA,2)+2 + IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 240 + MINT(20+JT)=ISIGN(IB,I) + RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) + IF(RVCKM.LE.0D0) GOTO 250 + 240 CONTINUE + ELSE + IB=2*((IA+1)/2)-1+MOD(IA,2) + MINT(20+JT)=ISIGN(IB,I) + ENDIF + 250 PMQ(JT)=PYMASS(MINT(20+JT)) + 260 CONTINUE + JT=INT(1.5D0+PYR(0)) + ZMIN=2D0*PMQ(JT)/SHPR + ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ + & (SHPR*(SHPR-PMQ(3-JT))) + ZMAX=MIN(1D0-XH,ZMAX) + IF(ZMIN.GE.ZMAX) GOTO 230 + Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) + IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. + & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 230 + SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 230 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) + CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) + Z(3-JT)=1D0-XH/(1D0-Z(JT)) + SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 230 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) + CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) + PHIR=PARU(2)*PYR(0) + CPHI=COS(PHIR) + ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* + & SQRT(1D0-CTHE(2)**2)*CPHI + Z1=2D0-Z(JT) + Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) + Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP + Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* + & PMQ(3-JT)**2/SHP)) + ZMIN=2D0*PMQ(3-JT)/SHPR + ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) + ZMAX=MIN(1D0-XH,ZMAX) + IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 230 + KCC=22 + KFRES=25 + + ELSEIF(ISUB.EQ.10) THEN +C...f + f' -> f + f' (gamma/Z/W exchange); th = (p(f)-p(f))**2 + IF(MINT(2).EQ.1) THEN + KCC=22 + ELSE +C...W exchange: need to mix flavours according to CKM matrix + DO 280 JT=1,2 + I=MINT(14+JT) + IA=IABS(I) + IF(IA.LE.10) THEN + RVCKM=VINT(180+I)*PYR(0) + DO 270 J=1,MSTP(1) + IB=2*J-1+MOD(IA,2) + IPM=(5-ISIGN(1,I))/2 + IDC=J+MDCY(IA,2)+2 + IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270 + MINT(20+JT)=ISIGN(IB,I) + RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) + IF(RVCKM.LE.0D0) GOTO 280 + 270 CONTINUE + ELSE + IB=2*((IA+1)/2)-1+MOD(IA,2) + MINT(20+JT)=ISIGN(IB,I) + ENDIF + 280 CONTINUE + KCC=22 + ENDIF + ENDIF + + ELSEIF(ISUB.LE.20) THEN + IF(ISUB.EQ.11) THEN +C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2 + KCC=MINT(2) + IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 + + ELSEIF(ISUB.EQ.12) THEN +C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2 + MINT(21)=ISIGN(KFLF,MINT(15)) + MINT(22)=-MINT(21) + KCC=4 + + ELSEIF(ISUB.EQ.13) THEN +C...f + fbar -> g + g; th arbitrary + MINT(21)=21 + MINT(22)=21 + KCC=MINT(2)+4 + + ELSEIF(ISUB.EQ.14) THEN +C...f + fbar -> g + gamma; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=21 + MINT(23-JS)=22 + KCC=17+JS + + ELSEIF(ISUB.EQ.15) THEN +C...f + fbar -> g + Z0; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=21 + MINT(23-JS)=23 + KCC=17+JS + + ELSEIF(ISUB.EQ.16) THEN +C...f + fbar' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 + MINT(20+JS)=21 + MINT(23-JS)=ISIGN(24,KCH1+KCH2) + KCC=17+JS + + ELSEIF(ISUB.EQ.17) THEN +C...f + fbar -> g + h0; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=21 + MINT(23-JS)=25 + KCC=17+JS + + ELSEIF(ISUB.EQ.18) THEN +C...f + fbar -> gamma + gamma; th arbitrary + MINT(21)=22 + MINT(22)=22 + + ELSEIF(ISUB.EQ.19) THEN +C...f + fbar -> gamma + Z0; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=22 + MINT(23-JS)=23 + + ELSEIF(ISUB.EQ.20) THEN +C...f + fbar' -> gamma + W+/-; th = (p(f)-p(W-))**2 or +C...(p(fbar')-p(W+))**2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 + MINT(20+JS)=22 + MINT(23-JS)=ISIGN(24,KCH1+KCH2) + ENDIF + + ELSEIF(ISUB.LE.30) THEN + IF(ISUB.EQ.21) THEN +C...f + fbar -> gamma + h0; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=22 + MINT(23-JS)=25 + + ELSEIF(ISUB.EQ.22) THEN +C...f + fbar -> Z0 + Z0; th arbitrary + MINT(21)=23 + MINT(22)=23 + + ELSEIF(ISUB.EQ.23) THEN +C...f + fbar' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 + MINT(20+JS)=23 + MINT(23-JS)=ISIGN(24,KCH1+KCH2) + + ELSEIF(ISUB.EQ.24) THEN +C...f + fbar -> Z0 + h0 (or H0, or A0); th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=23 + MINT(23-JS)=KFHIGG + + ELSEIF(ISUB.EQ.25) THEN +C...f + fbar -> W+ + W-; th = (p(f)-p(W-))**2 + MINT(21)=-ISIGN(24,MINT(15)) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.26) THEN +C...f + fbar' -> W+/- + h0 (or H0, or A0); +C...th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 + MINT(20+JS)=ISIGN(24,KCH1+KCH2) + MINT(23-JS)=KFHIGG + + ELSEIF(ISUB.EQ.27) THEN +C...f + fbar -> h0 + h0 + + ELSEIF(ISUB.EQ.28) THEN +C...f + g -> f + g; th = (p(f)-p(f))**2 + IF(MINT(15).EQ.21) JS=2 + KCC=MINT(2)+6 + IF(MINT(15).EQ.21) KCC=KCC+2 + IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) + IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) + + ELSEIF(ISUB.EQ.29) THEN +C...f + g -> f + gamma; th = (p(f)-p(f))**2 + IF(MINT(15).EQ.21) JS=2 + MINT(23-JS)=22 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.30) THEN +C...f + g -> f + Z0; th = (p(f)-p(f))**2 + IF(MINT(15).EQ.21) JS=2 + MINT(23-JS)=23 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + ENDIF + + ELSEIF(ISUB.LE.40) THEN + IF(ISUB.EQ.31) THEN +C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f' + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I) + RVCKM=VINT(180+I)*PYR(0) + DO 290 J=1,MSTP(1) + IB=2*J-1+MOD(IA,2) + IPM=(5-ISIGN(1,I))/2 + IDC=J+MDCY(IA,2)+2 + IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 290 + MINT(20+JS)=ISIGN(IB,I) + RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) + IF(RVCKM.LE.0D0) GOTO 300 + 290 CONTINUE + 300 KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.32) THEN +C...f + g -> f + h0; th = (p(f)-p(f))**2 + IF(MINT(15).EQ.21) JS=2 + MINT(23-JS)=25 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.33) THEN +C...f + gamma -> f + g; th=(p(f)-p(f))**2 + IF(MINT(15).EQ.22) JS=2 + MINT(23-JS)=21 + KCC=24+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.34) THEN +C...f + gamma -> f + gamma; th=(p(f)-p(f))**2 + IF(MINT(15).EQ.22) JS=2 + KCC=22 + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.35) THEN +C...f + gamma -> f + Z0; th=(p(f)-p(f))**2 + IF(MINT(15).EQ.22) JS=2 + MINT(23-JS)=23 + KCC=22 + + ELSEIF(ISUB.EQ.36) THEN +C...f + gamma -> f' + W+/-; th=(p(f)-p(f'))**2 + IF(MINT(15).EQ.22) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I) + IF(IA.LE.10) THEN + RVCKM=VINT(180+I)*PYR(0) + DO 310 J=1,MSTP(1) + IB=2*J-1+MOD(IA,2) + IPM=(5-ISIGN(1,I))/2 + IDC=J+MDCY(IA,2)+2 + IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 310 + MINT(20+JS)=ISIGN(IB,I) + RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) + IF(RVCKM.LE.0D0) GOTO 320 + 310 CONTINUE + ELSE + IB=2*((IA+1)/2)-1+MOD(IA,2) + MINT(20+JS)=ISIGN(IB,I) + ENDIF + 320 KCC=22 + + ELSEIF(ISUB.EQ.37) THEN +C...f + gamma -> f + h0 + + ELSEIF(ISUB.EQ.38) THEN +C...f + Z0 -> f + g + + ELSEIF(ISUB.EQ.39) THEN +C...f + Z0 -> f + gamma + + ELSEIF(ISUB.EQ.40) THEN +C...f + Z0 -> f + Z0 + ENDIF + + ELSEIF(ISUB.LE.50) THEN + IF(ISUB.EQ.41) THEN +C...f + Z0 -> f' + W+/- + + ELSEIF(ISUB.EQ.42) THEN +C...f + Z0 -> f + h0 + + ELSEIF(ISUB.EQ.43) THEN +C...f + W+/- -> f' + g + + ELSEIF(ISUB.EQ.44) THEN +C...f + W+/- -> f' + gamma + + ELSEIF(ISUB.EQ.45) THEN +C...f + W+/- -> f' + Z0 + + ELSEIF(ISUB.EQ.46) THEN +C...f + W+/- -> f' + W+/- + + ELSEIF(ISUB.EQ.47) THEN +C...f + W+/- -> f' + h0 + + ELSEIF(ISUB.EQ.48) THEN +C...f + h0 -> f + g + + ELSEIF(ISUB.EQ.49) THEN +C...f + h0 -> f + gamma + + ELSEIF(ISUB.EQ.50) THEN +C...f + h0 -> f + Z0 + ENDIF + + ELSEIF(ISUB.LE.60) THEN + IF(ISUB.EQ.51) THEN +C...f + h0 -> f' + W+/- + + ELSEIF(ISUB.EQ.52) THEN +C...f + h0 -> f + h0 + + ELSEIF(ISUB.EQ.53) THEN +C...g + g -> f + fbar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFLF,KCS) + MINT(22)=-MINT(21) + KCC=MINT(2)+10 + + ELSEIF(ISUB.EQ.54) THEN +C...g + gamma -> f + fbar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFLF,KCS) + MINT(22)=-MINT(21) + KCC=27 + IF(MINT(16).EQ.21) KCC=28 + + ELSEIF(ISUB.EQ.55) THEN +C...g + Z0 -> f + fbar + + ELSEIF(ISUB.EQ.56) THEN +C...g + W+/- -> f + fbar' + + ELSEIF(ISUB.EQ.57) THEN +C...g + h0 -> f + fbar + + ELSEIF(ISUB.EQ.58) THEN +C...gamma + gamma -> f + fbar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFLF,KCS) + MINT(22)=-MINT(21) + KCC=21 + + ELSEIF(ISUB.EQ.59) THEN +C...gamma + Z0 -> f + fbar + + ELSEIF(ISUB.EQ.60) THEN +C...gamma + W+/- -> f + fbar' + ENDIF + + ELSEIF(ISUB.LE.70) THEN + IF(ISUB.EQ.61) THEN +C...gamma + h0 -> f + fbar + + ELSEIF(ISUB.EQ.62) THEN +C...Z0 + Z0 -> f + fbar + + ELSEIF(ISUB.EQ.63) THEN +C...Z0 + W+/- -> f + fbar' + + ELSEIF(ISUB.EQ.64) THEN +C...Z0 + h0 -> f + fbar + + ELSEIF(ISUB.EQ.65) THEN +C...W+ + W- -> f + fbar + + ELSEIF(ISUB.EQ.66) THEN +C...W+/- + h0 -> f + fbar' + + ELSEIF(ISUB.EQ.67) THEN +C...h0 + h0 -> f + fbar + + ELSEIF(ISUB.EQ.68) THEN +C...g + g -> g + g; th arbitrary + KCC=MINT(2)+12 + KCS=(-1)**INT(1.5D0+PYR(0)) + + ELSEIF(ISUB.EQ.69) THEN +C...gamma + gamma -> W+ + W-; th arbitrary + MINT(21)=24 + MINT(22)=-24 + KCC=21 + + ELSEIF(ISUB.EQ.70) THEN +C...gamma + W+/- -> Z0 + W+/-; th=(p(W)-p(W))**2 + IF(MINT(15).EQ.22) MINT(21)=23 + IF(MINT(16).EQ.22) MINT(22)=23 + KCC=21 + ENDIF + + ELSEIF(ISUB.LE.80) THEN + IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN +C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W- + XH=SH/SHP + MINT(21)=MINT(15) + MINT(22)=MINT(16) + PMQ(1)=PYMASS(MINT(21)) + PMQ(2)=PYMASS(MINT(22)) + 330 JT=INT(1.5D0+PYR(0)) + ZMIN=2D0*PMQ(JT)/SHPR + ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ + & (SHPR*(SHPR-PMQ(3-JT))) + ZMAX=MIN(1D0-XH,ZMAX) + Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) + IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. + & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 330 + SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 330 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) + CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) + Z(3-JT)=1D0-XH/(1D0-Z(JT)) + SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 330 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) + CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) + PHIR=PARU(2)*PYR(0) + CPHI=COS(PHIR) + ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* + & SQRT(1D0-CTHE(2)**2)*CPHI + Z1=2D0-Z(JT) + Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) + Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP + Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* + & PMQ(3-JT)**2/SHP)) + ZMIN=2D0*PMQ(3-JT)/SHPR + ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) + ZMAX=MIN(1D0-XH,ZMAX) + IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 330 + KCC=22 + + ELSEIF(ISUB.EQ.73) THEN +C...Z0 + W+/- -> Z0 + W+/- + JS=MINT(2) + XH=SH/SHP + 340 JT=3-MINT(2) + I=MINT(14+JT) + IA=IABS(I) + IF(IA.LE.10) THEN + RVCKM=VINT(180+I)*PYR(0) + DO 350 J=1,MSTP(1) + IB=2*J-1+MOD(IA,2) + IPM=(5-ISIGN(1,I))/2 + IDC=J+MDCY(IA,2)+2 + IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 350 + MINT(20+JT)=ISIGN(IB,I) + RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) + IF(RVCKM.LE.0D0) GOTO 360 + 350 CONTINUE + ELSE + IB=2*((IA+1)/2)-1+MOD(IA,2) + MINT(20+JT)=ISIGN(IB,I) + ENDIF + 360 PMQ(JT)=PYMASS(MINT(20+JT)) + MINT(23-JT)=MINT(17-JT) + PMQ(3-JT)=PYMASS(MINT(23-JT)) + JT=INT(1.5D0+PYR(0)) + ZMIN=2D0*PMQ(JT)/SHPR + ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ + & (SHPR*(SHPR-PMQ(3-JT))) + ZMAX=MIN(1D0-XH,ZMAX) + IF(ZMIN.GE.ZMAX) GOTO 340 + Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) + IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. + & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 340 + SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 340 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) + CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) + Z(3-JT)=1D0-XH/(1D0-Z(JT)) + SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 340 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) + CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) + PHIR=PARU(2)*PYR(0) + CPHI=COS(PHIR) + ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* + & SQRT(1D0-CTHE(2)**2)*CPHI + Z1=2D0-Z(JT) + Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) + Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP + Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* + & PMQ(3-JT)**2/SHP)) + ZMIN=2D0*PMQ(3-JT)/SHPR + ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) + ZMAX=MIN(1D0-XH,ZMAX) + IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340 + KCC=22 + + ELSEIF(ISUB.EQ.74) THEN +C...Z0 + h0 -> Z0 + h0 + + ELSEIF(ISUB.EQ.75) THEN +C...W+ + W- -> gamma + gamma + + ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN +C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W- + XH=SH/SHP + 370 DO 400 JT=1,2 + I=MINT(14+JT) + IA=IABS(I) + IF(IA.LE.10) THEN + RVCKM=VINT(180+I)*PYR(0) + DO 380 J=1,MSTP(1) + IB=2*J-1+MOD(IA,2) + IPM=(5-ISIGN(1,I))/2 + IDC=J+MDCY(IA,2)+2 + IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 380 + MINT(20+JT)=ISIGN(IB,I) + RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) + IF(RVCKM.LE.0D0) GOTO 390 + 380 CONTINUE + ELSE + IB=2*((IA+1)/2)-1+MOD(IA,2) + MINT(20+JT)=ISIGN(IB,I) + ENDIF + 390 PMQ(JT)=PYMASS(MINT(20+JT)) + 400 CONTINUE + JT=INT(1.5D0+PYR(0)) + ZMIN=2D0*PMQ(JT)/SHPR + ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ + & (SHPR*(SHPR-PMQ(3-JT))) + ZMAX=MIN(1D0-XH,ZMAX) + IF(ZMIN.GE.ZMAX) GOTO 370 + Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) + IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. + & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 370 + SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 370 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) + CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) + Z(3-JT)=1D0-XH/(1D0-Z(JT)) + SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) + IF(SQC1.LT.1D-8) GOTO 370 + C1=SQRT(SQC1) + C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) + CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 + CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) + PHIR=PARU(2)*PYR(0) + CPHI=COS(PHIR) + ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* + & SQRT(1D0-CTHE(2)**2)*CPHI + Z1=2D0-Z(JT) + Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) + Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP + Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* + & PMQ(3-JT)**2/SHP)) + ZMIN=2D0*PMQ(3-JT)/SHPR + ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) + ZMAX=MIN(1D0-XH,ZMAX) + IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 370 + KCC=22 + + ELSEIF(ISUB.EQ.78) THEN +C...W+/- + h0 -> W+/- + h0 + + ELSEIF(ISUB.EQ.79) THEN +C...h0 + h0 -> h0 + h0 + + ELSEIF(ISUB.EQ.80) THEN +C...q + gamma -> q' + pi+/-; th=(p(q)-p(q'))**2 + IF(MINT(15).EQ.22) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(23-JS)=ISIGN(211,KCHG(IA,1)*I) + IB=3-IA + MINT(20+JS)=ISIGN(IB,I) + KCC=22 + ENDIF + + ELSEIF(ISUB.LE.90) THEN + IF(ISUB.EQ.81) THEN +C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2 + MINT(21)=ISIGN(MINT(55),MINT(15)) + MINT(22)=-MINT(21) + KCC=4 + + ELSEIF(ISUB.EQ.82) THEN +C...g + g -> Q + Qbar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(MINT(55),KCS) + MINT(22)=-MINT(21) + KCC=MINT(2)+10 + + ELSEIF(ISUB.EQ.83) THEN +C...f + q -> f' + Q; th = (p(f) - p(f'))**2 + KFOLD=MINT(16) + IF(MINT(2).EQ.2) KFOLD=MINT(15) + KFAOLD=IABS(KFOLD) + IF(KFAOLD.GT.10) THEN + KFANEW=KFAOLD+2*MOD(KFAOLD,2)-1 + ELSE + RCKM=VINT(180+KFOLD)*PYR(0) + IPM=(5-ISIGN(1,KFOLD))/2 + KFANEW=-MOD(KFAOLD+1,2) + 410 KFANEW=KFANEW+2 + IDC=MDCY(KFAOLD,2)+(KFANEW+1)/2+2 + IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) THEN + IF(MOD(KFAOLD,2).EQ.0) RCKM=RCKM- + & VCKM(KFAOLD/2,(KFANEW+1)/2) + IF(MOD(KFAOLD,2).EQ.1) RCKM=RCKM- + & VCKM(KFANEW/2,(KFAOLD+1)/2) + ENDIF + IF(KFANEW.LE.6.AND.RCKM.GT.0D0) GOTO 410 + ENDIF + IF(MINT(2).EQ.1) THEN + MINT(21)=ISIGN(MINT(55),MINT(15)) + MINT(22)=ISIGN(KFANEW,MINT(16)) + ELSE + MINT(21)=ISIGN(KFANEW,MINT(15)) + MINT(22)=ISIGN(MINT(55),MINT(16)) + JS=2 + ENDIF + KCC=22 + + ELSEIF(ISUB.EQ.84) THEN +C...g + gamma -> Q + Qbar; th arbitary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(MINT(55),KCS) + MINT(22)=-MINT(21) + KCC=27 + IF(MINT(16).EQ.21) KCC=28 + + ELSEIF(ISUB.EQ.85) THEN +C...gamma + gamma -> F + Fbar; th arbitary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(MINT(56),KCS) + MINT(22)=-MINT(21) + KCC=21 + + ELSEIF(ISUB.GE.86.AND.ISUB.LE.89) THEN +C...g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g + MINT(21)=KFPR(ISUB,1) + MINT(22)=KFPR(ISUB,2) + KCC=24 + KCS=(-1)**INT(1.5D0+PYR(0)) + ENDIF + + ELSEIF(ISUB.LE.100) THEN + IF(ISUB.EQ.95) THEN +C...Low-pT ( = energyless g + g -> g + g) + KCC=MINT(2)+12 + KCS=(-1)**INT(1.5D0+PYR(0)) + + ELSEIF(ISUB.EQ.96) THEN +C...Multiple interactions (should be reassigned to QCD process) + ENDIF + + ELSEIF(ISUB.LE.110) THEN + IF(ISUB.EQ.101) THEN +C...g + g -> gamma*/Z0 + KCC=21 + KFRES=22 + + ELSEIF(ISUB.EQ.102) THEN +C...g + g -> h0 (or H0, or A0) + KCC=21 + KFRES=KFHIGG + + ELSEIF(ISUB.EQ.103) THEN +C...gamma + gamma -> h0 (or H0, or A0) + KCC=21 + KFRES=KFHIGG + + ELSEIF(ISUB.EQ.104.OR.ISUB.EQ.105) THEN +C...g + g -> chi_0c or chi_2c. + KCC=21 + KFRES=KFPR(ISUB,1) + + ELSEIF(ISUB.EQ.106) THEN +C...g + g -> J/Psi + gamma + MINT(21)=KFPR(ISUB,1) + MINT(22)=KFPR(ISUB,2) + KCC=21 + + ELSEIF(ISUB.EQ.107) THEN +C...g + gamma -> J/Psi + g + MINT(21)=KFPR(ISUB,1) + MINT(22)=KFPR(ISUB,2) + KCC=22 + IF(MINT(16).EQ.22) KCC=33 + + ELSEIF(ISUB.EQ.108) THEN +C...gamma + gamma -> J/Psi + gamma + MINT(21)=KFPR(ISUB,1) + MINT(22)=KFPR(ISUB,2) + + ELSEIF(ISUB.EQ.110) THEN +C...f + fbar -> gamma + h0; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=22 + MINT(23-JS)=KFHIGG + ENDIF + + ELSEIF(ISUB.LE.120) THEN + IF(ISUB.EQ.111) THEN +C...f + fbar -> g + h0; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=21 + MINT(23-JS)=KFHIGG + KCC=17+JS + + ELSEIF(ISUB.EQ.112) THEN +C...f + g -> f + h0; th = (p(f) - p(f))**2 + IF(MINT(15).EQ.21) JS=2 + MINT(23-JS)=KFHIGG + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.113) THEN +C...g + g -> g + h0; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(23-JS)=KFHIGG + KCC=22+JS + KCS=(-1)**INT(1.5D0+PYR(0)) + + ELSEIF(ISUB.EQ.114) THEN +C...g + g -> gamma + gamma; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(21)=22 + MINT(22)=22 + KCC=21 + + ELSEIF(ISUB.EQ.115) THEN +C...g + g -> g + gamma; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(23-JS)=22 + KCC=22+JS + KCS=(-1)**INT(1.5D0+PYR(0)) + + ELSEIF(ISUB.EQ.116) THEN +C...g + g -> gamma + Z0 + + ELSEIF(ISUB.EQ.117) THEN +C...g + g -> Z0 + Z0 + + ELSEIF(ISUB.EQ.118) THEN +C...g + g -> W+ + W- + ENDIF + + ELSEIF(ISUB.LE.140) THEN + IF(ISUB.EQ.121) THEN +C...g + g -> Q + Qbar + h0 + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS) + MINT(22)=-MINT(21) + KCC=11+INT(0.5D0+PYR(0)) + KFRES=KFHIGG + + ELSEIF(ISUB.EQ.122) THEN +C...q + qbar -> Q + Qbar + h0 + MINT(21)=ISIGN(KFPR(ISUBSV,2),MINT(15)) + MINT(22)=-MINT(21) + KCC=4 + KFRES=KFHIGG + + ELSEIF(ISUB.EQ.123) THEN +C...f + f' -> f + f' + h0 (or H0, or A0) (Z0 + Z0 -> h0 as +C...inner process) + KCC=22 + KFRES=KFHIGG + + ELSEIF(ISUB.EQ.124) THEN +C...f + f' -> f" + f"' + h0 (or H0, or A) (W+ + W- -> h0 as +C...inner process) + DO 430 JT=1,2 + I=MINT(14+JT) + IA=IABS(I) + IF(IA.LE.10) THEN + RVCKM=VINT(180+I)*PYR(0) + DO 420 J=1,MSTP(1) + IB=2*J-1+MOD(IA,2) + IPM=(5-ISIGN(1,I))/2 + IDC=J+MDCY(IA,2)+2 + IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 420 + MINT(20+JT)=ISIGN(IB,I) + RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) + IF(RVCKM.LE.0D0) GOTO 430 + 420 CONTINUE + ELSE + IB=2*((IA+1)/2)-1+MOD(IA,2) + MINT(20+JT)=ISIGN(IB,I) + ENDIF + 430 CONTINUE + KCC=22 + KFRES=KFHIGG + + ELSEIF(ISUB.EQ.131.OR.ISUB.EQ.132) THEN +C...f + gamma*_(T,L) -> f + g; th=(p(f)-p(f))**2 + IF(MINT(15).EQ.22) JS=2 + MINT(23-JS)=21 + KCC=24+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.133.OR.ISUB.EQ.134) THEN +C...f + gamma*_(T,L) -> f + gamma; th=(p(f)-p(f))**2 + IF(MINT(15).EQ.22) JS=2 + KCC=22 + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.135.OR.ISUB.EQ.136) THEN +C...g + gamma*_(T,L) -> f + fbar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFLF,KCS) + MINT(22)=-MINT(21) + KCC=27 + IF(MINT(16).EQ.21) KCC=28 + + ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN +C...gamma*_(T,L) + gamma*_(T,L) -> f + fbar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFLF,KCS) + MINT(22)=-MINT(21) + KCC=21 + + ENDIF + + ELSEIF(ISUB.LE.160) THEN + IF(ISUB.EQ.141) THEN +C...f + fbar -> gamma*/Z0/Z'0 + KFRES=32 + + ELSEIF(ISUB.EQ.142) THEN +C...f + fbar' -> W'+/- + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + KFRES=ISIGN(34,KCH1+KCH2) + + ELSEIF(ISUB.EQ.143) THEN +C...f + fbar' -> H+/- + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + KFRES=ISIGN(37,KCH1+KCH2) + + ELSEIF(ISUB.EQ.144) THEN +C...f + fbar' -> R + KFRES=ISIGN(41,MINT(15)+MINT(16)) + + ELSEIF(ISUB.EQ.145) THEN +C...q + l -> LQ (leptoquark) + IF(IABS(MINT(16)).LE.8) JS=2 + KFRES=ISIGN(42,MINT(14+JS)) + KCC=28+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.146) THEN +C...e + gamma -> e* (excited lepton) + IF(MINT(15).EQ.22) JS=2 + KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS)) + KCC=22 + + ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN +C...q + g -> q* (excited quark) + IF(MINT(15).EQ.21) JS=2 + KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS)) + KCC=30+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.149) THEN +C...g + g -> eta_tc + KFRES=KTECHN+331 + KCC=23 + KCS=(-1)**INT(1.5D0+PYR(0)) + ENDIF + + ELSEIF(ISUB.LE.200) THEN + IF(ISUB.EQ.161) THEN +C...f + g -> f' + H+/-; th = (p(f)-p(f'))**2 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(23-JS)=ISIGN(37,KCHG(IA,1)*I) + IB=IA+MOD(IA,2)-MOD(IA+1,2) + MINT(20+JS)=ISIGN(IB,I) + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.162) THEN +C...q + g -> LQ + lbar; LQ=leptoquark; th=(p(q)-p(LQ))^2 + IF(MINT(15).EQ.21) JS=2 + MINT(20+JS)=ISIGN(42,MINT(14+JS)) + KFLQL=KFDP(MDCY(42,2),2) + MINT(23-JS)=-ISIGN(KFLQL,MINT(14+JS)) + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.163) THEN +C...g + g -> LQ + LQbar; LQ=leptoquark; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(42,KCS) + MINT(22)=-MINT(21) + KCC=MINT(2)+10 + + ELSEIF(ISUB.EQ.164) THEN +C...q + qbar -> LQ + LQbar; LQ=leptoquark; th=(p(q)-p(LQ))**2 + MINT(21)=ISIGN(42,MINT(15)) + MINT(22)=-MINT(21) + KCC=4 + + ELSEIF(ISUB.EQ.165) THEN +C...q + qbar -> l- + l+; th=(p(q)-p(l-))**2 + MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.166) THEN +C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2 + IF(MOD(MINT(15),2).EQ.0) THEN + MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15)) + MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16)) + ELSE + MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) + MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16)) + ENDIF + + ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN +C...q + q' -> q" + q* (excited quark) + KFQSTR=KFPR(ISUB,2) + KFQEXC=MOD(KFQSTR,KEXCIT) + JS=MINT(2) + MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS)) + IF(IABS(MINT(15)).NE.KFQEXC.AND.IABS(MINT(16)).NE.KFQEXC) + & MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS)) + KCC=22 + JS=3-JS + + ELSEIF(ISUB.EQ.169) THEN +C...q + qbar -> e + e* (excited lepton) + KFQSTR=KFPR(ISUB,2) + KFQEXC=MOD(KFQSTR,KEXCIT) + JS=MINT(2) + MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS)) + MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS)) + JS=3-JS + + ELSEIF(ISUB.EQ.191) THEN +C...f + fbar -> rho_tc0. + KFRES=KTECHN+113 + + ELSEIF(ISUB.EQ.192) THEN +C...f + fbar' -> rho_tc+/- + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + KFRES=ISIGN(KTECHN+213,KCH1+KCH2) + + ELSEIF(ISUB.EQ.193) THEN +C...f + fbar -> omega_tc0. + KFRES=KTECHN+223 + + ELSEIF(ISUB.EQ.194) THEN +C...f + fbar -> f' + fbar' via mixture of s-channel +C...rho_tc and omega_tc; th=(p(f)-p(f'))**2 + MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.195) THEN +C...f + fbar' -> f'' + fbar''' via s-channel +C...rho_tc+ th=(p(f)-p(f'))**2 +C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2 + IF(MOD(MINT(15),2).EQ.0) THEN + MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15)) + MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16)) + ELSE + MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) + MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16)) + ENDIF + ENDIF + +CMRENNA++ + ELSEIF(ISUB.LE.215) THEN + IF(ISUB.EQ.201) THEN +C...f + fbar -> ~e_L + ~e_Lbar + MINT(21)=ISIGN(KSUSY1+11,KCS) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.202) THEN +C...f + fbar -> ~e_R + ~e_Rbar + MINT(21)=ISIGN(KSUSY2+11,KCS) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.203) THEN +C...f + fbar -> ~e_L + ~e_Rbar + IF(MINT(15).LT.0) JS=2 + IF(MINT(2).EQ.1) THEN + MINT(20+JS)=KFPR(ISUB,1) + MINT(23-JS)=-KFPR(ISUB,2) + ELSE + MINT(20+JS)=-KFPR(ISUB,1) + MINT(23-JS)=KFPR(ISUB,2) + ENDIF + + ELSEIF(ISUB.EQ.204) THEN +C...f + fbar -> ~mu_L + ~mu_Lbar + MINT(21)=ISIGN(KSUSY1+13,KCS) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.205) THEN +C...f + fbar -> ~mu_R + ~mu_Rbar + MINT(21)=ISIGN(KSUSY2+13,KCS) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.206) THEN +C...f + fbar -> ~mu_L + ~mu_Rbar + IF(MINT(15).LT.0) JS=2 + IF(MINT(2).EQ.1) THEN + MINT(20+JS)=KFPR(ISUB,1) + MINT(23-JS)=-KFPR(ISUB,2) + ELSE + MINT(20+JS)=-KFPR(ISUB,1) + MINT(23-JS)=KFPR(ISUB,2) + ENDIF + + ELSEIF(ISUB.EQ.207) THEN +C...f + fbar -> ~tau_1 + ~tau_1bar + MINT(21)=ISIGN(KSUSY1+15,KCS) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.208) THEN +C...f + fbar -> ~tau_2 + ~tau_2bar + MINT(21)=ISIGN(KSUSY2+15,KCS) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.209) THEN +C...f + fbar -> ~tau_1 + ~tau_2bar + IF(MINT(15).LT.0) JS=2 + IF(MINT(2).EQ.1) THEN + MINT(20+JS)=KFPR(ISUB,1) + MINT(23-JS)=-KFPR(ISUB,2) + ELSE + MINT(20+JS)=-KFPR(ISUB,1) + MINT(23-JS)=KFPR(ISUB,2) + ENDIF + + ELSEIF(ISUB.EQ.210) THEN +C...q + qbar' -> ~l_L + ~nulbar; th arbitrary + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + MINT(21)=-ISIGN(KFPR(ISUB,1),KCH1+KCH2) + MINT(22)=ISIGN(KFPR(ISUB,2),KCH1+KCH2) + + ELSEIF(ISUB.EQ.211) THEN +C...q + qbar'-> ~tau_1 + ~nutaubar; th arbitrary + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + MINT(21)=-ISIGN(KSUSY1+15,KCH1+KCH2) + MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2) + + ELSEIF(ISUB.EQ.212) THEN +C...q + qbar'-> ~tau_2 + ~nutaubar; th arbitrary + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + MINT(21)=-ISIGN(KSUSY2+15,KCH1+KCH2) + MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2) + + ELSEIF(ISUB.EQ.213) THEN +C...f + fbar -> ~nul + ~nulbar + MINT(21)=ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.214) THEN +C...f + fbar -> ~nutau + ~nutaubar + MINT(21)=ISIGN(KSUSY1+16,KCS) + MINT(22)=-MINT(21) + ENDIF + + ELSEIF(ISUB.LE.225) THEN + IF(ISUB.EQ.216) THEN +C...f + fbar -> ~chi01 + ~chi01 + MINT(21)=KSUSY1+22 + MINT(22)=KSUSY1+22 + + ELSEIF(ISUB.EQ.217) THEN +C...f + fbar -> ~chi02 + ~chi02 + MINT(21)=KSUSY1+23 + MINT(22)=KSUSY1+23 + + ELSEIF(ISUB.EQ.218 ) THEN +C...f + fbar -> ~chi03 + ~chi03 + MINT(21)=KSUSY1+25 + MINT(22)=KSUSY1+25 + + ELSEIF(ISUB.EQ.219 ) THEN +C...f + fbar -> ~chi04 + ~chi04 + MINT(21)=KSUSY1+35 + MINT(22)=KSUSY1+35 + + ELSEIF(ISUB.EQ.220 ) THEN +C...f + fbar -> ~chi01 + ~chi02 + IF(MINT(15).LT.0) JS=2 +C IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+22 + MINT(23-JS)=KSUSY1+23 + + ELSEIF(ISUB.EQ.221 ) THEN +C...f + fbar -> ~chi01 + ~chi03 + IF(MINT(15).LT.0) JS=2 +C IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+22 + MINT(23-JS)=KSUSY1+25 + + ELSEIF(ISUB.EQ.222) THEN +C...f + fbar -> ~chi01 + ~chi04 + IF(MINT(15).LT.0) JS=2 +C IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+22 + MINT(23-JS)=KSUSY1+35 + + ELSEIF(ISUB.EQ.223) THEN +C...f + fbar -> ~chi02 + ~chi03 + IF(MINT(15).LT.0) JS=2 +C IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+23 + MINT(23-JS)=KSUSY1+25 + + ELSEIF(ISUB.EQ.224) THEN +C...f + fbar -> ~chi02 + ~chi04 + IF(MINT(15).LT.0) JS=2 +C IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+23 + MINT(23-JS)=KSUSY1+35 + + ELSEIF(ISUB.EQ.225) THEN +C...f + fbar -> ~chi03 + ~chi04 + IF(MINT(15).LT.0) JS=2 +C IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+25 + MINT(23-JS)=KSUSY1+35 + ENDIF + + ELSEIF(ISUB.LE.236) THEN + IF(ISUB.EQ.226) THEN +C...f + fbar -> ~chi+-1 + ~chi-+1 +C...th=(p(q)-p(chi+))**2 or (p(qbar)-p(chi-))**2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + MINT(21)=ISIGN(KSUSY1+24,KCH1) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.227) THEN +C...f + fbar -> ~chi+-2 + ~chi-+2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + MINT(21)=ISIGN(KSUSY1+37,KCH1) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.228) THEN +C...f + fbar -> ~chi+-1 + ~chi-+2 +C...th=(p(q)-p(chi1+))**2 or th=(p(qbar)-p(chi1-))**2 +C...js=1 if pyr<.5, js=2 if pyr>.5 +C...if 15=q, 16=qbar and js=1, chi1+ + chi2-, th=(q-chi1+)**2 +C...if 15=qbar, 16=q and js=1, chi2- + chi1+, th=(q-chi1+)**2 +C...if 15=q, 16=qbar and js=2, chi1- + chi2+, th=(qbar-chi1-)**2 +C...if 15=qbar, 16=q and js=2, chi2+ + chi1-, th=(q-chi1-)**2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=INT(1-KCH1)/2 + IF(MINT(2).EQ.1) THEN + MINT(21)= ISIGN(KSUSY1+24,KCH1) + MINT(22)= -ISIGN(KSUSY1+37,KCH1) +c IF(KCH2.EQ.0) JS=2 + ELSE + MINT(21)= ISIGN(KSUSY1+37,KCH1) + MINT(22)= -ISIGN(KSUSY1+24,KCH1) + JS=2 +c IF(KCH2.EQ.1) JS=2 + ENDIF + + ELSEIF(ISUB.EQ.229) THEN +C...q + qbar' -> ~chi01 + ~chi+-1 +C...th=(p(u)-p(chi+))**2 or (p(ubar)-p(chi-))**2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) +C...CHECK THIS + IF(MOD(MINT(15),2).EQ.0) JS=2 + MINT(20+JS)=KSUSY1+22 + MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) + + ELSEIF(ISUB.EQ.230) THEN +C...q + qbar' -> ~chi02 + ~chi+-1 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MOD(MINT(15),2).EQ.0) JS=2 + MINT(20+JS)=KSUSY1+23 + MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) + + ELSEIF(ISUB.EQ.231) THEN +C...q + qbar' -> ~chi03 + ~chi+-1 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MOD(MINT(15),2).EQ.0) JS=2 + MINT(20+JS)=KSUSY1+25 + MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) + + ELSEIF(ISUB.EQ.232) THEN +C...q + qbar' -> ~chi04 + ~chi+-1 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MOD(MINT(15),2).EQ.0) JS=2 + MINT(20+JS)=KSUSY1+35 + MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) + + ELSEIF(ISUB.EQ.233) THEN +C...q + qbar' -> ~chi01 + ~chi+-2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MOD(MINT(15),2).EQ.0) JS=2 + MINT(20+JS)=KSUSY1+22 + MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) + + ELSEIF(ISUB.EQ.234) THEN +C...q + qbar' -> ~chi02 + ~chi+-2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MOD(MINT(15),2).EQ.0) JS=2 + MINT(20+JS)=KSUSY1+23 + MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) + + ELSEIF(ISUB.EQ.235) THEN +C...q + qbar' -> ~chi03 + ~chi+-2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MOD(MINT(15),2).EQ.0) JS=2 + MINT(20+JS)=KSUSY1+25 + MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) + + ELSEIF(ISUB.EQ.236) THEN +C...q + qbar' -> ~chi04 + ~chi+-2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MOD(MINT(15),2).EQ.0) JS=2 + MINT(20+JS)=KSUSY1+35 + MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) + ENDIF + + ELSEIF(ISUB.LE.245) THEN + IF(ISUB.EQ.237) THEN +C...q + qbar -> ~chi01 + ~g +C...th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+21 + MINT(23-JS)=KSUSY1+22 + KCC=17+JS + + ELSEIF(ISUB.EQ.238) THEN +C...q + qbar -> ~chi02 + ~g +C...th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+21 + MINT(23-JS)=KSUSY1+23 + KCC=17+JS + + ELSEIF(ISUB.EQ.239) THEN +C...q + qbar -> ~chi03 + ~g +C...th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+21 + MINT(23-JS)=KSUSY1+25 + KCC=17+JS + + ELSEIF(ISUB.EQ.240) THEN +C...q + qbar -> ~chi04 + ~g +C...th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KSUSY1+21 + MINT(23-JS)=KSUSY1+35 + KCC=17+JS + + ELSEIF(ISUB.EQ.241) THEN +C...q + qbar' -> ~chi+-1 + ~g +C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+ +C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi- +C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi- +C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+ +C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + JS=1 + IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 + MINT(20+JS)=KSUSY1+21 + MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) + KCC=17+JS + + ELSEIF(ISUB.EQ.242) THEN +C...q + qbar' -> ~chi+-2 + ~g +C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+ +C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi- +C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi- +C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+ +C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + JS=1 + IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 + MINT(20+JS)=KSUSY1+21 + MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) + KCC=17+JS + + ELSEIF(ISUB.EQ.243) THEN +C...q + qbar -> ~g + ~g ; th arbitrary + MINT(21)=KSUSY1+21 + MINT(22)=KSUSY1+21 + KCC=MINT(2)+4 + + ELSEIF(ISUB.EQ.244) THEN +C...g + g -> ~g + ~g ; th arbitrary + KCC=MINT(2)+12 + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=KSUSY1+21 + MINT(22)=KSUSY1+21 + ENDIF + + ELSEIF(ISUB.LE.260) THEN + IF(ISUB.EQ.246) THEN +C...qj + g -> ~qj_L + ~chi01 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY1+IA,I) + MINT(23-JS)=KSUSY1+22 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.247) THEN +C...qj + g -> ~qj_R + ~chi01 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY2+IA,I) + MINT(23-JS)=KSUSY1+22 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.248) THEN +C...qj + g -> ~qj_L + ~chi02 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY1+IA,I) + MINT(23-JS)=KSUSY1+23 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.249) THEN +C...qj + g -> ~qj_R + ~chi02 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY2+IA,I) + MINT(23-JS)=KSUSY1+23 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.250) THEN +C...qj + g -> ~qj_L + ~chi03 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY1+IA,I) + MINT(23-JS)=KSUSY1+25 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.251) THEN +C...qj + g -> ~qj_R + ~chi03 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY2+IA,I) + MINT(23-JS)=KSUSY1+25 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.252) THEN +C...qj + g -> ~qj_L + ~chi04 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY1+IA,I) + MINT(23-JS)=KSUSY1+35 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.253) THEN +C...qj + g -> ~qj_R + ~chi04 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY2+IA,I) + MINT(23-JS)=KSUSY1+35 + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.254) THEN +C...qj + g -> ~qk_L + ~chi+-1 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I) + IB=-IA+INT((IA+1)/2)*4-1 + MINT(20+JS)=ISIGN(KSUSY1+IB,I) + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.255) THEN +C...qj + g -> ~qk_L + ~chi+-1 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I) + IB=-IA+INT((IA+1)/2)*4-1 + MINT(20+JS)=ISIGN(KSUSY2+IB,I) + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.256) THEN +C...qj + g -> ~qk_L + ~chi+-2 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + IB=-IA+INT((IA+1)/2)*4-1 + MINT(20+JS)=ISIGN(KSUSY1+IB,I) + MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I) + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.257) THEN +C...qj + g -> ~qk_R + ~chi+-2 + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + IB=-IA+INT((IA+1)/2)*4-1 + MINT(20+JS)=ISIGN(KSUSY2+IB,I) + MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I) + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.258) THEN +C...qj + g -> ~qj_L + ~g + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY1+IA,I) + MINT(23-JS)=KSUSY1+21 + KCC=MINT(2)+6 + IF(JS.EQ.2) KCC=KCC+2 + KCS=ISIGN(1,I) + + ELSEIF(ISUB.EQ.259) THEN +C...qj + g -> ~qj_R + ~g + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY2+IA,I) + MINT(23-JS)=KSUSY1+21 + KCC=MINT(2)+6 + IF(JS.EQ.2) KCC=KCC+2 + KCS=ISIGN(1,I) + ENDIF + + ELSEIF(ISUB.LE.270) THEN + IF(ISUB.EQ.261) THEN +C...f + fbar -> ~t_1 + ~t_1bar; th = (p(q)-p(sq))**2 + ISGN=1 + IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 + MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) +C...Correct color combination + IF(MINT(43).EQ.4) KCC=4 + + ELSEIF(ISUB.EQ.262) THEN +C...f + fbar -> ~t_2 + ~t_2bar; th = (p(q)-p(sq))**2 + ISGN=1 + IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 + MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) +C...Correct color combination + IF(MINT(43).EQ.4) KCC=4 + + ELSEIF(ISUB.EQ.263) THEN +C...f + fbar -> ~t_1 + ~t_2bar; th = (p(q)-p(sq))**2 + IF((KCS.GT.0.AND.MINT(2).EQ.1).OR. + & (KCS.LT.0.AND.MINT(2).EQ.2)) THEN + MINT(21)=ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-ISIGN(KFPR(ISUB,2),KCS) + ELSE + JS=2 + MINT(21)=ISIGN(KFPR(ISUB,2),KCS) + MINT(22)=-ISIGN(KFPR(ISUB,1),KCS) + ENDIF +C...Correct color combination + IF(MINT(43).EQ.4) KCC=4 + + ELSEIF(ISUB.EQ.264) THEN +C...g + g -> ~t_1 + ~t_1bar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) + KCC=MINT(2)+10 + + ELSEIF(ISUB.EQ.265) THEN +C...g + g -> ~t_2 + ~t_2bar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) + KCC=MINT(2)+10 + ENDIF + + ELSEIF(ISUB.LE.296) THEN + IF(ISUB.EQ.271.OR.ISUB.EQ.281.OR.ISUB.EQ.291) THEN +C...qi + qj -> ~qi_L + ~qj_L + KCC=MINT(2) + IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 + MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15)) + MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16)) + + ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.282.OR.ISUB.EQ.292) THEN +C...qi + qj -> ~qi_R + ~qj_R + KCC=MINT(2) + IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 + MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15)) + MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16)) + + ELSEIF(ISUB.EQ.273.OR.ISUB.EQ.283.OR.ISUB.EQ.293) THEN +C...qi + qj -> ~qi_L + ~qj_R + MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) + MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16)) + KCC=MINT(2) + IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 + + ELSEIF(ISUB.EQ.274.OR.ISUB.EQ.284) THEN +C...qi + qjbar -> ~qi_L + ~qj_Lbar; th = (p(f)-p(sf'))**2 + MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15)) + MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16)) + KCC=MINT(2) + IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 + + ELSEIF(ISUB.EQ.275.OR.ISUB.EQ.285) THEN +C...qi + qjbar -> ~qi_R + ~qj_Rbar ; th = (p(f)-p(sf'))**2 + MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15)) + MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16)) + KCC=MINT(2) + IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 + + ELSEIF(ISUB.EQ.276.OR.ISUB.EQ.286.OR.ISUB.EQ.296) THEN +C...qi + qjbar -> ~qi_L + ~qj_Rbar ; th = (p(f)-p(sf'))**2 + MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) + MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16)) + KCC=MINT(2) + IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 + + ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.287) THEN +C...f + fbar -> ~qi_L + ~qi_Lbar ; th = (p(q)-p(sq))**2 + ISGN=1 + IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 + MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) + IF(MINT(43).EQ.4) KCC=4 + + ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.288) THEN +C...f + fbar -> ~qi_R + ~qi_Rbar; th = (p(q)-p(sq))**2 + ISGN=1 + IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 + MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) + IF(MINT(43).EQ.4) KCC=4 + + ELSEIF(ISUB.EQ.279.OR.ISUB.EQ.289) THEN +C...g + g -> ~qi_L + ~qi_Lbar ; th arbitrary +C...pure LL + RR + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) + KCC=MINT(2)+10 + + ELSEIF(ISUB.EQ.280.OR.ISUB.EQ.290) THEN +C...g + g -> ~qi_R + ~qi_Rbar ; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) + KCC=MINT(2)+10 + + ELSEIF(ISUB.EQ.294) THEN +C...qj + g -> ~qj_L + ~g + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY1+IA,I) + MINT(23-JS)=KSUSY1+21 + KCC=MINT(2)+6 + IF(JS.EQ.2) KCC=KCC+2 + KCS=ISIGN(1,I) + + ELSEIF(ISUB.EQ.295) THEN +C...qj + g -> ~qj_R + ~g + IF(MINT(15).EQ.21) JS=2 + I=MINT(14+JS) + IA=IABS(I) + MINT(20+JS)=ISIGN(KSUSY2+IA,I) + MINT(23-JS)=KSUSY1+21 + KCC=MINT(2)+6 + IF(JS.EQ.2) KCC=KCC+2 + KCS=ISIGN(1,I) + ENDIF + + ELSEIF(ISUB.LE.330) THEN + IF(ISUB.EQ.311)THEN +C...g + g -> g* + g* (UED) + KCC=MINT(2)+12 + KCS=(-1)**INT(1.5D0+PYR(0)) + MUED(1)=472 + MUED(2)=472 + MINT(21)=IUEDEQ(472) + MINT(22)=IUEDEQ(472) + ELSEIF(ISUB.EQ.312)THEN +C...q + g -> q*_D + g*, q*_S + g* +C...The two channels have the same cross section + KKFLMI=450 + IF(PYR(0).GT.0.5)KKFLMI=456 + IF(MINT(15).EQ.21) JS=2 + KCC=MINT(2)+6 + IF(MINT(15).EQ.21)KCC=KCC+2 + IF(MINT(15).NE.21)THEN + KCS=ISIGN(1,MINT(15)) + MUED(2)=472 + MUED(1)=KCS*(KKFLMI+IABS(MINT(15))) + MINT(22)=IUEDEQ(472) + MINT(21)=KCS*IUEDEQ(KKFLMI+IABS(MINT(15))) + ENDIF + IF(MINT(16).NE.21)THEN + KCS=ISIGN(1,MINT(16)) + MUED(2)=KCS*(KKFLMI+IABS(MINT(16))) + MUED(1)=472 + MINT(22)=KCS*IUEDEQ(KKFLMI+IABS(MINT(16))) + MINT(21)=IUEDEQ(472) + ENDIF + ELSEIF(ISUB.EQ.313)THEN +C...q + q' -> q*_D + q*_D',q*_S+q*_S' +C...The two channels have the same cross section + KKFLMI=450 + IF(PYR(0).GT.0.5)KKFLMI=456 + KCC=MINT(2) + IF(MINT(15).EQ.MINT(16))THEN + MUED(1)=SIGN(1,MINT(15))*(KKFLMI+IABS(MINT(15))) + MUED(2)=MINT(21) + MINT(21)=SIGN(1,MINT(15))*IUEDEQ(KKFLMI+IABS(MINT(15))) + MINT(22)=MINT(21) + ELSE + MUED(1)=SIGN(1,MINT(15))*(KKFLMI+IABS(MINT(15))) + MUED(2)=SIGN(1,MINT(16))*(KKFLMI+IABS(MINT(16))) + MINT(21)=SIGN(1,MINT(15))*IUEDEQ(KKFLMI+IABS(MINT(15))) + MINT(22)=SIGN(1,MINT(16))*IUEDEQ(KKFLMI+IABS(MINT(16))) + ENDIF + IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 + ELSEIF(ISUB.EQ.314)THEN +C...g + g -> q*_D + q*_D_bar, q*_S + q*_S_bar +C...The two channels have the same cross section + KKFLMI=450 + IF(PYR(0).GT.0.5)KKFLMI=456 + KCS=(-1)**INT(1.5D0+PYR(0)) + XFLAOUT=PYR(0) + IF(XFLAOUT.LE.0.2)THEN + MUED(1)=ISIGN(1,KCS)*(KKFLMI+1) + MINT(21)=ISIGN(1,KCS)*IUEDEQ(KKFLMI+1) + ELSEIF(XFLAOUT.LE.0.4)THEN + MUED(1)=ISIGN(1,KCS)*(KKFLMI+2) + MINT(21)=ISIGN(1,KCS)*IUEDEQ(KKFLMI+2) + ELSEIF(XFLAOUT.LE.0.6)THEN + MUED(1)=ISIGN(1,KCS)*(KKFLMI+3) + MINT(21)=ISIGN(1,KCS)*IUEDEQ(KKFLMI+3) + ELSEIF(XFLAOUT.LE.0.8)THEN + MUED(1)=ISIGN(1,KCS)*(KKFLMI+4) + MINT(21)=ISIGN(1,KCS)*IUEDEQ(KKFLMI+4) + ELSE + MUED(1)=ISIGN(1,KCS)*(KKFLMI+5) + MINT(21)=ISIGN(1,KCS)*IUEDEQ(KKFLMI+5) + ENDIF + MINT(22)=-MINT(21) + MUED(2)=-MUED(1) + KCC=MINT(2)+10 + ELSEIF(ISUB.EQ.315)THEN +C...q + qbar -> q*_D + q*_D_bar, q*_S + q*_S_bar +C...The two channels have the same cross section + KKFLMI=450 + IF(PYR(0).GT.0.5)KKFLMI=456 + MUED(1)=ISIGN(1,MINT(15))*(KKFLMI+IABS(MINT(15))) + MUED(2)=-MINT(21) + MINT(21)=ISIGN(1,MINT(15))*IUEDEQ(KKFLMI+IABS(MINT(15))) + MINT(22)=-MINT(21) + KCC=4 + ELSEIF(ISUB.EQ.316)THEN +C...q + qbar' -> q*_D + q*_S_bar' + MUED(1)=ISIGN(1,MINT(15))*(456+IABS(MINT(15))) + MUED(2)=ISIGN(1,MINT(16))*(450+IABS(MINT(16))) + MINT(21)=ISIGN(1,MINT(15))*IUEDEQ(456+IABS(MINT(15))) + MINT(22)=ISIGN(1,MINT(16))*IUEDEQ(450+IABS(MINT(16))) + KCC=MINT(2)+2 + ELSEIF(ISUB.EQ.317)THEN +C...q + qbar' -> q*_D + q*_D_bar', q*_S + q*_S_bar +C...The two channels have the same cross section + KKFLMI=450 + IF(PYR(0).GT.0.5)KKFLMI=456 + MUED(1)=ISIGN(1,MINT(15))*(KKFLMI+IABS(MINT(15))) + MUED(2)=ISIGN(1,MINT(16))*(KKFLMI+IABS(MINT(16))) + MINT(21)=ISIGN(1,MINT(15))*IUEDEQ(KKFLMI+IABS(MINT(15))) + MINT(22)=ISIGN(1,MINT(16))*IUEDEQ(KKFLMI+IABS(MINT(16))) + KCC=MINT(2)+2 + ELSEIF(ISUB.EQ.318)THEN +C...q + q' -> q*_D + q*_S' + KCC=MINT(2) + MUED(1)=SIGN(1,MINT(15))*(456+IABS(MINT(15))) + MUED(2)=SIGN(1,MINT(16))*(450+IABS(MINT(16))) + MINT(21)=SIGN(1,MINT(15))*IUEDEQ(456+IABS(MINT(15))) + MINT(22)=SIGN(1,MINT(16))*IUEDEQ(450+IABS(MINT(16))) + ELSEIF(ISUB.EQ.319)THEN +C...q + qbar -> q*_D' + q*_D_bar', q*_S' + q*_S_bar' +C...The two channels have the same cross section + KKFLMI=450 + IF(PYR(0).GT.0.5)KKFLMI=456 + XFLAOUT=PYR(0) + IIFLAV=0 +C...N.B. NFLAVOURS=IUED(3) +C DO I=1,NFLAVOURS + DO 433 I=1,IUED(3) + IF(I.NE.IABS(MINT(15)))THEN + IIFLAV=IIFLAV+1 + IOKFLA(IIFLAV)=I + ENDIF + 433 CONTINUE + FLASTEP=1./(IUED(3)-1) + DO I=1,IUED(3)-1 + FLAVV=FLASTEP*I + IF(XFLAOUT.LE.FLAVV)THEN + MUED(1)=ISIGN(1,MINT(15))*(KKFLMI+IOKFLA(I)) + MINT(21)=ISIGN(1,MINT(15))*IUEDEQ(KKFLMI+IOKFLA(I)) + GOTO 435 + ENDIF + ENDDO + 435 CONTINUE + IF(IABS(MUED(1)).LT.451.AND.IABS(MUED(1)).GT.462)THEN + WRITE(MSTU(11),*) 'IN PYSCAT: KK FLAVORS PROBLEM !!!' + CALL PYSTOP(5000000) + ENDIF + MINT(22)=-MINT(21) + KCC=4 + ENDIF + + ELSEIF(ISUB.LE.340) THEN + + IF(ISUB.EQ.297.OR.ISUB.EQ.298) THEN +C...q + qbar' -> H+ + H0 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 + MINT(20+JS)=ISIGN(37,KCH1+KCH2) + MINT(23-JS)=KFPR(ISUB,2) + ELSEIF(ISUB.EQ.299.OR.ISUB.EQ.300) THEN +C...f + fbar -> A0 + H0; th arbitrary + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KFPR(ISUB,1) + MINT(23-JS)=KFPR(ISUB,2) + ELSEIF(ISUB.EQ.301) THEN +C...f + fbar -> H+ H- + MINT(21)=ISIGN(KFPR(ISUB,1),KCS) + MINT(22)=-MINT(21) + ENDIF +CMRENNA-- + + ELSEIF(ISUB.LE.360) THEN + + IF(ISUB.EQ.341.OR.ISUB.EQ.342) THEN +C...l + l -> H_L++/--, H_R++/-- + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2) + + ELSEIF(ISUB.GE.343.AND.ISUB.LE.348) THEN +C...l + gamma -> l' + H++/--; th=(p(l)-p(H))**2 + IF(MINT(15).EQ.22) JS=2 + MINT(20+JS)=ISIGN(KFPR(ISUB,1),-MINT(14+JS)) + MINT(23-JS)=ISIGN(KFPR(ISUB,2),-MINT(14+JS)) + KCC=22 + + ELSEIF(ISUB.EQ.349.OR.ISUB.EQ.350) THEN +C...f + fbar -> H++ + H--; th = (p(f)-p(H--))**2 + MINT(21)=-ISIGN(KFPR(ISUB,1),MINT(15)) + MINT(22)=-MINT(21) + + ELSEIF(ISUB.EQ.351.OR.ISUB.EQ.352) THEN +C...f + f' -> f" + f"' + H++/-- (W+/- + W+/- -> H++/-- +C...as inner process). + DO 450 JT=1,2 + I=MINT(14+JT) + IA=IABS(I) + IF(IA.LE.10) THEN + RVCKM=VINT(180+I)*PYR(0) + DO 440 J=1,MSTP(1) + IB=2*J-1+MOD(IA,2) + IPM=(5-ISIGN(1,I))/2 + IDC=J+MDCY(IA,2)+2 + IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 440 + MINT(20+JT)=ISIGN(IB,I) + RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) + IF(RVCKM.LE.0D0) GOTO 450 + 440 CONTINUE + ELSE + IB=2*((IA+1)/2)-1+MOD(IA,2) + MINT(20+JT)=ISIGN(IB,I) + ENDIF + 450 CONTINUE + KCC=22 + KFRES=ISIGN(KFPR(ISUB,1),MINT(15)) + IF(MOD(MINT(15),2).EQ.1) KFRES=-KFRES + + ELSEIF(ISUB.EQ.353) THEN +C...f + fbar -> Z_R0 + KFRES=KFPR(ISUB,1) + + ELSEIF(ISUB.EQ.354) THEN +C...f + fbar' -> W+/- + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2) + + ENDIF + + ELSEIF(ISUB.LE.380) THEN + + IF(ISUB.LE.363.OR.ISUB.EQ.368) THEN +C...f + fbar -> charged+ charged- technicolor + KSW=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFPR(ISUB,1),KSW) + MINT(22)=-ISIGN(KFPR(ISUB,2),KSW) + + ELSEIF(ISUB.LE.367.OR.ISUB.EQ.379.OR.ISUB.EQ.380) THEN +C...f + fbar -> neutral neutral technicolor + MINT(21)=KFPR(ISUB,1) + MINT(22)=KFPR(ISUB,2) + + ELSEIF(ISUB.EQ.374.OR.ISUB.EQ.375.OR.ISUB.EQ.378) THEN +C...f + fbar' -> neutral charged technicolor + IN=1 + IC=2 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 + MINT(23-JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2) + MINT(20+JS)=KFPR(ISUB,IN) + + ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN +C...f + fbar' -> charged neutral technicolor + IN=2 + IC=1 + KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) + KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) + IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 + MINT(20+JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2) + MINT(23-JS)=KFPR(ISUB,IN) + ENDIF + + ELSEIF(ISUB.LE.400) THEN + IF(ISUB.EQ.381) THEN +C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2, TC extensions + KCC=MINT(2) + IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 + + ELSEIF(ISUB.EQ.382) THEN +C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2, TC extensions + MINT(21)=ISIGN(KFLF,MINT(15)) + MINT(22)=-MINT(21) + KCC=4 + + ELSEIF(ISUB.EQ.383) THEN +C...f + fbar -> g + g; th arbitrary, TC extensions + MINT(21)=21 + MINT(22)=21 + KCC=MINT(2)+4 + + ELSEIF(ISUB.EQ.384) THEN +C...f + g -> f + g; th = (p(f)-p(f))**2, TC extensions + IF(MINT(15).EQ.21) JS=2 + KCC=MINT(2)+6 + IF(MINT(15).EQ.21) KCC=KCC+2 + IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) + IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) + + ELSEIF(ISUB.EQ.385) THEN +C...g + g -> f + fbar; th arbitrary, TC extensions + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFLF,KCS) + MINT(22)=-MINT(21) + KCC=MINT(2)+10 + + ELSEIF(ISUB.EQ.386) THEN +C...g + g -> g + g; th arbitrary, TC extensions + KCC=MINT(2)+12 + KCS=(-1)**INT(1.5D0+PYR(0)) + + ELSEIF(ISUB.EQ.387) THEN +C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2, TC extensions + MINT(21)=ISIGN(MINT(55),MINT(15)) + MINT(22)=-MINT(21) + KCC=4 + + ELSEIF(ISUB.EQ.388) THEN +C...g + g -> Q + Qbar; th arbitrary, TC extensions + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(MINT(55),KCS) + MINT(22)=-MINT(21) + KCC=MINT(2)+10 + + ELSEIF(ISUB.EQ.391) THEN +C...f + fbar -> G*. + KFRES=KFPR(ISUB,1) + + ELSEIF(ISUB.EQ.392) THEN +C...g + g -> G*. + KCC=21 + KFRES=KFPR(ISUB,1) + + ELSEIF(ISUB.EQ.393) THEN +C...q + qbar -> g + G*; th arbitrary. + IF(PYR(0).GT.0.5D0) JS=2 + MINT(20+JS)=KFPR(ISUB,1) + MINT(23-JS)=KFPR(ISUB,2) + KCC=17+JS + + ELSEIF(ISUB.EQ.394) THEN +C...q + g -> q + G*; th = (p(f) - p(f))**2 + IF(MINT(15).EQ.21) JS=2 + MINT(23-JS)=KFPR(ISUB,2) + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.EQ.395) THEN +C...g + g -> G* + g; th arbitrary. + IF(PYR(0).GT.0.5D0) JS=2 + MINT(23-JS)=KFPR(ISUB,2) + KCC=22+JS + ENDIF + + ELSEIF(ISUB.LE.420) THEN + IF(ISUB.EQ.401) THEN +C...g + g -> t + b + H+/- + KCS=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS) + MINT(22)=ISIGN(5,-KCS) + KCC=11+INT(0.5D0+PYR(0)) + KFRES=ISIGN(KFHIGG,-KCS) + + ELSEIF(ISUB.EQ.402) THEN +C...q + qbar -> t + b + H+/- + KFL=(-1)**INT(1.5D0+PYR(0)) + MINT(21)=ISIGN(INT(6.+.5*KFL),KCS) + MINT(22)=ISIGN(INT(6.-.5*KFL),-KCS) + KCC=4 + KFRES=ISIGN(KFHIGG,-KFL*KCS) + ENDIF + +C...QUARKONIA+++ +C...Additional code by Stefan Wolf + ELSEIF(ISUB.LE.430) THEN + IF(ISUB.GE.421.AND.ISUB.LE.424) THEN +C...g + g -> QQ~[n] + g +C...MINT(21), MINT(22) copied from ISUB.EQ.86-89 +C...[g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g] +C...KCC and KCS copied from ISUB.EQ.86-89 (for ISUB.EQ.421) +C...[g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g] +C...or from ISUB.EQ.68 (for ISUB.NE.421) +C...[g + g -> g + g; th arbitrary] + MINT(21)=KFPR(ISUBSV,1) + MINT(22)=KFPR(ISUBSV,2) + IF(ISUB.EQ.421) THEN + KCC=24 + KCS=(-1)**INT(1.5D0+PYR(0)) + ELSE + KCC=MINT(2)+12 + KCS=(-1)**INT(1.5D0+PYR(0)) + ENDIF + + ELSEIF(ISUB.GE.425.AND.ISUB.LE.427) THEN +C...q + g -> q + QQ~[n] +C...MINT(21), MINT(22) "copied" from ISUB.EQ.112 +C...[f + g -> f + h0; th = (p(f)-p(f))**2; (q + g -> q + h0 only)] +C...KCC copied from ISUB.EQ.28 +C...[f + g -> f + g; th = (p(f)-p(f))**2; (q + g -> q + g only)] + IF(MINT(15).EQ.21) JS=2 + MINT(23-JS)=KFPR(ISUBSV,2) + KCC=MINT(2)+6 + IF(MINT(15).EQ.21) KCC=KCC+2 + IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) + IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) + + ELSEIF(ISUB.GE.428.AND.ISUB.LE.430) THEN +C...q + q~ -> g + QQ~[n] +C...MINT(21), MINT(22) "copied" from ISUB.EQ.111 +C...[f + fbar -> g + h0; th arbitrary; (q + qbar -> g + h0 only)] +C...KCC copied from ISUB.EQ.13 +C...[f + fbar -> g + g; th arbitrary; (q + qbar -> g + g only)] + IF(PYR(0).GT.0.5) JS=2 + MINT(20+JS)=21 + MINT(23-JS)=KFPR(ISUBSV,2) + KCC=MINT(2)+4 + ENDIF + + ELSEIF(ISUB.LE.440) THEN + IF(ISUB.GE.431.AND.ISUB.LE.433) THEN +C...g + g -> QQ~[n] + g +C...MINT(21), MINT(22) copied from ISUB.EQ.86-89 +C...[g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g] +C...KCC and KCS copied from ISUB.EQ.86-89 +C...[g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g] + MINT(21)=KFPR(ISUBSV,1) + MINT(22)=KFPR(ISUBSV,2) + KCC=24 + KCS=(-1)**INT(1.5D0+PYR(0)) + + ELSEIF(ISUB.GE.434.AND.ISUB.LE.436) THEN +C...q + g -> q + QQ~[n] +C...MINT(21), MINT(22) "copied" from ISUB.EQ.112 +C...[f + g -> f + h0; th = (p(f)-p(f))**2; (q + g -> q + h0 only)] +C...KCC and KCS copied from ISUB.EQ.112 +C...[f + g -> f + h0; th = (p(f)-p(f))**2; (q + g -> q + h0 only)] + IF(MINT(15).EQ.21) JS=2 + MINT(23-JS)=KFPR(ISUBSV,2) + KCC=15+JS + KCS=ISIGN(1,MINT(14+JS)) + + ELSEIF(ISUB.GE.437.AND.ISUB.LE.439) THEN +C...q + q~ -> g + QQ~[n] +C...MINT(21), MINT(22) "copied" from ISUB.EQ.111 +C...[f + fbar -> g + h0; th arbitrary; (q + qbar -> g + h0 only)] +C...KCC copied from ISUB.EQ.111 +C...[f + fbar -> g + h0; th arbitrary; (q + qbar -> g + h0 only)] + IF(PYR(0).GT.0.5) JS=2 + MINT(20+JS)=21 + MINT(23-JS)=KFPR(ISUBSV,2) + KCC=17+JS + ENDIF +C...QUARKONIA--- + + ENDIF + + IF(ISET(ISUB).EQ.11) THEN +C...Store documentation for user-defined processes + BEZUP=(PUP(3,1)+PUP(3,2))/(PUP(4,1)+PUP(4,2)) + KUPPO(1)=MINT(83)+5 + KUPPO(2)=MINT(83)+6 + I=MINT(83)+6 + DO 470 IUP=3,NUP + KUPPO(IUP)=0 + IF(MSTP(128).GE.2.AND.MOTHUP(1,IUP).GE.3) THEN + IDOC=IDOC-1 + MINT(4)=MINT(4)-1 + GOTO 470 + ENDIF + I=I+1 + KUPPO(IUP)=I + K(I,1)=21 + K(I,2)=IDUP(IUP) + IF(IDUP(IUP).EQ.0) K(I,2)=90 + K(I,3)=0 + IF(MOTHUP(1,IUP).GE.3) K(I,3)=KUPPO(MOTHUP(1,IUP)) + K(I,4)=0 + K(I,5)=0 + DO 460 J=1,5 + P(I,J)=PUP(J,IUP) + 460 CONTINUE + V(I,5)=VTIMUP(IUP) + 470 CONTINUE + CALL PYROBO(MINT(83)+7,MINT(83)+4+NUP,0D0,VINT(24),0D0,0D0, + & -BEZUP) + +C...Store final state partons for user-defined processes + N=IPU2 + DO 490 IUP=3,NUP + N=N+1 + K(N,1)=1 + IF(ISTUP(IUP).EQ.2.OR.ISTUP(IUP).EQ.3) K(N,1)=11 + K(N,2)=IDUP(IUP) + IF(IDUP(IUP).EQ.0) K(N,2)=90 + IF(MSTP(128).LE.0.OR.MOTHUP(1,IUP).EQ.0) THEN + K(N,3)=KUPPO(IUP) + ELSE + K(N,3)=MINT(84)+MOTHUP(1,IUP) + ENDIF + K(N,4)=0 + K(N,5)=0 +C...Search for daughters of intermediate colourless particles. + IF(K(N,1).EQ.11.AND.KCHG(PYCOMP(K(N,2)),2).EQ.0) THEN + DO 475 IUPDAU=IUP+1,NUP + IF(MOTHUP(1,IUPDAU).EQ.IUP.AND.K(N,4).EQ.0) K(N,4)= + & N+IUPDAU-IUP + IF(MOTHUP(1,IUPDAU).EQ.IUP) K(N,5)=N+IUPDAU-IUP + 475 CONTINUE + ENDIF + DO 480 J=1,5 + P(N,J)=PUP(J,IUP) + 480 CONTINUE + V(N,5)=VTIMUP(IUP) + 490 CONTINUE + CALL PYROBO(IPU3,N,0D0,VINT(24),0D0,0D0,-BEZUP) + +C...Arrange colour flow for user-defined processes + NLBL=0 + DO 540 IUP1=1,NUP + I1=MINT(84)+IUP1 + IF(KCHG(PYCOMP(K(I1,2)),2).EQ.0) GOTO 540 + IF(K(I1,1).EQ.1) K(I1,1)=3 + IF(K(I1,1).EQ.11) K(I1,1)=14 +C...Find a not yet considered colour/anticolour line. + DO 530 ISDE1=1,2 + IF(ICOLUP(ISDE1,IUP1).EQ.0) GOTO 530 + NMAT=0 + DO 500 ILBL=1,NLBL + IF(ICOLUP(ISDE1,IUP1).EQ.ILAB(ILBL)) NMAT=1 + 500 CONTINUE + IF(NMAT.EQ.0) THEN + NLBL=NLBL+1 + ILAB(NLBL)=ICOLUP(ISDE1,IUP1) +C...Find all others belonging to same line. + I3=I1 + I4=0 + DO 520 IUP2=IUP1+1,NUP + I2=MINT(84)+IUP2 + DO 510 ISDE2=1,2 + IF(ICOLUP(ISDE2,IUP2).EQ.ICOLUP(ISDE1,IUP1)) THEN + IF(ISDE2.EQ.ISDE1) THEN + K(I3,3+ISDE2)=K(I3,3+ISDE2)+I2 + K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I3 + I3=I2 + ELSEIF(I4.NE.0) THEN + K(I4,3+ISDE2)=K(I4,3+ISDE2)+I2 + K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I4 + I4=I2 + ELSEIF(IUP2.LE.2) THEN + K(I1,3+ISDE1)=K(I1,3+ISDE1)+I2 + K(I2,3+ISDE2)=K(I2,3+ISDE2)+I1 + I4=I2 + ELSE + K(I1,3+ISDE1)=K(I1,3+ISDE1)+MSTU(5)*I2 + K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I1 + I4=I2 + ENDIF + ENDIF + 510 CONTINUE + 520 CONTINUE + ENDIF + 530 CONTINUE + 540 CONTINUE + + ELSEIF(IDOC.EQ.7) THEN +C...Resonance not decaying; store kinematics + I=MINT(83)+7 + K(IPU3,1)=1 + K(IPU3,2)=KFRES + K(IPU3,3)=I + P(IPU3,4)=SHUSER + P(IPU3,5)=SHUSER + K(I,1)=21 + K(I,2)=KFRES + P(I,4)=SHUSER + P(I,5)=SHUSER + N=IPU3 + MINT(21)=KFRES + MINT(22)=0 + +C...Special cases: colour flow in coloured resonances + KCRES=PYCOMP(KFRES) + IF(KCHG(KCRES,2).NE.0) THEN + K(IPU3,1)=3 + DO 550 J=1,2 + JC=J + IF(KCS.EQ.-1) JC=3-J + IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= + & MINT(84)+ICOL(KCC,1,JC) + IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= + & MINT(84)+ICOL(KCC,2,JC) + IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)= + & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) + 550 CONTINUE + ELSE + K(IPU1,4)=IPU2 + K(IPU1,5)=IPU2 + K(IPU2,4)=IPU1 + K(IPU2,5)=IPU1 + ENDIF + + ELSEIF(IDOC.EQ.8) THEN +C...2 -> 2 processes: store outgoing partons in their CM-frame + DO 560 JT=1,2 + I=MINT(84)+2+JT + KCA=PYCOMP(MINT(20+JT)) + K(I,1)=1 + IF(KCHG(KCA,2).NE.0) K(I,1)=3 + K(I,2)=MINT(20+JT) + K(I,3)=MINT(83)+IDOC+JT-2 + KFAA=IABS(K(I,2)) + IF(KFPR(ISUBSV,1+MOD(JS+JT,2)).NE.0) THEN + P(I,5)=SQRT(VINT(63+MOD(JS+JT,2))) + ELSE + P(I,5)=PYMASS(K(I,2)) + ENDIF + IF((KFAA.EQ.6.OR.KFAA.EQ.7.OR.KFAA.EQ.8).AND. + & P(I,5).LT.PARP(42)) P(I,5)=PYMASS(K(I,2)) + 560 CONTINUE + IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN + KFA1=IABS(MINT(21)) + KFA2=IABS(MINT(22)) + IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21)) + & THEN + MINT(51)=1 + RETURN + ENDIF + P(IPU3,5)=0D0 + P(IPU4,5)=0D0 + ENDIF + P(IPU3,4)=0.5D0*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR) + P(IPU3,3)=SQRT(MAX(0D0,P(IPU3,4)**2-P(IPU3,5)**2)) + P(IPU4,4)=SHR-P(IPU3,4) + P(IPU4,3)=-P(IPU3,3) + N=IPU4 + MINT(7)=MINT(83)+7 + MINT(8)=MINT(83)+8 + +C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4) + CALL PYROBO(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) + + ELSEIF(IDOC.EQ.9) THEN +C...2 -> 3 processes: store outgoing partons in their CM frame + DO 570 JT=1,2 + I=MINT(84)+2+JT + KCA=PYCOMP(MINT(20+JT)) + K(I,1)=1 + IF(KCHG(KCA,2).NE.0) K(I,1)=3 + K(I,2)=MINT(20+JT) + K(I,3)=MINT(83)+IDOC+JT-3 + JTA=JT +C...t and b in opposide order in event list as compared to +C...matrix element? + IF(ISUB.EQ.402.AND.IABS(MINT(21)).EQ.5) JTA=3-JT + IF(IABS(K(I,2)).LE.22) THEN + P(I,5)=PYMASS(K(I,2)) + ELSE + P(I,5)=SQRT(VINT(63+MOD(JS+JTA,2))) + ENDIF + PT=SQRT(MAX(0D0,VINT(197+5*JTA)-P(I,5)**2+VINT(196+5*JTA)**2)) + P(I,1)=PT*COS(VINT(198+5*JTA)) + P(I,2)=PT*SIN(VINT(198+5*JTA)) + 570 CONTINUE + K(IPU5,1)=1 + K(IPU5,2)=KFRES + K(IPU5,3)=MINT(83)+IDOC + P(IPU5,5)=SHR + P(IPU5,1)=-P(IPU3,1)-P(IPU4,1) + P(IPU5,2)=-P(IPU3,2)-P(IPU4,2) + PMS1=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2 + PMS2=P(IPU4,5)**2+P(IPU4,1)**2+P(IPU4,2)**2 + PMS3=P(IPU5,5)**2+P(IPU5,1)**2+P(IPU5,2)**2 + PMT3=SQRT(PMS3) + P(IPU5,3)=PMT3*SINH(VINT(211)) + P(IPU5,4)=PMT3*COSH(VINT(211)) + PMS12=(SHPR-P(IPU5,4))**2-P(IPU5,3)**2 + SQL12=(PMS12-PMS1-PMS2)**2-4D0*PMS1*PMS2 + IF(SQL12.LE.0D0) THEN + MINT(51)=1 + RETURN + ENDIF + P(IPU3,3)=(-P(IPU5,3)*(PMS12+PMS1-PMS2)+ + & VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2D0*PMS12) + P(IPU4,3)=-P(IPU3,3)-P(IPU5,3) + IF(ISUB.EQ.402.AND.IABS(MINT(21)).EQ.5) THEN +C...t and b in opposide order in event list as compared to +C...matrix element + P(IPU4,3)=(-P(IPU5,3)*(PMS12+PMS2-PMS1)+ + & VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2D0*PMS12) + P(IPU3,3)=-P(IPU4,3)-P(IPU5,3) + END IF + P(IPU3,4)=SQRT(PMS1+P(IPU3,3)**2) + P(IPU4,4)=SQRT(PMS2+P(IPU4,3)**2) + MINT(23)=KFRES + N=IPU5 + MINT(7)=MINT(83)+7 + MINT(8)=MINT(83)+8 + + ELSEIF(IDOC.EQ.11) THEN +C...Z0 + Z0 -> h0, W+ + W- -> h0: store Higgs and outgoing partons + PHI(1)=PARU(2)*PYR(0) + PHI(2)=PHI(1)-PHIR + DO 580 JT=1,2 + I=MINT(84)+2+JT + K(I,1)=1 + IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3 + K(I,2)=MINT(20+JT) + K(I,3)=MINT(83)+IDOC+JT-2 + P(I,5)=PYMASS(K(I,2)) + IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) THEN + MINT(51)=1 + RETURN + ENDIF + PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2)) + PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2)) + P(I,1)=PTABS*COS(PHI(JT)) + P(I,2)=PTABS*SIN(PHI(JT)) + P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) + P(I,4)=0.5D0*SHPR*Z(JT) + IZW=MINT(83)+6+JT + K(IZW,1)=21 + K(IZW,2)=23 + IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT))) + K(IZW,3)=IZW-2 + P(IZW,1)=-P(I,1) + P(IZW,2)=-P(I,2) + P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) + P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT)) + P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) + 580 CONTINUE + I=MINT(83)+9 + K(IPU5,1)=1 + K(IPU5,2)=KFRES + K(IPU5,3)=I + P(IPU5,5)=SHR + P(IPU5,1)=-P(IPU3,1)-P(IPU4,1) + P(IPU5,2)=-P(IPU3,2)-P(IPU4,2) + P(IPU5,3)=-P(IPU3,3)-P(IPU4,3) + P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4) + K(I,1)=21 + K(I,2)=KFRES + DO 590 J=1,5 + P(I,J)=P(IPU5,J) + 590 CONTINUE + N=IPU5 + MINT(23)=KFRES + + ELSEIF(IDOC.EQ.12) THEN +C...Z0 and W+/- scattering: store bosons and outgoing partons + PHI(1)=PARU(2)*PYR(0) + PHI(2)=PHI(1)-PHIR + JTRAN=INT(1.5D0+PYR(0)) + DO 600 JT=1,2 + I=MINT(84)+2+JT + K(I,1)=1 + IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3 + K(I,2)=MINT(20+JT) + K(I,3)=MINT(83)+IDOC+JT-2 + P(I,5)=PYMASS(K(I,2)) + IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0D0 + PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2)) + PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2)) + P(I,1)=PTABS*COS(PHI(JT)) + P(I,2)=PTABS*SIN(PHI(JT)) + P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) + P(I,4)=0.5D0*SHPR*Z(JT) + IZW=MINT(83)+6+JT + K(IZW,1)=21 + IF(MINT(14+JT).EQ.MINT(20+JT)) THEN + K(IZW,2)=23 + ELSE + K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT))-PYCHGE(MINT(20+JT))) + ENDIF + K(IZW,3)=IZW-2 + P(IZW,1)=-P(I,1) + P(IZW,2)=-P(I,2) + P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) + P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT)) + P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) + IPU=MINT(84)+4+JT + K(IPU,1)=3 + K(IPU,2)=KFPR(ISUB,JT) + IF(ISUB.EQ.72.AND.JT.EQ.JTRAN) K(IPU,2)=-K(IPU,2) + IF(ISUB.EQ.73.OR.ISUB.EQ.77) K(IPU,2)=K(IZW,2) + K(IPU,3)=MINT(83)+8+JT + IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN + P(IPU,5)=PYMASS(K(IPU,2)) + ELSE + P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2))) + ENDIF + MINT(22+JT)=K(IPU,2) + 600 CONTINUE +C...Find rotation and boost for hard scattering subsystem + I1=MINT(83)+7 + I2=MINT(83)+8 + BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4)) + BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4)) + BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4)) + GAMCM=(P(I1,4)+P(I2,4))/SHR + BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3) + PX=P(I1,1)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEXCM + PY=P(I1,2)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEYCM + PZ=P(I1,3)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEZCM + THECM=PYANGL(PZ,SQRT(PX**2+PY**2)) + PHICM=PYANGL(PX,PY) +C...Store hard scattering subsystem. Rotate and boost it + SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4D0*P(IPU5,5)**2* + & P(IPU6,5)**2 + PABS=SQRT(MAX(0D0,SQLAM/(4D0*SH))) + CTHWZ=VINT(23) + STHWZ=SQRT(MAX(0D0,1D0-CTHWZ**2)) + PHIWZ=VINT(24)-PHICM + P(IPU5,1)=PABS*STHWZ*COS(PHIWZ) + P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ) + P(IPU5,3)=PABS*CTHWZ + P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2) + P(IPU6,1)=-P(IPU5,1) + P(IPU6,2)=-P(IPU5,2) + P(IPU6,3)=-P(IPU5,3) + P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2) + CALL PYROBO(IPU5,IPU6,THECM,PHICM,BEXCM,BEYCM,BEZCM) + DO 620 JT=1,2 + I1=MINT(83)+8+JT + I2=MINT(84)+4+JT + K(I1,1)=21 + K(I1,2)=K(I2,2) + DO 610 J=1,5 + P(I1,J)=P(I2,J) + 610 CONTINUE + 620 CONTINUE + N=IPU6 + MINT(7)=MINT(83)+9 + MINT(8)=MINT(83)+10 + ENDIF + + IF(ISET(ISUB).EQ.11) THEN + ELSEIF(IDOC.GE.8) THEN +C...Store colour connection indices + DO 630 J=1,2 + JC=J + IF(KCS.EQ.-1) JC=3-J + IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= + & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC) + IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= + & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC) + IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)= + & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) + IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)= + & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC)) + 630 CONTINUE + +C...Copy outgoing partons to documentation lines + IMAX=2 + IF(IDOC.EQ.9) IMAX=3 + DO 650 I=1,IMAX + I1=MINT(83)+IDOC-IMAX+I + I2=MINT(84)+2+I + K(I1,1)=21 + K(I1,2)=K(I2,2) + IF(IDOC.LE.9) K(I1,3)=0 + IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I + DO 640 J=1,5 + P(I1,J)=P(I2,J) + 640 CONTINUE + 650 CONTINUE + + ELSEIF(IDOC.EQ.9) THEN +C...Store colour connection indices + DO 660 J=1,2 + JC=J + IF(KCS.EQ.-1) JC=3-J + IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= + & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)+ + & MAX(0,MIN(1,ICOL(KCC,1,JC)-2)) + IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= + & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)+ + & MAX(0,MIN(1,ICOL(KCC,2,JC)-2)) + IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)= + & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) + IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU5,1).EQ.3) K(IPU5,J+3)= + & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC)) + 660 CONTINUE + +C...Copy outgoing partons to documentation lines + DO 680 I=1,3 + I1=MINT(83)+IDOC-3+I + I2=MINT(84)+2+I + K(I1,1)=21 + K(I1,2)=K(I2,2) + K(I1,3)=0 + DO 670 J=1,5 + P(I1,J)=P(I2,J) + 670 CONTINUE + 680 CONTINUE + ENDIF + +C...Copy outgoing partons to list of allowed radiators. + NPART=0 + IF(MINT(35).GE.2.AND.ISET(ISUB).NE.0) THEN + DO 690 I=MINT(84)+3,N + NPART=NPART+1 + IPART(NPART)=I + PTPART(NPART)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2) + 690 CONTINUE + ENDIF + +C...Low-pT events: remove gluons used for string drawing purposes + IF(ISUB.EQ.95) THEN + IF(MINT(35).LE.1) THEN + K(IPU3,1)=K(IPU3,1)+10 + K(IPU4,1)=K(IPU4,1)+10 + ENDIF + DO 700 J=41,66 + VINTSV(J)=VINT(J) + VINT(J)=0D0 + 700 CONTINUE + DO 720 I=MINT(83)+5,MINT(83)+8 + DO 710 J=1,5 + P(I,J)=0D0 + 710 CONTINUE + 720 CONTINUE + ENDIF + + RETURN + END + +C*********************************************************************** + +C...PYEVOL +C...Handles intertwined pT-ordered spacelike initial-state parton +C...and multiple interactions. + + SUBROUTINE PYEVOL(MODE,PT2MAX,PT2MIN) +C...Mode = -1 : Initialize first time. Determine MAX and MIN scales. +C...MODE = 0 : (Re-)initialize ISR/MI evolution. +C...Mode = 1 : Evolve event from PT2MAX to PT2MIN. + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...External + EXTERNAL PYALPS + DOUBLE PRECISION PYALPS +C...Parameter statement for maximum size of showers. + PARAMETER (MAXNUR=1000) +C...Commonblocks. + COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR) + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) + COMMON/PYINTM/KFIVAL(2,3),NMI(2),IMI(2,800,2),NVC(2,-6:6), + & XASSOC(2,-6:6,240),XPSVC(-6:6,-1:240),PVCTOT(2,-1:1), + & XMI(2,240),PT2MI(240),IMISEP(0:240) + COMMON/PYCTAG/NCT,MCT(4000,2) + COMMON/PYISMX/MIMX,JSMX,KFLAMX,KFLCMX,KFBEAM(2),NISGEN(2,240), + & PT2MX,PT2AMX,ZMX,RM2CMX,Q2BMX,PHIMX + COMMON/PYISJN/MJN1MX,MJN2MX,MJOIND(2,240) +C...Local arrays and saved variables. + DIMENSION VINTSV(11:80),KSAV(4,5),PSAV(4,5),VSAV(4,5),SHAT(240) + SAVE NSAV,NPARTS,M15SV,M16SV,M21SV,M22SV,VINTSV,SHAT,ISUBHD,ALAM3 + & ,PSAV,KSAV,VSAV + + SAVE /PYPART/,/PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/, + & /PYINT2/,/PYINT3/,/PYINTM/,/PYCTAG/,/PYISMX/,/PYISJN/ + +C---------------------------------------------------------------------- +C...MODE=-1: Pre-initialization. Store info on hard scattering etc, +C...done only once per event, while MODE=0 is repeated each time the +C...evolution needs to be restarted. + IF (MODE.EQ.-1) THEN + ISUBHD=MINT(1) + NSAV=N + NPARTS=NPART +C...Store hard scattering variables + M15SV=MINT(15) + M16SV=MINT(16) + M21SV=MINT(21) + M22SV=MINT(22) + DO 100 J=11,80 + VINTSV(J)=VINT(J) + 100 CONTINUE + DO 120 J=1,5 + DO 110 IS=1,4 + I=IS+MINT(84) + PSAV(IS,J)=P(I,J) + KSAV(IS,J)=K(I,J) + VSAV(IS,J)=V(I,J) + 110 CONTINUE + 120 CONTINUE + +C...Set shat for hardest scattering + SHAT(1)=VINT(44) + IF(ISET(ISUBHD).GE.3.AND.ISET(ISUBHD).LE.5) SHAT(1)=VINT(26) + & *VINT(2) + +C...Compute 3-Flavour Lambda_QCD (sets absolute lowest PT scale below) + RMC=PMAS(4,1) + RMB=PMAS(5,1) + ALAM4=PARP(61) + IF(MSTU(112).LT.4) ALAM4=PARP(61)*(PARP(61)/RMC)**(2D0/25D0) + IF(MSTU(112).GT.4) ALAM4=PARP(61)*(RMB/PARP(61))**(2D0/25D0) + ALAM3=ALAM4*(RMC/ALAM4)**(2D0/27D0) + +C---------------------------------------------------------------------- +C...MODE= 0: Initialize ISR/MI evolution, i.e. begin from hardest +C...interaction initiators, with no previous evolution. Check the input +C...PT2MAX and PT2MIN and impose extra constraints on minimum PT2 (e.g. +C...must be larger than Lambda_QCD) and maximum PT2 (e.g. must be +C...smaller than the CM energy / 2.) + ELSEIF (MODE.EQ.0) THEN +C...Reset counters and switches + N=NSAV + NPART=NPARTS + MINT(30)=0 + MINT(31)=1 + MINT(36)=1 +C...Reset hard scattering variables + MINT(1)=ISUBHD + DO 130 J=11,80 + VINT(J)=VINTSV(J) + 130 CONTINUE + DO 150 J=1,5 + DO 140 IS=1,4 + I=IS+MINT(84) + P(I,J)=PSAV(IS,J) + K(I,J)=KSAV(IS,J) + V(I,J)=VSAV(IS,J) + P(MINT(83)+4+IS,J)=PSAV(IS,J) + V(MINT(83)+4+IS,J)=VSAV(IS,J) + 140 CONTINUE + 150 CONTINUE +C...Reset statistics on activity in event. + DO 160 J=351,359 + MINT(J)=0 + VINT(J)=0D0 + 160 CONTINUE +C...Reset extra companion reweighting factor + VINT(140)=1D0 + +C...We do not generate MI for soft process (ISUB=95), but the +C...initialization must be done regardless, for later purposes. + MINT(36)=1 + +C...Initialize multiple interactions. + CALL PYPTMI(-1,PTDUM1,PTDUM2,PTDUM3,IDUM) + IF(MINT(51).NE.0) RETURN + +C...Decide whether quarks in hard scattering were valence or sea + PT2HD=VINT(54) + DO 170 JS=1,2 + MINT(30)=JS + CALL PYPTMI(2,PT2HD,PTDUM2,PTDUM3,IDUM) + IF(MINT(51).NE.0) RETURN + 170 CONTINUE + +C...Set lower cutoff for PT2 iteration and colour interference PT2 scale + VINT(18)=0D0 + PT2MIN=MAX(PT2MIN,(1.1D0*ALAM3)**2) + IF (MSTP(70).EQ.2) THEN +C...VINT(18) is freezeout scale of alpha_s: alpha_eff(0) = alpha_s(VINT(18)) + VINT(18)=(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2 + ELSEIF (MSTP(70).EQ.3) THEN +C...MSTP(70) = 3 : Derive VINT(18) from alpha_eff(Lambda3) = PARP(73) + ALPHA0 = MAX(1D-6,PARP(73)) + Q20 = ALAM3**2/PARP(64) + IF (MSTP(64).EQ.3) Q20 = Q20 * 1.661**2 + VINT(18) = Q20 * (EXP(12*PARU(1)/27D0/ALPHA0)-1D0) + ENDIF +C...Also store PT2MIN in VINT(17). + 180 VINT(17)=PT2MIN + +C...Set FS masses zero now. + VINT(63)=0D0 + VINT(64)=0D0 + +C...Initialize IS showers with VINT(56) as max scale. + PT2ISR=VINT(56) + PT20=PT2MIN + IF (MSTP(70).EQ.0) THEN + PT20=MAX(PT2MIN,PARP(62)**2) + ELSEIF (MSTP(70).EQ.1) THEN + PT20=MAX(PT2MIN,(PARP(81)*(VINT(1)/PARP(89))**PARP(90))**2) + ENDIF + CALL PYPTIS(-1,PT2ISR,PT20,PT2DUM,IFAIL) + IF(MINT(51).NE.0) RETURN + + RETURN + +C---------------------------------------------------------------------- +C...MODE= 1: Evolve event from PTMAX to PTMIN. + ELSEIF (MODE.EQ.1) THEN + +C...Skip if no phase space. + 190 IF (PT2MAX.LE.PT2MIN) GOTO 330 + +C...Starting pT2 max scale (to be udpated successively). + PT2CMX=PT2MAX + +C...Evolve two sides of the event to find which branches at highest pT. + 200 JSMX=-1 + MIMX=0 + PT2MX=0D0 + +C...Loop over current shower initiators. + IF (MSTP(61).GE.1) THEN + DO 230 MI=1,MINT(31) + IF (MI.GE.2.AND.MSTP(84).LE.0) GOTO 230 + ISUB=96 + IF (MI.EQ.1) ISUB=ISUBHD + MINT(1)=ISUB + MINT(36)=MI +C...Set up shat, initiator x values, and x remaining in BR. + VINT(44)=SHAT(MI) + VINT(141)=XMI(1,MI) + VINT(142)=XMI(2,MI) + VINT(143)=1D0 + VINT(144)=1D0 + DO 210 JI=1,MINT(31) + IF (JI.EQ.MINT(36)) GOTO 210 + VINT(143)=VINT(143)-XMI(1,JI) + VINT(144)=VINT(144)-XMI(2,JI) + 210 CONTINUE +C...Loop over sides. +C...Generate trial branchings for this interaction. The hardest +C...branching so far is automatically updated if necessary in /PYISMX/. + DO 220 JS=1,2 + MINT(30)=JS + PT20=PT2MIN + IF (MSTP(70).EQ.0) THEN + PT20=MAX(PT2MIN,PARP(62)**2) + ELSEIF (MSTP(70).EQ.1) THEN + PT20=MAX(PT2MIN, + & (PARP(81)*(VINT(1)/PARP(89))**PARP(90))**2) + ENDIF + CALL PYPTIS(0,PT2CMX,PT20,PT2NEW,IFAIL) + IF (MINT(51).NE.0) RETURN + 220 CONTINUE + 230 CONTINUE + ENDIF + +C...Generate trial additional interaction. + MINT(36)=MINT(31)+1 + 240 IF (MOD(MSTP(81),10).GE.1) THEN + MINT(1)=96 +C...Set up X remaining in BR. + VINT(143)=1D0 + VINT(144)=1D0 + DO 250 JI=1,MINT(31) + VINT(143)=VINT(143)-XMI(1,JI) + VINT(144)=VINT(144)-XMI(2,JI) + 250 CONTINUE +C...Generate trial interaction + 260 CALL PYPTMI(0,PT2CMX,PT2MIN,PT2NEW,IFAIL) + IF (MINT(51).EQ.1) RETURN + ENDIF + +C...And the winner is: + IF (PT2MX.LT.PT2MIN) THEN + GOTO 330 + ELSEIF (JSMX.EQ.0) THEN +C...Accept additional interaction (may still fail). + CALL PYPTMI(1,PT2NEW,PT2MIN,PT2DUM,IFAIL) + IF(MINT(51).NE.0) RETURN + IF (IFAIL.EQ.0) THEN + SHAT(MINT(36))=VINT(44) +C...Decide on flavours (valence/sea/companion). + DO 270 JS=1,2 + MINT(30)=JS + CALL PYPTMI(2,PT2NEW,PT2MIN,PT2DUM,IFAIL) + IF(MINT(51).NE.0) RETURN + 270 CONTINUE + ENDIF + ELSEIF (JSMX.EQ.1.OR.JSMX.EQ.2) THEN +C...Reconstruct kinematics of acceptable ISR branching. +C...Set up shat, initiator x values, and x remaining in BR. + MINT(30)=JSMX + MINT(36)=MIMX + VINT(44)=SHAT(MINT(36)) + VINT(141)=XMI(1,MINT(36)) + VINT(142)=XMI(2,MINT(36)) + VINT(143)=1D0 + VINT(144)=1D0 + DO 280 JI=1,MINT(31) + IF (JI.EQ.MINT(36)) GOTO 280 + VINT(143)=VINT(143)-XMI(1,JI) + VINT(144)=VINT(144)-XMI(2,JI) + 280 CONTINUE + PT2NEW=PT2MX + CALL PYPTIS(1,PT2NEW,PT2DM1,PT2DM2,IFAIL) + IF (MINT(51).EQ.1) RETURN + ELSEIF (JSMX.EQ.3.OR.JSMX.EQ.4) THEN +C...Bookeep joining. Cannot (yet) be constructed kinematically. + MINT(354)=MINT(354)+1 + VINT(354)=VINT(354)+SQRT(PT2MX) + IF (MINT(354).EQ.1) VINT(359)=SQRT(PT2MX) + MJOIND(JSMX-2,MJN1MX)=MJN2MX + MJOIND(JSMX-2,MJN2MX)=MJN1MX + ENDIF + +C...Update PT2 iteration scale. + PT2CMX=PT2MX + +C...Loop back to continue evolution. + IF(N.GT.MSTU(4)-MSTU(32)-10) THEN + CALL PYERRM(11,'(PYEVOL:) no more memory left in PYJETS') + ELSE + IF (JSMX.GE.0.AND.PT2CMX.GE.PT2MIN) GOTO 200 + ENDIF + +C---------------------------------------------------------------------- +C...MODE= 2: (Re-)store user information on hardest interaction etc. + ELSEIF (MODE.EQ.2) THEN + +C...Revert to "ordinary" meanings of some parameters. + 290 DO 310 JS=1,2 + MINT(12+JS)=K(IMI(JS,1,1),2) + VINT(140+JS)=XMI(JS,1) + IF(MINT(18+JS).EQ.1) VINT(140+JS)=VINT(154+JS)*XMI(JS,1) + VINT(142+JS)=1D0 + DO 300 MI=1,MINT(31) + VINT(142+JS)=VINT(142+JS)-XMI(JS,MI) + 300 CONTINUE + 310 CONTINUE + +C...Restore saved quantities for hardest interaction. + MINT(1)=ISUBHD + MINT(15)=M15SV + MINT(16)=M16SV + MINT(21)=M21SV + MINT(22)=M22SV + DO 320 J=11,80 + VINT(J)=VINTSV(J) + 320 CONTINUE + + ENDIF + + 330 RETURN + END + +C********************************************************************* + +C...PYSSPA +C...Generates spacelike parton showers. + + SUBROUTINE PYSSPA(IPU1,IPU2) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP + PARAMETER (MAXNUR=1000) +C...Commonblocks. + COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR) + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) + COMMON/PYCTAG/NCT,MCT(4000,2) + SAVE /PYPART/,/PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/, + &/PYINT1/,/PYINT2/,/PYINT3/,/PYCTAG/ +C...Local arrays and data. + DIMENSION KFLS(4),IS(2),XS(2),ZS(2),Q2S(2),TEVCSV(2),TEVESV(2), + &XFS(2,-25:25),XFA(-25:25),XFB(-25:25),XFN(-25:25),WTAPC(-25:25), + &WTAPE(-25:25),WTSF(-25:25),THE2(2),ALAM(2),DQ2(3),DPC(3),DPD(4), + &DPB(4),ROBO(5),MORE(2),KFBEAM(2),Q2MNCS(2),KCFI(2),NFIS(2), + &THEFIS(2,2),ISFI(2),DPHI(2),MCESV(2) + DATA IS/2*0/ + +C...Read out basic information; set global Q^2 scale. + IPUS1=IPU1 + IPUS2=IPU2 + ISUB=MINT(1) + Q2MX=VINT(56) + VINT2R=VINT(2)*VINT(143)*VINT(144) + IF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.9.OR.ISET(ISUB).EQ.11) Q2MX= + &MIN(VINT2R,PARP(67)*VINT(56)) + FCQ2MX=1D0 + +C...Define which processes ME corrections have been implemented for. + MECOR=0 + IF(MSTP(68).EQ.1.OR.MSTP(68).EQ.3) THEN + IF(ISUB.EQ.1.OR.ISUB.EQ.2.OR.ISUB.EQ.141.OR.ISUB.EQ.142.OR. + & ISUB.EQ.144) MECOR=1 + IF(ISUB.EQ.102.OR.ISUB.EQ.152.OR.ISUB.EQ.157) MECOR=2 + IF(ISUB.EQ.3.OR.ISUB.EQ.151.OR.ISUB.EQ.156) MECOR=3 + ENDIF + +C...Initialize QCD evolution and check phase space. + Q2MNC=PARP(62)**2 + Q2MNCS(1)=Q2MNC + Q2MNCS(2)=Q2MNC + IF(MINT(107).EQ.2.AND.MSTP(66).EQ.2) THEN + Q0S=PARP(15)**2 + PS=VINT(3)**2 + Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* + & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) + Q2INT=SQRT(Q0S*Q2EFF) + Q2MNCS(1)=MAX(Q2MNC,Q2INT) + ELSEIF(MINT(107).EQ.3.AND.MSTP(66).GE.1) THEN + Q2MNCS(1)=MAX(Q2MNC,VINT(283)) + ENDIF + IF(MINT(108).EQ.2.AND.MSTP(66).EQ.2) THEN + Q0S=PARP(15)**2 + PS=VINT(4)**2 + Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* + & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) + Q2INT=SQRT(Q0S*Q2EFF) + Q2MNCS(2)=MAX(Q2MNC,Q2INT) + ELSEIF(MINT(108).EQ.3.AND.MSTP(66).GE.1) THEN + Q2MNCS(2)=MAX(Q2MNC,VINT(284)) + ENDIF + MCEV=0 + ALAMS=PARU(112) + PARU(112)=PARP(61) + FQ2C=1D0 + TCMX=0D0 + IF(MINT(47).GE.2.AND.(MINT(47).LT.5.OR.MSTP(12).GE.1)) THEN + MCEV=1 + IF(MSTP(64).EQ.1) FQ2C=PARP(63) + IF(MSTP(64).EQ.2) FQ2C=PARP(64) + TCMX=LOG(FQ2C*Q2MX/PARP(61)**2) + IF(Q2MX.LT.MAX(Q2MNC,2D0*PARP(61)**2).OR.TCMX.LT.0.2D0) + & MCEV=0 + ENDIF + +C...Initialize QED evolution and check phase space. + MEEV=0 + XEE=1D-10 + SPME=PMAS(11,1)**2 + IF(IABS(MINT(11)).EQ.13.OR.IABS(MINT(12)).EQ.13) + &SPME=PMAS(13,1)**2 + IF(IABS(MINT(11)).EQ.15.OR.IABS(MINT(12)).EQ.15) + &SPME=PMAS(15,1)**2 + Q2MNE=MAX(PARP(68)**2,2D0*SPME) + TEMX=0D0 + FWTE=10D0 + IF(MINT(45).EQ.3.OR.MINT(46).EQ.3) THEN + MEEV=1 + TEMX=LOG(Q2MX/SPME) + IF(Q2MX.LE.Q2MNE.OR.TEMX.LT.0.2D0) MEEV=0 + ENDIF + IF(MSTP(61).GE.2.AND.MCEV.EQ.1.AND.MEEV.EQ.0) THEN + MEEV=2 + TEMX=TCMX + FWTE=1D0 + ENDIF + IF(MCEV.EQ.0.AND.MEEV.EQ.0) RETURN + +C...Loopback point in case of failure to reconstruct kinematics. + NS=N + NPARTS=NPART + LOOP=0 + MNT352=MINT(352) + MNT353=MINT(353) + VNT352=VINT(352) + VNT353=VINT(353) + 100 LOOP=LOOP+1 + IF(LOOP.GT.100) THEN + MINT(51)=1 + RETURN + ENDIF + N=NS + NPART=NPARTS + MINT(352)=MNT352 + MINT(353)=MNT353 + VINT(352)=VNT352 + VINT(353)=VNT353 + +C...Initial values: flavours, momenta, virtualities. + DO 120 JT=1,2 + MORE(JT)=1 + KFBEAM(JT)=MINT(10+JT) + IF(MINT(18+JT).EQ.1)KFBEAM(JT)=22 + KFLS(JT)=MINT(14+JT) + KFLS(JT+2)=KFLS(JT) + XS(JT)=VINT(40+JT) + IF(MINT(18+JT).EQ.1) XS(JT)=VINT(40+JT)/VINT(154+JT) + IF(MINT(31).GE.2) XS(JT)=XS(JT)/VINT(142+JT) + ZS(JT)=1D0 + Q2S(JT)=FCQ2MX*Q2MX + DQ2(JT)=0D0 + TEVCSV(JT)=TCMX + ALAM(JT)=PARP(61) + THE2(JT)=1D0 + TEVESV(JT)=TEMX + MCESV(JT)=0 +C...Calculate initial parton distribution weights. + MINT(105)=MINT(102+JT) + MINT(109)=MINT(106+JT) + VINT(120)=VINT(2+JT) +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JT +C.... + IF(XS(JT).LT.1D0-XEE) THEN + IF(MINT(31).GE.2) MINT(30)=JT + IF(MSTP(57).LE.1) THEN + CALL PYPDFU(KFBEAM(JT),XS(JT),Q2S(JT),XFB) + ELSE + CALL PYPDFL(KFBEAM(JT),XS(JT),Q2S(JT),XFB) + ENDIF + ENDIF + DO 110 KFL=-25,25 + XFS(JT,KFL)=XFB(KFL) + 110 CONTINUE +C...Special kinematics check for c/b quarks (that g -> c cbar or +C...b bbar kinematically possible). + KFLCB=IABS(KFLS(JT)) + IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5)) THEN + IF(XS(JT).GT.0.9D0*Q2S(JT)/(PMAS(KFLCB,1)**2+Q2S(JT))) THEN + MINT(51)=1 + RETURN + ENDIF + ENDIF + 120 CONTINUE + DSH=VINT(44) + IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) DSH=VINT(26)*VINT(2) + +C...Find if interference with final state partons. + MFIS=0 + IF(MSTP(67).GE.1.AND.MSTP(67).LE.3) MFIS=MSTP(67) + IF(MFIS.NE.0) THEN + DO 140 I=1,2 + KCFI(I)=0 + KCA=PYCOMP(IABS(KFLS(I))) + IF(KCA.NE.0) KCFI(I)=KCHG(KCA,2)*ISIGN(1,KFLS(I)) + NFIS(I)=0 + IF(KCFI(I).NE.0) THEN + IF(I.EQ.1) IPFS=IPUS1 + IF(I.EQ.2) IPFS=IPUS2 + DO 130 J=1,2 + ICSI=MOD(K(IPFS,3+J),MSTU(5)) + IF(ICSI.GT.0.AND.ICSI.NE.IPUS1.AND.ICSI.NE.IPUS2.AND. + & (KCFI(I).EQ.(-1)**(J+1).OR.KCFI(I).EQ.2)) THEN + NFIS(I)=NFIS(I)+1 + THEFIS(I,NFIS(I))=PYANGL(P(ICSI,3),SQRT(P(ICSI,1)**2+ + & P(ICSI,2)**2)) + IF(I.EQ.2) THEFIS(I,NFIS(I))=PARU(1)-THEFIS(I,NFIS(I)) + ENDIF + 130 CONTINUE + ENDIF + 140 CONTINUE + IF(NFIS(1)+NFIS(2).EQ.0) MFIS=0 + ENDIF + +C...Pick up leg with highest virtuality. + JTOLD=1 + 150 N=N+1 + JT=1 + IF(N.GT.NS+1.AND.Q2S(2).GT.Q2S(1)) JT=2 + IF(N.EQ.NS+2.AND.JT.EQ.JTOLD) JT=3-JT + IF(MORE(JT).EQ.0) JT=3-JT + JTOLD=JT + KFLB=KFLS(JT) + XB=XS(JT) + DO 160 KFL=-25,25 + XFB(KFL)=XFS(JT,KFL) + 160 CONTINUE + DSHR=2D0*SQRT(DSH) + DSHZ=DSH/ZS(JT) + +C...Check if allowed to branch. + MCEV=0 + IF(IABS(KFLB).LE.10.OR.KFLB.EQ.21) THEN + MCEV=1 + XEC=MAX(PARP(65)*DSHR/VINT2R,XB*(1D0/(1D0-PARP(66))-1D0)) + IF(XB.GE.1D0-2D0*XEC) MCEV=0 + ENDIF + MEEV=0 + IF(MINT(44+JT).EQ.3) THEN + MEEV=1 + IF(XB.GE.1D0-2D0*XEE) MEEV=0 + IF((IABS(KFLB).LE.10.OR.KFLB.EQ.21).AND.XB.GE.1D0-2D0*XEC) + & MEEV=0 +C***Currently kill QED shower for resolved photoproduction. + IF(MINT(18+JT).EQ.1) MEEV=0 +C***Currently kill shower for W inside electron. + IF(IABS(KFLB).EQ.24) THEN + MCEV=0 + MEEV=0 + ENDIF + ENDIF + IF(MSTP(61).GE.2.AND.MCEV.EQ.1.AND.MEEV.EQ.0.AND.IABS(KFLB).LE.10) + &MEEV=2 + IF(MCEV.EQ.0.AND.MEEV.EQ.0) THEN + Q2B=0D0 + GOTO 260 + ENDIF + +C...Maximum Q2 with or without Q2 ordering. Effective Lambda and n_f. + Q2B=Q2S(JT) + TEVCB=TEVCSV(JT) + TEVEB=TEVESV(JT) + IF(MSTP(62).LE.1) THEN + IF(ZS(JT).GT.0.99999D0) THEN + Q2B=Q2S(JT) + ELSE + Q2B=0.5D0*(1D0/ZS(JT)+1D0)*Q2S(JT)+0.5D0*(1D0/ZS(JT)-1D0)* + & (Q2S(3-JT)-DSH+SQRT((DSH+Q2S(1)+Q2S(2))**2+ + & 8D0*Q2S(1)*Q2S(2)*ZS(JT)/(1D0-ZS(JT)))) + ENDIF + IF(MCEV.EQ.1) TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) + IF(MEEV.EQ.1) TEVEB=LOG(Q2B/SPME) + ENDIF + IF(MCEV.EQ.1) THEN + ALSDUM=PYALPS(FQ2C*Q2B) + TEVCB=TEVCB+2D0*LOG(ALAM(JT)/PARU(117)) + ALAM(JT)=PARU(117) + B0=(33D0-2D0*MSTU(118))/6D0 + ENDIF + IF(MEEV.EQ.2) TEVEB=TEVCB + TEVCBS=TEVCB + TEVEBS=TEVEB + +C...Select side for interference with final state partons. + IF(MFIS.GE.1.AND.N.LE.NS+2) THEN + IFI=N-NS + ISFI(IFI)=0 + IF(IABS(KCFI(IFI)).EQ.1.AND.NFIS(IFI).EQ.1) THEN + ISFI(IFI)=1 + ELSEIF(KCFI(IFI).EQ.2.AND.NFIS(IFI).EQ.1) THEN + IF(PYR(0).GT.0.5D0) ISFI(IFI)=1 + ELSEIF(KCFI(IFI).EQ.2.AND.NFIS(IFI).EQ.2) THEN + ISFI(IFI)=1 + IF(PYR(0).GT.0.5D0) ISFI(IFI)=2 + ENDIF + ENDIF + +C...Calculate preweighting factor for ME-corrected processes. + IF(MECOR.GE.1) CALL PYMEMX(MECOR,WTFF,WTGF,WTFG,WTGG) + +C...Calculate Altarelli-Parisi weights. + DO 170 KFL=-25,25 + WTAPC(KFL)=0D0 + WTAPE(KFL)=0D0 + WTSF(KFL)=0D0 + 170 CONTINUE +C...q -> q (g or gamma emission), g -> q. + IF(IABS(KFLB).LE.10) THEN + WTAPC(KFLB)=(8D0/3D0)*LOG((1D0-XEC-XB)*(XB+XEC)/(XEC*(1D0-XEC))) + WTAPC(21)=0.5D0*(XB/(XB+XEC)-XB/(1D0-XEC)) + EQ2=1D0/9D0 + IF(MOD(IABS(KFLB),2).EQ.0) EQ2=4D0*EQ2 + IF(MEEV.EQ.2) WTAPE(KFLB)=2.*EQ2*LOG((1D0-XEC-XB)*(XB+XEC)/ + & (XEC*(1D0-XEC))) + IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN + WTAPC(KFLB)=WTFF*WTAPC(KFLB) + WTAPC(21)=WTGF*WTAPC(21) + WTAPE(KFLB)=WTFF*WTAPE(KFLB) + ENDIF +C...f -> f, gamma -> f. + ELSEIF(IABS(KFLB).LE.20) THEN + WTAPF1=LOG((1D0-XEE-XB)*(XB+XEE)/(XEE*(1D0-XEE))) + WTAPF2=LOG((1D0-XEE-XB)*(1D0-XEE)/(XEE*(XB+XEE))) + WTAPE(KFLB)=2D0*(WTAPF1+WTAPF2) + IF(MSTP(12).GE.1) WTAPE(22)=XB/(XB+XEE)-XB/(1D0-XEE) + IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN + WTAPE(KFLB)=WTFF*WTAPE(KFLB) + WTAPE(22)=WTGF*WTAPE(22) + ENDIF +C...f -> g, g -> g. + ELSEIF(KFLB.EQ.21) THEN + WTAPQ=(16D0/3D0)*(SQRT((1D0-XEC)/XB)-SQRT((XB+XEC)/XB)) + DO 180 KFL=1,MSTP(58) + WTAPC(KFL)=WTAPQ + WTAPC(-KFL)=WTAPQ + 180 CONTINUE + WTAPC(21)=6D0*LOG((1D0-XEC-XB)/XEC) + IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN + DO 190 KFL=1,MSTP(58) + WTAPC(KFL)=WTFG*WTAPC(KFL) + WTAPC(-KFL)=WTFG*WTAPC(-KFL) + 190 CONTINUE + WTAPC(21)=WTGG*WTAPC(21) + ENDIF +C...f -> gamma, W+, W-. + ELSEIF(KFLB.EQ.22) THEN + WTAPF=LOG((1D0-XEE-XB)*(1D0-XEE)/(XEE*(XB+XEE)))/XB + WTAPE(11)=WTAPF + WTAPE(-11)=WTAPF + IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN + WTAPE(11)=WTFG*WTAPE(11) + WTAPE(-11)=WTFG*WTAPE(-11) + ENDIF + ELSEIF(KFLB.EQ.24) THEN + WTAPE(-11)=1D0/(4D0*PARU(102))*LOG((1D0-XEE-XB)*(1D0-XEE)/ + & (XEE*(XB+XEE)))/XB + ELSEIF(KFLB.EQ.-24) THEN + WTAPE(11)=1D0/(4D0*PARU(102))*LOG((1D0-XEE-XB)*(1D0-XEE)/ + & (XEE*(XB+XEE)))/XB + ENDIF + +C...Calculate parton distribution weights and sum. + NTRY=0 + 200 NTRY=NTRY+1 + IF(NTRY.GT.500) THEN + MINT(51)=1 + RETURN + ENDIF + WTSUMC=0D0 + WTSUME=0D0 + XFBO=MAX(1D-10,XFB(KFLB)) + DO 210 KFL=-25,25 + WTSF(KFL)=XFB(KFL)/XFBO + WTSUMC=WTSUMC+WTAPC(KFL)*WTSF(KFL) + WTSUME=WTSUME+WTAPE(KFL)*WTSF(KFL) + 210 CONTINUE + WTSUMC=MAX(0.0001D0,WTSUMC) + WTSUME=MAX(0.0001D0/FWTE,WTSUME) + +C...Choose new t: fix alpha_s, alpha_s(Q^2), alpha_s(k_T^2). + NTRY2=0 + 220 NTRY2=NTRY2+1 + IF(NTRY2.GT.500) THEN + MINT(51)=1 + RETURN + ENDIF + IF(MCEV.EQ.1) THEN + IF(MSTP(64).LE.0) THEN + TEVCB=TEVCB+LOG(PYR(0))*PARU(2)/(PARU(111)*WTSUMC) + ELSEIF(MSTP(64).EQ.1) THEN + TEVCB=TEVCB*EXP(MAX(-50D0,LOG(PYR(0))*B0/WTSUMC)) + ELSE + TEVCB=TEVCB*EXP(MAX(-50D0,LOG(PYR(0))*B0/(5D0*WTSUMC))) + ENDIF + ENDIF + IF(MEEV.EQ.1) THEN + TEVEB=TEVEB*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/ + & (PARU(101)*FWTE*WTSUME*TEMX))) + ELSEIF(MEEV.EQ.2) THEN + TEVEB=TEVEB+LOG(PYR(0))*PARU(2)/(PARU(101)*WTSUME) + ENDIF + +C...Translate t into Q2 scale; choose between QCD and QED evolution. + 230 IF(MCEV.EQ.1) Q2CB=ALAM(JT)**2*EXP(MAX(-50D0,TEVCB))/FQ2C + IF(MEEV.EQ.1) Q2EB=SPME*EXP(MAX(-50D0,TEVEB)) + IF(MEEV.EQ.2) Q2EB=ALAM(JT)**2*EXP(MAX(-50D0,TEVEB))/FQ2C +C...Ensure that Q2 is above threshold for charm/bottom. + KFLCB=IABS(KFLB) + IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5).AND. + &MCEV.EQ.1) THEN + IF(Q2CB.LT.PMAS(KFLCB,1)**2) THEN + Q2CB=1.1D0*PMAS(KFLCB,1)**2 + TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) + FCQ2MX=MIN(2D0,1.05D0*FCQ2MX) + ENDIF + ENDIF + IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5).AND. + &MEEV.EQ.2) THEN + IF(Q2EB.LT.PMAS(KFLCB,1)**2) MEEV=0 + ENDIF + MCE=0 + IF(MCEV.EQ.0.AND.MEEV.EQ.0) THEN + ELSEIF(MCEV.EQ.1.AND.MEEV.EQ.0) THEN + IF(Q2CB.GT.Q2MNCS(JT)) MCE=1 + ELSEIF(MCEV.EQ.0.AND.MEEV.EQ.1) THEN + IF(Q2EB.GT.Q2MNE) MCE=2 + ELSEIF(MCEV.EQ.0.AND.MEEV.EQ.2) THEN + IF(Q2EB.GT.Q2MNCS(JT)) MCE=2 + ELSEIF(MCEV.EQ.1.AND.MEEV.EQ.2) THEN + IF(Q2CB.GT.Q2EB.AND.Q2CB.GT.Q2MNCS(JT)) MCE=1 + IF(Q2EB.GT.Q2CB.AND.Q2EB.GT.Q2MNCS(JT)) MCE=2 + ELSEIF(Q2MNCS(JT).GT.Q2MNE) THEN + MCE=1 + IF(Q2EB.GT.Q2CB.OR.Q2CB.LE.Q2MNCS(JT)) MCE=2 + IF(MCE.EQ.2.AND.Q2EB.LE.Q2MNE) MCE=0 + ELSE + MCE=2 + IF(Q2CB.GT.Q2EB.OR.Q2EB.LE.Q2MNE) MCE=1 + IF(MCE.EQ.1.AND.Q2CB.LE.Q2MNCS(JT)) MCE=0 + ENDIF + +C...Evolution possibly ended. Update t values. + IF(MCE.EQ.0) THEN + Q2B=0D0 + GOTO 260 + ELSEIF(MCE.EQ.1) THEN + Q2B=Q2CB + Q2REF=FQ2C*Q2B + IF(MEEV.EQ.1) TEVEB=LOG(Q2B/SPME) + IF(MEEV.EQ.2) TEVEB=LOG(FQ2C*Q2B/ALAM(JT)**2) + ELSE + Q2B=Q2EB + Q2REF=Q2B + IF(MCEV.EQ.1) TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) + ENDIF + +C...Select flavour for branching parton. + IF(MCE.EQ.1) WTRAN=PYR(0)*WTSUMC + IF(MCE.EQ.2) WTRAN=PYR(0)*WTSUME + KFLA=-25 + 240 KFLA=KFLA+1 + IF(MCE.EQ.1) WTRAN=WTRAN-WTAPC(KFLA)*WTSF(KFLA) + IF(MCE.EQ.2) WTRAN=WTRAN-WTAPE(KFLA)*WTSF(KFLA) + IF(KFLA.LE.24.AND.WTRAN.GT.0D0) GOTO 240 + IF(KFLA.EQ.25) THEN + Q2B=0D0 + GOTO 260 + ENDIF + +C...Choose z value and corrective weight. + WTZ=0D0 +C...q -> q + g or q -> q + gamma. + IF(IABS(KFLA).LE.10.AND.IABS(KFLB).LE.10) THEN + Z=1D0-((1D0-XB-XEC)/(1D0-XEC))* + & (XEC*(1D0-XEC)/((XB+XEC)*(1D0-XB-XEC)))**PYR(0) + WTZ=0.5D0*(1D0+Z**2) +C...q -> g + q. + ELSEIF(IABS(KFLA).LE.10.AND.KFLB.EQ.21) THEN + Z=XB/(SQRT(XB+XEC)+PYR(0)*(SQRT(1D0-XEC)-SQRT(XB+XEC)))**2 + WTZ=0.5D0*(1D0+(1D0-Z)**2)*SQRT(Z) +C...f -> f + gamma. + ELSEIF(IABS(KFLA).LE.20.AND.IABS(KFLB).LE.20) THEN + IF(WTAPF1.GT.PYR(0)*(WTAPF1+WTAPF2)) THEN + Z=1D0-((1D0-XB-XEE)/(1D0-XEE))* + & (XEE*(1D0-XEE)/((XB+XEE)*(1D0-XB-XEE)))**PYR(0) + ELSE + Z=XB+XB*(XEE/(1D0-XEE))* + & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) + ENDIF + WTZ=0.5D0*(1D0+Z**2)*(Z-XB)/(1D0-XB) +C...f -> gamma + f. + ELSEIF(IABS(KFLA).LE.20.AND.KFLB.EQ.22) THEN + Z=XB+XB*(XEE/(1D0-XEE))* + & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) + WTZ=0.5D0*(1D0+(1D0-Z)**2)*XB*(Z-XB)/Z +C...f -> W+- + f. + ELSEIF(IABS(KFLA).LE.20.AND.IABS(KFLB).EQ.24) THEN + Z=XB+XB*(XEE/(1D0-XEE))* + & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) + WTZ=0.5D0*(1D0+(1D0-Z)**2)*(XB*(Z-XB)/Z)* + & (Q2B/(Q2B+PMAS(24,1)**2)) +C...g -> q + qbar. + ELSEIF(KFLA.EQ.21.AND.IABS(KFLB).LE.10) THEN + Z=XB/(1D0-XEC)+PYR(0)*(XB/(XB+XEC)-XB/(1D0-XEC)) + WTZ=1D0-2D0*Z*(1D0-Z) +C...g -> g + g. + ELSEIF(KFLA.EQ.21.AND.KFLB.EQ.21) THEN + Z=1D0/(1D0+((1D0-XEC-XB)/XB)*(XEC/(1D0-XEC-XB))**PYR(0)) + WTZ=(1D0-Z*(1D0-Z))**2 +C...gamma -> f + fbar. + ELSEIF(KFLA.EQ.22.AND.IABS(KFLB).LE.20) THEN + Z=XB/(1D0-XEE)+PYR(0)*(XB/(XB+XEE)-XB/(1D0-XEE)) + WTZ=1D0-2D0*Z*(1D0-Z) + ENDIF + IF(MCE.EQ.2.AND.MEEV.EQ.1) WTZ=(WTZ/FWTE)*(TEVEB/TEMX) + +C...Option with resummation of soft gluon emission as effective z shift. + IF(MCE.EQ.1) THEN + IF(MSTP(65).GE.1) THEN + RSOFT=6D0 + IF(KFLB.NE.21) RSOFT=8D0/3D0 + Z=Z*(TEVCB/TEVCSV(JT))**(RSOFT*XEC/((XB+XEC)*B0)) + IF(Z.LE.XB) GOTO 220 + ENDIF + +C...Option with alpha_s(k_T^2): demand k_T^2 > cutoff, reweight. + IF(MSTP(64).GE.2) THEN + IF((1D0-Z)*Q2B.LT.Q2MNCS(JT)) GOTO 220 + ALPRAT=TEVCB/(TEVCB+LOG(1D0-Z)) + IF(ALPRAT.LT.5D0*PYR(0)) GOTO 220 + IF(ALPRAT.GT.5D0) WTZ=WTZ*ALPRAT/5D0 + ENDIF + ENDIF + +C...Remove kinematically impossible branchings. + UHAT=Q2B-DSH*(1D0-Z)/Z + IF(MSTP(68).GE.0.AND.UHAT.GT.0D0) GOTO 220 + +C...Select phi angle of branching at random. + PHIBR=PARU(2)*PYR(0) + +C...Matrix-element corrections for some processes. + IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN + IF(IABS(KFLA).LE.20.AND.IABS(KFLB).LE.20) THEN + CALL PYMEWT(MECOR,1,Q2B,Z,PHIBR,WTME) + WTZ=WTZ*WTME/WTFF + ELSEIF((KFLA.EQ.21.OR.KFLA.EQ.22).AND.IABS(KFLB).LE.20) THEN + CALL PYMEWT(MECOR,2,Q2B,Z,PHIBR,WTME) + WTZ=WTZ*WTME/WTGF + ELSEIF(IABS(KFLA).LE.20.AND.(KFLB.EQ.21.OR.KFLB.EQ.22)) THEN + CALL PYMEWT(MECOR,3,Q2B,Z,PHIBR,WTME) + WTZ=WTZ*WTME/WTFG + ELSEIF(KFLA.EQ.21.AND.KFLB.EQ.21) THEN + CALL PYMEWT(MECOR,4,Q2B,Z,PHIBR,WTME) + WTZ=WTZ*WTME/WTGG + ENDIF + ENDIF + +C...Impose angular constraint in first branching from interference +C...with final state partons. + IF(MCE.EQ.1) THEN + IF(MFIS.GE.1.AND.N.LE.NS+2.AND.NTRY2.LT.200) THEN + THE2D=(4D0*Q2B)/(DSH*(1D0-Z)) + IF(N.EQ.NS+1.AND.ISFI(1).GE.1) THEN + IF(THE2D.GT.THEFIS(1,ISFI(1))**2) GOTO 220 + ELSEIF(N.EQ.NS+2.AND.ISFI(2).GE.1) THEN + IF(THE2D.GT.THEFIS(2,ISFI(2))**2) GOTO 220 + ENDIF + ENDIF + +C...Option with angular ordering requirement. + IF(MSTP(62).GE.3.AND.NTRY2.LT.200) THEN + THE2T=(4D0*Z**2*Q2B)/(4D0*Z**2*Q2B+(1D0-Z)*XB**2*VINT2R) + IF(THE2T.GT.THE2(JT)) GOTO 220 + ENDIF + ENDIF + +C...Weighting with new parton distributions. + MINT(105)=MINT(102+JT) + MINT(109)=MINT(106+JT) + VINT(120)=VINT(2+JT) + IF(MINT(31).GE.2) MINT(30)=JT +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JT +C.... + IF(MSTP(57).LE.1) THEN + CALL PYPDFU(KFBEAM(JT),XB,Q2REF,XFN) + ELSE + CALL PYPDFL(KFBEAM(JT),XB,Q2REF,XFN) + ENDIF + XFBN=XFN(KFLB) + IF(XFBN.LT.1D-20) THEN + IF(KFLA.EQ.KFLB) THEN + TEVCB=TEVCBS + TEVEB=TEVEBS + WTAPC(KFLB)=0D0 + WTAPE(KFLB)=0D0 + GOTO 200 + ELSEIF(MCE.EQ.1.AND.TEVCBS-TEVCB.GT.0.2D0) THEN + TEVCB=0.5D0*(TEVCBS+TEVCB) + GOTO 230 + ELSEIF(MCE.EQ.2.AND.TEVEBS-TEVEB.GT.0.2D0) THEN + TEVEB=0.5D0*(TEVEBS+TEVEB) + GOTO 230 + ELSE + XFBN=1D-10 + XFN(KFLB)=XFBN + ENDIF + ENDIF + DO 250 KFL=-25,25 + XFB(KFL)=XFN(KFL) + 250 CONTINUE + XA=XB/Z +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JT +C.... + IF(MINT(31).GE.2) MINT(30)=JT + IF(MSTP(57).LE.1) THEN + CALL PYPDFU(KFBEAM(JT),XA,Q2REF,XFA) + ELSE + CALL PYPDFL(KFBEAM(JT),XA,Q2REF,XFA) + ENDIF + XFAN=XFA(KFLA) + IF(XFAN.LT.1D-20) GOTO 200 + WTSFA=WTSF(KFLA) + IF(WTZ*XFAN/XFBN.LT.PYR(0)*WTSFA) GOTO 200 + +C...Define two hard scatterers in their CM-frame. + 260 IF(N.EQ.NS+2) THEN + DQ2(JT)=Q2B + DPLCM=SQRT((DSH+DQ2(1)+DQ2(2))**2-4D0*DQ2(1)*DQ2(2))/DSHR + DO 280 JR=1,2 + I=NS+JR + IF(JR.EQ.1) IPO=IPUS1 + IF(JR.EQ.2) IPO=IPUS2 + DO 270 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 270 CONTINUE + K(I,1)=14 + K(I,2)=KFLS(JR+2) + K(I,4)=IPO + K(I,5)=IPO + P(I,3)=DPLCM*(-1)**(JR+1) + P(I,4)=(DSH+DQ2(3-JR)-DQ2(JR))/DSHR + P(I,5)=-SQRT(DQ2(JR)) + K(IPO,1)=14 + K(IPO,3)=I + K(IPO,4)=MOD(K(IPO,4),MSTU(5))+MSTU(5)*I + K(IPO,5)=MOD(K(IPO,5),MSTU(5))+MSTU(5)*I + MCT(I,1)=MCT(IPO,1) + MCT(I,2)=MCT(IPO,2) + 280 CONTINUE + +C...Find maximum allowed mass of timelike parton. + ELSEIF(N.GT.NS+2) THEN + JR=3-JT + DQ2(3)=Q2B + DPC(1)=P(IS(1),4) + DPC(2)=P(IS(2),4) + DPC(3)=0.5D0*(ABS(P(IS(1),3))+ABS(P(IS(2),3))) + DPD(1)=DSH+DQ2(JR)+DQ2(JT) + DPD(2)=DSHZ+DQ2(JR)+DQ2(3) + DPD(3)=SQRT(DPD(1)**2-4D0*DQ2(JR)*DQ2(JT)) + DPD(4)=SQRT(DPD(2)**2-4D0*DQ2(JR)*DQ2(3)) + IKIN=0 + IF(Q2S(JR).GE.0.25D0*Q2MNC.AND.DPD(1)-DPD(3).GE. + & 1D-10*DPD(1)) IKIN=1 + IF(IKIN.EQ.0) DMSMA=(DQ2(JT)/ZS(JT)-DQ2(3))* + & (DSH/(DSH+DQ2(JT))-DSH/(DSHZ+DQ2(3))) + IF(IKIN.EQ.1) DMSMA=(DPD(1)*DPD(2)-DPD(3)*DPD(4))/ + & (2D0*DQ2(JR))-DQ2(JT)-DQ2(3) + +C...Generate timelike parton shower (if required). + IT=N + DO 290 J=1,5 + K(IT,J)=0 + P(IT,J)=0D0 + V(IT,J)=0D0 + 290 CONTINUE +C...f -> f + g (gamma). + IF(IABS(KFLB).LE.20.AND.IABS(KFLS(JT+2)).LE.20) THEN + K(IT,2)=21 + IF(MCESV(JT).EQ.2.OR.IABS(KFLB).GE.11) K(IT,2)=22 +C...f -> g (gamma, W+-) + f. + ELSEIF(IABS(KFLB).LE.20.AND.IABS(KFLS(JT+2)).GT.20) THEN + K(IT,2)=KFLB + IF(KFLS(JT+2).EQ.24) THEN + K(IT,2)=-12 + ELSEIF(KFLS(JT+2).EQ.-24) THEN + K(IT,2)=12 + ENDIF +C...g (gamma) -> f + fbar, g + g. + ELSE + K(IT,2)=-KFLS(JT+2) + IF(KFLS(JT+2).GT.20) K(IT,2)=KFLS(JT+2) + ENDIF + K(IT,1)=3 + IF((IABS(K(IT,2)).GE.11.AND.IABS(K(IT,2)).LE.18).OR. + & IABS(K(IT,2)).EQ.22) K(IT,1)=1 + P(IT,5)=PYMASS(K(IT,2)) + IF(DMSMA.LE.P(IT,5)**2) GOTO 100 + IF(MSTP(63).GE.1.AND.MCESV(JT).EQ.1) THEN + MSTJ48=MSTJ(48) + PARJ85=PARJ(85) + P(IT,4)=(DSHZ-DSH-P(IT,5)**2)/DSHR + P(IT,3)=SQRT(P(IT,4)**2-P(IT,5)**2) + IF(MSTP(63).EQ.1) THEN + Q2TIM=DMSMA + ELSEIF(MSTP(63).EQ.2) THEN + Q2TIM=MIN(DMSMA,PARP(71)*Q2S(JT)) + ELSE + Q2TIM=DMSMA + MSTJ(48)=1 + IF(IKIN.EQ.0) DPT2=DMSMA*(DSHZ+DQ2(3))/(DSH+DQ2(JT)) + IF(IKIN.EQ.1) DPT2=DMSMA*(0.5D0*DPD(1)*DPD(2)+0.5D0*DPD(3)* + & DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)))/(4D0*DSH*DPC(3)**2) + PARJ(85)=SQRT(MAX(0D0,DPT2))* + & (1D0/P(IT,4)+1D0/P(IS(JT),4)) + ENDIF +C...Only do timelike shower here if using PYSHOW + IF (MSTJ(41).NE.11.AND.MSTJ(41).NE.12) THEN + CALL PYSHOW(IT,0,SQRT(Q2TIM)) + ENDIF + MSTJ(48)=MSTJ48 + PARJ(85)=PARJ85 + IF(N.GE.IT+1) P(IT,5)=P(IT+1,5) + ENDIF + +C...Reconstruct kinematics of branching: timelike parton shower. + DMS=P(IT,5)**2 + IF(IKIN.EQ.0) DPT2=(DMSMA-DMS)*(DSHZ+DQ2(3))/(DSH+DQ2(JT)) + IF(IKIN.EQ.1) DPT2=(DMSMA-DMS)*(0.5D0*DPD(1)*DPD(2)+ + & 0.5D0*DPD(3)*DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)+DMS))/ + & (4D0*DSH*DPC(3)**2) + IF(DPT2.LT.0D0) GOTO 100 + DPB(1)=(0.5D0*DPD(2)-DPC(JR)*(DSHZ+DQ2(JR)-DQ2(JT)-DMS)/ + & DSHR)/DPC(3)-DPC(3) + P(IT,1)=SQRT(DPT2) + P(IT,3)=DPB(1)*(-1)**(JT+1) + P(IT,4)=SQRT(DPT2+DPB(1)**2+DMS) + IF(N.GE.IT+1) THEN + DPB(1)=SQRT(DPB(1)**2+DPT2) + DPB(2)=SQRT(DPB(1)**2+DMS) + DPB(3)=P(IT+1,3) + DPB(4)=SQRT(DPB(3)**2+DMS) + DBEZ=(DPB(4)*DPB(1)-DPB(3)*DPB(2))/(DPB(4)*DPB(2)-DPB(3)* + & DPB(1)) + CALL PYROBO(IT+1,N,0D0,0D0,0D0,0D0,DBEZ) + THE=PYANGL(P(IT,3),P(IT,1)) + CALL PYROBO(IT+1,N,THE,0D0,0D0,0D0,0D0) + ENDIF + +C...Reconstruct kinematics of branching: spacelike parton. + DO 300 J=1,5 + K(N+1,J)=0 + P(N+1,J)=0D0 + V(N+1,J)=0D0 + 300 CONTINUE + K(N+1,1)=14 + K(N+1,2)=KFLB + P(N+1,1)=P(IT,1) + P(N+1,3)=P(IT,3)+P(IS(JT),3) + P(N+1,4)=P(IT,4)+P(IS(JT),4) + P(N+1,5)=-SQRT(DQ2(3)) + MCT(N+1,1)=0 + MCT(N+1,2)=0 + +C...Define colour flow of branching. + K(IS(JT),3)=N+1 + K(IT,3)=N+1 + IM1=N+1 + IM2=N+1 +C...f -> f + gamma (Z, W). + IF(IABS(K(IT,2)).GE.22) THEN + K(IT,1)=1 + ID1=IS(JT) + ID2=IS(JT) +C...f -> gamma (Z, W) + f. + ELSEIF(IABS(K(IS(JT),2)).GE.22) THEN + ID1=IT + ID2=IT +C...gamma -> q + qbar, g + g. + ELSEIF(K(N+1,2).EQ.22) THEN + ID1=IS(JT) + ID2=IT + IM1=ID2 + IM2=ID1 +C...q -> q + g. + ELSEIF(K(N+1,2).GT.0.AND.K(N+1,2).NE.21.AND.K(IT,2).EQ.21) THEN + ID1=IT + ID2=IS(JT) +C...q -> g + q. + ELSEIF(K(N+1,2).GT.0.AND.K(N+1,2).NE.21) THEN + ID1=IS(JT) + ID2=IT +C...qbar -> qbar + g. + ELSEIF(K(N+1,2).LT.0.AND.K(IT,2).EQ.21) THEN + ID1=IS(JT) + ID2=IT +C...qbar -> g + qbar. + ELSEIF(K(N+1,2).LT.0) THEN + ID1=IT + ID2=IS(JT) +C...g -> g + g; g -> q + qbar. + ELSEIF((K(IT,2).EQ.21.AND.PYR(0).GT.0.5D0).OR.K(IT,2).LT.0) THEN + ID1=IS(JT) + ID2=IT + ELSE + ID1=IT + ID2=IS(JT) + ENDIF + IF(IM1.EQ.N+1) K(IM1,4)=K(IM1,4)+ID1 + IF(IM2.EQ.N+1) K(IM2,5)=K(IM2,5)+ID2 + K(ID1,4)=K(ID1,4)+MSTU(5)*IM1 + K(ID2,5)=K(ID2,5)+MSTU(5)*IM2 + IF(ID1.NE.ID2) THEN + K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 + K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 + ENDIF + N=N+1 + IF(K(IT,1).EQ.1) THEN + K(IT,4)=0 + K(IT,5)=0 + ENDIF + +C...Boost to new CM-frame. + DBSVX=(P(N,1)+P(IS(JR),1))/(P(N,4)+P(IS(JR),4)) + DBSVZ=(P(N,3)+P(IS(JR),3))/(P(N,4)+P(IS(JR),4)) + IF(DBSVX**2+DBSVZ**2.GE.1D0) GOTO 100 + CALL PYROBO(NS+1,N,0D0,0D0,-DBSVX,0D0,-DBSVZ) + IR=N+(JT-1)*(IS(1)-N) + CALL PYROBO(NS+1,N,-PYANGL(P(IR,3),P(IR,1)),DPHI(JT), + & 0D0,0D0,0D0) + +C...Save timelike parton in PYPART if doing pT-ordered FSR off ISR + IF (MSTJ(41).EQ.11.OR.MSTJ(41).EQ.12) THEN + NPART=NPART+1 + IPART(NPART)=IT + PTPART(NPART)=SQRT(PARP(71)*DPT2) + ENDIF + +C...Global statistics. + MINT(352)=MINT(352)+1 + VINT(352)=VINT(352)+SQRT(P(IT,1)**2+P(IT,2)**2) + IF (MINT(352).EQ.1) VINT(357)=SQRT(P(IT,1)**2+P(IT,2)**2) + + ENDIF + +C...Update kinematics variables. + IS(JT)=N + DQ2(JT)=Q2B + IF(MSTP(62).GE.3.AND.NTRY2.LT.200.AND.MCE.EQ.1) THE2(JT)=THE2T + DSH=DSHZ + +C...Save quantities; loop back. + Q2S(JT)=Q2B + DPHI(JT)=PHIBR + MCESV(JT)=MCE + IF((MCEV.EQ.1.AND.Q2B.GE.0.25D0*Q2MNC).OR. + &(MEEV.EQ.1.AND.Q2B.GE.Q2MNE)) THEN + KFLS(JT+2)=KFLS(JT) + KFLS(JT)=KFLA + XS(JT)=XA + ZS(JT)=Z + DO 310 KFL=-25,25 + XFS(JT,KFL)=XFA(KFL) + 310 CONTINUE + TEVCSV(JT)=TEVCB + TEVESV(JT)=TEVEB + ELSE + MORE(JT)=0 + IF(JT.EQ.1) IPU1=N + IF(JT.EQ.2) IPU2=N + ENDIF + IF(N.GT.MSTU(4)-MSTU(32)-10) THEN + CALL PYERRM(11,'(PYSSPA:) no more memory left in PYJETS') + IF(MSTU(21).GE.1) N=NS + IF(MSTU(21).GE.1) RETURN + ENDIF + IF(MORE(1).EQ.1.OR.MORE(2).EQ.1) GOTO 150 + +C...Boost hard scattering partons to frame of shower initiators. + DO 320 J=1,3 + ROBO(J+2)=(P(NS+1,J)+P(NS+2,J))/(P(NS+1,4)+P(NS+2,4)) + 320 CONTINUE + K(N+2,1)=1 + DO 330 J=1,5 + P(N+2,J)=P(NS+1,J) + 330 CONTINUE + CALL PYROBO(N+2,N+2,0D0,0D0,-ROBO(3),-ROBO(4),-ROBO(5)) + ROBO(2)=PYANGL(P(N+2,1),P(N+2,2)) + ROBO(1)=PYANGL(P(N+2,3),SQRT(P(N+2,1)**2+P(N+2,2)**2)) + IMIN=MINT(83)+5 + IF(MINT(31).GE.2) IMIN=MIN(IPUS1,IPUS2) + CALL PYROBO(IMIN,NS,0D0,-ROBO(2),0D0,0D0,0D0) + CALL PYROBO(IMIN,NS,ROBO(1),ROBO(2),ROBO(3),ROBO(4),ROBO(5)) + +C...Store user information. Reset Lambda value. + IF(MINT(31).LE.1) THEN + K(IPU1,3)=MINT(83)+3 + K(IPU2,3)=MINT(83)+4 + ELSE + K(IPU1,3)=MINT(83)+1 + K(IPU2,3)=MINT(83)+2 + ENDIF + DO 340 JT=1,2 + MINT(12+JT)=KFLS(JT) + VINT(140+JT)=XS(JT) + IF(MINT(18+JT).EQ.1) VINT(140+JT)=VINT(154+JT)*XS(JT) + IF(MINT(31).GE.2) VINT(140+JT)=VINT(140+JT)*VINT(142+JT) + 340 CONTINUE + PARU(112)=ALAMS + + RETURN + END + +C********************************************************************* + +C...PYPTIS +C...Generates pT-ordered spacelike initial-state parton showers and +C...trial joinings. +C...MODE=-1: Initialize ISR from scratch, starting from the hardest +C... interaction initiators at PT2NOW. +C...MODE= 0: Generate a trial branching on interaction MINT(36), side +C... MINT(30). Start evolution at PT2NOW, solve Sudakov for PT2. +C... Store in /PYISMX/ if PT2 is largest so far. Abort if PT2 +C... is below PT2CUT. +C... (Also generate test joinings if MSTP(96)=1.) +C...MODE= 1: Accept stored shower branching. Update event record etc. +C...PT2NOW : Starting (max) PT2 scale for evolution. +C...PT2CUT : Lower limit for evolution. +C...PT2 : Result of evolution. Generated PT2 for trial emission. +C...IFAIL : Status return code. IFAIL=0 when all is well. + + SUBROUTINE PYPTIS(MODE,PT2NOW,PT2CUT,PT2,IFAIL) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement for maximum size of showers. + PARAMETER (MAXNUR=1000) +C...Commonblocks. + COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR) + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINTM/KFIVAL(2,3),NMI(2),IMI(2,800,2),NVC(2,-6:6), + & XASSOC(2,-6:6,240),XPSVC(-6:6,-1:240),PVCTOT(2,-1:1), + & XMI(2,240),PT2MI(240),IMISEP(0:240) + COMMON/PYISMX/MIMX,JSMX,KFLAMX,KFLCMX,KFBEAM(2),NISGEN(2,240), + & PT2MX,PT2AMX,ZMX,RM2CMX,Q2BMX,PHIMX + COMMON/PYCTAG/NCT,MCT(4000,2) + COMMON/PYISJN/MJN1MX,MJN2MX,MJOIND(2,240) + SAVE /PYPART/,/PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/, + & /PYINT2/,/PYINTM/,/PYISMX/,/PYCTAG/,/PYISJN/ +C...Local variables + DIMENSION ZSAV(2,240),PT2SAV(2,240), + & XFB(-25:25),XFA(-25:25),XFN(-25:25),XFJ(-25:25), + & WTAP(-25:25),WTPDF(-25:25),SHTNOW(240), + & WTAPJ(240),WTPDFJ(240),X1(240),Y(240) + SAVE ZSAV,PT2SAV,XFB,XFA,XFN,WTAP,WTPDF,XMXC,SHTNOW, + & RMB2,RMC2,ALAM3,ALAM4,ALAM5,TMIN,PTEMAX,WTEMAX,AEM2PI +C...For check on excessive weights. + CHARACTER CHWT*12 + +C...Only give errors for very large weights, otherwise just warnings + DATA WTEMAX /1.5D0/ +C...Only give errors for large pT, otherwise just warnings + DATA PTEMAX /5D0/ + + IFAIL=-1 + +C---------------------------------------------------------------------- +C...MODE=-1: Initialize initial state showers from scratch, i.e. +C...starting from the hardest interaction initiators. + IF (MODE.EQ.-1) THEN +C...Set hard scattering SHAT. + SHTNOW(1)=VINT(44) +C...Mass thresholds and Lambda for QCD evolution. + AEM2PI=PARU(101)/PARU(2) + RMB=PMAS(5,1) + RMC=PMAS(4,1) + ALAM4=PARP(61) + IF(MSTU(112).LT.4) ALAM4=PARP(61)*(PARP(61)/RMC)**(2D0/25D0) + IF(MSTU(112).GT.4) ALAM4=PARP(61)*(RMB/PARP(61))**(2D0/25D0) + ALAM5=ALAM4*(ALAM4/RMB)**(2D0/23D0) + ALAM3=ALAM4*(RMC/ALAM4)**(2D0/27D0) +C...Optionally use Lambda_MC = Lambda_CMW + IF (MSTP(64).EQ.3) THEN + ALAM5 = ALAM5 * 1.569 + ALAM4 = ALAM4 * 1.618 + ALAM3 = ALAM3 * 1.661 + ENDIF + RMB2=RMB**2 + RMC2=RMC**2 +C...Massive quark forced creation threshold (in M**2). + TMIN=1.01D0 +C...Set upper limit for X (ensures some X left for beam remnant). + XMXC=1D0-2D0*PARP(111)/VINT(1) + + IF (MSTP(61).GE.1) THEN +C...Initial values: flavours, momenta, virtualities. + DO 100 JS=1,2 + NISGEN(JS,1)=0 + +C...Special kinematics check for c/b quarks (that g -> c cbar or +C...b bbar kinematically possible). + KFLB=K(IMI(JS,1,1),2) + KFLCB=IABS(KFLB) + IF(KFBEAM(JS).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5)) THEN +C...Check PT2MAX > mQ^2 + IF (VINT(56).LT.1.05D0*PMAS(PYCOMP(KFLCB),1)**2) THEN + CALL PYERRM(9,'(PYPTIS:) PT2MAX < 1.05 * MQ**2. '// + & 'No Q creation possible.') + MINT(51)=1 + RETURN + ELSE +C...Check for physical z values (m == MQ / sqrt(s)) +C...For creation diagram, x < z < (1-m)/(1+m(1-m)) + FMQ=PMAS(KFLCB,1)/SQRT(SHTNOW(1)) + ZMXCR=(1D0-FMQ)/(1D0+FMQ*(1D0-FMQ)) + IF (XMI(JS,1).GT.0.9D0*ZMXCR) THEN + CALL PYERRM(9,'(PYPTIS:) No physical z value for '// + & 'Q creation.') + MINT(51)=1 + RETURN + ENDIF + ENDIF + ENDIF + 100 CONTINUE + ENDIF + + MINT(354)=0 +C...Zero joining array + DO 110 MJ=1,240 + MJOIND(1,MJ)=0 + MJOIND(2,MJ)=0 + 110 CONTINUE + +C---------------------------------------------------------------------- +C...MODE= 0: Generate a trial branching on interaction MINT(36) side +C...MINT(30). Store if emission PT2 scale is largest so far. +C...Also generate test joinings if MSTP(96)=1. + ELSEIF(MODE.EQ.0) THEN + IFAIL=-1 + MECOR=0 + ISUB=MINT(1) + JS=MINT(30) +C...No shower for structureless beam + IF (MINT(44+JS).EQ.1) RETURN + MI=MINT(36) + SHAT=VINT(44) +C...Absolute shower max scale = VINT(56) + PT2=MIN(PT2NOW,VINT(56)) + IF (NISGEN(1,MI).EQ.0.AND.NISGEN(2,MI).EQ.0) SHTNOW(MI)=SHAT +C...Define for which processes ME corrections have been implemented. + IF(MSTP(68).EQ.1.OR.MSTP(68).EQ.3) THEN + IF(ISUB.EQ.1.OR.ISUB.EQ.2.OR.ISUB.EQ.141.OR.ISUB.EQ + & .142.OR.ISUB.EQ.144) MECOR=1 + IF(ISUB.EQ.102.OR.ISUB.EQ.152.OR.ISUB.EQ.157) MECOR=2 + IF(ISUB.EQ.3.OR.ISUB.EQ.151.OR.ISUB.EQ.156) MECOR=3 +C...Calculate preweighting factor for ME-corrected processes. + IF(MECOR.GE.1) CALL PYMEMX(MECOR,WTFF,WTGF,WTFG,WTGG) + ENDIF +C...Basic info on daughter for which to find mother. + KFLB=K(IMI(JS,MI,1),2) + KFLBA=IABS(KFLB) +C...KSVCB: -1 for sea or first companion, 0 for valence or gluon, >1 for +C...second companion. + KSVCB=MAX(-1,IMI(JS,MI,2)) +C...Treat "first" companion of a pair like an ordinary sea quark +C...(except that creation diagram is not allowed) + IF(IMI(JS,MI,2).GT.IMISEP(MI)) KSVCB=-1 +C...X (rescaled to [0,1]) + XB=XMI(JS,MI)/VINT(142+JS) +C...Massive quarks (use physical masses.) + RMQ2=0D0 + MQMASS=0 + IF (KFLBA.EQ.4.OR.KFLBA.EQ.5) THEN + RMQ2=RMC2 + IF (KFLBA.EQ.5) RMQ2=RMB2 +C...Special threshold treatment for non-photon beams + IF (KFBEAM(JS).NE.22) MQMASS=KFLBA + ENDIF + +C...Flags for parton distribution calls. + MINT(105)=MINT(102+JS) + MINT(109)=MINT(106+JS) + VINT(120)=VINT(2+JS) + +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... +C...Calculate initial parton distribution weights. + IF(XB.GE.XMXC) THEN + RETURN + ELSEIF(MQMASS.EQ.0) THEN + CALL PYPDFU(KFBEAM(JS),XB,PT2,XFB) + ELSE +C...Initialize massive quark PT2 dependent pdf underestimate. + PT20=PT2 + CALL PYPDFU(KFBEAM(JS),XB,PT20,XFB) +C.!.Tentative treatment of massive valence quarks. + XQ0=MAX(1D-10,XPSVC(KFLB,KSVCB)) + XG0=XFB(21) + TPM0=LOG(PT20/RMQ2) + WPDF0=TPM0*XG0/XQ0 + ENDIF + IF (KFLBA.LE.6) THEN +C...For quarks, only include respective sea, val, or cmp part. + IF (KSVCB.LE.0) THEN + XFB(KFLB)=XPSVC(KFLB,KSVCB) + ELSE +C...Find companion's companion + MISEA=0 + 120 MISEA=MISEA+1 + IF (IMI(JS,MISEA,2).NE.IMI(JS,MI,1)) GOTO 120 + XS=XMI(JS,MISEA) + XREM=VINT(142+JS) + YS=XS/(XREM+XS) +C...Momentum fraction of the companion quark. +C...Rescale from XB = x/XREM to YB = x/(1-Sum_rest) -> factor (1-YS). + YB=XB*(1D0-YS) + XFB(KFLB)=PYFCMP(YB/VINT(140),YS/VINT(140),MSTP(87)) + ENDIF + ENDIF + +C...Determine overestimated z range: switch at c and b masses. + 130 IF (PT2.GT.TMIN*RMB2) THEN + IZRG=3 + PT2MNE=MAX(TMIN*RMB2,PT2CUT) + B0=23D0/6D0 + ALAM2=ALAM5**2 + ELSEIF(PT2.GT.TMIN*RMC2) THEN + IZRG=2 + PT2MNE=MAX(TMIN*RMC2,PT2CUT) + B0=25D0/6D0 + ALAM2=ALAM4**2 + ELSE + IZRG=1 + PT2MNE=PT2CUT + B0=27D0/6D0 + ALAM2=ALAM3**2 + ENDIF +C...Divide Lambda by PARP(64) (equivalent to mult pT2 by PARP(64)) + ALAM2=ALAM2/PARP(64) +C...Overestimated ZMAX: + IF (MQMASS.EQ.0) THEN +C...Massless + ZMAX=1D0-0.5D0*(PT2MNE/SHTNOW(MI))*(SQRT(1D0+4D0*SHTNOW(MI) + & /PT2MNE)-1D0) + ELSE +C...Massive (limit for bremsstrahlung diagram > creation) + FMQ=SQRT(RMQ2/SHTNOW(MI)) + ZMAX=1D0/(1D0+FMQ) + ENDIF + ZMIN=XB/XMXC + +C...If kinematically impossible then do not evolve. + IF(PT2.LT.PT2CUT.OR.ZMAX.LE.ZMIN) RETURN + +C...Reset Altarelli-Parisi and PDF weights. + DO 140 KFL=-5,5 + WTAP(KFL)=0D0 + WTPDF(KFL)=0D0 + 140 CONTINUE + WTAP(21)=0D0 + WTPDF(21)=0D0 +C...Zero joining weights and compute X(partner) and X(mother) values. + IF (MSTP(96).NE.0) THEN + NJN=0 + DO 150 MJ=1,MINT(31) + WTAPJ(MJ)=0D0 + WTPDFJ(MJ)=0D0 + X1(MJ)=XMI(JS,MJ)/(VINT(142+JS)+XMI(JS,MJ)) + Y(MJ)=(XMI(JS,MI)+XMI(JS,MJ))/(VINT(142+JS)+XMI(JS,MJ) + & +XMI(JS,MI)) + 150 CONTINUE + ENDIF + +C...Approximate Altarelli-Parisi weights (integrated AP dz). +C...q -> q, g -> q or q -> q + gamma (already set which). + IF(KFLBA.LE.5) THEN +C...Val and cmp quarks get an extra sqrt(z) to smooth their bumps. + IF (KSVCB.LT.0) THEN + WTAP(KFLB)=(8D0/3D0)*LOG((1D0-ZMIN)/(1D0-ZMAX)) + ELSE + RMIN=(1+SQRT(ZMIN))/(1-SQRT(ZMIN)) + RMAX=(1+SQRT(ZMAX))/(1-SQRT(ZMAX)) + WTAP(KFLB)=(8D0/3D0)*LOG(RMAX/RMIN) + ENDIF + WTAP(21)=0.5D0*(ZMAX-ZMIN) + WTAPE=(2D0/9D0)*LOG((1D0-ZMIN)/(1D0-ZMAX)) + IF(MOD(KFLBA,2).EQ.0) WTAPE=4D0*WTAPE + IF(MECOR.GE.1.AND.NISGEN(JS,MI).EQ.0) THEN + WTAP(KFLB)=WTFF*WTAP(KFLB) + WTAP(21)=WTGF*WTAP(21) + WTAPE=WTFF*WTAPE + ENDIF + IF (KSVCB.GE.1) THEN +C...Kill normal creation but add joining diagrams for cmp quark. + WTAP(21)=0D0 + IF (KFLBA.EQ.4.OR.KFLBA.EQ.5) THEN + CALL PYERRM(9,'(PYPTIS:) Sorry, I got a heavy companion'// + & " quark here. Not handled yet, giving up!") + PT2=0D0 + MINT(51)=1 + RETURN + ENDIF +C...Check for possible joinings + IF (MSTP(96).NE.0.AND.MJOIND(JS,MI).EQ.0) THEN +C...Find companion's companion. + MJ=0 + 160 MJ=MJ+1 + IF (IMI(JS,MJ,2).NE.IMI(JS,MI,1)) GOTO 160 + IF (MJOIND(JS,MJ).EQ.0) THEN + Y(MI)=YB+YS + Z=YB/Y(MI) + WTAPJ(MJ)=Z*(1D0-Z)*0.5D0*(Z**2+(1D0-Z)**2) + IF (WTAPJ(MJ).GT.1D-6) THEN + NJN=1 + ELSE + WTAPJ(MJ)=0D0 + ENDIF + ENDIF +C...Add trial gluon joinings. + DO 170 MJ=1,MINT(31) + KFLC=K(IMI(JS,MJ,1),2) + IF (KFLC.NE.21.OR.MJOIND(JS,MJ).NE.0) GOTO 170 + Z=XMI(JS,MJ)/(XMI(JS,MI)+XMI(JS,MJ)) + WTAPJ(MJ)=6D0*(Z**2+(1D0-Z)**2) + IF (WTAPJ(MJ).GT.1D-6) THEN + NJN=NJN+1 + ELSE + WTAPJ(MJ)=0D0 + ENDIF + 170 CONTINUE + ENDIF + ELSEIF (IMI(JS,MI,2).GE.0) THEN +C...Kill creation diagram for val quarks and sea quarks with companions. + WTAP(21)=0D0 + ELSEIF (MQMASS.EQ.0) THEN +C...Extra safety factor for massless sea quark creation. + WTAP(21)=WTAP(21)*1.25D0 + ENDIF + +C... q -> g, g -> g. + ELSEIF(KFLB.EQ.21) THEN +C...Here we decide later whether a quark picked up is valence or +C...sea, so we maintain the extra factor sqrt(z) since we deal +C...with the *sum* of sea and valence in this context. + WTAPQ=(16D0/3D0)*(SQRT(1D0/ZMIN)-SQRT(1D0/ZMAX)) +C...new: do not allow backwards evol to pick up heavy flavour. + DO 180 KFL=1,MIN(3,MSTP(58)) + WTAP(KFL)=WTAPQ + WTAP(-KFL)=WTAPQ + 180 CONTINUE + WTAP(21)=6D0*LOG(ZMAX*(1D0-ZMIN)/(ZMIN*(1D0-ZMAX))) + IF(MECOR.GE.1.AND.NISGEN(JS,MI).EQ.0) THEN + WTAPQ=WTFG*WTAPQ + WTAP(21)=WTGG*WTAP(21) + ENDIF +C...Check for possible joinings (companions handled separately above) + IF (MSTP(96).NE.0.AND.MINT(31).GE.2.AND.MJOIND(JS,MI).EQ.0) + & THEN + DO 190 MJ=1,MINT(31) + IF (MJ.EQ.MI.OR.MJOIND(JS,MJ).NE.0) GOTO 190 + KSVCC=IMI(JS,MJ,2) + IF (IMI(JS,MJ,2).GT.IMISEP(MJ)) KSVCC=-1 + IF (KSVCC.GE.1) GOTO 190 + KFLC=K(IMI(JS,MJ,1),2) +C...Only try g -> g + g once. + IF (MJ.GT.MI.AND.KFLC.EQ.21) GOTO 190 + Z=XMI(JS,MJ)/(XMI(JS,MI)+XMI(JS,MJ)) + IF (KFLC.EQ.21) THEN + WTAPJ(MJ)=6D0*(Z**2+(1D0-Z)**2) + ELSE + WTAPJ(MJ)=Z*4D0/3D0*(1D0+Z**2) + ENDIF + IF (WTAPJ(MJ).GT.1D-6) THEN + NJN=NJN+1 + ELSE + WTAPJ(MJ)=0D0 + ENDIF + 190 CONTINUE + ENDIF + ENDIF + +C...Initialize massive quark evolution + IF (MQMASS.NE.0) THEN + RML=(RMQ2+VINT(18))/ALAM2 + TML=LOG(RML) + TPL=LOG((PT2+VINT(18))/ALAM2) + TPM=LOG((PT2+VINT(18))/RMQ2) + WN=WTAP(21)*WPDF0/B0 + ENDIF + + +C...Loopback point for iteration + NTRY=0 + NTHRES=0 + 200 NTRY=NTRY+1 + IF(NTRY.GT.500) THEN + CALL PYERRM(9,'(PYPTIS:) failed to evolve shower.') + MINT(51)=1 + RETURN + ENDIF + +C... Calculate PDF weights and sum for evolution rate. + WTSUM=0D0 + XFBO=MAX(1D-10,XFB(KFLB)) + DO 210 KFL=-5,5 + WTPDF(KFL)=XFB(KFL)/XFBO + WTSUM=WTSUM+WTAP(KFL)*WTPDF(KFL) + 210 CONTINUE +C...Only add gluon mother diagram for massless KFLB. + IF(MQMASS.EQ.0) THEN + WTPDF(21)=XFB(21)/XFBO + WTSUM=WTSUM+WTAP(21)*WTPDF(21) + ENDIF + WTSUM=MAX(0.0001D0,WTSUM) + WTSUMS=WTSUM +C...Add joining diagrams where applicable. + WTJOIN=0D0 + IF (MSTP(96).NE.0.AND.NJN.NE.0) THEN + DO 220 MJ=1,MINT(31) + IF (WTAPJ(MJ).LT.1D-3) GOTO 220 + WTPDFJ(MJ)=1D0/XFBO +C...x and x*pdf (+ sea/val) for parton C. + KFLC=K(IMI(JS,MJ,1),2) + KFLCA=IABS(KFLC) + KSVCC=MAX(-1,IMI(JS,MJ,2)) + IF (IMI(JS,MJ,2).GT.IMISEP(MJ)) KSVCC=-1 + MINT(30)=JS + MINT(36)=MJ +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + CALL PYPDFU(KFBEAM(JS),X1(MJ),PT2,XFJ) + MINT(36)=MI + IF (KFLCA.LE.6.AND.KSVCC.LE.0) THEN + XFJ(KFLC)=XPSVC(KFLC,KSVCC) + ELSEIF (KSVCC.GE.1) THEN + print*, 'error! parton C is companion!' + ENDIF + WTPDFJ(MJ)=WTPDFJ(MJ)/XFJ(KFLC) +C...x and x*pdf (+ sea/val) for parton A. + KFLA=21 + KSVCA=0 + IF (KFLCA.EQ.21.AND.KFLBA.LE.5) THEN + KFLA=KFLB + KSVCA=KSVCB + ELSEIF (KFLBA.EQ.21.AND.KFLCA.LE.5) THEN + KFLA=KFLC + KSVCA=KSVCC + ENDIF + MINT(30)=JS +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + IF (KSVCA.LE.0) THEN +C...Consider C the "evolved" parton if B is gluon. Val/sea +C...counting will then be done correctly in PYPDFU. + IF (KFLBA.EQ.21) MINT(36)=MJ + CALL PYPDFU(KFBEAM(JS),Y(MJ),PT2,XFJ) + MINT(36)=MI + IF (IABS(KFLA).LE.6) XFJ(KFLA)=XPSVC(KFLA,KSVCA) + ELSE +C...If parton A is companion, use Y(MI) and YS in call to PYFCMP. + XFJ(KFLA)=PYFCMP(Y(MI)/VINT(140),YS/VINT(140),MSTP(87)) + ENDIF + WTPDFJ(MJ)=XFJ(KFLA)*WTPDFJ(MJ) + WTJOIN=WTJOIN+WTAPJ(MJ)*WTPDFJ(MJ) + 220 CONTINUE + ENDIF + +C...Pick normal pT2 (in overestimated z range). + 230 PT2OLD=PT2 + WTSUM=WTSUMS + PT2=ALAM2*((PT2+VINT(18))/ALAM2)**(PYR(0)**(B0/WTSUM))-VINT(18) + KFLC=21 + +C...Evolve q -> q gamma separately, pick it if larger pT. + IF(KFLBA.LE.5) THEN + PT2QED=(PT2OLD+VINT(18))*PYR(0)**(1D0/(AEM2PI*WTAPE))-VINT(18) + IF(PT2QED.GT.PT2) THEN + PT2=PT2QED + KFLC=22 + KFLA=KFLB + ENDIF + ENDIF + +C... Evolve massive quark creation separately. + MCRQQ=0 + IF (MQMASS.NE.0) THEN + PT2CR=(RMQ2+VINT(18))*(RML**(TPM/(TPL*PYR(0)**(-TML/WN)-TPM))) + & -VINT(18) +C... Ensure mininimum PT2CR and force creation near threshold. + IF (PT2CR.LT.TMIN*RMQ2) THEN + NTHRES=NTHRES+1 + IF (NTHRES.GT.50) THEN + CALL PYERRM(9,'(PYPTIS:) no phase space left for '// + & 'massive quark creation. Gave up trying.') + MINT(51)=1 +C...Special return code if failing before any evolution at all: bad event + IF (NISGEN(1,MI).EQ.0.AND.NISGEN(2,MI).EQ.0) MINT(51)=2 + RETURN + ENDIF + PT2=0D0 + PT2CR=TMIN*RMQ2 + MCRQQ=2 + ENDIF +C... Select largest PT2 (brems or creation): + IF (PT2CR.GT.PT2) THEN + MCRQQ=MAX(MCRQQ,1) + WTSUM=0D0 + PT2=PT2CR + KFLA=21 + ELSE + MCRQQ=0 + KFLA=KFLB + ENDIF +C... Compute logarithms for this PT2 + TPL=LOG((PT2+VINT(18))/ALAM2) + TPM=LOG((PT2+VINT(18))/(RMQ2+VINT(18))) + WTCRQQ=TPM/LOG(PT2/RMQ2) + ENDIF + +C...Evolve joining separately + MJOIN=0 + IF (MSTP(96).NE.0.AND.NJN.NE.0) THEN + PT2JN=ALAM2*((PT2OLD+VINT(18))/ALAM2)**(PYR(0)**(B0/WTJOIN)) + & -VINT(18) + IF (PT2JN.GE.PT2) THEN + MJOIN=1 + PT2=PT2JN + ENDIF + ENDIF + +C...Loopback if crossed c/b mass thresholds. + IF(IZRG.EQ.3.AND.PT2.LT.RMB2) THEN + PT2=RMB2 + GOTO 130 + ELSEIF(IZRG.EQ.2.AND.PT2.LT.RMC2) THEN + PT2=RMC2 + GOTO 130 + ENDIF + +C...Speed up shower. Skip if higher-PT acceptable branching +C...already found somewhere else. +C...Also finish if below lower cutoff. + + IF (PT2.LT.PT2MX.OR.PT2.LT.PT2CUT) RETURN + +C...Select parton A flavour (massive Q handled above.) + IF (MQMASS.EQ.0.AND.KFLC.NE.22.AND.MJOIN.EQ.0) THEN + WTRAN=PYR(0)*WTSUM + KFLA=-6 + 240 KFLA=KFLA+1 + WTRAN=WTRAN-WTAP(KFLA)*WTPDF(KFLA) + IF(KFLA.LE.5.AND.WTRAN.GT.0D0) GOTO 240 + IF(KFLA.EQ.6) KFLA=21 + ELSEIF (MJOIN.EQ.1) THEN +C...Tentative joining accept/reject. + WTRAN=PYR(0)*WTJOIN + MJ=0 + 250 MJ=MJ+1 + WTRAN=WTRAN-WTAPJ(MJ)*WTPDFJ(MJ) + IF(MJ.LE.MINT(31)-1.AND.WTRAN.GT.0D0) GOTO 250 + IF(MJOIND(JS,MJ).NE.0.OR.MJOIND(JS,MI).NE.0) THEN + CALL PYERRM(9,'(PYPTIS:) Attempted double joining.'// + & ' Rejected.') + GOTO 230 + ENDIF +C...x*pdf (+ sea/val) at new pT2 for parton B. + IF (KSVCB.LE.0) THEN + MINT(30)=JS +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + CALL PYPDFU(KFBEAM(JS),XB,PT2,XFB) + IF (KFLBA.LE.6) XFB(KFLB)=XPSVC(KFLB,KSVCB) + ELSE +C...Companion distributions do not evolve. + XFB(KFLB)=XFBO + ENDIF + WTVETO=1D0/WTPDFJ(MJ)/XFB(KFLB) + KFLC=K(IMI(JS,MJ,1),2) + KFLCA=IABS(KFLC) + KSVCC=MAX(-1,IMI(JS,MJ,2)) + IF (KSVCB.GE.1) KSVCC=-1 +C...x*pdf (+ sea/val) at new pT2 for parton C. + MINT(30)=JS + MINT(36)=MJ +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + CALL PYPDFU(KFBEAM(JS),X1(MJ),PT2,XFJ) + MINT(36)=MI + IF (KFLCA.LE.6.AND.KSVCC.LE.0) XFJ(KFLC)=XPSVC(KFLC,KSVCC) + WTVETO=WTVETO/XFJ(KFLC) +C...x and x*pdf (+ sea/val) at new pT2 for parton A. + KFLA=21 + KSVCA=0 + IF (KFLCA.EQ.21.AND.KFLBA.LE.5) THEN + KFLA=KFLB + KSVCA=KSVCB + ELSEIF (KFLBA.EQ.21.AND.KFLCA.LE.5) THEN + KFLA=KFLC + KSVCA=KSVCC + ENDIF + IF (KSVCA.LE.0) THEN + MINT(30)=JS +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + IF (KFLB.EQ.21) MINT(36)=MJ + CALL PYPDFU(KFBEAM(JS),Y(MJ),PT2,XFJ) + MINT(36)=MI + IF (IABS(KFLA).LE.6) XFJ(KFLA)=XPSVC(KFLA,KSVCA) + ELSE + XFJ(KFLA)=PYFCMP(Y(MJ)/VINT(140),YS/VINT(140),MSTP(87)) + ENDIF + WTVETO=WTVETO*XFJ(KFLA) +C...Monte Carlo veto. + IF (WTVETO.LT.PYR(0)) GOTO 200 +C...If accept, save PT2 of this joining. + IF (PT2.GT.PT2MX) THEN + PT2MX=PT2 + JSMX=2+JS + MJN1MX=MJ + MJN2MX=MI + WTAPJ(MJ)=0D0 + NJN=0 + ENDIF +C...Exit and continue evolution. + GOTO 390 + ENDIF + KFLAA=IABS(KFLA) + +C...Choose z value (still in overestimated range) and corrective weight. +C...Unphysical z will be rejected below when Q2 has is computed. + WTZ=0D0 + +C...Note: ME and MQ>0 give corrections to overall weights, not shapes. +C...q -> q + g or q -> q + gamma (already set which). + IF (KFLAA.LE.5.AND.KFLBA.LE.5) THEN + IF (KSVCB.LT.0) THEN + Z=1D0-(1D0-ZMIN)*((1D0-ZMAX)/(1D0-ZMIN))**PYR(0) + ELSE + ZFAC=RMIN*(RMAX/RMIN)**PYR(0) + Z=((1-ZFAC)/(1+ZFAC))**2 + ENDIF + WTZ=0.5D0*(1D0+Z**2) +C...Massive weight correction. + IF (KFLBA.GE.4) WTZ=WTZ-Z*(1D0-Z)**2*RMQ2/PT2 +C...Valence quark weight correction (extra sqrt) + IF (KSVCB.GE.0) WTZ=WTZ*SQRT(Z) + +C...q -> g + q. +C...NB: MQ>0 not yet implemented. Forced absent above. + ELSEIF (KFLAA.LE.5.AND.KFLB.EQ.21) THEN + KFLC=KFLA + Z=ZMAX/(1D0+PYR(0)*(SQRT(ZMAX/ZMIN)-1D0))**2 + WTZ=0.5D0*(1D0+(1D0-Z)**2)*SQRT(Z) + +C...g -> q + qbar. + ELSEIF (KFLA.EQ.21.AND.KFLBA.LE.5) THEN + KFLC=-KFLB + Z=ZMIN+PYR(0)*(ZMAX-ZMIN) + WTZ=Z**2+(1D0-Z)**2 +C...Massive correction + IF (MQMASS.NE.0) THEN + WTZ=WTZ+2D0*Z*(1D0-Z)*RMQ2/PT2 +C...Extra safety margin for light sea quark creation + ELSEIF (KSVCB.LT.0) THEN + WTZ=WTZ/1.25D0 + ENDIF + +C...g -> g + g. + ELSEIF (KFLA.EQ.21.AND.KFLB.EQ.21) THEN + KFLC=21 + Z=1D0/(1D0+((1D0-ZMIN)/ZMIN)*((1D0-ZMAX)*ZMIN/ + & (ZMAX*(1D0-ZMIN)))**PYR(0)) + WTZ=(1D0-Z*(1D0-Z))**2 + ENDIF + +C...Derive Q2 from pT2. + Q2B=PT2/(1D0-Z) + IF (KFLBA.GE.4) Q2B=Q2B-RMQ2 + +C...Loopback if outside allowed z range for given pT2. + RM2C=PYMASS(KFLC)**2 + PT2ADJ=Q2B-Z*(SHTNOW(MI)+Q2B)*(Q2B+RM2C)/SHTNOW(MI) + IF (PT2ADJ.LT.1D-6) GOTO 230 + +C...Size of phase space and coherence suppression: MSTP(67) and MSTP(62) +C...No modification for very first emission if using ME correction + MSTP67 = MSTP(67) + IF (MECOR.GE.1.AND.NISGEN(1,MI).EQ.0.AND.NISGEN(2,MI).EQ.0) THEN + MSTP67 = 0 + ENDIF + +C...For 1st branching, limit phase space by s-hat with color-partner + IF (MSTP67.GE.1.AND.NISGEN(JS,MI).EQ.0) THEN + MSIDE=1 + IDIP=IMI(JS,MI,1) +C...Use anticolor tag for antiquark, or for gluon half the time + IF ((KFLB.LT.0.AND.KFLBA.LT.10).OR.( + & KFLB.EQ.21.AND.PYR(0).GT.0.5)) MSIDE=2 +C...Tag + MCTAG=MCT(IDIP,MSIDE) +C...Default is to set up phase space using the opposite incoming parton + JDIP=IMI(3-JS,MI,1) + NDIP=0 +C...Alternatively, look for final-state color partner (pick first if several) + DO 260 IFS=1,NPART + IF (MCT(IPART(IFS),MSIDE).EQ.MCTAG.AND.NDIP.EQ.0) THEN + JDIP=IPART(IFS) + NDIP=NDIP+1 + ENDIF + 260 CONTINUE +C...Compute mass of pair + SDIP=(P(IDIP,4)+P(JDIP,4))**2-(P(IDIP,3)+P(JDIP,3))**2 + & -(P(IDIP,2)+P(JDIP,2))**2-(P(IDIP,1)+P(JDIP,1))**2 + IF (MSTP67.EQ.1) THEN +C...1 Option to completely kill radiation above s_dip * PARP(67) + IF (4*PT2.GT.PARP(67)*SDIP) GOTO 230 + ELSE IF (MSTP67.EQ.2) THEN +C...2 Option to allow suppressed unordered radiation above s_dip * PARP(67) +C... (-> improved power showers?) + IF (4*PT2*PYR(0).GT.PARP(67)*SDIP) GOTO 230 + ENDIF + +C...For subsequent branchings, loopback if nonordered in angle/rapidity + ELSE IF (MSTP(62).GE.3.AND.NISGEN(JS,MI).GE.1) THEN + IF(PT2.GT.((1D0-Z)/(Z*(1D0-ZSAV(JS,MI))))**2*PT2SAV(JS,MI)) + & GOTO 230 + ENDIF + +C...Select phi angle of branching at random. + PHI=PARU(2)*PYR(0) + +C...Matrix-element corrections for some processes. + IF (MECOR.GE.1.AND.NISGEN(JS,MI).EQ.0) THEN + IF (KFLAA.LE.20.AND.KFLBA.LE.20) THEN + CALL PYMEWT(MECOR,1,Q2B*SHAT/SHTNOW(MI),Z,PHI,WTME) + WTZ=WTZ*WTME/WTFF + ELSEIF((KFLA.EQ.21.OR.KFLA.EQ.22).AND.KFLBA.LE.20) THEN + CALL PYMEWT(MECOR,2,Q2B*SHAT/SHTNOW(MI),Z,PHI,WTME) + WTZ=WTZ*WTME/WTGF + ELSEIF(KFLAA.LE.20.AND.(KFLB.EQ.21.OR.KFLB.EQ.22)) THEN + CALL PYMEWT(MECOR,3,Q2B*SHAT/SHTNOW(MI),Z,PHI,WTME) + WTZ=WTZ*WTME/WTFG + ELSEIF(KFLA.EQ.21.AND.KFLB.EQ.21) THEN + CALL PYMEWT(MECOR,4,Q2B*SHAT/SHTNOW(MI),Z,PHI,WTME) + WTZ=WTZ*WTME/WTGG + ENDIF + ENDIF + +C...Parton distributions at new pT2 but old x. + MINT(30)=JS +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + CALL PYPDFU(KFBEAM(JS),XB,PT2,XFN) +C...Treat val and cmp separately + IF (KFLBA.LE.6.AND.KSVCB.LE.0) XFN(KFLB)=XPSVC(KFLB,KSVCB) + IF (KSVCB.GE.1) + & XFN(KFLB)=PYFCMP(YB/VINT(140),YS/VINT(140),MSTP(87)) + XFBN=XFN(KFLB) + IF(XFBN.LT.1D-20) THEN + IF(KFLA.EQ.KFLB) THEN + WTAP(KFLB)=0D0 + GOTO 200 + ELSE + XFBN=1D-10 + XFN(KFLB)=XFBN + ENDIF + ENDIF + DO 270 KFL=-5,5 + XFB(KFL)=XFN(KFL) + 270 CONTINUE + XFB(21)=XFN(21) + +C...Parton distributions at new pT2 and new x. + XA=XB/Z + MINT(30)=JS +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + CALL PYPDFU(KFBEAM(JS),XA,PT2,XFA) + IF (KFLBA.LE.5.AND.KFLAA.LE.5) THEN +C...q -> q + g: only consider respective sea, val, or cmp content. + IF (KSVCB.LE.0) THEN + XFA(KFLA)=XPSVC(KFLA,KSVCB) + ELSE + YA=XA*(1D0-YS) + XFA(KFLB)=PYFCMP(YA/VINT(140),YS/VINT(140),MSTP(87)) + ENDIF + ENDIF + XFAN=XFA(KFLA) + IF(XFAN.LT.1D-20) THEN + GOTO 200 + ENDIF + +C...If weighting fails continue evolution. + WTTOT=0D0 + IF (MCRQQ.EQ.0) THEN + WTPDFA=1D0/WTPDF(KFLA) + WTTOT=WTZ*XFAN/XFBN*WTPDFA + ELSEIF(MCRQQ.EQ.1) THEN + WTPDFA=TPM/WPDF0 + WTTOT=WTCRQQ*WTZ*XFAN/XFBN*WTPDFA + XBEST=TPM/TPM0*XQ0 + ELSEIF(MCRQQ.EQ.2) THEN +C...Force massive quark creation. + WTTOT=1D0 + ENDIF + +C...Loop back if trial emission fails. + IF(WTTOT.GE.0D0.AND.WTTOT.LT.PYR(0)) GOTO 200 + WTACC=((1D0+PT2)/(0.25D0+PT2))**2 + IF(WTTOT.LT.0D0) THEN + WRITE(CHWT,'(1P,E12.4)') WTTOT + CALL PYERRM(19,'(PYPTIS:) Weight '//CHWT//' negative') + ELSEIF(WTTOT.GT.WTACC) THEN + WRITE(CHWT,'(1P,E12.4)') WTTOT + IF (PT2.GT.PTEMAX.OR.WTTOT.GE.WTEMAX) THEN +C...Too high weight: write out as error, but do not update error counter + IF(MSTU(29).EQ.0) MSTU(23)=MSTU(23)-1 + CALL PYERRM(19, + & '(PYPTIS:) Weight '//CHWT//' above unity') + IF (PT2.GT.PTEMAX) PTEMAX=PT2 + IF (WTTOT.GT.WTEMAX) WTEMAX=WTTOT + ELSE + CALL PYERRM(9, + & '(PYPTIS:) Weight '//CHWT//' above unity') + ENDIF +C...Useful for debugging but commented out for distribution: +C print*, 'JS, MI',JS, MI +C print*, 'PT:',SQRT(PT2), ' MCRQQ',MCRQQ +C print*, 'A -> B C',KFLA, KFLB, KFLC +C XFAO=XFBO/WTPDFA +C print*, 'WT(Z,XFA,XFB)',WTZ, XFAN/XFAO, XFBO/XFBN + ENDIF + +C...Save acceptable branching. + IF(PT2.GT.PT2MX) THEN + MIMX=MINT(36) + JSMX=JS + PT2MX=PT2 + KFLAMX=KFLA + KFLCMX=KFLC + RM2CMX=RM2C + Q2BMX=Q2B + ZMX=Z + PT2AMX=PT2ADJ + PHIMX=PHI + ENDIF + +C---------------------------------------------------------------------- +C...MODE= 1: Accept stored shower branching. Update event record etc. + ELSEIF (MODE.EQ.1) THEN + MI=MIMX + JS=JSMX + SHAT=SHTNOW(MI) + SIDE=3D0-2D0*JS +C...Shift down rest of event record to make room for insertion. + IT=IMISEP(MI)+1 + IM=IT+1 + IS=IMI(JS,MI,1) + DO 290 I=N,IT,-1 + IF (K(I,3).GE.IT) K(I,3)=K(I,3)+2 + KT1=K(I,4)/MSTU(5)**2 + KT2=K(I,5)/MSTU(5)**2 + ID1=MOD(K(I,4),MSTU(5)) + ID2=MOD(K(I,5),MSTU(5)) + IM1=MOD(K(I,4)/MSTU(5),MSTU(5)) + IM2=MOD(K(I,5)/MSTU(5),MSTU(5)) + IF (ID1.GE.IT) ID1=ID1+2 + IF (ID2.GE.IT) ID2=ID2+2 + IF (IM1.GE.IT) IM1=IM1+2 + IF (IM2.GE.IT) IM2=IM2+2 + K(I,4)=KT1*MSTU(5)**2+IM1*MSTU(5)+ID1 + K(I,5)=KT2*MSTU(5)**2+IM2*MSTU(5)+ID2 + DO 280 IX=1,5 + K(I+2,IX)=K(I,IX) + P(I+2,IX)=P(I,IX) + V(I+2,IX)=V(I,IX) + 280 CONTINUE + MCT(I+2,1)=MCT(I,1) + MCT(I+2,2)=MCT(I,2) + 290 CONTINUE + N=N+2 +C...Also update shifted-down pointers in IMI, IMISEP, and IPART. + DO 300 JI=1,MINT(31) + IF (IMI(1,JI,1).GE.IT) IMI(1,JI,1)=IMI(1,JI,1)+2 + IF (IMI(1,JI,2).GE.IT) IMI(1,JI,2)=IMI(1,JI,2)+2 + IF (IMI(2,JI,1).GE.IT) IMI(2,JI,1)=IMI(2,JI,1)+2 + IF (IMI(2,JI,2).GE.IT) IMI(2,JI,2)=IMI(2,JI,2)+2 + IF (JI.GE.MI) IMISEP(JI)=IMISEP(JI)+2 +C...Also update companion pointers to the present mother. + IF (IMI(JS,JI,2).EQ.IS) IMI(JS,JI,2)=IM + 300 CONTINUE + DO 310 IFS=1,NPART + IF (IPART(IFS).GE.IT) IPART(IFS)=IPART(IFS)+2 + 310 CONTINUE +C...Zero entries dedicated for new timelike and mother partons. + DO 330 I=IT,IT+1 + DO 320 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 320 CONTINUE + MCT(I,1)=0 + MCT(I,2)=0 + 330 CONTINUE + +C...Define timelike and new mother partons. History. + K(IT,1)=3 + K(IT,2)=KFLCMX + K(IM,1)=14 + K(IM,2)=KFLAMX + K(IS,3)=IM + K(IT,3)=IM +C...Set mother origin = side. + K(IM,3)=MINT(83)+JS+2 + IF(MI.GE.2) K(IM,3)=MINT(83)+JS + +C...Define colour flow of branching. + IM1=IM + IM2=IM +C...q -> q + gamma. + IF(K(IT,2).EQ.22) THEN + K(IT,1)=1 + ID1=IS + ID2=IS +C...q -> q + g. + ELSEIF(K(IM,2).GT.0.AND.K(IM,2).LE.5.AND.K(IT,2).EQ.21) THEN + ID1=IT + ID2=IS +C...q -> g + q. + ELSEIF(K(IM,2).GT.0.AND.K(IM,2).LE.5) THEN + ID1=IS + ID2=IT +C...qbar -> qbar + g. + ELSEIF(K(IM,2).LT.0.AND.K(IM,2).GE.-5.AND.K(IT,2).EQ.21) THEN + ID1=IS + ID2=IT +C...qbar -> g + qbar. + ELSEIF(K(IM,2).LT.0.AND.K(IM,2).GE.-5) THEN + ID1=IT + ID2=IS +C...g -> g + g; g -> q + qbar.. + ELSEIF((K(IT,2).EQ.21.AND.PYR(0).GT.0.5D0).OR.K(IT,2).LT.0) THEN + ID1=IS + ID2=IT + ELSE + ID1=IT + ID2=IS + ENDIF + IF(IM1.EQ.IM) K(IM1,4)=K(IM1,4)+ID1 + IF(IM2.EQ.IM) K(IM2,5)=K(IM2,5)+ID2 + K(ID1,4)=K(ID1,4)+MSTU(5)*IM1 + K(ID2,5)=K(ID2,5)+MSTU(5)*IM2 + IF(ID1.NE.ID2) THEN + K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 + K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 + ENDIF + IF(K(IT,1).EQ.1) THEN + K(IT,4)=0 + K(IT,5)=0 + ENDIF +C...Update IMI and colour tag arrays. + IMI(JS,MI,1)=IM + DO 340 MC=1,2 + MCT(IT,MC)=0 + MCT(IM,MC)=0 + 340 CONTINUE + DO 350 JCS=4,5 + KCS=JCS +C...If mother flag not yet set for spacelike parton, trace it. + IF (K(IS,KCS)/MSTU(5)**2.LE.1) CALL PYCTTR(IS,-KCS,IM) + IF(MINT(51).NE.0) RETURN + 350 CONTINUE + DO 360 JCS=4,5 + KCS=JCS +C...If mother flag not yet set for timelike parton, trace it. + IF (K(IT,KCS)/MSTU(5)**2.LE.1) CALL PYCTTR(IT,KCS,IM) + IF(MINT(51).NE.0) RETURN + 360 CONTINUE + +C...Boost recoiling parton to compensate for Q2 scale. + BETAZ=SIDE*(1D0-(1D0+Q2BMX/SHAT)**2)/ + & (1D0+(1D0+Q2BMX/SHAT)**2) + IR=IMI(3-JS,MI,1) + CALL PYROBO(IR,IR,0D0,0D0,0D0,0D0,BETAZ) + +C...Define system to be rotated and boosted +C...(not including the 2 just added partons) +C...(but including the docu lines for first interaction) + IMIN=IMISEP(MI-1)+1 + IF (MI.EQ.1) IMIN=MINT(83)+5 + IMAX=IMISEP(MI)-2 + +C...Rotate back system in phi to compensate for subsequent rotation. + CALL PYROBO(IMIN,IMAX,0D0,-PHIMX,0D0,0D0,0D0) + +C...Define kinematics of new partons in old frame. + IMAX=IMISEP(MI) + P(IM,1)=SQRT(PT2AMX)*SHAT/(ZMX*(SHAT+Q2BMX)) + P(IM,3)=0.5D0*SQRT(SHAT)*((SHAT-Q2BMX)/((SHAT + & +Q2BMX)*ZMX)+(Q2BMX+RM2CMX)/SHAT)*SIDE + P(IM,4)=SQRT(P(IM,1)**2+P(IM,3)**2) + P(IT,1)=P(IM,1) + P(IT,3)=P(IM,3)-0.5D0*(SHAT+Q2BMX)/SQRT(SHAT)*SIDE + P(IT,4)=SQRT(P(IT,1)**2+P(IT,3)**2+RM2CMX) + P(IT,5)=SQRT(RM2CMX) + +C...Update internal line, now spacelike + P(IS,1)=P(IM,1)-P(IT,1) + P(IS,2)=P(IM,2)-P(IT,2) + P(IS,3)=P(IM,3)-P(IT,3) + P(IS,4)=P(IM,4)-P(IT,4) + P(IS,5)=P(IS,4)**2-P(IS,1)**2-P(IS,2)**2-P(IS,3)**2 +C...Represent spacelike virtualities as -sqrt(abs(Q2)) . + IF (P(IS,5).LT.0D0) THEN + P(IS,5)=-SQRT(ABS(P(IS,5))) + ELSE + P(IS,5)=SQRT(P(IS,5)) + ENDIF + +C...Boost entire system and rotate to new frame. +C...(including docu lines) + BETAX=(P(IM,1)+P(IR,1))/(P(IM,4)+P(IR,4)) + BETAZ=(P(IM,3)+P(IR,3))/(P(IM,4)+P(IR,4)) + IF(BETAX**2+BETAZ**2.GE.1D0) THEN + CALL PYERRM(1,'(PYPTIS:) boost bigger than unity') + MINT(51)=1 + IFAIL=-1 + RETURN + ENDIF + CALL PYROBO(IMIN,IMAX,0D0,0D0,-BETAX,0D0,-BETAZ) + I1=IMI(1,MI,1) + THETA=PYANGL(P(I1,3),P(I1,1)) + CALL PYROBO(IMIN,IMAX,-THETA,PHIMX,0D0,0D0,0D0) + +C...Global statistics. + MINT(352)=MINT(352)+1 + VINT(352)=VINT(352)+SQRT(P(IT,1)**2+P(IT,2)**2) + IF (MINT(352).EQ.1) VINT(357)=SQRT(P(IT,1)**2+P(IT,2)**2) + +C...Add parton with relevant pT scale for timelike shower. + IF (K(IT,2).NE.22) THEN + NPART=NPART+1 + IPART(NPART)=IT + PTPART(NPART)=SQRT(PT2AMX) + ENDIF + +C...Update saved variables. + SHTNOW(MIMX)=SHTNOW(MIMX)/ZMX + NISGEN(JSMX,MIMX)=NISGEN(JSMX,MIMX)+1 + XMI(JSMX,MIMX)=XMI(JSMX,MIMX)/ZMX + PT2SAV(JSMX,MIMX)=PT2MX + ZSAV(JS,MIMX)=ZMX + + KSA=IABS(K(IS,2)) + KMA=IABS(K(IM,2)) + IF (KSA.EQ.21.AND.KMA.GE.1.AND.KMA.LE.5) THEN +C...Gluon reconstructs to quark. +C...Decide whether newly created quark is valence or sea: + MINT(30)=JS + CALL PYPTMI(2,PT2NOW,PTDUM1,PTDUM2,IFAIL) + IF(MINT(51).NE.0) RETURN + ENDIF + IF(KSA.GE.1.AND.KSA.LE.5.AND.KMA.EQ.21) THEN +C...Quark reconstructs to gluon. +C...Now some guy may have lost his companion. Check. + ICMP=IMI(JS,MI,2) + IF (ICMP.GT.0) THEN + CALL PYERRM(9,'(PYPTIS:) Sorry, companion quark radiated' + & //' away. Cannot handle that yet. Giving up.') + MINT(51)=1 + RETURN + ELSEIF(ICMP.LT.0) THEN +C...A sea quark with companion still in BR was reconstructed to a gluon. +C...Companion should now be removed from the beam remnant. +C...(Momentum integral is automatically updated in next call to PYPDFU.) + ICMP=-ICMP + IFL=-K(IS,2) + DO 380 JCMP=ICMP,NVC(JS,IFL)-1 + XASSOC(JS,IFL,JCMP)=XASSOC(JS,IFL,JCMP+1) + DO 370 JI=1,MINT(31) + KMI=-IMI(JS,JI,2) + JFL=-K(IMI(JS,JI,1),2) + IF (KMI.EQ.JCMP+1.AND.JFL.EQ.IFL) IMI(JS,JI,2)=IMI(JS,JI + & ,2)+1 + 370 CONTINUE + 380 CONTINUE + NVC(JS,IFL)=NVC(JS,IFL)-1 + ENDIF +C...Set gluon IMI(JS,MI,2) = 0. + IMI(JS,MI,2)=0 + ELSEIF(KSA.GE.1.AND.KSA.LE.5.AND.KMA.NE.21) THEN +C...Quark reconstructing to quark. If sea with companion still in BR +C...then update associated x value. +C...(Momentum integral is automatically updated in next call to PYPDFU.) + IF (IMI(JS,MI,2).LT.0) THEN + ICMP=-IMI(JS,MI,2) + IFL=-K(IS,2) + XASSOC(JS,IFL,ICMP)=XMI(JSMX,MIMX) + ENDIF + ENDIF + + ENDIF + +C...If reached this point, normal exit. + 390 IFAIL=0 + + RETURN + END + +C********************************************************************* + +C...PYMEMX +C...Generates maximum ME weight in some initial-state showers. +C...Inparameter MECOR: kind of hard scattering process +C...Outparameter WTFF: maximum weight for fermion -> fermion +C... WTGF: maximum weight for gluon/photon -> fermion +C... WTFG: maximum weight for fermion -> gluon/photon +C... WTGG: maximum weight for gluon -> gluon + + SUBROUTINE PYMEMX(MECOR,WTFF,WTGF,WTFG,WTGG) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/,/PYINT2/ + +C...Default maximum weight. + WTFF=1D0 + WTGF=1D0 + WTFG=1D0 + WTGG=1D0 + +C...Select maximum weight by process. + IF(MECOR.EQ.1) THEN + WTFF=1D0 + WTGF=3D0 + ELSEIF(MECOR.EQ.2) THEN + WTFG=1D0 + WTGG=1D0 + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYMEWT +C...Calculates actual ME weight in some initial-state showers. +C...Inparameter MECOR: kind of hard scattering process +C... IFLCB: flavour combination of branching, +C... 1 for fermion -> fermion, +C... 2 for gluon/photon -> fermion +C... 3 for fermion -> gluon/photon, +C... 4 for gluon -> gluon +C... Q2: Q2 value of shower branching +C... Z: Z value of branching +C...In+outparameter PHIBR: azimuthal angle of branching +C...Outparameter WTME: actual ME weight + + SUBROUTINE PYMEWT(MECOR,IFLCB,Q2,Z,PHIBR,WTME) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/,/PYINT2/ + +C...Default output. + WTME=1D0 + +C...Define kinematics of shower branching in Mandelstam variables. + SQM=VINT(44) + SH=SQM/Z + TH=-Q2 + UH=Q2-SQM*(1D0-Z)/Z + +C...Matrix-element corrections for f + fbar -> s-channel vector boson. + IF(MECOR.EQ.1) THEN + IF(IFLCB.EQ.1) THEN + WTME=(TH**2+UH**2+2D0*SQM*SH)/(SH**2+SQM**2) + ELSEIF(IFLCB.EQ.2) THEN + WTME=(SH**2+TH**2+2D0*SQM*UH)/((SH-SQM)**2+SQM**2) + ENDIF + +C...Matrix-element corrections for g + g -> Higgs (h0, H0, A0). + ELSEIF(MECOR.EQ.2) THEN + IF(IFLCB.EQ.3) THEN + WTME=(SH**2+UH**2)/(SH**2+(SH-SQM)**2) + ELSEIF(IFLCB.EQ.4) THEN + WTME=0.5D0*(SH**4+UH**4+TH**4+SQM**4)/(SH**2-SQM*(SH-SQM))**2 + ENDIF + +C...Matrix-element corrections for q + qbar -> Higgs (h0) + ELSEIF(MECOR.EQ.3) THEN + IF(IFLCB.EQ.2) THEN + WTME=(SH**2+TH**2+2D0*(SQM-TH)*(SQM-SH))/ + 1 (SH**2+2D0*SQM*(SQM-SH)) + ENDIF + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYPTMI +C...Handles the generation of additional interactions in the new +C...multiple interactions framework. +C...MODE=-1 : Initalize MI from scratch. +C...MODE= 0 : Generate trial interaction. Start at PT2NOW, solve +C... Sudakov for PT2, abort if below PT2CUT. +C...MODE= 1 : Accept interaction at PT2NOW and store variables. +C...MODE= 2 : Decide sea/val/cmp for kicked-out quark at PT2NOW +C...PT2NOW : Starting (max) PT2 scale for evolution. +C...PT2CUT : Lower limit for evolution. +C...PT2 : Result of evolution. Generated PT2 for trial interaction. +C...IFAIL : Status return code. +C... = 0: All is well. +C... < 0: Phase space exhausted, generation to be terminated. +C... > 0: Additional interaction vetoed, but continue evolution. + + SUBROUTINE PYPTMI(MODE,PT2NOW,PT2CUT,PT2,IFAIL) +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement for maximum size of showers. + PARAMETER (MAXNUR=1000) +C...Commonblocks. + COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR) + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINT7/SIGT(0:6,0:6,0:5) + COMMON/PYINTM/KFIVAL(2,3),NMI(2),IMI(2,800,2),NVC(2,-6:6), + & XASSOC(2,-6:6,240),XPSVC(-6:6,-1:240),PVCTOT(2,-1:1), + & XMI(2,240),PT2MI(240),IMISEP(0:240) + COMMON/PYISMX/MIMX,JSMX,KFLAMX,KFLCMX,KFBEAM(2),NISGEN(2,240), + & PT2MX,PT2AMX,ZMX,RM2CMX,Q2BMX,PHIMX + COMMON/PYCTAG/NCT,MCT(4000,2) +C...Local arrays and saved variables. + DIMENSION WDTP(0:400),WDTE(0:400,0:5),XPQ(-25:25) + + SAVE /PYPART/,/PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/, + & /PYINT1/,/PYINT2/,/PYINT3/,/PYINT5/,/PYINT7/,/PYINTM/, + & /PYISMX/,/PYCTAG/ + SAVE XT2FAC,SIGS + + IFAIL=0 +C...Set MI subprocess = QCD 2 -> 2. + ISUB=96 + +C---------------------------------------------------------------------- +C...MODE=-1: Initialize from scratch + IF (MODE.EQ.-1) THEN +C...Initialize PT2 array. + PT2MI(1)=VINT(54) +C...Initialize list of incoming beams and partons from two sides. + DO 110 JS=1,2 + DO 100 MI=1,240 + IMI(JS,MI,1)=0 + IMI(JS,MI,2)=0 + 100 CONTINUE + NMI(JS)=1 + IMI(JS,1,1)=MINT(84)+JS + IMI(JS,1,2)=0 + XMI(JS,1)=VINT(40+JS) +C...Rescale x values to fractions of photon energy. + IF(MINT(18+JS).EQ.1) XMI(JS,1)=VINT(40+JS)/VINT(154+JS) +C...Hard reset: hard interaction initiators motherless by definition. + K(MINT(84)+JS,3)=2+JS + K(MINT(84)+JS,4)=MOD(K(MINT(84)+JS,4),MSTU(5)) + K(MINT(84)+JS,5)=MOD(K(MINT(84)+JS,5),MSTU(5)) + 110 CONTINUE + IMISEP(0)=MINT(84) + IMISEP(1)=N + IF (MOD(MSTP(81),10).GE.1) THEN + IF(MSTP(82).LE.1) THEN + SIGRAT=XSEC(ISUB,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0 + & ,5)) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* + & VINT(317)/(VINT(318)*VINT(320)) + XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) + ELSE + XT2FAC=VINT(146)*VINT(148)*XSEC(ISUB,1)/ + & MAX(1D-10,SIGT(0,0,5))*VINT(149)*(1D0+VINT(149)) + ENDIF + ENDIF +C...Zero entries relating to scatterings beyond the first. + DO 120 MI=2,240 + IMI(1,MI,1)=0 + IMI(2,MI,1)=0 + IMI(1,MI,2)=0 + IMI(2,MI,2)=0 + IMISEP(MI)=IMISEP(1) + PT2MI(MI)=0D0 + XMI(1,MI)=0D0 + XMI(2,MI)=0D0 + 120 CONTINUE +C...Initialize factors for PDF reshaping. + DO 140 JS=1,2 + KFBEAM(JS)=MINT(10+JS) + IF(MINT(18+JS).EQ.1) KFBEAM(JS)=22 + KFABM=IABS(KFBEAM(JS)) + KFSBM=ISIGN(1,KFBEAM(JS)) + +C...Zero flavour content of incoming beam particle. + KFIVAL(JS,1)=0 + KFIVAL(JS,2)=0 + KFIVAL(JS,3)=0 +C... Flavour content of baryon. + IF(KFABM.GT.1000) THEN + KFIVAL(JS,1)=KFSBM*MOD(KFABM/1000,10) + KFIVAL(JS,2)=KFSBM*MOD(KFABM/100,10) + KFIVAL(JS,3)=KFSBM*MOD(KFABM/10,10) +C... Flavour content of pi+-, K+-. + ELSEIF(KFABM.EQ.211) THEN + KFIVAL(JS,1)=KFSBM*2 + KFIVAL(JS,2)=-KFSBM + ELSEIF(KFABM.EQ.321) THEN + KFIVAL(JS,1)=-KFSBM*3 + KFIVAL(JS,2)=KFSBM*2 +C... Flavour content of pi0, gamma, K0S, K0L not defined yet. + ENDIF + +C...Zero initial valence and companion content. + DO 130 IFL=-6,6 + NVC(JS,IFL)=0 + 130 CONTINUE + 140 CONTINUE +C...Set up colour line tags starting from hard interaction initiators. + NCT=0 +C...Reset colour tag array and colour processing flags. + DO 150 I=IMISEP(0)+1,N + MCT(I,1)=0 + MCT(I,2)=0 + K(I,4)=MOD(K(I,4),MSTU(5)**2) + K(I,5)=MOD(K(I,5),MSTU(5)**2) + 150 CONTINUE +C... Consider each side in turn. + DO 170 JS=1,2 + I1=IMI(JS,1,1) + I2=IMI(3-JS,1,1) + DO 160 JCS=4,5 + IF (K(I1,2).NE.21.AND.(9-2*JCS).NE.ISIGN(1,K(I1,2))) + & GOTO 160 + IF (K(I1,JCS)/MSTU(5)**2.NE.0) GOTO 160 + KCS=JCS + CALL PYCTTR(I1,KCS,I2) + IF(MINT(51).NE.0) RETURN + 160 CONTINUE + 170 CONTINUE + +C...Range checking for companion quark pdf large-x param. + IF (MSTP(87).LT.0) THEN + CALL PYERRM(19,'(PYPTMI:) MSTP(87) out of range. Forced'// + & ' MSTP(87)=0') + MSTP(87)=0 + ELSEIF (MSTP(87).GT.4) THEN + CALL PYERRM(19,'(PYPTMI:) MSTP(87) out of range. Forced'// + & ' MSTP(87)=4') + MSTP(87)=4 + ENDIF + +C---------------------------------------------------------------------- +C...MODE=0: Generate trial interaction. Return codes: +C...IFAIL < 0: Phase space exhausted, generation to be terminated. +C...IFAIL = 0: Additional interaction generated at PT2. +C...IFAIL > 0: Additional interaction vetoed, but continue evolution. + ELSEIF (MODE.EQ.0) THEN +C...Abolute MI max scale = VINT(62) + XT2=4D0*MIN(PT2NOW,VINT(62))/VINT(2) + 180 IF(MSTP(82).LE.1) THEN + XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) + IF(XT2.LT.VINT(149)) IFAIL=-2 + ELSE + IF(XT2.LE.0.01001D0*VINT(149)) THEN + IFAIL=-3 + ELSE + XT2=XT2FAC*(XT2+VINT(149))/(XT2FAC-(XT2+VINT(149))* + & LOG(PYR(0)))-VINT(149) + ENDIF + ENDIF +C...Also exit if below lower limit or if higher trial branching +C...already found. + PT2=0.25D0*VINT(2)*XT2 + IF (PT2.LE.PT2CUT) IFAIL=-4 + IF (PT2.LE.PT2MX) IFAIL=-5 + IF (IFAIL.NE.0) THEN + PT2=0D0 + RETURN + ENDIF + IF(MSTP(82).GE.2) PT2=MAX(0.25D0*VINT(2)*0.01D0*VINT(149),PT2) + VINT(25)=4D0*PT2/VINT(2) + XT2=VINT(25) + +C...Choose tau and y*. Calculate cos(theta-hat). + IF(PYR(0).LE.COEF(ISUB,1)) THEN + TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) + TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) + ELSE + TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) + ENDIF + VINT(21)=TAU +C...New: require shat > 1. + IF(TAU*VINT(2).LT.1D0) GOTO 180 + CALL PYKLIM(2) + RYST=PYR(0) + MYST=1 + IF(RYST.GT.COEF(ISUB,8)) MYST=2 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 + CALL PYKMAP(2,MYST,PYR(0)) + VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) + +C...Check that x not used up. Accept or reject kinematical variables. + X1M=SQRT(TAU)*EXP(VINT(22)) + X2M=SQRT(TAU)*EXP(-VINT(22)) + IF(VINT(143)-X1M.LT.0.01D0.OR.VINT(144)-X2M.LT.0.01D0) GOTO 180 + VINT(71)=0.5D0*VINT(1)*SQRT(XT2) + CALL PYSIGH(NCHN,SIGS) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGS=SIGS*VINT(320) + IF(SIGS.LT.XSEC(ISUB,1)*PYR(0)) GOTO 180 + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGS=SIGS/VINT(320) + +C...Save if highest PT so far. + IF (PT2.GT.PT2MX) THEN + JSMX=0 + MIMX=MINT(31)+1 + PT2MX=PT2 + ENDIF + +C---------------------------------------------------------------------- +C...MODE=1: Generate and save accepted scattering. + ELSEIF (MODE.EQ.1) THEN + PT2=PT2NOW +C...Reset K, P, V, and MCT vectors. + DO 200 I=N+1,N+4 + DO 190 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 190 CONTINUE + MCT(I,1)=0 + MCT(I,2)=0 + 200 CONTINUE + + NTRY=0 +C...Choose flavour of reacting partons (and subprocess). + 210 NTRY=NTRY+1 + IF (NTRY.GT.50) THEN + CALL PYERRM(9,'(PYPTMI:) Unable to generate additional ' + & //'interaction. Giving up!') + MINT(51)=1 + RETURN + ENDIF + RSIGS=SIGS*PYR(0) + DO 220 ICHN=1,NCHN + KFL1=ISIG(ICHN,1) + KFL2=ISIG(ICHN,2) + ICONMI=ISIG(ICHN,3) + RSIGS=RSIGS-SIGH(ICHN) + IF(RSIGS.LE.0D0) GOTO 230 + 220 CONTINUE + +C...Reassign to appropriate process codes. + 230 ISUBMI=ICONMI/10 + ICONMI=MOD(ICONMI,10) + +C...Choose new quark flavour for annihilation graphs + IF(ISUBMI.EQ.12.OR.ISUBMI.EQ.53) THEN + SH=VINT(21)*VINT(2) + CALL PYWIDT(21,SH,WDTP,WDTE) + 240 RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*PYR(0) + DO 250 I=1,MDCY(21,3) + KFLF=KFDP(I+MDCY(21,2)-1,1) + RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4)) + IF(RKFL.LE.0D0) GOTO 260 + 250 CONTINUE + 260 IF(ISUBMI.EQ.53.AND.ICONMI.LE.2) THEN + IF(KFLF.GE.4) GOTO 240 + ELSEIF(ISUBMI.EQ.53.AND.ICONMI.LE.4) THEN + KFLF=4 + ICONMI=ICONMI-2 + ELSEIF(ISUBMI.EQ.53) THEN + KFLF=5 + ICONMI=ICONMI-4 + ENDIF + ENDIF + +C...Final state flavours and colour flow: default values + JS=1 + KFL3=KFL1 + KFL4=KFL2 + KCC=20 + KCS=ISIGN(1,KFL1) + + IF(ISUBMI.EQ.11) THEN +C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2 + KCC=ICONMI + IF(KFL1*KFL2.LT.0) KCC=KCC+2 + + ELSEIF(ISUBMI.EQ.12) THEN +C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2 + KFL3=ISIGN(KFLF,KFL1) + KFL4=-KFL3 + KCC=4 + + ELSEIF(ISUBMI.EQ.13) THEN +C...f + fbar -> g + g; th arbitrary + KFL3=21 + KFL4=21 + KCC=ICONMI+4 + + ELSEIF(ISUBMI.EQ.28) THEN +C...f + g -> f + g; th = (p(f)-p(f))**2 + IF(KFL1.EQ.21) JS=2 + KCC=ICONMI+6 + IF(KFL1.EQ.21) KCC=KCC+2 + IF(KFL1.NE.21) KCS=ISIGN(1,KFL1) + IF(KFL2.NE.21) KCS=ISIGN(1,KFL2) + + ELSEIF(ISUBMI.EQ.53) THEN +C...g + g -> f + fbar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + KFL3=ISIGN(KFLF,KCS) + KFL4=-KFL3 + KCC=ICONMI+10 + + ELSEIF(ISUBMI.EQ.68) THEN +C...g + g -> g + g; th arbitrary + KCC=ICONMI+12 + KCS=(-1)**INT(1.5D0+PYR(0)) + ENDIF + +C...Check that massive sea quarks have non-zero phase space for g -> Q Q + IF (IABS(KFL3).EQ.4.OR.IABS(KFL4).EQ.4.OR.IABS(KFL3).EQ.5 + & .OR.IABS(KFL4).EQ.5) THEN + RMMAX2=MAX(PMAS(PYCOMP(KFL3),1),PMAS(PYCOMP(KFL4),1))**2 + IF (PT2.LE.1.05*RMMAX2) THEN + IF (NTRY.EQ.2) CALL PYERRM(9,'(PYPTMI:) Heavy quarks' + & //' too close to threshold (2nd try).') + GOTO 210 + ENDIF + ENDIF + +C...Store flavours of scattering. + MINT(13)=KFL1 + MINT(14)=KFL2 + MINT(15)=KFL1 + MINT(16)=KFL2 + MINT(21)=KFL3 + MINT(22)=KFL4 + +C...Set flavours and mothers of scattering partons. + K(N+1,1)=14 + K(N+2,1)=14 + K(N+3,1)=3 + K(N+4,1)=3 + K(N+1,2)=KFL1 + K(N+2,2)=KFL2 + K(N+3,2)=KFL3 + K(N+4,2)=KFL4 + K(N+1,3)=MINT(83)+1 + K(N+2,3)=MINT(83)+2 + K(N+3,3)=N+1 + K(N+4,3)=N+2 + +C...Store colour connection indices. + DO 270 J=1,2 + JC=J + IF(KCS.EQ.-1) JC=3-J + IF(ICOL(KCC,1,JC).NE.0) K(N+1,J+3)=N+ICOL(KCC,1,JC) + IF(ICOL(KCC,2,JC).NE.0) K(N+2,J+3)=N+ICOL(KCC,2,JC) + IF(ICOL(KCC,3,JC).NE.0) K(N+3,J+3)=MSTU(5)*(N+ICOL(KCC,3,JC)) + IF(ICOL(KCC,4,JC).NE.0) K(N+4,J+3)=MSTU(5)*(N+ICOL(KCC,4,JC)) + 270 CONTINUE + +C...Store incoming and outgoing partons in their CM-frame. + SHR=SQRT(VINT(21))*VINT(1) + P(N+1,3)=0.5D0*SHR + P(N+1,4)=0.5D0*SHR + P(N+2,3)=-0.5D0*SHR + P(N+2,4)=0.5D0*SHR + P(N+3,5)=PYMASS(K(N+3,2)) + P(N+4,5)=PYMASS(K(N+4,2)) + IF(P(N+3,5)+P(N+4,5).GE.SHR) THEN + IFAIL=1 + RETURN + ENDIF + P(N+3,4)=0.5D0*(SHR+(P(N+3,5)**2-P(N+4,5)**2)/SHR) + P(N+3,3)=SQRT(MAX(0D0,P(N+3,4)**2-P(N+3,5)**2)) + P(N+4,4)=SHR-P(N+3,4) + P(N+4,3)=-P(N+3,3) + +C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4) + PHI=PARU(2)*PYR(0) + CALL PYROBO(N+3,N+4,ACOS(VINT(23)),PHI,0D0,0D0,0D0) + +C...Global statistics. + MINT(351)=MINT(351)+1 + VINT(351)=VINT(351)+SQRT(P(N+3,1)**2+P(N+3,2)**2) + IF (MINT(351).EQ.1) VINT(356)=SQRT(P(N+3,1)**2+P(N+3,2)**2) + +C...Keep track of loose colour ends and information on scattering. + MINT(31)=MINT(31)+1 + MINT(36)=MINT(31) + PT2MI(MINT(36))=PT2 + IMISEP(MINT(31))=N+4 + DO 280 JS=1,2 + IMI(JS,MINT(31),1)=N+JS + IMI(JS,MINT(31),2)=0 + XMI(JS,MINT(31))=VINT(40+JS) + NMI(JS)=NMI(JS)+1 +C...Update cumulative counters + VINT(142+JS)=VINT(142+JS)-VINT(40+JS) + VINT(150+JS)=VINT(150+JS)+VINT(40+JS) + 280 CONTINUE + +C...Add to list of final state partons + IPART(NPART+1)=N+3 + IPART(NPART+2)=N+4 + PTPART(NPART+1)=SQRT(PT2) + PTPART(NPART+2)=SQRT(PT2) + NPART=NPART+2 + +C...Initialize ISR + NISGEN(1,MINT(31))=0 + NISGEN(2,MINT(31))=0 + +C...Update ER + N=N+4 + IF(N.GT.MSTU(4)-MSTU(32)-10) THEN + CALL PYERRM(11,'(PYMIGN:) no more memory left in PYJETS') + MINT(51)=1 + RETURN + ENDIF + +C...Finally, assign colour tags to new partons + DO 300 JS=1,2 + I1=IMI(JS,MINT(31),1) + I2=IMI(3-JS,MINT(31),1) + DO 290 JCS=4,5 + IF (K(I1,2).NE.21.AND.(9-2*JCS).NE.ISIGN(1,K(I1,2))) + & GOTO 290 + IF (K(I1,JCS)/MSTU(5)**2.NE.0) GOTO 290 + KCS=JCS + CALL PYCTTR(I1,KCS,I2) + IF(MINT(51).NE.0) RETURN + 290 CONTINUE + 300 CONTINUE + +C---------------------------------------------------------------------- +C...MODE=2: Decide whether quarks in last scattering were valence, +C...companion, or sea. + ELSEIF (MODE.EQ.2) THEN + JS=MINT(30) + MI=MINT(36) + PT2=PT2NOW + KFSBM=ISIGN(1,MINT(10+JS)) + IFL=K(IMI(JS,MI,1),2) + IMI(JS,MI,2)=0 + IF (IABS(IFL).GE.6) THEN + IF (IABS(IFL).EQ.6) THEN + CALL PYERRM(29,'(PYPTMI:) top in initial state!') + ENDIF + RETURN + ENDIF +C...Get PDFs at X(rescaled) and PT2 of the current initiator. +C...(Do not include the parton itself in the X rescaling.) + X=XMI(JS,MI) + XRSC=X/(VINT(142+JS)+X) +C...Note: XPSVC = x*pdf. + MINT(30)=JS +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + CALL PYPDFU(KFBEAM(JS),XRSC,PT2,XPQ) + SEA=XPSVC(IFL,-1) + VAL=XPSVC(IFL,0) +C...Ensure that pdfs are positive definite + IF (SEA.LT.0D0) THEN + CALL PYERRM(9,'(PYPTMI:) Sea distribution negative.') + SEA=MAX(0D0,SEA) + ELSEIF (VAL.LT.0D0) THEN + CALL PYERRM(9,'(PYPTMI:) Val distribution negative.') + VAL=MAX(0D0,VAL) + ENDIF + CMP=0D0 + DO 310 IVC=1,NVC(JS,IFL) + CMP=CMP+XPSVC(IFL,IVC) + 310 CONTINUE + + NTRY=0 +C...Decide (Extra factor x cancels in the dvision). + 320 RVCS=PYR(0)*(SEA+VAL+CMP) + IVNOW=1 + NTRY=NTRY+1 + 330 IF (RVCS.LE.VAL.AND.IVNOW.GE.1) THEN +C...Safety check that valence present; pi0/gamma/K0S/K0L special cases. + IVNOW=0 + IF(KFIVAL(JS,1).EQ.IFL) IVNOW=IVNOW+1 + IF(KFIVAL(JS,2).EQ.IFL) IVNOW=IVNOW+1 + IF(KFIVAL(JS,3).EQ.IFL) IVNOW=IVNOW+1 + IF(KFIVAL(JS,1).EQ.0) THEN + IF(KFBEAM(JS).EQ.111.AND.IABS(IFL).LE.2) IVNOW=1 + IF(KFBEAM(JS).EQ.22.AND.IABS(IFL).LE.5) IVNOW=1 + IF((KFBEAM(JS).EQ.130.OR.KFBEAM(JS).EQ.310).AND. + & (IABS(IFL).EQ.1.OR.IABS(IFL).EQ.3)) IVNOW=1 + ELSE +C...Count down valence remaining. Do not count current scattering. + DO 340 I1=1,NMI(JS) + IF (I1.EQ.MINT(36)) GOTO 340 + IF (K(IMI(JS,I1,1),2).EQ.IFL.AND.IMI(JS,I1,2).EQ.0) + & IVNOW=IVNOW-1 + 340 CONTINUE + ENDIF + IF(IVNOW.EQ.0) GOTO 330 +C...Mark valence. + IMI(JS,MI,2)=0 +C...Sets valence content of gamma, pi0, K0S, K0L if not done. + IF(KFIVAL(JS,1).EQ.0) THEN + IF(KFBEAM(JS).EQ.111.OR.KFBEAM(JS).EQ.22) THEN + KFIVAL(JS,1)=IFL + KFIVAL(JS,2)=-IFL + ELSEIF(KFBEAM(JS).EQ.130.OR.KFBEAM(JS).EQ.310) THEN + KFIVAL(JS,1)=IFL + IF(IABS(IFL).EQ.1) KFIVAL(JS,2)=ISIGN(3,-IFL) + IF(IABS(IFL).NE.1) KFIVAL(JS,2)=ISIGN(1,-IFL) + ENDIF + ENDIF + + ELSEIF (RVCS.LE.VAL+SEA) THEN +C...If sea, add opposite sign companion parton. Store X and I. + NVC(JS,-IFL)=NVC(JS,-IFL)+1 + XASSOC(JS,-IFL,NVC(JS,-IFL))=XMI(JS,MI) +C...Set pointer to companion + IMI(JS,MI,2)=-NVC(JS,-IFL) + + ELSE +C...If companion, check whether we've got any in the books + IF (NVC(JS,IFL).EQ.0) THEN + CMP=0D0 +C...Only report error first time for this event + IF (NTRY.EQ.1) + & CALL PYERRM(9,'(PYPTMI:) No cmp quark, but pdf != 0!') +C...Try a few times + IF (NTRY.LE.10) THEN + GOTO 320 +C... But if it stil fails, abort this event + ELSE + MINT(51)=1 + RETURN + ENDIF + ENDIF +C...If several possibilities, decide which one + CMPSUM=VAL+SEA + ISEL=0 + 350 ISEL=ISEL+1 + CMPSUM=CMPSUM+XPSVC(IFL,ISEL) + IF (RVCS.GT.CMPSUM.AND.ISEL.LT.NVC(JS,IFL)) GOTO 350 +C...Find original sea (anti-)quark. Do not consider current scattering. + IASSOC=0 + DO 360 I1=1,NMI(JS) + IF (I1.EQ.MINT(36)) GOTO 360 + IF (K(IMI(JS,I1,1),2).NE.-IFL) GOTO 360 + IF (-IMI(JS,I1,2).EQ.ISEL) THEN + IMI(JS,MI,2)=IMI(JS,I1,1) + IMI(JS,I1,2)=IMI(JS,MI,1) + ENDIF + 360 CONTINUE +C...Mark companion "out-kicked". + XASSOC(JS,IFL,ISEL)=-XASSOC(JS,IFL,ISEL) + ENDIF + + ENDIF + RETURN + END + +C********************************************************************* + +C...PYFCMP: Auxiliary to PYPDFU and PYPTIS. +C...Giving the x*f pdf of a companion quark, with its partner at XS, +C...using an approximate gluon density like (1-X)^NPOW/X. The value +C...corresponds to an unrescaled range between 0 and 1-X. + + FUNCTION PYFCMP(XC,XS,NPOW) + IMPLICIT NONE + DOUBLE PRECISION XC, XS, Y, PYFCMP,FAC + INTEGER NPOW + + PYFCMP=0D0 +C...Parent gluon momentum fraction + Y=XC+XS + IF (Y.GE.1D0) RETURN +C...Common factor (includes factor XC, since PYFCMP=x*f) + FAC=3D0*XC*XS*(XC**2+XS**2)/(Y**4) +C...Store normalized companion x*f distribution. + IF (NPOW.LE.0) THEN + PYFCMP=FAC/(2D0-XS*(3D0-XS*(3D0-2D0*XS))) + ELSEIF (NPOW.EQ.1) THEN + PYFCMP=FAC*(1D0-Y)/(2D0+XS**2*(-3D0+XS)+3D0*XS*LOG(XS)) + ELSEIF (NPOW.EQ.2) THEN + PYFCMP=FAC*(1D0-Y)**2/(2D0*((1D0-XS)*(1D0+XS*(4D0+XS)) + & +3D0*XS*(1D0+XS)*LOG(XS))) + ELSEIF (NPOW.EQ.3) THEN + PYFCMP=FAC*(1D0-Y)**3*2D0/(4D0+27D0*XS-31D0*XS**3 + & +6D0*XS*LOG(XS)*(3D0+2D0*XS*(3D0+XS))) + ELSEIF (NPOW.GE.4) THEN + PYFCMP=FAC*(1D0-Y)**4/(2D0*(1D0+2D0*XS)*((1D0-XS)*(1D0+ + & XS*(10D0+XS))+6D0*XS*LOG(XS)*(1D0+XS))) + ENDIF + RETURN + END + +C********************************************************************* + +C...PYPCMP: Auxiliary to PYPDFU. +C...Giving the momentum integral of a companion quark, with its +C...partner at XS, using an approximate gluon density like (1-x)^NPOW/x. +C...The value corresponds to an unrescaled range between 0 and 1-XS. + + FUNCTION PYPCMP(XS,NPOW) + IMPLICIT NONE + DOUBLE PRECISION XS, PYPCMP + INTEGER NPOW + IF (XS.GE.1D0.OR.XS.LE.0D0) THEN + PYPCMP=0D0 + ELSEIF (NPOW.LE.0) THEN + PYPCMP=XS*(5D0+XS*(-9D0-2D0*XS*(-3D0+XS))+3D0*LOG(XS)) + PYPCMP=PYPCMP/((-1D0+XS)*(2D0+XS*(-1D0+2D0*XS))) + ELSEIF (NPOW.EQ.1) THEN + PYPCMP=-1D0-3D0*XS+(2D0*(-1D0+XS)**2*(1D0+XS+XS**2)) + & /(2D0+XS**2*(XS-3D0)+3D0*XS*LOG(XS)) + ELSEIF (NPOW.EQ.2) THEN + PYPCMP=XS*((1D0-XS)*(19D0+XS*(43D0+4D0*XS)) + & +6D0*LOG(XS)*(1D0+6D0*XS+4D0*XS**2)) + PYPCMP=PYPCMP/(4D0*((XS-1D0)*(1D0+XS*(4D0+XS)) + & -3D0*XS*LOG(XS)*(1+XS))) + ELSEIF (NPOW.EQ.3) THEN + PYPCMP=3D0*XS*((XS-1)*(7D0+XS*(28D0+13D0*XS)) + & -2D0*LOG(XS)*(1D0+XS*(9D0+2D0*XS*(6D0+XS)))) + PYPCMP=PYPCMP/(4D0+27D0*XS-31D0*XS**3 + & +6D0*XS*LOG(XS)*(3D0+2D0*XS*(3D0+XS))) + ELSE + PYPCMP=(-9D0*XS*(XS**2-1D0)*(5D0+XS*(24D0+XS))+12D0*XS*LOG(XS) + & *(1D0+2D0*XS)*(1D0+2D0*XS*(5D0+2D0*XS))) + PYPCMP=PYPCMP/(8D0*(1D0+2D0*XS)*((XS-1D0)*(1D0+XS*(10D0+XS)) + & -6D0*XS*LOG(XS)*(1D0+XS))) + ENDIF + RETURN + END + +C********************************************************************* + +C...PYUPRE +C...Rearranges contents of the HEPEUP commonblock so that +C...mothers precede daughters and daughters of a decay are +C...listed consecutively. + + SUBROUTINE PYUPRE + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + +C...User process event common block. + INTEGER MAXNUP + PARAMETER (MAXNUP=500) + INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP + DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP + COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), + &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), + &VTIMUP(MAXNUP),SPINUP(MAXNUP) + SAVE /HEPEUP/ + +C...Local arrays. + DIMENSION NEWPOS(0:MAXNUP),IDUPT(MAXNUP),ISTUPT(MAXNUP), + &MOTUPT(2,MAXNUP),ICOUPT(2,MAXNUP),PUPT(5,MAXNUP), + &VTIUPT(MAXNUP),SPIUPT(MAXNUP) + +C...Check whether a rearrangement is required. + NEED=0 + DO 100 IUP=1,NUP + IF(MOTHUP(1,IUP).GT.IUP) NEED=NEED+1 + 100 CONTINUE + DO 110 IUP=2,NUP + IF(MOTHUP(1,IUP).LT.MOTHUP(1,IUP-1)) NEED=NEED+1 + 110 CONTINUE + + IF(NEED.NE.0) THEN +C...Find the new order that particles should have. + NEWPOS(0)=0 + NNEW=0 + INEW=-1 + 120 INEW=INEW+1 + DO 130 IUP=1,NUP + IF(MOTHUP(1,IUP).EQ.NEWPOS(INEW)) THEN + NNEW=NNEW+1 + NEWPOS(NNEW)=IUP + ENDIF + 130 CONTINUE + IF(INEW.LT.NNEW.AND.INEW.LT.NUP) GOTO 120 + IF(NNEW.NE.NUP) THEN + CALL PYERRM(2, + & '(PYUPRE:) failed to make sense of mother pointers in HEPEUP') + RETURN + ENDIF + +C...Copy old info into temporary storage. + DO 150 I=1,NUP + IDUPT(I)=IDUP(I) + ISTUPT(I)=ISTUP(I) + MOTUPT(1,I)=MOTHUP(1,I) + MOTUPT(2,I)=MOTHUP(2,I) + ICOUPT(1,I)=ICOLUP(1,I) + ICOUPT(2,I)=ICOLUP(2,I) + DO 140 J=1,5 + PUPT(J,I)=PUP(J,I) + 140 CONTINUE + VTIUPT(I)=VTIMUP(I) + SPIUPT(I)=SPINUP(I) + 150 CONTINUE + +C...Copy info back into HEPEUP in right order. + DO 180 I=1,NUP + IOLD=NEWPOS(I) + IDUP(I)=IDUPT(IOLD) + ISTUP(I)=ISTUPT(IOLD) + MOTHUP(1,I)=0 + MOTHUP(2,I)=0 + DO 160 IMOT=1,I-1 + IF(MOTUPT(1,IOLD).EQ.NEWPOS(IMOT)) MOTHUP(1,I)=IMOT + IF(MOTUPT(2,IOLD).EQ.NEWPOS(IMOT)) MOTHUP(2,I)=IMOT + 160 CONTINUE + IF(MOTHUP(2,I).GT.0.AND.MOTHUP(2,I).LT.MOTHUP(1,I)) THEN + MOTHSW=MOTHUP(1,I) + MOTHUP(1,I)=MOTHUP(2,I) + MOTHUP(2,I)=MOTHSW + ENDIF + ICOLUP(1,I)=ICOUPT(1,IOLD) + ICOLUP(2,I)=ICOUPT(2,IOLD) + DO 170 J=1,5 + PUP(J,I)=PUPT(J,IOLD) + 170 CONTINUE + VTIMUP(I)=VTIUPT(IOLD) + SPINUP(I)=SPIUPT(IOLD) + 180 CONTINUE + ENDIF + +c...If incoming particles are massive recalculate to put them massless. + IF(PUP(5,1).NE.0D0.OR.PUP(5,2).NE.0D0) THEN + PPLUS=(PUP(4,1)+PUP(3,1))+(PUP(4,2)+PUP(3,2)) + PMINUS=(PUP(4,1)-PUP(3,1))+(PUP(4,2)-PUP(3,2)) + PUP(4,1)=0.5D0*PPLUS + PUP(3,1)=PUP(4,1) + PUP(5,1)=0D0 + PUP(4,2)=0.5D0*PMINUS + PUP(3,2)=-PUP(4,2) + PUP(5,2)=0D0 + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYADSH +C...Administers the generation of successive final-state showers +C...in external processes. + + SUBROUTINE PYADSH(NFIN) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement for maximum size of showers. + PARAMETER (MAXNUR=1000) +C...Commonblocks. + COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR) + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYCTAG/NCT,MCT(4000,2) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + SAVE /PYPART/,/PYJETS/,/PYCTAG/,/PYDAT1/,/PYPARS/,/PYINT1/ +C...Local array. + DIMENSION IBEG(100),KSAV(100,5),PSUM(4),BETA(3) + +C...Set primary vertex. + DO 100 J=1,5 + V(MINT(83)+5,J)=0D0 + V(MINT(83)+6,J)=0D0 + V(MINT(84)+1,J)=0D0 + V(MINT(84)+2,J)=0D0 + 100 CONTINUE + +C...Isolate systems of particles with the same mother. + NSYS=0 + IMS=-1 + DO 140 I=MINT(84)+3,NFIN + IM=K(I,3) + IF(IM.GT.0.AND.IM.LE.MINT(84)) IM=K(IM,3) + IF(IM.NE.IMS) THEN + NSYS=NSYS+1 + IBEG(NSYS)=I + IMS=IM + ENDIF + +C...Set production vertices. + IF(IM.LE.MINT(83)+6.OR.(IM.GT.MINT(84).AND.IM.LE.MINT(84)+2)) + & THEN + DO 110 J=1,4 + V(I,J)=0D0 + 110 CONTINUE + ELSE + DO 120 J=1,4 + V(I,J)=V(IM,J)+V(IM,5)*P(IM,J)/P(IM,5) + 120 CONTINUE + ENDIF + IF(MSTP(125).GE.1) THEN + IDOC=I-MSTP(126)+4 + DO 130 J=1,5 + V(IDOC,J)=V(I,J) + 130 CONTINUE + ENDIF + 140 CONTINUE + +C...End loop over systems. Return if no showers to be performed. + IBEG(NSYS+1)=NFIN+1 + IF(MSTP(71).LE.0) RETURN + +C...Loop through systems of particles; check that sensible size. + DO 270 ISYS=1,NSYS + NSIZ=IBEG(ISYS+1)-IBEG(ISYS) + IF(MINT(35).LE.2) THEN + IF(NSIZ.EQ.1.AND.ISYS.EQ.1) THEN + GOTO 270 + ELSEIF(NSIZ.LE.1) THEN + CALL PYERRM(2,'(PYADSH:) only one particle in system') + GOTO 270 + ELSEIF(NSIZ.GT.80) THEN + CALL PYERRM(2,'(PYADSH:) more than 80 particles in system') + GOTO 270 + ENDIF + ENDIF + +C...Save status codes and daughters of showering particles; reset them. + DO 150 J=1,4 + PSUM(J)=0D0 + 150 CONTINUE + DO 170 II=1,NSIZ + I=IBEG(ISYS)-1+II + KSAV(II,1)=K(I,1) + IF(K(I,1).GT.10) THEN + K(I,1)=1 + IF(KSAV(II,1).EQ.14) K(I,1)=3 + ENDIF + IF(KSAV(II,1).LE.10) THEN + ELSEIF(K(I,1).EQ.1) THEN + KSAV(II,4)=K(I,4) + KSAV(II,5)=K(I,5) + K(I,4)=0 + K(I,5)=0 + ELSE + KSAV(II,4)=MOD(K(I,4),MSTU(5)) + KSAV(II,5)=MOD(K(I,5),MSTU(5)) + K(I,4)=K(I,4)-KSAV(II,4) + K(I,5)=K(I,5)-KSAV(II,5) + ENDIF + DO 160 J=1,4 + PSUM(J)=PSUM(J)+P(I,J) + 160 CONTINUE + 170 CONTINUE + +C...Perform shower. + QMAX=SQRT(MAX(0D0,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2- + & PSUM(3)**2)) + IF(ISYS.EQ.1) QMAX=MIN(QMAX,SQRT(PARP(71))*VINT(55)) + NSAV=N + IF(MINT(35).LE.2) THEN + IF(NSIZ.EQ.2) THEN + CALL PYSHOW(IBEG(ISYS),IBEG(ISYS)+1,QMAX) + ELSE + CALL PYSHOW(IBEG(ISYS),-NSIZ,QMAX) + ENDIF + +C...For external processes, first call, also ISR partons radiate. +C...Can use existing PYPART list, removing partons that radiate later. + ELSEIF(ISYS.EQ.1) THEN + NPARTN=0 + DO 175 II=1,NPART + IF(IPART(II).LT.IBEG(2).OR.IPART(II).GE.IBEG(NSYS+1)) THEN + NPARTN=NPARTN+1 + IPART(NPARTN)=IPART(II) + PTPART(NPARTN)=PTPART(II) + ENDIF + 175 CONTINUE + NPART=NPARTN + CALL PYPTFS(1,0.5D0*QMAX,0D0,PTGEN) + ELSE +C...For subsequent calls use the systems excluded above. + NPART=NSIZ + NPARTD=0 + DO 180 II=1,NSIZ + I=IBEG(ISYS)-1+II + IPART(II)=I + PTPART(II)=0.5D0*QMAX + 180 CONTINUE + CALL PYPTFS(2,0.5D0*QMAX,0D0,PTGEN) + ENDIF + +C...Look up showered copies of original showering particles. + DO 260 II=1,NSIZ + I=IBEG(ISYS)-1+II + IMV=I +C...Particles without daughters need not be studied. + IF(KSAV(II,1).LE.10) GOTO 260 + IF(N.EQ.NSAV.OR.K(I,1).LE.10) THEN + ELSEIF(K(I,1).EQ.11) THEN + 190 IMV=MOD(K(IMV,4),MSTU(5)) + IF(K(IMV,1).EQ.11) GOTO 190 + ELSE + KDA1=MOD(K(I,4),MSTU(5)) + IF(KDA1.GT.0) THEN + IF(K(KDA1,2).EQ.21) KDA1=K(KDA1,5)/MSTU(5) + ENDIF + KDA2=MOD(K(I,5),MSTU(5)) + IF(KDA2.GT.0) THEN + IF(K(KDA2,2).EQ.21) KDA2=K(KDA2,4)/MSTU(5) + ENDIF + DO 200 I3=I+1,N + IF(K(I3,2).EQ.K(I,2).AND.(I3.EQ.KDA1.OR.I3.EQ.KDA2)) + & THEN + IMV=I3 + KDA1=MOD(K(I3,4),MSTU(5)) + IF(KDA1.GT.0) THEN + IF(K(KDA1,2).EQ.21) KDA1=K(KDA1,5)/MSTU(5) + ENDIF + KDA2=MOD(K(I3,5),MSTU(5)) + IF(KDA2.GT.0) THEN + IF(K(KDA2,2).EQ.21) KDA2=K(KDA2,4)/MSTU(5) + ENDIF + ENDIF + 200 CONTINUE + ENDIF + +C...Restore daughter info of original partons to showered copies. + IF(KSAV(II,1).GT.10) K(IMV,1)=KSAV(II,1) + IF(KSAV(II,1).LE.10) THEN + ELSEIF(K(I,1).EQ.1) THEN + K(IMV,4)=KSAV(II,4) + K(IMV,5)=KSAV(II,5) + ELSE + K(IMV,4)=K(IMV,4)+KSAV(II,4) + K(IMV,5)=K(IMV,5)+KSAV(II,5) + ENDIF + +C...Reset mother info of existing daughters to showered copies. + DO 210 I3=IBEG(ISYS+1),NFIN + IF(K(I3,3).EQ.I) K(I3,3)=IMV + IF(K(I3,1).EQ.3.OR.K(I3,1).EQ.14) THEN + IF(K(I3,4)/MSTU(5).EQ.I) K(I3,4)=K(I3,4)+MSTU(5)*(IMV-I) + IF(K(I3,5)/MSTU(5).EQ.I) K(I3,5)=K(I3,5)+MSTU(5)*(IMV-I) + ENDIF + 210 CONTINUE + +C...Boost all original daughters to new frame of showered copy. +C...Also update their colour tags. + IF(IMV.NE.I) THEN + DO 220 J=1,3 + BETA(J)=(P(IMV,J)-P(I,J))/(P(IMV,4)+P(I,4)) + 220 CONTINUE + FAC=2D0/(1D0+BETA(1)**2+BETA(2)**2+BETA(3)**2) + DO 230 J=1,3 + BETA(J)=FAC*BETA(J) + 230 CONTINUE + DO 250 I3=IBEG(ISYS+1),NFIN + IMO=I3 + 240 IMO=K(IMO,3) + IF(MSTP(128).LE.0) THEN + IF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) GOTO 240 + IF(IMO.EQ.I.OR.(K(I,3).LE.MINT(84).AND.IMO.EQ.K(I,3))) + & THEN + CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) + IF(MCT(I3,1).EQ.MCT(I,1)) MCT(I3,1)=MCT(IMV,1) + IF(MCT(I3,2).EQ.MCT(I,2)) MCT(I3,2)=MCT(IMV,2) + ENDIF + ELSE + IF(IMO.EQ.IMV) THEN + CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) + IF(MCT(I3,1).EQ.MCT(I,1)) MCT(I3,1)=MCT(IMV,1) + IF(MCT(I3,2).EQ.MCT(I,2)) MCT(I3,2)=MCT(IMV,2) + ELSEIF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) THEN + GOTO 240 + ENDIF + ENDIF + 250 CONTINUE + ENDIF + 260 CONTINUE + +C...End of loop over showering systems + 270 CONTINUE + + RETURN + END + +C********************************************************************* + +C...PYVETO +C...Interface to UPVETO, which allows user to veto event generation +C...on the parton level, after parton showers but before multiple +C...interactions, beam remnants and hadronization is added. + + SUBROUTINE PYVETO(IVETO) + +C...All real arithmetic in double precision. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) +C...Three Pythia functions return integers, so need declaring. + INTEGER PYK,PYCHGE,PYCOMP + +C...PYTHIA commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYINT1/MINT(400),VINT(400) + SAVE /PYJETS/,/PYPARS/,/PYINT1/ +C...HEPEVT commonblock. + PARAMETER (NMXHEP=4000) + COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), + &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) + DOUBLE PRECISION PHEP,VHEP + SAVE /HEPEVT/ +C...Local array. + DIMENSION IRESO(100) + +C...Define longitudinal boost from initiator rest frame to cm frame. + GAMMA=0.5D0*(VINT(141)+VINT(142))/SQRT(VINT(141)*VINT(142)) + GABEZ=0.5D0*(VINT(141)-VINT(142))/SQRT(VINT(141)*VINT(142)) + +C...Presentation is different if using pT-ordered shower + IF(MINT(35).EQ.3) THEN + GAMMA=1D0 + GABEZ=0D0 + ENDIF + +C... Reset counters. + NEVHEP=0 + NHEP=0 + NRESO=0 + +C...Oth pass: identify beam and incoming partons + DO 140 I=MINT(83)+1,MINT(83)+6 + ISTORE=0 + IF(K(I,2).EQ.94) THEN + + ELSE + NRESO=NRESO+1 + IRESO(NRESO)=I + IMOTH=K(I,3) + ENDIF + 140 CONTINUE + +C...First pass: identify final locations of resonances +C...and of their daughters before showering. + DO 150 I=MINT(84)+3,N + ISTORE=0 + IMOTH=0 + +C...Skip shower CM frame documentation lines. + IF(K(I,2).EQ.94) THEN + +C... Store a new intermediate product, when mother in documentation. + ELSEIF(MSTP(128).EQ.0.AND.K(I,3).GT.MINT(83)+6.AND. + & K(I,3).LE.MINT(84)) THEN + ISTORE=1 + NHEP=NHEP+1 + II=NHEP + NRESO=NRESO+1 + IRESO(NRESO)=I + IMOTH=MAX(0,K(K(I,3),3)-(MINT(83)+6)) + +C... Store a new intermediate product, when mother in main section. + ELSEIF(MSTP(128).EQ.1.AND.K(I-MINT(84)+MINT(83)+4,1).EQ.21.AND. + & K(I-MINT(84)+MINT(83)+4,2).EQ.K(I,2)) THEN + ISTORE=1 + NHEP=NHEP+1 + II=NHEP + NRESO=NRESO+1 + IRESO(NRESO)=I + IMOTH=MAX(0,K(I-MINT(84)+MINT(83)+4,3)-(MINT(83)+6)) + ENDIF + + IF(ISTORE.EQ.1) THEN +C...Copy parton info, boosting momenta along z axis to cm frame. + ISTHEP(II)=2 + IDHEP(II)=K(I,2) + PHEP(1,II)=P(I,1) + PHEP(2,II)=P(I,2) + PHEP(3,II)=GAMMA*P(I,3)+GABEZ*P(I,4) + PHEP(4,II)=GAMMA*P(I,4)+GABEZ*P(I,3) + PHEP(5,II)=P(I,5) +C...Store one mother. Rest of history and vertex info zeroed. + JMOHEP(1,II)=IMOTH + JMOHEP(2,II)=0 + JDAHEP(1,II)=0 + JDAHEP(2,II)=0 + VHEP(1,II)=0D0 + VHEP(2,II)=0D0 + VHEP(3,II)=0D0 + VHEP(4,II)=0D0 + ENDIF + 150 CONTINUE + +C...Second pass: identify current set of "final" partons. + DO 200 I=MINT(84)+3,N + ISTORE=0 + IMOTH=0 + +C...Store a final parton. + IF(K(I,1).GE.1.AND.K(I,1).LE.10) THEN + ISTORE=1 + NHEP=NHEP+1 + II=NHEP +C..Trace it back through shower, to check if from documented particle. + IHIST=I + ISAVE=IHIST + 160 CONTINUE + IF(IHIST.GT.MINT(84)) THEN + IF(K(IHIST,2).EQ.94) IHIST=K(IHIST,3)+(ISAVE-1-IHIST) + DO 170 IRI=1,NRESO + IF(IHIST.EQ.IRESO(IRI)) IMOTH=IRI + 170 CONTINUE + ISAVE=IHIST + IHIST=K(IHIST,3) + IF(IMOTH.EQ.0) GOTO 160 + IMOTH=MAX(0,IMOTH-6) + ELSEIF(IHIST.LE.4) THEN + IF(IHIST.EQ.1.OR.IHIST.EQ.2) THEN + ISTORE=0 + NHEP=NHEP-1 + ELSE + IMOTH=0 + ENDIF + ENDIF + ENDIF + + IF(ISTORE.EQ.1) THEN +C...Copy parton info, boosting momenta along z axis to cm frame. + ISTHEP(II)=1 + IDHEP(II)=K(I,2) + PHEP(1,II)=P(I,1) + PHEP(2,II)=P(I,2) + PHEP(3,II)=GAMMA*P(I,3)+GABEZ*P(I,4) + PHEP(4,II)=GAMMA*P(I,4)+GABEZ*P(I,3) + PHEP(5,II)=P(I,5) +C...Store one mother. Rest of history and vertex info zeroed. + JMOHEP(1,II)=IMOTH + JMOHEP(2,II)=0 + JDAHEP(1,II)=0 + JDAHEP(2,II)=0 + VHEP(1,II)=0D0 + VHEP(2,II)=0D0 + VHEP(3,II)=0D0 + VHEP(4,II)=0D0 + ENDIF + 200 CONTINUE +C...Call user-written routine to decide whether to keep events. + CALL UPVETO(IVETO) + RETURN + END +C********************************************************************* + +C...PYRESD +C...Allows resonances to decay (including parton showers for hadronic +C...channels). + + SUBROUTINE PYRESD(IRES) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement to help give large particle numbers. + PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, + &KEXCIT=4000000,KDIMEN=5000000) +C...Parameter statement for maximum size of showers. + PARAMETER (MAXNUR=1000) +C...Commonblocks. + COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR) + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYCTAG/NCT,MCT(4000,2) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYPUED/IUED(0:99),RUED(0:99) + SAVE /PYPART/,/PYJETS/,/PYCTAG/,/PYDAT1/,/PYDAT2/,/PYDAT3/, + &/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT4/,/PYPUED/ +C...Local arrays and complex and character variables. + DIMENSION IREF(50,8),KDCY(3),KFL1(3),KFL2(3),KFL3(3),KEQL(3), + &KCQM(3),KCQ1(3),KCQ2(3),KCQ3(3),NSD(3),PMMN(3),ILIN(6), + &HGZ(3,3),COUP(6,4),CORL(2,2,2),PK(6,4),PKK(6,6),CTHE(3), + &PHI(3),WDTP(0:400),WDTE(0:400,0:5),DPMO(5),XM(5),VDCY(4), + &ITJUNC(3),CTM2(3),KCQ(0:10),IANT(3),ITRI(3),IOCT(3) + COMPLEX FGK,HA(6,6),HC(6,6) + REAL TIR,UIR + CHARACTER CODE*9,MASS*9 + +C...The F, Xi and Xj functions of Gunion and Kunszt +C...(Phys. Rev. D33, 665, plus errata from the authors). + FGK(I1,I2,I3,I4,I5,I6)=4.*HA(I1,I3)*HC(I2,I6)*(HA(I1,I5)* + &HC(I1,I4)+HA(I3,I5)*HC(I3,I4)) + DIGK(DT,DU)=-4D0*D34*D56+DT*(3D0*DT+4D0*DU)+DT**2*(DT*DU/ + &(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+2D0*(D34/D56+D56/D34)) + DJGK(DT,DU)=8D0*(D34+D56)**2-8D0*(D34+D56)*(DT+DU)-6D0*DT*DU- + &2D0*DT*DU*(DT*DU/(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+ + &2D0*(D34/D56+D56/D34)) + +C...Some general constants. + XW=PARU(102) + XWV=XW + IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 + XW1=1D0-XW + SQMZ=PMAS(23,1)**2 + + GMMZ=PMAS(23,1)*PMAS(23,2) + SQMW=PMAS(24,1)**2 + GMMW=PMAS(24,1)*PMAS(24,2) + SH=VINT(44) + +C...Boost and rotate to rest frame of incoming partons, +C...to get proper amount of smearing of decay angles. + IBST=0 + IF(IRES.EQ.0) THEN + IBST=1 + IIN1=MINT(84)+1 + IIN2=MINT(84)+2 +C...Bug fix 09 OCT 2008 (PS) at 6.4.18: in new shower, the incoming partons +C...(101,102) are off shell and can have inconsistent momenta, resulting +C...in boosts larger than unity. However, the corresponding docu partons +C...(5,6) are kept on shell, and have consistent momenta that can be used +C...to derive this boost instead. Ultimately, should change the way the new +C...shower stores intermediate partons, but just using partons (5,6) for now +C...does define the boost and furnishes a quick and much needed solution. + IF (MINT(35).EQ.3) THEN + IIN1=MINT(83)+5 + IIN2=MINT(83)+6 + ENDIF + ETOTIN=P(IIN1,4)+P(IIN2,4) + BEXIN=(P(IIN1,1)+P(IIN2,1))/ETOTIN + BEYIN=(P(IIN1,2)+P(IIN2,2))/ETOTIN + BEZIN=(P(IIN1,3)+P(IIN2,3))/ETOTIN + CALL PYROBO(MINT(83)+7,N,0D0,0D0,-BEXIN,-BEYIN,-BEZIN) + PHIIN=PYANGL(P(MINT(84)+1,1),P(MINT(84)+1,2)) + CALL PYROBO(MINT(83)+7,N,0D0,-PHIIN,0D0,0D0,0D0) + THEIN=PYANGL(P(MINT(84)+1,3),P(MINT(84)+1,1)) + CALL PYROBO(MINT(83)+7,N,-THEIN,0D0,0D0,0D0,0D0) + ENDIF + +C...Reset original resonance configuration. + DO 100 JT=1,8 + IREF(1,JT)=0 + 100 CONTINUE + +C...Define initial one, two or three objects for subprocess. + IHDEC=0 + IF(IRES.EQ.0) THEN + ISUB=MINT(1) + IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN + IREF(1,1)=MINT(84)+2+ISET(ISUB) + IREF(1,4)=MINT(83)+6+ISET(ISUB) + JTMAX=1 + ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN + IREF(1,1)=MINT(84)+1+ISET(ISUB) + IREF(1,2)=MINT(84)+2+ISET(ISUB) + IREF(1,4)=MINT(83)+5+ISET(ISUB) + IREF(1,5)=MINT(83)+6+ISET(ISUB) + JTMAX=2 + ELSEIF(ISET(ISUB).EQ.5) THEN + IREF(1,1)=MINT(84)+3 + IREF(1,2)=MINT(84)+4 + IREF(1,3)=MINT(84)+5 + IREF(1,4)=MINT(83)+7 + IREF(1,5)=MINT(83)+8 + IREF(1,6)=MINT(83)+9 + JTMAX=3 + ENDIF + +C...Define original resonance for odd cases. + ELSE + ISUB=0 + IF(K(IRES,2).EQ.25.OR.K(IRES,2).EQ.35.OR.K(IRES,2).EQ.36) + & IHDEC=1 + IF(IHDEC.EQ.1) ISUB=3 + IREF(1,1)=IRES + IREF(1,4)=K(IRES,3) + IRESTM=IRES + IF(IREF(1,4).GT.MINT(84)) THEN + 110 ITMPMO=IREF(1,4) + IF(K(ITMPMO,2).EQ.94) THEN + IREF(1,4)=K(ITMPMO,3)+(IRESTM-ITMPMO-1) + IF(K(IREF(1,4),3).LE.MINT(84)) IREF(1,4)=K(IREF(1,4),3) + ELSEIF(K(ITMPMO,2).EQ.K(IRES,2)) THEN + IRESTM=ITMPMO +C...Explicitly check that reference particle exists, otherwise stop recursion + IF(ITMPMO.GT.0.AND.K(ITMPMO,3).GT.0) THEN + IREF(1,4)=K(ITMPMO,3) + GOTO 110 + ENDIF + ENDIF + ENDIF + IF(IREF(1,4).GT.MINT(84)) THEN + EMATCH=1D10 + IREF14=IREF(1,4) + DO 120 II=MINT(83)+7,MINT(83)+MINT(4) + IF(K(II,2).EQ.K(IRES,2).AND.ABS(P(II,4)-P(IREF14,4)).LT. + & EMATCH) THEN + IREF(1,4)=II + EMATCH=ABS(P(II,4)-P(IREF14,4)) + ENDIF + 120 CONTINUE + ENDIF + JTMAX=1 + ENDIF + +C...Check if initial resonance has been moved (in resonance + jet). + DO 140 JT=1,3 + IF(IREF(1,JT).GT.0) THEN + IF(K(IREF(1,JT),1).GT.10) THEN + KFA=IABS(K(IREF(1,JT),2)) + IF(KFA.GE.6.AND.KCHG(PYCOMP(KFA),2).NE.0) THEN + KDA1=MOD(K(IREF(1,JT),4),MSTU(5)) + KDA2=MOD(K(IREF(1,JT),5),MSTU(5)) + IF(KDA1.GT.IREF(1,JT).AND.KDA1.LE.N) THEN + IF(K(KDA1,2).EQ.21) KDA1=K(KDA1,5)/MSTU(5) + ENDIF + IF(KDA2.GT.IREF(1,JT).AND.KDA2.LE.N) THEN + IF(K(KDA2,2).EQ.21) KDA2=K(KDA2,4)/MSTU(5) + ENDIF + DO 130 I=IREF(1,JT)+1,N + IF(K(I,2).EQ.K(IREF(1,JT),2).AND.(I.EQ.KDA1.OR. + & I.EQ.KDA2)) THEN + IREF(1,JT)=I + KDA1=MOD(K(IREF(1,JT),4),MSTU(5)) + KDA2=MOD(K(IREF(1,JT),5),MSTU(5)) + IF(KDA1.GT.IREF(1,JT).AND.KDA1.LE.N) THEN + IF(K(KDA1,2).EQ.21) KDA1=K(KDA1,5)/MSTU(5) + ENDIF + IF(KDA2.GT.IREF(1,JT).AND.KDA2.LE.N) THEN + IF(K(KDA2,2).EQ.21) KDA2=K(KDA2,4)/MSTU(5) + ENDIF + ENDIF + 130 CONTINUE + ELSE + KDA=MOD(K(IREF(1,JT),4),MSTU(5)) + IF(MWID(PYCOMP(KFA)).NE.0.AND.KDA.GT.1) IREF(1,JT)=KDA + ENDIF + ENDIF + ENDIF + 140 CONTINUE + +C...Set decay vertex for initial resonances + DO 160 JT=1,JTMAX + DO 150 I=1,4 + V(IREF(1,JT),I)=0D0 + 150 CONTINUE + 160 CONTINUE + +C...Loop over decay history. + NP=1 + IP=0 + 170 IP=IP+1 + NINH=0 + JTMAX=2 + IF(IREF(IP,2).EQ.0) JTMAX=1 + IF(IREF(IP,3).NE.0) JTMAX=3 + IT4=0 + NSAV=N + +C...Check for Higgs which appears as decay product of user-process. + IF(ISUB.EQ.0) THEN + IHDEC=0 + IF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR.IREF(IP,7) + & .EQ.36) IHDEC=1 + IF(IHDEC.EQ.1) ISUB=3 + ENDIF + +C...Start treatment of one, two or three resonances in parallel. + 180 N=NSAV + DO 340 JT=1,JTMAX + ID=IREF(IP,JT) + KDCY(JT)=0 + KFL1(JT)=0 + KFL2(JT)=0 + KFL3(JT)=0 + KEQL(JT)=0 + NSD(JT)=ID + ITJUNC(JT)=0 + +C...Check whether particle can/is allowed to decay. + IF(ID.EQ.0) GOTO 330 + KFA=IABS(K(ID,2)) + KCA=PYCOMP(KFA) + IF(MWID(KCA).EQ.0) GOTO 330 + IF(K(ID,1).GT.10.OR.MDCY(KCA,1).EQ.0) GOTO 330 + IF(KFA.EQ.6.OR.KFA.EQ.7.OR.KFA.EQ.8.OR.KFA.EQ.17.OR. + & KFA.EQ.18) IT4=IT4+1 + K(ID,4)=MSTU(5)*(K(ID,4)/MSTU(5)) + K(ID,5)=MSTU(5)*(K(ID,5)/MSTU(5)) + +C...Choose lifetime and determine decay vertex. + IF(K(ID,1).EQ.5) THEN + V(ID,5)=0D0 + ELSEIF(K(ID,1).NE.4) THEN + V(ID,5)=-PMAS(KCA,4)*LOG(PYR(0)) + ENDIF + DO 190 J=1,4 + VDCY(J)=V(ID,J)+V(ID,5)*P(ID,J)/P(ID,5) + 190 CONTINUE + +C...Determine whether decay allowed or not. + MOUT=0 + IF(MSTJ(22).EQ.2) THEN + IF(PMAS(KCA,4).GT.PARJ(71)) MOUT=1 + ELSEIF(MSTJ(22).EQ.3) THEN + IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1 + ELSEIF(MSTJ(22).EQ.4) THEN + IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1 + IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1 + ENDIF + IF(MOUT.EQ.1.AND.K(ID,1).NE.5) THEN + K(ID,1)=4 + GOTO 330 + ENDIF + +C...Info for selection of decay channel: sign, pairings. + IF(KCHG(KCA,3).EQ.0) THEN + IPM=2 + ELSE + IPM=(5-ISIGN(1,K(ID,2)))/2 + ENDIF + KFB=0 + IF(JTMAX.EQ.2) THEN + KFB=IABS(K(IREF(IP,3-JT),2)) + ELSEIF(JTMAX.EQ.3) THEN + JT2=JT+1-3*(JT/3) + KFB=IABS(K(IREF(IP,JT2),2)) + IF(KFB.NE.KFA) THEN + JT2=JT+2-3*((JT+1)/3) + KFB=IABS(K(IREF(IP,JT2),2)) + ENDIF + ENDIF + +C...Select decay channel. + IF(ISUB.EQ.1.OR.ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR. + & ISUB.EQ.30.OR.ISUB.EQ.35.OR.ISUB.EQ.141) MINT(61)=1 + CALL PYWIDT(KFA,P(ID,5)**2,WDTP,WDTE) + WDTE0S=WDTE(0,1)+WDTE(0,IPM)+WDTE(0,4) + IF(KFB.EQ.KFA) WDTE0S=WDTE0S+WDTE(0,5) + IF(WDTE0S.LE.0D0) GOTO 330 + RKFL=WDTE0S*PYR(0) + IDL=0 + 200 IDL=IDL+1 + IDC=IDL+MDCY(KCA,2)-1 + RKFL=RKFL-(WDTE(IDL,1)+WDTE(IDL,IPM)+WDTE(IDL,4)) + IF(KFB.EQ.KFA) RKFL=RKFL-WDTE(IDL,5) + IF(IDL.LT.MDCY(KCA,3).AND.RKFL.GT.0D0) GOTO 200 + +C...Read out flavours and colour charges of decay channel chosen. + KCQM(JT)=KCHG(KCA,2)*ISIGN(1,K(ID,2)) + IF(KCQM(JT).EQ.-2) KCQM(JT)=2 + KFL1(JT)=KFDP(IDC,1)*ISIGN(1,K(ID,2)) + KFC1A=PYCOMP(IABS(KFL1(JT))) + IF(KCHG(KFC1A,3).EQ.0) KFL1(JT)=IABS(KFL1(JT)) + KCQ1(JT)=KCHG(KFC1A,2)*ISIGN(1,KFL1(JT)) + IF(KCQ1(JT).EQ.-2) KCQ1(JT)=2 + KFL2(JT)=KFDP(IDC,2)*ISIGN(1,K(ID,2)) + KFC2A=PYCOMP(IABS(KFL2(JT))) + IF(KCHG(KFC2A,3).EQ.0) KFL2(JT)=IABS(KFL2(JT)) + KCQ2(JT)=KCHG(KFC2A,2)*ISIGN(1,KFL2(JT)) + IF(KCQ2(JT).EQ.-2) KCQ2(JT)=2 + KFL3(JT)=KFDP(IDC,3)*ISIGN(1,K(ID,2)) + KCQ3(JT)=0 + IF(KFL3(JT).NE.0) THEN + KFC3A=PYCOMP(IABS(KFL3(JT))) + IF(KCHG(KFC3A,3).EQ.0) KFL3(JT)=IABS(KFL3(JT)) + KCQ3(JT)=KCHG(KFC3A,2)*ISIGN(1,KFL3(JT)) + IF(KCQ3(JT).EQ.-2) KCQ3(JT)=2 + ENDIF + +C...Set/save further info on channel. + KDCY(JT)=1 + IF(KFB.EQ.KFA) KEQL(JT)=MDME(IDC,1) + NSD(JT)=N + HGZ(JT,1)=VINT(111) + HGZ(JT,2)=VINT(112) + HGZ(JT,3)=VINT(114) + JTZ=JT + +C...Select masses; to begin with assume resonances narrow. + DO 220 I=1,3 + P(N+I,5)=0D0 + PMMN(I)=0D0 + IF(I.EQ.1) THEN + KFLW=IABS(KFL1(JT)) + KCW=KFC1A + ELSEIF(I.EQ.2) THEN + KFLW=IABS(KFL2(JT)) + KCW=KFC2A + ELSEIF(I.EQ.3) THEN + IF(KFL3(JT).EQ.0) GOTO 220 + KFLW=IABS(KFL3(JT)) + KCW=KFC3A + ENDIF + P(N+I,5)=PMAS(KCW,1) +CMRENNA++ +C...This prevents SUSY/t particles from becoming too light. + IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN + PMMN(I)=PMAS(KCW,1) + DO 210 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 + IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN + PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ + & PMAS(PYCOMP(KFDP(IDC,2)),1) + IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ + & PMAS(PYCOMP(KFDP(IDC,3)),1) + PMMN(I)=MIN(PMMN(I),PMSUM) + ENDIF + 210 CONTINUE +C MRENNA-- + ELSEIF(KFLW.EQ.6) THEN + PMMN(I)=PMAS(24,1)+PMAS(5,1) + ENDIF +C...UED: select a graviton mass from continuous distribution +C...(stored in PMAS(39,1) so no value returned) + IF (IUED(1).EQ.1.AND.IUED(2).EQ.1.AND.KFLW.EQ.39) + & CALL PYGRAM(1) + 220 CONTINUE + +C...Check which two out of three are widest. + IWID1=1 + IWID2=2 + PWID1=PMAS(KFC1A,2) + PWID2=PMAS(KFC2A,2) + KFLW1=IABS(KFL1(JT)) + KFLW2=IABS(KFL2(JT)) + IF(KFL3(JT).NE.0) THEN + PWID3=PMAS(KFC3A,2) + IF(PWID3.GT.PWID1.AND.PWID2.GE.PWID1) THEN + IWID1=3 + PWID1=PWID3 + KFLW1=IABS(KFL3(JT)) + ELSEIF(PWID3.GT.PWID2) THEN + IWID2=3 + PWID2=PWID3 + KFLW2=IABS(KFL3(JT)) + ENDIF + ENDIF + +C...If all narrow then only check that masses consistent. + IF(MSTP(42).LE.0.OR.(PWID1.LT.PARP(41).AND. + & PWID2.LT.PARP(41))) THEN +CMRENNA++ +C....Handle near degeneracy cases. + IF(KFA/KSUSY1.EQ.1.OR.KFA/KSUSY1.EQ.2) THEN + IF(P(N+1,5)+P(N+2,5)+P(N+3,5).GT.P(ID,5)) THEN + P(N+1,5)=P(ID,5)-P(N+2,5)-0.5D0 + IF(P(N+1,5).LT.0D0) P(N+1,5)=0D0 + ENDIF + ENDIF +CMRENNA-- + IF(P(N+1,5)+P(N+2,5)+P(N+3,5).GT.P(ID,5)) THEN + CALL PYERRM(13,'(PYRESD:) daughter masses too large') + MINT(51)=1 + GOTO 720 + ELSEIF(P(N+1,5)+P(N+2,5)+P(N+3,5)+PARJ(64).GT.P(ID,5)) THEN + CALL PYERRM(3,'(PYRESD:) daughter masses too large') + MINT(51)=1 + GOTO 720 + ENDIF + +C...For three wide resonances select narrower of three +C...according to BW decoupled from rest. + ELSE + PMTOT=P(ID,5) + IF(KFL3(JT).NE.0) THEN + IWID3=6-IWID1-IWID2 + KFLW3=IABS(KFL1(JT))+IABS(KFL2(JT))+IABS(KFL3(JT))- + & KFLW1-KFLW2 + LOOP=0 + 230 LOOP=LOOP+1 + P(N+IWID3,5)=PYMASS(KFLW3) + IF(LOOP.LE.10.AND. P(N+IWID3,5).LE.PMMN(IWID3)) GOTO 230 + PMTOT=PMTOT-P(N+IWID3,5) + ENDIF +C...Select other two correlated within remaining phase space. + IF(IP.EQ.1) THEN + CKIN45=CKIN(45) + CKIN47=CKIN(47) + CKIN(45)=MAX(PMMN(IWID1),CKIN(45)) + CKIN(47)=MAX(PMMN(IWID2),CKIN(47)) + CALL PYOFSH(2,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5), + & P(N+IWID2,5)) + CKIN(45)=CKIN45 + CKIN(47)=CKIN47 + ELSE + CKIN(49)=PMMN(IWID1) + CKIN(50)=PMMN(IWID2) + CALL PYOFSH(5,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5), + & P(N+IWID2,5)) + CKIN(49)=0D0 + CKIN(50)=0D0 + ENDIF + IF(MINT(51).EQ.1) GOTO 720 + ENDIF + +C...Begin fill decay products, with colour flow for coloured objects. + MSTU10=MSTU(10) + MSTU(10)=1 + MSTU(19)=1 + +C...Three-body decays + IF(KFL3(JT).NE.0) THEN + DO 250 I=N+1,N+3 + DO 240 J=1,5 + K(I,J)=0 + V(I,J)=0D0 + 240 CONTINUE + MCT(I,1)=0 + MCT(I,2)=0 + 250 CONTINUE + K(N+1,1)=1 + K(N+1,2)=KFL1(JT) + K(N+2,1)=1 + K(N+2,2)=KFL2(JT) + K(N+3,1)=1 + K(N+3,2)=KFL3(JT) + IDIN=ID + +C...Generate kinematics (default is flat) + CALL PYTBDY(IDIN) + +C...Set generic colour flows whenever unambiguous, +C...(independently of the order of the decay products) +C...Sum up total colour content + NANT=0 + NTRI=0 + NOCT=0 + KCQ(0)=KCQM(JT) + KCQ(1)=KCQ1(JT) + KCQ(2)=KCQ2(JT) + KCQ(3)=KCQ3(JT) + DO 255 J=0,3 + IF (KCQ(J).EQ.-1) THEN + NANT=NANT+1 + IANT(NANT)=N+J + ELSEIF (KCQ(J).EQ.1) THEN + NTRI=NTRI+1 + ITRI(NTRI)=N+J + ELSEIF (KCQ(J).EQ.2) THEN + NOCT=NOCT+1 + IOCT(NOCT)=N+J + ENDIF + 255 CONTINUE + +C...Set color flow for generic 1 -> N processes (N arbitrary) + IF (NTRI.EQ.0.AND.NANT.EQ.0.AND.NOCT.EQ.0) THEN +C...All singlets: do nothing + + ELSEIF (NOCT.EQ.2.AND.NTRI.EQ.0.AND.NANT.EQ.0) THEN +C...Two octets, zero triplets, n singlets: + IF (KCQ(0).EQ.2) THEN +C...8 -> 8 + n(1) + K(ID,4)=K(ID,4)+IOCT(2) + K(ID,5)=K(ID,5)+IOCT(2) + K(IOCT(2),1)=3 + K(IOCT(2),4)=MSTU(5)*ID + K(IOCT(2),5)=MSTU(5)*ID + MCT(IOCT(2),1)=MCT(ID,1) + MCT(IOCT(2),2)=MCT(ID,2) + ELSE +C...1 -> 8 + 8 + n(1) + K(IOCT(1),1)=3 + K(IOCT(1),4)=MSTU(5)*IOCT(2) + K(IOCT(1),5)=MSTU(5)*IOCT(2) + K(IOCT(2),1)=3 + K(IOCT(2),4)=MSTU(5)*IOCT(1) + K(IOCT(2),5)=MSTU(5)*IOCT(1) + NCT=NCT+1 + MCT(IOCT(1),1)=NCT + MCT(IOCT(2),2)=NCT + NCT=NCT+1 + MCT(IOCT(2),1)=NCT + MCT(IOCT(1),2)=NCT + ENDIF + + ELSEIF (NTRI+NANT.EQ.2.AND.NOCT.EQ.0) THEN +C...Two triplets, zero octets, n singlets. + IF (KCQ(0).EQ.1) THEN +C...3 -> 3 + n(1) + K(ID,4)=K(ID,4)+ITRI(2) + K(ITRI(2),1)=3 + K(ITRI(2),4)=MSTU(5)*ID + MCT(ITRI(2),1)=MCT(ID,1) + ELSEIF (KCQ(0).EQ.-1) THEN +C...3bar -> 3bar + n(1) + K(ID,5)=K(ID,5)+IANT(2) + K(IANT(2),1)=3 + K(IANT(2),5)=MSTU(5)*ID + MCT(IANT(2),2)=MCT(ID,2) + ELSE +C...1 -> 3 + 3bar + n(1) + K(ITRI(1),1)=3 + K(ITRI(1),4)=MSTU(5)*IANT(1) + K(IANT(1),1)=3 + K(IANT(1),5)=MSTU(5)*ITRI(1) + NCT=NCT+1 + MCT(ITRI(1),1)=NCT + MCT(IANT(1),2)=NCT + ENDIF + + ELSEIF(NTRI+NANT.EQ.2.AND.NOCT.EQ.1) THEN +C...Two triplets, one octet, n singlets. + IF (KCQ(0).EQ.2) THEN +C...8 -> 3 + 3bar + n(1) + K(ID,4)=K(ID,4)+ITRI(1) + K(ID,5)=K(ID,5)+IANT(1) + K(ITRI(1),1)=3 + K(ITRI(1),4)=MSTU(5)*ID + K(IANT(1),1)=3 + K(IANT(1),5)=MSTU(5)*ID + MCT(ITRI(1),1)=MCT(ID,1) + MCT(IANT(1),2)=MCT(ID,2) + ELSEIF (KCQ(0).EQ.1) THEN +C...3 -> 8 + 3 + n(1) + K(ID,4)=K(ID,4)+IOCT(1) + K(IOCT(1),1)=3 + K(IOCT(1),4)=MSTU(5)*ID + K(IOCT(1),5)=MSTU(5)*ITRI(2) + K(ITRI(2),1)=3 + K(ITRI(2),4)=MSTU(5)*IOCT(1) + MCT(IOCT(1),1)=MCT(ID,1) + NCT=NCT+1 + MCT(IOCT(1),2)=NCT + MCT(ITRI(2),1)=NCT + ELSEIF (KCQ(0).EQ.-1) THEN +C...3bar -> 8 + 3bar + n(1) + K(ID,5)=K(ID,5)+IOCT(1) + K(IOCT(1),1)=3 + K(IOCT(1),5)=MSTU(5)*ID + K(IOCT(1),4)=MSTU(5)*IANT(2) + K(IANT(2),1)=3 + K(IANT(2),5)=MSTU(5)*IOCT(1) + MCT(IOCT(1),2)=MCT(ID,2) + NCT=NCT+1 + MCT(IOCT(1),1)=NCT + MCT(IANT(2),2)=NCT + ELSE +C...1 -> 3 + 3bar + 8 + n(1) + K(ITRI(1),1)=3 + K(ITRI(1),4)=MSTU(5)*IOCT(1) + K(IOCT(1),1)=3 + K(IOCT(1),5)=MSTU(5)*ITRI(1) + K(IOCT(1),4)=MSTU(5)*IANT(1) + K(IANT(1),1)=3 + K(IANT(1),5)=MSTU(5)*IOCT(1) + NCT=NCT+1 + MCT(ITRI(1),1)=NCT + MCT(IOCT(1),2)=NCT + NCT=NCT+1 + MCT(IOCT(1),1)=NCT + MCT(IANT(1),2)=NCT + ENDIF +CPS-- End of generic cases +C...(could three octets also be handled?) +C...(could (some of) the RPV cases be made generic as well?) + +C...Special cases (= old treatment) +C...Set colour flow for t -> W + b + Z. + ELSEIF(KFA.EQ.6) THEN + K(N+2,1)=3 + ISID=4 + IF(KCQM(JT).EQ.-1) ISID=5 + IDAU=N+2 + K(ID,ISID)=K(ID,ISID)+IDAU + K(IDAU,ISID)=MSTU(5)*ID + +C...Set colour flow in three-body decays - programmed as special cases. + + ELSEIF(KFC2A.LE.6) THEN + K(N+2,1)=3 + K(N+3,1)=3 + ISID=4 + IF(KFL2(JT).LT.0) ISID=5 + K(N+2,ISID)=MSTU(5)*(N+3) + K(N+3,9-ISID)=MSTU(5)*(N+2) +C...PS++: Bugfix 16 MAR 2006 for 3-body squark decays (e.g. via SLHA) + ELSEIF(KFA.GT.KSUSY1.AND.MOD(KFA,KSUSY1).LT.10 + & .AND.KFL3(JT).NE.0) THEN + KQSUMA=IABS(KCQ1(JT))+IABS(KCQ2(JT))+IABS(KCQ3(JT)) +C...3-body decays of squarks to colour singlets plus one quark + IF (KQSUMA.EQ.1) THEN +C...Find quark + IQ=0 + IF (KCQ1(JT).NE.0) IQ=1 + IF (KCQ2(JT).NE.0) IQ=2 + IF (KCQ3(JT).NE.0) IQ=3 + ISID=4 + IF (K(N+IQ,2).LT.0) ISID=5 + K(N+IQ,1)=3 + K(ID,ISID)=K(ID,ISID)+(N+IQ) + K(N+IQ,ISID)=MSTU(5)*ID + ENDIF +C...PS-- + ELSEIF(KFL1(JT).EQ.KSUSY1+21) THEN + K(N+1,1)=3 + K(N+2,1)=3 + K(N+3,1)=3 + ISID=4 + IF(KFL2(JT).LT.0) ISID=5 + K(N+1,ISID)=MSTU(5)*(N+2) + K(N+1,9-ISID)=MSTU(5)*(N+3) + K(N+2,ISID)=MSTU(5)*(N+1) + K(N+3,9-ISID)=MSTU(5)*(N+1) + ELSEIF(KFA.EQ.KSUSY1+21) THEN + K(N+2,1)=3 + K(N+3,1)=3 + ISID=4 + IF(KFL2(JT).LT.0) ISID=5 + K(ID,ISID)=K(ID,ISID)+(N+2) + K(ID,9-ISID)=K(ID,9-ISID)+(N+3) + K(N+2,ISID)=MSTU(5)*ID + K(N+3,9-ISID)=MSTU(5)*ID +CMRENNA-- + + ELSEIF(KFA.GE.KSUSY1+22.AND.KFA.LE.KSUSY1+37.AND. + & IABS(KCQ2(JT)).EQ.1) THEN + K(N+2,1)=3 + K(N+3,1)=3 + ISID=4 + IF(KFL2(JT).LT.0) ISID=5 + K(N+2,ISID)=MSTU(5)*(N+3) + K(N+3,9-ISID)=MSTU(5)*(N+2) + ENDIF + + NSAV=N + +C...Set colour flow in three-body decays with baryon number violation. +C...Neutralino and chargino decays first. + KCQSUM=KCQ1(JT)+KCQ2(JT)+KCQ3(JT) + IF(KCQM(JT).EQ.0.AND.IABS(KCQSUM).EQ.3) THEN + ITJUNC(JT)=(1+(1-KCQ1(JT))/2) + K(N+4,4)=ITJUNC(JT)*MSTU(5) +C...Insert junction to keep track of colours. + IF(KCQ1(JT).NE.0) K(N+1,1)=3 + IF(KCQ2(JT).NE.0) K(N+2,1)=3 + IF(KCQ3(JT).NE.0) K(N+3,1)=3 +C...Set special junction codes: + K(N+4,1)=42 + K(N+4,2)=88 + +C...Order decay products by invariant mass. (will be used in PYSTRF). + PM12=P(N+1,4)*P(N+2,4)-P(N+1,1)*P(N+2,1)-P(N+1,2)*P(N+2,2)- + & P(N+1,3)*P(N+2,3) + PM13=P(N+1,4)*P(N+3,4)-P(N+1,1)*P(N+3,1)-P(N+1,2)*P(N+3,2)- + & P(N+1,3)*P(N+3,3) + PM23=P(N+2,4)*P(N+3,4)-P(N+2,1)*P(N+3,1)-P(N+2,2)*P(N+3,2)- + & P(N+2,3)*P(N+3,3) + IF(PM12.LT.PM13.AND.PM12.LT.PM23) THEN + K(N+4,4)=N+3+K(N+4,4) + K(N+4,5)=N+1+MSTU(5)*(N+2) + ELSEIF(PM13.LT.PM23) THEN + K(N+4,4)=N+2+K(N+4,4) + K(N+4,5)=N+1+MSTU(5)*(N+3) + ELSE + K(N+4,4)=N+1+K(N+4,4) + K(N+4,5)=N+2+MSTU(5)*(N+3) + ENDIF + DO 260 J=1,5 + P(N+4,J)=0D0 + V(N+4,J)=0D0 + 260 CONTINUE +C...Connect daughters to junction. + DO 270 II=N+1,N+3 + K(II,4)=0 + K(II,5)=0 + K(II,ITJUNC(JT)+3)=MSTU(5)*(N+4) + 270 CONTINUE +C...Particle counter should be stepped up one extra for junction. + N=N+1 + +C...Gluino decays. + ELSEIF (KCQM(JT).EQ.2.AND.IABS(KCQSUM).EQ.3) THEN + ITJUNC(JT)=(5+(1-KCQ1(JT))/2) + K(N+4,4)=ITJUNC(JT)*MSTU(5) +C...Insert junction to keep track of colours. + IF(KCQ1(JT).NE.0) K(N+1,1)=3 + IF(KCQ2(JT).NE.0) K(N+2,1)=3 + IF(KCQ3(JT).NE.0) K(N+3,1)=3 + K(N+4,1)=42 + K(N+4,2)=88 + DO 280 J=1,5 + P(N+4,J)=0D0 + V(N+4,J)=0D0 + 280 CONTINUE + CTMSUM=0D0 + DO 290 II=N+1,N+3 + K(II,4)=0 + K(II,5)=0 +C...Start by connecting all daughters to junction. + K(II,ITJUNC(JT)-1)=MSTU(5)*(N+4) +C...Only consider colour topologies with off shell resonances. + RMQ1=PMAS(PYCOMP(K(II,2)),1) + RMRES=PMAS(PYCOMP(KSUSY1+IABS(K(II,2))),1) + RMGLU=PMAS(PYCOMP(KSUSY1+21),1) + IF (RMGLU-RMQ1.LT.RMRES) THEN +C...Calculate propagators for each colour topology. + RM2Q23=RMGLU**2+RMQ1**2-2D0*(P(II,4)*P(ID,4)+P(II,1) + & *P(ID,1)+P(II,2)*P(ID,2)+P(II,3)*P(ID,3)) + CTM2(II-N)=1D0/(RM2Q23-RMRES**2)**2 + ELSE + CTM2(II-N)=0D0 + ENDIF + CTMSUM=CTMSUM+CTM2(II-N) + 290 CONTINUE + CTMSUM=PYR(0)*CTMSUM +C...Select colour topology J, with most off shell least likely. + J=0 + 300 J=J+1 + CTMSUM=CTMSUM-CTM2(J) + IF (CTMSUM.GT.0D0) GOTO 300 +C...The lucky winner gets its colour (anti-colour) directly from gluino. + K(N+J,ITJUNC(JT)-1)=MSTU(5)*ID + K(ID,ITJUNC(JT)-1)=N+J+(K(ID,ITJUNC(JT)-1)/MSTU(5))*MSTU(5) +C...The other gluino colour is connected to junction + K(ID,10-ITJUNC(JT))=N+4+(K(ID,10-ITJUNC(JT))/MSTU(5))* + & MSTU(5) + K(N+4,4)=K(N+4,4)+ID +C...Lastly, connect junction to remaining daughters. + K(N+4,5)=N+1+MOD(J,3)+MSTU(5)*(N+1+MOD(J+1,3)) +C...Particle counter should be stepped up one extra for junction. + N=N+1 + ENDIF + +C...Update particle counter. + N=N+3 + +C...2) Everything else two-body decay. + ELSE + CALL PY2ENT(N+1,KFL1(JT),KFL2(JT),P(ID,5)) + MCT(N-1,1)=0 + MCT(N-1,2)=0 + MCT(N,1)=0 + MCT(N,2)=0 +C...First set colour flow as if mother colour singlet. + IF(KCQ1(JT).NE.0) THEN + K(N-1,1)=3 + IF(KCQ1(JT).NE.-1) K(N-1,4)=MSTU(5)*N + IF(KCQ1(JT).NE.1) K(N-1,5)=MSTU(5)*N + ENDIF + IF(KCQ2(JT).NE.0) THEN + K(N,1)=3 + IF(KCQ2(JT).NE.-1) K(N,4)=MSTU(5)*(N-1) + IF(KCQ2(JT).NE.1) K(N,5)=MSTU(5)*(N-1) + ENDIF +C...Then redirect colour flow if mother (anti)triplet. + IF(KCQM(JT).EQ.0) THEN + ELSEIF(KCQM(JT).NE.2) THEN + ISID=4 + IF(KCQM(JT).EQ.-1) ISID=5 + IDAU=N-1 + IF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.2) IDAU=N + K(ID,ISID)=K(ID,ISID)+IDAU + K(IDAU,ISID)=MSTU(5)*ID +C...Then redirect colour flow if mother octet. + ELSEIF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.0) THEN + IDAU=N-1 + IF(KCQ1(JT).EQ.0) IDAU=N + K(ID,4)=K(ID,4)+IDAU + K(ID,5)=K(ID,5)+IDAU + K(IDAU,4)=MSTU(5)*ID + K(IDAU,5)=MSTU(5)*ID + ELSE + ISID=4 + IF(KCQ1(JT).EQ.-1) ISID=5 + IF(KCQ1(JT).EQ.2) ISID=INT(4.5D0+PYR(0)) + K(ID,ISID)=K(ID,ISID)+(N-1) + K(ID,9-ISID)=K(ID,9-ISID)+N + K(N-1,ISID)=MSTU(5)*ID + K(N,9-ISID)=MSTU(5)*ID + ENDIF + +C...Insert junction + IF(IABS(KCQ1(JT)+KCQ2(JT)-KCQM(JT)).EQ.3) THEN + N=N+1 +C...~q* mother: type 3 junction. ~q mother: type 4. + ITJUNC(JT)=(7+KCQM(JT))/2 +C...Specify junction KF and set colour flow from junction + K(N,1)=42 + K(N,2)=88 + K(N,3)=ID +C...Junction type encoded together with mother: + K(N,4)=ID+ITJUNC(JT)*MSTU(5) + K(N,5)=N-1+MSTU(5)*(N-2) +C...Zero P and V for junction (V filled later) + DO 310 J=1,5 + P(N,J)=0D0 + V(N,J)=0D0 + 310 CONTINUE +C...Set colour flow from mother to junction + K(ID,8-ITJUNC(JT))= N + MSTU(5)*(K(ID,8-ITJUNC(JT))/MSTU(5)) +C...Set colour flow from daughters to junction + DO 320 II=N-2,N-1 + K(II,4) = 0 + K(II,5) = 0 +C...(Anti-)colour mother is junction. + K(II,1+ITJUNC(JT)) = MSTU(5)*(N) + 320 CONTINUE + ENDIF + ENDIF + +C...End loop over resonances for daughter flavour and mass selection. + MSTU(10)=MSTU10 + 330 IF(MWID(KCA).NE.0.AND.(KFL1(JT).EQ.0.OR.KFL3(JT).NE.0)) + & NINH=NINH+1 + IF(IRES.GT.0.AND.MWID(KCA).NE.0.AND.MDCY(KCA,1).NE.0.AND. + & KFL1(JT).EQ.0) THEN + WRITE(CODE,'(I9)') K(ID,2) + WRITE(MASS,'(F9.3)') P(ID,5) + CALL PYERRM(3,'(PYRESD:) Failed to decay particle'// + & CODE//' with mass'//MASS) + MINT(51)=1 + GOTO 720 + ENDIF + 340 CONTINUE + +C...Check for allowed combinations. Skip if no decays. + IF(JTMAX.EQ.1) THEN + IF(KDCY(1).EQ.0) GOTO 710 + ELSEIF(JTMAX.EQ.2) THEN + IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0) GOTO 710 + IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 180 + IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 180 + ELSEIF(JTMAX.EQ.3) THEN + IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0.AND.KDCY(3).EQ.0) GOTO 710 + IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 180 + IF(KEQL(1).EQ.4.AND.KEQL(3).EQ.4) GOTO 180 + IF(KEQL(2).EQ.4.AND.KEQL(3).EQ.4) GOTO 180 + IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 180 + IF(KEQL(1).EQ.5.AND.KEQL(3).EQ.5) GOTO 180 + IF(KEQL(2).EQ.5.AND.KEQL(3).EQ.5) GOTO 180 + ENDIF + +C...Special case: matrix element option for Z0 decay to quarks. + IF(MSTP(48).EQ.1.AND.ISUB.EQ.1.AND.JTMAX.EQ.1.AND. + &IABS(MINT(11)).EQ.11.AND.IABS(KFL1(1)).LE.5) THEN + +C...Check consistency of MSTJ options set. + IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN + CALL PYERRM(6, + & '(PYRESD:) MSTJ(109) value requires MSTJ(110) = 1') + MSTJ(110)=1 + ENDIF + IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN + CALL PYERRM(6, + & '(PYRESD:) MSTJ(109) value requires MSTJ(111) = 0') + + MSTJ(111)=0 + ENDIF + +C...Select alpha_strong behaviour. + MST111=MSTU(111) + PAR112=PARU(112) + MSTU(111)=MSTJ(108) + IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) + & MSTU(111)=1 + PARU(112)=PARJ(121) + IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) + +C...Find axial fraction in total cross section for scalar gluon model. + PARJ(171)=0D0 + IF((IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.1).OR. + & (MSTJ(101).EQ.5.AND.MSTJ(49).EQ.1)) THEN + POLL=1D0-PARJ(131)*PARJ(132) + SFF=1D0/(16D0*XW*XW1) + SFW=P(ID,5)**4/((P(ID,5)**2-PARJ(123)**2)**2+ + & (PARJ(123)*PARJ(124))**2) + SFI=SFW*(1D0-(PARJ(123)/P(ID,5))**2) + VE=4D0*XW-1D0 + HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) + HF1W=SFW*SFF**2*((VE**2+1D0)*POLL+2D0*VE* + & (PARJ(132)-PARJ(131))) + KFLC=IABS(KFL1(1)) + PMQ=PYMASS(KFLC) + QF=KCHG(KFLC,1)/3D0 + VQ=1D0 + IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0, + & 1D0-(2D0*PMQ/P(ID,5))**2)) + VF=SIGN(1D0,QF)-4D0*QF*XW + RFV=0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-2D0*QF*VF*HF1I+ + & VF**2*HF1W)+VQ**3*HF1W + IF(RFV.GT.0D0) PARJ(171)=MIN(1D0,VQ**3*HF1W/RFV) + ENDIF + +C...Choice of jet configuration. + CALL PYXJET(P(ID,5),NJET,CUT) + KFLC=IABS(KFL1(1)) + KFLN=21 + IF(NJET.EQ.4) THEN + CALL PYX4JT(NJET,CUT,KFLC,P(ID,5),KFLN,X1,X2,X4,X12,X14) + ELSEIF(NJET.EQ.3) THEN + CALL PYX3JT(NJET,CUT,KFLC,P(ID,5),X1,X3) + ELSE + MSTJ(120)=1 + ENDIF + +C...Fill jet configuration; return if incorrect kinematics. + NC=N-2 + IF(NJET.EQ.2.AND.MSTJ(101).NE.5) THEN + CALL PY2ENT(NC+1,KFLC,-KFLC,P(ID,5)) + ELSEIF(NJET.EQ.2) THEN + CALL PY2ENT(-(NC+1),KFLC,-KFLC,P(ID,5)) + ELSEIF(NJET.EQ.3) THEN + CALL PY3ENT(NC+1,KFLC,21,-KFLC,P(ID,5),X1,X3) + ELSEIF(KFLN.EQ.21) THEN + CALL PY4ENT(NC+1,KFLC,KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4, + & X12,X14) + ELSE + CALL PY4ENT(NC+1,KFLC,-KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4, + & X12,X14) + ENDIF + IF(MSTU(24).NE.0) THEN + MINT(51)=1 + MSTU(111)=MST111 + PARU(112)=PAR112 + GOTO 720 + ENDIF + +C...Angular orientation according to matrix element. + IF(MSTJ(106).EQ.1) THEN + CALL PYXDIF(NC,NJET,KFLC,P(ID,5),CHIZ,THEZ,PHIZ) + IF(MINT(11).LT.0) THEZ=PARU(1)-THEZ + CTHE(1)=COS(THEZ) + CALL PYROBO(NC+1,N,0D0,CHIZ,0D0,0D0,0D0) + CALL PYROBO(NC+1,N,THEZ,PHIZ,0D0,0D0,0D0) + ENDIF + +C...Boost partons to Z0 rest frame. + CALL PYROBO(NC+1,N,0D0,0D0,P(ID,1)/P(ID,4), + & P(ID,2)/P(ID,4),P(ID,3)/P(ID,4)) + +C...Mark decayed resonance and add documentation lines, + K(ID,1)=K(ID,1)+10 + IDOC=MINT(83)+MINT(4) + DO 360 I=NC+1,N + I1=MINT(83)+MINT(4)+1 + K(I,3)=I1 + IF(MSTP(128).GE.1) K(I,3)=ID + IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN + MINT(4)=MINT(4)+1 + K(I1,1)=21 + K(I1,2)=K(I,2) + K(I1,3)=IREF(IP,4) + DO 350 J=1,5 + P(I1,J)=P(I,J) + 350 CONTINUE + ENDIF + 360 CONTINUE + +C...Generate parton shower. + IF(MSTJ(101).EQ.5.AND.MINT(35).LE.1) THEN + CALL PYSHOW(N-1,N,P(ID,5)) + ELSEIF(MSTJ(101).EQ.5.AND.MINT(35).GE.2) THEN + NPART=2 + IPART(1)=N-1 + IPART(2)=N + PTPART(1)=0.5D0*P(ID,5) + PTPART(2)=PTPART(1) + NCT=NCT+1 + IF(K(N-1,2).GT.0) THEN + MCT(N-1,1)=NCT + MCT(N,2)=NCT + ELSE + MCT(N-1,2)=NCT + MCT(N,1)=NCT + ENDIF + CALL PYPTFS(2,0.5D0*P(ID,5),0D0,PTGEN) + ENDIF + +C... End special case for Z0: skip ahead. + MSTU(111)=MST111 + PARU(112)=PAR112 + GOTO 700 + ENDIF + +C...Order incoming partons and outgoing resonances. + IF(JTMAX.EQ.2.AND.ISUB.NE.0.AND.MSTP(47).GE.1.AND. + &NINH.EQ.0) THEN + ILIN(1)=MINT(84)+1 + IF(K(MINT(84)+1,2).GT.0) ILIN(1)=MINT(84)+2 + IF(K(ILIN(1),2).EQ.21.OR.K(ILIN(1),2).EQ.22) + & ILIN(1)=2*MINT(84)+3-ILIN(1) + ILIN(2)=2*MINT(84)+3-ILIN(1) + IMIN=1 + IF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR.IREF(IP,7) + & .EQ.36) IMIN=3 + IMAX=2 + IORD=1 + IF(K(IREF(IP,1),2).EQ.23) IORD=2 + IF(K(IREF(IP,1),2).EQ.24.AND.K(IREF(IP,2),2).EQ.-24) IORD=2 + IAKIPD=IABS(K(IREF(IP,IORD),2)) + IF(IAKIPD.EQ.25.OR.IAKIPD.EQ.35.OR.IAKIPD.EQ.36) IORD=3-IORD + IF(KDCY(IORD).EQ.0) IORD=3-IORD + +C...Order decay products of resonances. + DO 370 JT=IORD,3-IORD,3-2*IORD + IF(KDCY(JT).EQ.0) THEN + ILIN(IMAX+1)=NSD(JT) + IMAX=IMAX+1 + ELSEIF(K(NSD(JT)+1,2).GT.0) THEN + ILIN(IMAX+1)=N+2*JT-1 + ILIN(IMAX+2)=N+2*JT + IMAX=IMAX+2 + K(N+2*JT-1,2)=K(NSD(JT)+1,2) + K(N+2*JT,2)=K(NSD(JT)+2,2) + ELSE + ILIN(IMAX+1)=N+2*JT + + ILIN(IMAX+2)=N+2*JT-1 + IMAX=IMAX+2 + K(N+2*JT-1,2)=K(NSD(JT)+1,2) + K(N+2*JT,2)=K(NSD(JT)+2,2) + ENDIF + 370 CONTINUE + +C...Find charge, isospin, left- and righthanded couplings. + DO 390 I=IMIN,IMAX + DO 380 J=1,4 + COUP(I,J)=0D0 + 380 CONTINUE + KFA=IABS(K(ILIN(I),2)) + IF(KFA.EQ.0.OR.KFA.GT.20) GOTO 390 + COUP(I,1)=KCHG(KFA,1)/3D0 + COUP(I,2)=(-1)**MOD(KFA,2) + COUP(I,4)=-2D0*COUP(I,1)*XWV + COUP(I,3)=COUP(I,2)+COUP(I,4) + 390 CONTINUE + +C...Full propagator dependence and flavour correlations for 2 gamma*/Z. + IF(ISUB.EQ.22) THEN + DO 420 I=3,5,2 + I1=IORD + IF(I.EQ.5) I1=3-IORD + DO 410 J1=1,2 + DO 400 J2=1,2 + CORL(I/2,J1,J2)=COUP(1,1)**2*HGZ(I1,1)*COUP(I,1)**2/ + & 16D0+COUP(1,1)*COUP(1,J1+2)*HGZ(I1,2)*COUP(I,1)* + & COUP(I,J2+2)/4D0+COUP(1,J1+2)**2*HGZ(I1,3)* + & COUP(I,J2+2)**2 + 400 CONTINUE + 410 CONTINUE + 420 CONTINUE + COWT12=(CORL(1,1,1)+CORL(1,1,2))*(CORL(2,1,1)+CORL(2,1,2))+ + & (CORL(1,2,1)+CORL(1,2,2))*(CORL(2,2,1)+CORL(2,2,2)) + COMX12=(CORL(1,1,1)+CORL(1,1,2)+CORL(1,2,1)+CORL(1,2,2))* + & (CORL(2,1,1)+CORL(2,1,2)+CORL(2,2,1)+CORL(2,2,2)) + + IF(COWT12.LT.PYR(0)*COMX12) GOTO 180 + ENDIF + ENDIF + +C...Select angular orientation type - Z'/W' only. + MZPWP=0 + IF(ISUB.EQ.141) THEN + IF(PYR(0).LT.PARU(130)) MZPWP=1 + IF(IP.EQ.2) THEN + IF(IABS(K(IREF(2,1),2)).EQ.37) MZPWP=2 + IAKIR=IABS(K(IREF(2,2),2)) + IF(IAKIR.EQ.25.OR.IAKIR.EQ.35.OR.IAKIR.EQ.36) MZPWP=2 + IF(IAKIR.LE.20) MZPWP=2 + ENDIF + IF(IP.GE.3) MZPWP=2 + ELSEIF(ISUB.EQ.142) THEN + IF(PYR(0).LT.PARU(136)) MZPWP=1 + IF(IP.EQ.2) THEN + IAKIR=IABS(K(IREF(2,2),2)) + IF(IAKIR.EQ.25.OR.IAKIR.EQ.35.OR.IAKIR.EQ.36) MZPWP=2 + IF(IAKIR.LE.20) MZPWP=2 + ENDIF + IF(IP.GE.3) MZPWP=2 + ENDIF + +C...Select random angles (begin of weighting procedure). + 430 DO 440 JT=1,JTMAX + IF(KDCY(JT).EQ.0) GOTO 440 + IF(JTMAX.EQ.1.AND.ISUB.NE.0.AND.IHDEC.EQ.0) THEN + CTHE(JT)=VINT(13)+(VINT(33)-VINT(13)+VINT(34)-VINT(14))*PYR(0) + IF(CTHE(JT).GT.VINT(33)) CTHE(JT)=CTHE(JT)+VINT(14)-VINT(33) + PHI(JT)=VINT(24) + ELSE + CTHE(JT)=2D0*PYR(0)-1D0 + PHI(JT)=PARU(2)*PYR(0) + ENDIF + 440 CONTINUE + + IF(JTMAX.EQ.2.AND.MSTP(47).GE.1.AND.NINH.EQ.0) THEN +C...Construct massless four-vectors. + DO 460 I=N+1,N+4 + K(I,1)=1 + DO 450 J=1,5 + P(I,J)=0D0 + V(I,J)=0D0 + 450 CONTINUE + 460 CONTINUE + DO 470 JT=1,JTMAX + IF(KDCY(JT).EQ.0) GOTO 470 + ID=IREF(IP,JT) + P(N+2*JT-1,3)=0.5D0*P(ID,5) + P(N+2*JT-1,4)=0.5D0*P(ID,5) + P(N+2*JT,3)=-0.5D0*P(ID,5) + P(N+2*JT,4)=0.5D0*P(ID,5) + CALL PYROBO(N+2*JT-1,N+2*JT,ACOS(CTHE(JT)),PHI(JT), + & P(ID,1)/P(ID,4),P(ID,2)/P(ID,4),P(ID,3)/P(ID,4)) + 470 CONTINUE + +C...Store incoming and outgoing momenta, with random rotation to +C...avoid accidental zeroes in HA expressions. + IF(ISUB.NE.0) THEN + DO 490 I=IMIN,IMAX + K(N+4+I,1)=1 + P(N+4+I,4)=SQRT(P(ILIN(I),1)**2+P(ILIN(I),2)**2+ + & P(ILIN(I),3)**2+P(ILIN(I),5)**2) + P(N+4+I,5)=P(ILIN(I),5) + DO 480 J=1,3 + P(N+4+I,J)=P(ILIN(I),J) + 480 CONTINUE + 490 CONTINUE + 500 THERR=ACOS(2D0*PYR(0)-1D0) + PHIRR=PARU(2)*PYR(0) + CALL PYROBO(N+4+IMIN,N+4+IMAX,THERR,PHIRR,0D0,0D0,0D0) + DO 520 I=IMIN,IMAX + IF(P(N+4+I,1)**2+P(N+4+I,2)**2.LT.1D-4*(P(N+4+I,1)**2+ + & P(N+4+I,2)**2+P(N+4+I,3)**2)) GOTO 500 + DO 510 J=1,4 + PK(I,J)=P(N+4+I,J) + 510 CONTINUE + 520 CONTINUE + ENDIF + +C...Calculate internal products. + IF(ISUB.EQ.22.OR.ISUB.EQ.23.OR.ISUB.EQ.25.OR.ISUB.EQ.141.OR. + & ISUB.EQ.142) THEN + DO 540 I1=IMIN,IMAX-1 + DO 530 I2=I1+1,IMAX + HA(I1,I2)=SNGL(SQRT((PK(I1,4)-PK(I1,3))*(PK(I2,4)+ + & PK(I2,3))/(1D-20+PK(I1,1)**2+PK(I1,2)**2)))* + & CMPLX(SNGL(PK(I1,1)),SNGL(PK(I1,2)))- + & SNGL(SQRT((PK(I1,4)+PK(I1,3))*(PK(I2,4)-PK(I2,3))/ + & (1D-20+PK(I2,1)**2+PK(I2,2)**2)))* + & CMPLX(SNGL(PK(I2,1)),SNGL(PK(I2,2))) + HC(I1,I2)=CONJG(HA(I1,I2)) + IF(I1.LE.2) HA(I1,I2)=CMPLX(0.,1.)*HA(I1,I2) + IF(I1.LE.2) HC(I1,I2)=CMPLX(0.,1.)*HC(I1,I2) + HA(I2,I1)=-HA(I1,I2) + HC(I2,I1)=-HC(I1,I2) + 530 CONTINUE + 540 CONTINUE + ENDIF + +C...Calculate four-products. + IF(ISUB.NE.0) THEN + DO 560 I=1,2 + DO 550 J=1,4 + PK(I,J)=-PK(I,J) + 550 CONTINUE + 560 CONTINUE + DO 580 I1=IMIN,IMAX-1 + DO 570 I2=I1+1,IMAX + PKK(I1,I2)=2D0*(PK(I1,4)*PK(I2,4)-PK(I1,1)*PK(I2,1)- + & PK(I1,2)*PK(I2,2)-PK(I1,3)*PK(I2,3)) + PKK(I2,I1)=PKK(I1,I2) + 570 CONTINUE + 580 CONTINUE + ENDIF + ENDIF + + KFAGM=IABS(IREF(IP,7)) + IF(MSTP(47).LE.0.OR.NINH.NE.0) THEN +C...Isotropic decay selected by user. + WT=1D0 + WTMAX=1D0 + + ELSEIF(JTMAX.EQ.3) THEN +C...Isotropic decay when three mother particles. + WT=1D0 + WTMAX=1D0 + + ELSEIF(IT4.GE.1) THEN +C... Isotropic decay t -> b + W etc for 4th generation q and l. + WT=1D0 + WTMAX=1D0 + + ELSEIF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR. + & IREF(IP,7).EQ.36) THEN +C...Angular weight for h0/A0 -> Z0 + Z0 or W+ + W- -> 4 quarks/leptons. +C...CP-odd case added by Kari Ertresvag Myklevoll. +C...Now also with mixed Higgs CP-states + ETA=PARP(25) + IF(IP.EQ.1) WTMAX=SH**2 + IF(IP.GE.2) WTMAX=P(IREF(IP,8),5)**4 + KFA=IABS(K(IREF(IP,1),2)) + KFT=IABS(K(IREF(IP,2),2)) + + IF((KFA.EQ.KFT).AND.(KFA.EQ.23.OR.KFA.EQ.24).AND. + & MSTP(25).GE.3) THEN +C...For mixed CP states need epsilon product. + P10=PK(3,4) + P20=PK(4,4) + P30=PK(5,4) + P40=PK(6,4) + P11=PK(3,1) + P21=PK(4,1) + P31=PK(5,1) + P41=PK(6,1) + P12=PK(3,2) + P22=PK(4,2) + P32=PK(5,2) + P42=PK(6,2) + P13=PK(3,3) + P23=PK(4,3) + P33=PK(5,3) + P43=PK(6,3) + EPSI=P10*P21*P32*P43-P10*P21*P33*P42-P10*P22*P31*P43+P10*P22* + & P33*P41+P10*P23*P31*P42-P10*P23*P32*P41-P11*P20*P32*P43+P11* + & P20*P33*P42+P11*P22*P30*P43-P11*P22*P33*P40-P11*P23*P30*P42+ + & P11*P23*P32*P40+P12*P20*P31*P43-P12*P20*P33*P41-P12*P21*P30* + & P43+P12*P21*P33*P40+P12*P23*P30*P41-P12*P23*P31*P40-P13*P20* + & P31*P42+P13*P20*P32*P41+P13*P21*P30*P42-P13*P21*P32*P40-P13* + & P22*P30*P41+P13*P22*P31*P40 +C...For mixed CP states need gauge boson masses. + XMA=SQRT(MAX(0D0,(PK(3,4)+PK(4,4))**2-(PK(3,1)+PK(4,1))**2- + & (PK(3,2)+PK(4,2))**2-(PK(3,3)+PK(4,3))**2)) + XMB=SQRT(MAX(0D0,(PK(5,4)+PK(6,4))**2-(PK(5,1)+PK(6,1))**2- + & (PK(5,2)+PK(6,2))**2-(PK(5,3)+PK(6,3))**2)) + XMV=PMAS(KFA,1) + ENDIF + +C...Z decay + IF(KFA.EQ.23.AND.KFA.EQ.KFT) THEN + KFLF1A=IABS(KFL1(1)) + EF1=KCHG(KFLF1A,1)/3D0 + AF1=SIGN(1D0,EF1+0.1D0) + VF1=AF1-4D0*EF1*XWV + KFLF2A=IABS(KFL1(2)) + EF2=KCHG(KFLF2A,1)/3D0 + AF2=SIGN(1D0,EF2+0.1D0) + VF2=AF2-4D0*EF2*XWV + VA12AS=4D0*VF1*AF1*VF2*AF2/((VF1**2+AF1**2)*(VF2**2+AF2**2)) + IF((MSTP(25).EQ.0.AND.IREF(IP,7).NE.36).OR.MSTP(25).EQ.1) + & THEN +C...CP-even decay + WT=8D0*(1D0+VA12AS)*PKK(3,5)*PKK(4,6)+ + & 8D0*(1D0-VA12AS)*PKK(3,6)*PKK(4,5) + ELSEIF(MSTP(25).LE.2) THEN +C...CP-odd decay + WT=((PKK(3,5)+PKK(4,6))**2 +(PKK(3,6)+PKK(4,5))**2 + & -2*PKK(3,4)*PKK(5,6) + & -2*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2/ + & (PKK(3,4)*PKK(5,6)) + & +VA12AS*(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6))* + & (PKK(3,5)+PKK(4,5)-PKK(3,6)-PKK(4,6)))/(1+VA12AS) + ELSE +C...Mixed CP states. + WT=32D0*(0.25D0*((1D0+VA12AS)*PKK(3,5)*PKK(4,6) + & +(1D0-VA12AS)*PKK(3,6)*PKK(4,5)) + & -0.5D0*ETA/XMV**2*EPSI*((1D0+VA12AS)*(PKK(3,5)+PKK(4,6)) + & -(1D0-VA12AS)*(PKK(3,6)+PKK(4,5))) + & +6.25D-2*ETA**2/XMV**4*(-2D0*PKK(3,4)**2*PKK(5,6)**2 + & -2D0*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2 + & +PKK(3,4)*PKK(5,6) + & *((PKK(3,5)+PKK(4,6))**2+(PKK(3,6)+PKK(4,5))**2) + & +VA12AS*PKK(3,4)*PKK(5,6) + & *(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6)) + & *(PKK(3,5)-PKK(3,6)+PKK(4,5)-PKK(4,6)))) + & /(1D0 +2D0*ETA*XMA*XMB/XMV**2 + & +2D0*(ETA*XMA*XMB/XMV**2)**2*(1D0+VA12AS)) + ENDIF + +C...W decay + ELSEIF(KFA.EQ.24.AND.KFA.EQ.KFT) THEN + IF((MSTP(25).EQ.0.AND.IREF(IP,7).NE.36).OR.MSTP(25).EQ.1) + & THEN +C...CP-even decay + WT=16D0*PKK(3,5)*PKK(4,6) + ELSEIF(MSTP(25).LE.2) THEN +C...CP-odd decay + WT=0.5D0*((PKK(3,5)+PKK(4,6))**2 +(PKK(3,6)+PKK(4,5))**2 + & -2*PKK(3,4)*PKK(5,6) + & -2*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2/ + & (PKK(3,4)*PKK(5,6)) + & +(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6))* + & (PKK(3,5)+PKK(4,5)-PKK(3,6)-PKK(4,6))) + ELSE +C...Mixed CP states. + WT=32D0*(0.25D0*2D0*PKK(3,5)*PKK(4,6) + & -0.5D0*ETA/XMV**2*EPSI*2D0*(PKK(3,5)+PKK(4,6)) + & +6.25D-2*ETA**2/XMV**4*(-2D0*PKK(3,4)**2*PKK(5,6)**2 + & -2D0*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2 + & +PKK(3,4)*PKK(5,6) + & *((PKK(3,5)+PKK(4,6))**2+(PKK(3,6)+PKK(4,5))**2) + & +PKK(3,4)*PKK(5,6) + & *(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6)) + & *(PKK(3,5)-PKK(3,6)+PKK(4,5)-PKK(4,6)))) + & /(1D0 +2D0*ETA*XMA*XMB/XMV**2 + & +(2D0*ETA*XMA*XMB/XMV**2)**2) + ENDIF + +C...No angular correlations in other Higgs decays. + ELSE + WT=WTMAX + ENDIF + + ELSEIF((KFAGM.EQ.6.OR.KFAGM.EQ.7.OR.KFAGM.EQ.8.OR. + & KFAGM.EQ.17.OR.KFAGM.EQ.18).AND.IABS(K(IREF(IP,1),2)).EQ.24) + & THEN +C...Angular correlation in f -> f' + W -> f' + 2 quarks/leptons. + I1=IREF(IP,8) + IF(MOD(KFAGM,2).EQ.0) THEN + I2=N+1 + I3=N+2 + ELSE + I2=N+2 + I3=N+1 + ENDIF + I4=IREF(IP,2) + WT=(P(I1,4)*P(I2,4)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)- + & P(I1,3)*P(I2,3))*(P(I3,4)*P(I4,4)-P(I3,1)*P(I4,1)- + & P(I3,2)*P(I4,2)-P(I3,3)*P(I4,3)) + WTMAX=(P(I1,5)**4-P(IREF(IP,1),5)**4)/8D0 + + ELSEIF(ISUB.EQ.1) THEN +C...Angular weight for gamma*/Z0 -> 2 quarks/leptons. + EI=KCHG(IABS(MINT(15)),1)/3D0 + AI=SIGN(1D0,EI+0.1D0) + VI=AI-4D0*EI*XWV + EF=KCHG(IABS(KFL1(1)),1)/3D0 + AF=SIGN(1D0,EF+0.1D0) + + VF=AF-4D0*EF*XWV + RMF=MIN(1D0,4D0*PMAS(IABS(KFL1(1)),1)**2/SH) + WT1=EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ + & (VI**2+AI**2)*VINT(114)*(VF**2+(1D0-RMF)*AF**2) + WT2=RMF*(EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ + & (VI**2+AI**2)*VINT(114)*VF**2) + WT3=SQRT(1D0-RMF)*(EI*AI*VINT(112)*EF*AF+ + & 4D0*VI*AI*VINT(114)*VF*AF) + WT=WT1*(1D0+CTHE(1)**2)+WT2*(1D0-CTHE(1)**2)+ + & 2D0*WT3*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)) + WTMAX=2D0*(WT1+ABS(WT3)) + + ELSEIF(ISUB.EQ.2) THEN +C...Angular weight for W+/- -> 2 quarks/leptons. + RM3=PMAS(IABS(KFL1(1)),1)**2/SH + RM4=PMAS(IABS(KFL2(1)),1)**2/SH + BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) + WT=(1D0+BE34*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)))**2-(RM3-RM4)**2 + WTMAX=4D0 + + ELSEIF(ISUB.EQ.15.OR.ISUB.EQ.19) THEN +C...Angular weight for f + fbar -> gluon/gamma + (gamma*/Z0) -> +C...-> gluon/gamma + 2 quarks/leptons. + CLILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ + & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ + & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,3)**2 + CLIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ + & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ + & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,4)**2 + CRILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ + & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ + & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,3)**2 + CRIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ + & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ + & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,4)**2 + WT=(CLILF+CRIRF)*(PKK(1,3)**2+PKK(2,4)**2)+ + & (CLIRF+CRILF)*(PKK(1,4)**2+PKK(2,3)**2) + WTMAX=(CLILF+CLIRF+CRILF+CRIRF)* + & ((PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2) + + ELSEIF(ISUB.EQ.16.OR.ISUB.EQ.20) THEN +C...Angular weight for f + fbar' -> gluon/gamma + W+/- -> +C...-> gluon/gamma + 2 quarks/leptons. + WT=PKK(1,3)**2+PKK(2,4)**2 + WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2 + + ELSEIF(ISUB.EQ.22) THEN +C...Angular weight for f + fbar -> Z0 + Z0 -> 4 quarks/leptons. + S34=P(IREF(IP,IORD),5)**2 + S56=P(IREF(IP,3-IORD),5)**2 + TI=PKK(1,3)+PKK(1,4)+S34 + UI=PKK(1,5)+PKK(1,6)+S56 + TIR=REAL(TI) + UIR=REAL(UI) + FGK135=ABS(FGK(1,2,3,4,5,6)/TIR+FGK(1,2,5,6,3,4)/UIR)**2 + FGK145=ABS(FGK(1,2,4,3,5,6)/TIR+FGK(1,2,5,6,4,3)/UIR)**2 + FGK136=ABS(FGK(1,2,3,4,6,5)/TIR+FGK(1,2,6,5,3,4)/UIR)**2 + FGK146=ABS(FGK(1,2,4,3,6,5)/TIR+FGK(1,2,6,5,4,3)/UIR)**2 + FGK253=ABS(FGK(2,1,5,6,3,4)/TIR+FGK(2,1,3,4,5,6)/UIR)**2 + FGK263=ABS(FGK(2,1,6,5,3,4)/TIR+FGK(2,1,3,4,6,5)/UIR)**2 + FGK254=ABS(FGK(2,1,5,6,4,3)/TIR+FGK(2,1,4,3,5,6)/UIR)**2 + FGK264=ABS(FGK(2,1,6,5,4,3)/TIR+FGK(2,1,4,3,6,5)/UIR)**2 + + WT= + & CORL(1,1,1)*CORL(2,1,1)*FGK135+CORL(1,1,2)*CORL(2,1,1)*FGK145+ + & CORL(1,1,1)*CORL(2,1,2)*FGK136+CORL(1,1,2)*CORL(2,1,2)*FGK146+ + & CORL(1,2,1)*CORL(2,2,1)*FGK253+CORL(1,2,2)*CORL(2,2,1)*FGK263+ + & CORL(1,2,1)*CORL(2,2,2)*FGK254+CORL(1,2,2)*CORL(2,2,2)*FGK264 + WTMAX=16D0*((CORL(1,1,1)+CORL(1,1,2))*(CORL(2,1,1)+CORL(2,1,2))+ + & (CORL(1,2,1)+CORL(1,2,2))*(CORL(2,2,1)+CORL(2,2,2)))*S34*S56* + & ((TI**2+UI**2+2D0*SH*(S34+S56))/(TI*UI)-S34*S56*(1D0/TI**2+ + & 1D0/UI**2)) + + ELSEIF(ISUB.EQ.23) THEN +C...Angular weight for f + fbar' -> Z0 + W+/- -> 4 quarks/leptons. + D34=P(IREF(IP,IORD),5)**2 + D56=P(IREF(IP,3-IORD),5)**2 + DT=PKK(1,3)+PKK(1,4)+D34 + DU=PKK(1,5)+PKK(1,6)+D56 + FACBW=1D0/((SH-SQMW)**2+GMMW**2) + CAWZ=COUP(2,3)/DT-2D0*XW1*COUP(1,2)*(SH-SQMW)*FACBW + CBWZ=COUP(1,3)/DU+2D0*XW1*COUP(1,2)*(SH-SQMW)*FACBW + FGK135=ABS(REAL(CAWZ)*FGK(1,2,3,4,5,6)+ + + & REAL(CBWZ)*FGK(1,2,5,6,3,4)) + FGK136=ABS(REAL(CAWZ)*FGK(1,2,3,4,6,5)+ + & REAL(CBWZ)*FGK(1,2,6,5,3,4)) + WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2 + WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)*(CAWZ**2* + & DIGK(DT,DU)+CBWZ**2*DIGK(DU,DT)+CAWZ*CBWZ*DJGK(DT,DU)) + + ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN +C...Angular weight for f + fbar -> Z0 + h0 -> 2 quarks/leptons + h0 +C...(or H0, or A0). + WT=((COUP(1,3)*COUP(3,3))**2+(COUP(1,4)*COUP(3,4))**2)* + & PKK(1,3)*PKK(2,4)+((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)* + & COUP(3,3))**2)*PKK(1,4)*PKK(2,3) + WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)* + & (PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) + + ELSEIF(ISUB.EQ.25) THEN +C...Angular weight for f + fbar -> W+ + W- -> 4 quarks/leptons. + POLR=(1D0+PARJ(132))*(1D0-PARJ(131)) + POLL=(1D0-PARJ(132))*(1D0+PARJ(131)) + D34=P(IREF(IP,IORD),5)**2 + D56=P(IREF(IP,3-IORD),5)**2 + DT=PKK(1,3)+PKK(1,4)+D34 + DU=PKK(1,5)+PKK(1,6)+D56 + FACBW=1D0/((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2) + CDWW=(COUP(1,3)*SQMZ*(SH-SQMZ)*FACBW+COUP(1,2))/SH + CAWW=CDWW+0.5D0*(COUP(1,2)+1D0)/DT + CBWW=CDWW+0.5D0*(COUP(1,2)-1D0)/DU + CCWW=COUP(1,4)*SQMZ*(SH-SQMZ)*FACBW/SH + FGK135=ABS(REAL(CAWW)*FGK(1,2,3,4,5,6)- + & REAL(CBWW)*FGK(1,2,5,6,3,4)) + FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) + IF(MSTP(50).LE.0) THEN + WT=FGK135**2+(CCWW*FGK253)**2 + WTMAX=4D0*D34*D56*(CAWW**2*DIGK(DT,DU)+CBWW**2*DIGK(DU,DT)- + & CAWW*CBWW*DJGK(DT,DU)+CCWW**2*(DIGK(DT,DU)+DIGK(DU,DT)- + & DJGK(DT,DU))) + ELSE + WT=POLL*FGK135**2+POLR*(CCWW*FGK253)**2 + WTMAX=4D0*D34*D56*(POLL*(CAWW**2*DIGK(DT,DU)+ + & CBWW**2*DIGK(DU,DT)-CAWW*CBWW*DJGK(DT,DU))+ + & POLR*CCWW**2*(DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU))) + ENDIF + + ELSEIF(ISUB.EQ.26.OR.ISUB.EQ.172.OR.ISUB.EQ.177) THEN +C...Angular weight for f + fbar' -> W+/- + h0 -> 2 quarks/leptons + h0 +C...(or H0, or A0). + WT=PKK(1,3)*PKK(2,4) + WTMAX=(PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) + + ELSEIF(ISUB.EQ.30.OR.ISUB.EQ.35) THEN +C...Angular weight for f + g/gamma -> f + (gamma*/Z0) +C...-> f + 2 quarks/leptons. + CLILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ + & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ + & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,3)**2 + CLIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ + & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ + & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,4)**2 + CRILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ + & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ + & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,3)**2 + CRIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ + & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ + & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,4)**2 + IF(K(ILIN(1),2).GT.0) WT=(CLILF+CRIRF)*(PKK(1,4)**2+ + & PKK(3,5)**2)+(CLIRF+CRILF)*(PKK(1,3)**2+PKK(4,5)**2) + IF(K(ILIN(1),2).LT.0) WT=(CLILF+CRIRF)*(PKK(1,3)**2+ + & PKK(4,5)**2)+(CLIRF+CRILF)*(PKK(1,4)**2+PKK(3,5)**2) + WTMAX=(CLILF+CLIRF+CRILF+CRIRF)* + & ((PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2) + + ELSEIF(ISUB.EQ.31.OR.ISUB.EQ.36) THEN +C...Angular weight for f + g/gamma -> f' + W+/- -> f' + 2 fermions. + IF(K(ILIN(1),2).GT.0) WT=PKK(1,4)**2+PKK(3,5)**2 + IF(K(ILIN(1),2).LT.0) WT=PKK(1,3)**2+PKK(4,5)**2 + WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2 + + ELSEIF(ISUB.EQ.71.OR.ISUB.EQ.72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR. + & ISUB.EQ.77) THEN +C...Angular weight for V_L1 + V_L2 -> V_L3 + V_L4 (V = Z/W). + WT=16D0*PKK(3,5)*PKK(4,6) + WTMAX=SH**2 + + ELSEIF(ISUB.EQ.110) THEN +C...Angular weight for f + fbar -> gamma + h0 -> gamma + X is isotropic. + WT=1D0 + WTMAX=1D0 + + ELSEIF(ISUB.EQ.141) THEN +C...Special case: if only branching ratios known then isotropic decay. + IF(MWID(32).EQ.2) THEN + WT=1D0 + WTMAX=1D0 + ELSEIF(IP.EQ.1.AND.IABS(KFL1(1)).LT.20) THEN +C...Angular weight for f + fbar -> gamma*/Z0/Z'0 -> 2 quarks/leptons. +C...Couplings of incoming flavour. + KFAI=IABS(MINT(15)) + EI=KCHG(KFAI,1)/3D0 + AI=SIGN(1D0,EI+0.1D0) + VI=AI-4D0*EI*XWV + KFAIC=1 + IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2 + IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3 + IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4 + IF(KFAI.LE.2.OR.KFAI.EQ.11.OR.KFAI.EQ.12) THEN + VPI=PARU(119+2*KFAIC) + API=PARU(120+2*KFAIC) + ELSEIF(KFAI.LE.4.OR.KFAI.EQ.13.OR.KFAI.EQ.14) THEN + VPI=PARJ(178+2*KFAIC) + API=PARJ(179+2*KFAIC) + ELSE + VPI=PARJ(186+2*KFAIC) + API=PARJ(187+2*KFAIC) + ENDIF +C...Couplings of final flavour. + KFAF=IABS(KFL1(1)) + EF=KCHG(KFAF,1)/3D0 + AF=SIGN(1D0,EF+0.1D0) + VF=AF-4D0*EF*XWV + KFAFC=1 + IF(KFAF.LE.10.AND.MOD(KFAF,2).EQ.0) KFAFC=2 + IF(KFAF.GT.10.AND.MOD(KFAF,2).NE.0) KFAFC=3 + IF(KFAF.GT.10.AND.MOD(KFAF,2).EQ.0) KFAFC=4 + IF(KFAF.LE.2.OR.KFAF.EQ.11.OR.KFAF.EQ.12) THEN + VPF=PARU(119+2*KFAFC) + APF=PARU(120+2*KFAFC) + ELSEIF(KFAF.LE.4.OR.KFAF.EQ.13.OR.KFAF.EQ.14) THEN + VPF=PARJ(178+2*KFAFC) + APF=PARJ(179+2*KFAFC) + ELSE + VPF=PARJ(186+2*KFAFC) + APF=PARJ(187+2*KFAFC) + ENDIF +C...Asymmetry and weight. + ASYM=2D0*(EI*AI*VINT(112)*EF*AF+EI*API*VINT(113)*EF*APF+ + & 4D0*VI*AI*VINT(114)*VF*AF+(VI*API+VPI*AI)*VINT(115)* + & (VF*APF+VPF*AF)+4D0*VPI*API*VINT(116)*VPF*APF)/ + & (EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ + & EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* + & (VF**2+AF**2)+(VI*VPI+AI*API)*VINT(115)*(VF*VPF+AF*APF)+ + & (VPI**2+API**2)*VINT(116)*(VPF**2+APF**2)) + WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 + WTMAX=2D0+ABS(ASYM) + ELSEIF(IP.EQ.1.AND.IABS(KFL1(1)).EQ.24) THEN +C...Angular weight for f + fbar -> Z' -> W+ + W-. + RM1=P(NSD(1)+1,5)**2/SH + RM2=P(NSD(1)+2,5)**2/SH + CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* + & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) + CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ + & (RM2-RM1)**2) + WT=CFLAT+CCOS2*CTHE(1)**2 + WTMAX=CFLAT+MAX(0D0,CCOS2) + ELSEIF(IP.EQ.1.AND.(KFL1(1).EQ.25.OR.KFL1(1).EQ.35.OR. + & IABS(KFL1(1)).EQ.37)) THEN +C...Angular weight for f + fbar -> Z' -> h0 + A0, H0 + A0, H+ + H-. + WT=1D0-CTHE(1)**2 + WTMAX=1D0 + ELSEIF(IP.EQ.1.AND.KFL2(1).EQ.25) THEN +C...Angular weight for f + fbar -> Z' -> Z0 + h0. + RM1=P(NSD(1)+1,5)**2/SH + RM2=P(NSD(1)+2,5)**2/SH + FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) + WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) + WTMAX=1D0+FLAM2/(8D0*RM1) + ELSEIF(MZPWP.EQ.0) THEN +C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons +C...(W:s like if intermediate Z). + D34=P(IREF(IP,IORD),5)**2 + D56=P(IREF(IP,3-IORD),5)**2 + DT=PKK(1,3)+PKK(1,4)+D34 + DU=PKK(1,5)+PKK(1,6)+D56 + FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) + FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) + WT=(COUP(1,3)*FGK135)**2+(COUP(1,4)*FGK253)**2 + WTMAX=4D0*D34*D56*(COUP(1,3)**2+COUP(1,4)**2)* + & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) + ELSEIF(MZPWP.EQ.1) THEN +C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons +C...(W:s approximately longitudinal, like if intermediate H). + WT=16D0*PKK(3,5)*PKK(4,6) + WTMAX=SH**2 + ELSE +C...Angular weight for f + fbar -> Z' -> H+ + H-, Z0 + h0, h0 + A0, +C...H0 + A0 -> 4 quarks/leptons, t + tbar -> b + W+ + bbar + W- . + WT=1D0 + WTMAX=1D0 + ENDIF + + ELSEIF(ISUB.EQ.142) THEN +C...Special case: if only branching ratios known then isotropic decay. + IF(MWID(34).EQ.2) THEN + WT=1D0 + WTMAX=1D0 + ELSEIF(IP.EQ.1.AND.IABS(KFL1(1)).LT.20) THEN +C...Angular weight for f + fbar' -> W'+/- -> 2 quarks/leptons. + KFAI=IABS(MINT(15)) + KFAIC=1 + IF(KFAI.GT.10) KFAIC=2 + VI=PARU(129+2*KFAIC) + AI=PARU(130+2*KFAIC) + KFAF=IABS(KFL1(1)) + KFAFC=1 + IF(KFAF.GT.10) KFAFC=2 + VF=PARU(129+2*KFAFC) + AF=PARU(130+2*KFAFC) + ASYM=8D0*VI*AI*VF*AF/((VI**2+AI**2)*(VF**2+AF**2)) + WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 + WTMAX=2D0+ABS(ASYM) + ELSEIF(IP.EQ.1.AND.IABS(KFL2(1)).EQ.23) THEN +C...Angular weight for f + fbar' -> W'+/- -> W+/- + Z0. + RM1=P(NSD(1)+1,5)**2/SH + RM2=P(NSD(1)+2,5)**2/SH + CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* + & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) + CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ + & (RM2-RM1)**2) + WT=CFLAT+CCOS2*CTHE(1)**2 + WTMAX=CFLAT+MAX(0D0,CCOS2) + ELSEIF(IP.EQ.1.AND.KFL2(1).EQ.25) THEN +C...Angular weight for f + fbar -> W'+/- -> W+/- + h0. + RM1=P(NSD(1)+1,5)**2/SH + RM2=P(NSD(1)+2,5)**2/SH + FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) + WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) + WTMAX=1D0+FLAM2/(8D0*RM1) + ELSEIF(MZPWP.EQ.0) THEN +C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons +C...(W/Z like if intermediate W). + D34=P(IREF(IP,IORD),5)**2 + D56=P(IREF(IP,3-IORD),5)**2 + DT=PKK(1,3)+PKK(1,4)+D34 + DU=PKK(1,5)+PKK(1,6)+D56 + FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) + FGK136=ABS(FGK(1,2,3,4,6,5)-FGK(1,2,6,5,3,4)) + WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2 + WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)* + & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) + ELSEIF(MZPWP.EQ.1) THEN +C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons +C...(W/Z approximately longitudinal, like if intermediate H). + WT=16D0*PKK(3,5)*PKK(4,6) + WTMAX=SH**2 + ELSE +C...Angular weight for f + fbar -> W' -> W + h0 -> whatever, +C...t + bbar -> t + W + bbar. + WT=1D0 + WTMAX=1D0 + ENDIF + + ELSEIF(ISUB.EQ.145.OR.ISUB.EQ.162.OR.ISUB.EQ.163.OR.ISUB.EQ.164) + & THEN +C...Isotropic decay of leptoquarks (assumed spin 0). + WT=1D0 + WTMAX=1D0 + + ELSEIF(ISUB.GE.146.AND.ISUB.LE.148) THEN +C...Decays of (spin 1/2) q*/e* -> q/e + (g,gamma) or (Z0,W+-). + SIDE=1D0 + IF(MINT(16).EQ.21.OR.MINT(16).EQ.22) SIDE=-1D0 + IF(IP.EQ.1.AND.(KFL1(1).EQ.21.OR.KFL1(1).EQ.22)) THEN + WT=1D0+SIDE*CTHE(1) + WTMAX=2D0 + ELSEIF(IP.EQ.1) THEN + + RM1=P(NSD(1)+1,5)**2/SH + WT=1D0+SIDE*CTHE(1)*(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) + WTMAX=1D0+(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) + ELSE +C...W/Z decay assumed isotropic, since not known. + WT=1D0 + WTMAX=1D0 + ENDIF + + ELSEIF(ISUB.EQ.149) THEN +C...Isotropic decay of techni-eta. + WT=1D0 + WTMAX=1D0 + + ELSEIF(ISUB.EQ.191) THEN + IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN +C...Angular weight for f + fbar -> rho_tc0 -> W+ W-, +C...W+ pi_tc-, pi_tc+ W- or pi_tc+ pi_tc-. + WT=1D0-CTHE(1)**2 + WTMAX=1D0 + ELSEIF(IP.EQ.1) THEN +C...Angular weight for f + fbar -> rho_tc0 -> f fbar. + CTHESG=CTHE(1)*ISIGN(1,MINT(15)) + XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) + BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) + BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) + KFAI=IABS(MINT(15)) + EI=KCHG(KFAI,1)/3D0 + AI=SIGN(1D0,EI+0.1D0) + VI=AI-4D0*EI*XWV + VALI=0.5D0*(VI+AI) + VARI=0.5D0*(VI-AI) + ALEFTI=(EI+VALI*BWZR)**2+(VALI*BWZI)**2 + ARIGHI=(EI+VARI*BWZR)**2+(VARI*BWZI)**2 + KFAF=IABS(KFL1(1)) + EF=KCHG(KFAF,1)/3D0 + AF=SIGN(1D0,EF+0.1D0) + VF=AF-4D0*EF*XWV + VALF=0.5D0*(VF+AF) + VARF=0.5D0*(VF-AF) + ALEFTF=(EF+VALF*BWZR)**2+(VALF*BWZI)**2 + ARIGHF=(EF+VARF*BWZR)**2+(VARF*BWZI)**2 + ASAME=ALEFTI*ALEFTF+ARIGHI*ARIGHF + AFLIP=ALEFTI*ARIGHF+ARIGHI*ALEFTF + WT=ASAME*(1D0+CTHESG)**2+AFLIP*(1D0-CTHESG)**2 + WTMAX=4D0*MAX(ASAME,AFLIP) + ELSE +C...Isotropic decay of W/pi_tc produced in rho_tc decay. + WT=1D0 + WTMAX=1D0 + ENDIF + + ELSEIF(ISUB.EQ.192) THEN + IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN +C...Angular weight for f + fbar' -> rho_tc+ -> W+ Z0, +C...W+ pi_tc0, pi_tc+ Z0 or pi_tc+ pi_tc0. + WT=1D0-CTHE(1)**2 + WTMAX=1D0 + ELSEIF(IP.EQ.1) THEN +C...Angular weight for f + fbar' -> rho_tc+ -> f fbar'. + CTHESG=CTHE(1)*ISIGN(1,MINT(15)) + WT=(1D0+CTHESG)**2 + WTMAX=4D0 + ELSE +C...Isotropic decay of W/Z/pi_tc produced in rho_tc+ decay. + WT=1D0 + WTMAX=1D0 + ENDIF + + ELSEIF(ISUB.EQ.193) THEN + IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN +C...Angular weight for f + fbar -> omega_tc0 -> +C...gamma pi_tc0 or Z0 pi_tc0. + WT=1D0+CTHE(1)**2 + WTMAX=2D0 + ELSEIF(IP.EQ.1) THEN +C...Angular weight for f + fbar -> omega_tc0 -> f fbar. + CTHESG=CTHE(1)*ISIGN(1,MINT(15)) + BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) + BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) + KFAI=IABS(MINT(15)) + EI=KCHG(KFAI,1)/3D0 + AI=SIGN(1D0,EI+0.1D0) + VI=AI-4D0*EI*XWV + VALI=0.5D0*(VI+AI) + VARI=0.5D0*(VI-AI) + BLEFTI=(EI-VALI*BWZR)**2+(VALI*BWZI)**2 + BRIGHI=(EI-VARI*BWZR)**2+(VARI*BWZI)**2 + KFAF=IABS(KFL1(1)) + EF=KCHG(KFAF,1)/3D0 + AF=SIGN(1D0,EF+0.1D0) + VF=AF-4D0*EF*XWV + VALF=0.5D0*(VF+AF) + VARF=0.5D0*(VF-AF) + BLEFTF=(EF-VALF*BWZR)**2+(VALF*BWZI)**2 + BRIGHF=(EF-VARF*BWZR)**2+(VARF*BWZI)**2 + BSAME=BLEFTI*BLEFTF+BRIGHI*BRIGHF + BFLIP=BLEFTI*BRIGHF+BRIGHI*BLEFTF + WT=BSAME*(1D0+CTHESG)**2+BFLIP*(1D0-CTHESG)**2 + WTMAX=4D0*MAX(BSAME,BFLIP) + ELSE +C...Isotropic decay of Z/pi_tc produced in omega_tc decay. + WT=1D0 + WTMAX=1D0 + ENDIF + + ELSEIF(ISUB.EQ.353) THEN +C...Angular weight for Z_R0 -> 2 quarks/leptons. + EI=KCHG(IABS(MINT(15)),1)/3D0 + AI=SIGN(1D0,EI+0.1D0) + VI=AI-4D0*EI*XWV + EF=KCHG(PYCOMP(KFL1(1)),1)/3D0 + AF=SIGN(1D0,EF+0.1D0) + VF=AF-4D0*EF*XWV + RMF=MIN(1D0,4D0*PMAS(PYCOMP(KFL1(1)),1)**2/SH) + WT1=(VI**2+AI**2)*(VF**2+(1D0-RMF)*AF**2) + WT2=RMF*(VI**2+AI**2)*VF**2 + WT3=SQRT(1D0-RMF)*4D0*VI*AI*VF*AF + WT=WT1*(1D0+CTHE(1)**2)+WT2*(1D0-CTHE(1)**2)+ + & 2D0*WT3*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)) + WTMAX=2D0*(WT1+ABS(WT3)) + + ELSEIF(ISUB.EQ.354) THEN +C...Angular weight for W_R+/- -> 2 quarks/leptons. + RM3=PMAS(PYCOMP(KFL1(1)),1)**2/SH + RM4=PMAS(PYCOMP(KFL2(1)),1)**2/SH + BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) + WT=(1D0+BE34*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)))**2-(RM3-RM4)**2 + WTMAX=4D0 + + ELSEIF(ISUB.EQ.391) THEN +C...Angular weight for f + fbar -> G* -> f + fbar + IF(IP.EQ.1.AND.IABS(KFL1(1)).LE.18) THEN + WT=1D0-3D0*CTHE(1)**2+4D0*CTHE(1)**4 + WTMAX=2D0 +C...Angular weight for f + fbar -> G* -> gamma + gamma or g + g +C...implemented by M.-C. Lemaire + ELSEIF(IP.EQ.1.AND.(IABS(KFL1(1)).EQ.21.OR. + & IABS(KFL1(1)).EQ.22)) THEN + WT=1D0-CTHE(1)**4 + WTMAX=1D0 +C...Other G* decays not yet implemented angular distributions. + ELSE + WT=1D0 + WTMAX=1D0 + ENDIF + + ELSEIF(ISUB.EQ.392) THEN +C...Angular weight for g + g -> G* -> f + fbar + IF(IP.EQ.1.AND.IABS(KFL1(1)).LE.18) THEN + WT=1D0-CTHE(1)**4 + WTMAX=1D0 +C...Angular weight for g + g -> G* -> gamma +gamma or g + g +C...implemented by M.-C. Lemaire + ELSEIF(IP.EQ.1.AND.(IABS(KFL1(1)).EQ.21.OR. + & IABS(KFL1(1)).EQ.22)) THEN + WT=1D0+6D0*CTHE(1)**2+CTHE(1)**4 + WTMAX=8D0 +C...Other G* decays not yet implemented angular distributions. + ELSE + WT=1D0 + WTMAX=1D0 + ENDIF + +C...Obtain correct angular distribution by rejection techniques. + ELSE + WT=1D0 + WTMAX=1D0 + ENDIF + IF(WT.LT.PYR(0)*WTMAX) GOTO 430 + +C...Construct massive four-vectors using angles chosen. + 590 DO 690 JT=1,JTMAX + IF(KDCY(JT).EQ.0) GOTO 690 + ID=IREF(IP,JT) + DO 600 J=1,5 + DPMO(J)=P(ID,J) + 600 CONTINUE + DPMO(4)=SQRT(DPMO(1)**2+DPMO(2)**2+DPMO(3)**2+DPMO(5)**2) +CMRENNA++ + IF(KFL3(JT).EQ.0) THEN + CALL PYROBO(NSD(JT)+1,NSD(JT)+2,ACOS(CTHE(JT)),PHI(JT), + & DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4)) + N0=NSD(JT)+2 + ELSE + CALL PYROBO(NSD(JT)+1,NSD(JT)+3,ACOS(CTHE(JT)),PHI(JT), + & DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4)) + N0=NSD(JT)+3 + ENDIF + + DO 610 J=1,4 + VDCY(J)=V(ID,J)+V(ID,5)*P(ID,J)/P(ID,5) + 610 CONTINUE +C...Fill in position of decay vertex. + DO 630 I=NSD(JT)+1,N0 + DO 620 J=1,4 + V(I,J)=VDCY(J) + 620 CONTINUE + V(I,5)=0D0 + + 630 CONTINUE +CMRENNA-- + +C...Mark decayed resonances; trace history. + K(ID,1)=K(ID,1)+10 + KFA=IABS(K(ID,2)) + KCA=PYCOMP(KFA) + IF(KCQM(JT).NE.0) THEN +C...Do not kill colour flow through coloured resonance! + ELSE + K(ID,4)=NSD(JT)+1 + K(ID,5)=NSD(JT)+2 +C...If 3-body or 2-body with junction: + IF(KFL3(JT).NE.0.OR.ITJUNC(JT).NE.0) K(ID,5)=NSD(JT)+3 +C...If 3-body with junction: + IF(ITJUNC(JT).NE.0.AND.KFL3(JT).NE.0) K(ID,5)=NSD(JT)+4 + ENDIF + +C...Add documentation lines. + ISUBRG=MAX(1,MIN(500,MINT(1))) + IF(IRES.EQ.0.OR.ISET(ISUBRG).EQ.11) THEN + IDOC=MINT(83)+MINT(4) +CMRENNA+++ + IHI=NSD(JT)+2 + IF(KFL3(JT).NE.0) IHI=IHI+1 + DO 650 I=NSD(JT)+1,IHI +CMRENNA--- + I1=MINT(83)+MINT(4)+1 + K(I,3)=I1 + IF(MSTP(128).GE.1) K(I,3)=ID + IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN + MINT(4)=MINT(4)+1 + K(I1,1)=21 + K(I1,2)=K(I,2) + K(I1,3)=IREF(IP,JT+3) + DO 640 J=1,5 + P(I1,J)=P(I,J) + 640 CONTINUE + ENDIF + 650 CONTINUE + ELSE + K(NSD(JT)+1,3)=ID + K(NSD(JT)+2,3)=ID +C...If 3-body or 2-body with junction: + IF(KFL3(JT).NE.0.OR.ITJUNC(JT).GT.0) K(NSD(JT)+3,3)=ID +C...If 3-body with junction: + IF(KFL3(JT).NE.0.AND.ITJUNC(JT).GT.0) K(NSD(JT)+4,3)=ID + ENDIF + +C...Do showering of two or three objects. + NSHBEF=N + IF(MSTP(71).GE.1.AND.MINT(35).LE.1) THEN + IF(KFL3(JT).EQ.0) THEN + CALL PYSHOW(NSD(JT)+1,NSD(JT)+2,P(ID,5)) + ELSE + CALL PYSHOW(NSD(JT)+1,-3,P(ID,5)) + ENDIF + +c...For pT-ordered shower need set up first, especially colour tags. +C...(Need to set up colour tags even if MSTP(71) = 0) + ELSEIF(MINT(35).GE.2) THEN + NPART=2 + IF(KFL3(JT).NE.0) NPART=3 + IPART(1)=NSD(JT)+1 + IPART(2)=NSD(JT)+2 + IPART(3)=NSD(JT)+3 + PTPART(1)=0.5D0*P(ID,5) + PTPART(2)=PTPART(1) + PTPART(3)=PTPART(1) + IF(KCQ1(JT).EQ.1.OR.KCQ1(JT).EQ.2) THEN + MOTHER=K(NSD(JT)+1,4)/MSTU(5) + IF(MOTHER.LE.NSD(JT)) THEN + MCT(NSD(JT)+1,1)=MCT(MOTHER,1) + ELSE + NCT=NCT+1 + MCT(NSD(JT)+1,1)=NCT + MCT(MOTHER,2)=NCT + ENDIF + ENDIF + IF(KCQ1(JT).EQ.-1.OR.KCQ1(JT).EQ.2) THEN + MOTHER=K(NSD(JT)+1,5)/MSTU(5) + IF(MOTHER.LE.NSD(JT)) THEN + MCT(NSD(JT)+1,2)=MCT(MOTHER,2) + ELSE + NCT=NCT+1 + MCT(NSD(JT)+1,2)=NCT + MCT(MOTHER,1)=NCT + ENDIF + ENDIF + IF(MCT(NSD(JT)+2,1).EQ.0.AND.(KCQ2(JT).EQ.1.OR. + & KCQ2(JT).EQ.2)) THEN + MOTHER=K(NSD(JT)+2,4)/MSTU(5) + IF(MOTHER.LE.NSD(JT)) THEN + MCT(NSD(JT)+2,1)=MCT(MOTHER,1) + ELSE + NCT=NCT+1 + MCT(NSD(JT)+2,1)=NCT + MCT(MOTHER,2)=NCT + ENDIF + ENDIF + IF(MCT(NSD(JT)+2,2).EQ.0.AND.(KCQ2(JT).EQ.-1.OR. + & KCQ2(JT).EQ.2)) THEN + MOTHER=K(NSD(JT)+2,5)/MSTU(5) + IF(MOTHER.LE.NSD(JT)) THEN + MCT(NSD(JT)+2,2)=MCT(MOTHER,2) + ELSE + NCT=NCT+1 + MCT(NSD(JT)+2,2)=NCT + MCT(MOTHER,1)=NCT + ENDIF + ENDIF + IF(NPART.EQ.3.AND.MCT(NSD(JT)+3,1).EQ.0.AND. + & (KCQ3(JT).EQ.1.OR. KCQ3(JT).EQ.2)) THEN + MOTHER=K(NSD(JT)+3,4)/MSTU(5) + MCT(NSD(JT)+3,1)=MCT(MOTHER,1) + ENDIF + IF(NPART.EQ.3.AND.MCT(NSD(JT)+3,2).EQ.0.AND. + & (KCQ3(JT).EQ.-1.OR.KCQ3(JT).EQ.2)) THEN + MOTHER=K(NSD(JT)+3,5)/MSTU(5) + MCT(NSD(JT)+2,2)=MCT(MOTHER,2) + ENDIF + IF (MSTP(71).GE.1) CALL PYPTFS(2,0.5D0*P(ID,5),0D0,PTGEN) + ENDIF + NSHAFT=N + IF(JT.EQ.1) NAFT1=N + +C...Check if decay products moved by shower. + NSD1=NSD(JT)+1 + NSD2=NSD(JT)+2 + NSD3=NSD(JT)+3 + IF(NSHAFT.GT.NSHBEF) THEN + IF(K(NSD1,1).GT.10) THEN + DO 660 I=NSHBEF+1,NSHAFT + IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD1,2)) NSD1=I + 660 CONTINUE + ENDIF + IF(K(NSD2,1).GT.10) THEN + DO 670 I=NSHBEF+1,NSHAFT + IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD2,2).AND. + & I.NE.NSD1) NSD2=I + 670 CONTINUE + ENDIF + IF(KFL3(JT).NE.0.AND.K(NSD3,1).GT.10) THEN + DO 680 I=NSHBEF+1,NSHAFT + IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD3,2).AND. + & I.NE.NSD1.AND.I.NE.NSD2) NSD3=I + 680 CONTINUE + ENDIF + ENDIF + +C...Store decay products for further treatment. + NP=NP+1 + IREF(NP,1)=NSD1 + IREF(NP,2)=NSD2 + IREF(NP,3)=0 + IF(KFL3(JT).NE.0) IREF(NP,3)=NSD3 + IREF(NP,4)=IDOC+1 + IREF(NP,5)=IDOC+2 + IREF(NP,6)=0 + IF(KFL3(JT).NE.0) IREF(NP,6)=IDOC+3 + IREF(NP,7)=K(IREF(IP,JT),2) + IREF(NP,8)=IREF(IP,JT) + 690 CONTINUE + + +C...Fill information for 2 -> 1 -> 2. + 700 IF(JTMAX.EQ.1.AND.KDCY(1).NE.0.AND.ISUB.NE.0) THEN + MINT(7)=MINT(83)+6+2*ISET(ISUB) + MINT(8)=MINT(83)+7+2*ISET(ISUB) + MINT(25)=KFL1(1) + MINT(26)=KFL2(1) + VINT(23)=CTHE(1) + RM3=P(N-1,5)**2/SH + RM4=P(N,5)**2/SH + BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) + VINT(45)=-0.5D0*SH*(1D0-RM3-RM4-BE34*CTHE(1)) + VINT(46)=-0.5D0*SH*(1D0-RM3-RM4+BE34*CTHE(1)) + VINT(48)=0.25D0*SH*BE34**2*MAX(0D0,1D0-CTHE(1)**2) + VINT(47)=SQRT(VINT(48)) + ENDIF + +C...Possibility of colour rearrangement in W+W- events. + IF((ISUB.EQ.25.OR.ISUB.EQ.22).AND.MSTP(115).GE.1) THEN + IAKF1=IABS(KFL1(1)) + IAKF2=IABS(KFL1(2)) + IAKF3=IABS(KFL2(1)) + IAKF4=IABS(KFL2(2)) + IF(MIN(IAKF1,IAKF2,IAKF3,IAKF4).GE.1.AND. + & MAX(IAKF1,IAKF2,IAKF3,IAKF4).LE.5) CALL + & PYRECO(IREF(1,1),IREF(1,2),NSD(1),NAFT1) + IF(MINT(51).NE.0) RETURN + ENDIF + +C...Loop back if needed. + 710 IF(IP.LT.NP) GOTO 170 + +C...Boost back to standard frame. + 720 IF(IBST.EQ.1) CALL PYROBO(MINT(83)+7,N,THEIN,PHIIN,BEXIN,BEYIN, + &BEZIN) + + RETURN + END + +C********************************************************************* + +C...PYMULT +C...Initializes treatment of multiple interactions, selects kinematics +C...of hardest interaction if low-pT physics included in run, and +C...generates all non-hardest interactions. + + SUBROUTINE PYMULT(MMUL) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINT7/SIGT(0:6,0:6,0:5) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, + &/PYINT2/,/PYINT3/,/PYINT5/,/PYINT7/ +C...Local arrays and saved variables. + DIMENSION NMUL(20),SIGM(20),KSTR(500,2),VINTSV(80) + SAVE XT2,XT2FAC,XC2,XTS,IRBIN,RBIN,NMUL,SIGM,P83A,P83B,P83C, + &CQ2I,CQ2R,PIK,BDIV,B,PLOWB,PHIGHB,PALLB,S4A,S4B,S4C,POWIP, + &RPWIP,B2RPDV,B2RPMX,BAVG,VNT145,VNT146,VNT147 + +C...Initialization of multiple interaction treatment. + IF(MMUL.EQ.1) THEN + IF(MSTP(122).GE.1) WRITE(MSTU(11),5000) MSTP(82) + ISUB=96 + MINT(1)=96 + VINT(63)=0D0 + VINT(64)=0D0 + VINT(143)=1D0 + VINT(144)=1D0 + +C...Loop over phase space points: xT2 choice in 20 bins. + 100 SIGSUM=0D0 + DO 120 IXT2=1,20 + NMUL(IXT2)=MSTP(83) + SIGM(IXT2)=0D0 + DO 110 ITRY=1,MSTP(83) + RSCA=0.05D0*((21-IXT2)-PYR(0)) + XT2=VINT(149)*(1D0+VINT(149))/(VINT(149)+RSCA)-VINT(149) + XT2=MAX(0.01D0*VINT(149),XT2) + VINT(25)=XT2 + +C...Choose tau and y*. Calculate cos(theta-hat). + IF(PYR(0).LE.COEF(ISUB,1)) THEN + TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) + TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) + ELSE + TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) + ENDIF + VINT(21)=TAU + CALL PYKLIM(2) + RYST=PYR(0) + MYST=1 + IF(RYST.GT.COEF(ISUB,8)) MYST=2 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 + CALL PYKMAP(2,MYST,PYR(0)) + VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) + +C...Calculate differential cross-section. + VINT(71)=0.5D0*VINT(1)*SQRT(XT2) + CALL PYSIGH(NCHN,SIGS) + SIGM(IXT2)=SIGM(IXT2)+SIGS + 110 CONTINUE + SIGSUM=SIGSUM+SIGM(IXT2) + 120 CONTINUE + SIGSUM=SIGSUM/(20D0*MSTP(83)) + +C...Reject result if sigma(parton-parton) is smaller than hadronic one. + IF(SIGSUM.LT.1.1D0*SIGT(0,0,5)) THEN + IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) + & PARP(82)*(VINT(1)/PARP(89))**PARP(90),SIGSUM + PARP(82)=0.9D0*PARP(82) + VINT(149)=4D0*(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/ + & VINT(2) + GOTO 100 + ENDIF + IF(MSTP(122).GE.1) WRITE(MSTU(11),5200) + & PARP(82)*(VINT(1)/PARP(89))**PARP(90), SIGSUM + +C...Start iteration to find k factor. + YKE=SIGSUM/MAX(1D-10,SIGT(0,0,5)) + P83A=(1D0-PARP(83))**2 + P83B=2D0*PARP(83)*(1D0-PARP(83)) + P83C=PARP(83)**2 + CQ2I=1D0/PARP(84)**2 + CQ2R=2D0/(1D0+PARP(84)**2) + SO=0.5D0 + XI=0D0 + YI=0D0 + XF=0D0 + YF=0D0 + XK=0.5D0 + IIT=0 + 130 IF(IIT.EQ.0) THEN + XK=2D0*XK + ELSEIF(IIT.EQ.1) THEN + XK=0.5D0*XK + ELSE + XK=XI+(YKE-YI)*(XF-XI)/(YF-YI) + ENDIF + +C...Evaluate overlap integrals. Find where to divide the b range. + IF(MSTP(82).EQ.2) THEN + SP=0.5D0*PARU(1)*(1D0-EXP(-XK)) + SOP=SP/PARU(1) + ELSE + IF(MSTP(82).EQ.3) THEN + DELTAB=0.02D0 + ELSEIF(MSTP(82).EQ.4) THEN + DELTAB=MIN(0.01D0,0.05D0*PARP(84)) + ELSE + POWIP=MAX(0.4D0,PARP(83)) + RPWIP=2D0/POWIP-1D0 + DELTAB=MAX(0.02D0,0.02D0*(2D0/POWIP)**(1D0/POWIP)) + SO=0D0 + ENDIF + SP=0D0 + SOP=0D0 + BSP=0D0 + SOHIGH=0D0 + IBDIV=0 + B=-0.5D0*DELTAB + 140 B=B+DELTAB + IF(MSTP(82).EQ.3) THEN + OV=EXP(-B**2)/PARU(2) + ELSEIF(MSTP(82).EQ.4) THEN + OV=(P83A*EXP(-MIN(50D0,B**2))+ + & P83B*CQ2R*EXP(-MIN(50D0,B**2*CQ2R))+ + & P83C*CQ2I*EXP(-MIN(50D0,B**2*CQ2I)))/PARU(2) + ELSE + OV=EXP(-B**POWIP)/PARU(2) + SO=SO+PARU(2)*B*DELTAB*OV + ENDIF + IF(IBDIV.EQ.1) SOHIGH=SOHIGH+PARU(2)*B*DELTAB*OV + PACC=1D0-EXP(-MIN(50D0,PARU(1)*XK*OV)) + SP=SP+PARU(2)*B*DELTAB*PACC + SOP=SOP+PARU(2)*B*DELTAB*OV*PACC + BSP=BSP+B*PARU(2)*B*DELTAB*PACC + IF(IBDIV.EQ.0.AND.PARU(1)*XK*OV.LT.1D0) THEN + IBDIV=1 + BDIV=B+0.5D0*DELTAB + ENDIF + IF(B.LT.1D0.OR.B*PACC.GT.1D-6) GOTO 140 + ENDIF + YK=PARU(1)*XK*SO/SP + +C...Continue iteration until convergence. + IF(YK.LT.YKE) THEN + XI=XK + YI=YK + IF(IIT.EQ.1) IIT=2 + ELSE + XF=XK + YF=YK + IF(IIT.EQ.0) IIT=1 + ENDIF + IF(ABS(YK-YKE).GE.1D-5*YKE) GOTO 130 + +C...Store some results for subsequent use. + BAVG=BSP/SP + VINT(145)=SIGSUM + VINT(146)=SOP/SO + VINT(147)=SOP/SP + VNT145=VINT(145) + VNT146=VINT(146) + VNT147=VINT(147) +C...PIK = PARU(1)*XK = (VINT(146)/VINT(147))*sigma_jet/sigma_nondiffr. + PIK=(VNT146/VNT147)*YKE + +C...Find relative weight for low and high impact parameter. + PLOWB=PARU(1)*BDIV**2 + IF(MSTP(82).EQ.3) THEN + PHIGHB=PIK*0.5*EXP(-BDIV**2) + ELSEIF(MSTP(82).EQ.4) THEN + S4A=P83A*EXP(-BDIV**2) + S4B=P83B*EXP(-BDIV**2*CQ2R) + S4C=P83C*EXP(-BDIV**2*CQ2I) + PHIGHB=PIK*0.5*(S4A+S4B+S4C) + ELSEIF(PARP(83).GE.1.999D0) THEN + PHIGHB=PIK*SOHIGH + B2RPDV=BDIV**POWIP + ELSE + PHIGHB=PIK*SOHIGH + B2RPDV=BDIV**POWIP + B2RPMX=MAX(2D0*RPWIP,B2RPDV) + ENDIF + PALLB=PLOWB+PHIGHB + +C...Initialize iteration in xT2 for hardest interaction. + ELSEIF(MMUL.EQ.2) THEN + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + IF(MSTP(82).LE.0) THEN + ELSEIF(MSTP(82).EQ.1) THEN + XT2=1D0 + SIGRAT=XSEC(96,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* + & VINT(317)/(VINT(318)*VINT(320)) + XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) + ELSEIF(MSTP(82).EQ.2) THEN + XT2=1D0 + XT2FAC=VNT146*XSEC(96,1)/MAX(1D-10,SIGT(0,0,5))* + & VINT(149)*(1D0+VINT(149)) + ELSE + XC2=4D0*CKIN(3)**2/VINT(2) + IF(CKIN(3).LE.CKIN(5).OR.MINT(82).GE.2) XC2=0D0 + ENDIF + +C...Select impact parameter for hardest interaction. + IF(MSTP(82).LE.2) RETURN + 142 IF(PYR(0)*PALLB.LT.PLOWB) THEN +C...Treatment in low b region. + MINT(39)=1 + B=BDIV*SQRT(PYR(0)) + IF(MSTP(82).EQ.3) THEN + OV=EXP(-B**2)/PARU(2) + ELSEIF(MSTP(82).EQ.4) THEN + OV=(P83A*EXP(-MIN(50D0,B**2))+ + & P83B*CQ2R*EXP(-MIN(50D0,B**2*CQ2R))+ + & P83C*CQ2I*EXP(-MIN(50D0,B**2*CQ2I)))/PARU(2) + ELSE + OV=EXP(-B**POWIP)/PARU(2) + ENDIF + VINT(148)=OV/VNT147 + PACC=1D0-EXP(-MIN(50D0,PIK*OV)) + XT2=1D0 + XT2FAC=VNT146*VINT(148)*XSEC(96,1)/MAX(1D-10,SIGT(0,0,5))* + & VINT(149)*(1D0+VINT(149)) + ELSE +C...Treatment in high b region. + MINT(39)=2 + IF(MSTP(82).EQ.3) THEN + B=SQRT(BDIV**2-LOG(PYR(0))) + OV=EXP(-B**2)/PARU(2) + ELSEIF(MSTP(82).EQ.4) THEN + S4RNDM=PYR(0)*(S4A+S4B+S4C) + IF(S4RNDM.LT.S4A) THEN + B=SQRT(BDIV**2-LOG(PYR(0))) + ELSEIF(S4RNDM.LT.S4A+S4B) THEN + B=SQRT(BDIV**2-LOG(PYR(0))/CQ2R) + ELSE + B=SQRT(BDIV**2-LOG(PYR(0))/CQ2I) + ENDIF + OV=(P83A*EXP(-MIN(50D0,B**2))+ + & P83B*CQ2R*EXP(-MIN(50D0,B**2*CQ2R))+ + & P83C*CQ2I*EXP(-MIN(50D0,B**2*CQ2I)))/PARU(2) + ELSEIF(PARP(83).GE.1.999D0) THEN + 144 B2RPW=B2RPDV-LOG(PYR(0)) + ACCIP=(B2RPW/B2RPDV)**RPWIP + IF(ACCIP.LT.PYR(0)) GOTO 144 + OV=EXP(-B2RPW)/PARU(2) + B=B2RPW**(1D0/POWIP) + ELSE + 146 B2RPW=B2RPDV-2D0*LOG(PYR(0)) + ACCIP=(B2RPW/B2RPMX)**RPWIP*EXP(-0.5D0*(B2RPW-B2RPMX)) + IF(ACCIP.LT.PYR(0)) GOTO 146 + OV=EXP(-B2RPW)/PARU(2) + B=B2RPW**(1D0/POWIP) + ENDIF + VINT(148)=OV/VNT147 + PACC=(1D0-EXP(-MIN(50D0,PIK*OV)))/(PIK*OV) + ENDIF + IF(PACC.LT.PYR(0)) GOTO 142 + VINT(139)=B/BAVG + + ELSEIF(MMUL.EQ.3) THEN +C...Low-pT or multiple interactions (first semihard interaction): +C...choose xT2 according to dpT2/pT2**2*exp(-(sigma above pT2)/norm) +C...or (MSTP(82)>=2) dpT2/(pT2+pT0**2)**2*exp(-....). + ISUB=MINT(1) + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + IF(MSTP(82).LE.0) THEN + XT2=0D0 + ELSEIF(MSTP(82).EQ.1) THEN + XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) +C...Use with "Sudakov" for low b values when impact parameter dependence. + ELSEIF(MSTP(82).EQ.2.OR.MINT(39).EQ.1) THEN + IF(XT2.LT.1D0.AND.EXP(-XT2FAC*XT2/(VINT(149)*(XT2+ + & VINT(149)))).GT.PYR(0)) XT2=1D0 + IF(XT2.GE.1D0) THEN + XT2=(1D0+VINT(149))*XT2FAC/(XT2FAC-(1D0+VINT(149))*LOG(1D0- + & PYR(0)*(1D0-EXP(-XT2FAC/(VINT(149)*(1D0+VINT(149)))))))- + & VINT(149) + ELSE + XT2=-XT2FAC/LOG(EXP(-XT2FAC/(XT2+VINT(149)))+PYR(0)* + & (EXP(-XT2FAC/VINT(149))-EXP(-XT2FAC/(XT2+VINT(149)))))- + & VINT(149) + ENDIF + XT2=MAX(0.01D0*VINT(149),XT2) +C...Use without "Sudakov" for high b values when impact parameter dep. + ELSE + XT2=(XC2+VINT(149))*(1D0+VINT(149))/(1D0+VINT(149)- + & PYR(0)*(1D0-XC2))-VINT(149) + XT2=MAX(0.01D0*VINT(149),XT2) + ENDIF + VINT(25)=XT2 + +C...Low-pT: choose xT2, tau, y* and cos(theta-hat) fixed. + IF(MSTP(82).LE.1.AND.XT2.LT.VINT(149)) THEN + IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)-MINT(143) + IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)-MINT(143) + ISUB=95 + MINT(1)=ISUB + VINT(21)=0.01D0*VINT(149) + VINT(22)=0D0 + VINT(23)=0D0 + VINT(25)=0.01D0*VINT(149) + + ELSE +C...Multiple interactions (first semihard interaction). +C...Choose tau and y*. Calculate cos(theta-hat). + IF(PYR(0).LE.COEF(ISUB,1)) THEN + TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) + TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) + ELSE + TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) + ENDIF + VINT(21)=TAU + CALL PYKLIM(2) + RYST=PYR(0) + MYST=1 + IF(RYST.GT.COEF(ISUB,8)) MYST=2 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 + CALL PYKMAP(2,MYST,PYR(0)) + VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) + ENDIF + VINT(71)=0.5D0*VINT(1)*SQRT(VINT(25)) + +C...Store results of cross-section calculation. + ELSEIF(MMUL.EQ.4) THEN + ISUB=MINT(1) + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + XTS=VINT(25) + IF(ISET(ISUB).EQ.1) XTS=VINT(21) + IF(ISET(ISUB).EQ.2) + & XTS=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) + IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) XTS=VINT(26) + RBIN=MAX(0.000001D0,MIN(0.999999D0,XTS*(1D0+VINT(149))/ + & (XTS+VINT(149)))) + IRBIN=INT(1D0+20D0*RBIN) + IF(ISUB.EQ.96.AND.MSTP(171).EQ.0) THEN + NMUL(IRBIN)=NMUL(IRBIN)+1 + SIGM(IRBIN)=SIGM(IRBIN)+VINT(153) + ENDIF + +C...Choose impact parameter if not already done. + ELSEIF(MMUL.EQ.5) THEN + ISUB=MINT(1) + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + 150 IF(MINT(39).GT.0) THEN + ELSEIF(MSTP(82).EQ.3) THEN + EXPB2=PYR(0) + B2=-LOG(PYR(0)) + VINT(148)=EXPB2/(PARU(2)*VNT147) + VINT(139)=SQRT(B2)/BAVG + ELSEIF(MSTP(82).EQ.4) THEN + RTYPE=PYR(0) + IF(RTYPE.LT.P83A) THEN + B2=-LOG(PYR(0)) + ELSEIF(RTYPE.LT.P83A+P83B) THEN + B2=-LOG(PYR(0))/CQ2R + ELSE + B2=-LOG(PYR(0))/CQ2I + ENDIF + VINT(148)=(P83A*EXP(-MIN(50D0,B2))+ + & P83B*CQ2R*EXP(-MIN(50D0,B2*CQ2R))+ + & P83C*CQ2I*EXP(-MIN(50D0,B2*CQ2I)))/(PARU(2)*VNT147) + VINT(139)=SQRT(B2)/BAVG + ELSEIF(PARP(83).GE.1.999D0) THEN + POWIP=MAX(2D0,PARP(83)) + RPWIP=2D0/POWIP-1D0 + PROB1=POWIP/(2D0*EXP(-1D0)+POWIP) + 160 IF(PYR(0).LT.PROB1) THEN + B2RPW=PYR(0)**(0.5D0*POWIP) + ACCIP=EXP(-B2RPW) + ELSE + B2RPW=1D0-LOG(PYR(0)) + ACCIP=B2RPW**RPWIP + ENDIF + IF(ACCIP.LT.PYR(0)) GOTO 160 + VINT(148)=EXP(-B2RPW)/(PARU(2)*VNT147) + VINT(139)=B2RPW**(1D0/POWIP)/BAVG + ELSE + POWIP=MAX(0.4D0,PARP(83)) + RPWIP=2D0/POWIP-1D0 + PROB1=RPWIP/(RPWIP+2D0**RPWIP*EXP(-RPWIP)) + 170 IF(PYR(0).LT.PROB1) THEN + B2RPW=2D0*RPWIP*PYR(0) + ACCIP=(B2RPW/RPWIP)**RPWIP*EXP(RPWIP-B2RPW) + ELSE + B2RPW=2D0*(RPWIP-LOG(PYR(0))) + ACCIP=(0.5D0*B2RPW/RPWIP)**RPWIP*EXP(RPWIP-0.5D0*B2RPW) + ENDIF + IF(ACCIP.LT .PYR(0)) GOTO 170 + VINT(148)=EXP(-B2RPW)/(PARU(2)*VNT147) + VINT(139)=B2RPW**(1D0/POWIP)/BAVG + ENDIF + +C...Multiple interactions (variable impact parameter) : reject with +C...probability exp(-overlap*cross-section above pT/normalization). +C...Does not apply to low-b region, where "Sudakov" already included. + VINT(150)=1D0 + IF(MINT(39).NE.1) THEN + RNCOR=(IRBIN-20D0*RBIN)*NMUL(IRBIN) + SIGCOR=(IRBIN-20D0*RBIN)*SIGM(IRBIN) + DO 180 IBIN=IRBIN+1,20 + RNCOR=RNCOR+NMUL(IBIN) + SIGCOR=SIGCOR+SIGM(IBIN) + 180 CONTINUE + SIGABV=(SIGCOR/RNCOR)*VINT(149)*(1D0-XTS)/(XTS+VINT(149)) + IF(MSTP(171).EQ.1) SIGABV=SIGABV*VINT(2)/VINT(289) + VINT(150)=EXP(-MIN(50D0,VNT146*VINT(148)* + & SIGABV/MAX(1D-10,SIGT(0,0,5)))) + ENDIF + IF(MSTP(86).EQ.3.OR.(MSTP(86).EQ.2.AND.ISUB.NE.11.AND. + & ISUB.NE.12.AND.ISUB.NE.13.AND.ISUB.NE.28.AND.ISUB.NE.53 + & .AND.ISUB.NE.68.AND.ISUB.NE.95.AND.ISUB.NE.96)) THEN + IF(VINT(150).LT.PYR(0)) GOTO 150 + VINT(150)=1D0 + ENDIF + +C...Generate additional multiple semihard interactions. + ELSEIF(MMUL.EQ.6) THEN + ISUBSV=MINT(1) + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + DO 190 J=11,80 + VINTSV(J)=VINT(J) + 190 CONTINUE + ISUB=96 + MINT(1)=96 + VINT(151)=0D0 + VINT(152)=0D0 + +C...Reconstruct strings in hard scattering. + NMAX=MINT(84)+4 + IF(ISET(ISUBSV).EQ.1) NMAX=MINT(84)+2 + IF(ISET(ISUBSV).EQ.11) NMAX=MINT(84)+2+MINT(3) + NSTR=0 + DO 210 I=MINT(84)+1,NMAX + KCS=KCHG(PYCOMP(K(I,2)),2)*ISIGN(1,K(I,2)) + IF(KCS.EQ.0) GOTO 210 + DO 200 J=1,4 + IF(KCS.EQ.1.AND.(J.EQ.2.OR.J.EQ.4)) GOTO 200 + IF(KCS.EQ.-1.AND.(J.EQ.1.OR.J.EQ.3)) GOTO 200 + IF(J.LE.2) THEN + IST=MOD(K(I,J+3)/MSTU(5),MSTU(5)) + ELSE + IST=MOD(K(I,J+1),MSTU(5)) + ENDIF + IF(IST.LT.MINT(84).OR.IST.GT.I) GOTO 200 + IF(KCHG(PYCOMP(K(IST,2)),2).EQ.0) GOTO 200 + NSTR=NSTR+1 + IF(J.EQ.1.OR.J.EQ.4) THEN + KSTR(NSTR,1)=I + KSTR(NSTR,2)=IST + ELSE + KSTR(NSTR,1)=IST + KSTR(NSTR,2)=I + ENDIF + 200 CONTINUE + 210 CONTINUE + +C...Set up starting values for iteration in xT2. + XT2=4D0*VINT(62)/VINT(2) + IF(MSTP(82).LE.1) THEN + SIGRAT=XSEC(ISUB,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* + & VINT(317)/(VINT(318)*VINT(320)) + XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) + ELSE + XT2FAC=VNT146*VINT(148)*XSEC(ISUB,1)/ + & MAX(1D-10,SIGT(0,0,5))*VINT(149)*(1D0+VINT(149)) + ENDIF + VINT(63)=0D0 + VINT(64)=0D0 + VINT(143)=1D0-VINT(141) + VINT(144)=1D0-VINT(142) + +C...Iterate downwards in xT2. + 220 IF(MSTP(82).LE.1) THEN + XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) + IF(XT2.LT.VINT(149)) GOTO 270 + ELSE + IF(XT2.LE.0.01001D0*VINT(149)) GOTO 270 + XT2=XT2FAC*(XT2+VINT(149))/(XT2FAC-(XT2+VINT(149))* + & LOG(PYR(0)))-VINT(149) + IF(XT2.LE.0D0) GOTO 270 + XT2=MAX(0.01D0*VINT(149),XT2) + ENDIF + VINT(25)=XT2 + +C...Choose tau and y*. Calculate cos(theta-hat). + IF(PYR(0).LE.COEF(ISUB,1)) THEN + TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) + TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) + ELSE + TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) + ENDIF + VINT(21)=TAU + CALL PYKLIM(2) + RYST=PYR(0) + MYST=1 + IF(RYST.GT.COEF(ISUB,8)) MYST=2 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 + CALL PYKMAP(2,MYST,PYR(0)) + VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) + +C...Check that x not used up. Accept or reject kinematical variables. + X1M=SQRT(TAU)*EXP(VINT(22)) + X2M=SQRT(TAU)*EXP(-VINT(22)) + IF(VINT(143)-X1M.LT.0.01D0.OR.VINT(144)-X2M.LT.0.01D0) GOTO 220 + VINT(71)=0.5D0*VINT(1)*SQRT(XT2) + CALL PYSIGH(NCHN,SIGS) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGS=SIGS*VINT(320) + IF(SIGS.LT.XSEC(ISUB,1)*PYR(0)) GOTO 220 + +C...Reset K, P and V vectors. Select some variables. + DO 240 I=N+1,N+2 + DO 230 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 230 CONTINUE + 240 CONTINUE + RFLAV=PYR(0) + PT=0.5D0*VINT(1)*SQRT(XT2) + PHI=PARU(2)*PYR(0) + CTH=VINT(23) + +C...Add first parton to event record. + K(N+1,1)=3 + K(N+1,2)=21 + IF(RFLAV.GE.MAX(PARP(85),PARP(86))) K(N+1,2)= + & 1+INT((2D0+PARJ(2))*PYR(0)) + P(N+1,1)=PT*COS(PHI) + P(N+1,2)=PT*SIN(PHI) + P(N+1,3)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)-VINT(42)*(1D0-CTH)) + P(N+1,4)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)+VINT(42)*(1D0-CTH)) + P(N+1,5)=0D0 + +C...Add second parton to event record. + K(N+2,1)=3 + K(N+2,2)=21 + IF(K(N+1,2).NE.21) K(N+2,2)=-K(N+1,2) + P(N+2,1)=-P(N+1,1) + P(N+2,2)=-P(N+1,2) + P(N+2,3)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)-VINT(42)*(1D0+CTH)) + P(N+2,4)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)+VINT(42)*(1D0+CTH)) + P(N+2,5)=0D0 + + IF(RFLAV.LT.PARP(85).AND.NSTR.GE.1) THEN +C....Choose relevant string pieces to place gluons on. + DO 260 I=N+1,N+2 + DMIN=1D8 + DO 250 ISTR=1,NSTR + I1=KSTR(ISTR,1) + I2=KSTR(ISTR,2) + DIST=(P(I,4)*P(I1,4)-P(I,1)*P(I1,1)-P(I,2)*P(I1,2)- + & P(I,3)*P(I1,3))*(P(I,4)*P(I2,4)-P(I,1)*P(I2,1)- + & P(I,2)*P(I2,2)-P(I,3)*P(I2,3))/MAX(1D0,P(I1,4)*P(I2,4)- + & P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-P(I1,3)*P(I2,3)) + IF(ISTR.EQ.1.OR.DIST.LT.DMIN) THEN + DMIN=DIST + IST1=I1 + IST2=I2 + ISTM=ISTR + ENDIF + 250 CONTINUE + +C....Colour flow adjustments, new string pieces. + IF(K(IST1,4)/MSTU(5).EQ.IST2) K(IST1,4)=MSTU(5)*I+ + & MOD(K(IST1,4),MSTU(5)) + IF(MOD(K(IST1,5),MSTU(5)).EQ.IST2) K(IST1,5)= + & MSTU(5)*(K(IST1,5)/MSTU(5))+I + K(I,5)=MSTU(5)*IST1 + K(I,4)=MSTU(5)*IST2 + IF(K(IST2,5)/MSTU(5).EQ.IST1) K(IST2,5)=MSTU(5)*I+ + & MOD(K(IST2,5),MSTU(5)) + IF(MOD(K(IST2,4),MSTU(5)).EQ.IST1) K(IST2,4)= + & MSTU(5)*(K(IST2,4)/MSTU(5))+I + KSTR(ISTM,2)=I + KSTR(NSTR+1,1)=I + KSTR(NSTR+1,2)=IST2 + NSTR=NSTR+1 + 260 CONTINUE + +C...String drawing and colour flow for gluon loop. + ELSEIF(K(N+1,2).EQ.21) THEN + K(N+1,4)=MSTU(5)*(N+2) + K(N+1,5)=MSTU(5)*(N+2) + K(N+2,4)=MSTU(5)*(N+1) + K(N+2,5)=MSTU(5)*(N+1) + KSTR(NSTR+1,1)=N+1 + KSTR(NSTR+1,2)=N+2 + KSTR(NSTR+2,1)=N+2 + KSTR(NSTR+2,2)=N+1 + NSTR=NSTR+2 + +C...String drawing and colour flow for qqbar pair. + ELSE + K(N+1,4)=MSTU(5)*(N+2) + K(N+2,5)=MSTU(5)*(N+1) + KSTR(NSTR+1,1)=N+1 + KSTR(NSTR+1,2)=N+2 + NSTR=NSTR+1 + ENDIF + +C...Global statistics. + MINT(351)=MINT(351)+1 + VINT(351)=VINT(351)+PT + IF (MINT(351).EQ.1) VINT(356)=PT + +C...Update remaining energy; iterate. + N=N+2 + IF(N.GT.MSTU(4)-MSTU(32)-10) THEN + CALL PYERRM(11,'(PYMULT:) no more memory left in PYJETS') + MINT(51)=1 + RETURN + ENDIF + MINT(31)=MINT(31)+1 + VINT(151)=VINT(151)+VINT(41) + VINT(152)=VINT(152)+VINT(42) + VINT(143)=VINT(143)-VINT(41) + VINT(144)=VINT(144)-VINT(42) +C...Allow FSR for UE (always handle with old showers) + IF(MSTP(152).EQ.1) THEN + M41SAV=MSTJ(41) + IF (MSTJ(41).EQ.10) MSTJ(41)=2 + MSTJ(41)=MOD(MSTJ(41),10) + CALL PYSHOW(N-1,N,SQRT(PARP(71))*PT) + MSTJ(41)=M41SAV + ENDIF + IF(MINT(31).LT.240) GOTO 220 + 270 CONTINUE + MINT(1)=ISUBSV + DO 280 J=11,80 + VINT(J)=VINTSV(J) + 280 CONTINUE + ENDIF + +C...Format statements for printout. + 5000 FORMAT(/1X,'****** PYMULT: initialization of multiple inter', + &'actions for MSTP(82) =',I2,' ******') + 5100 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, + &D9.2,' mb: rejected') + 5200 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, + &D9.2,' mb: accepted') + + RETURN + END + +C********************************************************************* + +C...PYREMN +C...Adds on target remnants (one or two from each side) and +C...includes primordial kT for hadron beams. + + SUBROUTINE PYREMN(IPU1,IPU2) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ +C...Local arrays. + DIMENSION KFLCH(2),KFLSP(2),CHI(2),PMS(0:6),IS(2),ISN(2),ROBO(5), + &PSYS(0:2,5),PMIN(0:2),QOLD(4),QNEW(4),DBE(3),PSUM(4) + +C...Find event type and remaining energy. + ISUB=MINT(1) + NS=N + IF(MINT(50).EQ.0.OR.MOD(MSTP(81),10).LE.0) THEN + VINT(143)=1D0-VINT(141) + VINT(144)=1D0-VINT(142) + ENDIF + +C...Define initial partons. + NTRY=0 + 100 NTRY=NTRY+1 + DO 130 JT=1,2 + I=MINT(83)+JT+2 + IF(JT.EQ.1) IPU=IPU1 + IF(JT.EQ.2) IPU=IPU2 + K(I,1)=21 + K(I,2)=K(IPU,2) + K(I,3)=I-2 + PMS(JT)=0D0 + VINT(156+JT)=0D0 + VINT(158+JT)=0D0 + IF(MINT(47).EQ.1) THEN + DO 110 J=1,5 + P(I,J)=P(I-2,J) + 110 CONTINUE + ELSEIF(ISUB.EQ.95) THEN + K(I,2)=21 + ELSE + P(I,5)=P(IPU,5) + +C...No primordial kT, or chosen according to truncated Gaussian or +C...exponential, or (for photon) predetermined or power law. + 120 IF(MINT(40+JT).EQ.2.AND.MINT(10+JT).NE.22) THEN + IF(MSTP(91).LE.0) THEN + PT=0D0 + ELSEIF(MSTP(91).EQ.1) THEN + PT=PARP(91)*SQRT(-LOG(PYR(0))) + ELSE + RPT1=PYR(0) + RPT2=PYR(0) + PT=-PARP(92)*LOG(RPT1*RPT2) + ENDIF + IF(PT.GT.PARP(93)) GOTO 120 + ELSEIF(MINT(106+JT).EQ.3) THEN + PTA=SQRT(VINT(282+JT)) + PTB=0D0 + IF(MSTP(66).EQ.5.AND.MSTP(93).EQ.1) THEN + PTB=PARP(99)*SQRT(-LOG(PYR(0))) + ELSEIF(MSTP(66).EQ.5.AND.MSTP(93).EQ.2) THEN + RPT1=PYR(0) + RPT2=PYR(0) + PTB=-PARP(99)*LOG(RPT1*RPT2) + ENDIF + IF(PTB.GT.PARP(100)) GOTO 120 + PT=SQRT(PTA**2+PTB**2+2D0*PTA*PTB*COS(PARU(2)*PYR(0))) + PT=PT*0.8D0**MINT(57) + IF(NTRY.GT.10) PT=PT*0.8D0**(NTRY-10) + ELSEIF(IABS(MINT(14+JT)).LE.8.OR.MINT(14+JT).EQ.21) THEN + IF(MSTP(93).LE.0) THEN + PT=0D0 + ELSEIF(MSTP(93).EQ.1) THEN + PT=PARP(99)*SQRT(-LOG(PYR(0))) + ELSEIF(MSTP(93).EQ.2) THEN + RPT1=PYR(0) + RPT2=PYR(0) + PT=-PARP(99)*LOG(RPT1*RPT2) + ELSEIF(MSTP(93).EQ.3) THEN + HA=PARP(99)**2 + HB=PARP(100)**2 + PT=SQRT(MAX(0D0,HA*(HA+HB)/(HA+HB-PYR(0)*HB)-HA)) + ELSE + HA=PARP(99)**2 + HB=PARP(100)**2 + IF(MSTP(93).EQ.5) HB=MIN(VINT(48),PARP(100)**2) + PT=SQRT(MAX(0D0,HA*((HA+HB)/HA)**PYR(0)-HA)) + ENDIF + IF(PT.GT.PARP(100)) GOTO 120 + ELSE + PT=0D0 + ENDIF + VINT(156+JT)=PT + PHI=PARU(2)*PYR(0) + P(I,1)=PT*COS(PHI) + P(I,2)=PT*SIN(PHI) + PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 + ENDIF + 130 CONTINUE + IF(MINT(47).EQ.1) RETURN + +C...Kinematics construction for initial partons. + I1=MINT(83)+3 + I2=MINT(83)+4 + IF(ISUB.EQ.95) THEN + SHS=0D0 + SHR=0D0 + ELSE + SHS=VINT(141)*VINT(142)*VINT(2)+(P(I1,1)+P(I2,1))**2+ + & (P(I1,2)+P(I2,2))**2 + SHR=SQRT(MAX(0D0,SHS)) + IF((SHS-PMS(1)-PMS(2))**2-4D0*PMS(1)*PMS(2).LE.0D0) GOTO 100 + P(I1,4)=0.5D0*(SHR+(PMS(1)-PMS(2))/SHR) + P(I1,3)=SQRT(MAX(0D0,P(I1,4)**2-PMS(1))) + P(I2,4)=SHR-P(I1,4) + P(I2,3)=-P(I1,3) + +C...Transform partons to overall CM-frame. + ROBO(3)=(P(I1,1)+P(I2,1))/SHR + ROBO(4)=(P(I1,2)+P(I2,2))/SHR + CALL PYROBO(I1,I2,0D0,0D0,-ROBO(3),-ROBO(4),0D0) + ROBO(2)=PYANGL(P(I1,1),P(I1,2)) + CALL PYROBO(I1,I2,0D0,-ROBO(2),0D0,0D0,0D0) + ROBO(1)=PYANGL(P(I1,3),P(I1,1)) + CALL PYROBO(I1,I2,-ROBO(1),0D0,0D0,0D0,0D0) + CALL PYROBO(I2+1,MINT(52),0D0,-ROBO(2),0D0,0D0,0D0) + CALL PYROBO(I1,MINT(52),ROBO(1),ROBO(2),ROBO(3),ROBO(4),0D0) + ROBO(5)=(VINT(141)-VINT(142))/(VINT(141)+VINT(142)) + CALL PYROBO(I1,MINT(52),0D0,0D0,0D0,0D0,ROBO(5)) + ENDIF + +C...Optionally fix up x and Q2 definitions for leptoproduction. + IDISXQ=0 + IF((MINT(43).EQ.2.OR.MINT(43).EQ.3).AND.((ISUB.EQ.10.AND. + &MSTP(23).GE.1).OR.(ISUB.EQ.83.AND.MSTP(23).GE.2))) IDISXQ=1 + IF(IDISXQ.EQ.1) THEN + +C...Find where incoming and outgoing leptons/partons are sitting. + LESD=1 + IF(MINT(42).EQ.1) LESD=2 + LPIN=MINT(83)+3-LESD + LEIN=MINT(84)+LESD + LQIN=MINT(84)+3-LESD + LEOUT=MINT(84)+2+LESD + LQOUT=MINT(84)+5-LESD + IF(K(LEIN,3).GT.LEIN) LEIN=K(LEIN,3) + IF(K(LQIN,3).GT.LQIN) LQIN=K(LQIN,3) + LSCMS=0 + DO 140 I=MINT(84)+5,N + IF(K(I,2).EQ.94) THEN + LSCMS=I + LEOUT=I+LESD + LQOUT=I+3-LESD + ENDIF + 140 CONTINUE + LQBG=IPU1 + IF(LESD.EQ.1) LQBG=IPU2 + +C...Calculate actual and wanted momentum transfer. + XNOM=VINT(43-LESD) + Q2NOM=-VINT(45) + HPK=2D0*(P(LPIN,4)*P(LEIN,4)-P(LPIN,1)*P(LEIN,1)- + & P(LPIN,2)*P(LEIN,2)-P(LPIN,3)*P(LEIN,3))* + & (P(MINT(83)+LESD,4)*VINT(40+LESD)/P(LEIN,4)) + HPT2=MAX(0D0,Q2NOM*(1D0-Q2NOM/(XNOM*HPK))) + FAC=SQRT(HPT2/(P(LEOUT,1)**2+P(LEOUT,2)**2)) + P(N+1,1)=FAC*P(LEOUT,1) + P(N+1,2)=FAC*P(LEOUT,2) + P(N+1,3)=0.25D0*((HPK-Q2NOM/XNOM)/P(LPIN,4)- + & Q2NOM/(P(MINT(83)+LESD,4)*VINT(40+LESD)))*(-1)**(LESD+1) + P(N+1,4)=SQRT(P(LEOUT,5)**2+P(N+1,1)**2+P(N+1,2)**2+ + & P(N+1,3)**2) + DO 150 J=1,4 + QOLD(J)=P(LEIN,J)-P(LEOUT,J) + QNEW(J)=P(LEIN,J)-P(N+1,J) + 150 CONTINUE + +C...Boost outgoing electron and daughters. + IF(LSCMS.EQ.0) THEN + DO 160 J=1,4 + P(LEOUT,J)=P(N+1,J) + 160 CONTINUE + ELSE + DO 170 J=1,3 + P(N+2,J)=(P(N+1,J)-P(LEOUT,J))/(P(N+1,4)+P(LEOUT,4)) + 170 CONTINUE + PINV=2D0/(1D0+P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2) + DO 180 J=1,3 + DBE(J)=PINV*P(N+2,J) + 180 CONTINUE + DO 200 I=LSCMS+1,N + IORIG=I + 190 IORIG=K(IORIG,3) + IF(IORIG.GT.LEOUT) GOTO 190 + IF(I.EQ.LEOUT.OR.IORIG.EQ.LEOUT) + & CALL PYROBO(I,I,0D0,0D0,DBE(1),DBE(2),DBE(3)) + 200 CONTINUE + ENDIF + +C...Copy shower initiator and all outgoing partons. + NCOP=N+1 + K(NCOP,3)=LQBG + DO 210 J=1,5 + P(NCOP,J)=P(LQBG,J) + 210 CONTINUE + DO 240 I=MINT(84)+1,N + ICOP=0 + IF(K(I,1).GT.10) GOTO 240 + IF(I.EQ.LQBG.OR.I.EQ.LQOUT) THEN + ICOP=I + ELSE + IORIG=I + 220 IORIG=K(IORIG,3) + IF(IORIG.EQ.LQBG.OR.IORIG.EQ.LQOUT) THEN + ICOP=IORIG + ELSEIF(IORIG.GT.MINT(84).AND.IORIG.LE.N) THEN + GOTO 220 + ENDIF + ENDIF + IF(ICOP.NE.0) THEN + NCOP=NCOP+1 + K(NCOP,3)=I + DO 230 J=1,5 + P(NCOP,J)=P(I,J) + 230 CONTINUE + ENDIF + 240 CONTINUE + +C...Calculate relative rescaling factors. + SLC=3-2*LESD + PLCSUM=0D0 + DO 250 I=N+2,NCOP + PLCSUM=PLCSUM+(P(I,4)+SLC*P(I,3)) + 250 CONTINUE + DO 260 I=N+2,NCOP + V(I,1)=(P(I,4)+SLC*P(I,3))/PLCSUM + 260 CONTINUE + +C...Transfer extra three-momentum of current. + DO 280 I=N+2,NCOP + DO 270 J=1,3 + P(I,J)=P(I,J)+V(I,1)*(QNEW(J)-QOLD(J)) + 270 CONTINUE + P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) + 280 CONTINUE + +C...Iterate change of initiator momentum to get energy right. + ITER=0 + 290 ITER=ITER+1 + PEEX=-P(N+1,4)-QNEW(4) + PEMV=-P(N+1,3)/P(N+1,4) + DO 300 I=N+2,NCOP + PEEX=PEEX+P(I,4) + PEMV=PEMV+V(I,1)*P(I,3)/P(I,4) + 300 CONTINUE + IF(ABS(PEMV).LT.1D-10) THEN + MINT(51)=1 + MINT(57)=MINT(57)+1 + RETURN + ENDIF + PZCH=-PEEX/PEMV + P(N+1,3)=P(N+1,3)+PZCH + P(N+1,4)=SQRT(P(N+1,5)**2+P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2) + DO 310 I=N+2,NCOP + P(I,3)=P(I,3)+V(I,1)*PZCH + P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) + 310 CONTINUE + IF(ITER.LT.10.AND.ABS(PEEX).GT.1D-6*P(N+1,4)) GOTO 290 + +C...Modify momenta in event record. + HBE=2D0*(P(N+1,4)+P(LQBG,4))*(P(N+1,3)-P(LQBG,3))/ + & ((P(N+1,4)+P(LQBG,4))**2+(P(N+1,3)-P(LQBG,3))**2) + IF(ABS(HBE).GE.1D0) THEN + MINT(51)=1 + MINT(57)=MINT(57)+1 + RETURN + ENDIF + I=MINT(83)+5-LESD + CALL PYROBO(I,I,0D0,0D0,0D0,0D0,HBE) + DO 330 I=N+1,NCOP + ICOP=K(I,3) + DO 320 J=1,4 + P(ICOP,J)=P(I,J) + 320 CONTINUE + 330 CONTINUE + ENDIF + +C...Check minimum invariant mass of remnant system(s). + PSYS(0,4)=P(I1,4)+P(I2,4)+0.5D0*VINT(1)*(VINT(151)+VINT(152)) + PSYS(0,3)=P(I1,3)+P(I2,3)+0.5D0*VINT(1)*(VINT(151)-VINT(152)) + PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) + PMIN(0)=SQRT(PMS(0)) + DO 340 JT=1,2 + PSYS(JT,4)=0.5D0*VINT(1)*VINT(142+JT) + PSYS(JT,3)=PSYS(JT,4)*(-1)**(JT-1) + PMIN(JT)=0D0 + IF(MINT(44+JT).EQ.1) GOTO 340 + MINT(105)=MINT(102+JT) + MINT(109)=MINT(106+JT) + CALL PYSPLI(MINT(10+JT),MINT(12+JT),KFLCH(JT),KFLSP(JT)) + IF(MINT(51).NE.0) THEN + MINT(57)=MINT(57)+1 + RETURN + ENDIF + IF(KFLCH(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLCH(JT)) + IF(KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLSP(JT)) + IF(KFLCH(JT)*KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+0.5D0*PARP(111) + PMIN(JT)=SQRT(PMIN(JT)**2+P(MINT(83)+JT+2,1)**2+ + & P(MINT(83)+JT+2,2)**2) + 340 CONTINUE + IF(PMIN(0)+PMIN(1)+PMIN(2).GT.VINT(1).OR.(MINT(45).GE.2.AND. + &PMIN(1).GT.PSYS(1,4)).OR.(MINT(46).GE.2.AND.PMIN(2).GT. + &PSYS(2,4))) THEN + MINT(51)=1 + MINT(57)=MINT(57)+1 + RETURN + ENDIF + +C...Loop over two remnants; skip if none there. + I=NS + DO 410 JT=1,2 + ISN(JT)=0 + IF(MINT(44+JT).EQ.1) GOTO 410 + IF(JT.EQ.1) IPU=IPU1 + IF(JT.EQ.2) IPU=IPU2 + +C...Store first remnant parton. + I=I+1 + IS(JT)=I + ISN(JT)=1 + DO 350 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 350 CONTINUE + K(I,1)=1 + K(I,2)=KFLSP(JT) + K(I,3)=MINT(83)+JT + P(I,5)=PYMASS(K(I,2)) + +C...First parton colour connections and kinematics. + KCOL=KCHG(PYCOMP(KFLSP(JT)),2) + IF(KCOL.EQ.2) THEN + K(I,1)=3 + K(I,4)=MSTU(5)*IPU+IPU + K(I,5)=MSTU(5)*IPU+IPU + K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I + K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I + ELSEIF(KCOL.NE.0) THEN + K(I,1)=3 + KFLS=(3-KCOL*ISIGN(1,KFLSP(JT)))/2 + K(I,KFLS+3)=IPU + K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I + ENDIF + IF(KFLCH(JT).EQ.0) THEN + P(I,1)=-P(MINT(83)+JT+2,1) + P(I,2)=-P(MINT(83)+JT+2,2) + PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 + PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) + P(I,3)=PSYS(JT,3) + P(I,4)=PSYS(JT,4) + +C...When extra remnant parton or hadron: store extra remnant. + ELSE + I=I+1 + ISN(JT)=2 + DO 360 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 360 CONTINUE + K(I,1)=1 + K(I,2)=KFLCH(JT) + K(I,3)=MINT(83)+JT + P(I,5)=PYMASS(K(I,2)) + +C...Find parton colour connections of extra remnant. + KCOL=KCHG(PYCOMP(KFLCH(JT)),2) + IF(KCOL.EQ.2) THEN + K(I,1)=3 + K(I,4)=MSTU(5)*IPU+IPU + K(I,5)=MSTU(5)*IPU+IPU + K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I + K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I + ELSEIF(KCOL.NE.0) THEN + K(I,1)=3 + KFLS=(3-KCOL*ISIGN(1,KFLCH(JT)))/2 + K(I,KFLS+3)=IPU + K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I + ENDIF + +C...Relative transverse momentum when two remnants. + LOOP=0 + 370 LOOP=LOOP+1 + CALL PYPTDI(1,P(I-1,1),P(I-1,2)) + IF(IABS(MINT(10+JT)).LT.20) THEN + P(I-1,1)=0D0 + P(I-1,2)=0D0 + ELSE + P(I-1,1)=P(I-1,1)-0.5D0*P(MINT(83)+JT+2,1) + P(I-1,2)=P(I-1,2)-0.5D0*P(MINT(83)+JT+2,2) + ENDIF + PMS(JT+2)=P(I-1,5)**2+P(I-1,1)**2+P(I-1,2)**2 + P(I,1)=-P(MINT(83)+JT+2,1)-P(I-1,1) + P(I,2)=-P(MINT(83)+JT+2,2)-P(I-1,2) + PMS(JT+4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 + +C...Meson or baryon; photon as meson. For splitup below. + IMB=1 + IF(MOD(MINT(10+JT)/1000,10).NE.0) IMB=2 + +C***Relative distribution for electron into two electrons. Temporary! + IF(IABS(MINT(10+JT)).LT.20.AND.MINT(14+JT).EQ.-MINT(10+JT)) + & THEN + CHI(JT)=PYR(0) + +C...Relative distribution of electron energy into electron plus parton. + ELSEIF(IABS(MINT(10+JT)).LT.20) THEN + XHRD=VINT(140+JT) + XE=VINT(154+JT) + CHI(JT)=(XE-XHRD)/(1D0-XHRD) + +C...Relative distribution of energy for particle into two jets. + ELSEIF(IABS(KFLCH(JT)).LE.10.OR.KFLCH(JT).EQ.21) THEN + CHIK=PARP(92+2*IMB) + IF(MSTP(92).LE.1) THEN + IF(IMB.EQ.1) CHI(JT)=PYR(0) + IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) + ELSEIF(MSTP(92).EQ.2) THEN + CHI(JT)=1D0-PYR(0)**(1D0/(1D0+CHIK)) + ELSEIF(MSTP(92).EQ.3) THEN + CUT=2D0*0.3D0/VINT(1) + 380 CHI(JT)=PYR(0)**2 + IF((CHI(JT)**2/(CHI(JT)**2+CUT**2))**0.25D0* + & (1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 380 + ELSEIF(MSTP(92).EQ.4) THEN + CUT=2D0*0.3D0/VINT(1) + CUTR=(1D0+SQRT(1D0+CUT**2))/CUT + 390 CHIR=CUT*CUTR**PYR(0) + CHI(JT)=(CHIR**2-CUT**2)/(2D0*CHIR) + IF((1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 390 + ELSE + CUT=2D0*0.3D0/VINT(1) + CUTA=CUT**(1D0-PARP(98)) + CUTB=(1D0+CUT)**(1D0-PARP(98)) + 400 CHI(JT)=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) + IF(((CHI(JT)+CUT)**2/(2D0*(CHI(JT)**2+CUT**2)))** + & (0.5D0*PARP(98))*(1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 400 + ENDIF + +C...Relative distribution of energy for particle into jet plus particle. + ELSE + IF(MSTP(94).LE.1) THEN + IF(IMB.EQ.1) CHI(JT)=PYR(0) + IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) + IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) + ELSEIF(MSTP(94).EQ.2) THEN + CHI(JT)=1D0-PYR(0)**(1D0/(1D0+PARP(93+2*IMB))) + IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) + ELSEIF(MSTP(94).EQ.3) THEN + CALL PYZDIS(1,0,PMS(JT+4),ZZ) + CHI(JT)=ZZ + ELSE + CALL PYZDIS(1000,0,PMS(JT+4),ZZ) + CHI(JT)=ZZ + ENDIF + ENDIF + +C...Construct total transverse mass; reject if too large. + CHI(JT)=MAX(1D-8,MIN(1D0-1D-8,CHI(JT))) + PMS(JT)=PMS(JT+4)/CHI(JT)+PMS(JT+2)/(1D0-CHI(JT)) + IF(PMS(JT).GT.PSYS(JT,4)**2) THEN + IF(LOOP.LT.100) THEN + GOTO 370 + ELSE + MINT(51)=1 + MINT(57)=MINT(57)+1 + RETURN + ENDIF + ENDIF + PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) + VINT(158+JT)=CHI(JT) + +C...Subdivide longitudinal momentum according to value selected above. + PW1=CHI(JT)*(PSYS(JT,4)+ABS(PSYS(JT,3))) + P(IS(JT)+1,4)=0.5D0*(PW1+PMS(JT+4)/PW1) + P(IS(JT)+1,3)=0.5D0*(PW1-PMS(JT+4)/PW1)*(-1)**(JT-1) + P(IS(JT),4)=PSYS(JT,4)-P(IS(JT)+1,4) + P(IS(JT),3)=PSYS(JT,3)-P(IS(JT)+1,3) + ENDIF + 410 CONTINUE + N=I + +C...Check if longitudinal boosts needed - if so pick two systems. + PDEV=ABS(PSYS(0,4)+PSYS(1,4)+PSYS(2,4)-VINT(1))+ + &ABS(PSYS(0,3)+PSYS(1,3)+PSYS(2,3)) + IF(PDEV.LE.1D-6*VINT(1)) RETURN + IF(ISN(1).EQ.0) THEN + IR=0 + IL=2 + ELSEIF(ISN(2).EQ.0) THEN + IR=1 + IL=0 + ELSEIF(VINT(143).GT.0.2D0.AND.VINT(144).GT.0.2D0) THEN + IR=1 + IL=2 + ELSEIF(VINT(143).GT.0.2D0) THEN + IR=1 + IL=0 + ELSEIF(VINT(144).GT.0.2D0) THEN + IR=0 + IL=2 + ELSEIF(PMS(1)/PSYS(1,4)**2.GT.PMS(2)/PSYS(2,4)**2) THEN + IR=1 + IL=0 + ELSE + IR=0 + IL=2 + ENDIF + IG=3-IR-IL + +C...E+-pL wanted for system to be modified. + IF((IG.EQ.1.AND.ISN(1).EQ.0).OR.(IG.EQ.2.AND.ISN(2).EQ.0)) THEN + PPB=VINT(1) + PNB=VINT(1) + ELSE + PPB=VINT(1)-(PSYS(IG,4)+PSYS(IG,3)) + PNB=VINT(1)-(PSYS(IG,4)-PSYS(IG,3)) + ENDIF + +C...To keep x and Q2 in leptoproduction: do not count scattered lepton. + IF(IDISXQ.EQ.1.AND.IG.NE.0) THEN + PPB=PPB-(PSYS(0,4)+PSYS(0,3)) + PNB=PNB-(PSYS(0,4)-PSYS(0,3)) + DO 420 J=1,4 + PSYS(0,J)=0D0 + 420 CONTINUE + DO 450 I=MINT(84)+1,NS + IF(K(I,1).GT.10) GOTO 450 + INCL=0 + IORIG=I + 430 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 + IORIG=K(IORIG,3) + IF(IORIG.GT.LPIN) GOTO 430 + IF(INCL.EQ.0) GOTO 450 + DO 440 J=1,4 + PSYS(0,J)=PSYS(0,J)+P(I,J) + 440 CONTINUE + 450 CONTINUE + PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) + PPB=PPB+(PSYS(0,4)+PSYS(0,3)) + PNB=PNB+(PSYS(0,4)-PSYS(0,3)) + ENDIF + +C...Construct longitudinal boosts. + DPMTB=PPB*PNB + DPMTR=PMS(IR) + DPMTL=PMS(IL) + DSQLAM=SQRT(MAX(0D0,(DPMTB-DPMTR-DPMTL)**2-4D0*DPMTR*DPMTL)) + IF(DSQLAM.LE.1D-6*DPMTB) THEN + MINT(51)=1 + MINT(57)=MINT(57)+1 + RETURN + ENDIF + DSQSGN=SIGN(1D0,PSYS(IR,3)*PSYS(IL,4)-PSYS(IL,3)*PSYS(IR,4)) + DRKR=(DPMTB+DPMTR-DPMTL+DSQLAM*DSQSGN)/ + &(2D0*(PSYS(IR,4)+PSYS(IR,3))*PNB) + DRKL=(DPMTB+DPMTL-DPMTR+DSQLAM*DSQSGN)/ + &(2D0*(PSYS(IL,4)-PSYS(IL,3))*PPB) + DBER=(DRKR**2-1D0)/(DRKR**2+1D0) + DBEL=-(DRKL**2-1D0)/(DRKL**2+1D0) + +C...Perform longitudinal boosts. + IF(IR.EQ.1.AND.ISN(1).EQ.1.AND.DBER.LE.-0.99999999D0) THEN + P(IS(1),3)=0D0 + P(IS(1),4)=SQRT(P(IS(1),5)**2+P(IS(1),1)**2+P(IS(1),2)**2) + ELSEIF(IR.EQ.1) THEN + CALL PYROBO(IS(1),IS(1)+ISN(1)-1,0D0,0D0,0D0,0D0,DBER) + ELSEIF(IDISXQ.EQ.1) THEN + DO 470 I=I1,NS + INCL=0 + IORIG=I + 460 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 + IORIG=K(IORIG,3) + IF(IORIG.GT.LPIN) GOTO 460 + IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBER) + 470 CONTINUE + ELSE + CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBER) + ENDIF + IF(IL.EQ.2.AND.ISN(2).EQ.1.AND.DBEL.GE.0.99999999D0) THEN + P(IS(2),3)=0D0 + P(IS(2),4)=SQRT(P(IS(2),5)**2+P(IS(2),1)**2+P(IS(2),2)**2) + ELSEIF(IL.EQ.2) THEN + CALL PYROBO(IS(2),IS(2)+ISN(2)-1,0D0,0D0,0D0,0D0,DBEL) + ELSEIF(IDISXQ.EQ.1) THEN + DO 490 I=I1,NS + INCL=0 + IORIG=I + 480 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 + IORIG=K(IORIG,3) + IF(IORIG.GT.LPIN) GOTO 480 + IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBEL) + 490 CONTINUE + ELSE + CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBEL) + ENDIF + +C...Final check that energy-momentum conservation worked. + PESUM=0D0 + PZSUM=0D0 + DO 500 I=MINT(84)+1,N + IF(K(I,1).GT.10) GOTO 500 + PESUM=PESUM+P(I,4) + PZSUM=PZSUM+P(I,3) + 500 CONTINUE + PDEV=ABS(PESUM-VINT(1))+ABS(PZSUM) + IF(PDEV.GT.1D-4*VINT(1)) THEN + MINT(51)=1 + MINT(57)=MINT(57)+1 + RETURN + ENDIF + +C...Calculate rotation and boost from overall CM frame to +C...hadronic CM frame in leptoproduction. + MINT(91)=0 + IF(MINT(82).EQ.1.AND.(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN + MINT(91)=1 + LESD=1 + IF(MINT(42).EQ.1) LESD=2 + LPIN=MINT(83)+3-LESD + +C...Sum upp momenta of everything not lepton or photon to define boost. + DO 510 J=1,4 + PSUM(J)=0D0 + 510 CONTINUE + DO 530 I=1,N + IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 530 + IF(IABS(K(I,2)).GE.11.AND.IABS(K(I,2)).LE.20) GOTO 530 + IF(K(I,2).EQ.22) GOTO 530 + DO 520 J=1,4 + PSUM(J)=PSUM(J)+P(I,J) + 520 CONTINUE + 530 CONTINUE + VINT(223)=-PSUM(1)/PSUM(4) + VINT(224)=-PSUM(2)/PSUM(4) + VINT(225)=-PSUM(3)/PSUM(4) + +C...Boost incoming hadron to hadronic CM frame to determine rotations. + K(N+1,1)=1 + DO 540 J=1,5 + P(N+1,J)=P(LPIN,J) + V(N+1,J)=V(LPIN,J) + 540 CONTINUE + CALL PYROBO(N+1,N+1,0D0,0D0,VINT(223),VINT(224),VINT(225)) + VINT(222)=-PYANGL(P(N+1,1),P(N+1,2)) + CALL PYROBO(N+1,N+1,0D0,VINT(222),0D0,0D0,0D0) + IF(LESD.EQ.2) THEN + VINT(221)=-PYANGL(P(N+1,3),P(N+1,1)) + ELSE + VINT(221)=PYANGL(-P(N+1,3),P(N+1,1)) + ENDIF + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYMIGN +C...Initializes treatment of new multiple interactions scenario, +C...selects kinematics of hardest interaction if low-pT physics +C...included in run, and generates all non-hardest interactions. + + SUBROUTINE PYMIGN(MMUL) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP + EXTERNAL PYALPS + DOUBLE PRECISION PYALPS +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + COMMON/PYINT7/SIGT(0:6,0:6,0:5) + COMMON/PYINTM/KFIVAL(2,3),NMI(2),IMI(2,800,2),NVC(2,-6:6), + & XASSOC(2,-6:6,240),XPSVC(-6:6,-1:240),PVCTOT(2,-1:1), + & XMI(2,240),PT2MI(240),IMISEP(0:240) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, + &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT5/,/PYINT7/,/PYINTM/ +C...Local arrays and saved variables. + DIMENSION NMUL(20),SIGM(20),KSTR(500,2),VINTSV(80), + &WDTP(0:400),WDTE(0:400,0:5),XPQ(-25:25),KSAV(4,5),PSAV(4,5) + SAVE XT2,XT2FAC,XC2,XTS,IRBIN,RBIN,NMUL,SIGM,P83A,P83B,P83C, + &CQ2I,CQ2R,PIK,BDIV,B,PLOWB,PHIGHB,PALLB,S4A,S4B,S4C,POWIP, + &RPWIP,B2RPDV,B2RPMX,BAVG,VNT145,VNT146,VNT147 + +C...Initialization of multiple interaction treatment. + IF(MMUL.EQ.1) THEN + IF(MSTP(122).GE.1) WRITE(MSTU(11),5000) MSTP(82) + ISUB=96 + MINT(1)=96 + VINT(63)=0D0 + VINT(64)=0D0 + VINT(143)=1D0 + VINT(144)=1D0 + +C...Loop over phase space points: xT2 choice in 20 bins. + 100 SIGSUM=0D0 + DO 120 IXT2=1,20 + NMUL(IXT2)=MSTP(83) + SIGM(IXT2)=0D0 + DO 110 ITRY=1,MSTP(83) + RSCA=0.05D0*((21-IXT2)-PYR(0)) + XT2=VINT(149)*(1D0+VINT(149))/(VINT(149)+RSCA)-VINT(149) + XT2=MAX(0.01D0*VINT(149),XT2) + VINT(25)=XT2 + +C...Choose tau and y*. Calculate cos(theta-hat). + IF(PYR(0).LE.COEF(ISUB,1)) THEN + TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) + TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) + ELSE + TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) + ENDIF + VINT(21)=TAU + CALL PYKLIM(2) + RYST=PYR(0) + MYST=1 + IF(RYST.GT.COEF(ISUB,8)) MYST=2 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 + CALL PYKMAP(2,MYST,PYR(0)) + VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) + +C...Calculate differential cross-section. + VINT(71)=0.5D0*VINT(1)*SQRT(XT2) + CALL PYSIGH(NCHN,SIGS) + SIGM(IXT2)=SIGM(IXT2)+SIGS + 110 CONTINUE + SIGSUM=SIGSUM+SIGM(IXT2) + 120 CONTINUE + SIGSUM=SIGSUM/(20D0*MSTP(83)) + +C...Reject result if sigma(parton-parton) is smaller than hadronic one. + IF(SIGSUM.LT.1.1D0*SIGT(0,0,5)) THEN + IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) + & PARP(82)*(VINT(1)/PARP(89))**PARP(90),SIGSUM + PARP(82)=0.9D0*PARP(82) + VINT(149)=4D0*(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/ + & VINT(2) + GOTO 100 + ENDIF + IF(MSTP(122).GE.1) WRITE(MSTU(11),5200) + & PARP(82)*(VINT(1)/PARP(89))**PARP(90), SIGSUM + +C...Start iteration to find k factor. + YKE=SIGSUM/MAX(1D-10,SIGT(0,0,5)) + P83A=(1D0-PARP(83))**2 + P83B=2D0*PARP(83)*(1D0-PARP(83)) + P83C=PARP(83)**2 + CQ2I=1D0/PARP(84)**2 + CQ2R=2D0/(1D0+PARP(84)**2) + SO=0.5D0 + XI=0D0 + YI=0D0 + XF=0D0 + YF=0D0 + XK=0.5D0 + IIT=0 + 130 IF(IIT.EQ.0) THEN + XK=2D0*XK + ELSEIF(IIT.EQ.1) THEN + XK=0.5D0*XK + ELSE + XK=XI+(YKE-YI)*(XF-XI)/(YF-YI) + ENDIF + +C...Evaluate overlap integrals. Find where to divide the b range. + IF(MSTP(82).EQ.2) THEN + SP=0.5D0*PARU(1)*(1D0-EXP(-XK)) + SOP=SP/PARU(1) + ELSE + IF(MSTP(82).EQ.3) THEN + DELTAB=0.02D0 + ELSEIF(MSTP(82).EQ.4) THEN + DELTAB=MIN(0.01D0,0.05D0*PARP(84)) + ELSE + POWIP=MAX(0.4D0,PARP(83)) + RPWIP=2D0/POWIP-1D0 + DELTAB=MAX(0.02D0,0.02D0*(2D0/POWIP)**(1D0/POWIP)) + SO=0D0 + ENDIF + SP=0D0 + SOP=0D0 + BSP=0D0 + SOHIGH=0D0 + IBDIV=0 + B=-0.5D0*DELTAB + 140 B=B+DELTAB + IF(MSTP(82).EQ.3) THEN + OV=EXP(-B**2)/PARU(2) + ELSEIF(MSTP(82).EQ.4) THEN + OV=(P83A*EXP(-MIN(50D0,B**2))+ + & P83B*CQ2R*EXP(-MIN(50D0,B**2*CQ2R))+ + & P83C*CQ2I*EXP(-MIN(50D0,B**2*CQ2I)))/PARU(2) + ELSE + OV=EXP(-B**POWIP)/PARU(2) + SO=SO+PARU(2)*B*DELTAB*OV + ENDIF + IF(IBDIV.EQ.1) SOHIGH=SOHIGH+PARU(2)*B*DELTAB*OV + PACC=1D0-EXP(-MIN(50D0,PARU(1)*XK*OV)) + SP=SP+PARU(2)*B*DELTAB*PACC + SOP=SOP+PARU(2)*B*DELTAB*OV*PACC + BSP=BSP+B*PARU(2)*B*DELTAB*PACC + IF(IBDIV.EQ.0.AND.PARU(1)*XK*OV.LT.1D0) THEN + IBDIV=1 + BDIV=B+0.5D0*DELTAB + ENDIF + IF(B.LT.1D0.OR.B*PACC.GT.1D-6) GOTO 140 + ENDIF + YK=PARU(1)*XK*SO/SP + +C...Continue iteration until convergence. + IF(YK.LT.YKE) THEN + XI=XK + YI=YK + IF(IIT.EQ.1) IIT=2 + ELSE + XF=XK + YF=YK + IF(IIT.EQ.0) IIT=1 + ENDIF + IF(ABS(YK-YKE).GE.1D-5*YKE) GOTO 130 + +C...Store some results for subsequent use. + BAVG=BSP/SP + VINT(145)=SIGSUM + VINT(146)=SOP/SO + VINT(147)=SOP/SP + VNT145=VINT(145) + VNT146=VINT(146) + VNT147=VINT(147) +C...PIK = PARU(1)*XK = (VINT(146)/VINT(147))*sigma_jet/sigma_nondiffr. + PIK=(VNT146/VNT147)*YKE + +C...Find relative weight for low and high impact parameter.. + PLOWB=PARU(1)*BDIV**2 + IF(MSTP(82).EQ.3) THEN + PHIGHB=PIK*0.5*EXP(-BDIV**2) + ELSEIF(MSTP(82).EQ.4) THEN + S4A=P83A*EXP(-BDIV**2) + S4B=P83B*EXP(-BDIV**2*CQ2R) + S4C=P83C*EXP(-BDIV**2*CQ2I) + PHIGHB=PIK*0.5*(S4A+S4B+S4C) + ELSEIF(PARP(83).GE.1.999D0) THEN + PHIGHB=PIK*SOHIGH + B2RPDV=BDIV**POWIP + ELSE + PHIGHB=PIK*SOHIGH + B2RPDV=BDIV**POWIP + B2RPMX=MAX(2D0*RPWIP,B2RPDV) + ENDIF + PALLB=PLOWB+PHIGHB + +C...Initialize iteration in xT2 for hardest interaction. + ELSEIF(MMUL.EQ.2) THEN + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + IF(MSTP(82).LE.0) THEN + ELSEIF(MSTP(82).EQ.1) THEN + XT2=1D0 + SIGRAT=XSEC(96,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* + & VINT(317)/(VINT(318)*VINT(320)) + XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) + ELSEIF(MSTP(82).EQ.2) THEN + XT2=1D0 + XT2FAC=VNT146*XSEC(96,1)/MAX(1D-10,SIGT(0,0,5))* + & VINT(149)*(1D0+VINT(149)) + ELSE + XC2=4D0*CKIN(3)**2/VINT(2) + IF(CKIN(3).LE.CKIN(5).OR.MINT(82).GE.2) XC2=0D0 + ENDIF + +C...Select impact parameter for hardest interaction. + IF(MSTP(82).LE.2) RETURN + 142 IF(PYR(0)*PALLB.LT.PLOWB) THEN +C...Treatment in low b region. + MINT(39)=1 + B=BDIV*SQRT(PYR(0)) + IF(MSTP(82).EQ.3) THEN + OV=EXP(-B**2)/PARU(2) + ELSEIF(MSTP(82).EQ.4) THEN + OV=(P83A*EXP(-MIN(50D0,B**2))+ + & P83B*CQ2R*EXP(-MIN(50D0,B**2*CQ2R))+ + & P83C*CQ2I*EXP(-MIN(50D0,B**2*CQ2I)))/PARU(2) + ELSE + OV=EXP(-B**POWIP)/PARU(2) + ENDIF + VINT(148)=OV/VNT147 + PACC=1D0-EXP(-MIN(50D0,PIK*OV)) + XT2=1D0 + XT2FAC=VNT146*VINT(148)*XSEC(96,1)/MAX(1D-10,SIGT(0,0,5))* + & VINT(149)*(1D0+VINT(149)) + ELSE +C...Treatment in high b region. + MINT(39)=2 + IF(MSTP(82).EQ.3) THEN + B=SQRT(BDIV**2-LOG(PYR(0))) + OV=EXP(-B**2)/PARU(2) + ELSEIF(MSTP(82).EQ.4) THEN + S4RNDM=PYR(0)*(S4A+S4B+S4C) + IF(S4RNDM.LT.S4A) THEN + B=SQRT(BDIV**2-LOG(PYR(0))) + ELSEIF(S4RNDM.LT.S4A+S4B) THEN + B=SQRT(BDIV**2-LOG(PYR(0))/CQ2R) + ELSE + B=SQRT(BDIV**2-LOG(PYR(0))/CQ2I) + ENDIF + OV=(P83A*EXP(-MIN(50D0,B**2))+ + & P83B*CQ2R*EXP(-MIN(50D0,B**2*CQ2R))+ + & P83C*CQ2I*EXP(-MIN(50D0,B**2*CQ2I)))/PARU(2) + ELSEIF(PARP(83).GE.1.999D0) THEN + 144 B2RPW=B2RPDV-LOG(PYR(0)) + ACCIP=(B2RPW/B2RPDV)**RPWIP + IF(ACCIP.LT.PYR(0)) GOTO 144 + OV=EXP(-B2RPW)/PARU(2) + B=B2RPW**(1D0/POWIP) + ELSE + 146 B2RPW=B2RPDV-2D0*LOG(PYR(0)) + ACCIP=(B2RPW/B2RPMX)**RPWIP*EXP(-0.5D0*(B2RPW-B2RPMX)) + IF(ACCIP.LT.PYR(0)) GOTO 146 + OV=EXP(-B2RPW)/PARU(2) + B=B2RPW**(1D0/POWIP) + ENDIF + VINT(148)=OV/VNT147 + PACC=(1D0-EXP(-MIN(50D0,PIK*OV)))/(PIK*OV) + ENDIF + IF(PACC.LT.PYR(0)) GOTO 142 + VINT(139)=B/BAVG + + ELSEIF(MMUL.EQ.3) THEN +C...Low-pT or multiple interactions (first semihard interaction): +C...choose xT2 according to dpT2/pT2**2*exp(-(sigma above pT2)/norm) +C...or (MSTP(82)>=2) dpT2/(pT2+pT0**2)**2*exp(-....). + ISUB=MINT(1) + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + IF(MSTP(82).LE.0) THEN + XT2=0D0 + ELSEIF(MSTP(82).EQ.1) THEN + XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) +C...Use with "Sudakov" for low b values when impact parameter dependence. + ELSEIF(MSTP(82).EQ.2.OR.MINT(39).EQ.1) THEN + IF(XT2.LT.1D0.AND.EXP(-XT2FAC*XT2/(VINT(149)*(XT2+ + & VINT(149)))).GT.PYR(0)) XT2=1D0 + IF(XT2.GE.1D0) THEN + XT2=(1D0+VINT(149))*XT2FAC/(XT2FAC-(1D0+VINT(149))*LOG(1D0- + & PYR(0)*(1D0-EXP(-XT2FAC/(VINT(149)*(1D0+VINT(149)))))))- + & VINT(149) + ELSE + XT2=-XT2FAC/LOG(EXP(-XT2FAC/(XT2+VINT(149)))+PYR(0)* + & (EXP(-XT2FAC/VINT(149))-EXP(-XT2FAC/(XT2+VINT(149)))))- + & VINT(149) + ENDIF + XT2=MAX(0.01D0*VINT(149),XT2) +C...Use without "Sudakov" for high b values when impact parameter dep. + ELSE + XT2=(XC2+VINT(149))*(1D0+VINT(149))/(1D0+VINT(149)- + & PYR(0)*(1D0-XC2))-VINT(149) + XT2=MAX(0.01D0*VINT(149),XT2) + ENDIF + VINT(25)=XT2 + +C...Low-pT: choose xT2, tau, y* and cos(theta-hat) fixed. + IF(MSTP(82).LE.1.AND.XT2.LT.VINT(149)) THEN + IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)-MINT(143) + IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)-MINT(143) + ISUB=95 + MINT(1)=ISUB + VINT(21)=1D-12*VINT(149) + VINT(22)=0D0 + VINT(23)=0D0 + VINT(25)=1D-12*VINT(149) + + ELSE +C...Multiple interactions (first semihard interaction). +C...Choose tau and y*. Calculate cos(theta-hat). + IF(PYR(0).LE.COEF(ISUB,1)) THEN + TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) + TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) + ELSE + TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) + ENDIF + VINT(21)=TAU + CALL PYKLIM(2) + RYST=PYR(0) + MYST=1 + IF(RYST.GT.COEF(ISUB,8)) MYST=2 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 + CALL PYKMAP(2,MYST,PYR(0)) + VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) + ENDIF + VINT(71)=0.5D0*VINT(1)*SQRT(VINT(25)) + +C...Store results of cross-section calculation. + ELSEIF(MMUL.EQ.4) THEN + ISUB=MINT(1) + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + XTS=VINT(25) + IF(ISET(ISUB).EQ.1) XTS=VINT(21) + IF(ISET(ISUB).EQ.2) + & XTS=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) + IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) XTS=VINT(26) + RBIN=MAX(0.000001D0,MIN(0.999999D0,XTS*(1D0+VINT(149))/ + & (XTS+VINT(149)))) + IRBIN=INT(1D0+20D0*RBIN) + IF(ISUB.EQ.96.AND.MSTP(171).EQ.0) THEN + NMUL(IRBIN)=NMUL(IRBIN)+1 + SIGM(IRBIN)=SIGM(IRBIN)+VINT(153) + ENDIF + +C...Choose impact parameter if not already done. + ELSEIF(MMUL.EQ.5) THEN + ISUB=MINT(1) + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + 150 IF(MINT(39).GT.0) THEN + ELSEIF(MSTP(82).EQ.3) THEN + EXPB2=PYR(0) + B2=-LOG(PYR(0)) + VINT(148)=EXPB2/(PARU(2)*VNT147) + VINT(139)=SQRT(B2)/BAVG + ELSEIF(MSTP(82).EQ.4) THEN + RTYPE=PYR(0) + IF(RTYPE.LT.P83A) THEN + B2=-LOG(PYR(0)) + ELSEIF(RTYPE.LT.P83A+P83B) THEN + B2=-LOG(PYR(0))/CQ2R + ELSE + B2=-LOG(PYR(0))/CQ2I + ENDIF + VINT(148)=(P83A*EXP(-MIN(50D0,B2))+ + & P83B*CQ2R*EXP(-MIN(50D0,B2*CQ2R))+ + & P83C*CQ2I*EXP(-MIN(50D0,B2*CQ2I)))/(PARU(2)*VNT147) + VINT(139)=SQRT(B2)/BAVG + ELSEIF(PARP(83).GE.1.999D0) THEN + POWIP=MAX(2D0,PARP(83)) + RPWIP=2D0/POWIP-1D0 + PROB1=POWIP/(2D0*EXP(-1D0)+POWIP) + 160 IF(PYR(0).LT.PROB1) THEN + B2RPW=PYR(0)**(0.5D0*POWIP) + ACCIP=EXP(-B2RPW) + ELSE + B2RPW=1D0-LOG(PYR(0)) + ACCIP=B2RPW**RPWIP + ENDIF + IF(ACCIP.LT.PYR(0)) GOTO 160 + VINT(148)=EXP(-B2RPW)/(PARU(2)*VNT147) + VINT(139)=B2RPW**(1D0/POWIP)/BAVG + ELSE + POWIP=MAX(0.4D0,PARP(83)) + RPWIP=2D0/POWIP-1D0 + PROB1=RPWIP/(RPWIP+2D0**RPWIP*EXP(-RPWIP)) + 170 IF(PYR(0).LT.PROB1) THEN + B2RPW=2D0*RPWIP*PYR(0) + ACCIP=(B2RPW/RPWIP)**RPWIP*EXP(RPWIP-B2RPW) + ELSE + B2RPW=2D0*(RPWIP-LOG(PYR(0))) + ACCIP=(0.5D0*B2RPW/RPWIP)**RPWIP*EXP(RPWIP-0.5D0*B2RPW) + ENDIF + IF(ACCIP.LT .PYR(0)) GOTO 170 + VINT(148)=EXP(-B2RPW)/(PARU(2)*VNT147) + VINT(139)=B2RPW**(1D0/POWIP)/BAVG + ENDIF + +C...Multiple interactions (variable impact parameter) : reject with +C...probability exp(-overlap*cross-section above pT/normalization). +C...Does not apply to low-b region, where "Sudakov" already included. + VINT(150)=1D0 + IF(MINT(39).NE.1) THEN + RNCOR=(IRBIN-20D0*RBIN)*NMUL(IRBIN) + SIGCOR=(IRBIN-20D0*RBIN)*SIGM(IRBIN) + DO 180 IBIN=IRBIN+1,20 + RNCOR=RNCOR+NMUL(IBIN) + SIGCOR=SIGCOR+SIGM(IBIN) + 180 CONTINUE + SIGABV=(SIGCOR/RNCOR)*VINT(149)*(1D0-XTS)/(XTS+VINT(149)) + IF(MSTP(171).EQ.1) SIGABV=SIGABV*VINT(2)/VINT(289) + VINT(150)=EXP(-MIN(50D0,VNT146*VINT(148)* + & SIGABV/MAX(1D-10,SIGT(0,0,5)))) + ENDIF + IF(MSTP(86).EQ.3.OR.(MSTP(86).EQ.2.AND.ISUB.NE.11.AND. + & ISUB.NE.12.AND.ISUB.NE.13.AND.ISUB.NE.28.AND.ISUB.NE.53 + & .AND.ISUB.NE.68.AND.ISUB.NE.95.AND.ISUB.NE.96)) THEN + IF(VINT(150).LT.PYR(0)) GOTO 150 + VINT(150)=1D0 + ENDIF + +C...Generate additional multiple semihard interactions. + ELSEIF(MMUL.EQ.6) THEN + +C...Save data for hardest initeraction, to be restored. + ISUBSV=MINT(1) + VINT(145)=VNT145 + VINT(146)=VNT146 + VINT(147)=VNT147 + M13SV=MINT(13) + M14SV=MINT(14) + M15SV=MINT(15) + M16SV=MINT(16) + M21SV=MINT(21) + M22SV=MINT(22) + DO 190 J=11,80 + VINTSV(J)=VINT(J) + 190 CONTINUE + V141SV=VINT(141) + V142SV=VINT(142) + +C...Store data on hardest interaction. + XMI(1,1)=VINT(141) + XMI(2,1)=VINT(142) + PT2MI(1)=VINT(54) + IMISEP(0)=MINT(84) + IMISEP(1)=N + +C...Change process to generate; sum of x values so far. + ISUB=96 + MINT(1)=96 + VINT(143)=1D0-VINT(141) + VINT(144)=1D0-VINT(142) + VINT(151)=0D0 + VINT(152)=0D0 + +C...Initialize factors for PDF reshaping. + DO 230 JS=1,2 + KFBEAM=MINT(10+JS) + KFABM=IABS(KFBEAM) + KFSBM=ISIGN(1,KFBEAM) + +C...Zero flavour content of incoming beam particle. + KFIVAL(JS,1)=0 + KFIVAL(JS,2)=0 + KFIVAL(JS,3)=0 +C...Flavour content of baryon. + IF(KFABM.GT.1000) THEN + KFIVAL(JS,1)=KFSBM*MOD(KFABM/1000,10) + KFIVAL(JS,2)=KFSBM*MOD(KFABM/100,10) + KFIVAL(JS,3)=KFSBM*MOD(KFABM/10,10) +C...Flavour content of pi+-, K+-. + ELSEIF(KFABM.EQ.211) THEN + KFIVAL(JS,1)=KFSBM*2 + KFIVAL(JS,2)=-KFSBM + ELSEIF(KFABM.EQ.321) THEN + KFIVAL(JS,1)=-KFSBM*3 + KFIVAL(JS,2)=KFSBM*2 +C...Flavour content of pi0, gamma, K0S, K0L not defined yet. + ENDIF + +C...Zero initial valence and companion content. + DO 200 IFL=-6,6 + NVC(JS,IFL)=0 + 200 CONTINUE + +C...Initiate listing of all incoming partons from two sides. + NMI(JS)=0 + DO 210 I=MINT(84)+1,N + IF(K(I,3).EQ.MINT(83)+2+JS) THEN + IMI(JS,1,1)=I + IMI(JS,1,2)=0 + ENDIF + 210 CONTINUE + +C...Decide whether quarks in hard scattering were valence or sea. + IFL=K(IMI(JS,1,1),2) + IF (IABS(IFL).GT.6) GOTO 230 + +C...Get PDFs at X and Q2 of the parton shower initiator for the +C...hard scattering. + X=VINT(140+JS) + IF(MSTP(61).GE.1) THEN + Q2=PARP(62)**2 + ELSE + Q2=VINT(54) + ENDIF +C...Note: XPSVC = x*pdf. + MINT(30)=JS +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + CALL PYPDFU(KFBEAM,X,Q2,XPQ) + SEA=XPSVC(IFL,-1) + VAL=XPSVC(IFL,0) + +C...Decide (Extra factor x cancels in the division). + RVCS=PYR(0)*(SEA+VAL) + IVNOW=1 + 220 IF (RVCS.LE.VAL.AND.IVNOW.GE.1) THEN +C...Safety check that valence present; pi0/gamma/K0S/K0L special cases. + IVNOW=0 + IF(KFIVAL(JS,1).EQ.IFL) IVNOW=IVNOW+1 + IF(KFIVAL(JS,2).EQ.IFL) IVNOW=IVNOW+1 + IF(KFIVAL(JS,3).EQ.IFL) IVNOW=IVNOW+1 + IF(KFIVAL(JS,1).EQ.0) THEN + IF(KFBEAM.EQ.111.AND.IABS(IFL).LE.2) IVNOW=1 + IF(KFBEAM.EQ.22.AND.IABS(IFL).LE.5) IVNOW=1 + IF((KFBEAM.EQ.130.OR.KFBEAM.EQ.310).AND. + & (IABS(IFL).EQ.1.OR.IABS(IFL).EQ.3)) IVNOW=1 + ENDIF + IF(IVNOW.EQ.0) GOTO 220 +C...Mark valence. + IMI(JS,1,2)=0 +C...Sets valence content of gamma, pi0, K0S, K0L if not done. + IF(KFIVAL(JS,1).EQ.0) THEN + IF(KFBEAM.EQ.111.OR.KFBEAM.EQ.22) THEN + KFIVAL(JS,1)=IFL + KFIVAL(JS,2)=-IFL + ELSEIF(KFBEAM.EQ.130.OR.KFBEAM.EQ.310) THEN + KFIVAL(JS,1)=IFL + IF(IABS(IFL).EQ.1) KFIVAL(JS,2)=ISIGN(3,-IFL) + IF(IABS(IFL).NE.1) KFIVAL(JS,2)=ISIGN(1,-IFL) + ENDIF + ENDIF + +C...If sea, add opposite sign companion parton. Store X and I. + ELSE + NVC(JS,-IFL)=NVC(JS,-IFL)+1 + XASSOC(JS,-IFL,NVC(JS,-IFL))=X +C...Set pointer to companion + IMI(JS,1,2)=-NVC(JS,-IFL) + ENDIF + 230 CONTINUE + +C...Update counter number of multiple interactions. + NMI(1)=1 + NMI(2)=1 + +C...Set up starting values for iteration in xT2. + IF(MSTP(86).EQ.3.OR.(MSTP(86).EQ.2.AND.ISUBSV.NE.11.AND. + & ISUBSV.NE.12.AND.ISUBSV.NE.13.AND.ISUBSV.NE.28.AND. + & ISUBSV.NE.53.AND.ISUBSV.NE.68.AND.ISUBSV.NE.95.AND. + & ISUBSV.NE.96)) THEN + XT2=(1D0-VINT(141))*(1D0-VINT(142)) + ELSE + XT2=VINT(25) + IF(ISET(ISUBSV).EQ.1) XT2=VINT(21) + IF(ISET(ISUBSV).EQ.2) + & XT2=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) + IF(ISET(ISUBSV).GE.3.AND.ISET(ISUBSV).LE.5) XT2=VINT(26) + ENDIF + IF(MSTP(82).LE.1) THEN + SIGRAT=XSEC(ISUB,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* + & VINT(317)/(VINT(318)*VINT(320)) + XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) + ELSE + XT2FAC=VNT146*VINT(148)*XSEC(ISUB,1)/ + & MAX(1D-10,SIGT(0,0,5))*VINT(149)*(1D0+VINT(149)) + ENDIF + VINT(63)=0D0 + VINT(64)=0D0 + +C...Iterate downwards in xT2. + 240 IF((MINT(35).EQ.2.AND.MSTP(81).EQ.10).OR.ISUBSV.EQ.95) THEN + XT2=0D0 + GOTO 440 + ELSEIF(MSTP(82).LE.1) THEN + XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) + IF(XT2.LT.VINT(149)) GOTO 440 + ELSE + IF(XT2.LE.0.01001D0*VINT(149)) GOTO 440 + XT2=XT2FAC*(XT2+VINT(149))/(XT2FAC-(XT2+VINT(149))* + & LOG(PYR(0)))-VINT(149) + IF(XT2.LE.0D0) GOTO 440 + XT2=MAX(0.01D0*VINT(149),XT2) + ENDIF + VINT(25)=XT2 + +C...Choose tau and y*. Calculate cos(theta-hat). + IF(PYR(0).LE.COEF(ISUB,1)) THEN + TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) + TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) + ELSE + TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) + ENDIF + VINT(21)=TAU +C...New: require shat > 1. + IF(TAU*VINT(2).LT.1D0) GOTO 240 + CALL PYKLIM(2) + RYST=PYR(0) + MYST=1 + IF(RYST.GT.COEF(ISUB,8)) MYST=2 + IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 + CALL PYKMAP(2,MYST,PYR(0)) + VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) + +C...Check that x not used up. Accept or reject kinematical variables. + X1M=SQRT(TAU)*EXP(VINT(22)) + X2M=SQRT(TAU)*EXP(-VINT(22)) + IF(VINT(143)-X1M.LT.0.01D0.OR.VINT(144)-X2M.LT.0.01D0) GOTO 240 + VINT(71)=0.5D0*VINT(1)*SQRT(XT2) + CALL PYSIGH(NCHN,SIGS) + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGS=SIGS*VINT(320) + IF(SIGS.LT.XSEC(ISUB,1)*PYR(0)) GOTO 240 + IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGS=SIGS/VINT(320) + +C...Reset K, P and V vectors. + DO 260 I=N+1,N+4 + DO 250 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 250 CONTINUE + 260 CONTINUE + PT=0.5D0*VINT(1)*SQRT(XT2) + +C...Choose flavour of reacting partons (and subprocess). + RSIGS=SIGS*PYR(0) + DO 270 ICHN=1,NCHN + KFL1=ISIG(ICHN,1) + KFL2=ISIG(ICHN,2) + ICONMI=ISIG(ICHN,3) + RSIGS=RSIGS-SIGH(ICHN) + IF(RSIGS.LE.0D0) GOTO 280 + 270 CONTINUE + +C...Reassign to appropriate process codes. + 280 ISUBMI=ICONMI/10 + ICONMI=MOD(ICONMI,10) + +C...Choose new quark flavour for annihilation graphs + IF(ISUBMI.EQ.12.OR.ISUBMI.EQ.53) THEN + SH=TAU*VINT(2) + CALL PYWIDT(21,SH,WDTP,WDTE) + 290 RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*PYR(0) + DO 300 I=1,MDCY(21,3) + KFLF=KFDP(I+MDCY(21,2)-1,1) + RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4)) + IF(RKFL.LE.0D0) GOTO 310 + 300 CONTINUE + 310 IF(ISUBMI.EQ.53.AND.ICONMI.LE.2) THEN + IF(KFLF.GE.4) GOTO 290 + ELSEIF(ISUBMI.EQ.53.AND.ICONMI.LE.4) THEN + KFLF=4 + ICONMI=ICONMI-2 + ELSEIF(ISUBMI.EQ.53) THEN + KFLF=5 + ICONMI=ICONMI-4 + ENDIF + ENDIF + +C...Final state flavours and colour flow: default values + JS=1 + KFL3=KFL1 + KFL4=KFL2 + KCC=20 + KCS=ISIGN(1,KFL1) + + IF(ISUBMI.EQ.11) THEN +C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2 + KCC=ICONMI + IF(KFL1*KFL2.LT.0) KCC=KCC+2 + + ELSEIF(ISUBMI.EQ.12) THEN +C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2 + KFL3=ISIGN(KFLF,KFL1) + KFL4=-KFL3 + KCC=4 + + ELSEIF(ISUBMI.EQ.13) THEN +C...f + fbar -> g + g; th arbitrary + KFL3=21 + KFL4=21 + KCC=ICONMI+4 + + ELSEIF(ISUBMI.EQ.28) THEN +C...f + g -> f + g; th = (p(f)-p(f))**2 + IF(KFL1.EQ.21) JS=2 + KCC=ICONMI+6 + IF(KFL1.EQ.21) KCC=KCC+2 + IF(KFL1.NE.21) KCS=ISIGN(1,KFL1) + IF(KFL2.NE.21) KCS=ISIGN(1,KFL2) + + ELSEIF(ISUBMI.EQ.53) THEN +C...g + g -> f + fbar; th arbitrary + KCS=(-1)**INT(1.5D0+PYR(0)) + KFL3=ISIGN(KFLF,KCS) + KFL4=-KFL3 + KCC=ICONMI+10 + + ELSEIF(ISUBMI.EQ.68) THEN +C...g + g -> g + g; th arbitrary + KCC=ICONMI+12 + KCS=(-1)**INT(1.5D0+PYR(0)) + ENDIF + +C...Store flavours of scattering. + MINT(13)=KFL1 + MINT(14)=KFL2 + MINT(15)=KFL1 + MINT(16)=KFL2 + MINT(21)=KFL3 + MINT(22)=KFL4 + +C...Set flavours and mothers of scattering partons. + K(N+1,1)=14 + K(N+2,1)=14 + K(N+3,1)=3 + K(N+4,1)=3 + K(N+1,2)=KFL1 + K(N+2,2)=KFL2 + K(N+3,2)=KFL3 + K(N+4,2)=KFL4 + K(N+1,3)=MINT(83)+1 + K(N+2,3)=MINT(83)+2 + K(N+3,3)=N+1 + K(N+4,3)=N+2 + +C...Store colour connection indices. + DO 320 J=1,2 + JC=J + IF(KCS.EQ.-1) JC=3-J + IF(ICOL(KCC,1,JC).NE.0) K(N+1,J+3)=N+ICOL(KCC,1,JC) + IF(ICOL(KCC,2,JC).NE.0) K(N+2,J+3)=N+ICOL(KCC,2,JC) + IF(ICOL(KCC,3,JC).NE.0) K(N+3,J+3)=MSTU(5)*(N+ICOL(KCC,3,JC)) + IF(ICOL(KCC,4,JC).NE.0) K(N+4,J+3)=MSTU(5)*(N+ICOL(KCC,4,JC)) + 320 CONTINUE + +C...Store incoming and outgoing partons in their CM-frame. + SHR=SQRT(TAU)*VINT(1) + P(N+1,3)=0.5D0*SHR + P(N+1,4)=0.5D0*SHR + P(N+2,3)=-0.5D0*SHR + P(N+2,4)=0.5D0*SHR + P(N+3,5)=PYMASS(K(N+3,2)) + P(N+4,5)=PYMASS(K(N+4,2)) + IF(P(N+3,5)+P(N+4,5).GE.SHR) GOTO 240 + P(N+3,4)=0.5D0*(SHR+(P(N+3,5)**2-P(N+4,5)**2)/SHR) + P(N+3,3)=SQRT(MAX(0D0,P(N+3,4)**2-P(N+3,5)**2)) + P(N+4,4)=SHR-P(N+3,4) + P(N+4,3)=-P(N+3,3) + +C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4) + PHI=PARU(2)*PYR(0) + CALL PYROBO(N+3,N+4,ACOS(VINT(23)),PHI,0D0,0D0,0D0) + +C...Set up default values before showers. + MINT(31)=MINT(31)+1 + IPU1=N+1 + IPU2=N+2 + IPU3=N+3 + IPU4=N+4 + VINT(141)=VINT(41) + VINT(142)=VINT(42) + N=N+4 + +C...Showering of initial state partons (optional). +C...Note: no showering of final state partons here; it comes later. + IF(MSTP(84).GE.1.AND.MSTP(61).GE.1) THEN + MINT(51)=0 + ALAMSV=PARJ(81) + PARJ(81)=PARP(72) + NSAV=N + DO 340 I=1,4 + DO 330 J=1,5 + KSAV(I,J)=K(N-4+I,J) + PSAV(I,J)=P(N-4+I,J) + 330 CONTINUE + 340 CONTINUE + CALL PYSSPA(IPU1,IPU2) + PARJ(81)=ALAMSV +C...If shower failed then restore to situation before shower. + IF(MINT(51).GE.1) THEN + N=NSAV + DO 360 I=1,4 + DO 350 J=1,5 + K(N-4+I,J)=KSAV(I,J) + P(N-4+I,J)=PSAV(I,J) + 350 CONTINUE + 360 CONTINUE + IPU1=N-3 + IPU2=N-2 + VINT(141)=VINT(41) + VINT(142)=VINT(42) + ENDIF + ENDIF + +C...Keep track of loose colour ends and information on scattering. + 370 IMI(1,MINT(31),1)=IPU1 + IMI(2,MINT(31),1)=IPU2 + IMI(1,MINT(31),2)=0 + IMI(2,MINT(31),2)=0 + XMI(1,MINT(31))=VINT(141) + XMI(2,MINT(31))=VINT(142) + PT2MI(MINT(31))=VINT(54) + IMISEP(MINT(31))=N + +C...Decide whether quarks in last scattering were valence, companion or +C...sea. + DO 430 JS=1,2 + KFBEAM=MINT(10+JS) + KFSBM=ISIGN(1,MINT(10+JS)) + IFL=K(IMI(JS,MINT(31),1),2) + IMI(JS,MINT(31),2)=0 + IF (IABS(IFL).GT.6) GOTO 430 + +C...Get PDFs at X and Q2 of the parton shower initiator for the +C...last scattering. At this point VINT(143:144) do not yet +C...include the scattered x values VINT(141:142). + X=VINT(140+JS)/VINT(142+JS) + IF(MSTP(84).GE.1.AND.MSTP(61).GE.1) THEN + Q2=PARP(62)**2 + ELSE + Q2=VINT(54) + ENDIF +C...Note: XPSVC = x*pdf. + MINT(30)=JS +C.... ALICE +C.... Store side in MINT(124) + MINT(124) = JS +C.... + CALL PYPDFU(KFBEAM,X,Q2,XPQ) + SEA=XPSVC(IFL,-1) + VAL=XPSVC(IFL,0) + CMP=0D0 + DO 380 IVC=1,NVC(JS,IFL) + CMP=CMP+XPSVC(IFL,IVC) + 380 CONTINUE + +C...Decide (Extra factor x cancels in the dvision). + RVCS=PYR(0)*(SEA+VAL+CMP) + IVNOW=1 + 390 IF (RVCS.LE.VAL.AND.IVNOW.GE.1) THEN +C...Safety check that valence present; pi0/gamma/K0S/K0L special cases. + IVNOW=0 + IF(KFIVAL(JS,1).EQ.IFL) IVNOW=IVNOW+1 + IF(KFIVAL(JS,2).EQ.IFL) IVNOW=IVNOW+1 + IF(KFIVAL(JS,3).EQ.IFL) IVNOW=IVNOW+1 + IF(KFIVAL(JS,1).EQ.0) THEN + IF(KFBEAM.EQ.111.AND.IABS(IFL).LE.2) IVNOW=1 + IF(KFBEAM.EQ.22.AND.IABS(IFL).LE.5) IVNOW=1 + IF((KFBEAM.EQ.130.OR.KFBEAM.EQ.310).AND. + & (IABS(IFL).EQ.1.OR.IABS(IFL).EQ.3)) IVNOW=1 + ELSE + DO 400 I1=1,NMI(JS) + IF (K(IMI(JS,I1,1),2).EQ.IFL.AND.IMI(JS,I1,2).EQ.0) + & IVNOW=IVNOW-1 + 400 CONTINUE + ENDIF + IF(IVNOW.EQ.0) GOTO 390 +C...Mark valence. + IMI(JS,MINT(31),2)=0 +C...Sets valence content of gamma, pi0, K0S, K0L if not done. + IF(KFIVAL(JS,1).EQ.0) THEN + IF(KFBEAM.EQ.111.OR.KFBEAM.EQ.22) THEN + KFIVAL(JS,1)=IFL + KFIVAL(JS,2)=-IFL + ELSEIF(KFBEAM.EQ.130.OR.KFBEAM.EQ.310) THEN + KFIVAL(JS,1)=IFL + IF(IABS(IFL).EQ.1) KFIVAL(JS,2)=ISIGN(3,-IFL) + IF(IABS(IFL).NE.1) KFIVAL(JS,2)=ISIGN(1,-IFL) + ENDIF + ENDIF + + ELSEIF (RVCS.LE.VAL+SEA.OR.NVC(JS,IFL).EQ.0) THEN +C...If sea, add opposite sign companion parton. Store X and I. + NVC(JS,-IFL)=NVC(JS,-IFL)+1 + XASSOC(JS,-IFL,NVC(JS,-IFL))=X +C...Set pointer to companion + IMI(JS,MINT(31),2)=-NVC(JS,-IFL) + ELSE +C...If companion, decide which one. + CMPSUM=VAL+SEA + ISEL=0 + 410 ISEL=ISEL+1 + CMPSUM=CMPSUM+XPSVC(IFL,ISEL) + IF (RVCS.GT.CMPSUM.AND.ISEL.LT.NVC(JS,IFL)) GOTO 410 +C...Find original sea (anti-)quark: + IASSOC=0 + DO 420 I1=1,NMI(JS) + IF (K(IMI(JS,I1,1),2).NE.-IFL) GOTO 420 + IF (-IMI(JS,I1,2).EQ.ISEL) THEN + IMI(JS,MINT(31),2)=IMI(JS,I1,1) + IMI(JS,I1,2)=IMI(JS,MINT(31),1) + ENDIF + 420 CONTINUE +C...Change X to what associated companion had, so that the correct +C...amount of momentum can be subtracted from the companion sum below. + X=XASSOC(JS,IFL,ISEL) +C...Mark companion read. + XASSOC(JS,IFL,ISEL)=0D0 + ENDIF + 430 CONTINUE + +C...Global statistics. + MINT(351)=MINT(351)+1 + VINT(351)=VINT(351)+PT + IF (MINT(351).EQ.1) VINT(356)=PT + +C...Update remaining energy and other counters. + IF(N.GT.MSTU(4)-MSTU(32)-10) THEN + CALL PYERRM(11,'(PYMIGN:) no more memory left in PYJETS') + MINT(51)=1 + RETURN + ENDIF + NMI(1)=NMI(1)+1 + NMI(2)=NMI(2)+1 + VINT(151)=VINT(151)+VINT(41) + VINT(152)=VINT(152)+VINT(42) + VINT(143)=VINT(143)-VINT(141) + VINT(144)=VINT(144)-VINT(142) + +C...Iterate, with more interactions allowed. + IF(MINT(31).LT.240) GOTO 240 + 440 CONTINUE + +C...Restore saved quantities for hardest interaction. + MINT(1)=ISUBSV + MINT(13)=M13SV + MINT(14)=M14SV + MINT(15)=M15SV + MINT(16)=M16SV + MINT(21)=M21SV + MINT(22)=M22SV + DO 450 J=11,80 + VINT(J)=VINTSV(J) + 450 CONTINUE + VINT(141)=V141SV + VINT(142)=V142SV + + ENDIF + +C...Format statements for printout. + 5000 FORMAT(/1X,'****** PYMIGN: initialization of multiple inter', + &'actions for MSTP(82) =',I2,' ******') + 5100 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, + &D9.2,' mb: rejected') + 5200 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, + &D9.2,' mb: accepted') + + RETURN + END + +C********************************************************************* + +C...PYMIHK +C...Finds left-behind remnant flavour content and hooks up +C...the colour flow between the hard scattering and remnants + + SUBROUTINE PYMIHK + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...The event record + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) +C...Parameters + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) +C...The common block of dangling ends + COMMON/PYINTM/KFIVAL(2,3),NMI(2),IMI(2,800,2),NVC(2,-6:6), + & XASSOC(2,-6:6,240),XPSVC(-6:6,-1:240),PVCTOT(2,-1:1), + & XMI(2,240),PT2MI(240),IMISEP(0:240) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINTM/ +C...Local variables + PARAMETER (NERSIZ=4000) + COMMON /PYCBLS/MCO(NERSIZ,2),NCC,JCCO(NERSIZ,2),JCCN(NERSIZ,2) + & ,MACCPT + COMMON /PYCTAG/NCT,MCT(NERSIZ,2) + SAVE /PYCBLS/,/PYCTAG/ + DIMENSION JST(2,3),IV(2,3),IDQ(3),NVSUM(2),NBRTOT(2),NG(2) + & ,ITJUNC(2),MOUT(2),INSR(1000,3),ISTR(6),YMI(240) + DATA NERRPR/0/ + SAVE NERRPR + FOUR(I,J)=P(I,4)*P(J,4)-P(I,3)*P(J,3)-P(I,2)*P(J,2)-P(I,1)*P(J,1) + +C...Set up error checkers + IBOOST=0 + +C...Initialize colour arrays: MCO (Original) and MCT (New) + DO 110 I=MINT(84)+1,NERSIZ + DO 100 JC=1,2 + MCT(I,JC)=0 + MCO(I,JC)=0 + 100 CONTINUE +C...Also zero colour tracing information, if existed. + IF (I.LE.N) THEN + K(I,4)=MOD(K(I,4),MSTU(5)**2) + K(I,5)=MOD(K(I,5),MSTU(5)**2) + ENDIF + 110 CONTINUE + +C...Initialize colour tag collapse arrays: +C...JCCO (Original) and JCCN (New). + DO 130 MG=MINT(84)+1,NERSIZ + DO 120 JC=1,2 + JCCO(MG,JC)=0 + JCCN(MG,JC)=0 + 120 CONTINUE + 130 CONTINUE + +C...Zero gluon insertion array + DO 150 IM=1,1000 + DO 140 J=1,3 + INSR(IM,J)=0 + 140 CONTINUE + 150 CONTINUE + +C...Compute hard scattering system rapidities + IF (MSTP(89).EQ.1) THEN + DO 160 IM=1,240 + IF (IM.LE.MINT(31)) THEN + YMI(IM)=LOG(XMI(1,IM)/XMI(2,IM)) + ELSE +C...Set (unsigned) rapidity = 100 for beam remnant systems. + YMI(IM)=100D0 + ENDIF + 160 CONTINUE + ENDIF + +C...Treat each side separately + DO 290 JS=1,2 + +C...Initialize side. + NG(JS)=0 + JV=0 + KFS=ISIGN(1,MINT(10+JS)) + +C...Set valence content of pi0, gamma, K0S, K0L if not yet done. + IF(KFIVAL(JS,1).EQ.0) THEN + IF(MINT(10+JS).EQ.111) THEN + KFIVAL(JS,1)=INT(1.5D0+PYR(0)) + KFIVAL(JS,2)=-KFIVAL(JS,1) + ELSEIF(MINT(10+JS).EQ.22) THEN + PYRKF=PYR(0) + KFIVAL(JS,1)=1 + IF(PYRKF.GT.0.1D0) KFIVAL(JS,1)=2 + IF(PYRKF.GT.0.5D0) KFIVAL(JS,1)=3 + IF(PYRKF.GT.0.6D0) KFIVAL(JS,1)=4 + KFIVAL(JS,2)=-KFIVAL(JS,1) + ELSEIF(MINT(10+JS).EQ.130.OR.MINT(10+JS).EQ.310) THEN + IF(PYR(0).GT.0.5D0) THEN + KFIVAL(JS,1)=1 + KFIVAL(JS,2)=-3 + ELSE + KFIVAL(JS,1)=3 + KFIVAL(JS,2)=-1 + ENDIF + ENDIF + ENDIF + +C...Initialize beam remnant sea and valence content flavour by flavour. + NVSUM(JS)=0 + NBRTOT(JS)=0 + DO 210 JFA=1,6 +C...Count up original number of JFA valence quarks and antiquarks. + NVALQ=0 + NVALQB=0 + NSEA=0 + DO 170 J=1,3 + IF(KFIVAL(JS,J).EQ.JFA) NVALQ=NVALQ+1 + IF(KFIVAL(JS,J).EQ.-JFA) NVALQB=NVALQB+1 + 170 CONTINUE + NVSUM(JS)=NVSUM(JS)+NVALQ+NVALQB +C...Subtract kicked out valence and determine sea from flavour cons. + DO 180 IM=1,NMI(JS) + IFL = K(IMI(JS,IM,1),2) + IFA = IABS(IFL) + IFS = ISIGN(1,IFL) + IF (IFL.EQ.JFA.AND.IMI(JS,IM,2).EQ.0) THEN +C...Subtract K.O. valence quark from remainder. + NVALQ=NVALQ-1 + JV=NVSUM(JS)-NVALQ-NVALQB + IV(JS,JV)=IMI(JS,IM,1) + ELSEIF (IFL.EQ.-JFA.AND.IMI(JS,IM,2).EQ.0) THEN +C...Subtract K.O. valence antiquark from remainder. + NVALQB=NVALQB-1 + JV=NVSUM(JS)-NVALQ-NVALQB + IV(JS,JV)=IMI(JS,IM,1) + ELSEIF (IFA.EQ.JFA) THEN +C...Outside sea without companion: add opposite sea flavour inside. + IF (IMI(JS,IM,2).LT.0) NSEA=NSEA-IFS + ENDIF + 180 CONTINUE +C...Check if space left in PYJETS for additional BR flavours + NFLSUM=IABS(NSEA)+NVALQ+NVALQB + NBRTOT(JS)=NBRTOT(JS)+NFLSUM + IF (N+NFLSUM+1.GT.MSTU(4)) THEN + CALL PYERRM(11,'(PYMIHK:) no more memory left in PYJETS') + MINT(51)=1 + RETURN + ENDIF +C...Add required val+sea content to beam remnant. + IF (NFLSUM.GT.0) THEN + DO 200 IA=1,NFLSUM +C...Insert beam remnant quark as p.t. symbolic parton in ER. + N=N+1 + DO 190 IX=1,5 + K(N,IX)=0 + P(N,IX)=0D0 + V(N,IX)=0D0 + 190 CONTINUE + K(N,1)=3 + K(N,2)=ISIGN(JFA,NSEA) + IF (IA.LE.NVALQ) K(N,2)=JFA + IF (IA.GT.NVALQ.AND.IA.LE.NVALQ+NVALQB) K(N,2)=-JFA + K(N,3)=MINT(83)+JS +C...Also update NMI, IMI, and IV arrays. + NMI(JS)=NMI(JS)+1 + IMI(JS,NMI(JS),1)=N + IMI(JS,NMI(JS),2)=-1 + IF (IA.LE.NVALQ+NVALQB) THEN + IMI(JS,NMI(JS),2)=0 + JV=JV+1 + IV(JS,JV)=IMI(JS,NMI(JS),1) + ENDIF + 200 CONTINUE + ENDIF + 210 CONTINUE + + IM=0 + 220 IM=IM+1 + IF (IM.LE.NMI(JS)) THEN + IF (K(IMI(JS,IM,1),2).EQ.21) THEN + NG(JS)=NG(JS)+1 +C...Add fictitious parent gluons for companion pairs. + ELSEIF (IMI(JS,IM,2).NE.0.AND.K(IMI(JS,IM,1),2).GT.0) THEN +C...Randomly assign companions to sea quarks which have none. + IF (IMI(JS,IM,2).LT.0) THEN + IMC=PYR(0)*NMI(JS) + 230 IMC=MOD(IMC,NMI(JS))+1 + IF (K(IMI(JS,IMC,1),2).NE.-K(IMI(JS,IM,1),2)) GOTO 230 + IF (IMI(JS,IMC,2).GE.0) GOTO 230 + IMI(JS, IM,2) = IMI(JS,IMC,1) + IMI(JS,IMC,2) = IMI(JS, IM,1) + ENDIF +C...Add fictitious parent gluon + N=N+1 + DO 240 IX=1,5 + K(N,IX)=0 + P(N,IX)=0D0 + V(N,IX)=0D0 + 240 CONTINUE + K(N,1)=14 + K(N,2)=21 + K(N,3)=MINT(83)+JS +C...Set gluon (anti-)colour daughter pointers + K(N,4)=IMI(JS, IM,1) + K(N,5)=IMI(JS, IM,2) +C...Set quark (anti-)colour parent pointers + K(IMI(JS, IM,2),5)=K(IMI(JS, IM,2),5)+MSTU(5)*N + K(IMI(JS, IM,1),4)=K(IMI(JS, IM,1),4)+MSTU(5)*N +C...Add gluon to IMI + NMI(JS)=NMI(JS)+1 + IMI(JS,NMI(JS),1)=N + IMI(JS,NMI(JS),2)=0 + ENDIF + GOTO 220 + ENDIF + +C...If incoming (anti-)baryon, insert inside (anti-)junction. +C...Set up initial v-v-j-v configuration. Otherwise set up +C...mesonic v-vbar configuration + IF (IABS(MINT(10+JS)).GT.1000) THEN +C...Determine junction type (1: B=1 2: B=-1) + ITJUNC(JS) = (3-KFS)/2 +C...Insert junction. + N=N+1 + DO 250 IX=1,5 + K(N,IX)=0 + P(N,IX)=0D0 + V(N,IX)=0D0 + 250 CONTINUE +C...Set special junction codes: + K(N,1)=42 + K(N,2)=88 +C...Set parent to side. + K(N,3)=MINT(83)+JS + K(N,4)=ITJUNC(JS)*MSTU(5) + K(N,5)=0 +C...Connect valence quarks to junction. + MOUT(JS)=0 + MANTI=ITJUNC(JS)-1 +C...Set (anti)colour mother = junction. + DO 260 JV=1,3 + K(IV(JS,JV),4+MANTI)=MOD(K(IV(JS,JV),4+MANTI),MSTU(5)) + & +MSTU(5)*N +C...Keep track of partons adjacent to junction: + JST(JS,JV)=IV(JS,JV) + 260 CONTINUE + ELSE +C...Mesons: set up initial q-qbar topology + ITJUNC(JS)=0 + IF (K(IV(JS,1),2).GT.0) THEN + IQ=IV(JS,1) + IQBAR=IV(JS,2) + ELSE + IQ=IV(JS,2) + IQBAR=IV(JS,1) + ENDIF + IV(JS,3)=0 + JST(JS,1)=IQ + JST(JS,2)=IQBAR + JST(JS,3)=0 + K(IQ,4)=MOD(K(IQ,4),MSTU(5))+MSTU(5)*IQBAR + K(IQBAR,5)=MOD(K(IQBAR,5),MSTU(5))+MSTU(5)*IQ +C...Special for mesons. Insert gluon if BR empty. + IF (NBRTOT(JS).EQ.0) THEN + N=N+1 + DO 270 IX=1,5 + K(N,IX)=0 + P(N,IX)=0D0 + V(N,IX)=0D0 + 270 CONTINUE + K(N,1)=3 + K(N,2)=21 + K(N,3)=MINT(83)+JS + K(N,4)=0 + K(N,5)=0 + NBRTOT(JS)=1 + NG(JS)=NG(JS)+1 +C...Add gluon to IMI + NMI(JS)=NMI(JS)+1 + IMI(JS,NMI(JS),1)=N + IMI(JS,NMI(JS),2)=0 + ENDIF + MOUT(JS)=0 + ENDIF + +C...Count up number of valence quarks outside BR. + DO 280 JV=1,3 + IF (JST(JS,JV).LE.MINT(53).AND.JST(JS,JV).GT.0) + & MOUT(JS)=MOUT(JS)+1 + 280 CONTINUE + + 290 CONTINUE + +C...Now both sides have been prepared in an initial vvjv (baryonic) or +C...v(g)vbar (mesonic) configuration. + +C...Create colour line tags starting from initiators. + NCT=0 + DO 320 IM=1,MINT(31) +C...Consider each side in turn. + DO 310 JS=1,2 + I1=IMI(JS,IM,1) + I2=IMI(3-JS,IM,1) + DO 300 JCS=4,5 + IF (K(I1,2).NE.21.AND.(9-2*JCS).NE.ISIGN(1,K(I1,2))) + & GOTO 300 + IF (K(I1,JCS)/MSTU(5)**2.NE.0) GOTO 300 + + KCS=JCS + CALL PYCTTR(I1,KCS,I2) + IF(MINT(51).NE.0) RETURN + + 300 CONTINUE + 310 CONTINUE + 320 CONTINUE + + DO 340 JS=1,2 +C...Create colour tags for beam remnant partons. + DO 330 IM=MINT(31)+1,NMI(JS) + IP=IMI(JS,IM,1) + IF (K(IP,2).NE.21) THEN + JC=(3-ISIGN(1,K(IP,2)))/2 + IF (MCT(IP,JC).EQ.0) THEN + NCT=NCT+1 + MCT(IP,JC)=NCT + ENDIF + ELSE +C...Gluons + ICD=K(IP,4) + IAD=K(IP,5) + IF (ICD.NE.0) THEN +C...Fictituous gluons just inherit from their quark daughters. + ICC=MCT(ICD,1) + IAC=MCT(IAD,2) + ELSE +C...Real beam remnant gluons get their own colours + ICC=NCT+1 + IAC=NCT+2 + NCT=NCT+2 + ENDIF + MCT(IP,1)=ICC + MCT(IP,2)=IAC + ENDIF + 330 CONTINUE + 340 CONTINUE + +C...Create colour tags for colour lines which are detached from the +C...initial state. + + DO 360 MQGST=1,2 + DO 350 I=MINT(84)+1,N + +C...Look for coloured string endpoint, or (later) leftover gluon. + IF (K(I,1).NE.3) GOTO 350 + KC=PYCOMP(K(I,2)) + IF(KC.EQ.0) GOTO 350 + KQ=KCHG(KC,2) + IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 350 + +C...Pick up loose string end with no previous tag. + KCS=4 + IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5 + IF(MCT(I,KCS-3).NE.0) GOTO 350 + + CALL PYCTTR(I,KCS,I) + IF(MINT(51).NE.0) RETURN + + 350 CONTINUE + 360 CONTINUE + +C...Store original colour tags + DO 370 I=MINT(84)+1,N + MCO(I,1)=MCT(I,1) + MCO(I,2)=MCT(I,2) + 370 CONTINUE + +C...Iteratively add gluons to already existing string pieces, enforcing +C...various possible orderings, and rejecting insertions that would give +C...rise to singlet gluons. +C... normalization. + RM0=1.5D0 + MRETRY=0 + PARP80=PARP(80) + +C...Set up simplified kinematics. +C...Boost hard interaction systems. + IBOOST=IBOOST+1 + DO 380 IM=1,MINT(31) + BETA=(XMI(1,IM)-XMI(2,IM))/(XMI(1,IM)+XMI(2,IM)) + CALL PYROBO(IMISEP(IM-1)+1,IMISEP(IM),0D0,0D0,0D0,0D0,BETA) + 380 CONTINUE +C...Assign preliminary beam remnant momenta. + DO 390 I=MINT(53)+1,N + JS=K(I,3) + P(I,1)=0D0 + P(I,2)=0D0 + IF (K(I,2).NE.88) THEN + P(I,4)=0.5D0*VINT(142+JS)*VINT(1)/MAX(1,NMI(JS)-MINT(31)) + P(I,3)=P(I,4) + IF (JS.EQ.2) P(I,3)=-P(I,3) + ELSE +C...Junctions are wildcards for the present. + P(I,4)=0D0 + P(I,3)=0D0 + ENDIF + 390 CONTINUE + +C...Reset colour processing information. + 400 DO 410 I=MINT(84)+1,N + K(I,4)=MOD(K(I,4),MSTU(5)**2) + K(I,5)=MOD(K(I,5),MSTU(5)**2) + 410 CONTINUE + + NCC=0 + DO 430 JS=1,2 +C...If meson, without gluon in BR, collapse q-qbar colour tags: + IF (ITJUNC(JS).EQ.0) THEN + JC1=MCT(JST(JS,1),1) + JC2=MCT(JST(JS,2),2) + NCC=NCC+1 + JCCO(NCC,1)=MAX(JC1,JC2) + JCCO(NCC,2)=MIN(JC1,JC2) +C...Collapse colour tags in event record + DO 420 I=MINT(84)+1,N + IF (MCT(I,1).EQ.JCCO(NCC,1)) MCT(I,1)=JCCO(NCC,2) + IF (MCT(I,2).EQ.JCCO(NCC,1)) MCT(I,2)=JCCO(NCC,2) + 420 CONTINUE + ENDIF + 430 CONTINUE + + 440 JS=1 + IF (PYR(0).GT.0.5D0.OR.NG(1).EQ.0) JS=2 + IF (NG(JS).GT.0) THEN + NOPT=0 + RLOPT=1D9 +C...Start at random gluon (optimizes speed for random attachments) + NMGL=0 + IMGL=PYR(0)*NMI(JS)+1 + 450 IMGL=MOD(IMGL,NMI(JS))+1 + NMGL=NMGL+1 +C...Only loop through NMI once (with upper limit to save time) + IF (NMGL.LE.NMI(JS).AND.NOPT.LE.3) THEN + IGL = IMI(JS,IMGL,1) +C...If not gluon or if already connected, try next. + IF (K(IGL,2).NE.21.OR.K(IGL,4)/MSTU(5).NE.0 + & .OR.K(IGL,5)/MSTU(5).NE.0) GOTO 450 +C...Now loop through all possible insertions of this gluon. + NMP1=0 + IMP1=PYR(0)*NMI(JS)+1 + 460 IMP1=MOD(IMP1,NMI(JS))+1 + NMP1=NMP1+1 + IF (IMP1.EQ.IMGL) GOTO 460 +C...Only loop through NMI once (with upper limit to save time). + IF (NMP1.LE.NMI(JS).AND.NOPT.LE.3) THEN + IP1 = IMI(JS,IMP1,1) +C...Try both colour mother and colour anti-mother. +C...Randomly select which one to try first. + NANTI=0 + MANTI=PYR(0)*2 + 470 MANTI=MOD(MANTI+1,2) + NANTI=NANTI+1 + IF (NANTI.LE.2) THEN + IP2 =MOD(K(IP1,4+MANTI)/MSTU(5),MSTU(5)) +C...Reject if no appropriate mother (or if mother is fictitious +C...parent gluon.) + IF (IP2.LE.0) GOTO 470 + IF (K(IP2,2).EQ.21.AND.IP2.GT.MINT(53)) GOTO 470 +C...Also reject if this link has already been tried. + IF (K(IP1,4+MANTI)/MSTU(5)**2.EQ.2) GOTO 470 + IF (K(IP2,5-MANTI)/MSTU(5)**2.EQ.2) GOTO 470 +C...Set flag to indicate that this link has now been tried for this +C...gluon. IP2 may be junction, which has several mothers. + K(IP1,4+MANTI)=K(IP1,4+MANTI)+2*MSTU(5)**2 + IF (K(IP2,2).NE.88) THEN + K(IP2,5-MANTI)=K(IP2,5-MANTI)+2*MSTU(5)**2 + ENDIF + +C...JCG1: Original colour tag of gluon on IP1 side +C...JCG2: Original colour tag of gluon on IP2 side +C...JCP1: Original colour tag of IP1 on gluon side +C...JCP2: Original colour tag of IP2 on gluon side. + JCG1=MCO(IGL,2-MANTI) + JCG2=MCO(IGL,1+MANTI) + JCP1=MCO(IP1,1+MANTI) + JCP2=MCO(IP2,2-MANTI) + + CALL PYMIHG(JCP1,JCG1,JCP2,JCG2) +C...Reject gluon attachments that give rise to singlet gluons. + IF (MACCPT.EQ.0) GOTO 470 + +C...Update colours + JCG1=MCT(IGL,2-MANTI) + JCG2=MCT(IGL,1+MANTI) + JCP1=MCT(IP1,1+MANTI) + JCP2=MCT(IP2,2-MANTI) + +C...Select whether to accept this insertion + IF (MSTP(89).EQ.0) THEN +C...Random insertions: no measure. + RL=1D0 +C...For random ordering, we want to suppress beam remnant breakups +C...already at this point. + IF (IP1.GT.MINT(53).AND.IP2.GT.MINT(53) + & .AND.MOUT(JS).NE.0.AND.PYR(0).GT.PARP80) THEN + NMP1=0 + NMGL=0 + GOTO 470 + ENDIF + ELSEIF (MSTP(89).EQ.1) THEN +C...Rapidity ordering: +C...YGL = Rapidity of gluon. + YGL=YMI(IMGL) +C...If fictitious gluon + IF (YGL.EQ.100D0) THEN + YGL=(3-2*JS)*100D0 + IDA1=MOD(K(IGL,4),MSTU(5)) + IDA2=MOD(K(IGL,5),MSTU(5)) + DO 480 IMT=1,NMI(JS) +C...Select (arbitrarily) the most central daughter. + IF (IMI(JS,IMT,1).EQ.IDA1.OR.IMI(JS,IMT,1).EQ.IDA2) + & THEN + IF (ABS(YGL).GT.ABS(YMI(IMT))) YGL=YMI(IMT) + ENDIF + 480 CONTINUE + ENDIF +C...YP1 = Rapidity IP1 + YP1=YMI(IMP1) +C...If fictitious gluon + IF (YP1.EQ.100D0) THEN + YP1=(3-2*JS)*YP1 + IDA1=MOD(K(IP1,4),MSTU(5)) + IDA2=MOD(K(IP1,5),MSTU(5)) + DO 490 IMT=1,NMI(JS) +C...Select (arbitrarily) the most central daughter. + IF (IMI(JS,IMT,1).EQ.IDA1.OR.IMI(JS,IMT,1).EQ.IDA2) + & THEN + IF (ABS(YP1).GT.ABS(YMI(IMT))) YP1=YMI(IMT) + ENDIF + 490 CONTINUE + ENDIF +C...YP2 = Rapidity of mother system + IF (K(IP2,2).NE.88) THEN + DO 500 IMT=1,NMI(JS) + IF (IMI(JS,IMT,1).EQ.IP2) YP2=YMI(IMT) + 500 CONTINUE +C...If fictitious gluon + IF (YP2.EQ.100D0) THEN + YP2=(3-2*JS)*YP2 + IDA1=MOD(K(IP2,4),MSTU(5)) + IDA2=MOD(K(IP2,5),MSTU(5)) + DO 510 IMT=1,NMI(JS) +C...Select (arbitrarily) the most central daughter. + IF (IMI(JS,IMT,1).EQ.IDA1.OR.IMI(JS,IMT,1).EQ.IDA2 + & ) THEN + IF (ABS(YP2).GT.ABS(YMI(IMT))) YP2=YMI(IMT) + ENDIF + 510 CONTINUE + ENDIF +C...Assign (arbitrarily) 100D0 to junction also + ELSE + YP2=(3-2*JS)*100D0 + ENDIF + RL=ABS(YGL-YP1)+ABS(YGL-YP2) + ELSEIF (MSTP(89).EQ.2) THEN +C...Lambda ordering: +C...Compute lambda measure for this insertion. + RL=1D0 + DO 520 IST=1,6 + ISTR(IST)=0 + 520 CONTINUE +C...If IP2 is junction, not caught below. + IF (JCP2.EQ.0) THEN + ITJU=MOD(K(IP2,4)/MSTU(5),MSTU(5)) +C...Anti-junction is colour endpoint et vv., always on JCG2. + ISTR(5-ITJU)=IP2 + ENDIF + DO 530 I=MINT(84)+1,N + IF (K(I,1).LT.10) THEN +C...The new string pieces + IF (MCT(I,1).EQ.JCG1) ISTR(1)=I + IF (MCT(I,2).EQ.JCG1) ISTR(2)=I + IF (MCT(I,1).EQ.JCG2) ISTR(3)=I + IF (MCT(I,2).EQ.JCG2) ISTR(4)=I + ENDIF + 530 CONTINUE +C...Also identify junctions as string endpoints. + DO 540 I=MINT(84)+1,N + ICMO=MOD(K(I,4)/MSTU(5),MSTU(5)) + IAMO=MOD(K(I,5)/MSTU(5),MSTU(5)) +C...Find partons adjacent to junctions. + IF (ICMO.GT.0.AND.ICMO.LE.N) THEN + IF (K(ICMO,1).EQ.42.AND.MCT(I,1).EQ.JCG1.AND.ISTR(2) + & .EQ.0) ISTR(2) = ICMO + IF (K(ICMO,1).EQ.42.AND.MCT(I,1).EQ.JCG2.AND.ISTR(4) + & .EQ.0) ISTR(4) = ICMO + ENDIF + IF (IAMO.GT.0.AND.IAMO.LE.N) THEN + IF (K(IAMO,1).EQ.42.AND.MCT(I,2).EQ.JCG1.AND.ISTR(1) + & .EQ.0) ISTR(1) = IAMO + IF (K(IAMO,1).EQ.42.AND.MCT(I,2).EQ.JCG2.AND.ISTR(3) + & .EQ.0) ISTR(3) = IAMO + ENDIF + 540 CONTINUE +C...The old string piece + ISTR(5)=ISTR(1+2*MANTI) + ISTR(6)=ISTR(4-2*MANTI) + IF (ISTR(1).EQ.0.OR.ISTR(2).EQ.0.OR.ISTR(3).EQ.0.OR. + & ISTR(4).EQ.0.OR.ISTR(5).EQ.0.OR.ISTR(6).EQ.0) THEN +C...If one or more of the colour tags for this connection is/are still +C...dangling, skip this attempt for the time being. + RL=1D6 + ELSE + RL=MAX(1D0,FOUR(ISTR(1),ISTR(2)))*MAX(1D0,FOUR(ISTR(3) + & ,ISTR(4)))/MAX(1D0,FOUR(ISTR(5),ISTR(6))) + RL=LOG(RL) + ENDIF + ENDIF +C...Allow some breadth to speed things up. + IF (ABS(1D0-RL/RLOPT).LT.0.05D0) THEN + NOPT=NOPT+1 + ELSEIF (RL.GT.RLOPT) THEN + GOTO 470 + ELSE + NOPT=1 + RLOPT=RL + ENDIF +C...INSR(NOPT,1)=Gluon colour mother +C...INSR(NOPT,2)=Gluon +C...INSR(NOPT,3)=Gluon anticolour mother + IF (NOPT.GT.1000) GOTO 470 + INSR(NOPT,1+2*MANTI)=IP2 + INSR(NOPT,2)=IGL + INSR(NOPT,3-2*MANTI)=IP1 + IF (MSTP(89).GT.0.OR.NOPT.EQ.0) GOTO 470 + ENDIF + IF (MSTP(89).GT.0.OR.NOPT.EQ.0) GOTO 460 + ENDIF +C...Reset link test information. + DO 550 I=MINT(84)+1,N + K(I,4)=MOD(K(I,4),MSTU(5)**2) + K(I,5)=MOD(K(I,5),MSTU(5)**2) + 550 CONTINUE + IF (MSTP(89).GT.0.OR.NOPT.EQ.0) GOTO 450 + ENDIF +C...Now we have a list of best gluon insertions, none of which cause +C...singlets to arise. If list is empty, try again a few times. Note: +C...this should never happen if we have a meson with a gluon inserted +C...in the beam remnant, since that breaks up the colour line. + IF (NOPT.EQ.0) THEN +C...Abandon BR-g-BR suppression for retries. This is not serious, it +C...just means we happened to start with trying a bad sequence. + PARP80=1D0 + IF (MRETRY.LE.10.AND.(ITJUNC(1).NE.0.OR.JST(1,3).EQ.0).AND + & .(ITJUNC(2).NE.0.OR.JST(2,3).EQ.0)) THEN + MRETRY=MRETRY+1 + DO 590 JS=1,2 + IF (ITJUNC(JS).NE.0) THEN + JST(JS,1)=IV(JS,1) + JST(JS,2)=IV(JS,2) + JST(JS,3)=IV(JS,3) +C...Reset valence quark parent pointers + DO 560 I=MINT(53)+1,N + IF (K(I,2).EQ.88.AND.K(I,3).EQ.JS) IJU=I + 560 CONTINUE + MANTI=ITJUNC(JS)-1 +C...Set (anti)colour mother = junction. + DO 570 JV=1,3 + K(IV(JS,JV),4+MANTI)=MOD(K(IV(JS,JV),4+MANTI),MSTU(5)) + & +MSTU(5)*IJU + 570 CONTINUE + ELSE +C...Same for mesons. JST unchanged, so needn't be restored. + IQ=JST(JS,1) + IQBAR=JST(JS,2) + K(IQ,4)=MOD(K(IQ,4),MSTU(5))+MSTU(5)*IQBAR + K(IQBAR,5)=MOD(K(IQBAR,5),MSTU(5))+MSTU(5)*IQ + ENDIF +C...Also reset gluon parent pointers. + NG(JS)=0 + DO 580 IM=1,NMI(JS) + I=IMI(JS,IM,1) + IF (K(I,2).EQ.21) THEN + K(I,4)=MOD(K(I,4),MSTU(5)) + K(I,5)=MOD(K(I,5),MSTU(5)) + NG(JS)=NG(JS)+1 + ENDIF + 580 CONTINUE + 590 CONTINUE +C...Reset colour tags + DO 600 I=MINT(84)+1,N + MCT(I,1)=MCO(I,1) + MCT(I,2)=MCO(I,2) + 600 CONTINUE + GOTO 400 + ELSE + IF(NERRPR.LT.5) THEN + NERRPR=NERRPR+1 + CALL PYLIST(4) + CALL PYERRM(19,'(PYMIHK:) No physical colour flow found!') + WRITE(MSTU(11),*) 'NG:', NG,' MOUT:', MOUT(JS) + ENDIF +C...Kill event and start another. + MINT(51)=1 + RETURN + ENDIF + ELSE +C...Select between insertions, suppressing insertions wholly in the BR. + IIN=PYR(0)*NOPT+1 + 610 IIN=MOD(IIN,NOPT)+1 + IF (INSR(IIN,1).GT.MINT(53).AND.INSR(IIN,3).GT.MINT(53) + & .AND.MOUT(JS).NE.0.AND.PYR(0).GT.PARP80) GOTO 610 + ENDIF + +C...Now we know which gluon to insert where. Colour tags in JCCO and +C...colour connection information should be updated, NG(JS) should be +C...counted down, and a new loop performed if there are still gluons +C...left on any side. + ICM=INSR(IIN,1) + IACM=INSR(IIN,3) + IGL=INSR(IIN,2) +C...JCG : Original gluon colour tag +C...JCAG: Original gluon anticolour tag. +C...JCM : Original anticolour tag of gluon colour mother +C...JACM: Original colour tag of gluon anticolour mother + JCG=MCO(IGL,1) + JCM=MCO(ICM,2) + JACG=MCO(IGL,2) + JACM=MCO(IACM,1) + + CALL PYMIHG(JACM,JACG,JCM,JCG) + IF (MACCPT.EQ.0) THEN + IF(NERRPR.LT.5) THEN + NERRPR=NERRPR+1 + CALL PYLIST(4) + CALL PYERRM(11,'(PYMIHK:) Unphysical colour flow!') + WRITE(MSTU(11),*) 'attaching', IGL,' between', ICM, IACM + ENDIF +C...Kill event and start another. + MINT(51)=1 + RETURN + ELSE +C...If everything went fine, store new JCCN in JCCO. + NCC=NCC+1 + DO 620 ICC=1,NCC + JCCO(ICC,1)=JCCN(ICC,1) + JCCO(ICC,2)=JCCN(ICC,2) + 620 CONTINUE + ENDIF + +C...One gluon attached is counted as equivalent to one end outside. + MOUT(JS)=1 +C...Set IGL colour mother = ICM. + K(IGL,4)=MOD(K(IGL,4),MSTU(5))+MSTU(5)*ICM +C...Set ICM anticolour mother = IGL colour. + IF (K(ICM,2).NE.88) THEN + K(ICM,5)=MOD(K(ICM,5),MSTU(5))+MSTU(5)*IGL + ELSE +C...If ICM is junction, just update JST array for now. + DO 630 MSJ=1,3 + IF (JST(JS,MSJ).EQ.IACM) JST(JS,MSJ)=IGL + 630 CONTINUE + ENDIF +C...Set IGL anticolour mother = IACM. + K(IGL,5)=MOD(K(IGL,5),MSTU(5))+MSTU(5)*IACM +C...Set IACM anticolour mother = IGL anticolour. + IF (K(IACM,2).NE.88) THEN + K(IACM,4)=MOD(K(IACM,4),MSTU(5))+MSTU(5)*IGL + ELSE +C...If IACM is junction, just update JST array for now. + DO 640 MSJ=1,3 + IF (JST(JS,MSJ).EQ.ICM) JST(JS,MSJ)=IGL + 640 CONTINUE + ENDIF +C...Count down # unconnected gluons. + NG(JS)=NG(JS)-1 + ENDIF + IF (NG(1).GT.0.OR.NG(2).GT.0) GOTO 440 + + DO 840 JS=1,2 +C...Collapse fictitious gluons. + DO 670 IGL=MINT(53)+1,N + IF (K(IGL,2).EQ.21.AND.K(IGL,3).EQ.MINT(83)+JS.AND. + & K(IGL,1).EQ.14) THEN + ICM=K(IGL,4)/MSTU(5) + IAM=K(IGL,5)/MSTU(5) + ICD=MOD(K(IGL,4),MSTU(5)) + IAD=MOD(K(IGL,5),MSTU(5)) +C...Set gluon daughters pointing to gluon mothers + K(IAD,5)=MOD(K(IAD,5),MSTU(5))+MSTU(5)*IAM + K(ICD,4)=MOD(K(ICD,4),MSTU(5))+MSTU(5)*ICM +C...Set gluon mothers pointing to gluon daughters. + IF (K(ICM,2).NE.88) THEN + K(ICM,5)=MOD(K(ICM,5),MSTU(5))+MSTU(5)*ICD + ELSE +C...Special case: mother=junction. Just update JST array for now. + DO 650 MSJ=1,3 + IF (JST(JS,MSJ).EQ.IGL) JST(JS,MSJ)=ICD + 650 CONTINUE + ENDIF + IF (K(IAM,2).NE.88) THEN + K(IAM,4)=MOD(K(IAM,4),MSTU(5))+MSTU(5)*IAD + ELSE + DO 660 MSJ=1,3 + IF (JST(JS,MSJ).EQ.IGL) JST(JS,MSJ)=IAD + 660 CONTINUE + ENDIF + ENDIF + 670 CONTINUE + +C...Erase collapsed gluons from NMI and IMI (but keep them in ER) + IM=NMI(JS)+1 + 680 IM=IM-1 + IF (IM.GT.MINT(31).AND.K(IMI(JS,IM,1),2).NE.21) GOTO 680 + IF (IM.GT.MINT(31)) THEN + NMI(JS)=NMI(JS)-1 + DO 690 IMR=IM,NMI(JS) + IMI(JS,IMR,1)=IMI(JS,IMR+1,1) + IMI(JS,IMR,2)=IMI(JS,IMR+1,2) + 690 CONTINUE + GOTO 680 + ENDIF + +C...Finally, connect junction. + IF (ITJUNC(JS).NE.0) THEN + DO 700 I=MINT(53)+1,N + IF (K(I,2).EQ.88.AND.K(I,3).EQ.MINT(83)+JS) IJU=I + 700 CONTINUE +C...NBRJQ counts # of jq, NBRVQ # of jv, inside BR. + NBRJQ =0 + NBRVQ =0 + DO 720 MSJ=1,3 + IDQ(MSJ)=0 +C...Find jq with no glue inbetween inside beam remnant. + IF (JST(JS,MSJ).GT.MINT(53).AND.IABS(K(JST(JS,MSJ),2)).LE.5) + & THEN + NBRJQ=NBRJQ+1 +C...Set IDQ = -I if q non-valence and = +I if q valence. + IDQ(NBRJQ)=-JST(JS,MSJ) + DO 710 JV=1,3 + IF (IV(JS,JV).EQ.JST(JS,MSJ)) THEN + IDQ(NBRJQ)=JST(JS,MSJ) + NBRVQ=NBRVQ+1 + ENDIF + 710 CONTINUE + ENDIF + I12=MOD(MSJ+1,2) + I45=5 + IF (MSJ.EQ.3) I45=4 + K(IJU,I45)=K(IJU,I45)+(MSTU(5)**I12)*JST(JS,MSJ) + 720 CONTINUE + +C...Check if diquark can be formed. + IF ((MSTP(88).GE.0.AND.NBRVQ.GE.2).OR.(NBRJQ.GE.2.AND.MSTP(88) + & .GE.1)) THEN +C...If there is less than 2 valence quarks connected to junction +C...and MSTP(88)>1, use random non-valence quarks to fill up. + IF (NBRVQ.LE.1) THEN + NDIQ=NBRVQ + 730 JFLIP=NBRJQ*PYR(0)+1 + IF (IDQ(JFLIP).LT.0) THEN + IDQ(JFLIP)=-IDQ(JFLIP) + NDIQ=NDIQ+1 + ENDIF + IF (NDIQ.LE.1) GOTO 730 + ENDIF +C...Place selected quarks first in IDQ, ordered in flavour. + DO 740 JDQ=1,3 + IF (IDQ(JDQ).LE.0) THEN + ITEMP1 = IDQ(JDQ) + IDQ(JDQ)= IDQ(3) + IDQ(3) = -ITEMP1 + IF (IABS(K(IDQ(1),2)).LT.IABS(K(IDQ(2),2))) THEN + ITEMP1 = IDQ(1) + IDQ(1) = IDQ(2) + IDQ(2) = ITEMP1 + ENDIF + ENDIF + 740 CONTINUE +C...Choose diquark spin. + IF (NBRVQ.EQ.2) THEN +C...If the selected quarks are both valence, we may use SU(6) rules +C...to figure out which spin the diquark has, by a subdivision of the +C...original beam hadron into the selected diquark system plus a kicked +C...out quark, IKO. + JKO=6 + DO 760 JDQ=1,2 + DO 750 JV=1,3 + IF (IDQ(JDQ).EQ.IV(JS,JV)) JKO=JKO-JV + 750 CONTINUE + 760 CONTINUE + IKO=IV(JS,JKO) + CALL PYSPLI(MINT(10+JS),K(IKO,2),KFDUM,KFDQ) + ELSE +C...If one or more of the selected quarks are not valence, we cannot use +C...SU(6) subdivisions of the original beam hadron. Instead, with the +C...flavours of the diquark already selected, we assume for now +C...50:50 spin-1:spin-0 (where spin-0 possible). + KFDQ=1000*K(IDQ(1),2)+100*K(IDQ(2),2) + IS=3 + IF (K(IDQ(1),2).NE.K(IDQ(2),2).AND. + & (1D0+3D0*PARJ(4))*PYR(0).LT.1D0) IS=1 + KFDQ=KFDQ+ISIGN(IS,KFDQ) + ENDIF + +C...Collapse diquark-j-quark system to baryon, if allowed and possible. +C...Note: third quark can per definition not also be valence, +C...therefore we can only do this if we are allowed to use sea quarks. + 770 IF (IDQ(3).NE.0.AND.MSTP(88).GE.2) THEN + NTRY=0 + 780 NTRY=NTRY+1 + CALL PYKFDI(KFDQ,K(IABS(IDQ(3)),2),KFDUM,KFBAR) + IF (KFBAR.EQ.0.AND.NTRY.LE.100) THEN + GOTO 780 + ELSEIF(NTRY.GT.100) THEN +C...If no baryon can be found, give up and form diquark. + IDQ(3)=0 + GOTO 770 + ELSE +C...Replace junction by baryon. + K(IJU,1)=1 + K(IJU,2)=KFBAR + K(IJU,3)=MINT(83)+JS + K(IJU,4)=0 + K(IJU,5)=0 + P(IJU,5)=PYMASS(KFBAR) + DO 790 MSJ=1,3 +C...Prepare removal of participating quarks from ER. + K(JST(JS,MSJ),1)=-1 + 790 CONTINUE + ENDIF + ELSE +C...If collapse to baryon not possible or not allowed, replace junction +C...by diquark. This way, collapsed gluons that were pointing at the +C...junction will now point (correctly) at diquark. + MANTI=ITJUNC(JS)-1 + K(IJU,1)=3 + K(IJU,2)=KFDQ + K(IJU,3)=MINT(83)+JS + K(IJU,4)=0 + K(IJU,5)=0 + DO 800 MSJ=1,3 + IP=JST(JS,MSJ) + IF (IP.NE.IDQ(1).AND.IP.NE.IDQ(2)) THEN + K(IJU,4+MANTI)=0 + K(IJU,5-MANTI)=IP*MSTU(5) + K(IP,4+MANTI)=MOD(K(IP,4+MANTI),MSTU(5))+ + & MSTU(5)*IJU + MCT(IJU,2-MANTI)=MCT(IP,1+MANTI) + ELSE +C...Prepare removal of participating quarks from ER. + K(IP,1)=-1 + ENDIF + 800 CONTINUE + ENDIF + +C...Update so ER pointers to collapsed quarks +C...now go to collapsed object. + DO 820 I=MINT(84)+1,N + IF ((K(I,3).EQ.MINT(83)+JS.OR.K(I,3).EQ.MINT(83)+2+JS).AND + & .K(I,1).GT.0) THEN + DO 810 ISID=4,5 + IMO=K(I,ISID)/MSTU(5) + IDA=MOD(K(I,ISID),MSTU(5)) + IF (IMO.GT.0) THEN + IF (K(IMO,1).EQ.-1) IMO=IJU + ENDIF + IF (IDA.GT.0) THEN + IF (K(IDA,1).EQ.-1) IDA=IJU + ENDIF + K(I,ISID)=IDA+MSTU(5)*IMO + 810 CONTINUE + ENDIF + 820 CONTINUE + ENDIF + ENDIF + +C...Finally, if beam remnant is empty, insert a gluon in beam remnant. +C...(this only happens for baryons, where we want to force the gluon +C...to sit next to the junction. Mesons handled above.) + IF (NBRTOT(JS).EQ.0) THEN + N=N+1 + DO 830 IX=1,5 + K(N,IX)=0 + P(N,IX)=0D0 + V(N,IX)=0D0 + 830 CONTINUE + IGL=N + K(IGL,1)=3 + K(IGL,2)=21 + K(IGL,3)=MINT(83)+JS + IF (ITJUNC(JS).NE.0) THEN +C...Incoming baryons. Pick random leg in JST (NVSUM = 3 for baryons) + JLEG=PYR(0)*NVSUM(JS)+1 + I1=JST(JS,JLEG) + JST(JS,JLEG)=IGL + JCT=MCT(I1,ITJUNC(JS)) + MCT(IGL,3-ITJUNC(JS))=JCT + NCT=NCT+1 + MCT(IGL,ITJUNC(JS))=NCT + MANTI=ITJUNC(JS)-1 + ELSE +C...Meson. Should not happen. + CALL PYERRM(19,'(PYMIHK:) Empty meson beam remnant') + IF(NERRPR.LT.5) THEN + WRITE(MSTU(11),*) 'This should not have been possible!' + CALL PYLIST(4) + NERRPR=NERRPR+1 + ENDIF + MINT(51)=1 + RETURN + ENDIF + I2=MOD(K(I1,4+MANTI)/MSTU(5),MSTU(5)) + K(I1,4+MANTI)=MOD(K(I1,4+MANTI),MSTU(5))+MSTU(5)*IGL + K(IGL,5-MANTI)=MOD(K(IGL,5-MANTI),MSTU(5))+MSTU(5)*I1 + K(IGL,4+MANTI)=MOD(K(IGL,4+MANTI),MSTU(5))+MSTU(5)*I2 + IF (K(I2,2).NE.88) THEN + K(I2,5-MANTI)=MOD(K(I2,5-MANTI),MSTU(5))+MSTU(5)*IGL + ELSE + IF (MOD(K(I2,4),MSTU(5)).EQ.I1) THEN + K(I2,4)=(K(I2,4)/MSTU(5))*MSTU(5)+IGL + ELSEIF(MOD(K(I2,5)/MSTU(5),MSTU(5)).EQ.I1) THEN + K(I2,5)=MOD(K(I2,5),MSTU(5))+MSTU(5)*IGL + ELSE + K(I2,5)=(K(I2,5)/MSTU(5))*MSTU(5)+IGL + ENDIF + ENDIF + ENDIF + 840 CONTINUE + +C...Remove collapsed quarks and junctions from ER and update IMI. + CALL PYEDIT(11) + +C...Also update beam remnant part of IMI. + NMI(1)=MINT(31) + NMI(2)=MINT(31) + DO 850 I=MINT(53)+1,N + IF (K(I,1).LE.0) GOTO 850 +C...Restore BR quark/diquark/baryon pointers in IMI. + IF ((K(I,2).NE.21.OR.K(I,1).NE.14).AND.K(I,2).NE.88) THEN + JS=K(I,3)-MINT(83) + NMI(JS)=NMI(JS)+1 + IMI(JS,NMI(JS),1)=I + IMI(JS,NMI(JS),2)=0 + ENDIF + 850 CONTINUE + +C...Restore companion information from collapsed gluons. + DO 870 I=MINT(53)+1,N + IF (K(I,2).EQ.21.AND.K(I,1).EQ.14) THEN + JS=K(I,3)-MINT(83) + JCD=MOD(K(I,4),MSTU(5)) + JAD=MOD(K(I,5),MSTU(5)) + DO 860 IM=1,NMI(JS) + IF (IMI(JS,IM,1).EQ.JCD) IMC=IM + IF (IMI(JS,IM,1).EQ.JAD) IMA=IM + 860 CONTINUE + IMI(JS,IMC,2)=IMI(JS,IMA,1) + IMI(JS,IMA,2)=IMI(JS,IMC,1) + ENDIF + 870 CONTINUE + +C...Renumber colour lines (since some have disappeared) + JCT=0 + JCD=0 + 880 JCT=JCT+1 + MFOUND=0 + I=MINT(84) + 890 I=I+1 + IF (I.EQ.N+1) THEN + IF (MFOUND.EQ.0) JCD=JCD+1 + ELSEIF (MCT(I,1).EQ.JCT.AND.K(I,1).GE.1) THEN + MCT(I,1)=JCT-JCD + MFOUND=1 + ELSEIF (MCT(I,2).EQ.JCT.AND.K(I,1).GE.1) THEN + MCT(I,2)=JCT-JCD + MFOUND=1 + ENDIF + IF (I.LE.N) GOTO 890 + IF (JCT.LT.NCT) GOTO 880 + NCT=JCT-JCD + +C...Reset hard interaction subsystems to their CM frames. + IF (IBOOST.EQ.1) THEN + DO 900 IM=1,MINT(31) + BETA=-(XMI(1,IM)-XMI(2,IM))/(XMI(1,IM)+XMI(2,IM)) + CALL PYROBO(IMISEP(IM-1)+1,IMISEP(IM),0D0,0D0,0D0,0D0,BETA) + 900 CONTINUE +C...Zero beam remnant longitudinal momenta and energies + DO 910 I=MINT(53)+1,N + P(I,3)=0D0 + P(I,4)=0D0 + 910 CONTINUE + ELSE + CALL PYERRM(9 + & ,'(PYMIHK:) Inconsistent kinematics. Too many boosts.') +C...Kill event and start another. + MINT(51)=1 + RETURN + ENDIF + + 9999 RETURN + END +C********************************************************************* + +C...PYCTTR +C...Adapted from PYPREP. +C...Assigns LHA1 colour tags to coloured partons based on +C...K(I,4) and K(I,5) colour connection record. +C...KCS negative signifies that a previous tracing should be continued. +C...(in case the tag to be continued is empty, the routine exits) +C...Starts at I and ends at I or IEND. +C...Special considerations for systems with junctions. +C...Special: if IEND=-1, means trace this parton to its color partner, +C... then exit. If no partner found, exit with 0. + + SUBROUTINE PYCTTR(I,KCS,IEND) +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYINT1/MINT(400),VINT(400) +C...The common block of colour tags. + COMMON/PYCTAG/NCT,MCT(4000,2) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYINT1/,/PYCTAG/ + DATA NERRPR/0/ + SAVE NERRPR + +C...Skip if parton not existing or does not have KCS + IF (K(I,1).LE.0) GOTO 120 + KC=PYCOMP(K(I,2)) + IF (KC.EQ.0) GOTO 120 + KQ=KCHG(KC,2) + IF (KQ.EQ.0) GOTO 120 + IF (IABS(KQ).EQ.1.AND.KQ*(9-2*ABS(KCS)).NE.ISIGN(1,K(I,2))) + & GOTO 120 + + IF (KCS.GT.0) THEN + NCT=NCT+1 +C...Set colour tag of first parton. + MCT(I,KCS-3)=NCT + NCS=NCT + ELSE + KCS=-KCS + NCS=MCT(I,KCS-3) + IF (NCS.EQ.0) GOTO 120 + ENDIF + + IA=I + NSTP=0 + 100 NSTP=NSTP+1 + IF(NSTP.GT.4*N) THEN + CALL PYERRM(14,'(PYCTTR:) caught in infinite loop') + GOTO 120 + ENDIF + +C...Finished if reached final-state triplet. + IF(K(IA,1).EQ.3) THEN + IF(NSTP.GE.2.AND.KCHG(PYCOMP(K(IA,2)),2).NE.2) GOTO 120 + ENDIF + +C...Also finished if reached junction. + IF(K(IA,1).EQ.42) THEN + GOTO 120 + ENDIF + +C...GOTO next parton in colour space. + 110 IB=IA +C...If IB's KCS daughter not traced and exists, goto KCS daughter. + IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5)) + & .NE.0) THEN + IA=MOD(K(IB,KCS),MSTU(5)) + K(IB,KCS)=K(IB,KCS)+MSTU(5)**2 + MREV=0 + ELSE +C...If KCS mother traced or KCS mother nonexistent, switch colour. + IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5), + & MSTU(5)).EQ.0) THEN + KCS=9-KCS + NCT=NCT+1 + NCS=NCT +C...Assign new colour tag on other side of old parton. + MCT(IB,KCS-3)=NCT + ENDIF +C...Goto (new) KCS mother, set mother traced tag + IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5)) + K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2 + MREV=1 + ENDIF + IF(IA.LE.0.OR.IA.GT.N) THEN + IF (IEND.EQ.-1) THEN + IEND=0 + GOTO 120 + ENDIF + CALL PYERRM(12,'(PYCTTR:) colour tag tracing failed') + IF(NERRPR.LT.5) THEN + write(*,*) 'began at ',I + write(*,*) 'ended going from', IB, ' to', IA, ' KCS=',KCS, + & ' NCS=',NCS,' MREV=',MREV + CALL PYLIST(4) + NERRPR=NERRPR+1 + ENDIF + MINT(51)=1 + RETURN + ENDIF + IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5), + & MSTU(5)).EQ.IB) THEN + IF(MREV.EQ.1) KCS=9-KCS + IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS +C...Set KSC mother traced tag for IA + K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2 + ELSE + IF(MREV.EQ.0) KCS=9-KCS + IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS +C...Set KCS daughter traced tag for IA + K(IA,KCS)=K(IA,KCS)+MSTU(5)**2 + ENDIF +C...Assign new colour tag + MCT(IA,KCS-3)=NCS +C...Finish if IEND=-1 and found final-state color partner + IF (IEND.EQ.-1.AND.K(IA,1).LT.10) THEN + IEND=IA + GOTO 120 + ENDIF + IF (IA.NE.I.AND.IA.NE.IEND) GOTO 100 + + 120 RETURN + END + +********************************************************************* + +C...PYMIHG +C...Collapse JCP1 and connecting tags to JCG1. +C...Collapse JCP2 and connecting tags to JCG2. + + SUBROUTINE PYMIHG(JCP1,JCG1,JCP2,JCG2) +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...The event record + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) +C...Parameters + COMMON/PYINT1/MINT(400),VINT(400) + SAVE /PYJETS/,/PYINT1/ +C...Local variables + COMMON /PYCBLS/MCO(4000,2),NCC,JCCO(4000,2),JCCN(4000,2),MACCPT + COMMON /PYCTAG/NCT,MCT(4000,2) + SAVE /PYCBLS/,/PYCTAG/ + +C...Break up JCP1<->JCP2 tag and create JCP1<->JCG1 and JCP2<->JCG2 tags +C...in temporary tag collapse array JCCN. Only break up one connection. + MACCPT=1 + MCLPS=0 + DO 100 ICC=1,NCC + JCCN(ICC,1)=JCCO(ICC,1) + JCCN(ICC,2)=JCCO(ICC,2) +C...If there was a mother, it was previously connected to JCP1. +C...Should be changed to JCP2. + IF (MCLPS.EQ.0) THEN + IF (JCCN(ICC,1).EQ.MAX(JCP1,JCP2).AND.JCCN(ICC,2).EQ.MIN(JCP1 + & ,JCP2)) THEN + JCCN(ICC,1)=MAX(JCG2,JCP2) + JCCN(ICC,2)=MIN(JCG2,JCP2) + MCLPS=1 + ENDIF + ENDIF + 100 CONTINUE +C...Also collapse colours on JCP1 side of JCG1 + IF (JCP1.NE.0) THEN + JCCN(NCC+1,1)=MAX(JCP1,JCG1) + JCCN(NCC+1,2)=MIN(JCP1,JCG1) + ELSE + JCCN(NCC+1,1)=MAX(JCP2,JCG2) + JCCN(NCC+1,2)=MIN(JCP2,JCG2) + ENDIF + +C...Initialize event record colour tag array MCT array to MCO. + DO 110 I=MINT(84)+1,N + MCT(I,1)=MCO(I,1) + MCT(I,2)=MCO(I,2) + 110 CONTINUE + +C...Collapse tags: +C...IS = 1 : All tags connecting to JCG1 on JCG1 side -> JCG1 +C...IS = 2 : All tags connecting to JCG2 on JCG2 side -> JCG2 +C...IS = 3 : All tags connecting to JCG1 on JCP1 side -> JCG1 +C...IS = 4 : All tags connecting to JCG2 on JCP2 side -> JCG2 + DO 160 IS=1,4 +C...Skip if junction. + IF ((IS.EQ.4.AND.JCP2.EQ.0).OR.(IS.EQ.3).AND.JCP1.EQ.0) GOTO 160 +C...Define starting point in tag space. +C...JCA = previous tag +C...JCO = present tag +C...JCN = new tag + IF (MOD(IS,2).EQ.1) THEN + JCO=JCP1 + JCN=JCG1 + JCALL=JCG1 + ELSEIF (MOD(IS,2).EQ.0) THEN + JCO=JCP2 + JCN=JCG2 + JCALL=JCG2 + ENDIF + ITRACE=0 + 120 ITRACE=ITRACE+1 + IF (ITRACE.GT.1000) THEN +C...NB: Proper error message should be defined here. + CALL PYERRM(14 + & ,'(PYMIHG:) Inf loop when collapsing colours.') + MINT(57)=MINT(57)+1 + MINT(51)=1 + RETURN + ENDIF +C...Collapse all JCN tags to JCALL + DO 130 I=MINT(84)+1,N + IF (MCO(I,1).EQ.JCN) MCT(I,1)=JCALL + IF (MCO(I,2).EQ.JCN) MCT(I,2)=JCALL + 130 CONTINUE +C...IS = 1,2: first step forward. IS = 3,4: first step backward. + IF (IS.GT.2.AND.(JCN.EQ.JCALL)) THEN + JCA=JCN + JCN=JCO + ELSE + JCA=JCO + JCO=JCN + ENDIF +C...If possible, step from JCO to new tag JCN not equal to JCA. + DO 140 ICC=1,NCC+1 + IF (JCCN(ICC,1).EQ.JCO.AND.JCCN(ICC,2).NE.JCA) JCN= + & JCCN(ICC,2) + IF (JCCN(ICC,2).EQ.JCO.AND.JCCN(ICC,1).NE.JCA) JCN= + & JCCN(ICC,1) + 140 CONTINUE +C...Iterate if new colour was arrived at, but don't go in circles. + IF (JCN.NE.JCO.AND.JCN.NE.JCALL) GOTO 120 +C...Change all JCN tags in MCO to JCALL in MCT. + DO 150 I=MINT(84)+1,N + IF (MCO(I,1).EQ.JCN) MCT(I,1)=JCALL + IF (MCO(I,2).EQ.JCN) MCT(I,2)=JCALL +C...If gluon and colour tag = anticolour tag (and not = 0) try again. + IF (K(I,2).EQ.21.AND.MCT(I,1).EQ.MCT(I,2).AND.MCT(I,1) + & .NE.0) MACCPT=0 + 150 CONTINUE + 160 CONTINUE + + DO 200 JCL=NCT,1,-1 + JCA=0 + JCN=JCL + 170 JCO=JCN + DO 180 ICC=1,NCC+1 + IF (JCCN(ICC,1).EQ.JCO.AND.JCCN(ICC,2).NE.JCA) JCN + & =JCCN(ICC,2) + IF (JCCN(ICC,2).EQ.JCO.AND.JCCN(ICC,1).NE.JCA) JCN + & =JCCN(ICC,1) + 180 CONTINUE +C...Overpaint all JCN with JCL + IF (JCN.NE.JCO.AND.JCN.NE.JCL) THEN + DO 190 I=MINT(84)+1,N + IF (MCT(I,1).EQ.JCN) MCT(I,1)=JCL + IF (MCT(I,2).EQ.JCN) MCT(I,2)=JCL +C...If gluon and colour tag = anticolour tag (and not = 0) try again. + IF (K(I,2).EQ.21.AND.MCT(I,1).EQ.MCT(I,2).AND.MCT(I,1) + & .NE.0) MACCPT=0 + 190 CONTINUE + JCA=JCO + GOTO 170 + ENDIF + 200 CONTINUE + + RETURN + END + +C********************************************************************* + +C...PYMIRM +C...Picks primordial kT and shares longitudinal momentum among +C...beam remnants. + + SUBROUTINE PYMIRM + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...The event record + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) +C...Parameters + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) +C...The common block of colour tags. + COMMON/PYCTAG/NCT,MCT(4000,2) +C...The common block of dangling ends + COMMON/PYINTM/KFIVAL(2,3),NMI(2),IMI(2,800,2),NVC(2,-6:6), + & XASSOC(2,-6:6,240),XPSVC(-6:6,-1:240),PVCTOT(2,-1:1), + & XMI(2,240),PT2MI(240),IMISEP(0:240) + SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/,/PYINTM/,/PYCTAG/ +C...Local variables + DIMENSION W(0:2,0:2),VB(3),NNXT(2),IVALQ(2),ICOMQ(2) +C...W(I,J)| J=0 | 1 | 2 | +C... I=0 | Wrem**2 | W+ | W- | +C... 1 | W1**2 | W1+ | W1- | +C... 2 | W2**2 | W2+ | W2- | +C...4-product + FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3) +C...Tentative parametrization of as a function of Q. + SIGPT(Q)=MAX(PARJ(21),2.1D0*Q/(7D0+Q)) +C SIGPT(Q)=MAX(0.36D0,4D0*SQRT(Q)/(10D0+SQRT(Q)) +C SIGPT(Q)=MAX(PARJ(21),3D0*SQRT(Q)/(5D0+SQRT(Q)) + GETPT(Q,SIGMA)=MIN(SIGMA*SQRT(-LOG(PYR(0))),PARP(93)) +C...Lambda kinematic function. + FLAM(A,B,C)=A**2+B**2+C**2-2D0*(A*B+B*C+C*A) + +C...Beginning and end of beam remnant partons + NOUT=MINT(53) + ISUB=MINT(1) + +C...Loopback point if kinematic choices gives impossible configuration. + NTRY=0 + 100 NTRY=NTRY+1 + +C...Assign kT values on each side separately. + DO 180 JS=1,2 + +C...First zero all kT on this side. Skip if no kT to generate. + DO 110 IM=1,NMI(JS) + P(IMI(JS,IM,1),1)=0D0 + P(IMI(JS,IM,1),2)=0D0 + 110 CONTINUE + IF(MSTP(91).LE.0) GOTO 180 + +C...Now assign kT to each (non-collapsed) parton in IMI. + DO 170 IM=1,NMI(JS) + I=IMI(JS,IM,1) +C...Select kT according to truncated gaussian or 1/kt6 tails. +C...For first interaction, either use rms width = PARP(91) or fitted. + IF (IM.EQ.1) THEN + SIGMA=PARP(91) + IF (MSTP(91).GE.11.AND.MSTP(91).LE.20) THEN + Q=SQRT(PT2MI(IM)) + SIGMA=SIGPT(Q) + ENDIF + ELSE +C...For subsequent interactions and BR partons use fragmentation width. + SIGMA=PARJ(21) + ENDIF + PHI=PARU(2)*PYR(0) + PT=0D0 + IF(NTRY.LE.100) THEN + 111 IF (MSTP(91).EQ.1.OR.MSTP(91).EQ.11) THEN + PT=GETPT(Q,SIGMA) + PTX=PT*COS(PHI) + PTY=PT*SIN(PHI) + ELSEIF (MSTP(91).EQ.2) THEN + CALL PYERRM(1,'(PYMIRM:) Sorry, MSTP(91)=2 not '// + & 'available, using MSTP(91)=1.') + CALL PYGIVE('MSTP(91)=1') + GOTO 111 + ELSEIF(MSTP(91).EQ.3.OR.MSTP(91).EQ.13) THEN +C...Use distribution with kt**6 tails, rms width = PARP(91). + EPS=SQRT(3D0/2D0)*SIGMA +C...Generate PTX and PTY separately, each propto 1/KT**6 + DO 119 IXY=1,2 +C...Decide which interval to try + 112 P12=1D0/(1D0+27D0/40D0*SIGMA**6/EPS**6) + IF (PYR(0).LT.P12) THEN +C...Use flat approx with accept/reject up to EPS. + PT=PYR(0)*EPS + WT=(3D0/2D0*SIGMA**2/(PT**2+3D0/2D0*SIGMA**2))**3 + IF (PYR(0).GT.WT) GOTO 112 + ELSE +C...Above EPS, use 1/kt**6 approx with accept/reject. + PT=EPS/(PYR(0)**(1D0/5D0)) + WT=PT**6/(PT**2+3D0/2D0*SIGMA**2)**3 + IF (PYR(0).GT.WT) GOTO 112 + ENDIF + MSIGN=1 + IF (PYR(0).GT.0.5D0) MSIGN=-1 + IF (IXY.EQ.1) PTX=MSIGN*PT + IF (IXY.EQ.2) PTY=MSIGN*PT + 119 CONTINUE + ELSEIF (MSTP(91).EQ.4.OR.MSTP(91).EQ.14) THEN + PTX=SIGMA*(SQRT(6D0)*PYR(0)-SQRT(3D0/2D0)) + PTY=SIGMA*(SQRT(6D0)*PYR(0)-SQRT(3D0/2D0)) + ENDIF +C...Adjust final PT. Impose upper cutoff, or zero for soft evts. + PT=SQRT(PTX**2+PTY**2) + WT=1D0 + IF (PT.GT.PARP(93)) WT=SQRT(PARP(93)/PT) + IF(ISUB.EQ.95.AND.IM.EQ.1) WT=0D0 + PTX=PTX*WT + PTY=PTY*WT + PT=SQRT(PTX**2+PTY**2) + ENDIF + + P(I,1)=P(I,1)+PTX + P(I,2)=P(I,2)+PTY + +C...Compensation kicks, with varying degree of local anticorrelations. + MCORR=MSTP(90) + IF (MCORR.EQ.0.OR.ISUB.EQ.95) THEN + PTCX=-PTX/(NMI(JS)-1) + PTCY=-PTY/(NMI(JS)-1) + IF(ISUB.EQ.95) THEN + PTCX=-PTX/(NMI(JS)-2) + PTCY=-PTY/(NMI(JS)-2) + ENDIF + DO 120 IMC=1,NMI(JS) + IF (IMC.EQ.IM) GOTO 120 + IF(ISUB.EQ.95.AND.IMC.EQ.1) GOTO 120 + P(IMI(JS,IMC,1),1)=P(IMI(JS,IMC,1),1)+PTCX + P(IMI(JS,IMC,1),2)=P(IMI(JS,IMC,1),2)+PTCY + 120 CONTINUE + ELSEIF (MCORR.GE.1) THEN + DO 140 MSID=4,5 + NNXT(MSID-3)=0 +C...Count up # of neighbours on either side + IMO=I + 130 IMO=K(IMO,MSID)/MSTU(5) + IF (IMO.EQ.0) GOTO 140 + NNXT(MSID-3)=NNXT(MSID-3)+1 +C...Stop at quarks and junctions + IF (MCORR.EQ.1.AND.K(IMO,2).EQ.21) GOTO 130 + 140 CONTINUE +C...How should compensation be shared when unequal numbers on the +C...two sides? 50/50 regardless? N1:N2? Assume latter for now. + NSUM=NNXT(1)+NNXT(2) + T1=0 + DO 160 MSID=4,5 +C...Total momentum to be compensated on this side + IF (NNXT(MSID-3).EQ.0) GOTO 160 + PTCX=-(NNXT(MSID-3)*PTX)/NSUM + PTCY=-(NNXT(MSID-3)*PTY)/NSUM +C...RS: compensation supression factor as we go out from parton I. +C...Hardcoded behaviour RS=0.5, i.e. 1/2**n falloff, +C...since (for now) MSTP(90) provides enough variability. + RS=0.5D0 + FAC=(1D0-RS)/(RS*(1-RS**NNXT(MSID-3))) + IMO=I + 150 IDA=IMO + IMO=K(IMO,MSID)/MSTU(5) + IF (IMO.EQ.0) GOTO 160 + FAC=FAC*RS + IF (K(IMO,2).NE.88) THEN + P(IMO,1)=P(IMO,1)+FAC*PTCX + P(IMO,2)=P(IMO,2)+FAC*PTCY + IF (MCORR.EQ.1.AND.K(IMO,2).EQ.21) GOTO 150 +C...If we reach junction, divide out the kT that would have been +C...assigned to the junction on each of its other legs. + ELSE + L1=MOD(K(IMO,4),MSTU(5)) + L2=K(IMO,5)/MSTU(5) + L3=MOD(K(IMO,5),MSTU(5)) + P(L1,1)=P(L1,1)+0.5D0*FAC*PTCX + P(L1,2)=P(L1,2)+0.5D0*FAC*PTCY + P(L2,1)=P(L2,1)+0.5D0*FAC*PTCX + P(L2,2)=P(L2,2)+0.5D0*FAC*PTCY + P(L3,1)=P(L3,1)+0.5D0*FAC*PTCX + P(L3,2)=P(L3,2)+0.5D0*FAC*PTCY + P(IDA,1)=P(IDA,1)-0.5D0*FAC*PTCX + P(IDA,2)=P(IDA,2)-0.5D0*FAC*PTCY + ENDIF + + 160 CONTINUE + ENDIF + 170 CONTINUE +C...End assignment of kT values to initiators and remnants. + 180 CONTINUE + +C...Check kinematics constraints for non-BR partons. + DO 190 IM=1,MINT(31) + SHAT=XMI(1,IM)*XMI(2,IM)*VINT(2) + PT1=SQRT(P(IMI(1,IM,1),1)**2+P(IMI(1,IM,1),2)**2) + PT2=SQRT(P(IMI(2,IM,1),1)**2+P(IMI(2,IM,1),2)**2) + PT1PT2=P(IMI(1,IM,1),1)*P(IMI(2,IM,1),1) + & +P(IMI(1,IM,1),2)*P(IMI(2,IM,1),2) + IF (SHAT.LT.2D0*(PT1*PT2-PT1PT2).AND.NTRY.LE.100) THEN + IF(NTRY.GE.100) THEN +C...Kill this event and start another. + CALL PYERRM(1, + & '(PYMIRM:) No consistent (x,kT) sets found') + MINT(51)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + 190 CONTINUE + +C...Calculate W+ and W- available for combined remnant system. + W(0,1)=VINT(1) + W(0,2)=VINT(1) + DO 200 IM=1,MINT(31) + PT2 = (P(IMI(1,IM,1),1)+P(IMI(2,IM,1),1))**2 + & +(P(IMI(1,IM,1),2)+P(IMI(2,IM,1),2))**2 + ST=XMI(1,IM)*XMI(2,IM)*VINT(2)+PT2 + W(0,1)=W(0,1)-SQRT(XMI(1,IM)/XMI(2,IM)*ST) + W(0,2)=W(0,2)-SQRT(XMI(2,IM)/XMI(1,IM)*ST) + 200 CONTINUE +C...Also store Wrem**2 = W+ * W- + W(0,0)=W(0,1)*W(0,2) + + IF ((W(0,0).LT.0D0.OR.W(0,1)+W(0,2).LT.0D0).AND.NTRY.LE.100) THEN + IF(NTRY.GE.100) THEN +C...Kill this event and start another. + CALL PYERRM(1, + & '(PYMIRM:) Negative beam remnant mass squared unavoidable') + MINT(51)=1 + RETURN + ENDIF + GOTO 100 + ENDIF + +C...Assign unscaled x values to partons/hadrons in each of the +C...beam remnants and calculate unscaled W+ and W- from them. + NTRYX=0 + 210 NTRYX=NTRYX+1 + DO 280 JS=1,2 + W(JS,1)=0D0 + W(JS,2)=0D0 + DO 270 IM=MINT(31)+1,NMI(JS) + I=IMI(JS,IM,1) + KF=K(I,2) + KFA=IABS(KF) + ICOMP=IMI(JS,IM,2) + +C...Skip collapsed gluons and junctions. Reset. + IF (KFA.EQ.21.AND.K(I,1).EQ.14) GOTO 270 + IF (KFA.EQ.88) GOTO 270 + X=0D0 + IVALQ(1)=0 + IVALQ(2)=0 + ICOMQ(1)=0 + ICOMQ(2)=0 + +C...If gluon then only beam remnant, so takes all. + IF(KFA.EQ.21) THEN + X=1D0 +C...If valence quark then use parametrized valence distribution. + ELSEIF(KFA.LE.6.AND.ICOMP.EQ.0) THEN + IVALQ(1)=KF +C...If companion quark then derive from companion x. + ELSEIF(KFA.LE.6) THEN + ICOMQ(1)=ICOMP +C...If valence diquark then use two parametrized valence distributions. + ELSEIF(KFA.GT.1000.AND.MOD(KFA/10,10).EQ.0.AND. + & ICOMP.EQ.0) THEN + IVALQ(1)=ISIGN(KFA/1000,KF) + IVALQ(2)=ISIGN(MOD(KFA/100,10),KF) +C...If valence+sea diquark then combine valence + companion choices. + ELSEIF(KFA.GT.1000.AND.MOD(KFA/10,10).EQ.0.AND. + & ICOMP.LT.MSTU(5)) THEN + IF(KFA/1000.EQ.IABS(K(ICOMP,2))) THEN + IVALQ(1)=ISIGN(MOD(KFA/100,10),KF) + ELSE + IVALQ(1)=ISIGN(KFA/1000,KF) + ENDIF + ICOMQ(1)=ICOMP +C...Extra code: workaround for diquark made out of two sea +C...quarks, but where not (yet) ICOMP > MSTU(5). + DO 220 IM1=1,MINT(31) + IF(IMI(JS,IM1,2).EQ.I.AND.IMI(JS,IM1,1).NE.ICOMP) THEN + ICOMQ(2)=IMI(JS,IM1,1) + IVALQ(1)=0 + ENDIF + 220 CONTINUE +C...If sea diquark then sum of two derived from companion x. + ELSEIF(KFA.GT.1000.AND.MOD(KFA/10,10).EQ.0) THEN + ICOMQ(1)=MOD(ICOMP,MSTU(5)) + ICOMQ(2)=ICOMP/MSTU(5) +C...If meson or baryon then use fragmentation function. +C...Somewhat arbitrary split into old and new flavour, but OK normally. + ELSE + KFL3=MOD(KFA/10,10) + IF(MOD(KFA/1000,10).EQ.0) THEN + KFL1=MOD(KFA/100,10) + ELSE + KFL1=MOD(KFA,10000)-10*KFL3-1 + IF(MOD(KFA/1000,10).EQ.MOD(KFA/100,10).AND. + & MOD(KFA,10).EQ.2) KFL1=KFL1+2 + ENDIF + PR=P(I,5)**2+P(I,1)**2+P(I,2)**2 + CALL PYZDIS(KFL1,KFL3,PR,X) + ENDIF + + DO 260 IQ=1,2 +C...Calculation of x of valence quark: assume form (1-x)^a/sqrt(x), +C...where a=3.5 for u in proton, =2 for d in proton and =0.8 for meson. +C...In other baryons combine u and d from proton appropriately. + IF(IVALQ(IQ).NE.0) THEN + NVAL=0 + IF(KFIVAL(JS,1).EQ.IVALQ(IQ)) NVAL=NVAL+1 + IF(KFIVAL(JS,2).EQ.IVALQ(IQ)) NVAL=NVAL+1 + IF(KFIVAL(JS,3).EQ.IVALQ(IQ)) NVAL=NVAL+1 +C...Meson. + IF(KFIVAL(JS,3).EQ.0) THEN + MDU=0 +C...Baryon with three identical quarks: mix u and d forms. + ELSEIF(NVAL.EQ.3) THEN + MDU=INT(PYR(0)+5D0/3D0) +C...Baryon, one of two identical quarks: u form. + ELSEIF(NVAL.EQ.2) THEN + MDU=2 +C...Baryon with two identical quarks, but not the one picked: d form. + ELSEIF(KFIVAL(JS,1).EQ.KFIVAL(JS,2).OR.KFIVAL(JS,2).EQ. + & KFIVAL(JS,3).OR.KFIVAL(JS,1).EQ.KFIVAL(JS,3)) THEN + MDU=1 +C...Baryon with three nonidentical quarks: mix u and d forms. + ELSE + MDU=INT(PYR(0)+5D0/3D0) + ENDIF + XPOW=0.8D0 + IF(MDU.EQ.1) XPOW=3.5D0 + IF(MDU.EQ.2) XPOW=2D0 + 230 XX=PYR(0)**2 + IF((1D0-XX)**XPOW.LT.PYR(0)) GOTO 230 + X=X+XX + ENDIF + +C...Calculation of x of companion quark. + IF(ICOMQ(IQ).NE.0) THEN + XCOMP=1D-4 + DO 240 IM1=1,MINT(31) + IF(IMI(JS,IM1,1).EQ.ICOMQ(IQ)) XCOMP=XMI(JS,IM1) + 240 CONTINUE + NPOW=MAX(0,MIN(4,MSTP(87))) + 250 XX=XCOMP*(1D0/(1D0-PYR(0)*(1D0-XCOMP))-1D0) + CORR=((1D0-XCOMP-XX)/(1D0-XCOMP))**NPOW* + & (XCOMP**2+XX**2)/(XCOMP+XX)**2 + IF(CORR.LT.PYR(0)) GOTO 250 + X=X+XX + ENDIF + 260 CONTINUE + +C...Optionally enchance x of composite systems (e.g. diquarks) + IF (KFA.GT.100) X=PARP(79)*X + +C...Store x. Also calculate light cone energies of each system. + XMI(JS,IM)=X + W(JS,JS)=W(JS,JS)+X + W(JS,3-JS)=W(JS,3-JS)+(P(I,5)**2+P(I,1)**2+P(I,2)**2)/X + 270 CONTINUE + W(JS,JS)=W(JS,JS)*W(0,JS) + W(JS,3-JS)=W(JS,3-JS)/W(0,JS) + W(JS,0)=W(JS,1)*W(JS,2) + 280 CONTINUE + +C...Check W1 W2 < Wrem (can be done before rescaling, since W +C...insensitive to global rescalings of the BR x values). + IF (SQRT(W(1,0))+SQRT(W(2,0)).GT.SQRT(W(0,0)).AND.NTRYX.LE.100) + & THEN + GOTO 210 + ELSEIF (NTRYX.GT.100.AND.NTRY.LE.100) THEN + GOTO 100 + ELSEIF (NTRYX.GT.100) THEN + CALL PYERRM(1,'(PYMIRM:) No consistent (x,kT) sets found') + MINT(57)=MINT(57)+1 + MINT(51)=1 + RETURN + ENDIF + +C...Compute x rescaling factors + COMTRM=W(0,0)+SQRT(FLAM(W(0,0),W(1,0),W(2,0))) + R1=(COMTRM+W(1,0)-W(2,0))/(2D0*W(1,1)*W(0,2)) + R2=(COMTRM+W(2,0)-W(1,0))/(2D0*W(2,2)*W(0,1)) + + IF (R1.LT.0.OR.R2.LT.0) THEN + CALL PYERRM(19,'(PYMIRM:) negative rescaling factors !') + MINT(57)=MINT(57)+1 + MINT(51)=1 + ENDIF + +C...Rescale W(1,*) and W(2,*) (not really necessary, but consistent). + W(1,1)=W(1,1)*R1 + W(1,2)=W(1,2)/R1 + W(2,1)=W(2,1)/R2 + W(2,2)=W(2,2)*R2 + +C...Rescale BR x values. + DO 290 IM=MINT(31)+1,MAX(NMI(1),NMI(2)) + XMI(1,IM)=XMI(1,IM)*R1 + XMI(2,IM)=XMI(2,IM)*R2 + 290 CONTINUE + +C...Now we have a consistent set of x and kT values. +C...First set up the initiators and their daughters correctly. + DO 300 IM=1,MINT(31) + I1=IMI(1,IM,1) + I2=IMI(2,IM,1) + ST=XMI(1,IM)*XMI(2,IM)*VINT(2)+(P(I1,1)+P(I2,1))**2+ + & (P(I1,2)+P(I2,2))**2 + PT12=P(I1,1)**2+P(I1,2)**2 + PT22=P(I2,1)**2+P(I2,2)**2 +C...p_z + P(I1,3)=SQRT(FLAM(ST,PT12,PT22)/(4D0*ST)) + P(I2,3)=-P(I1,3) +C...Energies (masses should be zero at this stage) + P(I1,4)=SQRT(PT12+P(I1,3)**2) + P(I2,4)=SQRT(PT22+P(I2,3)**2) + +C...Transverse 12 system initiator velocity: + VB(1)=(P(I1,1)+P(I2,1))/SQRT(ST) + VB(2)=(P(I1,2)+P(I2,2))/SQRT(ST) +C...Boost to overall initiator system rest frame + CALL PYROBO(I1,I1,0D0,0D0,-VB(1),-VB(2),0D0) + CALL PYROBO(I2,I2,0D0,0D0,-VB(1),-VB(2),0D0) + +C...Compute phi,theta coordinates of I1 and rotate z axis. + PHI=PYANGL(P(I1,1),P(I1,2)) + THE=PYANGL(P(I1,3),SQRT(P(I1,1)**2+P(I1,2)**2)) + IMIN=IMISEP(IM-1)+1 +C...(include documentation lines if MI = 1) + IF (IM.EQ.1) IMIN=MINT(83)+5 + IMAX=IMISEP(IM) +C...Rotate entire system in phi + CALL PYROBO(IMIN,IMAX,0D0,-PHI,0D0,0D0,0D0) +C...Only rotate 12 system in theta + CALL PYROBO(I1,I1,-THE,0D0,0D0,0D0,0D0) + CALL PYROBO(I2,I2,-THE,0D0,0D0,0D0,0D0) + +C...Now boost entire system back to LAB + VB(3)=(XMI(1,IM)-XMI(2,IM))/(XMI(1,IM)+XMI(2,IM)) + CALL PYROBO(IMIN,IMAX,THE,PHI,VB(1),VB(2),0D0) + CALL PYROBO(IMIN,IMAX,0D0,0D0,0D0,0D0,VB(3)) + + 300 CONTINUE + + +C...For the beam remnant partons/hadrons, we only need to set pz and E. + DO 320 JS=1,2 + DO 310 IM=MINT(31)+1,NMI(JS) + I=IMI(JS,IM,1) +C...Skip collapsed gluons and junctions. + IF (K(I,2).EQ.21.AND.K(I,1).EQ.14) GOTO 310 + IF (KFA.EQ.88) GOTO 310 + RMT2=P(I,5)**2+P(I,1)**2+P(I,2)**2 + P(I,4)=0.5D0*(XMI(JS,IM)*W(0,JS)+RMT2/(XMI(JS,IM)*W(0,JS))) + P(I,3)=0.5D0*(XMI(JS,IM)*W(0,JS)-RMT2/(XMI(JS,IM)*W(0,JS))) + IF (JS.EQ.2) P(I,3)=-P(I,3) + 310 CONTINUE + 320 CONTINUE + + +C...Documentation lines + DO 340 JS=1,2 + IN=MINT(83)+JS+2 + IO=IMI(JS,1,1) + K(IN,1)=21 + K(IN,2)=K(IO,2) + K(IN,3)=MINT(83)+JS + K(IN,4)=0 + K(IN,5)=0 + DO 330 J=1,5 + P(IN,J)=P(IO,J) + V(IN,J)=V(IO,J) + 330 CONTINUE + MCT(IN,1)=MCT(IO,1) + MCT(IN,2)=MCT(IO,2) + 340 CONTINUE + +C...Final state colour reconnections. + IF (MSTP(95).NE.1.OR.MINT(31).LE.1) GOTO 380 + +C...Number of colour tags for which a recoupling will be tried. + NTOT=NCT +C...Number of recouplings to try + MINT(34)=0 + NRECP=0 + NITER=0 + 350 NRECP=MINT(34) + NITER=NITER+1 + IITER=0 + 360 IITER=IITER+1 + IF (IITER.LE.PARP(78)*NTOT) THEN +C...Select two colour tags at random +C...NB: jj strings do not have colour tags assigned to them, +C...thus they are as yet not affected by anything done here. + JCT=PYR(0)*NCT+1 + KCT=MOD(INT(JCT+PYR(0)*NCT),NCT)+1 + IJ1=0 + IJ2=0 + IK1=0 + IK2=0 +C...Find final state partons with this (anti)colour + DO 370 I=MINT(84)+1,N + IF (K(I,1).EQ.3) THEN + IF (MCT(I,1).EQ.JCT) IJ1=I + IF (MCT(I,2).EQ.JCT) IJ2=I + IF (MCT(I,1).EQ.KCT) IK1=I + IF (MCT(I,2).EQ.KCT) IK2=I + ENDIF + 370 CONTINUE +C...Only consider recouplings not involving junctions for now. + IF (IJ1.EQ.0.OR.IJ2.EQ.0.OR.IK1.EQ.0.OR.IK2.EQ.0) GOTO 360 + + RLO=2D0*FOUR(IJ1,IJ2)*2D0*FOUR(IK1,IK2) + RLN=2D0*FOUR(IJ1,IK2)*2D0*FOUR(IK1,IJ2) + IF (RLN.LT.RLO.AND.MCT(IJ2,1).NE.KCT.AND.MCT(IK2,1).NE.JCT) THEN + MCT(IJ2,2)=KCT + MCT(IK2,2)=JCT +C...Count up number of reconnections + MINT(34)=MINT(34)+1 + ENDIF + IF (MINT(34).LE.1000) THEN + GOTO 360 + ELSE + CALL PYERRM(4,'(PYMIRM:) caught in infinite loop') + GOTO 380 + ENDIF + ENDIF + IF (NRECP.LT.MINT(34)) GOTO 350 + +C...Signal PYPREP to use /PYCTAG/ information rather than K(I,KCS). + 380 MINT(33)=1 + + RETURN + END + +C********************************************************************* + +C...PYFSCR +C...Performs colour annealing. +C...MSTP(95) : CR Type +C... = 1 : old cut-and-paste reconnections, handled in PYMIHK +C... = 2 : Type I(no gg loops); hadron-hadron only +C... = 3 : Type I(no gg loops); all beams +C... = 4 : Type II(gg loops) ; hadron-hadron only +C... = 5 : Type II(gg loops) ; all beams +C... = 6 : Type S ; hadron-hadron only +C... = 7 : Type S ; all beams +C...Types I and II are described in Sandhoff+Skands, in hep-ph/0604120. +C...Type S is driven by starting only from free triplets, not octets. +C...A string piece remains unchanged with probability +C... PKEEP = (1-PARP(78))**N +C...This scaling corresponds to each string piece having to go through +C...N other ones, each with probability PARP(78) for reconnection, where +C...N is here chosen simply as the number of multiple interactions, +C...for a rough scaling with the general level of activity. + + SUBROUTINE PYFSCR(IP) +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYINT1/MINT(400),VINT(400) +C...The common block of colour tags. + COMMON/PYCTAG/NCT,MCT(4000,2) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYINT1/,/PYCTAG/, + &/PYPARS/ +C...MCN: Temporary storage of new colour tags + INTEGER MCN(4000,2) +C...Arrays for storing color string lengths + INTEGER ICR(4000),MSCR(4000) + INTEGER IOPT(4000) + DOUBLE PRECISION RLOPTC(4000) + +C...Function to give four-product. + FOUR(I,J)=P(I,4)*P(J,4) + & -P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3) + +C...Check valid range of MSTP(95), local copy + IF (MSTP(95).LE.1.OR.MSTP(95).GE.10) RETURN + MSTP95=MOD(MSTP(95),10) +C...Set whether CR allowed inside resonance systems or not +C...(not implemented yet) +C MRESCR=1 +C IF (MSTP(95).GE.10) MRESCR=0 + +C...Check whether colour tags already defined + IF (MINT(33).EQ.0) THEN +C...Erase any existing colour tags for this event + DO 100 I=1,N + MCT(I,1)=0 + MCT(I,2)=0 + 100 CONTINUE +C...Create colour tags for this event + DO 120 I=1,N + IF (K(I,1).EQ.3) THEN + DO 110 KCS=4,5 + KCSIN=KCS + IF (MCT(I,KCSIN-3).EQ.0) THEN + CALL PYCTTR(I,KCSIN,I) + ENDIF + 110 CONTINUE + ENDIF + 120 CONTINUE +C...Instruct PYPREP to use colour tags + MINT(33)=1 + ENDIF + +C...For MSTP(95) even, only apply to hadron-hadron + KA1=IABS(MINT(11)) + KA2=IABS(MINT(12)) + IF (MOD(MSTP(95),2).EQ.0.AND.(KA1.LT.100.OR.KA2.LT.100)) GOTO 9999 + +C...Initialize new tag array (but do not delete old yet) + LCT=NCT + DO 130 I=MAX(1,IP),N + MCN(I,1)=0 + MCN(I,2)=0 + 130 CONTINUE + +C...For each final-state dipole, check whether string should be +C...preserved. + NCR=0 + IA=0 + IC=0 + + DO 150 ICT=1,NCT + IA=0 + IC=0 + DO 140 I=MAX(1,IP),N + IF (K(I,1).EQ.3.AND.MCT(I,1).EQ.ICT) IC=I + IF (K(I,1).EQ.3.AND.MCT(I,2).EQ.ICT) IA=I + 140 CONTINUE + IF (IC.NE.0.AND.IA.NE.0) THEN + CRMODF=1D0 +C...Opt: suppress breakup of high-boost string pieces (i.e., let them escape) +C...(so far ignores the possibility that the whole "muck" may be moving.) + IF (PARP(77).GT.0D0) THEN + PT2STR=(P(IA,1)+P(IC,1))**2+(P(IA,2)+P(IC,2))**2 +C...For lepton-lepton, use actual p2/m2, otherwise approximate p2 ~ 3/2 pT2 + IF (KA1.LT.100.AND.KA2.LT.100) THEN + P2STR = PT2STR + (P(IA,3)+P(IC,3))**2 + ELSE + P2STR = 3D0/2D0 * PT2STR + ENDIF + RM2STR=(P(IA,4)+P(IC,4))**2-(P(IA,3)+P(IC,3))**2-PT2STR + RM2STR=MAX(RM2STR,PMAS(PYCOMP(111),1)**2) +C...Estimate number of particles ~ log(M2), cut off at 1. + RLOGM2=MAX(1D0,LOG(RM2STR)) + P2AVG=P2STR/RLOGM2 +C...Supress reconnection probability by 1/(1+P77*P2AVG) + CRMODF=1D0/(1D0+PARP(77)**2*P2AVG) + ENDIF + PKEEP=(1D0-PARP(78)*CRMODF)**MINT(31) + IF (PYR(0).LE.PKEEP) THEN + LCT=LCT+1 + MCN(IC,1)=LCT + MCN(IA,2)=LCT + ELSE +C...Add coloured parton + NCR=NCR+1 + ICR(NCR)=IC + MSCR(NCR)=1 + IOPT(NCR)=0 + RLOPTC(NCR)=1D19 +C...Add anti-coloured parton + NCR=NCR+1 + ICR(NCR)=IA + MSCR(NCR)=2 + IOPT(NCR)=0 + RLOPTC(NCR)=1D19 + ENDIF + ENDIF + 150 CONTINUE + +C...Skip if there is only one possibility + IF (NCR.LE.2) THEN + GOTO 9999 + ENDIF + +C...Reorder, so ordered in I (in order to correspond to old algorithm) + NLOOP=0 + 151 NLOOP=NLOOP+1 + MORD=1 + DO 155 IC1=1,NCR-1 + I1=ICR(IC1) + I2=ICR(IC1+1) + IF (I1.GT.I2) THEN + IT=I1 + MST=MSCR(IC1) + ICR(IC1)=I2 + MSCR(IC1)=MSCR(IC1+1) + ICR(IC1+1)=IT + MSCR(IC1+1)=MST + MORD=0 + ENDIF + 155 CONTINUE +C...Max do 1000 reordering loops + IF (MORD.EQ.0.AND.NLOOP.LE.1000) GOTO 151 + +C...Loop over CR partons +C...(Ignore junctions for now.) + NLOOP=0 + 160 NLOOP=NLOOP+1 + RLMAX=0D0 + ICRMAX=0 +C...Loop over coloured partons + DO 230 IC1=1,NCR +C...Retrieve parton Event Record index and Colour Side + I=ICR(IC1) + MSI=MSCR(IC1) +C...Skip already connected partons + IF (MCN(I,MSI).NE.0) GOTO 230 +C...Shorthand for colour charge + MCI=KCHG(PYCOMP(K(I,2)),2)*ISIGN(1,K(I,2)) +C...For Seattle algorithm, only start from partons with one dangling +C...colour tag + IF (MSTP(95).GE.6.AND.MSTP(95).LE.9) THEN + IF (MCI.EQ.2.AND.MCN(I,1).EQ.0.AND.MCN(I,2).EQ.0) GOTO 230 + ENDIF +C...Retrieve saved optimal partner + IO=IOPT(IC1) + IF (IO.NE.0) THEN +C...Reject saved optimal partner if latter is now connected +C...(Also reject if using model S1, since saved partner may +C...now give rise to gg loop.) + IF (MCN(IO,3-MSI).NE.0.OR.MSTP(95).LE.3) THEN + IOPT(IC1)=0 + RLOPTC(IC1)=1D19 + ENDIF + ENDIF + RLOPT=RLOPTC(IC1) +C...Search for new optimal partner if necessary + IF (IOPT(IC1).EQ.0) THEN + MBROPT=0 + MGGOPT=0 + RLOPT=1D19 +C...Loop over partons you can connect to + DO 210 IC2=1,NCR + J=ICR(IC2) + MSJ=MSCR(IC2) +C...Skip if already connected + IF (MCN(J,MSJ).NE.0) GOTO 210 +C...Skip if this not colour-anticolour pair + IF (MSI.EQ.MSJ) GOTO 210 +C...And do not let gluons connect to themselves + IF (I.EQ.J) GOTO 210 +C...Suppress direct connections between partons in same Beam Remnant + MBRSTR=0 + IF (K(I,3).LE.2.AND.K(I,3).GE.1.AND.K(I,3).EQ.K(J,3)) + & MBRSTR=1 +C...Shorthand for colour charge + MCJ=KCHG(PYCOMP(K(J,2)),2)*ISIGN(1,K(J,2)) +C...Check for gluon loops + MGGSTR=0 + IF (MCJ.EQ.2.AND.MCI.EQ.2) THEN + IF (MCN(I,2).EQ.MCN(J,1).AND.MSTP(95).LE.3.AND. + & MCN(I,2).NE.0) MGGSTR=1 + ENDIF +C...Save connection with smallest lambda measure + RL=FOUR(I,J) +C...Optional: Seattle v2: multiply gluons by 1/2 since two strings connected + IF (MSTP(95).GE.7.AND.MSTP(95).LE.8) THEN + IF (K(I,2).EQ.21) RL=0.5D0*RL + IF (K(J,2).EQ.21) RL=0.5D0*RL + ENDIF +C...If best so far was a BR string and this is not, also save. +C...If best so far was a gg string and this is not, also save. +C...NB: this is not fool-proof. If the algorithm finds a BR or gg +C...string with a small Lambda measure as the last step, this connection +C...will be saved regardless of whether other possibilities existed. +C...I.e., there should really be a check whether another possibility has +C...already been found, but since these models are now actively in use +C...and uncertainties are anyway large, the algorithm is left as it is. +C...(correction --> Pythia 8 ?) + IF (RL.LT.RLOPT.OR.(RL.EQ.RLOPT.AND.PYR(0).LE.0.5D0) + & .OR.(MBROPT.EQ.1.AND.MBRSTR.EQ.0) + & .OR.(MGGOPT.EQ.1.AND.MGGSTR.EQ.0)) THEN + RLOPT=RL + RLOPTC(IC1)=RLOPT + IOPT(IC1)=J + MBROPT=MBRSTR + MGGOPT=MGGSTR + ENDIF + 210 CONTINUE + ENDIF + IF (IOPT(IC1).NE.0) THEN +C...Save pair with largest RLOPT so far + IF (RLOPT.GE.RLMAX) THEN + ICRMAX=IC1 + RLMAX=RLOPT + ENDIF + ENDIF + 230 CONTINUE +C...Save and iterate + IF (ICRMAX.GT.0) THEN + LCT=LCT+1 + ILMAX=ICR(ICRMAX) + JLMAX=IOPT(ICRMAX) + ICMAX=MSCR(ICRMAX) + JCMAX=3-ICMAX + MCN(ILMAX,ICMAX)=LCT + MCN(JLMAX,JCMAX)=LCT + IF (NLOOP.LE.2*(N-IP)) THEN + GOTO 160 + ELSE + CALL PYERRM(31,' PYFSCR: infinite loop in color annealing') + CALL PYSTOP(11) + ENDIF + ELSE +C...Save and exit. First check for leftover gluon(s) + DO 260 I=MAX(1,IP),N +C...Check colour charge + MCI=KCHG(PYCOMP(K(I,2)),2)*ISIGN(1,K(I,2)) + IF (K(I,1).NE.3.OR.MCI.NE.2) GOTO 260 + IF(MCN(I,1).EQ.0.AND.MCN(I,2).EQ.0) THEN +C...Decide where to put left-over gluon (minimal insertion) + ILMAX=0 + RLMAX=1D19 + DO 250 KCT=NCT+1,LCT + DO 240 IT=MAX(1,IP),N + IF (IT.EQ.I.OR.K(IT,1).NE.3) GOTO 240 + IF (MCN(IT,1).EQ.KCT) IC=IT + IF (MCN(IT,2).EQ.KCT) IA=IT + 240 CONTINUE + RL=FOUR(IC,I)*FOUR(IA,I) + IF (RL.LT.RLMAX) THEN + RLMAX=RL + ICMAX=IC + IAMAX=IA + ENDIF + 250 CONTINUE + LCT=LCT+1 + MCN(I,1)=MCN(ICMAX,1) + MCN(I,2)=LCT + MCN(ICMAX,1)=LCT + ENDIF + 260 CONTINUE +C...Here we need to loop over entire event. + DO 270 IZ=MAX(1,IP),N +C...Do not erase parton shower colour history + IF (K(IZ,1).NE.3) GOTO 270 +C...Check colour charge + MCI=KCHG(PYCOMP(K(IZ,2)),2)*ISIGN(1,K(IZ,2)) + IF (MCI.EQ.0) GOTO 270 + IF (MCN(IZ,1).NE.0) MCT(IZ,1)=MCN(IZ,1) + IF (MCN(IZ,2).NE.0) MCT(IZ,2)=MCN(IZ,2) + 270 CONTINUE + ENDIF + + 9999 RETURN + END + +C********************************************************************* + +C...PYDIFF +C...Handles diffractive and elastic scattering. + + SUBROUTINE PYDIFF + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ + +C...Reset K, P and V vectors. Store incoming particles. + DO 110 JT=1,MSTP(126)+10 + I=MINT(83)+JT + DO 100 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 100 CONTINUE + 110 CONTINUE + N=MINT(84) + MINT(3)=0 + MINT(21)=0 + MINT(22)=0 + MINT(23)=0 + MINT(24)=0 + MINT(4)=4 + DO 130 JT=1,2 + I=MINT(83)+JT + K(I,1)=21 + K(I,2)=MINT(10+JT) + DO 120 J=1,5 + P(I,J)=VINT(285+5*JT+J) + 120 CONTINUE + 130 CONTINUE + MINT(6)=2 + +C...Subprocess; kinematics. + SQLAM=(VINT(2)-VINT(63)-VINT(64))**2-4D0*VINT(63)*VINT(64) + PZ=SQRT(SQLAM)/(2D0*VINT(1)) + DO 200 JT=1,2 + I=MINT(83)+JT + PE=(VINT(2)+VINT(62+JT)-VINT(65-JT))/(2D0*VINT(1)) + KFH=MINT(102+JT) + +C...Elastically scattered particle. (Except elastic GVMD states.) + IF(MINT(16+JT).LE.0.AND.(MINT(10+JT).NE.22.OR. + & MINT(106+JT).NE.3)) THEN + N=N+1 + K(N,1)=1 + K(N,2)=KFH + K(N,3)=I+2 + P(N,3)=PZ*(-1)**(JT+1) + P(N,4)=PE + P(N,5)=SQRT(VINT(62+JT)) + +C...Decay rho from elastic scattering of gamma with sin**2(theta) +C...distribution of decay products (in rho rest frame). + IF(KFH.EQ.113.AND.MINT(10+JT).EQ.22.AND.MSTP(102).EQ.1) THEN + NSAV=N + DBETAZ=P(N,3)/SQRT(P(N,3)**2+P(N,5)**2) + P(N,3)=0D0 + P(N,4)=P(N,5) + CALL PYDECY(NSAV) + IF(N.EQ.NSAV+2.AND.IABS(K(NSAV+1,2)).EQ.211) THEN + PHI=PYANGL(P(NSAV+1,1),P(NSAV+1,2)) + CALL PYROBO(NSAV+1,NSAV+2,0D0,-PHI,0D0,0D0,0D0) + THE=PYANGL(P(NSAV+1,3),P(NSAV+1,1)) + CALL PYROBO(NSAV+1,NSAV+2,-THE,0D0,0D0,0D0,0D0) + 140 CTHE=2D0*PYR(0)-1D0 + IF(1D0-CTHE**2.LT.PYR(0)) GOTO 140 + CALL PYROBO(NSAV+1,NSAV+2,ACOS(CTHE),PHI,0D0,0D0,0D0) + ENDIF + CALL PYROBO(NSAV,NSAV+2,0D0,0D0,0D0,0D0,DBETAZ) + ENDIF + +C...Diffracted particle: low-mass system to two particles. + ELSEIF(VINT(62+JT).LT.(VINT(66+JT)+PARP(103))**2) THEN + N=N+2 + K(N-1,1)=1 + K(N,1)=1 + K(N-1,3)=I+2 + K(N,3)=I+2 + PMMAS=SQRT(VINT(62+JT)) + NTRY=0 + 150 NTRY=NTRY+1 + IF(NTRY.LT.20) THEN + MINT(105)=MINT(102+JT) + MINT(109)=MINT(106+JT) + CALL PYSPLI(KFH,21,KFL1,KFL2) + CALL PYKFDI(KFL1,0,KFL3,KF1) + IF(KF1.EQ.0) GOTO 150 + CALL PYKFDI(KFL2,-KFL3,KFLDUM,KF2) + IF(KF2.EQ.0) GOTO 150 + ELSE + KF1=KFH + KF2=111 + ENDIF + PM1=PYMASS(KF1) + PM2=PYMASS(KF2) + IF(PM1+PM2+PARJ(64).GT.PMMAS) GOTO 150 + K(N-1,2)=KF1 + K(N,2)=KF2 + P(N-1,5)=PM1 + P(N,5)=PM2 + PZP=SQRT(MAX(0D0,(PMMAS**2-PM1**2-PM2**2)**2- + & 4D0*PM1**2*PM2**2))/(2D0*PMMAS) + P(N-1,3)=PZP + P(N,3)=-PZP + P(N-1,4)=SQRT(PM1**2+PZP**2) + P(N,4)=SQRT(PM2**2+PZP**2) + CALL PYROBO(N-1,N,ACOS(2D0*PYR(0)-1D0),PARU(2)*PYR(0), + & 0D0,0D0,0D0) + DBETAZ=PZ*(-1)**(JT+1)/SQRT(PZ**2+PMMAS**2) + CALL PYROBO(N-1,N,0D0,0D0,0D0,0D0,DBETAZ) + +C...Diffracted particle: valence quark kicked out. + ELSEIF(MSTP(101).EQ.1.OR.(MSTP(101).EQ.3.AND.PYR(0).LT. + & PARP(101))) THEN + N=N+2 + K(N-1,1)=2 + K(N,1)=1 + K(N-1,3)=I+2 + K(N,3)=I+2 + MINT(105)=MINT(102+JT) + MINT(109)=MINT(106+JT) + CALL PYSPLI(KFH,21,K(N,2),K(N-1,2)) + P(N-1,5)=PYMASS(K(N-1,2)) + P(N,5)=PYMASS(K(N,2)) + SQLAM=(VINT(62+JT)-P(N-1,5)**2-P(N,5)**2)**2- + & 4D0*P(N-1,5)**2*P(N,5)**2 + P(N-1,3)=(PE*SQRT(SQLAM)+PZ*(VINT(62+JT)+P(N-1,5)**2- + & P(N,5)**2))/(2D0*VINT(62+JT))*(-1)**(JT+1) + P(N-1,4)=SQRT(P(N-1,3)**2+P(N-1,5)**2) + P(N,3)=PZ*(-1)**(JT+1)-P(N-1,3) + P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) + +C...Diffracted particle: gluon kicked out. + ELSE + N=N+3 + K(N-2,1)=2 + K(N-1,1)=2 + K(N,1)=1 + K(N-2,3)=I+2 + K(N-1,3)=I+2 + K(N,3)=I+2 + MINT(105)=MINT(102+JT) + MINT(109)=MINT(106+JT) + CALL PYSPLI(KFH,21,K(N,2),K(N-2,2)) + K(N-1,2)=21 + P(N-2,5)=PYMASS(K(N-2,2)) + P(N-1,5)=0D0 + P(N,5)=PYMASS(K(N,2)) +C...Energy distribution for particle into two jets. + 160 IMB=1 + IF(MOD(KFH/1000,10).NE.0) IMB=2 + CHIK=PARP(92+2*IMB) + IF(MSTP(92).LE.1) THEN + IF(IMB.EQ.1) CHI=PYR(0) + IF(IMB.EQ.2) CHI=1D0-SQRT(PYR(0)) + ELSEIF(MSTP(92).EQ.2) THEN + CHI=1D0-PYR(0)**(1D0/(1D0+CHIK)) + ELSEIF(MSTP(92).EQ.3) THEN + CUT=2D0*0.3D0/VINT(1) + 170 CHI=PYR(0)**2 + IF((CHI**2/(CHI**2+CUT**2))**0.25D0*(1D0-CHI)**CHIK.LT. + & PYR(0)) GOTO 170 + ELSEIF(MSTP(92).EQ.4) THEN + CUT=2D0*0.3D0/VINT(1) + CUTR=(1D0+SQRT(1D0+CUT**2))/CUT + 180 CHIR=CUT*CUTR**PYR(0) + CHI=(CHIR**2-CUT**2)/(2D0*CHIR) + IF((1D0-CHI)**CHIK.LT.PYR(0)) GOTO 180 + ELSE + CUT=2D0*0.3D0/VINT(1) + CUTA=CUT**(1D0-PARP(98)) + CUTB=(1D0+CUT)**(1D0-PARP(98)) + 190 CHI=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) + IF(((CHI+CUT)**2/(2D0*(CHI**2+CUT**2)))** + & (0.5D0*PARP(98))*(1D0-CHI)**CHIK.LT.PYR(0)) GOTO 190 + ENDIF + IF(CHI.LT.P(N,5)**2/VINT(62+JT).OR.CHI.GT.1D0-P(N-2,5)**2/ + & VINT(62+JT)) GOTO 160 + SQM=P(N-2,5)**2/(1D0-CHI)+P(N,5)**2/CHI + PZI=(PE*(VINT(62+JT)-SQM)+PZ*(VINT(62+JT)+SQM))/ + & (2D0*VINT(62+JT)) + PEI=SQRT(PZI**2+SQM) + PQQP=(1D0-CHI)*(PEI+PZI) + P(N-2,3)=0.5D0*(PQQP-P(N-2,5)**2/PQQP)*(-1)**(JT+1) + P(N-2,4)=SQRT(P(N-2,3)**2+P(N-2,5)**2) + P(N-1,4)=0.5D0*(VINT(62+JT)-SQM)/(PEI+PZI) + P(N-1,3)=P(N-1,4)*(-1)**JT + P(N,3)=PZI*(-1)**(JT+1)-P(N-2,3) + P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) + ENDIF + +C...Documentation lines. + K(I+2,1)=21 + IF(MINT(16+JT).EQ.0) K(I+2,2)=KFH + IF(MINT(16+JT).NE.0.OR.(MINT(10+JT).EQ.22.AND. + & MINT(106+JT).EQ.3)) K(I+2,2)=ISIGN(9900000,KFH)+10*(KFH/10) + K(I+2,3)=I + P(I+2,3)=PZ*(-1)**(JT+1) + P(I+2,4)=PE + P(I+2,5)=SQRT(VINT(62+JT)) + 200 CONTINUE + +C...Rotate outgoing partons/particles using cos(theta). + IF(VINT(23).LT.0.9D0) THEN + CALL PYROBO(MINT(83)+3,N,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) + ELSE + CALL PYROBO(MINT(83)+3,N,ASIN(VINT(59)),VINT(24),0D0,0D0,0D0) + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYDISG +C...Set up a DIS process as gamma* + f -> f, with beam remnant +C...and showering added consecutively. Photon flux by the PYGAGA +C...routine (if at all). + + SUBROUTINE PYDISG + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement to help give large particle numbers. + PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, + &KEXCIT=4000000,KDIMEN=5000000) +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ +C...Local arrays. + DIMENSION PMS(4) + +C...Choice of subprocess, number of documentation lines + IDOC=7 + MINT(3)=IDOC-6 + MINT(4)=IDOC + IPU1=MINT(84)+1 + IPU2=MINT(84)+2 + IPU3=MINT(84)+3 + ISIDE=1 + IF(MINT(107).EQ.4) ISIDE=2 + +C...Reset K, P and V vectors. Store incoming particles + DO 110 JT=1,MSTP(126)+20 + I=MINT(83)+JT + DO 100 J=1,5 + K(I,J)=0 + P(I,J)=0D0 + V(I,J)=0D0 + 100 CONTINUE + 110 CONTINUE + DO 130 JT=1,2 + I=MINT(83)+JT + K(I,1)=21 + K(I,2)=MINT(10+JT) + DO 120 J=1,5 + P(I,J)=VINT(285+5*JT+J) + 120 CONTINUE + 130 CONTINUE + MINT(6)=2 + +C...Store incoming partons in hadronic CM-frame + DO 140 JT=1,2 + I=MINT(84)+JT + K(I,1)=14 + K(I,2)=MINT(14+JT) + K(I,3)=MINT(83)+2+JT + 140 CONTINUE + IF(MINT(15).EQ.22) THEN + P(MINT(84)+1,3)=0.5D0*(VINT(1)+VINT(307)/VINT(1)) + P(MINT(84)+1,4)=0.5D0*(VINT(1)-VINT(307)/VINT(1)) + P(MINT(84)+1,5)=-SQRT(VINT(307)) + P(MINT(84)+2,3)=-0.5D0*VINT(307)/VINT(1) + P(MINT(84)+2,4)=0.5D0*VINT(307)/VINT(1) + KFRES=MINT(16) + ISIDE=2 + ELSE + P(MINT(84)+1,3)=0.5D0*VINT(308)/VINT(1) + P(MINT(84)+1,4)=0.5D0*VINT(308)/VINT(1) + P(MINT(84)+2,3)=-0.5D0*(VINT(1)+VINT(308)/VINT(1)) + P(MINT(84)+2,4)=0.5D0*(VINT(1)-VINT(308)/VINT(1)) + P(MINT(84)+1,5)=-SQRT(VINT(308)) + KFRES=MINT(15) + ISIDE=1 + ENDIF + SIDESG=(-1D0)**(ISIDE-1) + +C...Copy incoming partons to documentation lines. + DO 170 JT=1,2 + I1=MINT(83)+4+JT + I2=MINT(84)+JT + K(I1,1)=21 + K(I1,2)=K(I2,2) + K(I1,3)=I1-2 + DO 150 J=1,5 + P(I1,J)=P(I2,J) + 150 CONTINUE + +C...Second copy for partons before ISR shower, since no such. + I1=MINT(83)+2+JT + K(I1,1)=21 + K(I1,2)=K(I2,2) + K(I1,3)=I1-2 + DO 160 J=1,5 + P(I1,J)=P(I2,J) + 160 CONTINUE + 170 CONTINUE + +C...Define initial partons. + NTRY=0 + 180 NTRY=NTRY+1 + IF(NTRY.GT.100) THEN + MINT(51)=1 + RETURN + ENDIF + +C...Scattered quark in hadronic CM frame. + I=MINT(83)+7 + K(IPU3,1)=3 + K(IPU3,2)=KFRES + K(IPU3,3)=I + P(IPU3,5)=PYMASS(KFRES) + P(IPU3,3)=P(IPU1,3)+P(IPU2,3) + P(IPU3,4)=P(IPU1,4)+P(IPU2,4) + P(IPU3,5)=0D0 + K(I,1)=21 + K(I,2)=KFRES + K(I,3)=MINT(83)+4+ISIDE + P(I,3)=P(IPU3,3) + P(I,4)=P(IPU3,4) + P(I,5)=P(IPU3,5) + N=IPU3 + MINT(21)=KFRES + MINT(22)=0 + +C...No primordial kT, or chosen according to truncated Gaussian or +C...exponential, or (for photon) predetermined or power law. + 190 IF(MINT(40+ISIDE).EQ.2.AND.MINT(10+ISIDE).NE.22) THEN + IF(MSTP(91).LE.0) THEN + PT=0D0 + ELSEIF(MSTP(91).EQ.1) THEN + PT=PARP(91)*SQRT(-LOG(PYR(0))) + ELSE + RPT1=PYR(0) + RPT2=PYR(0) + PT=-PARP(92)*LOG(RPT1*RPT2) + ENDIF + IF(PT.GT.PARP(93)) GOTO 190 + ELSEIF(MINT(106+ISIDE).EQ.3) THEN + PTA=SQRT(VINT(282+ISIDE)) + PTB=0D0 + IF(MSTP(66).EQ.5.AND.MSTP(93).EQ.1) THEN + PTB=PARP(99)*SQRT(-LOG(PYR(0))) + ELSEIF(MSTP(66).EQ.5.AND.MSTP(93).EQ.2) THEN + RPT1=PYR(0) + RPT2=PYR(0) + PTB=-PARP(99)*LOG(RPT1*RPT2) + ENDIF + IF(PTB.GT.PARP(100)) GOTO 190 + PT=SQRT(PTA**2+PTB**2+2D0*PTA*PTB*COS(PARU(2)*PYR(0))) + IF(NTRY.GT.10) PT=PT*0.8D0**(NTRY-10) + ELSEIF(IABS(MINT(14+ISIDE)).LE.8.OR.MINT(14+ISIDE).EQ.21) THEN + IF(MSTP(93).LE.0) THEN + PT=0D0 + ELSEIF(MSTP(93).EQ.1) THEN + PT=PARP(99)*SQRT(-LOG(PYR(0))) + ELSEIF(MSTP(93).EQ.2) THEN + RPT1=PYR(0) + RPT2=PYR(0) + PT=-PARP(99)*LOG(RPT1*RPT2) + ELSEIF(MSTP(93).EQ.3) THEN + HA=PARP(99)**2 + HB=PARP(100)**2 + PT=SQRT(MAX(0D0,HA*(HA+HB)/(HA+HB-PYR(0)*HB)-HA)) + ELSE + HA=PARP(99)**2 + HB=PARP(100)**2 + IF(MSTP(93).EQ.5) HB=MIN(VINT(48),PARP(100)**2) + PT=SQRT(MAX(0D0,HA*((HA+HB)/HA)**PYR(0)-HA)) + ENDIF + IF(PT.GT.PARP(100)) GOTO 190 + ELSE + PT=0D0 + ENDIF + VINT(156+ISIDE)=PT + PHI=PARU(2)*PYR(0) + P(IPU3,1)=PT*COS(PHI) + P(IPU3,2)=PT*SIN(PHI) + P(IPU3,4)=SQRT(P(IPU3,5)**2+PT**2+P(IPU3,3)**2) + PMS(3-ISIDE)=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2 + PCP=P(IPU3,4)+ABS(P(IPU3,3)) + +C...Find one or two beam remnants. + MINT(105)=MINT(102+ISIDE) + MINT(109)=MINT(106+ISIDE) + CALL PYSPLI(MINT(10+ISIDE),MINT(12+ISIDE),KFLCH,KFLSP) + IF(MINT(51).NE.0) THEN + MINT(51)=0 + GOTO 180 + ENDIF + +C...Store first remnant parton, with colour info and kinematics. + I=N+1 + K(I,1)=1 + K(I,2)=KFLSP + K(I,3)=MINT(83)+ISIDE + P(I,5)=PYMASS(K(I,2)) + KCOL=KCHG(PYCOMP(KFLSP),2) + IF(KCOL.NE.0) THEN + K(I,1)=3 + KFLS=(3-KCOL*ISIGN(1,KFLSP))/2 + K(I,KFLS+3)=MSTU(5)*IPU3 + K(IPU3,6-KFLS)=MSTU(5)*I + ICOLR=I + ENDIF + IF(KFLCH.EQ.0) THEN + P(I,1)=-P(IPU3,1) + P(I,2)=-P(IPU3,2) + PMS(ISIDE)=P(I,5)**2+P(I,1)**2+P(I,2)**2 + P(I,3)=-P(IPU3,3) + P(I,4)=SQRT(PMS(ISIDE)+P(I,3)**2) + PRP=P(I,4)+ABS(P(I,3)) + +C...When extra remnant parton or hadron: store extra remnant. + ELSE + I=I+1 + K(I,1)=1 + K(I,2)=KFLCH + K(I,3)=MINT(83)+ISIDE + P(I,5)=PYMASS(K(I,2)) + KCOL=KCHG(PYCOMP(KFLCH),2) + IF(KCOL.NE.0) THEN + K(I,1)=3 + KFLS=(3-KCOL*ISIGN(1,KFLCH))/2 + K(I,KFLS+3)=MSTU(5)*IPU3 + K(IPU3,6-KFLS)=MSTU(5)*I + ICOLR=I + ENDIF + +C...Relative transverse momentum when two remnants. + LOOP=0 + 200 LOOP=LOOP+1 + CALL PYPTDI(1,P(I-1,1),P(I-1,2)) + P(I-1,1)=P(I-1,1)-0.5D0*P(IPU3,1) + P(I-1,2)=P(I-1,2)-0.5D0*P(IPU3,2) + PMS(3)=P(I-1,5)**2+P(I-1,1)**2+P(I-1,2)**2 + P(I,1)=-P(IPU3,1)-P(I-1,1) + P(I,2)=-P(IPU3,2)-P(I-1,2) + PMS(4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 + +C...Relative distribution of energy for particle into jet plus particle. + IMB=1 + IF(MOD(MINT(10+ISIDE)/1000,10).NE.0) IMB=2 + IF(MSTP(94).LE.1) THEN + IF(IMB.EQ.1) CHI=PYR(0) + IF(IMB.EQ.2) CHI=1D0-SQRT(PYR(0)) + IF(MOD(KFLCH/1000,10).NE.0) CHI=1D0-CHI + ELSEIF(MSTP(94).EQ.2) THEN + CHI=1D0-PYR(0)**(1D0/(1D0+PARP(93+2*IMB))) + IF(MOD(KFLCH/1000,10).NE.0) CHI=1D0-CHI + ELSEIF(MSTP(94).EQ.3) THEN + CALL PYZDIS(1,0,PMS(4),ZZ) + CHI=ZZ + ELSE + CALL PYZDIS(1000,0,PMS(4),ZZ) + CHI=ZZ + ENDIF + +C...Construct total transverse mass; reject if too large. + CHI=MAX(1D-8,MIN(1D0-1D-8,CHI)) + PMS(ISIDE)=PMS(4)/CHI+PMS(3)/(1D0-CHI) + IF(PMS(ISIDE).GT.P(IPU3,4)**2) THEN + IF(LOOP.LT.10) GOTO 200 + GOTO 180 + ENDIF + VINT(158+ISIDE)=CHI + +C...Subdivide longitudinal momentum according to value selected above. + PRP=SQRT(PMS(ISIDE)+P(IPU3,3)**2)+ABS(P(IPU3,3)) + PW1=(1D0-CHI)*PRP + P(I-1,4)=0.5D0*(PW1+PMS(3)/PW1) + P(I-1,3)=0.5D0*(PW1-PMS(3)/PW1)*SIDESG + PW2=CHI*PRP + P(I,4)=0.5D0*(PW2+PMS(4)/PW2) + P(I,3)=0.5D0*(PW2-PMS(4)/PW2)*SIDESG + ENDIF + N=I + +C...Boost current and remnant systems to correct frame. + IF(SQRT(PMS(1))+SQRT(PMS(2)).GT.0.99D0*VINT(1)) GOTO 180 + DSQLAM=SQRT(MAX(0D0,(VINT(2)-PMS(1)-PMS(2))**2-4D0*PMS(1)*PMS(2))) + DRKC=(VINT(2)+PMS(3-ISIDE)-PMS(ISIDE)+DSQLAM)/ + &(2D0*VINT(1)*PCP) + DRKR=(VINT(2)+PMS(ISIDE)-PMS(3-ISIDE)+DSQLAM)/ + &(2D0*VINT(1)*PRP) + DBEC=-SIDESG*(DRKC**2-1D0)/(DRKC**2+1D0) + DBER=SIDESG*(DRKR**2-1D0)/(DRKR**2+1D0) + CALL PYROBO(IPU3,IPU3,0D0,0D0,0D0,0D0,DBEC) + CALL PYROBO(IPU3+1,N,0D0,0D0,0D0,0D0,DBER) + +C...Let current quark shower; recoil but no showering by colour partner. + QMAX=2D0*SQRT(VINT(309-ISIDE)) + MSTJ48=MSTJ(48) + MSTJ(48)=1 + PARJ86=PARJ(86) + PARJ(86)=0D0 + IF(MSTP(71).EQ.1) CALL PYSHOW(IPU3,ICOLR,QMAX) + MSTJ(48)=MSTJ48 + PARJ(86)=PARJ86 + + RETURN + END + +C********************************************************************* + +C...PYDOCU +C...Handles the documentation of the process in MSTI and PARI, +C...and also computes cross-sections based on accumulated statistics. + + SUBROUTINE PYDOCU + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + SAVE /PYJETS/,/PYDAT1/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, + &/PYINT5/ + +C...Calculate Monte Carlo estimates of cross-sections. + ISUB=MINT(1) + IF(MSTP(111).NE.-1) NGEN(ISUB,3)=NGEN(ISUB,3)+1 + NGEN(0,3)=NGEN(0,3)+1 + XSEC(0,3)=0D0 + DO 100 I=1,500 + IF(I.EQ.96.OR.I.EQ.97) THEN + XSEC(I,3)=0D0 + ELSEIF(MSUB(95).EQ.1.AND.(I.EQ.11.OR.I.EQ.12.OR.I.EQ.13.OR. + & I.EQ.28.OR.I.EQ.53.OR.I.EQ.68)) THEN + XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1D0,DBLE(NGEN(96,1))* + & DBLE(NGEN(96,2))) + ELSEIF(MSUB(95).EQ.1.AND.I.GE.381.AND.I.LE.386) THEN + XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1D0,DBLE(NGEN(96,1))* + & DBLE(NGEN(96,2))) + ELSEIF(MSUB(I).EQ.0.OR.NGEN(I,1).EQ.0) THEN + XSEC(I,3)=0D0 + ELSEIF(NGEN(I,2).EQ.0) THEN + XSEC(I,3)=XSEC(I,2)*NGEN(0,3)/(DBLE(NGEN(I,1))* + & DBLE(NGEN(0,2))) + ELSE + XSEC(I,3)=XSEC(I,2)*NGEN(I,3)/(DBLE(NGEN(I,1))* + & DBLE(NGEN(I,2))) + ENDIF + XSEC(0,3)=XSEC(0,3)+XSEC(I,3) + 100 CONTINUE + +C...Rescale to known low-pT cross-section for standard QCD processes. + IF(MSUB(95).EQ.1) THEN + XSECH=XSEC(11,3)+XSEC(12,3)+XSEC(13,3)+XSEC(28,3)+XSEC(53,3)+ + & XSEC(68,3)+XSEC(95,3) + XSECW=XSEC(97,2)/MAX(1D0,DBLE(NGEN(97,1))) + IF(XSECH.GT.1D-20.AND.XSECW.GT.1D-20) THEN + FAC=XSECW/XSECH + XSEC(11,3)=FAC*XSEC(11,3) + XSEC(12,3)=FAC*XSEC(12,3) + XSEC(13,3)=FAC*XSEC(13,3) + XSEC(28,3)=FAC*XSEC(28,3) + XSEC(53,3)=FAC*XSEC(53,3) + XSEC(68,3)=FAC*XSEC(68,3) + XSEC(95,3)=FAC*XSEC(95,3) + XSEC(0,3)=XSEC(0,3)-XSECH+XSECW + ENDIF + ENDIF + +C...Save information for gamma-p and gamma-gamma. + IF(MINT(121).GT.1) THEN + IGA=MINT(122) + CALL PYSAVE(2,IGA) + CALL PYSAVE(5,0) + ENDIF + +C...Reset information on hard interaction. + DO 110 J=1,200 + MSTI(J)=0 + PARI(J)=0D0 + 110 CONTINUE + +C...Copy integer valued information from MINT into MSTI. + DO 120 J=1,32 + MSTI(J)=MINT(J) + 120 CONTINUE + IF(MINT(121).GT.1) MSTI(9)=MINT(122) + +C...Store cross-section variables in PARI. + PARI(1)=XSEC(0,3) + PARI(2)=XSEC(0,3)/MINT(5) + PARI(7)=VINT(97) + PARI(9)=VINT(99) + PARI(10)=VINT(100) + VINT(98)=VINT(98)+VINT(100) + IF(MSTP(142).EQ.1) PARI(2)=XSEC(0,3)/VINT(98) + +C...Store kinematics variables in PARI. + PARI(11)=VINT(1) + PARI(12)=VINT(2) + IF(ISUB.NE.95) THEN + DO 130 J=13,26 + PARI(J)=VINT(30+J) + 130 CONTINUE + PARI(29)=VINT(39) + PARI(30)=VINT(40) + PARI(31)=VINT(141) + PARI(32)=VINT(142) + PARI(33)=VINT(41) + PARI(34)=VINT(42) + PARI(35)=PARI(33)-PARI(34) + PARI(36)=VINT(21) + PARI(37)=VINT(22) + PARI(38)=VINT(26) + PARI(39)=VINT(157) + PARI(40)=VINT(158) + PARI(41)=VINT(23) + PARI(42)=2D0*VINT(47)/VINT(1) + ENDIF + +C...Store information on scattered partons in PARI. + IF(ISUB.NE.95.AND.MINT(7)*MINT(8).NE.0) THEN + DO 140 IS=7,8 + I=MINT(IS) + PARI(36+IS)=P(I,3)/VINT(1) + PARI(38+IS)=P(I,4)/VINT(1) + PR=MAX(1D-20,P(I,5)**2+P(I,1)**2+P(I,2)**2) + PARI(40+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ + & SQRT(PR),1D20)),P(I,3)) + PR=MAX(1D-20,P(I,1)**2+P(I,2)**2) + PARI(42+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ + & SQRT(PR),1D20)),P(I,3)) + PARI(44+IS)=P(I,3)/SQRT(1D-20+P(I,1)**2+P(I,2)**2+P(I,3)**2) + PARI(46+IS)=PYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) + PARI(48+IS)=PYANGL(P(I,1),P(I,2)) + 140 CONTINUE + ENDIF + +C...Store sum up transverse and longitudinal momenta. + PARI(65)=2D0*PARI(17) + IF(ISUB.LE.90.OR.ISUB.GE.95) THEN + DO 150 I=MSTP(126)+1,N + IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 + PT=SQRT(P(I,1)**2+P(I,2)**2) + PARI(69)=PARI(69)+PT + IF(I.LE.MINT(52)) PARI(66)=PARI(66)+PT + IF(I.GT.MINT(52).AND.I.LE.MINT(53)) PARI(68)=PARI(68)+PT + 150 CONTINUE + PARI(67)=PARI(68) + PARI(71)=VINT(151) + PARI(72)=VINT(152) + PARI(73)=VINT(151) + PARI(74)=VINT(152) + ELSE + PARI(66)=PARI(65) + PARI(69)=PARI(65) + ENDIF + +C...Store various other pieces of information into PARI. + PARI(61)=VINT(148) + PARI(75)=VINT(155) + PARI(76)=VINT(156) + PARI(77)=VINT(159) + PARI(78)=VINT(160) + PARI(81)=VINT(138) + +C...Store information on lepton -> lepton + gamma in PYGAGA. + MSTI(71)=MINT(141) + MSTI(72)=MINT(142) + PARI(101)=VINT(301) + PARI(102)=VINT(302) + DO 160 I=103,114 + PARI(I)=VINT(I+202) + 160 CONTINUE + +C...Set information for PYTABU. + IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN + MSTU(161)=MINT(21) + MSTU(162)=0 + ELSEIF(ISET(ISUB).EQ.5) THEN + MSTU(161)=MINT(23) + MSTU(162)=0 + ELSE + MSTU(161)=MINT(21) + MSTU(162)=MINT(22) + ENDIF + + RETURN + END + +C********************************************************************* + +C...PYFRAM +C...Performs transformations between different coordinate frames. + + SUBROUTINE PYFRAM(IFRAME) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + SAVE /PYDAT1/,/PYPARS/,/PYINT1/ + +C...Check that transformation can and should be done. + IF(IFRAME.EQ.1.OR.IFRAME.EQ.2.OR.(IFRAME.EQ.3.AND. + &MINT(91).EQ.1)) THEN + IF(IFRAME.EQ.MINT(6)) RETURN + ELSE + WRITE(MSTU(11),5000) IFRAME,MINT(6) + RETURN + ENDIF + + IF(MINT(6).EQ.1) THEN +C...Transform from fixed target or user specified frame to +C...overall CM frame. + CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) + CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) + CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) + ELSEIF(MINT(6).EQ.3) THEN +C...Transform from hadronic CM frame in DIS to overall CM frame. + CALL PYROBO(0,0,-VINT(221),-VINT(222),-VINT(223),-VINT(224), + & -VINT(225)) + ENDIF + + IF(IFRAME.EQ.1) THEN +C...Transform from overall CM frame to fixed target or user specified +C...frame. + CALL PYROBO(0,0,VINT(6),VINT(7),VINT(8),VINT(9),VINT(10)) + ELSEIF(IFRAME.EQ.3) THEN +C...Transform from overall CM frame to hadronic CM frame in DIS. + CALL PYROBO(0,0,0D0,0D0,VINT(223),VINT(224),VINT(225)) + CALL PYROBO(0,0,0D0,VINT(222),0D0,0D0,0D0) + CALL PYROBO(0,0,VINT(221),0D0,0D0,0D0,0D0) + ENDIF + +C...Set information about new frame. + MINT(6)=IFRAME + MSTI(6)=IFRAME + + 5000 FORMAT(1X,'Error: illegal values in subroutine PYFRAM.',1X, + &'No transformation performed.'/1X,'IFRAME =',1X,I5,'; MINT(6) =', + &1X,I5) + + RETURN + END + +C********************************************************************* + +C...PYWIDT +C...Calculates full and partial widths of resonances. + + SUBROUTINE PYWIDT(KFLR,SH,WDTP,WDTE) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Parameter statement to help give large particle numbers. + PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, + &KEXCIT=4000000,KDIMEN=5000000) +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT4/MWID(500),WIDS(500,5) + COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) + COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), + &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) + COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) + COMMON/PYPUED/IUED(0:99),RUED(0:99) + SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, + &/PYINT4/,/PYMSSM/,/PYSSMT/,/PYTCSM/,/PYPUED/ +C...Local arrays and saved variables. + COMPLEX*16 ZMIXC(4,4),AL,BL,AR,BR,FL,FR + DIMENSION WDTP(0:400),WDTE(0:400,0:5),MOFSV(3,2),WIDWSV(3,2), + &WID2SV(3,2),WDTPP(0:400),WDTEP(0:400,0:5) +C...UED: equivalences between ordered particles (451->475) +C...and UED particle code (5 000 000 + id) + PARAMETER(KKFLMI=451,KKFLMA=475) + DIMENSION CHIDEL(3), IUEDPR(25) + DIMENSION IUEDEQ(KKFLMA),MUED(2) + COMMON/SW1/SW21,CW21 + DATA (IUEDEQ(I),I=KKFLMI,KKFLMA)/ + & 6100001,6100002,6100003,6100004,6100005,6100006, + & 5100001,5100002,5100003,5100004,5100005,5100006, + & 6100011,6100013,6100015, + & 5100012,5100011,5100014,5100013,5100016,5100015, + & 5100021,5100022,5100023,5100024/ +C...Save local variables + SAVE MOFSV,WIDWSV,WID2SV +C...Initial values + DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/ + DATA CHIDEL/1.1D-03,1.D0,7.4D+2/ + DATA IUEDPR/25*0/ +C...UED: inline functions used in kk width calculus + FKAC1(X,Y)=1.-X**2/Y**2 + FKAC2(X,Y)=2.+X**2/Y**2 + +C...Compressed code and sign; mass. + KFLA=IABS(KFLR) + KFLS=ISIGN(1,KFLR) + KC=PYCOMP(KFLA) + SHR=SQRT(SH) + PMR=PMAS(KC,1) + +C...Reset width information. + DO 110 I=0,MDCY(KC,3) + WDTP(I)=0D0 + DO 100 J=0,5 + WDTE(I,J)=0D0 + 100 CONTINUE + 110 CONTINUE + +C...Allow for fudge factor to rescale resonance width. + FUDGE=1D0 + IF(MSTP(110).NE.0.AND.(MWID(KC).EQ.1.OR.MWID(KC).EQ.2.OR. + &(MWID(KC).EQ.3.AND.MINT(63).EQ.1))) THEN + IF(MSTP(110).EQ.KFLA) THEN + FUDGE=PARP(110) + ELSEIF(MSTP(110).EQ.-1) THEN + IF(KFLA.NE.6.AND.KFLA.NE.23.AND.KFLA.NE.24) FUDGE=PARP(110) + ELSEIF(MSTP(110).EQ.-2) THEN + FUDGE=PARP(110) + ENDIF + ENDIF + +C...Not to be treated as a resonance: return. + IF((MWID(KC).LE.0.OR.MWID(KC).GE.4).AND.KFLA.NE.21.AND. + &KFLA.NE.22) THEN + WDTP(0)=1D0 + WDTE(0,0)=1D0 + MINT(61)=0 + MINT(62)=0 + MINT(63)=0 + RETURN + +C...Treatment as a resonance based on tabulated branching ratios. + ELSEIF(MWID(KC).EQ.2.OR.(MWID(KC).EQ.3.AND.MINT(63).EQ.0)) THEN +C...Loop over possible decay channels; skip irrelevant ones. + DO 120 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 120 + +C...Read out decay products and nominal masses. + KFD1=KFDP(IDC,1) + KFC1=PYCOMP(KFD1) +C...Skip dummy modes or unrecognized particles + IF (KFD1.EQ.0.OR.KFC1.EQ.0) GOTO 120 + IF(KCHG(KFC1,3).EQ.1) KFD1=KFLS*KFD1 + PM1=PMAS(KFC1,1) + KFD2=KFDP(IDC,2) + KFC2=PYCOMP(KFD2) + IF(KCHG(KFC2,3).EQ.1) KFD2=KFLS*KFD2 + PM2=PMAS(KFC2,1) + KFD3=KFDP(IDC,3) + PM3=0D0 + IF(KFD3.NE.0) THEN + KFC3=PYCOMP(KFD3) + IF(KCHG(KFC3,3).EQ.1) KFD3=KFLS*KFD3 + PM3=PMAS(KFC3,1) + ENDIF + +C...Naive partial width and alternative threshold factors. + WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR) + IF(MDME(IDC,2).GE.51.AND.MDME(IDC,2).LE.53.AND. + & PM1+PM2+PM3.GE.SHR) THEN + WDTP(I)=0D0 + ELSEIF(MDME(IDC,2).EQ.52.AND.KFD3.EQ.0) THEN + WDTP(I)=WDTP(I)*SQRT(MAX(0D0,(SH-PM1**2-PM2**2)**2- + & 4D0*PM1**2*PM2**2))/SH + ELSEIF(MDME(IDC,2).EQ.52) THEN + PMA=MAX(PM1,PM2,PM3) + PMC=MIN(PM1,PM2,PM3) + PMB=PM1+PM2+PM3-PMA-PMC + PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMC-PMC) + PMAN=PMA**2/SH + PMBN=PMB**2/SH + PMCN=PMC**2/SH + PMBCN=PMBC**2/SH + WDTP(I)=WDTP(I)*SQRT(MAX(0D0, + & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* + & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* + & ((SHR-PMA)**2-(PMB+PMC)**2)* + & (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/ + & ((1D0-PMBCN)*PMBCN*SH) + ELSEIF(MDME(IDC,2).EQ.53.AND.KFD3.EQ.0) THEN + WDTP(I)=WDTP(I)*SQRT( + & MAX(0D0,(SH-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)/ + & MAX(1D-4,(PMR**2-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)) + ELSEIF(MDME(IDC,2).EQ.53) THEN + PMA=MAX(PM1,PM2,PM3) + PMC=MIN(PM1,PM2,PM3) + PMB=PM1+PM2+PM3-PMA-PMC + PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMB-PMC) + PMAN=PMA**2/SH + PMBN=PMB**2/SH + PMCN=PMC**2/SH + PMBCN=PMBC**2/SH + FACACT=SQRT(MAX(0D0, + & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* + & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* + & ((SHR-PMA)**2-(PMB+PMC)**2)* + & (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/ + & ((1D0-PMBCN)*PMBCN*SH) + PMBC=PMB+PMC+0.5D0*(PMR-PMA-PMB-PMC) + PMAN=PMA**2/PMR**2 + PMBN=PMB**2/PMR**2 + PMCN=PMC**2/PMR**2 + PMBCN=PMBC**2/PMR**2 + FACNOM=SQRT(MAX(0D0, + & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* + & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* + & ((PMR-PMA)**2-(PMB+PMC)**2)* + & (1D0+0.25D0*(PMA+PMB+PMC)/PMR)/ + & ((1D0-PMBCN)*PMBCN*PMR**2) + WDTP(I)=WDTP(I)*FACACT/MAX(1D-6,FACNOM) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + +C...Calculate secondary width (at most two identical/opposite). + WID2=1D0 + IF(MDME(IDC,1).GT.0) THEN + IF(KFD2.EQ.KFD1) THEN + IF(KCHG(KFC1,3).EQ.0) THEN + WID2=WIDS(KFC1,1) + ELSEIF(KFD1.GT.0) THEN + WID2=WIDS(KFC1,4) + ELSE + WID2=WIDS(KFC1,5) + ENDIF + IF(KFD3.GT.0) THEN + WID2=WID2*WIDS(KFC3,2) + ELSEIF(KFD3.LT.0) THEN + WID2=WID2*WIDS(KFC3,3) + ENDIF + ELSEIF(KFD2.EQ.-KFD1) THEN + WID2=WIDS(KFC1,1) + IF(KFD3.GT.0) THEN + WID2=WID2*WIDS(KFC3,2) + ELSEIF(KFD3.LT.0) THEN + WID2=WID2*WIDS(KFC3,3) + ENDIF + ELSEIF(KFD3.EQ.KFD1) THEN + IF(KCHG(KFC1,3).EQ.0) THEN + WID2=WIDS(KFC1,1) + ELSEIF(KFD1.GT.0) THEN + WID2=WIDS(KFC1,4) + ELSE + WID2=WIDS(KFC1,5) + ENDIF + IF(KFD2.GT.0) THEN + WID2=WID2*WIDS(KFC2,2) + ELSEIF(KFD2.LT.0) THEN + WID2=WID2*WIDS(KFC2,3) + ENDIF + ELSEIF(KFD3.EQ.-KFD1) THEN + WID2=WIDS(KFC1,1) + IF(KFD2.GT.0) THEN + WID2=WID2*WIDS(KFC2,2) + ELSEIF(KFD2.LT.0) THEN + WID2=WID2*WIDS(KFC2,3) + ENDIF + ELSEIF(KFD3.EQ.KFD2) THEN + IF(KCHG(KFC2,3).EQ.0) THEN + WID2=WIDS(KFC2,1) + ELSEIF(KFD2.GT.0) THEN + WID2=WIDS(KFC2,4) + ELSE + WID2=WIDS(KFC2,5) + ENDIF + IF(KFD1.GT.0) THEN + WID2=WID2*WIDS(KFC1,2) + ELSEIF(KFD1.LT.0) THEN + WID2=WID2*WIDS(KFC1,3) + ENDIF + ELSEIF(KFD3.EQ.-KFD2) THEN + WID2=WIDS(KFC2,1) + IF(KFD1.GT.0) THEN + WID2=WID2*WIDS(KFC1,2) + ELSEIF(KFD1.LT.0) THEN + WID2=WID2*WIDS(KFC1,3) + ENDIF + ELSE + IF(KFD1.GT.0) THEN + WID2=WIDS(KFC1,2) + ELSE + WID2=WIDS(KFC1,3) + ENDIF + IF(KFD2.GT.0) THEN + WID2=WID2*WIDS(KFC2,2) + ELSE + WID2=WID2*WIDS(KFC2,3) + ENDIF + IF(KFD3.GT.0) THEN + WID2=WID2*WIDS(KFC3,2) + ELSEIF(KFD3.LT.0) THEN + WID2=WID2*WIDS(KFC3,3) + ENDIF + ENDIF + +C...Store effective widths according to case. + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 120 CONTINUE +C...Return. + MINT(61)=0 + MINT(62)=0 + MINT(63)=0 + RETURN + ENDIF + +C...Here begins detailed dynamical calculation of resonance widths. +C...Shared treatment of Higgs states. + KFHIGG=25 + IHIGG=1 + IF(KFLA.EQ.35.OR.KFLA.EQ.36) THEN + KFHIGG=KFLA + IHIGG=KFLA-33 + ENDIF + +C...Common electroweak and strong constants. + XW=PARU(102) + XWV=XW + IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 + XW1=1D0-XW + AEM=PYALEM(SH) + IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) + AS=PYALPS(SH) + RADC=1D0+AS/PARU(1) + + IF(KFLA.EQ.6) THEN +C...t quark. + FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR + RADCT=1D0-2.5D0*AS/PARU(1) + DO 140 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 140 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140 + WID2=1D0 + IF(I.GE.4.AND.I.LE.7) THEN +C...t -> W + q; including approximate QCD correction factor. + WDTP(I)=FAC*VCKM(3,I-3)*RADCT* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) + IF(KFLR.GT.0) THEN + WID2=WIDS(24,2) + IF(I.EQ.7) WID2=WID2*WIDS(7,2) + ELSE + WID2=WIDS(24,3) + IF(I.EQ.7) WID2=WID2*WIDS(7,3) + ENDIF + ELSEIF(I.EQ.9) THEN +C...t -> H + b. + RM2R=PYMRUN(KFDP(IDC,2),SH)**2/SH + WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0+RM2-RM1)*(RM2R*PARU(141)**2+1D0/PARU(141)**2)+ + & 4D0*SQRT(RM2R*RM2)) + WID2=WIDS(37,2) + IF(KFLR.LT.0) WID2=WIDS(37,3) +CMRENNA++ + ELSEIF(I.GE.10.AND.I.LE.13.AND.IMSS(1).NE.0) THEN +C...t -> ~t + ~chi_i0, i = 1, 2, 3 or 4. + BETA=ATAN(RMSS(5)) + SINB=SIN(BETA) + TANW=SQRT(PARU(102)/(1D0-PARU(102))) + ET=KCHG(6,1)/3D0 + T3L=SIGN(0.5D0,ET) + KFC1=PYCOMP(KFDP(IDC,1)) + KFC2=PYCOMP(KFDP(IDC,2)) + PMNCHI=PMAS(KFC1,1) + PMSTOP=PMAS(KFC2,1) + IF(SHR.GT.PMNCHI+PMSTOP) THEN + IZ=I-9 + DO 130 IK=1,4 + ZMIXC(IZ,IK)=DCMPLX(ZMIX(IZ,IK),ZMIXI(IZ,IK)) + 130 CONTINUE + AL=SHR*DCONJG(ZMIXC(IZ,4))/(2.0D0*PMAS(24,1)*SINB) + AR=-ET*ZMIXC(IZ,1)*TANW + BL=T3L*(ZMIXC(IZ,2)-ZMIXC(IZ,1)*TANW)-AR + BR=AL + FL=SFMIX(6,1)*AL+SFMIX(6,2)*AR + FR=SFMIX(6,1)*BL+SFMIX(6,2)*BR + PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)* + & (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR) + WDTP(I)=(0.5D0*PYALEM(SH)/PARU(102))*PCM* + & ((ABS(FL)**2+ABS(FR)**2)*(SH+PMNCHI**2-PMSTOP**2)+ + & SMZ(IZ)*4D0*SHR*DBLE(FL*DCONJG(FR)))/SH + IF(KFLR.GT.0) THEN + WID2=WIDS(KFC1,2)*WIDS(KFC2,2) + ELSE + WID2=WIDS(KFC1,2)*WIDS(KFC2,3) + ENDIF + ENDIF + ELSEIF(I.EQ.14.AND.IMSS(1).NE.0) THEN +C...t -> ~g + ~t + KFC1=PYCOMP(KFDP(IDC,1)) + KFC2=PYCOMP(KFDP(IDC,2)) + PMNCHI=PMAS(KFC1,1) + PMSTOP=PMAS(KFC2,1) + IF(SHR.GT.PMNCHI+PMSTOP) THEN + RL=SFMIX(6,1) + RR=-SFMIX(6,2) + PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)* + & (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR) + WDTP(I)=4D0/3D0*0.5D0*PYALPS(SH)*PCM*((RL**2+RR**2)* + & (SH+PMNCHI**2-PMSTOP**2)+PMNCHI*4D0*SHR*RL*RR)/SH + IF(KFLR.GT.0) THEN + WID2=WIDS(KFC1,2)*WIDS(KFC2,2) + ELSE + WID2=WIDS(KFC1,2)*WIDS(KFC2,3) + ENDIF + ENDIF + ELSEIF(I.EQ.15.AND.IMSS(1).NE.0) THEN +C...t -> ~gravitino + ~t + XMP2=RMSS(29)**2 + KFC1=PYCOMP(KFDP(IDC,1)) + XMGR2=PMAS(KFC1,1)**2 + WDTP(I)=SH**2*SHR/(96D0*PARU(1)*XMP2*XMGR2)*(1D0-RM2)**4 + KFC2=PYCOMP(KFDP(IDC,2)) + WID2=WIDS(KFC2,2) + IF(KFLR.LT.0) WID2=WIDS(KFC2,3) +CMRENNA-- + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 140 CONTINUE + + ELSEIF(KFLA.EQ.7) THEN +C...b' quark. + FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR + DO 150 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 150 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 150 + WID2=1D0 + IF(I.GE.4.AND.I.LE.7) THEN +C...b' -> W + q. + WDTP(I)=FAC*VCKM(I-3,4)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) + IF(KFLR.GT.0) THEN + WID2=WIDS(24,3) + IF(I.EQ.6) WID2=WID2*WIDS(6,2) + IF(I.EQ.7) WID2=WID2*WIDS(8,2) + ELSE + WID2=WIDS(24,2) + IF(I.EQ.6) WID2=WID2*WIDS(6,3) + IF(I.EQ.7) WID2=WID2*WIDS(8,3) + ENDIF + WID2=WIDS(24,3) + IF(KFLR.LT.0) WID2=WIDS(24,2) + ELSEIF(I.EQ.9.OR.I.EQ.10) THEN +C...b' -> H + q. + WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) + IF(KFLR.GT.0) THEN + WID2=WIDS(37,3) + IF(I.EQ.10) WID2=WID2*WIDS(6,2) + ELSE + WID2=WIDS(37,2) + IF(I.EQ.10) WID2=WID2*WIDS(6,3) + ENDIF + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 150 CONTINUE + + ELSEIF(KFLA.EQ.8) THEN +C...t' quark. + FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR + DO 160 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 160 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 160 + WID2=1D0 + IF(I.GE.4.AND.I.LE.7) THEN +C...t' -> W + q. + WDTP(I)=FAC*VCKM(4,I-3)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) + IF(KFLR.GT.0) THEN + WID2=WIDS(24,2) + IF(I.EQ.7) WID2=WID2*WIDS(7,2) + ELSE + WID2=WIDS(24,3) + IF(I.EQ.7) WID2=WID2*WIDS(7,3) + ENDIF + ELSEIF(I.EQ.9.OR.I.EQ.10) THEN +C...t' -> H + q. + WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) + IF(KFLR.GT.0) THEN + WID2=WIDS(37,2) + IF(I.EQ.10) WID2=WID2*WIDS(7,2) + ELSE + WID2=WIDS(37,3) + IF(I.EQ.10) WID2=WID2*WIDS(7,3) + ENDIF + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 160 CONTINUE + + ELSEIF(KFLA.EQ.17) THEN +C...tau' lepton. + FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR + DO 170 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 170 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 170 + WID2=1D0 + IF(I.EQ.3) THEN +C...tau' -> W + nu'_tau. + WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) + IF(KFLR.GT.0) THEN + WID2=WIDS(24,3) + WID2=WID2*WIDS(18,2) + ELSE + WID2=WIDS(24,2) + WID2=WID2*WIDS(18,3) + ENDIF + ELSEIF(I.EQ.5) THEN +C...tau' -> H + nu'_tau. + WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) + IF(KFLR.GT.0) THEN + WID2=WIDS(37,3) + WID2=WID2*WIDS(18,2) + ELSE + WID2=WIDS(37,2) + WID2=WID2*WIDS(18,3) + ENDIF + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 170 CONTINUE + + ELSEIF(KFLA.EQ.18) THEN +C...nu'_tau neutrino. + FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR + DO 180 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 180 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 180 + WID2=1D0 + IF(I.EQ.2) THEN +C...nu'_tau -> W + tau'. + WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) + IF(KFLR.GT.0) THEN + WID2=WIDS(24,2) + WID2=WID2*WIDS(17,2) + ELSE + WID2=WIDS(24,3) + WID2=WID2*WIDS(17,3) + ENDIF + ELSEIF(I.EQ.3) THEN +C...nu'_tau -> H + tau'. + WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) + IF(KFLR.GT.0) THEN + WID2=WIDS(37,2) + WID2=WID2*WIDS(17,2) + ELSE + WID2=WIDS(37,3) + WID2=WID2*WIDS(17,3) + ENDIF + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 180 CONTINUE + + ELSEIF(KFLA.EQ.21) THEN +C...QCD: +C***Note that widths are not given in dimensional quantities here. + DO 190 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 190 + RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 190 + WID2=1D0 + IF(I.LE.8) THEN +C...QCD -> q + qbar + WDTP(I)=(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) + IF(I.EQ.6) WID2=WIDS(6,1) + IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 190 CONTINUE + + ELSEIF(KFLA.EQ.22) THEN +C...QED photon. +C***Note that widths are not given in dimensional quantities here. + DO 200 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 200 + RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 200 + WID2=1D0 + IF(I.LE.8) THEN +C...QED -> q + qbar. + EF=KCHG(I,1)/3D0 + FCOF=3D0*RADC + IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) + WDTP(I)=FCOF*EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) + IF(I.EQ.6) WID2=WIDS(6,1) + IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) + ELSEIF(I.LE.12) THEN +C...QED -> l+ + l-. + EF=KCHG(9+2*(I-8),1)/3D0 + WDTP(I)=EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) + IF(I.EQ.12) WID2=WIDS(17,1) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 200 CONTINUE + + ELSEIF(KFLA.EQ.23) THEN +C...Z0: + ICASE=1 + XWC=1D0/(16D0*XW*XW1) + FAC=(AEM*XWC/3D0)*SHR + 210 CONTINUE + IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN + VINT(111)=0D0 + VINT(112)=0D0 + VINT(114)=0D0 + ENDIF + IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN + KFI=IABS(MINT(15)) + IF(KFI.GT.20) KFI=IABS(MINT(16)) + EI=KCHG(KFI,1)/3D0 + AI=SIGN(1D0,EI) + VI=AI-4D0*EI*XWV + SQMZ=PMAS(23,1)**2 + HZ=SHR*WDTP(0) + IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=1D0 + IF(MSTP(43).EQ.3) VINT(112)= + & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) + IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= + & XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) + ENDIF + DO 220 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 220 + RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 220 + WID2=1D0 + IF(I.LE.8) THEN +C...Z0 -> q + qbar + EF=KCHG(I,1)/3D0 + AF=SIGN(1D0,EF+0.1D0) + VF=AF-4D0*EF*XWV + FCOF=3D0*RADC + IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) + IF(I.EQ.6) WID2=WIDS(6,1) + IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) + ELSEIF(I.LE.16) THEN +C...Z0 -> l+ + l-, nu + nubar + EF=KCHG(I+2,1)/3D0 + AF=SIGN(1D0,EF+0.1D0) + VF=AF-4D0*EF*XWV + FCOF=1D0 + IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) + ENDIF + BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) + IF(ICASE.EQ.1) THEN + WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* + & BE34 + ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN + WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* + & EF*VF+(VI**2+AI**2)*VINT(114)*VF**2)*(1D0+2D0*RM1)+ + & (VI**2+AI**2)*VINT(114)*AF**2*(1D0-4D0*RM1))*BE34 + ELSEIF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN + FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 + FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 + FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 + ENDIF + IF(ICASE.EQ.1) WDTP(I)=FUDGE*WDTP(I) + IF(ICASE.EQ.1) WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. + & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ + & WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN + IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)= + & VINT(111)+FGGF*WID2 + IF(MSTP(43).EQ.3) VINT(112)=VINT(112)+FGZF*WID2 + IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= + & VINT(114)+FZZF*WID2 + ENDIF + ENDIF + 220 CONTINUE + IF(MINT(61).GE.1) ICASE=3-ICASE + IF(ICASE.EQ.2) GOTO 210 + + ELSEIF(KFLA.EQ.24) THEN +C...W+/-: + FAC=(AEM/(24D0*XW))*SHR + DO 230 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 230 + RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 230 + WID2=1D0 + IF(I.LE.16) THEN +C...W+/- -> q + qbar' + FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1) + IF(KFLR.GT.0) THEN + IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) + IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) + IF(I.GE.13) WID2=WID2*WIDS(7,3) + ELSE + IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) + IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) + IF(I.GE.13) WID2=WID2*WIDS(7,2) + ENDIF + ELSEIF(I.LE.20) THEN +C...W+/- -> l+/- + nu + FCOF=1D0 + IF(KFLR.GT.0) THEN + IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) + ELSE + IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) + ENDIF + ENDIF + WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 230 CONTINUE + + ELSEIF(KFLA.EQ.25.OR.KFLA.EQ.35.OR.KFLA.EQ.36) THEN +C...h0 (or H0, or A0): + SHFS=SH + FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR + DO 270 I=1,MDCY(KFHIGG,3) + IDC=I+MDCY(KFHIGG,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 270 + KFC1=PYCOMP(KFDP(IDC,1)) + KFC2=PYCOMP(KFDP(IDC,2)) + RM1=PMAS(KFC1,1)**2/SH + RM2=PMAS(KFC2,1)**2/SH + IF(I.NE.16.AND.I.NE.17.AND.SQRT(RM1)+SQRT(RM2).GT.1D0) + & GOTO 270 + WID2=1D0 + + IF(I.LE.8) THEN +C...h0 -> q + qbar + WDTP(I)=FAC*3D0*(PYMRUN(KFDP(IDC,1),SH)**2/SHFS)* + & SQRT(MAX(0D0,1D0-4D0*RM1))*RADC +C...A0 behaves like beta, ho and H0 like beta**3. + IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1) + IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN + IF(MOD(I,2).EQ.1) WDTP(I)=WDTP(I)*PARU(151+10*IHIGG)**2 + IF(MOD(I,2).EQ.0) WDTP(I)=WDTP(I)*PARU(152+10*IHIGG)**2 + IF(IMSS(1).NE.0.AND.KFC1.EQ.5) THEN + WDTP(I)=WDTP(I)/(1D0+RMSS(41))**2 + IF(IHIGG.NE.3) THEN + WDTP(I)=WDTP(I)*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ + & PARU(151+10*IHIGG))**2 + ENDIF + ENDIF + ENDIF + IF(I.EQ.6) WID2=WIDS(6,1) + IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) + ELSEIF(I.LE.12) THEN +C...h0 -> l+ + l- + WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))*(SH/SHFS) +C...A0 behaves like beta, ho and H0 like beta**3. + IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1) + IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* + & PARU(153+10*IHIGG)**2 + IF(I.EQ.12) WID2=WIDS(17,1) + + ELSEIF(I.EQ.13) THEN +C...h0 -> g + g; quark loop contribution only + ETARE=0D0 + ETAIM=0D0 + DO 240 J=1,2*MSTP(1) + EPS=(2D0*PMAS(J,1))**2/SH +C...Loop integral; function of eps=4m^2/shat; different for A0. + IF(EPS.LE.1D0) THEN + IF(EPS.GT.1D-4) THEN + ROOT=SQRT(1D0-EPS) + RLN=LOG((1D0+ROOT)/(1D0-ROOT)) + ELSE + RLN=LOG(4D0/EPS-2D0) + ENDIF + PHIRE=-0.25D0*(RLN**2-PARU(1)**2) + PHIIM=0.5D0*PARU(1)*RLN + ELSE + PHIRE=(ASIN(1D0/SQRT(EPS)))**2 + PHIIM=0D0 + ENDIF + IF(IHIGG.LE.2) THEN + ETAREJ=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) + ETAIMJ=-0.5D0*EPS*(1D0-EPS)*PHIIM + ELSE + ETAREJ=-0.5D0*EPS*PHIRE + ETAIMJ=-0.5D0*EPS*PHIIM + ENDIF +C...Couplings (=1 for standard model Higgs). + IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN + IF(MOD(J,2).EQ.1) THEN + ETAREJ=ETAREJ*PARU(151+10*IHIGG) + ETAIMJ=ETAIMJ*PARU(151+10*IHIGG) + ELSE + ETAREJ=ETAREJ*PARU(152+10*IHIGG) + ETAIMJ=ETAIMJ*PARU(152+10*IHIGG) + ENDIF + ENDIF + ETARE=ETARE+ETAREJ + ETAIM=ETAIM+ETAIMJ + 240 CONTINUE + ETA2=ETARE**2+ETAIM**2 + WDTP(I)=FAC*(AS/PARU(1))**2*ETA2 + + ELSEIF(I.EQ.14) THEN +C...h0 -> gamma + gamma; quark, lepton, W+- and H+- loop contributions + ETARE=0D0 + ETAIM=0D0 + JMAX=3*MSTP(1)+1 + IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 + DO 250 J=1,JMAX + IF(J.LE.2*MSTP(1)) THEN + EJ=KCHG(J,1)/3D0 + EPS=(2D0*PMAS(J,1))**2/SH + ELSEIF(J.LE.3*MSTP(1)) THEN + JL=2*(J-2*MSTP(1))-1 + EJ=KCHG(10+JL,1)/3D0 + EPS=(2D0*PMAS(10+JL,1))**2/SH + ELSEIF(J.EQ.3*MSTP(1)+1) THEN + EPS=(2D0*PMAS(24,1))**2/SH + ELSE + EPS=(2D0*PMAS(37,1))**2/SH + ENDIF +C...Loop integral; function of eps=4m^2/shat. + IF(EPS.LE.1D0) THEN + IF(EPS.GT.1D-4) THEN + ROOT=SQRT(1D0-EPS) + RLN=LOG((1D0+ROOT)/(1D0-ROOT)) + ELSE + RLN=LOG(4D0/EPS-2D0) + ENDIF + PHIRE=-0.25D0*(RLN**2-PARU(1)**2) + PHIIM=0.5D0*PARU(1)*RLN + ELSE + PHIRE=(ASIN(1D0/SQRT(EPS)))**2 + PHIIM=0D0 + ENDIF + IF(J.LE.3*MSTP(1)) THEN +C...Fermion loops: loop integral different for A0; charges. + IF(IHIGG.LE.2) THEN + PHIPRE=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) + PHIPIM=-0.5D0*EPS*(1D0-EPS)*PHIIM + ELSE + PHIPRE=-0.5D0*EPS*PHIRE + PHIPIM=-0.5D0*EPS*PHIIM + ENDIF + IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN + EJC=3D0*EJ**2 + EJH=PARU(151+10*IHIGG) + ELSEIF(J.LE.2*MSTP(1)) THEN + EJC=3D0*EJ**2 + EJH=PARU(152+10*IHIGG) + ELSE + EJC=EJ**2 + EJH=PARU(153+10*IHIGG) + ENDIF + IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 + ETAREJ=EJC*EJH*PHIPRE + ETAIMJ=EJC*EJH*PHIPIM + ELSEIF(J.EQ.3*MSTP(1)+1) THEN +C...W loops: loop integral and charges. + ETAREJ=0.5D0+0.75D0*EPS*(1D0+(2D0-EPS)*PHIRE) + ETAIMJ=0.75D0*EPS*(2D0-EPS)*PHIIM + IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN + ETAREJ=ETAREJ*PARU(155+10*IHIGG) + ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) + ENDIF + ELSE +C...Charged H loops: loop integral and charges. + FACHHH=(PMAS(24,1)/PMAS(37,1))**2* + & PARU(158+10*IHIGG+2*(IHIGG/3)) + ETAREJ=EPS*(1D0-EPS*PHIRE)*FACHHH + ETAIMJ=-EPS**2*PHIIM*FACHHH + ENDIF + ETARE=ETARE+ETAREJ + ETAIM=ETAIM+ETAIMJ + 250 CONTINUE + ETA2=ETARE**2+ETAIM**2 + WDTP(I)=FAC*(AEM/PARU(1))**2*0.5D0*ETA2 + + ELSEIF(I.EQ.15) THEN +C...h0 -> gamma + Z0; quark, lepton, W and H+- loop contributions + ETARE=0D0 + ETAIM=0D0 + JMAX=3*MSTP(1)+1 + IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 + DO 260 J=1,JMAX + IF(J.LE.2*MSTP(1)) THEN + EJ=KCHG(J,1)/3D0 + AJ=SIGN(1D0,EJ+0.1D0) + VJ=AJ-4D0*EJ*XWV + EPS=(2D0*PMAS(J,1))**2/SH + EPSP=(2D0*PMAS(J,1)/PMAS(23,1))**2 + ELSEIF(J.LE.3*MSTP(1)) THEN + JL=2*(J-2*MSTP(1))-1 + EJ=KCHG(10+JL,1)/3D0 + AJ=SIGN(1D0,EJ+0.1D0) + VJ=AJ-4D0*EJ*XWV + EPS=(2D0*PMAS(10+JL,1))**2/SH + EPSP=(2D0*PMAS(10+JL,1)/PMAS(23,1))**2 + ELSE + EPS=(2D0*PMAS(24,1))**2/SH + EPSP=(2D0*PMAS(24,1)/PMAS(23,1))**2 + ENDIF +C...Loop integrals; functions of eps=4m^2/shat and eps'=4m^2/m_Z^2. + IF(EPS.LE.1D0) THEN + ROOT=SQRT(1D0-EPS) + IF(EPS.GT.1D-4) THEN + RLN=LOG((1D0+ROOT)/(1D0-ROOT)) + ELSE + RLN=LOG(4D0/EPS-2D0) + ENDIF + PHIRE=-0.25D0*(RLN**2-PARU(1)**2) + PHIIM=0.5D0*PARU(1)*RLN + PSIRE=0.5D0*ROOT*RLN + PSIIM=-0.5D0*ROOT*PARU(1) + ELSE + PHIRE=(ASIN(1D0/SQRT(EPS)))**2 + PHIIM=0D0 + PSIRE=SQRT(EPS-1D0)*ASIN(1D0/SQRT(EPS)) + PSIIM=0D0 + ENDIF + IF(EPSP.LE.1D0) THEN + ROOT=SQRT(1D0-EPSP) + IF(EPSP.GT.1D-4) THEN + RLN=LOG((1D0+ROOT)/(1D0-ROOT)) + ELSE + RLN=LOG(4D0/EPSP-2D0) + ENDIF + PHIREP=-0.25D0*(RLN**2-PARU(1)**2) + PHIIMP=0.5D0*PARU(1)*RLN + PSIREP=0.5D0*ROOT*RLN + PSIIMP=-0.5D0*ROOT*PARU(1) + ELSE + PHIREP=(ASIN(1D0/SQRT(EPSP)))**2 + PHIIMP=0D0 + PSIREP=SQRT(EPSP-1D0)*ASIN(1D0/SQRT(EPSP)) + PSIIMP=0D0 + ENDIF + FXYRE=EPS*EPSP/(8D0*(EPS-EPSP))*(1D0+EPS*EPSP/(EPS-EPSP)* + & (PHIRE-PHIREP)+2D0*EPS/(EPS-EPSP)*(PSIRE-PSIREP)) + FXYIM=EPS**2*EPSP/(8D0*(EPS-EPSP)**2)* + & (EPSP*(PHIIM-PHIIMP)+2D0*(PSIIM-PSIIMP)) + F1RE=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIRE-PHIREP) + F1IM=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIIM-PHIIMP) + IF(J.LE.3*MSTP(1)) THEN +C...Fermion loops: loop integral different for A0; charges. + IF(IHIGG.EQ.3) FXYRE=0D0 + IF(IHIGG.EQ.3) FXYIM=0D0 + IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN + EJC=-3D0*EJ*VJ + EJH=PARU(151+10*IHIGG) + ELSEIF(J.LE.2*MSTP(1)) THEN + EJC=-3D0*EJ*VJ + EJH=PARU(152+10*IHIGG) + ELSE + EJC=-EJ*VJ + EJH=PARU(153+10*IHIGG) + ENDIF + IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 + ETAREJ=EJC*EJH*(FXYRE-0.25D0*F1RE) + ETAIMJ=EJC*EJH*(FXYIM-0.25D0*F1IM) + ELSEIF(J.EQ.3*MSTP(1)+1) THEN +C...W loops: loop integral and charges. + HEPS=(1D0+2D0/EPS)*XW/XW1-(5D0+2D0/EPS) + ETAREJ=-XW1*((3D0-XW/XW1)*F1RE+HEPS*FXYRE) + ETAIMJ=-XW1*((3D0-XW/XW1)*F1IM+HEPS*FXYIM) + IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN + ETAREJ=ETAREJ*PARU(155+10*IHIGG) + ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) + ENDIF + ELSE +C...Charged H loops: loop integral and charges. + FACHHH=(PMAS(24,1)/PMAS(37,1))**2*(1D0-2D0*XW)* + & PARU(158+10*IHIGG+2*(IHIGG/3)) + ETAREJ=FACHHH*FXYRE + ETAIMJ=FACHHH*FXYIM + ENDIF + ETARE=ETARE+ETAREJ + ETAIM=ETAIM+ETAIMJ + 260 CONTINUE + ETA2=(ETARE**2+ETAIM**2)/(XW*XW1) + WDTP(I)=FAC*(AEM/PARU(1))**2*(1D0-PMAS(23,1)**2/SH)**3*ETA2 + WID2=WIDS(23,2) + + ELSEIF(I.LE.17) THEN +C...h0 -> Z0 + Z0, W+ + W- + PM1=PMAS(IABS(KFDP(IDC,1)),1) + PG1=PMAS(IABS(KFDP(IDC,1)),2) + IF(MINT(62).GE.1) THEN + IF(MSTP(42).EQ.0.OR.(4D0*(PM1+10D0*PG1)**2.LT.SH.AND. + & CKIN(46).LT.CKIN(45).AND.CKIN(48).LT.CKIN(47).AND. + & MAX(CKIN(45),CKIN(47)).LT.PM1-10D0*PG1)) THEN + MOFSV(IHIGG,I-15)=0 + WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, + & 1D0-4D0*RM1)) + WID2=1D0 + ELSE + MOFSV(IHIGG,I-15)=1 + RMAS=SQRT(MAX(0D0,SH)) + CALL PYOFSH(1,KFLA,KFDP(IDC,1),KFDP(IDC,2),RMAS,WIDW, + & WID2) + WIDWSV(IHIGG,I-15)=WIDW + WID2SV(IHIGG,I-15)=WID2 + ENDIF + ELSE + IF(MOFSV(IHIGG,I-15).EQ.0) THEN + WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, + & 1D0-4D0*RM1)) + WID2=1D0 + ELSE + WIDW=WIDWSV(IHIGG,I-15) + WID2=WID2SV(IHIGG,I-15) + ENDIF + ENDIF + WDTP(I)=FAC*WIDW/(2D0*(18-I)) + IF(MSTP(49).NE.0) WDTP(I)=WDTP(I)*PMAS(KFHIGG,1)**2/SHFS + IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* + & PARU(138+I+10*IHIGG)**2 + WID2=WID2*WIDS(7+I,1) + + ELSEIF(I.EQ.18.AND.IHIGG.GE.2) THEN +C...H0 -> Z0 + h0, A0-> Z0 + h0 + WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0, + & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + IF(IHIGG.EQ.2) THEN + WDTP(I)=WDTP(I)*PARU(179)**2 + ELSEIF(IHIGG.EQ.3) THEN + WDTP(I)=WDTP(I)*PARU(186)**2 + ENDIF + WID2=WIDS(23,2)*WIDS(25,2) + + ELSEIF(I.EQ.19.AND.IHIGG.GE.2) THEN +C...H0 -> h0 + h0, A0-> h0 + h0 + WDTP(I)=FAC*0.25D0* + & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) + IF(IHIGG.EQ.2) THEN + WDTP(I)=WDTP(I)*PARU(176)**2 + ELSEIF(IHIGG.EQ.3) THEN + WDTP(I)=WDTP(I)*PARU(169)**2 + ENDIF + WID2=WIDS(25,1) + ELSEIF((I.EQ.20.OR.I.EQ.21).AND.IHIGG.GE.2) THEN +C...H0 -> W+/- + H-/+, A0 -> W+/- + H-/+ + WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0, + & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + & *PARU(195+IHIGG)**2 + IF(I.EQ.20) THEN + WID2=WIDS(24,2)*WIDS(37,3) + ELSEIF(I.EQ.21) THEN + WID2=WIDS(24,3)*WIDS(37,2) + ENDIF + + ELSEIF(I.EQ.22.AND.IHIGG.EQ.2) THEN +C...H0 -> Z0 + A0. + WDTP(I)=FAC*0.5D0*PARU(187)**2*SQRT(MAX(0D0, + & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + WID2=WIDS(36,2)*WIDS(23,2) + + ELSEIF(I.EQ.23.AND.IHIGG.EQ.2) THEN +C...H0 -> h0 + A0. + WDTP(I)=FAC*0.5D0*PARU(180)**2* + & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) + WID2=WIDS(25,2)*WIDS(36,2) + + ELSEIF(I.EQ.24.AND.IHIGG.EQ.2) THEN +C...H0 -> A0 + A0 + WDTP(I)=FAC*0.25D0*PARU(177)**2* + & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) + WID2=WIDS(36,1) + +CMRENNA++ + ELSE +C...Add in SUSY decays (two-body) by rescaling by phase space factor. + RM10=RM1*SH/PMR**2 + RM20=RM2*SH/PMR**2 + WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20) + WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2) + IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN + WFAC=0D0 + ELSE + WFAC=WFAC/WFAC0 + ENDIF + WDTP(I)=PMAS(KFLA,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC) +CMRENNA-- + IF(KFC2.EQ.KFC1) THEN + WID2=WIDS(KFC1,1) + ELSE + KSGN1=2 + IF(KFDP(IDC,1).LT.0) KSGN1=3 + KSGN2=2 + IF(KFDP(IDC,2).LT.0) KSGN2=3 + WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2) + ENDIF + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 270 CONTINUE + + ELSEIF(KFLA.EQ.32) THEN +C...Z'0: + ICASE=1 + XWC=1D0/(16D0*XW*XW1) + FAC=(AEM*XWC/3D0)*SHR + VINT(117)=0D0 + 280 CONTINUE + IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN + VINT(111)=0D0 + VINT(112)=0D0 + VINT(113)=0D0 + VINT(114)=0D0 + VINT(115)=0D0 + VINT(116)=0D0 + ENDIF + IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN + KFAI=IABS(MINT(15)) + EI=KCHG(KFAI,1)/3D0 + AI=SIGN(1D0,EI+0.1D0) + VI=AI-4D0*EI*XWV + KFAIC=1 + IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2 + IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3 + IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4 + IF(KFAI.LE.2.OR.KFAI.EQ.11.OR.KFAI.EQ.12) THEN + VPI=PARU(119+2*KFAIC) + API=PARU(120+2*KFAIC) + ELSEIF(KFAI.LE.4.OR.KFAI.EQ.13.OR.KFAI.EQ.14) THEN + VPI=PARJ(178+2*KFAIC) + API=PARJ(179+2*KFAIC) + ELSE + VPI=PARJ(186+2*KFAIC) + API=PARJ(187+2*KFAIC) + ENDIF + SQMZ=PMAS(23,1)**2 + HZ=SHR*VINT(117) + SQMZP=PMAS(32,1)**2 + HZP=SHR*WDTP(0) + IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. + & MSTP(44).EQ.7) VINT(111)=1D0 + IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)= + & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) + IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)= + & 2D0*XWC*SH*(SH-SQMZP)/((SH-SQMZP)**2+HZP**2) + IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. + & MSTP(44).EQ.7) VINT(114)=XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) + IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)= + & 2D0*XWC**2*SH**2*((SH-SQMZ)*(SH-SQMZP)+HZ*HZP)/ + & (((SH-SQMZ)**2+HZ**2)*((SH-SQMZP)**2+HZP**2)) + IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. + & MSTP(44).EQ.7) VINT(116)=XWC**2*SH**2/((SH-SQMZP)**2+HZP**2) + ENDIF + DO 290 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 290 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0.OR.MDME(IDC,1).LT.0) GOTO 290 + WID2=1D0 + IF(I.LE.16) THEN + IF(I.LE.8) THEN +C...Z'0 -> q + qbar + EF=KCHG(I,1)/3D0 + AF=SIGN(1D0,EF+0.1D0) + VF=AF-4D0*EF*XWV + IF(I.LE.2) THEN + VPF=PARU(123-2*MOD(I,2)) + APF=PARU(124-2*MOD(I,2)) + ELSEIF(I.LE.4) THEN + VPF=PARJ(182-2*MOD(I,2)) + APF=PARJ(183-2*MOD(I,2)) + ELSE + VPF=PARJ(190-2*MOD(I,2)) + APF=PARJ(191-2*MOD(I,2)) + ENDIF + FCOF=3D0*RADC + IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF* + & PYHFTH(SH,SH*RM1,1D0) + IF(I.EQ.6) WID2=WIDS(6,1) + IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) + ELSEIF(I.LE.16) THEN +C...Z'0 -> l+ + l-, nu + nubar + EF=KCHG(I+2,1)/3D0 + AF=SIGN(1D0,EF+0.1D0) + VF=AF-4D0*EF*XWV + IF(I.LE.10) THEN + VPF=PARU(127-2*MOD(I,2)) + APF=PARU(128-2*MOD(I,2)) + ELSEIF(I.LE.12) THEN + VPF=PARJ(186-2*MOD(I,2)) + APF=PARJ(187-2*MOD(I,2)) + ELSE + VPF=PARJ(194-2*MOD(I,2)) + APF=PARJ(195-2*MOD(I,2)) + ENDIF + FCOF=1D0 + IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) + ENDIF + BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) + IF(ICASE.EQ.1) THEN + WDTPZ=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 + WDTP(I)=FAC*FCOF*(VPF**2*(1D0+2D0*RM1)+ + & APF**2*(1D0-4D0*RM1))*BE34 + ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN + WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* + & EF*VF+EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* + & VF**2+(VI*VPI+AI*API)*VINT(115)*VF*VPF+(VPI**2+API**2)* + & VINT(116)*VPF**2)*(1D0+2D0*RM1)+((VI**2+AI**2)*VINT(114)* + & AF**2+(VI*VPI+AI*API)*VINT(115)*AF*APF+(VPI**2+API**2)* + & VINT(116)*APF**2)*(1D0-4D0*RM1))*BE34 + ELSEIF(MINT(61).EQ.2) THEN + FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 + FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 + FGZPF=FCOF*EF*VPF*(1D0+2D0*RM1)*BE34 + FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 + FZZPF=FCOF*(VF*VPF*(1D0+2D0*RM1)+AF*APF*(1D0-4D0*RM1))* + & BE34 + FZPZPF=FCOF*(VPF**2*(1D0+2D0*RM1)+APF**2*(1D0-4D0*RM1))* + & BE34 + ENDIF + ELSEIF(I.EQ.17) THEN +C...Z'0 -> W+ + W- + WDTPZP=PARU(129)**2*XW1**2* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) + IF(ICASE.EQ.1) THEN + WDTPZ=0D0 + WDTP(I)=FAC*WDTPZP + ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN + WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP + ELSEIF(MINT(61).EQ.2) THEN + FGGF=0D0 + FGZF=0D0 + FGZPF=0D0 + FZZF=0D0 + FZZPF=0D0 + FZPZPF=WDTPZP + ENDIF + WID2=WIDS(24,1) + ELSEIF(I.EQ.18) THEN +C...Z'0 -> H+ + H- + CZC=2D0*(1D0-2D0*XW) + BE34C=(1D0-4D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) + IF(ICASE.EQ.1) THEN + WDTPZ=0.25D0*PARU(142)**2*CZC**2*BE34C + WDTP(I)=FAC*0.25D0*PARU(143)**2*CZC**2*BE34C + ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN + WDTP(I)=FAC*0.25D0*(EI**2*VINT(111)+PARU(142)*EI*VI* + & VINT(112)*CZC+PARU(143)*EI*VPI*VINT(113)*CZC+PARU(142)**2* + & (VI**2+AI**2)*VINT(114)*CZC**2+PARU(142)*PARU(143)* + & (VI*VPI+AI*API)*VINT(115)*CZC**2+PARU(143)**2* + & (VPI**2+API**2)*VINT(116)*CZC**2)*BE34C + ELSEIF(MINT(61).EQ.2) THEN + FGGF=0.25D0*BE34C + FGZF=0.25D0*PARU(142)*CZC*BE34C + FGZPF=0.25D0*PARU(143)*CZC*BE34C + FZZF=0.25D0*PARU(142)**2*CZC**2*BE34C + FZZPF=0.25D0*PARU(142)*PARU(143)*CZC**2*BE34C + FZPZPF=0.25D0*PARU(143)**2*CZC**2*BE34C + ENDIF + WID2=WIDS(37,1) + ELSEIF(I.EQ.19) THEN +C...Z'0 -> Z0 + gamma. + ELSEIF(I.EQ.20) THEN +C...Z'0 -> Z0 + h0 + FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + WDTPZP=PARU(145)**2*4D0*ABS(1D0-2D0*XW)* + & (3D0*RM1+0.25D0*FLAM**2)*FLAM + IF(ICASE.EQ.1) THEN + WDTPZ=0D0 + WDTP(I)=FAC*WDTPZP + ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN + WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP + ELSEIF(MINT(61).EQ.2) THEN + FGGF=0D0 + FGZF=0D0 + FGZPF=0D0 + FZZF=0D0 + FZZPF=0D0 + FZPZPF=WDTPZP + ENDIF + WID2=WIDS(23,2)*WIDS(25,2) + ELSEIF(I.EQ.21.OR.I.EQ.22) THEN +C...Z' -> h0 + A0 or H0 + A0. + BE34C=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + IF(I.EQ.21) THEN + CZAH=PARU(186) + CZPAH=PARU(188) + ELSE + CZAH=PARU(187) + CZPAH=PARU(189) + ENDIF + IF(ICASE.EQ.1) THEN + WDTPZ=CZAH**2*BE34C + WDTP(I)=FAC*CZPAH**2*BE34C + ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN + WDTP(I)=FAC*(CZAH**2*(VI**2+AI**2)*VINT(114)+CZAH*CZPAH* + & (VI*VPI+AI*API)*VINT(115)+CZPAH**2*(VPI**2+API**2)* + & VINT(116))*BE34C + ELSEIF(MINT(61).EQ.2) THEN + FGGF=0D0 + FGZF=0D0 + FGZPF=0D0 + FZZF=CZAH**2*BE34C + FZZPF=CZAH*CZPAH*BE34C + FZPZPF=CZPAH**2*BE34C + ENDIF + IF(I.EQ.21) WID2=WIDS(25,2)*WIDS(36,2) + IF(I.EQ.22) WID2=WIDS(35,2)*WIDS(36,2) + ENDIF + IF(ICASE.EQ.1) THEN + VINT(117)=VINT(117)+FAC*WDTPZ + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + ENDIF + IF(MDME(IDC,1).GT.0) THEN + IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. + & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ + & WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN + IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. + & MSTP(44).EQ.7) VINT(111)=VINT(111)+FGGF*WID2 + IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)=VINT(112)+ + & FGZF*WID2 + IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)=VINT(113)+ + & FGZPF*WID2 + IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. + & MSTP(44).EQ.7) VINT(114)=VINT(114)+FZZF*WID2 + IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)=VINT(115)+ + & FZZPF*WID2 + IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. + & MSTP(44).EQ.7) VINT(116)=VINT(116)+FZPZPF*WID2 + ENDIF + ENDIF + 290 CONTINUE + IF(MINT(61).GE.1) ICASE=3-ICASE + IF(ICASE.EQ.2) GOTO 280 + + ELSEIF(KFLA.EQ.34) THEN +C...W'+/-: + FAC=(AEM/(24D0*XW))*SHR + DO 300 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 300 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 300 + WID2=1D0 + IF(I.LE.20) THEN + IF(I.LE.16) THEN +C...W'+/- -> q + qbar' + FCOF=3D0*RADC*(PARU(131)**2+PARU(132)**2)* + & VCKM((I-1)/4+1,MOD(I-1,4)+1) + IF(KFLR.GT.0) THEN + IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) + IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) + IF(I.GE.13) WID2=WID2*WIDS(7,3) + ELSE + IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) + IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) + IF(I.GE.13) WID2=WID2*WIDS(7,2) + ENDIF + ELSEIF(I.LE.20) THEN +C...W'+/- -> l+/- + nu + FCOF=PARU(133)**2+PARU(134)**2 + IF(KFLR.GT.0) THEN + IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) + ELSE + IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) + ENDIF + ENDIF + WDTP(I)=FAC*FCOF*0.5D0*(2D0-RM1-RM2-(RM1-RM2)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + ELSEIF(I.EQ.21) THEN +C...W'+/- -> W+/- + Z0 + WDTP(I)=FAC*PARU(135)**2*0.5D0*XW1*(RM1/RM2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) + IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(23,2) + IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(23,2) + ELSEIF(I.EQ.23) THEN +C...W'+/- -> W+/- + h0 + FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + WDTP(I)=FAC*PARU(146)**2*2D0*(3D0*RM1+0.25D0*FLAM**2)*FLAM + IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) + IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 300 CONTINUE + + ELSEIF(KFLA.EQ.37) THEN +C...H+/-: +C IF(MSTP(49).EQ.0) THEN + SHFS=SH +C ELSE +C SHFS=PMAS(37,1)**2 +C ENDIF + FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR + DO 310 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 310 + KFC1=PYCOMP(KFDP(IDC,1)) + KFC2=PYCOMP(KFDP(IDC,2)) + RM1=PMAS(KFC1,1)**2/SH + RM2=PMAS(KFC2,1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 310 + WID2=1D0 + IF(I.LE.4) THEN +C...H+/- -> q + qbar' + RM1R=PYMRUN(KFDP(IDC,1),SH)**2/SH + RM2R=PYMRUN(KFDP(IDC,2),SH)**2/SH + WDTP(I)=FAC*3D0*RADC*MAX(0D0,(RM1R*PARU(141)**2+ + & RM2R/PARU(141)**2)*(1D0-RM1R-RM2R)-4D0*RM1R*RM2R)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS) + IF(KFLR.GT.0) THEN + IF(I.EQ.3) WID2=WIDS(6,2) + IF(I.EQ.4) WID2=WIDS(7,3)*WIDS(8,2) + ELSE + IF(I.EQ.3) WID2=WIDS(6,3) + IF(I.EQ.4) WID2=WIDS(7,2)*WIDS(8,3) + ENDIF + ELSEIF(I.LE.8) THEN +C...H+/- -> l+/- + nu + WDTP(I)=FAC*((RM1*PARU(141)**2+RM2/PARU(141)**2)* + & (1D0-RM1-RM2)-4D0*RM1*RM2)*SQRT(MAX(0D0, + & (1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS) + IF(KFLR.GT.0) THEN + IF(I.EQ.8) WID2=WIDS(17,3)*WIDS(18,2) + ELSE + IF(I.EQ.8) WID2=WIDS(17,2)*WIDS(18,3) + ENDIF + ELSEIF(I.EQ.9) THEN +C...H+/- -> W+/- + h0. + WDTP(I)=FAC*PARU(195)**2*0.5D0*SQRT(MAX(0D0, + & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) + IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) + +CMRENNA++ + ELSE +C...Add in SUSY decays (two-body) by rescaling by phase space factor. + RM10=RM1*SH/PMR**2 + RM20=RM2*SH/PMR**2 + WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20) + WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2) + IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN + WFAC=0D0 + ELSE + WFAC=WFAC/WFAC0 + ENDIF + WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC) +CMRENNA-- + KSGN1=2 + IF(KFLS*KFDP(IDC,1).LT.0.AND.KCHG(KFC1,3).EQ.1) KSGN1=3 + KSGN2=2 + IF(KFLS*KFDP(IDC,2).LT.0.AND.KCHG(KFC2,3).EQ.1) KSGN2=3 + WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 310 CONTINUE + + ELSEIF(KFLA.EQ.41) THEN +C...R: + FAC=(AEM/(12D0*XW))*SHR + DO 320 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 320 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 320 + WID2=1D0 + IF(I.LE.6) THEN +C...R -> q + qbar' + FCOF=3D0*RADC + ELSEIF(I.LE.9) THEN +C...R -> l+ + l'- + FCOF=1D0 + ENDIF + WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + IF(KFLR.GT.0) THEN + IF(I.EQ.4) WID2=WIDS(6,3) + IF(I.EQ.5) WID2=WIDS(7,3) + IF(I.EQ.6) WID2=WIDS(6,2)*WIDS(8,3) + IF(I.EQ.9) WID2=WIDS(17,3) + ELSE + IF(I.EQ.4) WID2=WIDS(6,2) + IF(I.EQ.5) WID2=WIDS(7,2) + IF(I.EQ.6) WID2=WIDS(6,3)*WIDS(8,2) + IF(I.EQ.9) WID2=WIDS(17,2) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 320 CONTINUE + + ELSEIF(KFLA.EQ.42) THEN +C...LQ (leptoquark). + FAC=(AEM/4D0)*PARU(151)*SHR + DO 330 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 330 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 330 + WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + WID2=1D0 + ILQQ=KFDP(IDC,1)*ISIGN(1,KFLR) + IF(ILQQ.GE.6) WID2=WIDS(ILQQ,2) + IF(ILQQ.LE.-6) WID2=WIDS(-ILQQ,3) + ILQL=KFDP(IDC,2)*ISIGN(1,KFLR) + IF(ILQL.GE.17) WID2=WID2*WIDS(ILQL,2) + IF(ILQL.LE.-17) WID2=WID2*WIDS(-ILQL,3) + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 330 CONTINUE + +C...UED: kk state width decays : flav: 451 476 + ELSEIF(IUED(1).EQ.1.AND. + & PYCOMP(ABS(KFLA)).GE.KKFLMI.AND. + & PYCOMP(ABS(KFLA)).LE.KKFLMA) THEN + KCLA=PYCOMP(KFLA) +C...q*_S,q*_D,l*_S,l*_D,gamma*,g*,Z*,W* + RMFLAS=PMAS(KCLA,1) + FACSH=SH/PMAS(KCLA,1)**2 + ALPHEM=PYALEM(RMFLAS**2) + ALPHS=PYALPS(RMFLAS**2) + +C...uedcor parameters (alpha_s is calculated at mkk scale) +C...alpha_em is calculated at z pole ! + ALPHEM=PARU(101) + FACSH=1. + + DO 1070 I=1,MDCY(KCLA,3) + IDC=I+MDCY(KCLA,2)-1 + + IF(MDME(IDC,1).LT.0) GOTO 1070 + KFC1=PYCOMP(ABS(KFDP(IDC,1))) + KFC2=PYCOMP(ABS(KFDP(IDC,2))) + RM1=PMAS(KFC1,1)**2/SH + RM2=PMAS(KFC2,1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) + & GOTO 1070 + WID2=1D0 + +C...N.B. RINV=RUED(1) + RMKK=RUED(1) + RMWKK=PMAS(475,1) + RMZKK=PMAS(474,1) + SW2=PARU(102) + CW2=1.-SW2 + KKCLA=KCLA-KKFLMI+1 + IF(ABS(KFC1).GE.KKFLMI)KKPART=KFC1 + IF(ABS(KFC2).GE.KKFLMI)KKPART=KFC2 + IF(KKCLA.LE.6) THEN +C...q*_S -> q + gamma* (in first time sw21=0) + FAC=0.25*ALPHEM*RMFLAS*0.5*CW21/CW2*KCHG(KCLA,1)**2/9. +C...Eventually change the following by enabling a choice of open or closed. +C...Only the gamma_kk channel is open. + IF(MOD(I,2).EQ.0) + + WDTP(I)=FAC*FKAC2(RMFLAS,RMKK)*FKAC1(RMKK,RMFLAS)**2 + WDTP(I)=FACSH*WDTP(I) + WID2=WIDS(473,2) + ELSEIF(KKCLA.GT.6.AND.KKCLA.LE.12)THEN +C...q*_D -> q + Z*/W* + FAC=0.25*ALPHEM*RMFLAS/(4.*SW2) + GAMMAW=FAC*FKAC2(RMFLAS,RMWKK)*FKAC1(RMWKK,RMFLAS)**2 + IF(I.EQ.1)THEN +C...q*_D -> q + Z* + WDTP(I)=0.5*GAMMAW + WID2=WIDS(474,2) + ELSEIF(I.EQ.2)THEN +C...q*_D -> q + W* + WDTP(I)=GAMMAW + WID2=WIDS(475,2) + ENDIF + WDTP(I)=FACSH*WDTP(I) +C...q*_D -> q + gamma* is closed + ELSEIF(KKCLA.GT.12.AND.KKCLA.LE.21)THEN +C...l*_S,l*_D -> gamma* + l*_S/l*_D(=nu_l,l) + FAC=ALPHEM/4.*RMFLAS/CW2/8. + RMGAKK=PMAS(473,1) + WDTP(I)=FAC*FKAC2(RMFLAS,RMGAKK)* + + FKAC1(RMGAKK,RMFLAS)**2 + WDTP(I)=FACSH*WDTP(I) + WID2=WIDS(473,2) + ELSEIF(KKCLA.EQ.22)THEN + RMQST=PMAS(KKPART,1) + WID2=WIDS(KKPART,2) +C...g* -> q*_S/q*_D + q + FAC=10.*ALPHS/12.*RMFLAS + WDTP(I)=FAC*FKAC1(RMQST,RMFLAS)**2*FKAC2(RMQST,RMFLAS) + WDTP(I)=FACSH*WDTP(I) + ELSEIF(KKCLA.EQ.23)THEN +C...gamma* decays to graviton + gamma : initial value is used + ICHI=IUED(4)/2 + WDTP(I)=RMFLAS*(RMFLAS/RUED(2))**(IUED(4)+2) + & *CHIDEL(ICHI) + ELSEIF(KKCLA.EQ.24)THEN +C...Z* -> l*_S + l is closed +C... Z* -> l*_D + l + IF(I.LE.3)GOTO 1070 +c... After closing the channels for a Z* decaying into positively charged +C... KK lepton singlets, close the channels for a Z* decaying into negatively +C... charged KK lepton singlets + positively charged SM particles + IF(I.GE.10.AND.I.LE.12)GOTO 1070 + FAC=3./2.*ALPHEM/24./SW2*RMZKK + RMLST=PMAS(KKPART,1) + WDTP(I)=FAC*FKAC1(RMLST,RMZKK)**2*FKAC2(RMLST,RMZKK) + WDTP(I)=FACSH*WDTP(I) + WID2=WIDS(KKPART,2) + ELSEIF(KKCLA.EQ.25)THEN +C...W* -> l*_D lbar + FAC=3.*ALPHEM/12./SW2*RMWKK + RMLST=PMAS(KKPART,1) + WDTP(I)=FAC*FKAC1(RMLST,RMWKK)**2*FKAC2(RMLST,RMWKK) + WDTP(I)=FACSH*WDTP(I) + WID2=WIDS(KKPART,2) + ENDIF + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 1070 CONTINUE + IUEDPR(KKCLA)=1 + + ELSEIF(KFLA.EQ.KTECHN+111.OR.KFLA.EQ.KTECHN+221) THEN +C...Techni-pi0 and techni-pi0': + FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR + DO 340 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 340 + PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) + PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) + RM1=PM1**2/SH + RM2=PM2**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 340 + WID2=1D0 +C...pi_tc -> g + g + IF(I.EQ.8) THEN + FACP=(AS/(4D0*PARU(1))*ITCM(1)/RTCM(1))**2 + & /(8D0*PARU(1))*SH*SHR + IF(KFLA.EQ.KTECHN+111) THEN + FACP=FACP*RTCM(9) + ELSE + FACP=FACP*RTCM(10) + ENDIF + WDTP(I)=FACP + ELSE +C...pi_tc -> f + fbar. + FCOF=1D0 + IKA=IABS(KFDP(IDC,1)) + IF(IKA.LT.10) FCOF=3D0*RADC + HM1=PM1 + HM2=PM2 + IF(IKA.GE.4.AND.IKA.LE.6) THEN + FCOF=FCOF*RTCM(1+IKA)**2 + HM1=PYMRUN(KFDP(IDC,1),SH) + HM2=PYMRUN(KFDP(IDC,2),SH) + ELSEIF(IKA.EQ.15) THEN + FCOF=FCOF*RTCM(8)**2 + ENDIF + WDTP(I)=FAC*FCOF*(HM1+HM2)**2* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 340 CONTINUE + + ELSEIF(KFLA.EQ.KTECHN+211) THEN +C...pi+_tc + FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR + DO 350 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 350 + PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) + PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) + PM3=0D0 + IF(I.EQ.5) PM3=PMAS(PYCOMP(KFDP(IDC,3)),1) + RM1=PM1**2/SH + RM2=PM2**2/SH + RM3=PM3**2/SH + IF(SQRT(RM1)+SQRT(RM2)+SQRT(RM3).GT.1D0) GOTO 350 + WID2=1D0 +C...pi_tc -> f + f'. + FCOF=1D0 + IF(IABS(KFDP(IDC,1)).LT.10) FCOF=3D0*RADC +C...pi_tc+ -> W b b~ + IF(I.EQ.5.AND.SHR.LT.PMAS(6,1)+PMAS(5,1)) THEN + FCOF=3D0*RADC + XMT2=PMAS(6,1)**2/SH + FACP=FAC/(4D0*PARU(1))*FCOF*XMT2*RTCM(7)**2 + KFC3=PYCOMP(KFDP(IDC,3)) + CHECK = SQRT(RM1)+SQRT(RM2)+SQRT(RM3) + CHECK = SQRT(RM1) + T0 = (1D0-CHECK**2)* + & (XMT2*(6D0*XMT2**2+3D0*XMT2*RM1-4D0*RM1**2)- + & (5D0*XMT2**2+2D0*XMT2*RM1-8D0*RM1**2))/(4D0*XMT2**2) + T1 = (1D0-XMT2)*(RM1-XMT2)*((XMT2**2+XMT2*RM1+4D0*RM1**2) + & -3D0*XMT2**2*(XMT2+RM1))/(2D0*XMT2**3) + T3 = RM1**2/XMT2**3*(3D0*XMT2-4D0*RM1+4D0*XMT2*RM1) + WDTP(I)=FACP*(T0 + T1*LOG((XMT2-CHECK**2)/(XMT2-1D0)) + & +T3*LOG(CHECK)) + IF(KFLR.GT.0) THEN + WID2=WIDS(24,2) + ELSE + WID2=WIDS(24,3) + ENDIF + ELSE + FCOF=1D0 + IKA=IABS(KFDP(IDC,1)) + IF(IKA.LT.10) FCOF=3D0*RADC + HM1=PM1 + HM2=PM2 + IF(I.GE.1.AND.I.LE.5) THEN + IF(I.LE.2) THEN + FCOF=FCOF*RTCM(5)**2 + ELSEIF(I.LE.4) THEN + FCOF=FCOF*RTCM(6)**2 + ELSEIF(I.EQ.5) THEN + FCOF=FCOF*RTCM(7)**2 + ENDIF + HM1=PYMRUN(KFDP(IDC,1),SH) + HM2=PYMRUN(KFDP(IDC,2),SH) + ELSEIF(I.EQ.8) THEN + FCOF=FCOF*RTCM(8)**2 + ENDIF + WDTP(I)=FAC*FCOF*(HM1+HM2)**2* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 350 CONTINUE + + ELSEIF(KFLA.EQ.KTECHN+331) THEN +C...Techni-eta. + FAC=(SH/PARP(46)**2)*SHR + DO 360 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 360 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 360 + WID2=1D0 + IF(I.LE.2) THEN + WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))/(4D0*PARU(1)) + IF(I.EQ.2) WID2=WIDS(6,1) + ELSE + WDTP(I)=FAC*5D0*AS**2/(96D0*PARU(1)**3) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 360 CONTINUE + + ELSEIF(KFLA.EQ.KTECHN+113) THEN +C...Techni-rho0: + ALPRHT=2.16D0*(3D0/ITCM(1)) + FAC=(ALPRHT/12D0)*SHR + FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR + SQMZ=PMAS(23,1)**2 + SQMW=PMAS(24,1)**2 + SHP=SH + CALL PYWIDX(23,SHP,WDTPP,WDTEP) + GMMZ=SHR*WDTPP(0) + XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) + BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) + BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) + DO 370 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 370 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 370 + WID2=1D0 + IF(I.EQ.1) THEN +C...rho_tc0 -> W+ + W-. +C... Multiplied by 2 for W^+_T W^-_L + W^+_L W^-_T + WDTP(I)=FAC*RTCM(3)**4* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ + & 2D0*AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* + & RTCM(3)**2/4D0/XW/24D0/RTCM(13)**2*SHR**3 + WID2=WIDS(24,1) + ELSEIF(I.EQ.2) THEN +C...rho_tc0 -> W+ + pi_tc-. +C... Multiplied by 2 for pi_T^+ W^-_T + pi_T^- W^+_T + WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ + & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*RM1)* + & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 + WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3) + ELSEIF(I.EQ.3) THEN +C...rho_tc0 -> pi_tc+ + W-. + WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ + & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*RM2)* + & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 + WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(24,3) + ELSEIF(I.EQ.4) THEN +C...rho_tc0 -> pi_tc+ + pi_tc-. + WDTP(I)=FAC*(1D0-RTCM(3)**2)**2* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + WID2=WIDS(PYCOMP(KTECHN+211),1) + ELSEIF(I.EQ.5) THEN +C...rho_tc0 -> gamma + pi_tc0 + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* + & SHR**3 + WID2=WIDS(PYCOMP(KTECHN+111),2) + ELSEIF(I.EQ.6) THEN +C...rho_tc0 -> gamma + pi_tc0' + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*SHR**3 + WID2=WIDS(PYCOMP(KTECHN+221),2) + ELSEIF(I.EQ.7) THEN +C...rho_tc0 -> Z0 + pi_tc0 + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* + & XW/XW1*SHR**3 + WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2) + ELSEIF(I.EQ.8) THEN +C...rho_tc0 -> Z0 + pi_tc0' + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/ + & XW/XW1*SHR**3 + WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2) + ELSEIF(I.EQ.9) THEN +C...rho_tc0 -> gamma + Z0 + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (2D0*RTCM(2)-1D0)**2*RTCM(3)**2/24D0/RTCM(12)**2*SHR**3 + WID2=WIDS(23,2) + ELSEIF(I.EQ.10) THEN +C...rho_tc0 -> Z0 + Z0 + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (2D0*RTCM(2)-1D0)**2*RTCM(3)**2*XW/XW1/24D0/RTCM(12)**2* + & SHR**3 + WID2=WIDS(23,1) + ELSE +C...rho_tc0 -> f + fbar. + WID2=1D0 + IF(I.LE.18) THEN + IA=I-10 + FCOF=3D0*RADC + IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1) + ELSE + IA=I-6 + FCOF=1D0 + IF(IA.GE.17) WID2=WIDS(IA,1) + ENDIF + EI=KCHG(IA,1)/3D0 + AI=SIGN(1D0,EI+0.1D0) + VI=AI-4D0*EI*XWV + VALI=0.5D0*(VI+AI) + VARI=0.5D0*(VI-AI) + WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)* + & ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ + & (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*( + & (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2)) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 370 CONTINUE + + ELSEIF(KFLA.EQ.KTECHN+213) THEN +C...Techni-rho+/-: + ALPRHT=2.16D0*(3D0/ITCM(1)) + FAC=(ALPRHT/12D0)*SHR + SQMZ=PMAS(23,1)**2 + SQMW=PMAS(24,1)**2 + SHP=SH + CALL PYWIDX(24,SHP,WDTPP,WDTEP) + GMMW=SHR*WDTPP(0) + FACF=(1D0/12D0)*(AEM**2/ALPRHT)*SHR* + & (0.125D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2) + DO 380 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 380 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 380 + WID2=1D0 + PCM=.5D0*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) +c WDTP(I)=AEM*PCM*(AA2*(PCM**2+1.5D0*RM1)+PCM**2*VA2) +c & /3D0*SHR**3 + IF(I.EQ.1) THEN +C...rho_tc+ -> W+ + Z0. +C......Goldstone + WDTP(I)=FAC*RTCM(3)**4* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + VA2=RTCM(3)**2*(2D0*RTCM(2)-1D0)**2*XW/XW1/RTCM(12)**2 + AA2=RTCM(3)**2/RTCM(13)**2/4D0/XW/XW1 +C......W_L Z_T + WDTP(I)=WDTP(I)+AEM*PCM*(AA2*(PCM**2+1.5D0*RM2)+PCM**2*VA2) + & /3D0*SHR**3 + VA2=0D0 + AA2=RTCM(3)**2/RTCM(13)**2/4D0/XW +C......W_T Z_L + WDTP(I)=WDTP(I)+AEM*PCM*(AA2*(PCM**2+1.5D0*RM1)+PCM**2*VA2) + & /3D0*SHR**3 + IF(KFLR.GT.0) THEN + WID2=WIDS(24,2)*WIDS(23,2) + ELSE + WID2=WIDS(24,3)*WIDS(23,2) + ENDIF + ELSEIF(I.EQ.2) THEN +C...rho_tc+ -> W+ + pi_tc0. + WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ + & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* + & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 + IF(KFLR.GT.0) THEN + WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+111),2) + ELSE + WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+111),2) + ENDIF + ELSEIF(I.EQ.3) THEN +C...rho_tc+ -> pi_tc+ + Z0. + WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ + & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* + & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMZ/SH)* + & (1D0-RTCM(3)**2)/4D0/XW/XW1/24D0/RTCM(13)**2*SHR**3+ + & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* + & SHR**3*XW/XW1 + IF(KFLR.GT.0) THEN + WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(23,2) + ELSE + WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(23,2) + ENDIF + ELSEIF(I.EQ.4) THEN +C...rho_tc+ -> pi_tc+ + pi_tc0. + WDTP(I)=FAC*(1D0-RTCM(3)**2)**2* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + IF(KFLR.GT.0) THEN + WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(PYCOMP(KTECHN+111),2) + ELSE + WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(PYCOMP(KTECHN+111),2) + ENDIF + ELSEIF(I.EQ.5) THEN +C...rho_tc+ -> pi_tc+ + gamma + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* + & SHR**3 + IF(KFLR.GT.0) THEN + WID2=WIDS(PYCOMP(KTECHN+211),2) + ELSE + WID2=WIDS(PYCOMP(KTECHN+211),3) + ENDIF + ELSEIF(I.EQ.6) THEN +C...rho_tc+ -> W+ + pi_tc0' + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (1D0-RTCM(4)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3 + IF(KFLR.GT.0) THEN + WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+221),2) + ELSE + WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+221),2) + ENDIF + ELSEIF(I.EQ.7) THEN +C...rho_tc+ -> W+ + gamma + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (2D0*RTCM(2)-1D0)**2*RTCM(3)**2/24D0/RTCM(12)**2*SHR**3 + IF(KFLR.GT.0) THEN + WID2=WIDS(24,2) + ELSE + WID2=WIDS(24,3) + ENDIF + ELSE +C...rho_tc+ -> f + fbar'. + IA=I-7 + WID2=1D0 + IF(IA.LE.16) THEN + FCOF=3D0*RADC*VCKM((IA-1)/4+1,MOD(IA-1,4)+1) + IF(KFLR.GT.0) THEN + IF(MOD(IA,4).EQ.3) WID2=WIDS(6,2) + IF(MOD(IA,4).EQ.0) WID2=WIDS(8,2) + IF(IA.GE.13) WID2=WID2*WIDS(7,3) + ELSE + IF(MOD(IA,4).EQ.3) WID2=WIDS(6,3) + IF(MOD(IA,4).EQ.0) WID2=WIDS(8,3) + IF(IA.GE.13) WID2=WID2*WIDS(7,2) + ENDIF + ELSE + FCOF=1D0 + IF(KFLR.GT.0) THEN + IF(IA.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) + ELSE + IF(IA.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) + ENDIF + ENDIF + WDTP(I)=FACF*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 380 CONTINUE + + ELSEIF(KFLA.EQ.KTECHN+223) THEN +C...Techni-omega: + ALPRHT=2.16D0*(3D0/ITCM(1)) + FAC=(ALPRHT/12D0)*SHR + FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR*(2D0*RTCM(2)-1D0)**2 + SQMZ=PMAS(23,1)**2 + SHP=SH + CALL PYWIDX(23,SHP,WDTPP,WDTEP) + GMMZ=SHR*WDTPP(0) + BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) + BWZI=-(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) + DO 390 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 390 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 390 + WID2=1D0 + IF(I.EQ.1) THEN +C...omega_tc0 -> gamma + pi_tc0. + WDTP(I)=AEM/24D0/RTCM(12)**2*(1D0-RTCM(3)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*SHR**3 + WID2=WIDS(PYCOMP(KTECHN+111),2) + ELSEIF(I.EQ.2) THEN +C...omega_tc0 -> Z0 + pi_tc0 + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (1D0-RTCM(3)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/ + & XW/XW1*SHR**3 + WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2) + ELSEIF(I.EQ.3) THEN +C...omega_tc0 -> gamma + pi_tc0' + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2* + & SHR**3 + WID2=WIDS(PYCOMP(KTECHN+221),2) + ELSEIF(I.EQ.4) THEN +C...omega_tc0 -> Z0 + pi_tc0' + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2* + & XW/XW1*SHR**3 + WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2) + ELSEIF(I.EQ.5) THEN +C...omega_tc0 -> W+ + pi_tc- + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+ + & FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3) + ELSEIF(I.EQ.6) THEN +C...omega_tc0 -> pi_tc+ + W- + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+ + & FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+211),2) + ELSEIF(I.EQ.7) THEN +C...omega_tc0 -> W+ + W-. +C... Multiplied by 2 for W^+_T W^-_L + W^+_L W^-_T + WDTP(I)=FAC*RTCM(3)**4*RTCM(11)**2* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ + & 2D0*AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & RTCM(3)**2/4D0/XW/24D0/RTCM(12)**2*SHR**3 + WID2=WIDS(24,1) + ELSEIF(I.EQ.8) THEN +C...omega_tc0 -> pi_tc+ + pi_tc-. + WDTP(I)=FAC*(1D0-RTCM(3)**2)**2*RTCM(11)**2* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 + WID2=WIDS(PYCOMP(KTECHN+211),1) +C...omega_tc0 -> gamma + Z0 + ELSEIF(I.EQ.9) THEN + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & RTCM(3)**2/24D0/RTCM(12)**2*SHR**3 + WID2=WIDS(23,2) +C...omega_tc0 -> Z0 + Z0 + ELSEIF(I.EQ.10) THEN + WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* + & RTCM(3)**2*(XW1-XW)**2/XW/XW1/4D0 + & /24D0/RTCM(12)**2*SHR**3 + WID2=WIDS(23,1) + ELSE +C...omega_tc0 -> f + fbar. + WID2=1D0 + IF(I.LE.18) THEN + IA=I-10 + FCOF=3D0*RADC + IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1) + ELSE + IA=I-8 + FCOF=1D0 + IF(IA.GE.17) WID2=WIDS(IA,1) + ENDIF + EI=KCHG(IA,1)/3D0 + AI=SIGN(1D0,EI+0.1D0) + VI=AI-4D0*EI*XWV + VALI=-0.5D0*(VI+AI) + VARI=-0.5D0*(VI-AI) + WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)* + & ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ + & (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*( + & (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2)) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 390 CONTINUE + +C.....V8 -> quark anti-quark + ELSEIF(KFLA.EQ.KTECHN+100021) THEN + FAC=AS/6D0*SHR + TANT3=RTCM(21) + IF(ITCM(2).EQ.0) THEN + IMDL=1 + ELSEIF(ITCM(2).EQ.1) THEN + IMDL=2 + ENDIF + DO 400 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 400 + PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) + RM1=PM1**2/SH + IF(RM1.GT.0.25D0) GOTO 400 + WID2=1D0 + IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN + FMIX=1D0/TANT3**2 + ELSE + FMIX=TANT3**2 + ENDIF + WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*FMIX + IF(I.EQ.6) WID2=WIDS(6,1) + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 400 CONTINUE + + ELSEIF(KFLA.EQ.KTECHN+100111.OR.KFLA.EQ.KTECHN+200111) THEN + FAC=(1D0/(4D0*PARU(1)*RTCM(1)**2))*SHR + CLEBF=0D0 + DO 410 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 410 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 410 + WID2=1D0 +C...pi_tc -> g + g + IF(I.EQ.7) THEN + IF(KFLA.EQ.KTECHN+100111) THEN + CLEBG=4D0/3D0 + ELSE + CLEBG=5D0/3D0 + ENDIF + FACP=(AS/(8D0*PARU(1))*ITCM(1)/RTCM(1))**2 + & /(2D0*PARU(1))*SH*SHR*CLEBG + WDTP(I)=FACP + ELSE +C...pi_tc -> f + fbar. + IF(I.EQ.6) WID2=WIDS(6,1) + FCOF=1D0 + IKA=IABS(KFDP(IDC,1)) + IF(IKA.LT.10) FCOF=3D0*RADC + HM1=PYMRUN(KFDP(IDC,1),SH) + WDTP(I)=FAC*FCOF*HM1**2*CLEBF* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 410 CONTINUE + + ELSEIF(KFLA.GE.KTECHN+100113.AND.KFLA.LE.KTECHN+400113) THEN + FAC=AS/6D0*SHR + ALPRHT=2.16D0*(3D0/ITCM(1)) + TANT3=RTCM(21) + SIN2T=2D0*TANT3/(TANT3**2+1D0) + SINT3=TANT3/SQRT(TANT3**2+1D0) + CSXPP=RTCM(22) + RM82=RTCM(27)**2 + X12=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*COS(RTCM(30))+ + & RTCM(31)*SQRT(1D0-RTCM(31)**2)*COS(RTCM(32)))/SQRT(2D0) + X21=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*SIN(RTCM(30))+ + & RTCM(31)*SQRT(1D0-RTCM(31)**2)*SIN(RTCM(32)))/SQRT(2D0) + X11=(.25D0*(RTCM(29)**2+RTCM(31)**2+2D0)- + & SINT3**2)*2D0 + X22=(.25D0*(2D0-RTCM(29)**2-RTCM(31)**2)- + & SINT3**2)*2D0 + CALL PYWIDX(KTECHN+100021,SH,WDTPP,WDTEP) + + IF(WDTPP(0).GT.RTCM(33)*SHR) WDTPP(0)=RTCM(33)*SHR + GMV8=SHR*WDTPP(0) + RMV8=PMAS(PYCOMP(KTECHN+100021),1) + FV8RE=SH*(SH-RMV8**2)/((SH-RMV8**2)**2+GMV8**2) + FV8IM=SH*GMV8/((SH-RMV8**2)**2+GMV8**2) + IF(ITCM(2).EQ.0) THEN + IMDL=1 + ELSE + IMDL=2 + ENDIF + DO 420 I=1,MDCY(KC,3) + IF(I.EQ.7.AND.(KFLA.EQ.KTECHN+200113.OR. + & KFLA.EQ.KTECHN+300113)) GOTO 420 + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 420 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 420 + WID2=1D0 + IF(I.LE.6) THEN + IF(I.EQ.6) WID2=WIDS(6,1) + XIG=1D0 + IF(KFLA.EQ.KTECHN+200113) THEN + XIG=0D0 + XIJ=X12 + ELSEIF(KFLA.EQ.KTECHN+300113) THEN + XIG=0D0 + XIJ=X21 + ELSEIF(KFLA.EQ.KTECHN+100113) THEN + XIJ=X11 + ELSE + XIJ=X22 + ENDIF + IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN + FMIX=1D0/TANT3/SIN2T + ELSE + FMIX=-TANT3/SIN2T + ENDIF + XFAC=(XIG+FMIX*XIJ*FV8RE)**2+(FMIX*XIJ*FV8IM)**2 + WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*AS/ALPRHT*XFAC + ELSEIF(I.EQ.7) THEN + WDTP(I)=SHR*AS**2/(4D0*ALPRHT) + ELSEIF(KFLA.EQ.KTECHN+400113.AND.I.LE.9) THEN + PSH=SHR*(1D0-RM1)/2D0 + WDTP(I)=AS/9D0*PSH**3/RM82 + IF(I.EQ.8) THEN + WDTP(I)=2D0*WDTP(I)*CSXPP**2 + WID2=WIDS(PYCOMP(KFDP(IDC,1)),2) + ELSE + WDTP(I)=5D0*WDTP(I) + WID2=WIDS(PYCOMP(KFDP(IDC,1)),2) + ENDIF + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 420 CONTINUE + + ELSEIF(KFLA.EQ.KEXCIT+1) THEN +C...d* excited quark. + FAC=(SH/RTCM(41)**2)*SHR + DO 430 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 430 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 430 + WID2=1D0 + IF(I.EQ.1) THEN +C...d* -> g + d. + WDTP(I)=FAC*AS*RTCM(45)**2/3D0 + WID2=1D0 + ELSEIF(I.EQ.2) THEN +C...d* -> gamma + d. + QF=-RTCM(43)/2D0+RTCM(44)/6D0 + WDTP(I)=FAC*AEM*QF**2/4D0 + WID2=1D0 + ELSEIF(I.EQ.3) THEN +C...d* -> Z0 + d. + QF=-RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0 + WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* + & (1D0-RM1)**2*(2D0+RM1) + WID2=WIDS(23,2) + ELSEIF(I.EQ.4) THEN +C...d* -> W- + u. + WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* + & (1D0-RM1)**2*(2D0+RM1) + IF(KFLR.GT.0) WID2=WIDS(24,3) + IF(KFLR.LT.0) WID2=WIDS(24,2) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 430 CONTINUE + + ELSEIF(KFLA.EQ.KEXCIT+2) THEN +C...u* excited quark. + FAC=(SH/RTCM(41)**2)*SHR + DO 440 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 440 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 440 + WID2=1D0 + IF(I.EQ.1) THEN +C...u* -> g + u. + WDTP(I)=FAC*AS*RTCM(45)**2/3D0 + WID2=1D0 + ELSEIF(I.EQ.2) THEN +C...u* -> gamma + u. + QF=RTCM(43)/2D0+RTCM(44)/6D0 + WDTP(I)=FAC*AEM*QF**2/4D0 + WID2=1D0 + ELSEIF(I.EQ.3) THEN +C...u* -> Z0 + u. + QF=RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0 + WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* + & (1D0-RM1)**2*(2D0+RM1) + WID2=WIDS(23,2) + ELSEIF(I.EQ.4) THEN +C...u* -> W+ + d. + WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* + & (1D0-RM1)**2*(2D0+RM1) + IF(KFLR.GT.0) WID2=WIDS(24,2) + IF(KFLR.LT.0) WID2=WIDS(24,3) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 440 CONTINUE + + ELSEIF(KFLA.EQ.KEXCIT+11) THEN +C...e* excited lepton. + FAC=(SH/RTCM(41)**2)*SHR + DO 450 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 450 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 450 + WID2=1D0 + IF(I.EQ.1) THEN +C...e* -> gamma + e. + QF=-RTCM(43)/2D0-RTCM(44)/2D0 + WDTP(I)=FAC*AEM*QF**2/4D0 + WID2=1D0 + ELSEIF(I.EQ.2) THEN +C...e* -> Z0 + e. + QF=-RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0 + WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* + & (1D0-RM1)**2*(2D0+RM1) + WID2=WIDS(23,2) + ELSEIF(I.EQ.3) THEN +C...e* -> W- + nu. + WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* + & (1D0-RM1)**2*(2D0+RM1) + IF(KFLR.GT.0) WID2=WIDS(24,3) + IF(KFLR.LT.0) WID2=WIDS(24,2) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 450 CONTINUE + + ELSEIF(KFLA.EQ.KEXCIT+12) THEN +C...nu*_e excited neutrino. + FAC=(SH/RTCM(41)**2)*SHR + DO 460 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 460 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 460 + WID2=1D0 + IF(I.EQ.1) THEN +C...nu*_e -> Z0 + nu*_e. + QF=RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0 + WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* + & (1D0-RM1)**2*(2D0+RM1) + WID2=WIDS(23,2) + ELSEIF(I.EQ.2) THEN +C...nu*_e -> W+ + e. + WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* + & (1D0-RM1)**2*(2D0+RM1) + IF(KFLR.GT.0) WID2=WIDS(24,2) + IF(KFLR.LT.0) WID2=WIDS(24,3) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 460 CONTINUE + + ELSEIF(KFLA.EQ.KDIMEN+39) THEN +C...G* (graviton resonance): + FAC=(PARP(50)**2/PARU(1))*SHR + DO 470 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 470 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 470 + WID2=1D0 + IF(I.LE.8) THEN +C...G* -> q + qbar + FCOF=3D0*RADC + IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF* + & PYHFTH(SH,SH*RM1,1D0) + WDTP(I)=FAC*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))**3* + & (1D0+8D0*RM1/3D0)/320D0 + IF(I.EQ.6) WID2=WIDS(6,1) + IF(I.EQ.7.OR.I.EQ.8) WID2=WIDS(I,1) + ELSEIF(I.LE.16) THEN +C...G* -> l+ + l-, nu + nubar + FCOF=1D0 + WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))**3* + & (1D0+8D0*RM1/3D0)/320D0 + IF(I.EQ.15.OR.I.EQ.16) WID2=WIDS(2+I,1) + ELSEIF(I.EQ.17) THEN +C...G* -> g + g. + WDTP(I)=FAC/20D0 + ELSEIF(I.EQ.18) THEN +C...G* -> gamma + gamma. + WDTP(I)=FAC/160D0 + ELSEIF(I.EQ.19) THEN +C...G* -> Z0 + Z0. + WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+ + & 14D0*RM1/3D0+4D0*RM1**2)/160D0 + WID2=WIDS(23,1) + ELSEIF(I.EQ.20) THEN +C...G* -> W+ + W-. + WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+ + & 14D0*RM1/3D0+4D0*RM1**2)/80D0 + WID2=WIDS(24,1) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 470 CONTINUE + + ELSEIF(KFLA.EQ.9900012.OR.KFLA.EQ.9900014.OR.KFLA.EQ.9900016) THEN +C...nu_eR, nu_muR, nu_tauR: righthanded Majorana neutrinos. + PMWR=MAX(1.001D0*SHR,PMAS(PYCOMP(9900024),1)) + FAC=(AEM**2/(768D0*PARU(1)*XW**2))*SHR**5/PMWR**4 + DO 480 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 480 + PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) + PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) + PM3=PMAS(PYCOMP(KFDP(IDC,3)),1) + IF(PM1+PM2+PM3.GE.SHR) GOTO 480 + WID2=1D0 + IF(I.LE.9) THEN +C...nu_lR -> l- qbar q' + FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1) + IF(MOD(I,3).EQ.0) WID2=WIDS(6,2) + ELSEIF(I.LE.18) THEN +C...nu_lR -> l+ q qbar' + FCOF=3D0*RADC*VCKM((I-10)/3+1,MOD(I-10,3)+1) + IF(MOD(I-9,3).EQ.0) WID2=WIDS(6,3) + ELSE +C...nu_lR -> l- l'+ nu_lR' + charge conjugate. + FCOF=1D0 + WID2=WIDS(PYCOMP(KFDP(IDC,3)),2) + ENDIF + X=(PM1+PM2+PM3)/SHR + FX=1D0-8D0*X**2+8D0*X**6-X**8-24D0*X**4*LOG(X) + Y=(SHR/PMWR)**2 + FY=(12D0*(1D0-Y)*LOG(1D0-Y)+12D0*Y-6D0*Y**2-2D0*Y**3)/Y**4 + WDTP(I)=FAC*FCOF*FX*FY + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 480 CONTINUE + + ELSEIF(KFLA.EQ.9900023) THEN +C...Z_R0: + FAC=(AEM/(48D0*XW*XW1*(1D0-2D0*XW)))*SHR + DO 490 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 490 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 490 + WID2=1D0 + SYMMET=1D0 + IF(I.LE.6) THEN +C...Z_R0 -> q + qbar + EF=KCHG(I,1)/3D0 + AF=SIGN(1D0,EF+0.1D0)*(1D0-2D0*XW) + VF=SIGN(1D0,EF+0.1D0)-4D0*EF*XW + FCOF=3D0*RADC + IF(I.EQ.6) WID2=WIDS(6,1) + ELSEIF(I.EQ.7.OR.I.EQ.10.OR.I.EQ.13) THEN +C...Z_R0 -> l+ + l- + AF=-(1D0-2D0*XW) + VF=-1D0+4D0*XW + FCOF=1D0 + ELSEIF(I.EQ.8.OR.I.EQ.11.OR.I.EQ.14) THEN +C...Z0 -> nu_L + nu_Lbar, assumed Majorana. + AF=-2D0*XW + VF=0D0 + FCOF=1D0 + SYMMET=0.5D0 + ELSEIF(I.LE.15) THEN +C...Z0 -> nu_R + nu_R, assumed Majorana. + AF=2D0*XW1 + VF=0D0 + FCOF=1D0 + WID2=WIDS(PYCOMP(KFDP(IDC,1)),1) + SYMMET=0.5D0 + ENDIF + WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* + & SQRT(MAX(0D0,1D0-4D0*RM1))*SYMMET + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 490 CONTINUE + + ELSEIF(KFLA.EQ.9900024) THEN +C...W_R+/-: + FAC=(AEM/(24D0*XW))*SHR + DO 500 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 500 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 500 + WID2=1D0 + IF(I.LE.9) THEN +C...W_R+/- -> q + qbar' + FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1) + IF(KFLR.GT.0) THEN + IF(MOD(I,3).EQ.0) WID2=WIDS(6,2) + ELSE + IF(MOD(I,3).EQ.0) WID2=WIDS(6,3) + ENDIF + ELSEIF(I.LE.12) THEN +C...W_R+/- -> l+/- + nu_R + FCOF=1D0 + ENDIF + WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 500 CONTINUE + + ELSEIF(KFLA.EQ.9900041) THEN +C...H_L++/--: + FAC=(1D0/(8D0*PARU(1)))*SHR + DO 510 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 510 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 510 + WID2=1D0 + IF(I.LE.6) THEN +C...H_L++/-- -> l+/- + l'+/- + FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+ + & (IABS(KFDP(IDC,2))-9)/2)**2 + IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF + ELSEIF(I.EQ.7) THEN +C...H_L++/-- -> W_L+/- + W_L+/- + FCOF=0.5D0*PARP(190)**4*PARP(192)**2/PMAS(24,1)**2* + & (3D0*RM1+0.25D0/RM1-1D0) + WID2=WIDS(24,4+(1-KFLS)/2) + ENDIF + WDTP(I)=FAC*FCOF* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 510 CONTINUE + + ELSEIF(KFLA.EQ.9900042) THEN +C...H_R++/--: + FAC=(1D0/(8D0*PARU(1)))*SHR + DO 520 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 520 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 520 + WID2=1D0 + IF(I.LE.6) THEN +C...H_R++/-- -> l+/- + l'+/- + FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+ + & (IABS(KFDP(IDC,2))-9)/2)**2 + IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF + ELSEIF(I.EQ.7) THEN +C...H_R++/-- -> W_R+/- + W_R+/- + FCOF=PARP(191)**2*(3D0*RM1+0.25D0/RM1-1D0) + WID2=WIDS(PYCOMP(9900024),4+(1-KFLS)/2) + ENDIF + WDTP(I)=FAC*FCOF* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 520 CONTINUE + + ELSEIF(KFLA.EQ.KTECHN+115) THEN +C...Techni-a2: +C...Need to update to alpha_rho + ALPRHT=2.16D0*(3D0/ITCM(1))*RTCM(47)**2 + FAC=(ALPRHT/12D0)*SHR + FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR + SQMZ=PMAS(23,1)**2 + SQMW=PMAS(24,1)**2 + SHP=SH + CALL PYWIDX(23,SHP,WDTPP,WDTEP) + GMMZ=SHR*WDTPP(0) + XWRHT=1D0/(4D0*XW*(1D0-XW)) + BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) + BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) + DO 530 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 530 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 530 + WID2=1D0 + PCM=.5D0*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + IF(I.LE.4) THEN + FACPV=PCM**2 + FACPA=PCM**2+1.5D0*RM1 + VA2=0D0 + AA2=0D0 +C...a2_tc0 -> W+ + W- + IF(I.EQ.1) THEN + AA2=2D0*RTCM(3)**2/4D0/XW/RTCM(49)**2 +C...Multiplied by 2 for W^+_T W^-_L + W^+_L W^-_T.(KL) + WID2=WIDS(24,1) +C...a2_tc0 -> W+ + pi_tc- + c.c. + ELSEIF(I.EQ.2.OR.I.EQ.3) THEN + AA2=(1D0-RTCM(3)**2)/4D0/XW/RTCM(49)**2 + IF(I.EQ.6) THEN + WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3) + ELSE + WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+211),2) + ENDIF + ELSEIF(I.EQ.4) THEN +C...a2_tc0 -> Z0 + pi_tc0' + VA2=(1D0-RTCM(4)**2)/4D0/XW/XW1/RTCM(48)**2 + WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2) + ENDIF + WDTP(I)=AEM*SHR**3*PCM/3D0*(VA2*FACPV+AA2*FACPA) + ELSEIF(I.GE.5.AND.I.LE.10) THEN + FACPV=PCM**2*(1D0+RM1+RM2)+3D0*RM1*RM2 + FACPA=PCM**2*(1D0+RM1+RM2) + VA2=0D0 + AA2=0D0 + IF(I.EQ.5) THEN +C...a_T^0 -> gamma rho_T^0 + VA2=(2D0*RTCM(2)-1D0)**2/RTCM(50)**4 + WID2=WIDS(PYCOMP(KTECHN+113),2) + ELSEIF(I.EQ.6) THEN +C...a_T^0 -> gamma omega_T + VA2=1D0/RTCM(50)**4 + WID2=WIDS(PYCOMP(KTECHN+223),2) + ELSEIF(I.EQ.7.OR.I.EQ.8) THEN +C...a_T^0 -> W^+- rho_T^-+ + AA2=.25D0/XW/RTCM(51)**4 + IF(I.EQ.7) THEN + WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+213),3) + ELSE + WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+213),2) + ENDIF + ELSEIF(I.EQ.9) THEN +C...a_T^0 -> Z^0 rho_T^0 + VA2=(2D0*RTCM(2)-1D0)**2*XW/XW1/RTCM(50)**4 + WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+113),2) + ELSEIF(I.EQ.10) THEN +C...a_T^0 -> Z^0 omega_T + VA2=.25D0*(1D0-2D0*XW)**2/XW/XW1/RTCM(50)**4 + WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+223),2) + ENDIF + WDTP(I)=AEM*SHR**5*PCM/12D0*(VA2*FACPV+AA2*FACPA) + ELSE +C...a2_tc0 -> f + fbar. + WID2=1D0 + IF(I.LE.18) THEN + IA=I-10 + FCOF=3D0*RADC + IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1) + ELSE + IA=I-8 + FCOF=1D0 + IF(IA.GE.17) WID2=WIDS(IA,1) + ENDIF + EI=KCHG(IA,1)/3D0 + AI=SIGN(1D0,EI+0.1D0) + VI=AI-4D0*EI*XWV + VALI=0.5D0*(VI+AI) + VARI=0.5D0*(VI-AI) + WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)* + & ((VALI*BWZR)**2+(VALI*BWZI)**2+ + & (VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*( + & (VALI*BWZR)*(VARI*BWZR)+VALI*VARI*BWZI**2)) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 530 CONTINUE + + ELSEIF(KFLA.EQ.KTECHN+215) THEN +C...Techni-a2+/-: + ALPRHT=2.16D0*(3D0/ITCM(1))*RTCM(47)**2 + FAC=(ALPRHT/12D0)*SHR + SQMZ=PMAS(23,1)**2 + SQMW=PMAS(24,1)**2 + SHP=SH + CALL PYWIDX(24,SHP,WDTPP,WDTEP) + GMMW=SHR*WDTPP(0) + FACF=(1D0/12D0)*(AEM**2/ALPRHT)*SHR* + & (0.125D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2) + DO 540 I=1,MDCY(KC,3) + IDC=I+MDCY(KC,2)-1 + IF(MDME(IDC,1).LT.0) GOTO 540 + RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH + RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH + IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 540 + WID2=1D0 + PCM=.5D0*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + IF(KFLR.GT.0) THEN + ICHANN=2 + ELSE + ICHANN=3 + ENDIF + IF(I.LE.7) THEN + AA2=0 + VA2=0 +C...a2_tc+ -> gamma + W+. + IF(I.EQ.1) THEN + AA2=RTCM(3)**2/RTCM(49)**2 + WID2=WIDS(24,ICHANN) +C...a2_tc+ -> gamma + pi_tc+. + ELSEIF(I.EQ.2) THEN + AA2=(1D0-RTCM(3)**2)/RTCM(49)**2 + WID2=WIDS(PYCOMP(KTECHN+211),ICHANN) +C...a2_tc+ -> W+ + Z + ELSEIF(I.EQ.3) THEN + AA2=RTCM(3)**2*(1D0/4D0/XW1 + + & (XW-XW1)**2/4./XW/XW1)/RTCM(49)**2 + WID2=WIDS(24,ICHANN)*WIDS(23,2) +C...a2_tc+ -> W+ + pi_tc0. + ELSEIF(I.EQ.4) THEN + AA2=(1D0-RTCM(3)**2)/4D0/XW/RTCM(49)**2 + WID2=WIDS(24,ICHANN)*WIDS(PYCOMP(KTECHN+111),2) +C...a2_tc+ -> W+ + pi_tc'0. + ELSEIF(I.EQ.5) THEN + VA2=(1D0-RTCM(4)**2)/4D0/XW/RTCM(48)**2 + WID2=WIDS(24,ICHANN)*WIDS(PYCOMP(KTECHN+221),2) +C...a2_tc+ -> Z0 + pi_tc+. + ELSEIF(I.EQ.6) THEN + AA2=(1D0-RTCM(3)**2)/4D0/XW/XW1*(1D0-2D0*XW)**2/ + & RTCM(49)**2 + WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+211),ICHANN) + ENDIF + WDTP(I)=AEM*PCM*(AA2*(PCM**2+1.5D0*RM1)+PCM**2*VA2) + & /3D0*SHR**3 + ELSEIF(I.LE.10) THEN + FACPV=PCM**2*(1D0+RM1+RM2)+3D0*RM1*RM2 + FACPA=PCM**2*(1D0+RM1+RM2) + VA2=0D0 + AA2=0D0 +C...a2_tc+ -> gamma + rho_tc+ + IF(I.EQ.7) THEN + VA2=(2D0*RTCM(2)-1D0)**2/RTCM(50)**4 + WID2=WIDS(PYCOMP(KTECHN+213),ICHANN) +C...a2_tc+ -> W+ + rho_T^0 + ELSEIF(I.EQ.8) THEN + AA2=1D0/(4D0*XW)/RTCM(51)**4 + WID2=WIDS(24,ICHANN)*WIDS(PYCOMP(KTECHN+113),2) +C...a2_tc+ -> W+ + omega_T + ELSEIF(I.EQ.9) THEN + VA2=.25D0/XW/RTCM(50)**4 + WID2=WIDS(24,ICHANN)*WIDS(PYCOMP(KTECHN+223),2) +C...a2_tc+ -> Z^0 + rho_T^+ + ELSEIF(I.EQ.10) THEN + VA2=(2D0*RTCM(2)-1D0)**2*XW/XW1/RTCM(50)**4 + AA2=1D0/(4D0*XW*XW1)/RTCM(51)**4 + WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+213),ICHANN) + ENDIF + WDTP(I)=AEM*SHR**5*PCM/12D0*(VA2*FACPV+AA2*FACPA) + ELSE +C...a2_tc+ -> f + fbar'. + IA=I-10 + WID2=1D0 + IF(IA.LE.16) THEN + FCOF=3D0*RADC*VCKM((IA-1)/4+1,MOD(IA-1,4)+1) + IF(KFLR.GT.0) THEN + IF(MOD(IA,4).EQ.3) WID2=WIDS(6,2) + IF(MOD(IA,4).EQ.0) WID2=WIDS(8,2) + IF(IA.GE.13) WID2=WID2*WIDS(7,3) + ELSE + IF(MOD(IA,4).EQ.3) WID2=WIDS(6,3) + IF(MOD(IA,4).EQ.0) WID2=WIDS(8,3) + IF(IA.GE.13) WID2=WID2*WIDS(7,2) + ENDIF + ELSE + FCOF=1D0 + IF(KFLR.GT.0) THEN + IF(IA.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) + ELSE + IF(IA.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) + ENDIF + ENDIF + WDTP(I)=FACF*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* + & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + ENDIF + WDTP(I)=FUDGE*WDTP(I) + WDTP(0)=WDTP(0)+WDTP(I) + IF(MDME(IDC,1).GT.0) THEN + WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 + WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) + WDTE(I,0)=WDTE(I,MDME(IDC,1)) + WDTE(0,0)=WDTE(0,0)+WDTE(I,0) + ENDIF + 540 CONTINUE + + ENDIF + MINT(61)=0 + MINT(62)=0 + MINT(63)=0 + RETURN + END + +C*********************************************************************** + +C...PYOFSH +C...Calculates partial width and differential cross-section maxima +C...of channels/processes not allowed on mass-shell, and selects +C...masses in such channels/processes. + + SUBROUTINE PYOFSH(MOFSH,KFMO,KFD1,KFD2,PMMO,RET1,RET2) + +C...Double precision and integer declarations. + IMPLICIT DOUBLE PRECISION(A-H, O-Z) + IMPLICIT INTEGER(I-N) + INTEGER PYK,PYCHGE,PYCOMP +C...Commonblocks. + COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) + COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) + COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) + COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) + COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) + COMMON/PYINT1/MINT(400),VINT(400) + COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) + COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) + SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, + &/PYINT2/,/PYINT5/ +C...Local arrays. + DIMENSION KFD(2),MBW(2),PMD(2),PGD(2),PMG(2),PML(2),PMU(2), + &PMH(2),ATL(2),ATU(2),ATH(2),RMG(2),INX1(100),XPT1(100), + &FPT1(100),INX2(100),XPT2(100),FPT2(100),WDTP(0:400), + &WDTE(0:400,0:5) + +C...Find if particles equal, maximum mass, matrix elements, etc. + MINT(51)=0 + ISUB=MINT(1) + KFD(1)=IABS(KFD1) + KFD(2)=IABS(KFD2) + MEQL=0 + IF(KFD(1).EQ.KFD(2)) MEQL=1 + MLM=0 + IF(MOFSH.GE.2.AND.MEQL.EQ.1) MLM=INT(1.5D0+PYR(0)) + IF(MOFSH.LE.2.OR.MOFSH.EQ.5) THEN + NOFF=44 + PMMX=PMMO + ELSE + NOFF=40 + PMMX=VINT(1) + IF(CKIN(2).GT.CKIN(1)) PMMX=MIN(CKIN(2),VINT(1)) + ENDIF + MMED=0 + IF((KFMO.EQ.25.OR.KFMO.EQ.35.OR.KFMO.EQ.36).AND.MEQL.EQ.1.AND. + &(KFD(1).EQ.23.OR.KFD(1).EQ.24)) MMED=1 + IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(1).EQ.23.OR. + &KFD(1).EQ.24).AND.(KFD(2).EQ.23.OR.KFD(2).EQ.24)) MMED=2 + IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(2).EQ.25.OR. + &KFD(2).EQ.35.OR.KFD(2).EQ.36)) MMED=3 + LOOP=1 + +C...Find where Breit-Wigners are required, else select discrete masses. + 100 DO 110 I=1,2 + KFCA=PYCOMP(KFD(I)) + IF(KFCA.GT.0) THEN + PMD(I)=PMAS(KFCA,1) + PGD(I)=PMAS(KFCA,2) + ELSE + PMD(I)=0D0 + PGD(I)=0D0 + ENDIF + IF(MSTP(42).LE.0.OR.PGD(I).LT.PARP(41)) THEN + MBW(I)=0 + PMG(I)=PMD(I) + RMG(I)=(PMG(I)/PMMX)**2 + ELSE + MBW(I)=1 + ENDIF + 110 CONTINUE + +C...Find allowed mass range and Breit-Wigner parameters. + DO 120 I=1,2 + IF(MOFSH.EQ.1.AND.LOOP.EQ.1.AND.MBW(I).EQ.1) THEN + PML(I)=PARP(42) + PMU(I)=PMMX-PARP(42) + IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) + IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 + ELSEIF(MBW(I).EQ.1.AND.MOFSH.NE.5) THEN + ILM=I + IF(MLM.EQ.2) ILM=3-I + PML(I)=MAX(CKIN(NOFF+2*ILM-1),PARP(42)) + IF(MBW(3-I).EQ.0) THEN + PMU(I)=PMMX-PMD(3-I) + ELSE + PMU(I)=PMMX-MAX(CKIN(NOFF+5-2*ILM),PARP(42)) + ENDIF + IF(CKIN(NOFF+2*ILM).GT.CKIN(NOFF+2*ILM-1)) PMU(I)= + & MIN(PMU(I),CKIN(NOFF+2*ILM)) + IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) + IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) + IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 + IF(MBW(I).EQ.1) THEN + ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) + ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) + IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* + & PGD(I))) + ENDIF + ELSEIF(MBW(I).EQ.1.AND.MOFSH.EQ.5) THEN + ILM=I + IF(MLM.EQ.2) ILM=3-I + PML(I)=MAX(CKIN(48+I),PARP(42)) + PMU(I)=PMMX-MAX(CKIN(51-I),PARP(42)) + IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) + IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) + IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) + IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 + IF(MBW(I).EQ.1) THEN + ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) + ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) + IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* + & PGD(I))) + ENDIF + ENDIF + 120 CONTINUE + IF(MBW(1).LT.0.OR.MBW(2).LT.0.OR.(MBW(1).EQ.0.AND.MBW(2).EQ.0)) + &THEN + CALL PYERRM(3,'(PYOFSH:) no allowed decay product masses') + MINT(51)=1 + RETURN + ENDIF + +C...Calculation of partial width of resonance. + IF(MOFSH.EQ.1) THEN + +C..If only one integration, pick that to be the inner. + IF(MBW(1).EQ.0) THEN + PM2=PMD(1) + PMD(1)=PMD(2) + PGD(1)=PGD(2) + PML(1)=PML(2) + PMU(1)=PMU(2) + ELSEIF(MBW(2).EQ.0) THEN + PM2=PMD(2) + ENDIF + +C...Start outer loop of integration. + IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN + ATL2=ATAN((PML(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) + ATU2=ATAN((PMU(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) + NPT2=1 + XPT2(1)=1D0 + INX2(1)=0 + FMAX2=0D0 + ENDIF + 130 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN + PM2S=PMD(2)**2+PMD(2)*PGD(2)*TAN(ATL2+XPT2(NPT2)*(ATU2-ATL2)) + PM2=MIN(PMU(2),MAX(PML(2),SQRT(MAX(0D0,PM2S)))) + ENDIF + RM2=(PM2/PMMX)**2 + +C...Start inner loop of integration. + PML1=PML(1) + PMU1=MIN(PMU(1),PMMX-PM2) + IF(MEQL.EQ.1) PMU1=MIN(PMU1,PM2) + ATL1=ATAN((PML1**2-PMD(1)**2)/(PMD(1)*PGD(1))) + ATU1=ATAN((PMU1**2-PMD(1)**2)/(PMD(1)*PGD(1))) + IF(PML1+PARJ(64).GE.PMU1.OR.ATL1+1D-7.GE.ATU1) THEN + FUNC2=0D0 + GOTO 180 + ENDIF + NPT1=1 + XPT1(1)=1D0 + INX1(1)=0 + FMAX1=0D0 + 140 PM1S=PMD(1)**2+PMD(1)*PGD(1)*TAN(ATL1+XPT1(NPT1)*(ATU1-ATL1)) + PM1=MIN(PMU1,MAX(PML1,SQRT(MAX(0D0,PM1S)))) + RM1=(PM1/PMMX)**2 + +C...Evaluate function value - inner loop. + FUNC1=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) + IF(MMED.EQ.1) FUNC1=FUNC1*((1D0-RM1-RM2)**2+8D0*RM1*RM2) + IF(MMED.EQ.2) FUNC1=FUNC1**3*(1D0+10D0*RM1+10D0*RM2+RM1**2+ + & RM2**2+10D0*RM1*RM2) + IF(FUNC1.GT.FMAX1) FMAX1=FUNC1 + FPT1(NPT1)=FUNC1 + +C...Go to next position in inner loop. + IF(NPT1.EQ.1) THEN + NPT1=NPT1+1 + XPT1(NPT1)=0D0 + INX1(NPT1)=1 + GOTO 140 + ELSEIF(NPT1.LE.8) THEN + NPT1=NPT1+1 + IF(NPT1.LE.4.OR.NPT1.EQ.6) ISH1=1 + ISH1=ISH1+1 + XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) + INX1(NPT1)=INX1(ISH1) + INX1(ISH1)=NPT1 + GOTO 140 + ELSEIF(NPT1.LT.100) THEN + ISN1=ISH1 + 150 ISH1=ISH1+1 + IF(ISH1.GT.NPT1) ISH1=2 + IF(ISH1.EQ.ISN1) GOTO 160 + DFPT1=ABS(FPT1(ISH1)-FPT1(INX1(ISH1))) + IF(DFPT1.LT.PARP(43)*FMAX1) GOTO 150 + NPT1=NPT1+1 + XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) + INX1(NPT1)=INX1(ISH1) + INX1(ISH1)=NPT1 + GOTO 140 + ENDIF + +C...Calculate integral over inner loop. + 160 FSUM1=0D0 + DO 170 IPT1=2,NPT1 + FSUM1=FSUM1+0.5D0*(FPT1(IPT1)+FPT1(INX1(IPT1)))* + & (XPT1(INX1(IPT1))-XPT1(IPT1)) + 170 CONTINUE + FUNC2=FSUM1*(ATU1-ATL1)/PARU(1) + 180 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN + IF(FUNC2.GT.FMAX2) FMAX2=FUNC2 + FPT2(NPT2)=FUNC2 + +C...Go to next position in outer loop. + IF(NPT2.EQ.1) THEN + NPT2=NPT2+1 + XPT2(NPT2)=0D0 + INX2(NPT2)=1 + GOTO 130 + ELSEIF(NPT2.LE.8) THEN + NPT2=NPT2+1 + IF(NPT2.LE.4.OR.NPT2.EQ.6) ISH2=1 + ISH2=ISH2+1 + XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) + INX2(NPT2)=INX2(ISH2) + INX2(ISH2)=NPT2 + GOTO 130 + ELSEIF(NPT2.LT.100) THEN + ISN2=ISH2 + 190 ISH2=ISH2+1 + IF(ISH2.GT.NPT2) ISH2=2 + IF(ISH2.EQ.ISN2) GOTO 200 + DFPT2=ABS(FPT2(ISH2)-FPT2(INX2(ISH2))) + IF(DFPT2.LT.PARP(43)*FMAX2) GOTO 190 + NPT2=NPT2+1 + XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) + INX2(NPT2)=INX2(ISH2) + INX2(ISH2)=NPT2 + GOTO 130 + ENDIF + +C...Calculate integral over outer loop. + 200 FSUM2=0D0 + DO 210 IPT2=2,NPT2 + FSUM2=FSUM2+0.5D0*(FPT2(IPT2)+FPT2(INX2(IPT2)))* + & (XPT2(INX2(IPT2))-XPT2(IPT2)) + 210 CONTINUE + FSUM2=FSUM2*(ATU2-ATL2)/PARU(1) + IF(MEQL.EQ.1) FSUM2=2D0*FSUM2 + ELSE + FSUM2=FUNC2 + ENDIF + +C...Save result; second integration for user-selected mass range. + IF(LOOP.EQ.1) WIDW=FSUM2 + WID2=FSUM2 + IF(LOOP.EQ.1.AND.(CKIN(46).GE.CKIN(45).OR.CKIN(48).GE.CKIN(47) + & .OR.MAX(CKIN(45),CKIN(47)).GE.1.01D0*PARP(42))) THEN + LOOP=2 + GOTO 100 + ENDIF + RET1=WIDW + RET2=WID2/WIDW + +C...Select two decay product masses of a resonance. + ELSEIF(MOFSH.EQ.2.OR.MOFSH.EQ.5) THEN + 220 DO 230 I=1,2 + IF(MBW(I).EQ.0) GOTO 230 + PMBW=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)* + & (ATU(I)-ATL(I))) + PMG(I)=MIN(PMU(I),MAX(PML(I),SQRT(MAX(0D0,PMBW)))) + RMG(I)=(PMG(I)/PMMX)**2 + 230 CONTINUE + IF((MEQL.EQ.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. + & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) GOTO 220 + +C...Weight with matrix element (if none known, use beta factor). + FLAM=SQRT(MAX(0D0,(1D0-RMG(1)-RMG(2))**2-4D0*RMG(1)*RMG(2))) + IF(MMED.EQ.1) THEN + WTBE=FLAM*((1D0-RMG(1)-RMG(2))**2+8D0*RMG(1)*RMG(2)) + ELSEIF(MMED.EQ.2) THEN + WTBE=FLAM**3*(1D0+10D0*RMG(1)+10D0*RMG(2)+RMG(1)**2+ + & RMG(2)**2+10D0*RMG(1)*RMG(2)) + ELSEIF(MMED.EQ.3) THEN + WTBE=FLAM*(RMG(1)+FLAM**2/12D0) + ELSE + WTBE=FLAM + ENDIF + IF(WTBE.LT.PYR(0)) GOTO 220 + RET1=PMG(1) + RET2=PMG(2) + +C...Find suitable set of masses for initialization of 2 -> 2 processes. + ELSEIF(MOFSH.EQ.3) THEN + IF(MBW(1).NE.0.AND.MBW(2).EQ.0) THEN + PMG(1)=MIN(PMD(1),0.5D0*(PML(1)+PMU(1))) + PMG(2)=PMD(2) + ELSEIF(MBW(2).NE.0.AND.MBW(1).EQ.0) THEN + PMG(1)=PMD(1) + PMG(2)=MIN(PMD(2),0.5D0*(PML(2)+PMU(2))) + ELSE + IDIV=-1 + 240 IDIV=IDIV+1 + PMG(1)=MIN(PMD(1),0.1D0*(IDIV*PML(1)+(10-IDIV)*PMU(1))) + PMG(2)=MIN(PMD(2),0.1D0*(IDIV*PML(2)+(10-IDIV)*PMU(2))) + IF(IDIV.LE.9.AND.PMG(1)+PMG(2).GT.0.9D0*PMMX) GOTO 240 + ENDIF + RET1=PMG(1) + RET2=PMG(2) + +C...Evaluate importance of excluded tails of Breit-Wigners. + IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) + & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 + IF(MEQL.LE.1) THEN + VINT(80)=1D0 + DO 250 I=1,2 + IF(MBW(I).NE.0) VINT(80)=VINT(80)*1.25D0*(ATU(I)-ATL(I))/ + & PARU(1) + 250 CONTINUE + ELSE + VINT(80)=(1.25D0/PARU(1))**2*MAX((ATU(1)-ATL(1))* + & (ATH(2)-ATL(2)),(ATH(1)-ATL(1))*(ATU(2)-ATL(2))) + ENDIF + IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.30.OR.ISUB.EQ.35).AND. + & MSTP(43).NE.2) VINT(80)=2D0*VINT(80) + IF(ISUB.EQ.22.AND.MSTP(43).NE.2) VINT(80)=4D0*VINT(80) + IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) + +C...Pick one particle to be the lighter (if improves efficiency). + ELSEIF(MOFSH.EQ.4) THEN + IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) + & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 + 260 IF(MEQL.EQ.2) MLM=INT(1.5D0+PYR(0)) + +C...Select two masses according to Breit-Wigner + flat in s + 1/s. + DO 270 I=1,2 + IF(MBW(I).EQ.0) GOTO 270 + PMV=PMU(I) + IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) + ATV=ATU(I) + IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) + RBR=PYR(0) + IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. + & ISUB.EQ.35).AND.MSTP(43).NE.2) RBR=2D0*RBR + IF(RBR.LT.0.8D0) THEN + PMSR=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)*(ATV-ATL(I))) + PMG(I)=MIN(PMV,MAX(PML(I),SQRT(MAX(0D0,PMSR)))) + ELSEIF(RBR.LT.0.9D0) THEN + PMG(I)=SQRT(MAX(0D0,PML(I)**2+PYR(0)*(PMV**2-PML(I)**2))) + ELSEIF(RBR.LT.1.5D0) THEN + PMG(I)=PML(I)*(PMV/PML(I))**PYR(0) + ELSE + PMG(I)=SQRT(MAX(0D0,PML(I)**2*PMV**2/(PML(I)**2+PYR(0)* + & (PMV**2-PML(I)**2)))) + ENDIF + 270 CONTINUE + IF((MEQL.GE.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. + & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) THEN + IF(MINT(48).EQ.1.AND.MSTP(171).EQ.0) THEN + NGEN(0,1)=NGEN(0,1)+1 + NGEN(MINT(1),1)=NGEN(MINT(1),1)+1 + GOTO 260 + ELSE + MINT(51)=1 + RETURN + ENDIF + ENDIF + RET1=PMG(1) + RET2=PMG(2) + +C...Give weight for selected mass distribution. + VINT(80)=1D0 + DO 280 I=1,2 + IF(MBW(I).EQ.0) GOTO 280 + PMV=PMU(I) + IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) + ATV=ATU(I) + IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) + F0=PMD(I)*PGD(I)/((PMG(I)**2-PMD(I)**2)**2+ + & (PMD(I)*PGD(I))**2)/PARU(1) + F1=1D0 + F2=1D0/PMG(I)**2 + F3=1D0/PMG(I)**4 + FI0=(ATV-ATL(I))/PARU(1) + FI1=PMV**2-PML(I)**2 + FI2=2D0*LOG(PMV/PML(I)) + FI3=1D0/PML(I)**2-1D0/PMV**2 + IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. + & ISUB.EQ.35).AND.MSTP(43).NE.2) THEN + VINT(80)=VINT(80)*20D0/(8D0+(FI0/F0)*(F1/FI1+6D0*F2/FI2+ + & 5D0*F3/FI3)) + ELSE + VINT(80)=VINT(80)*10D0/(8D0+(FI0/F0)*(F1/FI1+F2/FI2)) + ENDIF + VINT(80)=VINT(80)*FI0 + 280 CONTINUE + IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) + ENDIF + + RETURN + END + +C*********************************************************************** + +C...PYRECO +C...Handles the possibility of colour reconnection in W+W- events, +C...Based on the main scenarios of the Sjostrand and Khoze study: +C...I, II, II', inte