C********************************************************************* C********************************************************************* C* ** C* April 2004 ** C* ** C* The Lund Monte Carlo ** C* ** C* PYTHIA version 6.2 ** C* ** C* Torbjorn Sjostrand ** C* Department of Theoretical Physics ** C* Lund University ** C* Solvegatan 14A, S-223 62 Lund, Sweden ** C* phone +46 - 46 - 222 48 16 ** C* E-mail torbjorn@thep.lu.se ** C* ** C* SUSY and Technicolor parts by ** C* Stephen Mrenna ** C* Computing Division, Simulations 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* Baryon and lepton number violation parts by ** C* Peter Skands ** C* Department of Theoretical Physics ** C* Lund University ** C* Solvegatan 14A, S-223 62 Lund, Sweden ** C* phone +46 - 46 - 222 31 92 ** C* E-mail zeiler@thep.lu.se ** C* ** C* PYTHIA 7 efforts coordinated by ** C* Leif Lonnblad ** C* Department of Theoretical Physics ** C* Lund University ** C* Solvegatan 14A, S-223 62 Lund, Sweden ** C* phone +46 - 46 - 222 77 80 ** C* E-mail leif@thep.lu.se ** 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* PYGAUS adapted from CERN library (K.S. Kolbig) ** 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 2004 ** 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 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 PYSTAT to print cross-section and other information * 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 PYSSPA to simulate initial state spacelike showers * C S PYMEMX auxiliary to PYSSPA for ME correction maximum * C S PYMEWT auxiliary to PYSSPA for matrix element correction * C S PYUPRE to rearranges contents of the HEPEUP commonblock * C S PYADSH to administrate sequential final-state showers * C S PYRESD to perform resonance decays * C S PYMULT to generate multiple interactions * C S PYREMN to add on target remnants * 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 pdf's * C S PYGBEH to evaluate Bethe-Heitler part of photon pdf's * C S PYGDIR to evaluate direct contribution to photon pdf's * 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 * PYTBH* auxiliaries to PYSTBH * C * C S PYMSIN to initialize the supersymmetry simulation * C S PYAPPS to determine MSSM parameters from SUGRA input * C S PYSUGI to determine MSSM parameters using ISASUSY * 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 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 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 timelike parton shower evolution * C F PYMAEL auxiliary to PYSHOW, with 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 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 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 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/PYBINS/IHIST(4),INDX(1000),BIN(20000) SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/,/PYSUBS/, &/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/, &/PYINT6/,/PYINT7/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYTCSM/,/PYBINS/ C...PYDAT1, containing status codes and most parameters. DATA MSTU/ & 0, 0, 0, 4000,10000, 500, 8000, 0, 0, 2, 1 6, 1, 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, 0D0, 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, 10, 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, &139*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,156*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,139*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,139*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,139*0D0/ 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.02911D0,0.01741D0,0.04536D0,0.09511D0,0.8686D0,0.62395D0, &0.19192D0,123.27638D0,0.02296D0,0.18886D0,23.26819D0,2.86306D0, &0D0,3.45903D0,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,139*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.29108D0,0.17412D0,0.45362D0,0.95114D0,8.68604D0,6.23946D0, &1.91923D0,450D0,0.22959D0,1.88863D0,232.68185D0,28.63059D0,0D0, &34.59032D0,25.93594D0,25.96873D0,4.28961D0,4.19124D0,1.41528D0, &0.00977D0,0.00976D0,0.00973D0,267.24501D0,217.49162D0,8.81592D0, &8.80013D0,7*0D0,139*0D0/ 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,112*0D0,139*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,146*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,4023,4047,4073,4097,4103,4110, &4117,4124,4130,4136,4145,4149,4153,4156,4158,4178,4200,4222,4244/ DATA (MDCY(I,2),I= 352, 500)/4259,4271,4278,146*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,24,26,24,6,3*7,2*6,9,2*4,3,2,20, &3*22,15,12,2*7,146*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,85*1, &2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,200*1,2*-1,2*1,-1, &1249*1,2*-1,377*1,2*-1,1868*1,2*-1,6*1,2*-1,9*1,-1,3*1,-1,3*1, &5*-1,3*1,-1,14*1,2*-1,6*1,2*-1,67*1,2*-1,6*1,2*-1,111*1,3716*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,4*32,8*0,8*32,14*0,16*32,12*0,8*32,8*0, &46*32,3*53,12*0,8*32,12*0,66*51,6*32,9*0,9*32,3733*0/ DATA (BRAT(I) ,I= 1, 346)/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.000349D0,0.048707D0,0.768308D0, &4*0D0,0.000227D0,0.064048D0,0D0,0.040621D0,0.002043D0,0.000615D0, &0.006981D0,0.068099D0,62*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.000049D0,0.000774D0,5*0D0,0.000074D0,0D0,0.000417D0/ DATA (BRAT(I) ,I= 347, 651)/0.000015D0,0.000061D0,0.30671D0, &0.689011D0,0D0,0.002889D0,69*0D0,0.000001D0,0.000121D0, &0.001924D0,4*0D0,0.000001D0,0.000184D0,0D0,0.003106D0,0.000015D0, &0.000003D0,2*0D0,0.994646D0,66*0D0,0.000021D0,0.090135D0,2*0D0, &0.000013D0,0.003714D0,0D0,0.906117D0,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/ DATA (BRAT(I) ,I= 652, 823)/0.302D0,0.0302D0,0.0212D0,0.0016D0, &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/ DATA (BRAT(I) ,I= 824, 991)/2*0.02D0,0.03D0,2*0.005D0,0.015D0, &0.037D0,0.028D0,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/ DATA (BRAT(I) ,I= 992,1183)/1D0,2*0.3D0,2*0.2D0,0.047D0,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/ DATA (BRAT(I) ,I=1184,1377)/2*0.08D0,0.76D0,0.08D0,1D0,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/ DATA (BRAT(I) ,I=1378,1580)/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,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/ DATA (BRAT(I) ,I=1581,4149)/0.008D0,0.024D0,0.008D0,0.024D0, &0.425D0,0.02D0,0.185D0,0.088D0,0.043D0,0.067D0,0.066D0,2404*0D0, &0.017431D0,0.054048D0,0.857694D0,2*0D0,0.00025D0,0.070578D0,0D0, &0.022748D0,0.026576D0,0.359486D0,0.561581D0,2*0D0,0.000104D0, &0.029504D0,0.011185D0,0.034681D0,0.550354D0,2*0D0,0.00016D0, &0.045287D0,0.358333D0,0.445781D0,0D0,0.554219D0,0.144051D0, &2*0.351902D0,0D0,0.082107D0,0.029566D0,0.001511D0,0.000726D0, &0.004518D0,0.006522D0,0.004518D0,0.006522D0,0.004513D0,3*0D0, &0.002908D0,0.000973D0,0.002908D0,0.000973D0,0.002908D0, &0.000973D0,2*0D0,0.143982D0,0.489888D0,0.1951D0,0D0,0.114302D0, &0.008426D0,0.014868D0,0.000763D0,2*0D0,0.000763D0,0.01484D0, &0.000003D0,2*0D0,0.000027D0,0.001945D0,5*0D0,3*0.00503D0,0D0, &0.133776D0,0.003284D0,0.37169D0,0.006838D0,2*0.030954D0, &0.00163D0,0D0,0.047224D0,0.073737D0,0.047224D0,0.073732D0, &0.047179D0,3*0D0,0.034761D0,0.009166D0,0.034761D0,0.009166D0, &0.034759D0,0.009166D0,2*0D0,4*0.009069D0,0.510147D0,0.453576D0, &6*0D0,1D0,6*0D0,1D0,4*0.001128D0,0.571047D0,0.382288D0, &0.042153D0,4*0.016597D0,0.93361D0,0D0,4*0.016597D0,0.93361D0,0D0, &4*0.05515D0,0.34469D0,0D0,0.228998D0,0.164208D0,0.041503D0, &0.850973D0,0.005411D0,0.045025D0,0.098591D0,0.849898D0/ DATA (BRAT(I) ,I=4150,4280)/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,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/ DATA (BRAT(I) ,I=4281,8000)/0.090428D0,0.001808D0,0.81372D0,0D0, &3716*0D0/ 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,4127)/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, &2*24,2*3000211,2*22,2*23,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18, &2*24,3*3000211,24,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,22,23,22, &23,24,3000211,24,3000211,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18, &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/ DATA (KFDP(I,1),I=4128,8000)/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,2*11, &2*-11,9*13,9*-13,2*13,2*-13,9*15,9*-15,2*15,2*-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,3716*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,4136)/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,-24,-3000211,-24,-3000211, &3000111,3000221,3000111,3000221,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12, &-13,-14,-15,-16,-17,-18,23,3000111,23,3000111,22,3000221,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,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16, &-17,-18,-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/ DATA (KFDP(I,2),I=4137,8000)/-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,2*-13,2*15,3*-1,3*-3, &3*-5,3*1,3*3,3*5,2*-11,2*15,3*-1,3*-3,3*-5,3*1,3*3,3*5,2*-11, &2*13,-1,-2,-3,-4,-5,-6,-11,-12,9900012,-13,-14,9900014,-15,-16, &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,3716*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,169*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,3757*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, 100)/'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',' '/ DATA (CHAF(I,1),I= 101, 202)/'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+',139*' '/ 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-',139*' '/ 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, 1, 0, 0, 7 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8 1, 1, 100, 0, 0, 2, 0, 0, 0, 0, 9 1, 3, 1, 3, 0, 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, 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, 7 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 8 6, 223, 2004, 04, 15, 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, 1.0D0,1D-3,2*0D0, 7 4.0D0, 0.25D0, 8*0D0, 8 1.90D0, 1.90D0, 0.5D0, 0.2D0, 0.33D0, 8 0.66D0, 0.7D0, 0.5D0, 1000D0, 0.16D0, 9 1.0D0,0.40D0,5.0D0,1.0D0,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 10*0D0, 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, 8*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, 39*-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, -1, -1, -1, 8 2, 2, 2, 2, 2, 2, 2, 2, -2, -2, 9 1, 1, 2, 2, 2, 5*-2, & 5, 5, 98*-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, 78*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,500)/ 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, 0, 7 0, 0, 0, 0, 0, 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, & 37, 6, 37, 6, 196*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,146*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- ', 39*' '/ 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' ',' ', 7' '/ DATA (PROC(I),I=381,500)/ 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+/- ', & 98*' '/ 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 69*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, 4*0D0, 4 49*0D0/ C...Data for histogramming routines. DATA IHIST/1000,20000,55,1/ DATA INDX/1000*0/ 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) STOP 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) STOP 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...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) SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, &/PYINT1/,/PYINT2/,/PYINT5/ 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/W50512/QCDL4,QCDL5 SAVE /W50512/ DOUBLE PRECISION VALUE(20),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...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).GE.1) CALL PYLIST(0) IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) C...Reset processes that should not be on. MSUB(96)=0 MSUB(97)=0 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(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) 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 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)) STOP ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).EQ.-1) THEN WRITE(MSTU(11),5300) ISUB STOP ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).LE.-2) THEN WRITE(MSTU(11),5400) ISUB STOP 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) STOP 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(MSTP(81).EQ.0.AND.CKIN(3).GT.PTMN) MSTP(82)=MIN(1,MSTP(82)) IF((MINT(49).NE.0.OR.MSTP(131).NE.0).AND.MSTP(82).GE.2) & CALL PYMULT(1) 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) STOP 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 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/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/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/, &/PYINT2/,/PYINT4/,/PYINT5/ C...Local array. DIMENSION VTX(4) C...Stop if no subprocesses on. IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN WRITE(MSTU(11),5100) STOP ENDIF C...Initial values for some counters. N=0 MINT(5)=MINT(5)+1 MINT(7)=0 MINT(8)=0 MINT(83)=0 MINT(84)=MSTP(126) MSTU(24)=0 MSTU70=0 MSTJ14=MSTJ(14) 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 250 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 260 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(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 240 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 IF(ISUB.EQ.95) GOTO 120 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) CALL PYSSPA(IPU1,IPU2) PARJ(81)=ALAMSV IF(MINT(51).EQ.1) GOTO 100 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...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. IF(MSTP(81).GE.1.AND.MINT(50).EQ.1) CALL PYMULT(6) MINT(53)=N C...Hadron remnants and primordial kT. 120 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 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. IF(MSTP(111).GE.1) THEN NFIX=N DO 130 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 130 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 140 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) 140 CONTINUE NRECAL=N ENDIF 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(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100 IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN DO 170 I=MINT(84)+1,N IF(K(I,2).EQ.94) THEN DO 160 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 150 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 150 CONTINUE IF(K(I+1,3).EQ.0) K(I+1,3)=K(I,3) ENDIF ENDIF 160 CONTINUE ENDIF 170 CONTINUE CALL PYEDIT(12) CALL PYEDIT(14) IF(MSTP(125).EQ.0) CALL PYEDIT(15) IF(MSTP(125).EQ.0) MINT(4)=0 DO 190 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 180 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 180 CONTINUE ENDIF 190 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 200 J=1,4 VTX(J)=PARP(150+J)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0))))* & SIN(PARU(2)*PYR(0)) 200 CONTINUE DO 220 I=MINT(83)+1,N DO 210 J=1,4 V(I,J)=V(I,J)+VTX(J) 210 CONTINUE 220 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 230 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) 230 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. 240 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) 250 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. 260 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) 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,'********* 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...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) STOP 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 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) STOP 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).EQ.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)) STOP ENDIF IF(S.LT.PARP(2)**2) THEN WRITE(MSTU(11),5900) SQRT(S) STOP 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).EQ.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) 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 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).EQ.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) SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT6/,/PYINT7/ C...Local arrays, character variables and data. CHARACTER CVAR(4)*4 DIMENSION NPTS(4),MVARPT(500,4),VINTPT(500,30),SIGSPT(500), &NAREL(7),WTREL(7),WTMAT(7,7),WTRELN(7),COEFU(7),COEFO(7), &IACCMX(4),SIGSMX(4),SIGSSM(3),PMMN(2) 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 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.MSTP(81).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 ELSEIF(ISUB.EQ.194) THEN KFR1=KTECHN+113 ELSEIF(ISUB.EQ.195) THEN KFR1=KTECHN+213 ELSEIF(ISUB.GE.361.AND.ISUB.LE.368) THEN KFR1=KTECHN+113 ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN KFR1=KTECHN+213 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) IF(KFR1.EQ.KTECHN+113) THEN CALL PYTECM(S1,S2) TAUR1=S1/VINT(2) ENDIF GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) MINT(72)=1 MINT(73)=KFR1 VINT(73)=TAUR1 VINT(74)=GAMR1 ENDIF KFR2=0 IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.(ISUB.GE.364.AND.ISUB.LE.368)) $ THEN KFR2=23 IF(ISUB.EQ.194) THEN KFR2=KTECHN+223 ELSEIF(ISUB.GE.364.AND.ISUB.LE.368) THEN KFR2=KTECHN+223 ENDIF KCR2=PYCOMP(KFR2) TAUR2=PMAS(KCR2,1)**2/VINT(2) IF(KFR2.EQ.KTECHN+223) THEN CALL PYTECM(S1,S2) TAUR2=S2/VINT(2) ENDIF GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) KFR2=0 IF(KFR2.NE.0.AND.KFR1.NE.0) THEN MINT(72)=2 MINT(74)=KFR2 VINT(75)=TAUR2 VINT(76)=GAMR2 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 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). 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) NPTS(1)=NPTS(1)+1 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 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(MTAU.GT.2+2*MINT(72)) MTAU=7 RTAU=0.5D0 C...Special case when both resonances have same mass, C...as is often the case in process 194. IF(MINT(72).EQ.2) THEN IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LT. & 0.01D0*(PMAS(KCR2,1)+PMAS(KCR1,1))) THEN IF(MTAU.EQ.3.OR.MTAU.EQ.4) THEN RTAU=0.4D0 ELSEIF(MTAU.EQ.5.OR.MTAU.EQ.6) THEN RTAU=0.6D0 ENDIF ENDIF 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).GT.2+2*MINT(72)) 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.AND.IBIN.EQ.7) IBIN=3+2*MINT(72) 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(NBIN.GT.2+2*MINT(72)) THEN WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(ATAU1/ATAU7)* & TAU/MAX(2D-10,1D0-TAU) 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) 200 CONTINUE DO 230 IRED=1,NBIN-1 DO 220 IBIN=IRED+1,NBIN IF(ABS(WTMAT(IRED,IRED)).LT.1D-20) THEN MSOLV=0 GOTO 260 ENDIF RQT=WTMAT(IBIN,IRED)/WTMAT(IRED,IRED) WTREL(IBIN)=WTREL(IBIN)-RQT*WTREL(IRED) DO 210 ICOE=IRED,NBIN WTMAT(IBIN,ICOE)=WTMAT(IBIN,ICOE)-RQT*WTMAT(IRED,ICOE) 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 COEFU(IRED)=WTREL(IRED)/WTMAT(IRED,IRED) 250 CONTINUE 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, & WTREL(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.AND.IBIN.GT.2+2*MINT(72)) ICOF=7 IF(IVAR.EQ.3.AND.IBIN.EQ.4.AND.MINT(45).NE.3) ICOF=ICOF+1 COEF(ISUB,ICOF)=COEFO(IBIN) 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 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) STOP 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.MSTP(81).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,8D11.3) 5600 FORMAT(1X,'Result for ',A4,':',7F9.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) SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/,/PYMSSM/ 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(97)=1D0 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 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).EQ.11.AND.IABS(IDWTUP).EQ.2.AND.LOOP.GE.2) THEN CALL UPEVNT CALL PYUPRE ELSEIF(MINT(111).EQ.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) 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. IF(INMULT.EQ.1) CALL PYMULT(2) 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) 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...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 ELSEIF(ISUB.EQ.194) THEN KFR1=KTECHN+113 ELSEIF(ISUB.EQ.195) THEN KFR1=KTECHN+213 ELSEIF(ISUB.GE.361.AND.ISUB.LE.368) THEN KFR1=KTECHN+113 ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN KFR1=KTECHN+213 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) IF(KFR1.EQ.KTECHN+113) THEN CALL PYTECM(S1,S2) TAUR1=S1/VINT(2) ENDIF GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) MINT(72)=1 MINT(73)=KFR1 VINT(73)=TAUR1 VINT(74)=GAMR1 ENDIF IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.(ISUB.GE.364.AND.ISUB.LE.368)) $THEN KFR2=23 IF(ISUB.EQ.194) THEN KFR2=KTECHN+223 ELSEIF(ISUB.GE.364.AND.ISUB.LE.368) THEN KFR2=KTECHN+223 ENDIF KCR2=PYCOMP(KFR2) TAUR2=PMAS(KCR2,1)**2/VINT(2) IF(KFR2.EQ.KTECHN+223) THEN CALL PYTECM(S1,S2) TAUR2=S2/VINT(2) ENDIF GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) KFR2=0 IF(KFR2.NE.0.AND.KFR1.NE.0) THEN MINT(72)=2 MINT(74)=KFR2 VINT(75)=TAUR2 VINT(76)=GAMR2 ELSEIF(KFR2.NE.0) THEN KFR1=KFR2 TAUR1=TAUR2 GAMR1=GAMR2 MINT(72)=1 MINT(73)=KFR1 VINT(73)=TAUR1 VINT(74)=GAMR1 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.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)=(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 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 CALL PYMULT(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) 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 C...Calculate differential cross-section for different subprocesses. IF(ISTSB.LE.10) CALL PYSIGH(NCHN,SIGS) 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 CALL PYMULT(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) STOP ENDIF ELSE IF(VIOL.LT.MIN(-1D-3,VINT(109))) THEN VINT(109)=VIOL 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. 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) STOP 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 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 WRITE(MSTU(11),5800) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) ELSEIF(KFPR(ISUB,1).LE.99) THEN WRITE(MSTU(11),5900) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) ELSE 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 WRITE(MSTU(11),5500) ISUB,XSEC(ISUB,1) ELSEIF(ISUB.LE.99) THEN WRITE(MSTU(11),5600) ISUB,XSEC(ISUB,1) ELSE WRITE(MSTU(11),5700) ISUB,XSEC(ISUB,1) ENDIF ENDIF VINT(108)=1D0 ENDIF ENDIF C...Multiple interactions: choose impact parameter. VINT(148)=1D0 IF(MINT(50).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GE.96).AND. &MSTP(82).GE.3) THEN CALL PYMULT(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) 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...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/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) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYSSMT/,/PYTCSM/ 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) 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...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 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 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.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).AND.MINT(2).LE.2) THEN IF(KFLF.GE.4) GOTO 180 ELSEIF((ISUB.EQ.53.OR.ISUB.EQ.385).AND.MINT(2).LE.4) THEN KFLF=4 MINT(2)=MINT(2)-2 ELSEIF(ISUB.EQ.53.OR.ISUB.EQ.385) 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.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) 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) 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.402) 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)) ! Top or bottom MINT(21)=ISIGN(INT(6.+.5*KFL),KCS) MINT(22)=ISIGN(INT(6.-.5*KFL),-KCS) KCC=4 KFRES=ISIGN(KFHIGG,-KFL*KCS) ENDIF 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 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 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 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...Low-pT events: remove gluons used for string drawing purposes IF(ISUB.EQ.95) THEN K(IPU3,1)=K(IPU3,1)+10 K(IPU4,1)=K(IPU4,1)+10 DO 690 J=41,66 VINTSV(J)=VINT(J) VINT(J)=0D0 690 CONTINUE DO 710 I=MINT(83)+5,MINT(83)+8 DO 700 J=1,5 P(I,J)=0D0 700 CONTINUE 710 CONTINUE ENDIF 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 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) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, &/PYINT2/,/PYINT3/ 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) IF(ISET(ISUB).EQ.2) Q2MX=MIN(VINT(2),PARP(67)*VINT(56)) FCQ2MX=1D0 C...Define which processes ME corrections have been implemented for. MECOR=0 IF(MSTP(68).EQ.1) 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 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 LOOP=0 100 LOOP=LOOP+1 IF(LOOP.GT.100) THEN MINT(51)=1 RETURN ENDIF N=NS 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) 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) IF(XS(JT).LT.1D0-XEE) THEN 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/VINT(2),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*VINT(2)) 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(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 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 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 CALL PYSHOW(IT,0,SQRT(Q2TIM)) 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)) 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) ENDIF C...Update kinematics variables. IS(JT)=N DQ2(JT)=Q2B IF(MSTP(62).GE.3.AND.NTRY2.LT.200) 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)) CALL PYROBO(MINT(83)+5,NS,0D0,-ROBO(2),0D0,0D0,0D0) CALL PYROBO(MINT(83)+5,NS,ROBO(1),ROBO(2),ROBO(3),ROBO(4), &ROBO(5)) C...Store user information. Reset Lambda value. K(IPU1,3)=MINT(83)+3 K(IPU2,3)=MINT(83)+4 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) 340 CONTINUE PARU(112)=ALAMS 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+UH**2+2D0*SQM*TH)/((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 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.EQ.0) RETURN 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 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...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...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 260 ISYS=1,NSYS NSIZ=IBEG(ISYS+1)-IBEG(ISYS) IF(NSIZ.EQ.1.AND.ISYS.EQ.1) THEN ELSEIF(NSIZ.LE.1) THEN CALL PYERRM(2,'(PYADSH:) only one particle in system') ELSEIF(NSIZ.GT.80) THEN CALL PYERRM(2,'(PYADSH:) more than 80 particles in system') ELSE C...Save status codes and daughters of showering pair; 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(NSIZ.EQ.2) THEN CALL PYSHOW(IBEG(ISYS),IBEG(ISYS)+1,QMAX) ELSE CALL PYSHOW(IBEG(ISYS),-NSIZ,QMAX) ENDIF C...Look up showered copies of original showering particles. DO 250 II=1,NSIZ I=IBEG(ISYS)-1+II IMV=I IF(N.EQ.NSAV.OR.K(I,1).LE.10) THEN ELSEIF(K(I,1).EQ.11) THEN 180 IMV=MOD(K(IMV,4),MSTU(5)) IF(K(IMV,1).EQ.11) GOTO 180 ELSE KDA1=MOD(K(I,4),MSTU(5)) KDA2=MOD(K(I,5),MSTU(5)) DO 190 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)) KDA2=MOD(K(I3,5),MSTU(5)) ENDIF 190 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 200 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 200 CONTINUE C...Boost all original daughters to new frame of showered copy. IF(IMV.NE.I) THEN DO 210 J=1,3 BETA(J)=(P(IMV,J)-P(I,J))/(P(IMV,4)+P(I,4)) 210 CONTINUE FAC=2D0/(1D0+BETA(1)**2+BETA(2)**2+BETA(3)**2) DO 220 J=1,3 BETA(J)=FAC*BETA(J) 220 CONTINUE DO 240 I3=IBEG(ISYS+1),NFIN IMO=I3 230 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 230 IF(IMO.EQ.I.OR.(K(I,3).LE.MINT(84).AND.IMO.EQ.K(I,3))) & CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) ELSE IF(IMO.EQ.IMV) THEN CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) ELSEIF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) THEN GOTO 230 ENDIF ENDIF 240 CONTINUE ENDIF 250 CONTINUE C...End of loop over showering systems ENDIF 260 CONTINUE 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...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/PYINT4/MWID(500),WIDS(500,5) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, &/PYINT1/,/PYINT2/,/PYINT4/ 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) 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 ETOTIN=P(MINT(84)+1,4)+P(MINT(84)+2,4) BEXIN=(P(MINT(84)+1,1)+P(MINT(84)+2,1))/ETOTIN BEYIN=(P(MINT(84)+1,2)+P(MINT(84)+2,2))/ETOTIN BEZIN=(P(MINT(84)+1,3)+P(MINT(84)+2,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) IF(IREF(1,4).GT.MINT(84)) THEN 103 ITMPMO=IREF(1,4) IF(K(ITMPMO,2).EQ.94) THEN IREF(1,4)=K(ITMPMO,3)+(IRES-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 IREF(1,4)=K(ITMPMO,3) GOTO 103 ENDIF ENDIF IF(IREF(1,4).GT.MINT(84)) THEN EMATCH=1D10 IREF14=IREF(1,4) DO 106 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 106 CONTINUE ENDIF JTMAX=1 ENDIF C...Check if initial resonance has been moved (in resonance + jet). DO 120 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)) DO 110 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)) ENDIF 110 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 120 CONTINUE C.....Set decay vertex for initial resonances DO 140 JT=1,JTMAX DO 130 I=1,4 V(IREF(1,JT),I)=0D0 130 CONTINUE 140 CONTINUE C...Loop over decay history. NP=1 IP=0 150 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. 160 N=NSAV DO 320 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 310 KFA=IABS(K(ID,2)) KCA=PYCOMP(KFA) IF(MWID(KCA).EQ.0) GOTO 310 IF(K(ID,1).GT.10.OR.MDCY(KCA,1).EQ.0) GOTO 310 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 170 J=1,4 VDCY(J)=V(ID,J)+V(ID,5)*P(ID,J)/P(ID,5) 170 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 310 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 310 RKFL=WDTE0S*PYR(0) IDL=0 180 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 180 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 200 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 200 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 190 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 190 CONTINUE CMRENNA-- ELSEIF(KFLW.EQ.6) THEN PMMN(I)=PMAS(24,1)+PMAS(5,1) ENDIF 200 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 700 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 700 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 210 LOOP=LOOP+1 P(N+IWID3,5)=PYMASS(KFLW3) IF(LOOP.LE.10.AND. P(N+IWID3,5).LE.PMMN(IWID3)) GOTO 210 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 700 ENDIF C...Begin fill decay products, with colour flow for coloured objects. MSTU10=MSTU(10) MSTU(10)=1 MSTU(19)=1 CMRENNA++ C...1) Three-body decays of SUSY particles (plus special case top). IF(KFL3(JT).NE.0) THEN DO 230 I=N+1,N+3 DO 220 J=1,5 K(I,J)=0 V(I,J)=0D0 220 CONTINUE 230 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 CALL PYTBDY(IDIN) C...Set colour flow for t -> W + b + Z. IF(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) ENDIF IF(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) ENDIF IF(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 ENDIF CMRENNA-- IF(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 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 240 J=1,5 P(N+4,J)=0D0 V(N+4,J)=0D0 240 CONTINUE C...Connect daughters to junction. DO 250 II=N+1,N+3 K(II,4)=0 K(II,5)=0 K(II,ITJUNC(JT)+3)=MSTU(5)*(N+4) 250 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 260 J=1,5 P(N+4,J)=0D0 V(N+4,J)=0D0 260 CONTINUE CTMSUM=0D0 DO 270 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) 270 CONTINUE CTMSUM=PYR(0)*CTMSUM C...Select colour topology J, with most off shell least likely. J=0 280 J=J+1 CTMSUM=CTMSUM-CTM2(J) IF (CTMSUM.GT.0D0) GOTO 280 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)) 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 290 J=1,5 P(N,J)=0D0 V(N,J)=0D0 290 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 300 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) 300 CONTINUE ENDIF ENDIF C...End loop over resonances for daughter flavour and mass selection. MSTU(10)=MSTU10 310 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 700 ENDIF 320 CONTINUE C...Check for allowed combinations. Skip if no decays. IF(JTMAX.EQ.1) THEN IF(KDCY(1).EQ.0) GOTO 690 ELSEIF(JTMAX.EQ.2) THEN IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0) GOTO 690 IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 160 IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 160 ELSEIF(JTMAX.EQ.3) THEN IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0.AND.KDCY(3).EQ.0) GOTO 690 IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 160 IF(KEQL(1).EQ.4.AND.KEQL(3).EQ.4) GOTO 160 IF(KEQL(2).EQ.4.AND.KEQL(3).EQ.4) GOTO 160 IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 160 IF(KEQL(1).EQ.5.AND.KEQL(3).EQ.5) GOTO 160 IF(KEQL(2).EQ.5.AND.KEQL(3).EQ.5) GOTO 160 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 700 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 340 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 330 J=1,5 P(I1,J)=P(I,J) 330 CONTINUE ENDIF 340 CONTINUE C...Generate parton shower. IF(MSTJ(101).EQ.5) CALL PYSHOW(N-1,N,P(ID,5)) C... End special case for Z0: skip ahead. MSTU(111)=MST111 PARU(112)=PAR112 GOTO 680 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 350 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 350 CONTINUE C...Find charge, isospin, left- and righthanded couplings. DO 370 I=IMIN,IMAX DO 360 J=1,4 COUP(I,J)=0D0 360 CONTINUE KFA=IABS(K(ILIN(I),2)) IF(KFA.EQ.0.OR.KFA.GT.20) GOTO 370 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) 370 CONTINUE C...Full propagator dependence and flavour correlations for 2 gamma*/Z. IF(ISUB.EQ.22) THEN DO 400 I=3,5,2 I1=IORD IF(I.EQ.5) I1=3-IORD DO 390 J1=1,2 DO 380 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 380 CONTINUE 390 CONTINUE 400 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 160 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). 410 DO 420 JT=1,JTMAX IF(KDCY(JT).EQ.0) GOTO 420 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 420 CONTINUE IF(JTMAX.EQ.2.AND.MSTP(47).GE.1.AND.NINH.EQ.0) THEN C...Construct massless four-vectors. DO 440 I=N+1,N+4 K(I,1)=1 DO 430 J=1,5 P(I,J)=0D0 V(I,J)=0D0 430 CONTINUE 440 CONTINUE DO 450 JT=1,JTMAX IF(KDCY(JT).EQ.0) GOTO 450 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)) 450 CONTINUE C...Store incoming and outgoing momenta, with random rotation to C...avoid accidental zeroes in HA expressions. IF(ISUB.NE.0) THEN DO 470 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 460 J=1,3 P(N+4+I,J)=P(ILIN(I),J) 460 CONTINUE 470 CONTINUE 480 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 500 I=IMIN,IMAX IF(P(N+4+I,1)**2+P(N+4+I,2)**2.LT.1D-4*P(N+4+I,4)**2) & GOTO 480 DO 490 J=1,4 PK(I,J)=P(N+4+I,J) 490 CONTINUE 500 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 520 I1=IMIN,IMAX-1 DO 510 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) 510 CONTINUE 520 CONTINUE ENDIF C...Calculate four-products. IF(ISUB.NE.0) THEN DO 540 I=1,2 DO 530 J=1,4 PK(I,J)=-PK(I,J) 530 CONTINUE 540 CONTINUE DO 560 I1=IMIN,IMAX-1 DO 550 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) 550 CONTINUE 560 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)) IF((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) 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) 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 IF(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