C********************************************************************* C********************************************************************* C* ** C* September 1996 ** C* ** C* The Lund Monte Carlo for Hadronic Processes ** C* ** C* PYTHIA version 6.0 ** C* ** C* Torbjorn Sjostrand ** C* Department of Theoretical Physics 2 ** 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* Several parts are written by Hans-Uno Bengtsson ** C* PYSHOW is written together with Mats Bengtsson ** C* CTEQ 3 parton distributions are by the CTEQ collaboration ** C* SaS photon parton distributions together with Gerhard Schuler ** C* g + g and q + qbar -> t + tbar + H code by Zoltan Kunszt ** C* ** C* The latest program version and documentation is found on WWW ** C* http://thep.lu.se/tf2/staff/torbjorn/Pythia.html ** C* ** C* Copyright Torbjorn Sjostrand, Lund 1996 ** 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 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 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 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 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 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 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 + Q~ + H * 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 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 PYINDF to do independent fragmentation of one or many jets * C S PYDECY to do the decay of a particle * C S PYKFDI to select parton and hadron flavours in fragm * 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 S PYBOEI to include Bose-Einstein effects (crudely) * C F PYMASS to give the mass of a particle or parton * 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 PYKCUT dummy routine for user kinematical cuts * C S PYEVWT dummy routine for weighting events * C S PYUPIN dummy routine to initialize a user process * C S PYUPEV 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 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) 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(4000,2),BRAT(4000),KFDP(4000,5) COMMON/PYDAT4/CHAF(500,2) CHARACTER CHAF*16 COMMON/PYDATR/MRLU(6),RRLU(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) SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/,/PYSUBS/, &/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/, &/PYINT6/,/PYINT7/ C...PYDAT1, containing status codes and most parameters. DATA MSTU/ & 0, 0, 0, 4000,10000, 500, 4000, 0, 0, 2, 1 6, 1, 1, 0, 1, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1 1, 5, 3, 5, 0, 0, 0, 0, 0, 0, 2 80*0/ DATA PARU/ & 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, & 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,1000D0,1.0D0, 1.0D0, 1.0D0, 1.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, 0, 0, 0, 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, 0, 0, 0, 0, 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, 0D0, 0D0, 0D0, 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,2.5D0,0.6D0,0D0, 4 0.3D0,0.58D0,0.5D0,0.9D0,0.5D0,1.0D0,1.0D0,1.0D0,0D0,0D0, 5 0.77D0,0.77D0,0.77D0,-0.05D0,-0.005D0, 5-0.00001D0,-0.00001D0,-0.00001D0,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, 0D0, 8 0.29D0, 1.0D0, 1.0D0, 0D0, 10D0, 10D0, 0D0, 0D0, 0D0, 0D0, 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, 3 0.99D0, 0D0, 0D0, 0.2D0, 0D0, 4 60*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,0,-1,44*0,2,-1,20*0,4*3,8*0,3*3,4*0, &3*3,3*0,3*3,7*0,3*3,3*0,3*3,3*0,-2,-3,2*1,3*0,4,3*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,0,-1,2,-3,164*0/ DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,16*0,2,1,113*0,-1,0,2*-1, &3*0,-1,4*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,6*0,2*1,165*0/ DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,0,2*1, &41*0,1,0,2*1,20*0,4*1,5*0,6*1,4*0,9*1,4*0,12*1,3*0,102*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,16*1,163*0/ DATA (KCHG(I,4),I= 1, 293)/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,210,211,213,215,220,221,223,225,310,311, &313,315,321,323,325,330,331,333,335,411,413,415,421,423,425,431, &433,435,440,441,443,445,511,513,515,521,523,525,531,533,535,541, &543,545,551,553,555,1103,1114,2101,2103,2110,2112,2114,2203,2210, &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/ DATA (KCHG(I,4),I= 294, 500)/20443,20513,20523,20533,20543,20553, &30443,30553,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,4000001,4000002,4000011,4000012,163*0/ DATA (PMAS(I,1),I= 1, 220)/0.0099D0,0.0056D0,0.199D0,1.35D0, &5D0,160D0,2*250D0,2*0D0,0.00051D0,0D0,0.1057D0,0D0,1.777D0,0D0, &250D0,5*0D0,91.187D0,80.25D0,80D0,6*0D0,500D0,900D0,500D0, &3*300D0,350D0,200D0,5000D0,42*0D0,1D0,2D0,5D0,16*0D0,0.135D0, &0.7683D0,1.318D0,0.4977D0,0D0,0.1396D0,0.7669D0,1.318D0,0D0, &0.5475D0,0.782D0,1.275D0,2*0.4977D0,0.8961D0,1.432D0,0.4936D0, &0.8916D0,1.425D0,0D0,0.9578D0,1.0194D0,1.525D0,1.8693D0,2.0101D0, &2.46D0,1.8645D0,2.0071D0,2.46D0,1.9688D0,2.11D0,2.61D0,0D0, &2.9788D0,3.0969D0,3.5562D0,5.2787D0,5.325D0,5.83D0,5.2786D0, &5.325D0,5.83D0,5.47972D0,5.5068D0,6.07D0,6.594D0,6.602D0,7.35D0, &9.4D0,9.4603D0,9.9132D0,0.77133D0,1.234D0,0.57933D0,0.77133D0, &0D0,0.9396D0,1.233D0,0.77133D0,0D0,0.9383D0,1.232D0,1.231D0, &0.80473D0,0.92953D0,1.1974D0,1.3872D0,1.1156D0,0.80473D0, &0.92953D0,1.1926D0,1.3837D0,1.1894D0,1.3828D0,1.09361D0,1.3213D0, &1.535D0,1.3149D0,1.5318D0,1.6724D0,1.96908D0,2.00808D0,2.4525D0, &2.5D0,2.2849D0,2.473D0,1.96908D0,2.00808D0,2.4529D0,2.5D0, &2.4527D0,2.5D0,2.466D0,2.15432D0,2.17967D0,2.55D0,2.63D0,2.55D0, &2.63D0,2.73D0,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/ DATA (PMAS(I,1),I= 221, 500)/5.81D0,5.8D0,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.9827D0, &1.232D0,0.983D0,1.232D0,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.26D0,1.282D0,2*1.402D0,1.42D0,2*2.372D0, &2.56D0,3.5106D0,2*5.78D0,6.02D0,7.3D0,9.8919D0,3.686D0,10.0233D0, &32*500D0,4*400D0,163*0D0/ DATA (PMAS(I,2),I= 1, 500)/5*0D0,1.12297D0,16*0D0,2.47833D0, &2.06646D0,0.00295D0,6*0D0,14.67788D0,0D0,16.79392D0,8.45231D0, &4.93534D0,5.80468D0,19.1898D0,0.39162D0,417.35283D0,62*0D0, &0.151D0,0.11D0,3*0D0,0.149D0,0.11D0,2*0D0,0.00843D0,0.185D0, &2*0D0,0.0505D0,0.109D0,0D0,0.0498D0,0.098D0,0D0,0.0002D0, &0.0044D0,0.076D0,2*0D0,0.019D0,2*0D0,0.019D0,2*0D0,0.02D0,0D0, &0.001D0,0D0,0.002D0,2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,2*0D0, &0.02D0,4*0D0,0.12D0,4*0D0,0.12D0,3*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.057D0,0.155D0,0.057D0,0.155D0,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.024D0,2*0.174D0, &0.06D0,3*0.05D0,0.0009D0,4*0.05D0,3*0D0,32*1D0,2.60511D0, &2.60839D0,0.42904D0,0.41921D0,163*0D0/ DATA (PMAS(I,3),I= 1, 500)/5*0D0,11.22971D0,16*0D0,24.78326D0, &20.66459D0,0.02954D0,6*0D0,146.77876D0,0D0,167.93924D0, &84.52308D0,49.35344D0,58.04675D0,191.89803D0,3.91624D0, &4173.5283D0,62*0D0,0.4D0,0.25D0,3*0D0,0.4D0,0.25D0,2*0D0,0.1D0, &0.17D0,2*0D0,0.2D0,0.12D0,0D0,0.2D0,0.12D0,0D0,0.002D0,0.015D0, &0.2D0,2*0D0,0.12D0,2*0D0,0.12D0,2*0D0,0.05D0,0D0,0.005D0,0D0, &0.01D0,2*0D0,0.05D0,2*0D0,0.05D0,2*0D0,0.05D0,2*0D0,0.05D0,4*0D0, &0.14D0,4*0D0,0.14D0,3*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,32*10D0,26.05109D0,26.08388D0,4.29043D0,4.19206D0, &163*0D0/ DATA (PMAS(I,4),I= 1, 500)/12*0D0,658650D0,0D0,0.0914D0,68*0D0, &0.1D0,0.387D0,19*0D0,15500D0,0D0,7804D0,6*0D0,26.75D0,3*0D0, &3709D0,6*0D0,0.32D0,2*0D0,0.1259D0,2*0D0,0.135D0,6*0D0,0.387D0, &2*0D0,0.387D0,2*0D0,0.387D0,2*0D0,0.15D0,19*0D0,44.3D0,0D0, &78.88D0,4*0D0,23.95D0,2*0D0,49.1D0,0D0,86.9D0,0D0,24.6D0,4*0D0, &0.057D0,0.025D0,6*0D0,0.09D0,6*0D0,0.13D0,2*0D0,7*0.1D0,4*0D0, &3*0.387D0,6*0D0,2*0.387D0,6*0D0,0.387D0,0D0,0.387D0,2*0D0, &8*0.387D0,0D0,9*0.387D0,83*0D0,163*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 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 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 1870*0D0/ DATA ((VCKM(I,J),J=1,4),I=1,4)/ 1 0.95113D0, 0.04884D0, 0.00003D0, 0.00000D0, 2 0.04884D0, 0.94940D0, 0.00176D0, 0.00000D0, 3 0.00003D0, 0.00176D0, 0.99821D0, 0.00000D0, 4 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, &7*1,42*0,3*1,16*0,3*1,3*0,2*1,0,7*1,0,2*1,0,12*1,0,18*1,0,1,4*0, &1,3*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,56*1,32*0,4*1,163*0/ DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,50,60,2*0,70,74,76, &81,83,124,126,131,2*0,134,143,155,171,191,6*0,208,0,230,253,273, &291,300,303,304,42*0,313,314,318,16*0,327,329,333,341,0,349,350, &352,0,358,365,370,379,381,383,386,396,402,405,0,416,422,430,436, &499,502,510,571,573,581,614,615,0,619,620,623,625,661,662,670, &706,707,715,754,755,759,790,791,795,796,805,0,807,4*0,808,3*0, &811,814,2*0,815,817,820,2*0,824,825,828,831,0,834,835,837,839, &841,2*0,845,846,847,923,2*0,924,925,926,927,928,2*0,929,930,932, &933,935,936,0,937,941,945,949,953,957,961,2*0,965,966,967,984, &985,2*0,994,995,996,997,998,999,2*0,1008,1009,1010,1011,1012, &1013,1014,2*0,1023,1032,1041,1050,1059,1068,1077,1086,0,1095, &1104,1113,1122,1131,1140,1149,1158,1167,1176,1177,1178,1179,1180, &1185,1188,1190,1195,1197,1202,1207,1211,1213,1215,1217,1219,1221, &1223,1225,1226,1228,1230,1232,1234,1236,1238,1240,1242,1244,1245, &1247,1249,1262,1264,1266,1270,1272,1274,1276,1278,1280,1282,1284, &1286,1288,1299,32*0,1313,1317,1321,1324,163*0/ DATA (MDCY(I,3),I= 1, 500)/5*8,9,2*10,2*0,4,2,5,2,41,2,5,3,2*0, &9,12,16,20,17,6*0,22,0,23,20,18,9,3,1,9,42*0,1,4,9,16*0,2,4,2*8, &0,1,2,6,0,7,5,9,2*2,3,10,6,3,11,0,6,8,6,63,3,8,61,2,8,33,1,4,0,1, &3,2,36,1,8,36,1,8,39,1,4,31,1,4,1,9,2,0,1,4*0,3,3*0,3,1,2*0,2,3, &4,2*0,1,3*3,0,1,3*2,4,2*0,2*1,76,1,2*0,5*1,2*0,1,2,1,2,2*1,0,7*4, &2*0,2*1,17,1,9,2*0,5*1,9,2*0,6*1,9,2*0,8*9,0,9*9,4*1,5,3,2,5,2, &2*5,4,7*2,1,9*2,1,2*2,13,2*2,4,9*2,11,14,32*0,2*4,3,2,163*0/ DATA (MDME(I,1),I= 1,4000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, &7*1,-1,1,-1,8*1,2*-1,8*1,2*-1,60*1,-1,2*1,-1,6*1,2*-1,7*1,2*-1, &3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,-1,6*1,2*-1, &3*1,-1,11*1,2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,6*1, &2*-1,3*1,-1,5*1,-1,8*1,2*-1,3*1,-1,9*1,-1,3*1,-1,9*1,2*-1,2*1,-1, &1013*1,2675*0/ DATA (MDME(I,2),I= 1,4000)/43*102,4*0,102,0,3*102,4*0,102,2*0, &3*102,4*0,102,2*0,6*102,42,6*102,2*42,2*0,7*41,2*0,24*41,8*102,0, &102,0,102,2*0,21*102,8*32,8*0,16*32,4*0,8*32,4*0,32,4*0,8*32, &14*0,16*32,7*0,8*32,4*0,32,7*0,8*32,4*0,32,5*0,4*32,5*0,3*32,0, &6*32,3*0,12,2*42,2*11,9*42,0,2,3,13*0,4*42,3*0,3,11*0,2,2*0,1,0, &3,15*0,2*3,15*0,2*42,2*3,18*0,2*3,3*0,1,8*0,22*42,41*0,2*3,9*0, &16*42,45*0,3,10*0,10*42,20*0,2*13,5*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,40*0,14*42,52*0, &10*13,84,4*0,84,6*0,84,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,2*42,85,9*42, &4*0,85,9*42,4*0,85,0,162*42,48*0,2*12,17*0,2*32,32*0,12,9*0,32, &2*0,12,11*0,4*32,2*4,2693*0/ DATA (BRAT(I) ,I= 1, 313)/43*0D0,0.00003D0,0.00177D0,0.9982D0, &29*0D0,1D0,6*0D0,0.179D0,0.178D0,0.116D0,0.235D0,0.005D0,0.056D0, &0.018D0,0.023D0,0.011D0,2*0.004D0,0.0067D0,0.014D0,2*0.002D0, &2*0.001D0,0.0022D0,0.054D0,0.002D0,0.016D0,0.005D0,0.011D0, &0.0101D0,5*0.006D0,0.002D0,2*0.001D0,5*0.002D0,35*0D0,0.15403D0, &0.11945D0,0.15402D0,0.11931D0,0.15215D0,3*0D0,0.03357D0,0.0668D0, &0.03357D0,0.0668D0,0.0335D0,0.0668D0,2*0D0,0.32139D0,0.0165D0, &2*0D0,0.0165D0,0.32067D0,2*0D0,0.00001D0,0.00059D0,6*0D0, &2*0.10814D0,0.10806D0,3*0D0,0.00031D0,0.04438D0,0.88031D0,4*0D0, &0.0002D0,0.05531D0,0D0,0.01838D0,0.00071D0,0D0,0.00009D0, &0.00032D0,0.14449D0,0.11223D0,0.14449D0,0.11223D0,0.14443D0, &0.05782D0,2*0D0,0.03172D0,0.06305D0,0.03172D0,0.06305D0, &0.03172D0,0.06305D0,8*0D0,0.24928D0,0.0128D0,0.00001D0,0D0, &0.0128D0,0.24882D0,0.00039D0,0D0,0.00001D0,0.00046D0,0.22153D0, &5*0D0,2*0.08464D0,0.08463D0,7*0D0,0.00005D0,0.00097D0,5*0D0, &0.00007D0,0D0,0.00049D0,0.00001D0,0.00006D0,0.30591D0,0.68863D0, &0D0,0.0038D0,4*0D0,0.00008D0,0.00167D0,5*0D0,0.00013D0,0D0, &0.00294D0,0.00001D0,3*0D0,0.99517D0,0D0,0.00002D0,0.07231D0, &2*0D0,0.00001D0,0.00269D0,0D0,0.92497D0,0.0024D0,0.99483D0, &0.00278D0,1D0,3*0.21511D0,0.21478D0,2*0D0,2*0.06995D0,0D0,1D0/ DATA (BRAT(I) ,I= 314, 490)/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.99912D0,0.00079D0,0.00005D0,0.00004D0,2*0.35D0,0.144D0, &0.105D0,0.024D0,2*0.012D0,0.003D0,0.217D0,0.124D0,2*0.193D0, &2*0.135D0,0.002D0,0.001D0,1D0,0.99955D0,0.00045D0,2*0.35D0, &0.144D0,0.105D0,0.048D0,0.003D0,0.389D0,0.319D0,0.2367D0,0.049D0, &0.005D0,0.001D0,0.0003D0,0.888D0,0.085D0,0.021D0,2*0.003D0, &0.566D0,0.283D0,0.069D0,0.028D0,0.023D0,2*0.0115D0,0.005D0, &0.003D0,0.686D0,0.314D0,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.635D0,0.212D0,0.056D0,0.017D0,0.048D0,0.032D0,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.441D0,0.206D0,0.3D0,0.03D0,0.022D0, &0.001D0,0.49D0,0.344D0,3*0.043D0,0.023D0,0.013D0,0.001D0,0.356D0, &2*0.178D0,0.28D0,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/ DATA (BRAT(I) ,I= 491, 657)/0.0218D0,0.001D0,0.022D0,0.087D0, &0.001D0,0.0019D0,0.0015D0,0.0028D0,0.65D0,0.3D0,0.05D0,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.56D0,0.44D0,0.3D0,0.15D0,0.16D0,0.08D0, &0.13D0,0.06D0,0.08D0,0.04D0,0.01D0,2*0.02D0,0.03D0,2*0.005D0, &2*0.02D0,0.03D0,2*0.005D0,0.015D0,0.037D0,0.028D0,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,1D0,2*0.3D0,2*0.2D0,1D0, &0.0627D0,0.0597D0,0.8776D0,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/ DATA (BRAT(I) ,I= 658, 827)/0.02D0,0.015D0,0.005D0,1D0,0.3D0, &0.15D0,0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.02D0,0.055D0, &2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0, &0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0, &0.018D0,0.015D0,0.0185D0,0.0135D0,0.025D0,0.0004D0,0.0007D0, &0.0008D0,0.0014D0,0.0019D0,0.0025D0,0.4291D0,0.08D0,0.07D0, &0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0, &0.06D0,0.08D0,0.04D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0, &0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0, &0.011D0,0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0, &0.0135D0,0.025D0,2*0.0002D0,0.0007D0,2*0.0004D0,0.0014D0,0.001D0, &0.0009D0,0.0025D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0, &1D0,2*0.3D0,2*0.2D0,0.047D0,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,3*0.027D0,0.015D0, &0.045D0,0.015D0,0.045D0,0.77D0,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.641D0,0.357D0,2*0.001D0,1D0,0.88D0,2*0.06D0/ DATA (BRAT(I) ,I= 828,1047)/0.516D0,0.483D0,0.001D0,0.88D0, &2*0.06D0,1D0,0.667D0,0.333D0,0.995D0,0.005D0,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,7*1D0,2*0.5D0,1D0,2*0.5D0,2*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,1D0, &2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0, &5*1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, &0.005D0,6*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/ DATA (BRAT(I) ,I=1048,1229)/0.015D0,0.005D0,2*0.105D0,0.04D0, &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,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.62D0,0.31D0,0.035D0,2*0.0175D0,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/ DATA (BRAT(I) ,I=1230,4000)/0.667D0,0.333D0,0.667D0,0.333D0, &8*0.5D0,0.02D0,0.98D0,1D0,4*0.5D0,3*0.12D0,0.097D0,0.043D0, &4*0.095D0,4*0.03D0,0.667D0,0.333D0,0.667D0,0.333D0,4*0.25D0, &0.667D0,0.333D0,0.667D0,0.333D0,2*0.5D0,0.273D0,0.727D0,0.667D0, &0.333D0,0.667D0,0.333D0,4*0.5D0,0.35D0,0.65D0,2*0.0083D0, &0.1866D0,0.324D0,0.184D0,0.027D0,0.001D0,0.093D0,0.087D0,0.078D0, &0.0028D0,3*0.014D0,0.008D0,0.024D0,0.008D0,0.024D0,0.425D0, &0.02D0,0.185D0,0.088D0,0.043D0,0.067D0,0.066D0,0.8516D0, &0.00539D0,0.04483D0,0.09819D0,0.85053D0,0.02152D0,0.02989D0, &0.09806D0,0.29439D0,0.10943D0,0.59618D0,0.38983D0,0.61017D0, &2675*0D0/ DATA (KFDP(I,1),I= 1, 488)/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,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,35*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,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,36,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24, &23,-1,-3,-5,-7,-11,-13,-15,-17,24,5,6,21,2,1,2,3,4,5,6,11,13,15, &82,-11,-13,2*2,-12,-14,-16,2*-2,2*-4,-2,-4,2*22,211,111,13,11, &213,-213,221,223,321,130,310,2*111,211,-12,12,-14,14,211,111,-13, &2*211,213,113,221,223,321,211,22,111,211,2*22,211,22,211,22,211, &2*111,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,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/ DATA (KFDP(I,1),I= 489, 908)/-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,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,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, &3322,3312,2*3122,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/ DATA (KFDP(I,1),I= 909,1290)/2*3222,2*3224,4*2,3,2*2,1,2*2,0, &4*4122,0,3*4132,3*4232,0,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,0,-12,-14,-16,2*-2, &2*-4,-2,-4,4*5122,0,-12,-14,-16,2*-2,2*-4,-2,-4,2*5132,2*5232,0, &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,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, &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,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/ DATA (KFDP(I,1),I=1291,4000)/4*443,10441,20443,445,441,11,13,15, &1,2,3,4,21,22,2*553,10551,20553,555,21,22,23,-24,21,22,23,24,22, &23,-24,23,24,2675*0/ DATA (KFDP(I,2),I= 1, 416)/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,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,3*-211,-321,-323,-321,-323,3*-321, &4*-211,-213,-211,-213,-211,-213,-211,-213,-211,-213,6*-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, &-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,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25,36, &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,25,2,4,6, &8,12,14,16,18,25,-5,-6,21,11,-3,-4,-5,-6,-7,-8,-13,-15,-17,-82, &12,14,-1,-3,11,13,15,1,4,3,4,1,3,22,11,-211,22,-13,-11,-211,211, &111,211,-321,130,310,22,111,-211,11,-11,13,-13,-211,111,14,111, &22,111,3*211,-311,2*22,111,-211,211,11,-211,13,-211,111,-211, &2*111,-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/ DATA (KFDP(I,2),I= 417, 840)/111,113,223,22,111,-321,310,211,111, &2*-211,221,22,-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,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,-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,2*-211,2*111,22,111,211/ DATA (KFDP(I,2),I= 841,1253)/-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,0,2*111,2*211,0,22,111,2*22,111,22,0,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,0,11,13,15,1,4,3,4,1,3,2*111,2*211,0,11,13,15,1,4,3,4,1,3, &4*22,0,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,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, &-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/ DATA (KFDP(I,2),I=1254,4000)/-211,211,111,211,-321,2*-311,-321, &-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,3*1,4*2,1, &2*11,2*12,11,2675*0/ DATA (KFDP(I,3),I= 1, 823)/75*0,14,6*0,2*16,2*0,5*111,310,130, &2*0,2*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221, &2*113,221,113,2*213,-213,194*0,4*3,4*4,1,4,3,2*2,0,-11,7*0,-211, &4*0,2*111,211,-211,211,-211,8*0,111,3*0,2*111,-211,-11,11,-13, &111,2*0,22,111,2*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,8*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,12*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,511,513,511,513,1,2,13*0,2*21,11*0,2112,6*0,2212/ DATA (KFDP(I,3),I= 824,4000)/20*0,3322,2*0,3122,3212,3214,2112, &2114,2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1, &20*0,28*3,2*0,3*4122,8*0,4,1,4,3,2*2,0,4*4,1,4,3,2*2,5*0,4*4,1,4, &3,2*2,6*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,76*0,-211,2*111,-211,3*111,-211,111,211,29*0,-211,111, &13*0,2*21,-211,111,2691*0/ DATA (KFDP(I,4),I= 1,4000)/88*0,3*111,8*0,-211,0,-211,3*0,111, &2*-211,0,111,0,2*111,113,221,111,-213,-211,211,194*0,13*81,36*0, &-11,8*0,111,-211,4*0,111,59*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,42*0,6*1,39*0,6*2, &42*0,6*3,14*0,8*4,4*0,4*-5,4*0,2*-5,62*0,-211,111,5*0,-211,111, &52*0,2101,2103,2*2101,20*0,28*81,13*0,6*2101,0,9*81,5*0,9*81,6*0, &162*81,2825*0/ DATA (KFDP(I,5),I= 1,4000)/90*0,111,16*0,111,7*0,111,0,2*111, &372*0,-211,2*111,-211,111,-211,111,65*0,111,-211,3*111,-211,111, &3430*0/ C...PYDAT4, with particle names (character strings). DATA (CHAF(I,1),I= 1, 201)/'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',2*' ','reggeon', &'pomeron',2*' ','Z''0','Z"0','W''+','H0','A0','H+','eta_tech0', &'LQ_ue','R0',40*' ','specflav','rndmflav','phasespa','c-hadron', &'b-hadron',5*' ','cluster','string','indep.','CMshower', &'SPHEaxis','THRUaxis','CLUSjet','CELLjet','table',' ', &'rho_diff0','pi0','rho0','a_20','K_L0','pi_diffr+','pi+','rho+', &'a_2+','omega_di','eta','omega','f_2','K_S0','K0','K*0','K*_20', &'K+','K*+','K*_2+','phi_diff','eta''','phi','f''_2','D+','D*+', &'D*_2+','D0','D*0','D*_20','D_s+','D*_s+','D*_2s+','J/psi_di', &'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','dd_1','Delta-','ud_0','ud_1','n_diffr0','n0', &'Delta0','uu_1','p_diffr+','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'/ DATA (CHAF(I,1),I= 202, 332)/'Omega*_c0','cc_1','Xi_cc+', &'Xi*_cc+','Xi_cc++','Xi*_cc++','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_L','~t_1','~e_L-','~nu_eL','~mu_L-','~nu_muL', &'~tau_L-','~nu_tauL','~g','~chi_10','~chi_20','~chi_1+', &'~chi_30','~chi_40','~chi_2+','~G','~d_R','~u_R','~s_R','~c_R', &'~b_R','~t_2','~e_R-','~nu_eR','~mu_R-','~nu_muR','~tau_R-'/ DATA (CHAF(I,1),I= 333, 500)/'~nu_tauR','d*','u*','e*-','nu*_e0', &163*' '/ DATA (CHAF(I,2),I= 1, 207)/'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-',' ','LQ_uebar','Rbar0',41*' ','rndmflavbar', &' ','c-hadronbar','b-hadronbar',20*' ','pi_diffr-','pi-','rho-', &'a_2-',5*' ','Kbar0','K*bar0','K*_2bar0','K-','K*-','K*_2-', &4*' ','D-','D*-','D*_2-','Dbar0','D*bar0','D*_2bar0','D_s-', &'D*_s-','D*_2s-',4*' ','Bbar0','B*bar0','B*_2bar0','B-','B*-', &'B*_2-','B_sbar0','B*_sbar0','B*_2sbar0','B_c-','B*_c-','B*_2c-', &3*' ','dd_1bar','Deltabar+','ud_0bar','ud_1bar','n_diffrbar0', &'nbar0','Deltabar0','uu_1bar','p_diffrbar-','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--'/ DATA (CHAF(I,2),I= 208, 324)/'Omega_ccbar-','Omega*_ccbar-', &'Omega*_cccbar-','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_Lbar','~t_1bar','~e_L+', &'~nu_eLbar','~mu_L+','~nu_muLbar','~tau_L+','~nu_tauLbar',3*' ', &'~chi_1-',2*' ','~chi_2-',' ','~d_Rbar','~u_Rbar','~s_Rbar'/ DATA (CHAF(I,2),I= 325, 500)/'~c_Rbar','~b_Rbar','~t_2bar', &'~e_R+','~nu_eRbar','~mu_R+','~nu_muRbar','~tau_R+', &'~nu_tauRbar','d*bar','u*bar','e*bar+','nu*_ebar0',163*' '/ C...PYDATR, with initial values for the random number generator. DATA MRLU/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, -10D0, 10D0, 1 -10D0, 10D0, -10D0, 10D0, -10D0, 1 10D0, -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 140*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, 0, 5, 0, 0, 0, 0, 0, 2 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 3 1, 2, 0, 1, 0, 2, 1, 5, 2, 0, 4 1, 1, 3, 7, 3, 1, 1, 2, 2, 0, 5 4, 1, 1, 1, 5, 1, 1, 6, 1, 0, 6 1, 3, 2, 2, 1, 1, 2, 0, 0, 0, 7 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8 1, 1, 100, 0, 0, 0, 0, 0, 0, 0, 9 1, 4, 1, 2, 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, 40, 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, 009, 1996, 09, 03, 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.6D0, 1.0D0, 1.0D0, 3*0D0, 2 10*0D0, 3 1.5D0, 2.0D0, 0.075D0, 1.0D0, 0.2D0, 3 0D0, 2.0D0, 0.70D0, 0.006D0, 0D0, 4 0.02D0, 2.0D0, 0.10D0, 1000D0, 2054D0, 123D0, 246D0, 3*0D0, 5 1.0D0, 9*0D0, 6 0.25D0, 1.0D0,0.25D0, 1.0D0, 2.0D0,1D-3, 4.0D0,1D-3,2*0D0, 7 4.0D0, 0.25D0, 8*0D0, 8 1.40D0,1.55D0, 0.5D0, 0.2D0,0.33D0,0.66D0, 0.7D0, 0.5D0,2*0D0, 9 0.44D0, 0.20D0, 2.0D0, 1.0D0, 0D0, 9 3.0D0, 1.0D0, 0.75D0, 0.44D0, 2.0D0/ DATA (PARP(I),I=101,200)/ & 0.5D0, 0.28D0, 1.0D0, 7*0D0, 1 2.0D0, 9*0D0, 2 1.0D0, 0.4D0, 8*0D0, 3 0.01D0, 9*0D0, 4 10*0D0, 5 0D0, 0D0, 0D0, 0D0, 6*0D0, 6 2.20D0, 23.6D0, 18.4D0, 11.5D0, 6*0D0, 7 0D0, 0D0, 0D0, 1.0D0, 6*0D0, 8 20*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, -1, 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, -2, -2/ DATA (ISET(I),I=101,200)/ & -1, 1, 1, -2, -2, -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 -1, -2, -2, -2, -2, -2, -2, -2, -2, -2, 4 1, 1, 1, 1, 1, -2, 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 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2/ DATA (ISET(I),I=201,500)/300*-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, 0, 0, 0, 0, & 0, 0, 0, 0, 0, 0, 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 23, 5, 0, 0, 0, 0, 0, 0, 0, 0, 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4 32, 0, 34, 0, 37, 0, 40, 0, 39, 0, 4 0, 0, 4000001, 0, 4000002, 0, 38, 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, 39, 0, 39, 39, 39, 39, 11, 0, 6 11, 0, 0, 4000001, 0, 4000002, 0, 0, 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, 0, 0, 0, 0, 0, 0, 8 36, 6, 36, 6, 0, 0, 0, 0, 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=201,500)/600*0/ DATA COEF/10000*0D0/ DATA (((ICOL(I,J,K),K=1,2),J=1,4),I=1,40)/ 1 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, 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 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, 4 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, 5 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, 6 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, 7 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, 8 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, 9 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,0,0,0,0,0,0,0,0/ C...Treatment of resonances. DATA (MWID(I) ,I= 1, 500)/5*0,3*1,8*0,2*1,2*0,5*1,6*0,1,0,7*1, &293*0,4*1,163*0/ C...Character constants: name of processes. DATA PROC(0)/ 'All included subprocesses '/ DATA (PROC(I),I=1,20)/ 1'f + fbar -> gamma*/Z0 ', 'f + fbar'' -> W+/- ', 2'f + fbar -> h0 ', 'gamma + W+/- -> W+/- ', 3'Z0 + Z0 -> h0 ', 'Z0 + W+/- -> W+/- ', 4' ', 'W+ + W- -> h0 ', 5' ', 'f + f'' -> f + f'' (QFD) ', 6'f + f'' -> f + f'' (QCD) ','f + fbar -> f'' + fbar'' ', 7'f + fbar -> g + g ', 'f + fbar -> g + gamma ', 8'f + fbar -> g + Z0 ', 'f + fbar'' -> g + W+/- ', 9'f + fbar -> g + h0 ', 'f + fbar -> gamma + gamma ', &'f + fbar -> gamma + Z0 ', 'f + fbar'' -> gamma + W+/- '/ DATA (PROC(I),I=21,40)/ 1'f + fbar -> gamma + h0 ', 'f + fbar -> Z0 + Z0 ', 2'f + fbar'' -> Z0 + W+/- ', 'f + fbar -> Z0 + h0 ', 3'f + fbar -> W+ + W- ', 'f + fbar'' -> W+/- + h0 ', 4'f + fbar -> h0 + h0 ', 'f + g -> f + g ', 5'f + g -> f + gamma ', 'f + g -> f + Z0 ', 6'f + g -> f'' + W+/- ', 'f + g -> f + h0 ', 7'f + gamma -> f + g ', 'f + gamma -> f + gamma ', 8'f + gamma -> f + Z0 ', 'f + gamma -> f'' + W+/- ', 9'f + gamma -> f + h0 ', 'f + Z0 -> f + g ', &'f + Z0 -> f + gamma ', 'f + Z0 -> f + Z0 '/ DATA (PROC(I),I=41,60)/ 1'f + Z0 -> f'' + W+/- ', 'f + Z0 -> f + h0 ', 2'f + W+/- -> f'' + g ', 'f + W+/- -> f'' + gamma ', 3'f + W+/- -> f'' + Z0 ', 'f + W+/- -> f'' + W+/- ', 4'f + W+/- -> f'' + h0 ', 'f + h0 -> f + g ', 5'f + h0 -> f + gamma ', 'f + h0 -> f + Z0 ', 6'f + h0 -> f'' + W+/- ', 'f + h0 -> f + h0 ', 7'g + g -> f + fbar ', 'g + gamma -> f + fbar ', 8'g + Z0 -> f + fbar ', 'g + W+/- -> f + fbar'' ', 9'g + h0 -> f + fbar ', 'gamma + gamma -> f + fbar ', &'gamma + Z0 -> f + fbar ', 'gamma + W+/- -> f + fbar'' '/ DATA (PROC(I),I=61,80)/ 1'gamma + h0 -> f + fbar ', 'Z0 + Z0 -> f + fbar ', 2'Z0 + W+/- -> f + fbar'' ', 'Z0 + h0 -> f + fbar ', 3'W+ + W- -> f + fbar ', 'W+/- + h0 -> f + fbar'' ', 4'h0 + h0 -> f + fbar ', 'g + g -> g + g ', 5'gamma + gamma -> W+ + W- ', 'gamma + W+/- -> Z0 + W+/- ', 6'Z0 + Z0 -> Z0 + Z0 ', 'Z0 + Z0 -> W+ + W- ', 7'Z0 + W+/- -> Z0 + W+/- ', 'Z0 + Z0 -> Z0 + h0 ', 8'W+ + W- -> gamma + gamma ', 'W+ + W- -> Z0 + Z0 ', 9'W+/- + W+/- -> W+/- + W+/- ', 'W+/- + h0 -> W+/- + h0 ', &'h0 + h0 -> h0 + h0 ', 'q + gamma -> q'' + pi+/- '/ DATA (PROC(I),I=81,100)/ 1'q + qbar -> Q + Qbar, mass ', 'g + g -> Q + Qbar, massive ', 2'f + q -> f'' + Q, massive ', 'g + gamma -> Q + Qbar, mass ', 3'gamma + gamma -> F + Fbar, m', 'g + g -> J/Psi + g ', 4'g + g -> chi_0c + g ', 'g + g -> chi_1c + g ', 5'g + g -> chi_2c + g ', ' ', 6'Elastic scattering ', 'Single diffractive (XB) ', 7'Single diffractive (AX) ', 'Double diffractive ', 8'Low-pT scattering ', 'Semihard QCD 2 -> 2 ', 9' ', ' ', &' ', ' '/ DATA (PROC(I),I=101,120)/ 1'g + g -> gamma*/Z0 ', 'g + g -> h0 ', 2'gamma + gamma -> h0 ', ' ', 3' ', ' ', 4' ', ' ', 5' ', 'f + fbar -> gamma + h0 ', 6'f + fbar -> g + h0 ', 'q + g -> q + h0 ', 7'g + g -> g + h0 ', 'g + g -> gamma + gamma ', 8'g + g -> g + gamma ', 'g + g -> gamma + Z0 ', 9'g + g -> Z0 + Z0 ', 'g + g -> W+ + W- ', &' ', ' '/ DATA (PROC(I),I=121,140)/ 1'g + g -> Q + Qbar + h0 ', 'q + qbar -> Q + Qbar + h0 ', 2'f + f'' -> f + f'' + h0 ', 2'f + f'' -> f" + f"'' + h0 ', 3' ', ' ', 4' ', ' ', 5' ', ' ', 6'g + g -> Z0 + q + qbar ', ' ', 7' ', ' ', 8' ', ' ', 9' ', ' ', &' ', ' '/ DATA (PROC(I),I=141,160)/ 1'f + fbar -> gamma*/Z0/Z''0 ', 'f + fbar'' -> W''+/- ', 2'f + fbar'' -> H+/- ', 'f + fbar'' -> R ', 3'q + l -> LQ ', ' ', 4'd + g -> d* ', 'u + g -> u* ', 5'g + g -> eta_techni ', ' ', 6'f + fbar -> H0 ', 'g + g -> H0 ', 7'gamma + gamma -> H0 ', ' ', 8' ', 'f + fbar -> A0 ', 9'g + g -> A0 ', 'gamma + gamma -> A0 ', &' ', ' '/ DATA (PROC(I),I=161,180)/ 1'f + g -> f'' + H+/- ', 'q + g -> LQ + lbar ', 2'g + g -> LQ + LQbar ', 'q + qbar -> LQ + LQbar ', 3'f + fbar -> f'' + fbar'' (g/Z)', 3'f +fbar'' -> f" + fbar"'' (W) ', 4'q + q'' -> q" + d* ', 'q + q'' -> q" + u* ', 5' ', ' ', 6'f + fbar -> Z0 + H0 ', 'f + fbar'' -> W+/- + H0 ', 7'f + f'' -> f + f'' + H0 ', 7'f + f'' -> f" + f"'' + H0 ', 8' ', 'f + fbar -> Z0 + A0 ', 9'f + fbar'' -> W+/- + A0 ', 9'f + f'' -> f + f'' + A0 ', &'f + f'' -> f" + f"'' + A0 ', &' '/ DATA (PROC(I),I=181,200)/ 1'g + g -> Q + Qbar + H0 ', 'q + qbar -> Q + Qbar + H0 ', 2' ', ' ', 3' ', 'g + g -> Q + Qbar + A0 ', 4'q + qbar -> Q + Qbar + A0 ', ' ', 5' ', ' ', 6' ', ' ', 7' ', ' ', 8' ', ' ', 9' ', ' ', &' ', ' '/ DATA (PROC(I),I=201,500)/300*' '/ C...Cross sections and slope offsets. DATA SIGT/294*0D0/ 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) 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(4000,2),BRAT(4000),KFDP(4000,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.4D0) & 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 200 ISUB=1,500 MSUB(ISUB)=0 200 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('USER','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 205 J=1,4 PFIN(J)=PYP(0,J) 205 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 RETURN 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!') 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) 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 140 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 IF(I.GE.INEW+3.AND.K(I-1,1).EQ.21.AND.K(I-1,3).EQ.0) & IMO1=IMO1-1 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 120 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 120 KC=PYCOMP(K(I1,2)) IF(I1.LT.I.AND.KC.EQ.0) GOTO 120 IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120 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 130 I1=JDAHEP(1,I),JDAHEP(2,I) I2=MOD(K(I1,4)/MSTU(5),MSTU(5)) JDAHEP(1,I2)=I 130 CONTINUE ENDIF IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140 I1=JMOHEP(1,I) IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140 IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140 IF(JDAHEP(1,I1).EQ.0) THEN JDAHEP(1,I1)=I ELSE JDAHEP(2,I1)=I ENDIF 140 CONTINUE DO 150 I=1,NHEP IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150 IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I) 150 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 180 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 160 J=1,5 P(I,J)=PHEP(J,I) 160 CONTINUE DO 170 J=1,4 V(I,J)=VHEP(J,I) 170 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 180 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) 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(4000,2),BRAT(4000),KFDP(4000,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*8,CHBEAM*8,CHTARG*8,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; months. DATA ALAMIN/0.177D0,0.239D0,0.247D0,0.2D0,16*0.2D0/,NFIN/20*4/ DATA CHLH/'lepton','hadron'/ C...Reset MINT and VINT arrays. Write headers. 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...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) 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.10) 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 widths and partial widths for resonances. CALL PYINRE 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 MINT(123)=MSTP(14) 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)).GE.28.OR.IABS(MINT(12)).GE.28)) 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 ENDIF C...Set up kinematics of process. CALL PYINKI(0) C...Loop over gamma-p or gamma-gamma alternatives. DO 160 IGA=1,MINT(121) MINT(122)=IGA C...Select partonic subprocesses to be included in the simulation. CALL PYINPR 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) 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 IF(MINT(48).EQ.0) THEN WRITE(MSTU(11),5500) STOP ENDIF MINT(49)=MINT(48)-MSUB(91)-MSUB(92)-MSUB(93)-MSUB(94) 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 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.AND.(MINT(49).NE.0.OR.MSTP(131).NE.0).AND. & MSTP(82).GE.2) CALL PYMULT(1) C...Save results for gamma-p and gamma-gamma alternatives. IF(MINT(121).GT.1) CALL PYSAVE(1,IGA) 160 CONTINUE C...Initialization finished. 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('*')) 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) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) 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/PYUPPR/NUP,KUP(20,7),NFUP,IFUP(10,2),PUP(20,5),Q2UP(0:10) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/, &/PYINT5/,/PYUPPR/ C...Local array. DIMENSION VTX(4) 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) THEN C...Hard scattering (including low-pT): C...reconstruct kinematics and colour flow of hard scattering. 110 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 130 C...Showering of initial state partons (optional). 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(MSTP(71).GE.1.AND.ISET(ISUB).EQ.11.AND.NFUP.GE.1) THEN DO 120 IUP=1,NFUP IPU3=IFUP(IUP,1)+MINT(84) IPU4=IFUP(IUP,2)+MINT(84) QMAX=SQRT(MAX(0D0,Q2UP(IUP))) CALL PYSHOW(IPU3,IPU4,QMAX) 120 CONTINUE ENDIF PARJ(81)=ALAMSV C...Decay of final state resonances. IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10) CALL PYRESD 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. 130 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 ELSE C...Diffractive and elastic scattering. CALL PYDIFF ENDIF 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+3) 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) 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) 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(4000,2),BRAT(4000),KFDP(4000,5) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) 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 SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, &/PYINT4/,/PYINT5/,/PYINT6/ C...Local arrays, character variables and data. DIMENSION WDTP(0:100),WDTE(0:100,0:5) CHARACTER PROGA(6)*28,CHAU*16,CHKF*16,CHD1*16,CHD2*16,CHIN(2)*12, &STATE(-1:5)*4,CHKIN(21)*18,DISGA(2)*28 DATA PROGA/ &'VMD/hadron * VMD ','VMD/hadron * direct ', &'VMD/hadron * anomalous ','direct * direct ', &'direct * anomalous ','anomalous * anomalous '/ DATA DISGA/'e * VMD','e * anomalous'/ 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'' '/ 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) THEN WRITE(MSTU(11),5200) IGA,DISGA(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 150 KC=1,500 KF=KCHG(KC,4) CALL PYNAME(KF,CHKF) IOFF=0 IF(KC.LE.20) THEN IF(KC.GT.2*MSTP(1).AND.KC.LE.10) GOTO 150 IF(KC.GT.10+2*MSTP(1).AND.KC.LE.20) GOTO 150 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 ELSE IF(MWID(KC).LE.0) GOTO 150 IF(KC.LE.22) IOFF=1 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:9), & PMAS(KC,1),0D0,0D0,STATE(MDCY(KC,1)),0D0 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 CALL PYNAME(KFDP(IDC,1),CHD1) CALL PYNAME(KFDP(IDC,2),CHD2) IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND.NGP2.LE. & MSTP(1)) WRITE(MSTU(11),5800) IDC,CHD1(1:9), & CHD2(1:9),0D0,0D0,STATE(MDME(IDC,1)),0D0 130 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:9),PMAS(KC,1),WDTP(0),1D0, & STATE(MDCY(KC,1)),BRFIN DO 140 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 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(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1)) & WRITE(MSTU(11),5800) IDC,CHD1(1:9), & CHD2(1:9),WDTP(J),WDTP(J)/WDTP(0), & STATE(MDME(IDC,1)),BRFIN 140 CONTINUE ENDIF 150 CONTINUE WRITE(MSTU(11),5900) C...Allowed incoming partons/particles at hard interaction. ELSEIF(MSTAT.EQ.3) THEN WRITE(MSTU(11),6000) CALL PYNAME(MINT(11),CHAU) CHIN(1)=CHAU(1:12) CALL PYNAME(MINT(12),CHAU) CHIN(2)=CHAU(1:12) WRITE(MSTU(11),6100) CHIN(1),CHIN(2) DO 170 I=-20,22 IF(I.EQ.0) GOTO 170 IA=IABS(I) IF(IA.GT.MSTP(58).AND.IA.LE.10) GOTO 170 IF(IA.GT.10+2*MSTP(1).AND.IA.LE.20) GOTO 170 CALL PYNAME(I,CHAU) WRITE(MSTU(11),6200) CHAU,STATE(KFIN(1,I)),CHAU, & STATE(KFIN(2,I)) 170 CONTINUE WRITE(MSTU(11),6300) C...User-defined limits on kinematical variables. ELSEIF(MSTAT.EQ.4) THEN WRITE(MSTU(11),6400) WRITE(MSTU(11),6500) SHRMAX=CKIN(2) IF(SHRMAX.LT.0D0) SHRMAX=VINT(1) WRITE(MSTU(11),6600) 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),6700) CKIN(3),PTHMIN,CHKIN(2),PTHMAX WRITE(MSTU(11),6800) CHKIN(3),CKIN(6) DO 180 I=4,14 WRITE(MSTU(11),6600) CKIN(2*I-1),CHKIN(I),CKIN(2*I) 180 CONTINUE SPRMAX=CKIN(32) IF(SPRMAX.LT.0D0) SPRMAX=VINT(1) WRITE(MSTU(11),6600) CKIN(31),CHKIN(15),SPRMAX WRITE(MSTU(11),6900) C...Status codes and parameter values. ELSEIF(MSTAT.EQ.5) THEN WRITE(MSTU(11),7000) WRITE(MSTU(11),7100) DO 190 I=1,100 WRITE(MSTU(11),7200) I,MSTP(I),PARP(I),100+I,MSTP(100+I), & PARP(100+I) 190 CONTINUE 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',19('*'),1X,'PYSTAT: Decay Widths and Branching ', &'Ratios',1X,19('*')) 5600 FORMAT(/1X,82('=')/1X,'I',33X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/ &1X,'I',5X,'Branching/Decay Channel',5X,'I',1X,'Width (GeV)',1X, &'I',7X,'B.R.',1X,'I',1X,'Stat',1X,'I',2X,'Eff. B.R.',1X,'I'/1X, &'I',33X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,82('=')) 5700 FORMAT(1X,'I',33X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,'I',1X, &I8,1X,A9,'(',1P,D8.2,0P,')',1X,'->',1X,'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,1X,A9,1X,'+',1X,A9,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') 5900 FORMAT(1X,'I',33X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,82('=')) 6000 FORMAT('1',7('*'),1X,'PYSTAT: Allowed Incoming Partons/', &'Particles at Hard Interaction',1X,7('*')) 6100 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') 6200 FORMAT(1X,'I',1X,A9,5X,A4,19X,'I',1X,A9,5X,A4,18X,'I') 6300 FORMAT(1X,'I',38X,'I',37X,'I'/1X,78('=')) 6400 FORMAT('1',12('*'),1X,'PYSTAT: User-Defined Limits on ', &'Kinematical Variables',1X,12('*')) 6500 FORMAT(/1X,78('=')/1X,'I',76X,'I') 6600 FORMAT(1X,'I',16X,1P,D10.3,0P,1X,'<',1X,A,1X,'<',1X,1P,D10.3,0P, &16X,'I') 6700 FORMAT(1X,'I',3X,1P,D10.3,0P,1X,'(',1P,D10.3,0P,')',1X,'<',1X,A, &1X,'<',1X,1P,D10.3,0P,16X,'I') 6800 FORMAT(1X,'I',29X,A,1X,'=',1X,1P,D10.3,0P,16X,'I') 6900 FORMAT(1X,'I',76X,'I'/1X,78('=')) 7000 FORMAT('1',12('*'),1X,'PYSTAT: Summary of Status Codes and ', &'Parameter Values',1X,12('*')) 7100 FORMAT(/3X,'I',4X,'MSTP(I)',9X,'PARP(I)',20X,'I',4X,'MSTP(I)',9X, &'PARP(I)'/) 7200 FORMAT(1X,I3,5X,I6,6X,1P,D10.3,0P,18X,I3,5X,I6,6X,1P,D10.3) 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) 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(4000,2),BRAT(4000),KFDP(4000,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 SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, &/PYINT1/,/PYINT2/,/PYINT4/,/PYINT6/ C...Local arrays and data. DIMENSION WDTP(0:100),WDTE(0:100,0:5),WDTPM(0:100), &WDTEM(0:100,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 160 I=1,500 DO 150 J=1,5 WIDS(I,J)=1D0 150 CONTINUE 160 CONTINUE C...Order resonances by increasing mass (except Z0 and W+/-). NRES=0 DO 200 KC=1,500 IF(KCHG(KC,4).EQ.0) GOTO 200 IF(MWID(KC).EQ.0.OR.KC.EQ.21.OR.KC.EQ.22) GOTO 200 IF(KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18) THEN IF(MSTP(1).LE.3) GOTO 200 IF(KC.EQ.18.AND.PMORD(I).LT.1D0) GOTO 200 ENDIF NRES=NRES+1 PMRES=PMAS(KC,1) IF(KC.EQ.22.OR.KC.EQ.23) PMRES=0D0 DO 180 I1=NRES-1,1,-1 IF(PMRES.GE.PMORD(I1)) GOTO 190 KCORD(I1+1)=KCORD(I1) PMORD(I1+1)=PMORD(I1) 180 CONTINUE 190 KCORD(I1+1)=KC PMORD(I1+1)=PMRES 200 CONTINUE C...Loop over possible resonances. DO 250 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 220 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 220 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 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 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))/WDTP(0)**2 WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) WIDS(KC,3)=0D0 WIDS(KC,4)=0D0 WIDS(KC,5)=0D0 ELSE CALL PYWIDT(-KF,PMR**2,WDTPM,WDTEM) MINT(51)=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))/WDTP(0)**2 WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) WIDS(KC,3)=(WDTEM(0,1)+WDTEM(0,3)+WDTEM(0,4))/WDTP(0) 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))/WDTP(0)**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))/WDTP(0)**2 ENDIF C...Set resonance widths and branching ratios; C...also on/off switch for decays. IF(MWID(KC).EQ.1) THEN PMAS(KC,2)=WDTP(0) PMAS(KC,3)=MIN(0.9D0*PMAS(KC,1),10D0*PMAS(KC,2)) MDCY(KC,1)=MSTP(41) DO 240 J=1,MDCY(KC,3) IDC=J+MDCY(KC,2)-1 BRAT(IDC)=0D0 IF(WDTE(0,0).GT.0D0) BRAT(IDC)=WDTE(J,0)/WDTE(0,0) 240 CONTINUE ENDIF 250 CONTINUE C...Flavours of leptoquark: redefine charge and name. KFLQQ=KFDP(MDCY(39,2),1) KFLQL=KFDP(MDCY(39,2),2) KCHG(39,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(39,1)='LQ_'//CHAF(IABS(KFLQQ),1)(1:1)// &CHAF(IABS(KFLQL),1)(1:LL)//' ' CHAF(39,2)=CHAF(39,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) 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) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ C...Local arrays, character variables and data. CHARACTER CHFRAM*8,CHBEAM*8,CHTARG*8,CHCOM(3)*8,CHALP(2)*26, &CHIDNT(3)*8,CHTEMP*8,CHCDE(29)*8,CHINIT*76 DIMENSION LEN(3),KCDE(29),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_tauba','pi+ ','pi- ', &'n0 ','nbar0 ','p+ ','pbar- ','gamma ', &'lambda0 ','sigma- ','sigma0 ','sigma+ ','xi- ', &'xi0 ','omega- ','pi0 ','reggeon ','pomeron '/ 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,28,29/ C...Store initial energy. Default frame. VINT(290)=WIN MINT(111)=0 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)=8 DO 110 LL=8,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,6 IF(CHIDNT(I)(LL:LL).EQ.'~') THEN CHTEMP=CHIDNT(I) CHIDNT(I)=CHTEMP(1:LL-1)//'bar'//CHTEMP(LL+1:6)//' ' ENDIF 120 CONTINUE IF(CHIDNT(I)(7:7).EQ.'~') CHIDNT(I)(7:8)='ba' 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 150 I=1,2 DO 140 J=1,29 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) 150 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:3).EQ.'use') 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=(12-(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-specified 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:4).EQ.'four') 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=(12-(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-specified 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:4).EQ.'five') 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=(12-(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-specified 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...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!') 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) 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) 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) 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) 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) 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) 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 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) VINT(3)=P(1,5) IF(MINT(111).GE.4) VINT(4)=P(2,5) 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 IF(MINT(121).GT.1) PARP(81)=1.30D0+0.15D0*LOG(VINT(1)/200D0)/ & LOG(900D0/200D0) PTMN=PARP(81) ELSE IF(MINT(121).GT.1) PARP(82)=1.25D0+0.15D0*LOG(VINT(1)/200D0)/ & LOG(900D0/200D0) PTMN=PARP(82) ENDIF VINT(149)=4D0*PTMN**2/S 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) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYDAT3/MDCY(500,3),MDME(4000,2),BRAT(4000),KFDP(4000,5) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) SAVE /PYDAT1/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/ C...Reset processes to be included. IF(MSEL.NE.0) THEN DO 100 I=1,500 MSUB(I)=0 100 CONTINUE ENDIF C...For e-gamma witn MSTP(14)=10 allow mixture of VMD and anomalous. IF(MINT(121).EQ.2) THEN MSUB(10)=1 MINT(123)=MINT(122)+1 C...For gamma-p or gamma-gamma with MSTP(14)=10 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. MSTP(57)=3 MSTP(85)=0 PARP(2)=2D0 PARU(115)=1D0 CKIN(5)=0.2D0 CKIN(6)=0.2D0 C...Define pT cut-off parameters and whether run involves low-pT. IF(MSTP(82).LE.1) THEN PTMVMD=1.30D0+0.15D0*LOG(VINT(1)/200D0)/LOG(900D0/200D0) ELSE PTMVMD=1.25D0+0.15D0*LOG(VINT(1)/200D0)/LOG(900D0/200D0) ENDIF 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/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 PARP(81)=PTMVMD PARP(82)=PTMVMD 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(33)=1 MSUB(54)=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(MSTP(82).GE.2) MSTP(85)=1 IF(IPTL.EQ.1) CKIN(3)=PTMANO C...Set up for direct * direct gamma (switch off leptons). ELSEIF(MINT(122).EQ.4) THEN MINT(123)=0 MSUB(58)=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(33)=1 MSUB(54)=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(MSTP(82).GE.2) MSTP(85)=1 IF(IPTL.EQ.1) CKIN(3)=PTMANO ENDIF C...End of special set up for gamma-p and gamma-gamma. CKIN(1)=2D0*CKIN(3) ENDIF C...Flavour information for individual beams. DO 120 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 IF(MINT(10+I).EQ.28.OR.MINT(10+I).EQ.29) MINT(40+I)=2 MINT(44+I)=MINT(40+I) IF(MSTP(11).GE.1.AND.IABS(MINT(10+I)).EQ.11) MINT(44+I)=3 120 CONTINUE C...If two gammas, whereof one direct, pick the first. IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN IF(MINT(123).GE.4.AND.MINT(123).LE.6) THEN MINT(41)=1 MINT(45)=1 ENDIF ELSEIF(MINT(11).EQ.22.OR.MINT(12).EQ.22) THEN IF(MINT(123).GE.4) 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 MINT(50)=0 IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) MINT(50)=1 IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND.MINT(123).GE.3) &MINT(50)=0 MINT(107)=0 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 ENDIF MINT(108)=0 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 ENDIF C...Select default processes according to incoming beams C...(already done for gamma-p and gamma-gamma with MSTP(14)=10). 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(34)=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. MSUB(58)=1 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. MSUB(33)=1 MSUB(34)=1 MSUB(54)=1 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 IF(MSTP(82).LE.1.AND.CKIN(3).LT.PARP(81)) MSUB(95)=1 IF(MSTP(82).GE.2.AND.CKIN(3).LT.PARP(82)) 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 130 J=1,MIN(8,MDCY(21,3)) MDME(MDCY(21,2)+J-1,1)=0 130 CONTINUE MDME(MDCY(21,2)+MSEL-1,1)=1 MSUB(85)=1 DO 140 J=1,MIN(12,MDCY(22,3)) MDME(MDCY(22,2)+J-1,1)=0 140 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 150 J=1,MIN(8,MDCY(21,3)) MDME(MDCY(21,2)+J-1,1)=0 150 CONTINUE MDME(MDCY(21,2)+MSEL-31,1)=1 ENDIF C...Find heaviest new quark flavour allowed in processes 81-84. KFLQM=1 DO 160 I=1,MIN(8,MDCY(21,3)) IDC=I+MDCY(21,2)-1 IF(MDME(IDC,1).LE.0) GOTO 160 KFLQM=I 160 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 170 I=1,MIN(12,MDCY(22,3)) IDC=I+MDCY(22,2)-1 IF(MDME(IDC,1).LE.0) GOTO 170 KFLFM=KFDP(IDC,1) 170 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 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) 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/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) COMMON/PYINT7/SIGT(0:6,0:6,0:5) SAVE /PYDAT1/,/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) 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) IPROC=22 ELSEIF(KF2.GT.100) THEN IPROC=23 IF(MINT(123).EQ.2) IPROC=24 ELSE IPROC=25 IF(MINT(123).EQ.2) 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.1.5D0*(PMA+PMB)) 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 DO 140 I=1,4 CONV=AEM/PARP(160+I) 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 DO 170 I=1,4 CONV=AEM/PARP(160+I) 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 DO 210 I1=1,4 DO 200 I2=1,4 CONV=AEM**2/(PARP(160+I1)*PARP(160+I2)) 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) 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/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/,/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) DATA CVAR/'tau ','tau''','y* ','cth '/ DATA SIGSSM/3*0D0/ C...Select subprocess to study: skip cases not applicable. NPOSI=0 VINT(143)=1D0 VINT(144)=1D0 XSEC(0,1)=0D0 DO 440 ISUB=1,500 MINT(51)=0 IF(ISET(ISUB).EQ.11) THEN XSEC(ISUB,1)=1.00001D0*COEF(ISUB,1) NPOSI=NPOSI+1 GOTO 430 ELSEIF(ISUB.GE.91.AND.ISUB.LE.95) THEN XSEC(ISUB,1)=SIGT(0,0,ISUB-90) IF(MSUB(ISUB).NE.1) GOTO 440 NPOSI=NPOSI+1 GOTO 430 ELSEIF(ISUB.EQ.96) THEN IF(MINT(50).EQ.0) GOTO 440 IF(MSUB(95).NE.1.AND.MSTP(81).LE.0.AND.MSTP(131).LE.0) & GOTO 440 IF(MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 440 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 440 ELSE IF(MSUB(ISUB).NE.1) GOTO 440 ENDIF MINT(1)=ISUB 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=30 PMAS(30,1)=PARP(45) PMAS(30,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) ENDIF ENDIF CKMX=CKIN(2) IF(CKMX.LE.0D0) CKMX=VINT(1) KCR1=PYCOMP(KFR1) IF(KFR1.NE.0) THEN IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 ENDIF IF(KFR1.NE.0) THEN TAUR1=PMAS(KCR1,1)**2/VINT(2) GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) MINT(72)=1 MINT(73)=KFR1 VINT(73)=TAUR1 VINT(74)=GAMR1 ENDIF IF(ISUB.EQ.141) THEN KFR2=23 KCR2=PYCOMP(KFR2) TAUR2=PMAS(KCR2,1)**2/VINT(2) 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. 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 100 I=1,2 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 ENDIF 100 CONTINUE IF(NBW.GE.1) THEN CALL PYOFSH(3,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) IF(MINT(51).EQ.1) THEN WRITE(MSTU(11),5100) ISUB MSUB(ISUB)=0 GOTO 440 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) VINT(71)=PARP(81) IF(ISUB.EQ.96.AND.MSTP(82).GE.2) VINT(71)=0.08D0*PARP(82) ELSEIF(ISTSB.EQ.6) THEN CALL PYOFSH(5,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) IF(MINT(51).EQ.1) THEN WRITE(MSTU(11),5100) ISUB MSUB(ISUB)=0 GOTO 440 ENDIF SQM3=PQM3**2 SQM4=PQM4**2 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) VINT(204)=PMAS(23,1) IF(ISUB.EQ.124) VINT(204)=PMAS(24,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) VINT(204)=VINT(201) VINT(209)=VINT(204) 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.OR.ISTSB.EQ.6) NPTS(1)=1 ELSEIF(MINT(47).EQ.5) THEN IF(ISTSB.LE.2.OR.ISTSB.GE.6) 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).EQ.5) NPTS(2)=3 ENDIF NPTS(3)=1 IF(MINT(47).GE.4) NPTS(3)=3 IF(MINT(45).EQ.3) NPTS(3)=NPTS(3)+1 IF(MINT(46).EQ.3) NPTS(3)=NPTS(3)+1 NPTS(4)=1 IF(ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6) NPTS(4)=5 NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4) C...Reset coefficients of cross-section weighting. DO 110 J=1,20 COEF(ISUB,J)=0D0 110 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 140 ITRY=1,NTRY MINT(51)=0 IF(METAU.EQ.1) GOTO 140 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 CALL PYKMAP(1,MTAU,0.5D0) IF(ISTSB.GE.3.AND.ISTSB.LE.5) CALL PYKLIM(4) METAUP=MINT(51) ENDIF IF(METAUP.EQ.1) GOTO 140 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 140 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 140 IF(ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6) 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 140 NACC=NACC+1 MVARPT(NACC,1)=MTAU MVARPT(NACC,2)=MTAUP MVARPT(NACC,3)=MYST MVARPT(NACC,4)=MCTH DO 120 J=1,30 VINTPT(NACC,J)=VINT(10+J) 120 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 130 IKIN3=1,MSTP(129) CALL PYKMAP(5,0,0D0) IF(MINT(51).EQ.1) GOTO 130 CALL PYSIGH(NCHN,SIGTMP) IF(MWTXS.EQ.1) THEN CALL PYEVWT(WTXS) SIGTMP=WTXS*SIGTMP ENDIF IF(SIGTMP.GT.SIGS) SIGS=SIGTMP 130 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 140 CONTINUE IF(NACC.EQ.0) THEN WRITE(MSTU(11),5100) ISUB MSUB(ISUB)=0 GOTO 440 ELSEIF(SIGSAM.EQ.0D0) THEN WRITE(MSTU(11),5300) ISUB MSUB(ISUB)=0 GOTO 440 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-6,1D0-TAUMIN)/MAX(2D-6,1D0-TAUMAX)) ENDIF C...Reset. Sum up cross-sections in points calculated. DO 300 IVAR=1,4 IF(NPTS(IVAR).EQ.1) GOTO 300 IF(ISUB.EQ.96.AND.IVAR.EQ.4) GOTO 300 NBIN=NPTS(IVAR) DO 160 J1=1,NBIN NAREL(J1)=0 WTREL(J1)=0D0 COEFU(J1)=0D0 DO 150 J2=1,NBIN WTMAT(J1,J2)=0D0 150 CONTINUE 160 CONTINUE DO 170 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-6,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-6,1D0-TAUPMN)/MAX(2D-6,1D0-TAUPMX)) WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAUP1/ATAUP3)* & TAUP/MAX(2D-6,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-6,EXP(YST0-YSTMIN)-1D0)/ & MAX(1D-6,EXP(YST0-YSTMAX)-1D0)) WTMAT(IBIN,4)=WTMAT(IBIN,4)+(AYST0/AYST4)/ & MAX(1D-6,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-6,EXP(YST0+YSTMAX)-1D0)/ & MAX(1D-6,EXP(YST0+YSTMIN)-1D0)) WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(AYST0/AYST5)/ & MAX(1D-6,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 170 CONTINUE C...Check that equation system solvable; else trivial way out. IF(MSTP(122).GE.2) WRITE(MSTU(11),5400) CVAR(IVAR) MSOLV=1 WTRELS=0D0 DO 180 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) 180 CONTINUE IF(MSOLV.EQ.0) THEN DO 190 IBIN=1,NBIN COEFU(IBIN)=1D0 WTRELN(IBIN)=0.1D0 IF(WTRELS.GT.0D0) WTRELN(IBIN)=MAX(0.1D0, & WTREL(IBIN)/WTRELS) 190 CONTINUE C...Solve to find relative importance of cross-section pieces. ELSE 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 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...Normalize coefficients, with piece shared democratically. COEFSU=0D0 WTRELS=0D0 DO 260 IBIN=1,NBIN COEFU(IBIN)=MAX(0D0,COEFU(IBIN)) COEFSU=COEFSU+COEFU(IBIN) WTRELS=WTRELS+WTRELN(IBIN) 260 CONTINUE IF(COEFSU.GT.0D0) THEN DO 270 IBIN=1,NBIN COEFO(IBIN)=PARP(122)/NBIN+(1D0-PARP(122))*0.5D0* & (COEFU(IBIN)/COEFSU+WTRELN(IBIN)/WTRELS) 270 CONTINUE ELSE DO 280 IBIN=1,NBIN COEFO(IBIN)=1D0/NBIN 280 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 290 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) 290 CONTINUE IF(MSTP(122).GE.2) WRITE(MSTU(11),5600) CVAR(IVAR), & (COEFO(IBIN),IBIN=1,NBIN) 300 CONTINUE C...Find two most promising maxima among points previously determined. DO 310 J=1,4 IACCMX(J)=0 SIGSMX(J)=0D0 310 CONTINUE NMAX=0 DO 370 IACC=1,NACC DO 320 J=1,30 VINT(10+J)=VINTPT(IACC,J) 320 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 330 IKIN3=1,MSTP(129) CALL PYKMAP(5,0,0D0) IF(MINT(51).EQ.1) GOTO 330 CALL PYSIGH(NCHN,SIGTMP) IF(MWTXS.EQ.1) THEN CALL PYEVWT(WTXS) SIGTMP=WTXS*SIGTMP ENDIF IF(SIGTMP.GT.SIGS) SIGS=SIGTMP 330 CONTINUE ENDIF IEQ=0 DO 340 IMV=1,NMAX IF(ABS(SIGS-SIGSMX(IMV)).LT.1D-4*(SIGS+SIGSMX(IMV))) IEQ=IMV 340 CONTINUE IF(IEQ.EQ.0) THEN DO 350 IMV=NMAX,1,-1 IIN=IMV+1 IF(SIGS.LE.SIGSMX(IMV)) GOTO 360 IACCMX(IMV+1)=IACCMX(IMV) SIGSMX(IMV+1)=SIGSMX(IMV) 350 CONTINUE IIN=1 360 IACCMX(IIN)=IACC SIGSMX(IIN)=SIGS IF(NMAX.LE.1) NMAX=NMAX+1 ENDIF 370 CONTINUE C...Read out starting position for search. IF(MSTP(122).GE.2) WRITE(MSTU(11),5700) SIGSAM=SIGSMX(1) DO 420 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 410 IRPT=1,2 DO 400 IVAR=1,4 IF(NPTS(IVAR).EQ.1) GOTO 400 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 390 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. IF(IVAR.EQ.1) THEN VTAU=VNEW CALL PYKMAP(1,MTAU,VTAU) IF(ISTSB.GE.3.AND.ISTSB.LE.5) CALL PYKLIM(4) ENDIF IF(IVAR.LE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5) THEN IF(IVAR.EQ.2) VTAUP=VNEW CALL PYKMAP(4,MTAUP,VTAUP) ENDIF IF(IVAR.LE.2) CALL PYKLIM(2) IF(IVAR.LE.3) THEN IF(IVAR.EQ.3) VYST=VNEW CALL PYKMAP(2,MYST,VYST) CALL PYKLIM(3) ENDIF IF(ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6) THEN IF(IVAR.EQ.4) VCTH=VNEW CALL PYKMAP(3,MCTH,VCTH) ENDIF IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1D0-VINT(23)**2) C...Evaluate cross-section. Save new maximum. Final maximum. 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 380 IKIN3=1,MSTP(129) CALL PYKMAP(5,0,0D0) IF(MINT(51).EQ.1) GOTO 380 CALL PYSIGH(NCHN,SIGTMP) IF(MWTXS.EQ.1) THEN CALL PYEVWT(WTXS) SIGTMP=WTXS*SIGTMP ENDIF IF(SIGTMP.GT.SIGS) SIGS=SIGTMP 380 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 390 CONTINUE 400 CONTINUE 410 CONTINUE 420 CONTINUE IF(MSTP(121).EQ.1) SIGSAM=PARP(121)*SIGSAM XSEC(ISUB,1)=1.05D0*SIGSAM 430 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) 440 CONTINUE MINT(51)=0 C...Print summary table. IF(NPOSI.EQ.0) THEN WRITE(MSTU(11),5900) STOP ENDIF IF(MSTP(122).GE.1) THEN WRITE(MSTU(11),6000) WRITE(MSTU(11),6100) DO 450 ISUB=1,500 IF(MSUB(ISUB).NE.1.AND.ISUB.NE.96) GOTO 450 IF(ISUB.EQ.96.AND.MINT(50).EQ.0) GOTO 450 IF(ISUB.EQ.96.AND.MSUB(95).NE.1.AND.MSTP(81).LE.0) GOTO 450 IF(ISUB.EQ.96.AND.MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 450 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 450 WRITE(MSTU(11),6200) ISUB,PROC(ISUB),XSEC(ISUB,1) 450 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('=')) 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) 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 gamma-gamma alnternatives. Also makes random C...choice between alternatives. SUBROUTINE PYSAVE(ISAVE,IGA) C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) 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) SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT5/ C...Local arrays and saved variables. DIMENSION NCP(10),NSUBCP(10,20),MSUBCP(10,20),COEFCP(10,20,20), &NGENCP(10,0:20,3),XSECCP(10,0:20,3),INTCP(10,20),RECP(10,20) SAVE NCP,NSUBCP,MSUBCP,COEFCP,NGENCP,XSECCP,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 C...Save various common process variables. DO 140 J=1,10 INTCP(IGA,J)=MINT(40+J) 140 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) C...Save cross-section information only. ELSEIF(ISAVE.EQ.2) THEN DO 160 ICP=1,NCP(IGA) I=NSUBCP(IGA,ICP) DO 150 J=1,3 NGENCP(IGA,ICP,J)=NGEN(I,J) XSECCP(IGA,ICP,J)=XSEC(I,J) 150 CONTINUE 160 CONTINUE DO 170 J=1,3 NGENCP(IGA,0,J)=NGEN(0,J) XSECCP(IGA,0,J)=XSEC(0,J) 170 CONTINUE C...Choose between allowed alternatives. ELSEIF(ISAVE.EQ.3.OR.ISAVE.EQ.4) THEN IF(ISAVE.EQ.4) THEN XSUMCP=0D0 DO 180 IG=1,MINT(121) XSUMCP=XSUMCP+XSECCP(IG,0,1) 180 CONTINUE XSUMCP=XSUMCP*PYR(0) DO 190 IG=1,MINT(121) IGA=IG XSUMCP=XSUMCP-XSECCP(IG,0,1) IF(XSUMCP.LE.0D0) GOTO 200 190 CONTINUE 200 CONTINUE ENDIF C...Restore cross-section information. DO 210 I=1,500 MSUB(I)=0 210 CONTINUE DO 240 ICP=1,NCP(IGA) I=NSUBCP(IGA,ICP) MSUB(I)=MSUBCP(IGA,ICP) DO 220 J=1,20 COEF(I,J)=COEFCP(IGA,ICP,J) 220 CONTINUE DO 230 J=1,3 NGEN(I,J)=NGENCP(IGA,ICP,J) XSEC(I,J)=XSECCP(IGA,ICP,J) 230 CONTINUE 240 CONTINUE DO 250 J=1,3 NGEN(0,J)=NGENCP(IGA,0,J) XSEC(0,J)=XSECCP(IGA,0,J) 250 CONTINUE C...Restore various common process variables. DO 260 J=1,10 MINT(40+J)=INTCP(IGA,J) 260 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) C...Sum up cross-section info (for PYSTAT). ELSEIF(ISAVE.EQ.5) THEN DO 270 I=1,500 MSUB(I)=0 NGEN(I,1)=0 NGEN(I,3)=0 XSEC(I,3)=0D0 270 CONTINUE NGEN(0,1)=0 NGEN(0,2)=0 NGEN(0,3)=0 XSEC(0,3)=0 DO 290 IG=1,MINT(121) DO 280 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) 280 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) 290 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) 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/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/PYUPPR/NUP,KUP(20,7),NFUP,IFUP(10,2),PUP(20,5),Q2UP(0:10) SAVE /PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, &/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/,/PYUPPR/ C...Local arrays. DIMENSION XPQ(-25:25),PMM(2),PDIF(4),BHAD(4) C...Parameters and data used in elastic/diffractive treatment. DATA EPS/0.0808D0/, ALP/0.25D0/, CRES/2D0/, PMRC/1.062D0/, &SMP/0.880D0/, BHAD/2.3D0,1.4D0,1.4D0,0.23D0/ C...Initial values, specifically for (first) semihard interaction. MINT(10)=0 MINT(17)=0 MINT(18)=0 VINT(143)=1D0 VINT(144)=1D0 MFAIL=0 IF(MSTP(171).EQ.1.AND.MSTP(172).EQ.2) MFAIL=1 ISUB=0 LOOP=0 100 LOOP=LOOP+1 MINT(51)=0 C...Choice of process type - first event of pileup. IF(MINT(82).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GT.96)) THEN C...For gamma-p or gamma-gamma first pick between alternatives. IF(MINT(121).GT.1) CALL PYSAVE(4,IGA) MINT(122)=IGA C...For gamma + gamma with different nature, flip at random. IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4.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. RSUB=XSEC(0,1)*PYR(0) DO 110 I=1,500 IF(MSUB(I).NE.1) GOTO 110 ISUB=I RSUB=RSUB-XSEC(I,1) IF(RSUB.LE.0D0) GOTO 120 110 CONTINUE 120 IF(ISUB.EQ.95) ISUB=96 IF(ISUB.EQ.96) CALL PYMULT(2) 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) CALL PYMULT(2) ENDIF IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)+1 IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)+1 IF(ISUB.EQ.96.AND.LOOP.EQ.1.AND.MINT(82).EQ.1) &NGEN(97,1)=NGEN(97,1)+1 MINT(1)=ISUB ISTSB=ISET(ISUB) 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=30 PMAS(30,1)=PARP(45) PMAS(30,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) ENDIF ENDIF CKMX=CKIN(2) IF(CKMX.LE.0D0) CKMX=VINT(1) KCR1=PYCOMP(KFR1) IF(KFR1.NE.0) THEN IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 ENDIF IF(KFR1.NE.0) THEN TAUR1=PMAS(KCR1,1)**2/VINT(2) GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) MINT(72)=1 MINT(73)=KFR1 VINT(73)=TAUR1 VINT(74)=GAMR1 ENDIF IF(ISUB.EQ.141) THEN KFR2=23 KCR2=PYCOMP(KFR2) TAUR2=PMAS(KCR2,1)**2/VINT(2) 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 130 I=1,2 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 ENDIF 130 CONTINUE IF(NBW.GE.1) THEN CALL PYOFSH(4,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) 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)) ELSEIF(ISTSB.EQ.6) THEN CALL PYOFSH(6,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) 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 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) VINT(204)=PMAS(23,1) IF(ISUB.EQ.124) VINT(204)=PMAS(24,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) VINT(204)=VINT(201) VINT(209)=VINT(204) 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.5.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 150 I1=I1MN,I1MX KFV1=110*I1+3 DO 140 I2=I2MN,I2MX KFV2=110*I2+3 VRN=VRN-SIGT(I1,I2,5) IF(VRN.LE.0D0) GOTO 160 140 CONTINUE 150 CONTINUE 160 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 180 I1=I1MN,I1MX KFV1=110*I1+3 DO 170 I2=I2MN,I2MX KFV2=110*I2+3 VRN=VRN-SIGT(I1,I2,JJ) IF(VRN.LE.0D0) GOTO 190 170 CONTINUE 180 CONTINUE 190 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 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 200 JT=1,2 PDIF(JT)=PMM(JT) VINT(66+JT)=PDIF(JT) IF(MINT(16+JT).EQ.1) PDIF(JT)=PDIF(JT)+PARP(102) 200 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. 210 DO 220 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 220 CONTINUE SQM3=PDIF(3)**2 SQM4=PDIF(4)**2 C..Additional mass factors, including resonance enhancement. IF(PDIF(3)+PDIF(4).GE.VINT(1)) GOTO 210 IF(ISUB.EQ.92) THEN FSD=(1D0-SQM3/SH)*(1D0+CRES*SMRES1/(SMRES1+SQM3)) IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 210 ELSEIF(ISUB.EQ.93) THEN FSD=(1D0-SQM4/SH)*(1D0+CRES*SMRES2/(SMRES2+SQM4)) IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 210 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 210 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 210 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 210 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 210 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 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.6) 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.OR.ISTSB.EQ.6) 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...Low-pT or multiple interactions (first semihard interaction). ELSEIF(ISTSB.EQ.9) THEN CALL PYMULT(3) ISUB=MINT(1) C...Generate user-defined process: kinematics plus weight. ELSEIF(ISTSB.EQ.11) THEN MSTI(51)=0 CALL PYUPEV(ISUB,SIGS) 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(0,2)=NGEN(0,2)-1 NGEN(ISUB,1)=NGEN(ISUB,1)-1 ENDIF IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) RETURN ENDIF C...Construct 'trivial' kinematical variables needed. KFL1=KUP(1,2) KFL2=KUP(2,2) VINT(41)=2D0*PUP(1,4)/VINT(1) VINT(42)=2D0*PUP(2,4)/VINT(1) 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(56)=Q2UP(0) VINT(55)=SQRT(MAX(0D0,VINT(56))) 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 DO 230 IUP=3,NUP IF(KUP(IUP,1).EQ.1) VINT(25)=VINT(25)+2D0*(PUP(IUP,5)**2+ & PUP(IUP,1)**2+PUP(IUP,2)**2)/VINT(1) IF(KUP(IUP,1).EQ.1) VINT(48)=VINT(48)+0.5D0*(PUP(IUP,1)**2+ & PUP(IUP,2)**2) 230 CONTINUE VINT(47)=SQRT(VINT(48)) C...Calculate parton distribution weights. IF(MINT(47).GE.2) THEN DO 250 I=3-MIN(2,MINT(45)),MIN(2,MINT(46)) MINT(105)=MINT(102+I) MINT(109)=MINT(106+I) IF(MSTP(57).LE.1) THEN CALL PYPDFU(MINT(10+I),VINT(40+I),Q2UP(0),XPQ) ELSE CALL PYPDFL(MINT(10+I),VINT(40+I),Q2UP(0),XPQ) ENDIF DO 240 KFL=-25,25 XSFX(I,KFL)=XPQ(KFL) 240 CONTINUE 250 CONTINUE ENDIF ENDIF C...Choose azimuthal angle. 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) C...Multiply cross-section by user-defined weights. IF(MSTP(173).EQ.1) THEN SIGS=PARP(173)*SIGS DO 260 ICHN=1,NCHN SIGH(ICHN)=PARP(173)*SIGH(ICHN) 260 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.LOOP.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...Check that weight not negative. VIOL=SIGSWT/XSEC(ISUB,1) IF(ISUB.EQ.96.AND.MSTP(173).EQ.1) VIOL=VIOL/PARP(174) IF(MSTP(123).LE.0) THEN IF(VIOL.LT.-1D-3) THEN WRITE(MSTU(11),5000) VIOL,NGEN(0,3)+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 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) THEN IF(VIOL.LT.PYR(0)) THEN IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) GOTO 100 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 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.1D0) THEN MINT(10)=1 WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 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 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 WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 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 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)+1 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 280 RSIGS=SIGS*PYR(0) QT2=VINT(48) RQQBAR=PARP(87)*(1D0-(QT2/(QT2+(PARP(88)*PARP(82))**2))**2) IF(ISUB.NE.95.AND.(ISUB.NE.96.OR.MSTP(82).LE.1.OR. &PYR(0).GT.RQQBAR)) THEN DO 270 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 280 270 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. 280 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 310 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) 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 290 XE=XHRD**PYR(0) XG=MIN(0.999999D0,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 290 MINT(18+JT)=1 VINT(154+JT)=XE DO 300 KFLS=-25,25 XSFX(JT,KFLS)=XPQ(KFLS) 300 CONTINUE ENDIF 310 CONTINUE C...Pick scale where photon is resolved. IF(MINT(107).EQ.3) VINT(283)=PARP(15)**2* &(VINT(54)/PARP(15)**2)**PYR(0) IF(MINT(108).EQ.3) VINT(284)=PARP(15)**2* &(VINT(54)/PARP(15)**2)**PYR(0) 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,'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) 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) 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(4000,2),BRAT(4000),KFDP(4000,5) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/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/PYUPPR/NUP,KUP(20,7),NFUP,IFUP(10,2),PUP(20,5),Q2UP(0:10) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYUPPR/ C...Local arrays and saved variables. DIMENSION WDTP(0:100),WDTE(0:100,0:5),PMQ(2),Z(2),CTHE(2), &PHI(2),KUPPO(20),VINTSV(41:66) 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 ENDIF 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)+20 I=MINT(83)+JT 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) THEN IGLGA=21 IF(ISUB.EQ.58) 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.12.AND.MSTP(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/PARU(155)**4 IF(FACQQB/(FACQQB+FACCIB).LT.PYR(0)) GOTO 180 ELSEIF(ISUB.EQ.54) THEN IF((KCHG(PYCOMP(KFLF),1)/2D0)**2.LT.PYR(0)) GOTO 180 ELSEIF(ISUB.EQ.58) 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. IRUP=0 DO 210 IUP=3,NUP IF(KUP(IUP,1).NE.1) THEN ELSEIF(IRUP.LE.5) THEN IRUP=IRUP+1 MINT(20+IRUP)=KUP(IUP,2) 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.1.D-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.1.D-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.1.D-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.1.D-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 (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. 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.1.D-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.1.D-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.1.D-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.1.D-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.1.D-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.1.D-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.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)=25 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)=25 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)=25 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) THEN C...g + g -> Z0 + q + qbar. 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(40,MINT(15)+MINT(16)) ELSEIF(ISUB.EQ.145) THEN C...q + l -> LQ (leptoquark). IF(IABS(MINT(16)).LE.8) JS=2 KFRES=ISIGN(39,MINT(14+JS)) KCC=28+JS KCS=ISIGN(1,MINT(14+JS)) 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_techni. KFRES=38 KCC=23 KCS=(-1)**INT(1.5D0+PYR(0)) ENDIF ELSE 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(39,MINT(14+JS)) KFLQL=KFDP(MDCY(39,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(39,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(39,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,1000000) 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 ENDIF ENDIF IF(ISET(ISUB).EQ.11) THEN C...Store documentation for user-defined processes. BEZUP=(PUP(1,4)-PUP(2,4))/(PUP(1,4)+PUP(2,4)) KUPPO(1)=MINT(83)+5 KUPPO(2)=MINT(83)+6 I=MINT(83)+6 DO 450 IUP=3,NUP KUPPO(IUP)=0 IF(MSTP(128).GE.2.AND.KUP(IUP,3).NE.0) THEN IDOC=IDOC-1 MINT(4)=MINT(4)-1 GOTO 450 ENDIF I=I+1 KUPPO(IUP)=I K(I,1)=21 K(I,2)=KUP(IUP,2) K(I,3)=0 IF(KUP(IUP,3).NE.0) K(I,3)=KUPPO(KUP(IUP,3)) K(I,4)=0 K(I,5)=0 DO 440 J=1,5 P(I,J)=PUP(IUP,J) 440 CONTINUE 450 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 470 IUP=3,NUP N=N+1 K(N,1)=1 IF(KUP(IUP,1).NE.1) K(N,1)=11 K(N,2)=KUP(IUP,2) IF(MSTP(128).LE.0.OR.KUP(IUP,3).EQ.0) THEN K(N,3)=KUPPO(IUP) ELSE K(N,3)=MINT(84)+KUP(IUP,3) ENDIF K(N,4)=0 K(N,5)=0 DO 460 J=1,5 P(N,J)=PUP(IUP,J) 460 CONTINUE 470 CONTINUE CALL PYROBO(IPU3,N,0D0,VINT(24),0D0,0D0,-BEZUP) C...Arrange colour flow for user-defined processes. N=MINT(84) DO 480 IUP=1,NUP N=N+1 IF(KCHG(PYCOMP(K(N,2)),2).EQ.0) GOTO 480 IF(K(N,1).EQ.1) K(N,1)=3 IF(K(N,1).EQ.11) K(N,1)=14 IF(KUP(IUP,4).NE.0) K(N,4)=K(N,4)+MSTU(5)*(KUP(IUP,4)+ & MINT(84)) IF(KUP(IUP,5).NE.0) K(N,5)=K(N,5)+MSTU(5)*(KUP(IUP,5)+ & MINT(84)) IF(KUP(IUP,6).NE.0) K(N,4)=K(N,4)+KUP(IUP,6)+MINT(84) IF(KUP(IUP,7).NE.0) K(N,5)=K(N,5)+KUP(IUP,7)+MINT(84) 480 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 490 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)) 490 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 500 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 IF(MWID(KCA).NE.0.AND.KFPR(ISUBSV,1).NE.0) THEN P(I,5)=SQRT(VINT(63+MOD(JS+JT,2))) ELSEIF(MWID(KCA).NE.0.AND.KFPR(ISUBSV,2).NE.0) THEN P(I,5)=SQRT(VINT(64)) ELSE P(I,5)=PYMASS(K(I,2)) ENDIF 500 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.AND.ISET(ISUB).EQ.5) THEN C...2 -> 3 processes (alt 1): store outgoing partons in their CM frame. DO 510 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 IF(IABS(K(I,2)).LE.22) THEN P(I,5)=PYMASS(K(I,2)) ELSE P(I,5)=SQRT(VINT(63+MOD(JS+JT,2))) ENDIF PT=SQRT(MAX(0D0,VINT(197+5*JT)-P(I,5)**2+VINT(196+5*JT)**2)) P(I,1)=PT*COS(VINT(198+5*JT)) P(I,2)=PT*SIN(VINT(198+5*JT)) 510 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) 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.9) THEN C...2 -> 3 processes: store outgoing partons in their CM frame. DO 520 JT=1,3 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-3 IF(JT.EQ.1) THEN P(I,5)=SQRT(VINT(63)) ELSE P(I,5)=PMAS(PYCOMP(KFPR(ISUB,2)),1) ENDIF 520 CONTINUE P(IPU3,4)=0.5D0*(SHR+(VINT(63)-VINT(64))/SHR) P(IPU3,3)=SQRT(MAX(0D0,P(IPU3,4)**2-P(IPU3,5)**2)) P(IPU4,4)=0.5D0*SQRT(VINT(64)) P(IPU4,3)=SQRT(MAX(0D0,P(IPU4,4)**2-P(IPU4,5)**2)) P(IPU5,4)=P(IPU4,4) P(IPU5,3)=-P(IPU4,3) N=IPU5 MINT(7)=MINT(83)+7 MINT(8)=MINT(83)+9 C...Rotate and boost outgoing partons. CALL PYROBO(IPU4,IPU5,ACOS(VINT(83)),VINT(84),0D0,0D0,0D0) CALL PYROBO(IPU4,IPU5,0D0,0D0,0D0,0D0, & -P(IPU3,3)/(SHR-P(IPU3,4))) CALL PYROBO(IPU3,IPU5,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) 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 530 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 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)) 530 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 540 J=1,5 P(I,J)=P(IPU5,J) 540 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 550 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) 550 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 570 JT=1,2 I1=MINT(83)+8+JT I2=MINT(84)+4+JT K(I1,1)=21 K(I1,2)=K(I2,2) DO 560 J=1,5 P(I1,J)=P(I2,J) 560 CONTINUE 570 CONTINUE N=IPU6 MINT(7)=MINT(83)+9 MINT(8)=MINT(83)+10 ENDIF IF(ISET(ISUB).EQ.11) THEN ELSEIF(IDOC.GE.8.AND.ISET(ISUB).NE.6) THEN C...Store colour connection indices. DO 580 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)) 580 CONTINUE C...Copy outgoing partons to documentation lines. IMAX=2 IF(IDOC.EQ.9) IMAX=3 DO 600 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 590 J=1,5 P(I1,J)=P(I2,J) 590 CONTINUE 600 CONTINUE ELSEIF(IDOC.EQ.9) THEN C...Store colour connection indices. DO 610 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)) 610 CONTINUE C...Copy outgoing partons to documentation lines. DO 630 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 620 J=1,5 P(I1,J)=P(I2,J) 620 CONTINUE 630 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 640 J=41,66 VINTSV(J)=VINT(J) VINT(J)=0D0 640 CONTINUE DO 660 I=MINT(83)+5,MINT(83)+8 DO 650 J=1,5 P(I,J)=0D0 650 CONTINUE 660 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) 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) 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=PARP(67)*VINT(56) C...Initialize QCD evolution and check phase space. Q2MNC=PARP(62)**2 Q2MNCS(1)=Q2MNC IF(MSTP(66).EQ.1.AND.MINT(107).EQ.3) &Q2MNCS(1)=MAX(Q2MNC,VINT(283)) Q2MNCS(2)=Q2MNC IF(MSTP(66).EQ.1.AND.MINT(108).EQ.3) &Q2MNCS(2)=MAX(Q2MNC,VINT(284)) MCEV=0 XEC0=2D0*PARP(65)/VINT(1) ALAMS=PARU(112) PARU(112)=PARP(61) FQ2C=1D0 TCMX=0D0 IF(MINT(47).GE.2.AND.(MINT(47).NE.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. Q2MNE=PARP(68)**2 MEEV=0 XEE=1D-6 SPME=PMAS(11,1)**2 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(MCEV.EQ.0.AND.MEEV.EQ.0) RETURN C...Initial values: flavours, momenta, virtualities. NS=N 100 N=NS 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)=Q2MX TEVCSV(JT)=TCMX ALAM(JT)=PARP(61) THE2(JT)=100D0 TEVESV(JT)=TEMX DO 110 KFL=-25,25 XFS(JT,KFL)=XSFX(JT,KFL) 110 CONTINUE 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. 150 N=N+1 JT=1 IF(N.GT.NS+1.AND.Q2S(2).GT.Q2S(1)) JT=2 IF(MORE(JT).EQ.0) JT=3-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(XEC0,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(MCEV.EQ.0.AND.MEEV.EQ.0) THEN Q2B=0D0 GOTO 250 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 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 Altarelli-Parisi weights. DO 170 KFL=-25,25 WTAPC(KFL)=0D0 WTAPE(KFL)=0D0 WTSF(KFL)=0D0 170 CONTINUE C...q -> q, 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)) 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) 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) 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 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 190 NTRY=NTRY+1 IF(NTRY.GT.500) THEN MINT(51)=1 RETURN ENDIF WTSUMC=0D0 WTSUME=0D0 XFBO=MAX(1D-10,XFB(KFLB)) DO 200 KFL=-25,25 WTSF(KFL)=XFB(KFL)/XFBO WTSUMC=WTSUMC+WTAPC(KFL)*WTSF(KFL) WTSUME=WTSUME+WTAPE(KFL)*WTSF(KFL) 200 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 210 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))) ENDIF C...Translate t into Q2 scale; choose between QCD and QED evolution. 220 IF(MCEV.EQ.1) Q2CB=ALAM(JT)**2*EXP(MAX(-50D0,TEVCB))/FQ2C IF(MEEV.EQ.1) Q2EB=SPME*EXP(MAX(-50D0,TEVEB)) 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(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 250 ELSEIF(MCE.EQ.1) THEN Q2B=Q2CB Q2REF=FQ2C*Q2B IF(MEEV.EQ.1) TEVEB=LOG(Q2B/SPME) 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 230 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 230 IF(KFLA.EQ.25) THEN Q2B=0D0 GOTO 250 ENDIF C...Choose z value and corrective weight. WTZ=0D0 C...q -> q + g. 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) 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 210 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 210 ALPRAT=TEVCB/(TEVCB+LOG(1D0-Z)) IF(ALPRAT.LT.5D0*PYR(0)) GOTO 210 IF(ALPRAT.GT.5D0) WTZ=WTZ*ALPRAT/5D0 ENDIF C...Impose angular constraint in first branching from interference C...with final state partons. 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 210 ELSEIF(N.EQ.NS+2.AND.ISFI(2).GE.1) THEN IF(THE2D.GT.THEFIS(2,ISFI(2))**2) GOTO 210 ENDIF ENDIF C...Option with angular ordering requirement. IF(MSTP(62).GE.3.AND.NTRY2.LT.200) THEN THE2T=(4D0*Z**2*Q2B)/(VINT(2)*(1D0-Z)*XB**2) IF(THE2T.GT.THE2(JT)) GOTO 210 ENDIF ENDIF C...Weighting with new parton distributions. MINT(105)=MINT(102+JT) MINT(109)=MINT(106+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 190 ELSEIF(MCE.EQ.1.AND.TEVCBS-TEVCB.GT.0.2D0) THEN TEVCB=0.5D0*(TEVCBS+TEVCB) GOTO 220 ELSEIF(MCE.EQ.2.AND.TEVEBS-TEVEB.GT.0.2D0) THEN TEVEB=0.5D0*(TEVEBS+TEVEB) GOTO 220 ELSE XFBN=1D-10 XFN(KFLB)=XFBN ENDIF ENDIF DO 240 KFL=-25,25 XFB(KFL)=XFN(KFL) 240 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 190 WTSFA=WTSF(KFLA) IF(WTZ*XFAN/XFBN.LT.PYR(0)*WTSFA) GOTO 190 C...Define two hard scatterers in their CM-frame. 250 IF(N.EQ.NS+2) THEN DQ2(JT)=Q2B DPLCM=SQRT((DSH+DQ2(1)+DQ2(2))**2-4D0*DQ2(1)*DQ2(2))/DSHR DO 270 JR=1,2 I=NS+JR IF(JR.EQ.1) IPO=IPUS1 IF(JR.EQ.2) IPO=IPUS2 DO 260 J=1,5 K(I,J)=0 P(I,J)=0D0 V(I,J)=0D0 260 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 270 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 280 J=1,5 K(IT,J)=0 P(IT,J)=0D0 V(IT,J)=0D0 280 CONTINUE K(IT,1)=3 C...f -> f + g (gamma). IF(IABS(KFLB).LE.20.AND.IABS(KFLS(JT+2)).LE.20) THEN K(IT,2)=21 IF(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 P(IT,5)=PYMASS(K(IT,2)) IF(DMSMA.LE.P(IT,5)**2) GOTO 100 IF(MSTP(63).GE.1.AND.MCE.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 290 J=1,5 K(N+1,J)=0 P(N+1,J)=0D0 V(N+1,J)=0D0 290 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 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)),PARU(2)*PYR(0), & 0D0,0D0,0D0) ENDIF C...Update kinematics variables. IS(JT)=N DQ2(JT)=Q2B IF(MSTP(62).GE.3) THE2(JT)=THE2T DSH=DSHZ C...Save quantities; loop back. Q2S(JT)=Q2B 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 300 KFL=-25,25 XFS(JT,KFL)=XFA(KFL) 300 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 310 J=1,3 ROBO(J+2)=(P(NS+1,J)+P(NS+2,J))/(P(NS+1,4)+P(NS+2,4)) 310 CONTINUE K(N+2,1)=1 DO 320 J=1,5 P(N+2,J)=P(NS+1,J) 320 CONTINUE ROBOT=ROBO(3)**2+ROBO(4)**2+ROBO(5)**2 IF(ROBOT.GE.0.999999D0) THEN ROBOT=1.00001D0*SQRT(ROBOT) ROBO(3)=ROBO(3)/ROBOT ROBO(4)=ROBO(4)/ROBOT ROBO(5)=ROBO(5)/ROBOT ENDIF 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,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 330 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) 330 CONTINUE PARU(112)=ALAMS RETURN END C********************************************************************* C...PYRESD C...Allows resonances to decay (including parton showers for hadronic C...channels). SUBROUTINE PYRESD C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/PYDAT3/MDCY(500,3),MDME(4000,2),BRAT(4000),KFDP(4000,5) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/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 variables. DIMENSION IREF(20,8),KDCY(3),KFL1(3),KFL2(3),KEQL(3),NSD(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:100),WDTE(0:100,0:5),DBEZQQ(3),DPMO(5) COMPLEX FGK,HA(6,6),HC(6,6) 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)=4D0*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 SQMW=PMAS(24,1)**2 SH=VINT(44) C...Define initial one, two or three objects. ISUB=MINT(1) DO 100 JT=1,8 IREF(1,JT)=0 100 CONTINUE 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) 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) 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 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 DO 110 I=IREF(1,JT)+1,N IF(K(I,1).LE.10.AND.K(I,2).EQ.K(IREF(1,JT),2)) & IREF(1,JT)=I 110 CONTINUE ELSE KDA=MOD(K(IREF(1,JT),4),MSTU(4)) IF(MWID(PYCOMP(KFA)).NE.0.AND.KDA.GT.1) IREF(1,JT)=KDA ENDIF ENDIF ENDIF 120 CONTINUE C...Loop over decay history. NP=1 IP=0 130 IP=IP+1 NINH=0 JTMAX=2 IF(IP.EQ.1.AND.IREF(1,2).EQ.0) JTMAX=1 IF(IP.EQ.1.AND.IREF(1,3).NE.0) JTMAX=3 ITLH=0 NSAV=N C...Start treatment of one or two resonances in parallel. 140 N=NSAV DO 170 JT=1,JTMAX ID=IREF(IP,JT) KDCY(JT)=0 KFL1(JT)=0 KFL2(JT)=0 KEQL(JT)=0 NSD(JT)=ID IF(ID.EQ.0) GOTO 160 KFA=IABS(K(ID,2)) KCA=PYCOMP(KFA) IF(MWID(KCA).EQ.0) GOTO 160 IF(K(ID,1).GT.10.OR.MDCY(KCA,1).EQ.0) GOTO 160 IF(KFA.EQ.6.OR.KFA.EQ.7.OR.KFA.EQ.8.OR.KFA.EQ.17.OR. & KFA.EQ.18) ITLH=ITLH+1 K(ID,4)=MSTU(5)*(K(ID,4)/MSTU(5)) K(ID,5)=MSTU(5)*(K(ID,5)/MSTU(5)) C...Select decay channel. KFB=0 IF(ISET(ISUB).NE.6.OR.JT.NE.3) THEN 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) IF(KCHG(KCA,3).EQ.0) THEN IPM=2 ELSE IPM=(5-ISIGN(1,K(ID,2)))/2 ENDIF IF(JTMAX.GE.2.AND.JT.LE.2) KFB=IABS(K(IREF(IP,3-JT),2)) WDTE0S=WDTE(0,1)+WDTE(0,IPM)+WDTE(0,4) IF(KFB.EQ.KFA) WDTE0S=WDTE0S+WDTE(0,5) IF(WDTE0S.LE.0D0) THEN IF(KFA.EQ.6.OR.KFA.EQ.7.OR.KFA.EQ.8.OR.KFA.EQ.17.OR. & KFA.EQ.18) THEN MINT(51)=1 RETURN ELSE GOTO 160 ENDIF ENDIF RKFL=WDTE0S*PYR(0) IDL=0 150 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 150 ELSE IDC=MINT(35) ENDIF C...Read out and classify decay channel chosen. C...KDCY=0 for nonexistent, =1 for q/g, =2 for l/gamma, C... =3 for resonance. 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)) 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)) KDCY(JT)=2 IF(IABS(KFL1(JT)).LE.10.OR.KFL1(JT).EQ.21) KDCY(JT)=1 IF(IABS(KFL1(JT)).GE.23.AND.MWID(PYCOMP(KFL1(JT))).NE.0) & KDCY(JT)=3 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) C...Select masses and check that mass sum not too large. IF(MSTP(42).LE.0.OR.(PMAS(KFC1A,2).LT.PARP(41).AND. & PMAS(KFC2A,2).LT.PARP(41))) THEN P(N+1,5)=PMAS(KFC1A,1) P(N+2,5)=PMAS(KFC2A,1) IF(P(N+1,5)+P(N+2,5)+PARJ(64).GT.P(ID,5)) THEN CALL PYERRM(13,'(PYRESD:) daughter masses too large') MINT(51)=1 RETURN ENDIF ELSEIF(IP.EQ.1) THEN CALL PYOFSH(2,KFA,KFL1(JT),KFL2(JT),P(ID,5),P(N+1,5),P(N+2,5)) IF(MINT(51).EQ.1) RETURN ELSE CALL PYOFSH(7,KFA,KFL1(JT),KFL2(JT),P(ID,5),P(N+1,5),P(N+2,5)) IF(MINT(51).EQ.1) RETURN ENDIF C...Fill decay products, prepared for parton showers for quarks. C...Special cases, done by hand, for coloured resonances. MSTU(10)=1 IF(KCHG(KCA,2).NE.0) THEN MSTU(19)=1 CALL PY2ENT(N+1,KFL1(JT),KFL2(JT),P(ID,5)) ISID=4 IF(K(ID,2).LT.0) ISID=5 IF(KCHG(KCA,2).EQ.2) THEN IF(KFC1A.EQ.21.AND.PYR(0).GT.0.5D0) ISID=9-ISID K(N-1,1)=3 K(N,1)=3 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-1,9-ISID)=MSTU(5)*N K(N,ISID)=MSTU(5)*(N-1) K(N,9-ISID)=MSTU(5)*ID ELSEIF(KFA.EQ.6.OR.KFA.EQ.7.OR.KFA.EQ.8) THEN K(N-1,1)=1 K(N,1)=3 K(ID,ISID)=K(ID,ISID)+N K(N,ISID)=MSTU(5)*ID ELSEIF(KFA.EQ.39) THEN K(N-1,1)=3 K(N,1)=1 K(ID,ISID)=K(ID,ISID)+(N-1) K(N-1,ISID)=MSTU(5)*ID ELSEIF(KFL1(JT).NE.21) THEN K(N-1,1)=1 K(N,1)=3 K(ID,ISID)=K(ID,ISID)+N K(N,ISID)=MSTU(5)*ID ELSE K(N-1,1)=3 K(N,1)=3 K(ID,ISID)=K(ID,ISID)+(N-1) K(N-1,ISID)=MSTU(5)*ID K(N-1,9-ISID)=MSTU(5)*N K(N,ISID)=MSTU(5)*(N-1) ENDIF ELSEIF(KDCY(JT).EQ.1) THEN CALL PY2ENT(-(N+1),KFL1(JT),KFL2(JT),P(ID,5)) ELSE CALL PY2ENT(N+1,KFL1(JT),KFL2(JT),P(ID,5)) ENDIF MSTU(10)=2 160 IF(KFA.GE.23.AND.MWID(KCA).NE.0.AND.KFL1(JT).EQ.0) & NINH=NINH+1 170 CONTINUE C...Check for allowed combinations. Skip if no decays. IF(JTMAX.GE.2) THEN IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 140 IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 140 ENDIF IF(JTMAX.EQ.1.AND.KDCY(1).EQ.0) GOTO 480 IF(JTMAX.EQ.2.AND.KDCY(1).EQ.0.AND.KDCY(2).EQ.0) GOTO 480 IF(JTMAX.EQ.3.AND.KDCY(1).EQ.0.AND.KDCY(2).EQ.0.AND. &KDCY(3).EQ.0) GOTO 480 C...Order incoming partons and outgoing resonances. IF(JTMAX.EQ.2.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) 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 180 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 180 CONTINUE C...Find charge, isospin, left- and righthanded couplings. DO 200 I=IMIN,IMAX DO 190 J=1,4 COUP(I,J)=0D0 190 CONTINUE KFA=IABS(K(ILIN(I),2)) IF(KFA.EQ.0.OR.KFA.GT.20) GOTO 200 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) 200 CONTINUE C...Full propagator dependence and flavour correlations for 2 gamma*/Z. IF(ISUB.EQ.22) THEN DO 230 I=3,5,2 I1=IORD IF(I.EQ.5) I1=3-IORD DO 220 J1=1,2 DO 210 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 210 CONTINUE 220 CONTINUE 230 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 140 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 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 ENDIF IF(IP.GE.3) MZPWP=2 ENDIF C...Select random angles (begin of weighting procedure). 240 DO 250 JT=1,JTMAX IF(KDCY(JT).EQ.0) GOTO 250 IF(JTMAX.EQ.1) 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 250 CONTINUE IF(JTMAX.EQ.2.AND.MSTP(47).GE.1.AND.NINH.EQ.0) THEN C...Construct massless four-vectors. DO 270 I=N+1,N+4 K(I,1)=1 DO 260 J=1,5 P(I,J)=0D0 V(I,J)=0D0 260 CONTINUE 270 CONTINUE DO 280 JT=1,JTMAX IF(KDCY(JT).EQ.0) GOTO 280 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)) 280 CONTINUE C...Store incoming and outgoing momenta, with random rotation to C...avoid accidental zeroes in HA expressions. DO 300 I=1,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 290 J=1,3 P(N+4+I,J)=P(ILIN(I),J) 290 CONTINUE 300 CONTINUE 310 THERR=ACOS(2D0*PYR(0)-1D0) PHIRR=PARU(2)*PYR(0) CALL PYROBO(N+5,N+4+IMAX,THERR,PHIRR,0D0,0D0,0D0) DO 330 I=1,IMAX IF(P(N+4+I,1)**2+P(N+4+I,2)**2.LT.1D-4*P(N+4+I,4)**2) GOTO 310 DO 320 J=1,4 PK(I,J)=P(N+4+I,J) 320 CONTINUE 330 CONTINUE 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 350 I1=IMIN,IMAX-1 DO 340 I2=I1+1,IMAX HA(I1,I2)=SQRT((PK(I1,4)-PK(I1,3))*(PK(I2,4)+PK(I2,3))/ & (1D-20+PK(I1,1)**2+PK(I1,2)**2))*CMPLX(PK(I1,1),PK(I1,2))- & SQRT((PK(I1,4)+PK(I1,3))*(PK(I2,4)-PK(I2,3))/ & (1D-20+PK(I2,1)**2+PK(I2,2)**2))*CMPLX(PK(I2,1),PK(I2,2)) HC(I1,I2)=CONJG(HA(I1,I2)) IF(I1.LE.2) HA(I1,I2)=CMPLX(0D0,1D0)*HA(I1,I2) IF(I1.LE.2) HC(I1,I2)=CMPLX(0D0,1D0)*HC(I1,I2) HA(I2,I1)=-HA(I1,I2) HC(I2,I1)=-HC(I1,I2) 340 CONTINUE 350 CONTINUE ENDIF DO 370 I=1,2 DO 360 J=1,4 PK(I,J)=-PK(I,J) 360 CONTINUE 370 CONTINUE DO 390 I1=IMIN,IMAX-1 DO 380 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) 380 CONTINUE 390 CONTINUE 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(ITLH.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 -> Z0 + Z0 or W+ + W- -> 4 quarks/leptons. WT=16D0*PKK(3,5)*PKK(4,6) 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.NE.23.AND.KFA.NE.24) WT=WTMAX 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=WT1+ABS(WT3) ELSEIF(ISUB.EQ.2) THEN C...Angular weight for W+/- -> 2 quarks/leptons. WT=(1D0+CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)))**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(2,1)*COUP(3,1)**2/16D0+ & COUP(1,1)*COUP(1,3)*HGZ(2,2)*COUP(3,1)*COUP(3,3)/4D0+ & COUP(1,3)**2*HGZ(2,3)*COUP(3,3)**2 CLIRF=COUP(1,1)**2*HGZ(2,1)*COUP(3,1)**2/16D0+ & COUP(1,1)*COUP(1,3)*HGZ(2,2)*COUP(3,1)*COUP(3,4)/4D0+ & COUP(1,3)**2*HGZ(2,3)*COUP(3,4)**2 CRILF=COUP(1,1)**2*HGZ(2,1)*COUP(3,1)**2/16D0+ & COUP(1,1)*COUP(1,4)*HGZ(2,2)*COUP(3,1)*COUP(3,3)/4D0+ & COUP(1,4)**2*HGZ(2,3)*COUP(3,3)**2 CRIRF=COUP(1,1)**2*HGZ(2,1)*COUP(3,1)**2/16D0+ & COUP(1,1)*COUP(1,4)*HGZ(2,2)*COUP(3,1)*COUP(3,4)/4D0+ & COUP(1,4)**2*HGZ(2,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 FGK135=ABS(FGK(1,2,3,4,5,6)/TI+FGK(1,2,5,6,3,4)/UI)**2 FGK145=ABS(FGK(1,2,4,3,5,6)/TI+FGK(1,2,5,6,4,3)/UI)**2 FGK136=ABS(FGK(1,2,3,4,6,5)/TI+FGK(1,2,6,5,3,4)/UI)**2 FGK146=ABS(FGK(1,2,4,3,6,5)/TI+FGK(1,2,6,5,4,3)/UI)**2 FGK253=ABS(FGK(2,1,5,6,3,4)/TI+FGK(2,1,3,4,5,6)/UI)**2 FGK263=ABS(FGK(2,1,6,5,3,4)/TI+FGK(2,1,3,4,6,5)/UI)**2 FGK254=ABS(FGK(2,1,5,6,4,3)/TI+FGK(2,1,4,3,5,6)/UI)**2 FGK264=ABS(FGK(2,1,6,5,4,3)/TI+FGK(2,1,4,3,6,5)/UI)**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+SQMW*PMAS(24,2)**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(CAWZ*FGK(1,2,3,4,5,6)+CBWZ*FGK(1,2,5,6,3,4)) FGK136=ABS(CAWZ*FGK(1,2,3,4,6,5)+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. 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(CAWW*FGK(1,2,3,4,5,6)-CBWW*FGK(1,2,5,6,3,4)) FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) 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))) 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(2,1)*COUP(3,1)**2/16D0+ & COUP(1,1)*COUP(1,3)*HGZ(2,2)*COUP(3,1)*COUP(3,3)/4D0+ & COUP(1,3)**2*HGZ(2,3)*COUP(3,3)**2 CLIRF=COUP(1,1)**2*HGZ(2,1)*COUP(3,1)**2/16D0+ & COUP(1,1)*COUP(1,3)*HGZ(2,2)*COUP(3,1)*COUP(3,4)/4D0+ & COUP(1,3)**2*HGZ(2,3)*COUP(3,4)**2 CRILF=COUP(1,1)**2*HGZ(2,1)*COUP(3,1)**2/16D0+ & COUP(1,1)*COUP(1,4)*HGZ(2,2)*COUP(3,1)*COUP(3,3)/4D0+ & COUP(1,4)**2*HGZ(2,3)*COUP(3,3)**2 CRIRF=COUP(1,1)**2*HGZ(2,1)*COUP(3,1)**2/16D0+ & COUP(1,1)*COUP(1,4)*HGZ(2,2)*COUP(3,1)*COUP(3,4)/4D0+ & COUP(1,4)**2*HGZ(2,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) THEN C...Angular weight for f + g -> f' + W+/- -> f' + 2 quarks/leptons. 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.(KDCY(1).EQ.1.OR.KDCY(1).EQ.2)) 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 VPI=PARU(119+2*KFAIC) API=PARU(120+2*KFAIC) 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 VPF=PARU(119+2*KFAFC) APF=PARU(120+2*KFAFC) C...Asymmetry and weight. ASYM=2D0*(EI*AI*VINT(112)*EF*AF+EI*API*VINT(113)*EF*APF+ & 4D0*VI*AI*VINT(114)*VF*AF+(VI*API+VPI*AI)*VINT(115)* & (VF*APF+VPF*AF)+4D0*VPI*API*VINT(116)*VPF*APF)/ & (EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ & EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* & (VF**2+AF**2)+(VI*VPI+AI*API)*VINT(115)*(VF*VPF+AF*APF)+ & (VPI**2+API**2)*VINT(116)*(VPF**2+APF**2)) WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 WTMAX=2D0+ABS(ASYM) ELSEIF(IP.EQ.1.AND.IABS(KFL1(1)).EQ.24) THEN C...Angular weight for f + fbar -> Z' -> W+ + W-. RM1=P(NSD(1)+1,5)**2/SH RM2=P(NSD(1)+2,5)**2/SH CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ & (RM2-RM1)**2) WT=CFLAT+CCOS2*CTHE(1)**2 WTMAX=CFLAT+MAX(0D0,CCOS2) ELSEIF(IP.EQ.1.AND.(KFL1(1).EQ.25.OR.KFL1(1).EQ.35.OR. & IABS(KFL1(1)).EQ.37)) THEN C...Angular weight for f + fbar -> Z' -> h0 + A0, H0 + A0, H+ + H-. WT=1D0-CTHE(1)**2 WTMAX=1D0 ELSEIF(IP.EQ.1.AND.KDCY(1).EQ.3) THEN C...Angular weight for f + fbar -> Z' -> Z0 + h0. RM1=P(NSD(1)+1,5)**2/SH RM2=P(NSD(1)+2,5)**2/SH FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) WTMAX=1D0+FLAM2/(8D0*RM1) ELSEIF(MZPWP.EQ.0) THEN C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons C...(W:s like if intermediate Z). D34=P(IREF(IP,IORD),5)**2 D56=P(IREF(IP,3-IORD),5)**2 DT=PKK(1,3)+PKK(1,4)+D34 DU=PKK(1,5)+PKK(1,6)+D56 FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) WT=(COUP(1,3)*FGK135)**2+(COUP(1,4)*FGK253)**2 WTMAX=4D0*D34*D56*(COUP(1,3)**2+COUP(1,4)**2)* & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) ELSEIF(MZPWP.EQ.1) THEN C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons C...(W:s approximately longitudinal, like if intermediate H). WT=16D0*PKK(3,5)*PKK(4,6) WTMAX=SH**2 ELSE C...Angular weight for f + fbar -> Z' -> H+ + H-, Z0 + h0, h0 + A0, C...H0 + A0 -> 4 quarks/leptons. WT=1D0 WTMAX=1D0 ENDIF ELSEIF(ISUB.EQ.142) THEN IF(IP.EQ.1.AND.(KDCY(1).EQ.1.OR.KDCY(1).EQ.2)) THEN C...Angular weight for f + fbar' -> W'+/- -> 2 quarks/leptons. KFAI=IABS(MINT(15)) KFAIC=1 IF(KFAI.GT.10) KFAIC=2 VI=PARU(129+2*KFAIC) AI=PARU(130+2*KFAIC) KFAF=IABS(KFL1(1)) KFAFC=1 IF(KFAF.GT.10) KFAFC=2 VF=PARU(129+2*KFAFC) AF=PARU(130+2*KFAFC) ASYM=8D0*VI*AI*VF*AF/((VI**2+AI**2)*(VF**2+AF**2)) WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 WTMAX=2D0+ABS(ASYM) ELSEIF(IP.EQ.1.AND.IABS(KFL2(1)).EQ.23) THEN C...Angular weight for f + fbar' -> W'+/- -> W+/- + Z0. RM1=P(NSD(1)+1,5)**2/SH RM2=P(NSD(1)+2,5)**2/SH CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ & (RM2-RM1)**2) WT=CFLAT+CCOS2*CTHE(1)**2 WTMAX=CFLAT+MAX(0D0,CCOS2) ELSEIF(IP.EQ.1.AND.KDCY(1).EQ.3) THEN C...Angular weight for f + fbar -> W'+/- -> W+/- + h0. RM1=P(NSD(1)+1,5)**2/SH RM2=P(NSD(1)+2,5)**2/SH FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) WTMAX=1D0+FLAM2/(8D0*RM1) ELSEIF(MZPWP.EQ.0) THEN C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons C...(W/Z like if intermediate W). D34=P(IREF(IP,IORD),5)**2 D56=P(IREF(IP,3-IORD),5)**2 DT=PKK(1,3)+PKK(1,4)+D34 DU=PKK(1,5)+PKK(1,6)+D56 FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) FGK136=ABS(FGK(1,2,3,4,6,5)-FGK(1,2,6,5,3,4)) WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2 WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)* & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) ELSEIF(MZPWP.EQ.1) THEN C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons C...(W/Z approximately longitudinal, like if intermediate H). WT=16D0*PKK(3,5)*PKK(4,6) WTMAX=SH**2 ELSE C...Angular weight for f + fbar -> W' -> W + h0 -> whatever. WT=1D0 WTMAX=1D0 ENDIF ELSEIF(ISUB.EQ.145.OR.ISUB.EQ.162.OR.ISUB.EQ.163.OR.ISUB.EQ.164) &THEN C...Isotropic decay of leptoquarks (assumed spin 0). WT=1D0 WTMAX=1D0 ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN C...Decays of (spin 1/2) q* -> q + (g,gamma) or (Z0,W+-). SIDE=1D0 IF(MINT(16).EQ.21) SIDE=-1D0 IF(IP.EQ.1.AND.(KFL1(1).EQ.21.OR.KFL1(1).EQ.22)) THEN WT=1D0+SIDE*CTHE(1) WTMAX=2D0 ELSEIF(IP.EQ.1) THEN RM1=P(NSD(1)+1,5)**2/SH WT=1D0+SIDE*CTHE(1)*(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) WTMAX=1D0+(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) ELSE C...W/Z decay assumed isotropic, since not known. WT=1D0 WTMAX=1D0 ENDIF ELSEIF(ISUB.EQ.149) THEN C...Isotropic decay of techni-eta. WT=1D0 WTMAX=1D0 C...Obtain correct angular distribution by rejection techniques. ELSE WT=1D0 WTMAX=1D0 ENDIF IF(WT.LT.PYR(0)*WTMAX) GOTO 240 C...Construct massive four-vectors using angles chosen. Mark decayed C...resonances, add documentation lines. Shower evolution. 400 DO 470 JT=1,JTMAX IF(KDCY(JT).EQ.0) GOTO 470 ID=IREF(IP,JT) IF(ISET(ISUB).NE.6.OR.JT.NE.3) THEN DO 410 J=1,5 DPMO(J)=P(ID,J) 410 CONTINUE DPMO(4)=SQRT(DPMO(1)**2+DPMO(2)**2+DPMO(3)**2+DPMO(5)**2) CALL PYROBO(NSD(JT)+1,NSD(JT)+2,ACOS(CTHE(JT)),PHI(JT), & DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4)) ELSE C...Z + q + qbar : angles already known, in rest frame of system. DO 420 J=1,3 DBEZQQ(J)=(P(ID,J)+P(ID+1,J)+P(ID+2,J))/(P(ID,4)+P(ID+1,4)+ & P(ID+2,4)) 420 CONTINUE K(N+1,1)=1 DO 430 J=1,5 P(N+1,J)=P(ID,J) 430 CONTINUE CALL PYROBO(N+1,N+1,0D0,0D0,-DBEZQQ(1),-DBEZQQ(2),-DBEZQQ(3)) PHIZQQ=PYANGL(P(N+1,1),P(N+1,2)) THEZQQ=PYANGL(P(N+1,3),SQRT(P(N+1,1)**2+P(N+1,2)**2)) CALL PYROBO(NSD(JT)+1,NSD(JT)+2,ACOS(VINT(81)),VINT(82), & 0D0,0D0,SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2)/P(N+1,4)) CALL PYROBO(NSD(JT)+1,NSD(JT)+2,THEZQQ,PHIZQQ,DBEZQQ(1), & DBEZQQ(2),DBEZQQ(3)) ENDIF K(ID,1)=K(ID,1)+10 KFA=IABS(K(ID,2)) KCA=PYCOMP(KFA) IF(KCHG(KCA,2).NE.0) THEN C...Do not kill colour flow through coloured resonance! ELSE K(ID,4)=NSD(JT)+1 K(ID,5)=NSD(JT)+2 ENDIF IDOC=MINT(83)+MINT(4) DO 450 I=NSD(JT)+1,NSD(JT)+2 I1=MINT(83)+MINT(4)+1 K(I,3)=I1 IF(MSTP(128).GE.1) K(I,3)=ID IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN MINT(4)=MINT(4)+1 K(I1,1)=21 K(I1,2)=K(I,2) K(I1,3)=IREF(IP,JT+3) DO 440 J=1,5 P(I1,J)=P(I,J) 440 CONTINUE ENDIF 450 CONTINUE C...Shower - top currently special case. NSHBEF=N IF(MSTP(71).GE.1.AND.(KDCY(JT).LE.2.OR.KFA.EQ.6.OR.KFA.EQ.7.OR. &KFA.EQ.8)) CALL PYSHOW(NSD(JT)+1,NSD(JT)+2,P(ID,5)) NSHAFT=N C...Check if new resonances were produced. KNSDA1=IABS(K(NSD(JT)+1,2)) KNSDA2=IABS(K(NSD(JT)+2,2)) IF(KNSDA1.EQ.6.OR.KNSDA2.EQ.6.OR.KNSDA1.EQ.7.OR.KNSDA2.EQ.7.OR. &KNSDA1.EQ.8.OR.KNSDA2.EQ.8) THEN NSD1=0 NSD2=0 DO 460 I=NSD(JT)+1,N IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD(JT)+1,2)) NSD1=I IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD(JT)+2,2)) NSD2=I 460 CONTINUE IF(NSD1.NE.0.AND.NSD2.NE.0) THEN NP=NP+1 IREF(NP,1)=NSD1 IREF(NP,2)=NSD2 IREF(NP,3)=0 IREF(NP,4)=IDOC+1 IREF(NP,5)=IDOC+2 IREF(NP,6)=0 IREF(NP,7)=K(IREF(IP,JT),2) IREF(NP,8)=IREF(IP,JT) ENDIF ELSEIF(KDCY(JT).EQ.3.OR.KFA.EQ.6.OR.KFA.EQ.7.OR.KFA.EQ.8) THEN NP=NP+1 IREF(NP,1)=NSD(JT)+1 IREF(NP,2)=NSD(JT)+2 IF(NSHAFT-NSHBEF.GT.0) THEN IREF(NP,1)=NSHBEF+2 IREF(NP,2)=NSHBEF+3 ENDIF IREF(NP,3)=0 IREF(NP,4)=IDOC+1 IREF(NP,5)=IDOC+2 IREF(NP,6)=0 IREF(NP,7)=K(IREF(IP,JT),2) IREF(NP,8)=IREF(IP,JT) ENDIF 470 CONTINUE C...Fill information for 2 -> 1 -> 2. Loop back if needed. IF(JTMAX.EQ.1.AND.KDCY(1).NE.0) THEN MINT(7)=MINT(83)+6+2*ISET(ISUB) MINT(8)=MINT(83)+7+2*ISET(ISUB) MINT(25)=KFL1(1) MINT(26)=KFL2(1) VINT(23)=CTHE(1) RM3=P(N-1,5)**2/SH RM4=P(N,5)**2/SH BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) VINT(45)=-0.5D0*SH*(1D0-RM3-RM4-BE34*CTHE(1)) VINT(46)=-0.5D0*SH*(1D0-RM3-RM4+BE34*CTHE(1)) VINT(48)=0.25D0*SH*BE34**2*MAX(0D0,1D0-CTHE(1)**2) VINT(47)=SQRT(VINT(48)) ENDIF 480 IF(IP.LT.NP) GOTO 130 RETURN END C********************************************************************* C...PYMULT C...Initializes treatment of multiple interactions, selects kinematics C...of hardest interaction if low-pT physics included in run, and C...generates all non-hardest interactions. SUBROUTINE PYMULT(MMUL) C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) COMMON/PYINT7/SIGT(0:6,0:6,0:5) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, &/PYINT2/,/PYINT3/,/PYINT5/,/PYINT7/ C...Local arrays and saved variables. DIMENSION NMUL(20),SIGM(20),KSTR(500,2),VINTSV(80) SAVE XT2,XT2FAC,XC2,XTS,IRBIN,RBIN,NMUL,SIGM C...Initialization of multiple interaction treatment. IF(MMUL.EQ.1) THEN IF(MSTP(122).GE.1) WRITE(MSTU(11),5000) MSTP(82) ISUB=96 MINT(1)=96 VINT(63)=0D0 VINT(64)=0D0 VINT(143)=1D0 VINT(144)=1D0 C...Loop over phase space points: xT2 choice in 20 bins. 100 SIGSUM=0D0 DO 120 IXT2=1,20 NMUL(IXT2)=MSTP(83) SIGM(IXT2)=0D0 DO 110 ITRY=1,MSTP(83) RSCA=0.05D0*((21-IXT2)-PYR(0)) XT2=VINT(149)*(1D0+VINT(149))/(VINT(149)+RSCA)-VINT(149) XT2=MAX(0.01D0*VINT(149),XT2) VINT(25)=XT2 C...Choose tau and y*. Calculate cos(theta-hat). IF(PYR(0).LE.COEF(ISUB,1)) THEN TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) ELSE TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) ENDIF VINT(21)=TAU CALL PYKLIM(2) RYST=PYR(0) MYST=1 IF(RYST.GT.COEF(ISUB,8)) MYST=2 IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 CALL PYKMAP(2,MYST,PYR(0)) VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) C...Calculate differential cross-section. VINT(71)=0.5D0*VINT(1)*SQRT(XT2) CALL PYSIGH(NCHN,SIGS) SIGM(IXT2)=SIGM(IXT2)+SIGS 110 CONTINUE SIGSUM=SIGSUM+SIGM(IXT2) 120 CONTINUE SIGSUM=SIGSUM/(20D0*MSTP(83)) C...Reject result if sigma(parton-parton) is smaller than hadronic one. IF(SIGSUM.LT.1.1D0*SIGT(0,0,5)) THEN IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) PARP(82),SIGSUM PARP(82)=0.9D0*PARP(82) VINT(149)=4D0*PARP(82)**2/VINT(2) GOTO 100 ENDIF IF(MSTP(122).GE.1) WRITE(MSTU(11),5200) PARP(82), SIGSUM C...Start iteration to find k factor. YKE=SIGSUM/SIGT(0,0,5) SO=0.5D0 XI=0D0 YI=0D0 XF=0D0 YF=0D0 XK=0.5D0 IIT=0 130 IF(IIT.EQ.0) THEN XK=2D0*XK ELSEIF(IIT.EQ.1) THEN XK=0.5D0*XK ELSE XK=XI+(YKE-YI)*(XF-XI)/(YF-YI) ENDIF C...Evaluate overlap integrals. IF(MSTP(82).EQ.2) THEN SP=0.5D0*PARU(1)*(1D0-EXP(-XK)) SOP=SP/PARU(1) ELSE IF(MSTP(82).EQ.3) DELTAB=0.02D0 IF(MSTP(82).EQ.4) DELTAB=MIN(0.01D0,0.05D0*PARP(84)) SP=0D0 SOP=0D0 B=-0.5D0*DELTAB 140 B=B+DELTAB IF(MSTP(82).EQ.3) THEN OV=EXP(-B**2)/PARU(2) ELSE CQ2=PARP(84)**2 OV=((1D0-PARP(83))**2*EXP(-MIN(50D0,B**2))+ & 2D0*PARP(83)*(1D0-PARP(83))*2D0/(1D0+CQ2)* & EXP(-MIN(50D0,B**2*2D0/(1D0+CQ2)))+ & PARP(83)**2/CQ2*EXP(-MIN(50D0,B**2/CQ2)))/PARU(2) ENDIF PACC=1D0-EXP(-MIN(50D0,PARU(1)*XK*OV)) SP=SP+PARU(2)*B*DELTAB*PACC SOP=SOP+PARU(2)*B*DELTAB*OV*PACC IF(B.LT.1D0.OR.B*PACC.GT.1D-6) GOTO 140 ENDIF YK=PARU(1)*XK*SO/SP C...Continue iteration until convergence. IF(YK.LT.YKE) THEN XI=XK YI=YK IF(IIT.EQ.1) IIT=2 ELSE XF=XK YF=YK IF(IIT.EQ.0) IIT=1 ENDIF IF(ABS(YK-YKE).GE.1D-5*YKE) GOTO 130 C...Store some results for subsequent use. VINT(145)=SIGSUM VINT(146)=SOP/SO VINT(147)=SOP/SP C...Initialize iteration in xT2 for hardest interaction. ELSEIF(MMUL.EQ.2) THEN IF(MSTP(82).LE.0) THEN ELSEIF(MSTP(82).EQ.1) THEN XT2=1D0 XT2FAC=XSEC(96,1)/SIGT(0,0,5)*VINT(149)/(1D0-VINT(149)) ELSEIF(MSTP(82).EQ.2) THEN XT2=1D0 XT2FAC=VINT(146)*XSEC(96,1)/SIGT(0,0,5)*VINT(149)* & (1D0+VINT(149)) ELSE XC2=4D0*CKIN(3)**2/VINT(2) IF(CKIN(3).LE.CKIN(5).OR.MINT(82).GE.2) XC2=0D0 ENDIF ELSEIF(MMUL.EQ.3) THEN C...Low-pT or multiple interactions (first semihard interaction): C...choose xT2 according to dpT2/pT2**2*exp(-(sigma above pT2)/norm) C...or (MSTP(82)>=2) dpT2/(pT2+pT0**2)**2*exp(-....). ISUB=MINT(1) IF(MSTP(82).LE.0) THEN XT2=0D0 ELSEIF(MSTP(82).EQ.1) THEN XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) ELSEIF(MSTP(82).EQ.2) THEN IF(XT2.LT.1D0.AND.EXP(-XT2FAC*XT2/(VINT(149)*(XT2+ & VINT(149)))).GT.PYR(0)) XT2=1D0 IF(XT2.GE.1D0) THEN XT2=(1D0+VINT(149))*XT2FAC/(XT2FAC-(1D0+VINT(149))*LOG(1D0- & PYR(0)*(1D0-EXP(-XT2FAC/(VINT(149)*(1D0+VINT(149)))))))- & VINT(149) ELSE XT2=-XT2FAC/LOG(EXP(-XT2FAC/(XT2+VINT(149)))+PYR(0)* & (EXP(-XT2FAC/VINT(149))-EXP(-XT2FAC/(XT2+VINT(149)))))- & VINT(149) ENDIF XT2=MAX(0.01D0*VINT(149),XT2) ELSE XT2=(XC2+VINT(149))*(1D0+VINT(149))/(1D0+VINT(149)- & PYR(0)*(1D0-XC2))-VINT(149) XT2=MAX(0.01D0*VINT(149),XT2) ENDIF VINT(25)=XT2 C...Low-pT: choose xT2, tau, y* and cos(theta-hat) fixed. IF(MSTP(82).LE.1.AND.XT2.LT.VINT(149)) THEN IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)-1 IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)-1 ISUB=95 MINT(1)=ISUB VINT(21)=0.01D0*VINT(149) VINT(22)=0D0 VINT(23)=0D0 VINT(25)=0.01D0*VINT(149) ELSE C...Multiple interactions (first semihard interaction). C...Choose tau and y*. Calculate cos(theta-hat). IF(PYR(0).LE.COEF(ISUB,1)) THEN TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) ELSE TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) ENDIF VINT(21)=TAU CALL PYKLIM(2) RYST=PYR(0) MYST=1 IF(RYST.GT.COEF(ISUB,8)) MYST=2 IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 CALL PYKMAP(2,MYST,PYR(0)) VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) ENDIF VINT(71)=0.5D0*VINT(1)*SQRT(VINT(25)) C...Store results of cross-section calculation. ELSEIF(MMUL.EQ.4) THEN ISUB=MINT(1) XTS=VINT(25) IF(ISET(ISUB).EQ.1) XTS=VINT(21) IF(ISET(ISUB).EQ.2) & XTS=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) XTS=VINT(26) RBIN=MAX(0.000001D0,MIN(0.999999D0,XTS*(1D0+VINT(149))/ & (XTS+VINT(149)))) IRBIN=INT(1D0+20D0*RBIN) IF(ISUB.EQ.96.AND.MSTP(171).EQ.0) THEN NMUL(IRBIN)=NMUL(IRBIN)+1 SIGM(IRBIN)=SIGM(IRBIN)+VINT(153) ENDIF C...Choose impact parameter. ELSEIF(MMUL.EQ.5) THEN IF(MSTP(82).EQ.3) THEN VINT(148)=PYR(0)/(PARU(2)*VINT(147)) ELSE RTYPE=PYR(0) CQ2=PARP(84)**2 IF(RTYPE.LT.(1D0-PARP(83))**2) THEN B2=-LOG(PYR(0)) ELSEIF(RTYPE.LT.1D0-PARP(83)**2) THEN B2=-0.5D0*(1D0+CQ2)*LOG(PYR(0)) ELSE B2=-CQ2*LOG(PYR(0)) ENDIF VINT(148)=((1D0-PARP(83))**2*EXP(-MIN(50D0,B2))+2D0*PARP(83)* & (1D0-PARP(83))*2D0/(1D0+CQ2)*EXP(-MIN(50D0,B2*2D0/(1D0+CQ2)))+ & PARP(83)**2/CQ2*EXP(-MIN(50D0,B2/CQ2)))/(PARU(2)*VINT(147)) ENDIF C...Multiple interactions (variable impact parameter) : reject with C...probability exp(-overlap*cross-section above pT/normalization). RNCOR=(IRBIN-20D0*RBIN)*NMUL(IRBIN) SIGCOR=(IRBIN-20D0*RBIN)*SIGM(IRBIN) DO 150 IBIN=IRBIN+1,20 RNCOR=RNCOR+NMUL(IBIN) SIGCOR=SIGCOR+SIGM(IBIN) 150 CONTINUE SIGABV=(SIGCOR/RNCOR)*VINT(149)*(1D0-XTS)/(XTS+VINT(149)) IF(MSTP(171).EQ.1) SIGABV=SIGABV*VINT(2)/VINT(289) VINT(150)=EXP(-MIN(50D0,VINT(146)*VINT(148)* & SIGABV/SIGT(0,0,5))) C...Generate additional multiple semihard interactions. ELSEIF(MMUL.EQ.6) THEN ISUBSV=MINT(1) DO 160 J=11,80 VINTSV(J)=VINT(J) 160 CONTINUE ISUB=96 MINT(1)=96 C...Reconstruct strings in hard scattering. NMAX=MINT(84)+4 IF(ISET(ISUBSV).EQ.1) NMAX=MINT(84)+2 IF(ISET(ISUBSV).EQ.11) NMAX=MINT(84)+2+MINT(3) NSTR=0 DO 180 I=MINT(84)+1,NMAX KCS=KCHG(PYCOMP(K(I,2)),2)*ISIGN(1,K(I,2)) IF(KCS.EQ.0) GOTO 180 DO 170 J=1,4 IF(KCS.EQ.1.AND.(J.EQ.2.OR.J.EQ.4)) GOTO 170 IF(KCS.EQ.-1.AND.(J.EQ.1.OR.J.EQ.3)) GOTO 170 IF(J.LE.2) THEN IST=MOD(K(I,J+3)/MSTU(5),MSTU(5)) ELSE IST=MOD(K(I,J+1),MSTU(5)) ENDIF IF(IST.LT.MINT(84).OR.IST.GT.I) GOTO 170 IF(KCHG(PYCOMP(K(IST,2)),2).EQ.0) GOTO 170 NSTR=NSTR+1 IF(J.EQ.1.OR.J.EQ.4) THEN KSTR(NSTR,1)=I KSTR(NSTR,2)=IST ELSE KSTR(NSTR,1)=IST KSTR(NSTR,2)=I ENDIF 170 CONTINUE 180 CONTINUE C...Set up starting values for iteration in xT2. XT2=VINT(25) IF(ISET(ISUBSV).EQ.1) XT2=VINT(21) IF(ISET(ISUBSV).EQ.2) & XT2=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) IF(ISET(ISUBSV).GE.3.AND.ISET(ISUBSV).LE.5) XT2=VINT(26) IF(MSTP(82).LE.1) THEN XT2FAC=XSEC(ISUB,1)*VINT(149)/((1D0-VINT(149))*SIGT(0,0,5)) ELSE XT2FAC=VINT(146)*VINT(148)*XSEC(ISUB,1)/SIGT(0,0,5)* & VINT(149)*(1D0+VINT(149)) ENDIF VINT(63)=0D0 VINT(64)=0D0 VINT(143)=1D0-VINT(141) VINT(144)=1D0-VINT(142) C...Iterate downwards in xT2. 190 IF(MSTP(82).LE.1) THEN XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) IF(XT2.LT.VINT(149)) GOTO 240 ELSE IF(XT2.LE.0.01D0*VINT(149)) GOTO 240 XT2=XT2FAC*(XT2+VINT(149))/(XT2FAC-(XT2+VINT(149))* & LOG(PYR(0)))-VINT(149) IF(XT2.LE.0D0) GOTO 240 XT2=MAX(0.01D0*VINT(149),XT2) ENDIF VINT(25)=XT2 C...Choose tau and y*. Calculate cos(theta-hat). IF(PYR(0).LE.COEF(ISUB,1)) THEN TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) ELSE TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) ENDIF VINT(21)=TAU CALL PYKLIM(2) RYST=PYR(0) MYST=1 IF(RYST.GT.COEF(ISUB,8)) MYST=2 IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 CALL PYKMAP(2,MYST,PYR(0)) VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) C...Check that x not used up. Accept or reject kinematical variables. X1M=SQRT(TAU)*EXP(VINT(22)) X2M=SQRT(TAU)*EXP(-VINT(22)) IF(VINT(143)-X1M.LT.0.01D0.OR.VINT(144)-X2M.LT.0.01D0) GOTO 190 VINT(71)=0.5D0*VINT(1)*SQRT(XT2) CALL PYSIGH(NCHN,SIGS) IF(SIGS.LT.XSEC(ISUB,1)*PYR(0)) GOTO 190 C...Reset K, P and V vectors. Select some variables. DO 210 I=N+1,N+2 DO 200 J=1,5 K(I,J)=0 P(I,J)=0D0 V(I,J)=0D0 200 CONTINUE 210 CONTINUE RFLAV=PYR(0) PT=0.5D0*VINT(1)*SQRT(XT2) PHI=PARU(2)*PYR(0) CTH=VINT(23) C...Add first parton to event record. K(N+1,1)=3 K(N+1,2)=21 IF(RFLAV.GE.MAX(PARP(85),PARP(86))) K(N+1,2)= & 1+INT((2D0+PARJ(2))*PYR(0)) P(N+1,1)=PT*COS(PHI) P(N+1,2)=PT*SIN(PHI) P(N+1,3)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)-VINT(42)*(1D0-CTH)) P(N+1,4)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)+VINT(42)*(1D0-CTH)) P(N+1,5)=0D0 C...Add second parton to event record. K(N+2,1)=3 K(N+2,2)=21 IF(K(N+1,2).NE.21) K(N+2,2)=-K(N+1,2) P(N+2,1)=-P(N+1,1) P(N+2,2)=-P(N+1,2) P(N+2,3)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)-VINT(42)*(1D0+CTH)) P(N+2,4)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)+VINT(42)*(1D0+CTH)) P(N+2,5)=0D0 IF(RFLAV.LT.PARP(85).AND.NSTR.GE.1) THEN C....Choose relevant string pieces to place gluons on. DO 230 I=N+1,N+2 DMIN=1D8 DO 220 ISTR=1,NSTR I1=KSTR(ISTR,1) I2=KSTR(ISTR,2) DIST=(P(I,4)*P(I1,4)-P(I,1)*P(I1,1)-P(I,2)*P(I1,2)- & P(I,3)*P(I1,3))*(P(I,4)*P(I2,4)-P(I,1)*P(I2,1)- & P(I,2)*P(I2,2)-P(I,3)*P(I2,3))/MAX(1D0,P(I1,4)*P(I2,4)- & P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-P(I1,3)*P(I2,3)) IF(ISTR.EQ.1.OR.DIST.LT.DMIN) THEN DMIN=DIST IST1=I1 IST2=I2 ISTM=ISTR ENDIF 220 CONTINUE C....Colour flow adjustments, new string pieces. IF(K(IST1,4)/MSTU(5).EQ.IST2) K(IST1,4)=MSTU(5)*I+ & MOD(K(IST1,4),MSTU(5)) IF(MOD(K(IST1,5),MSTU(5)).EQ.IST2) K(IST1,5)= & MSTU(5)*(K(IST1,5)/MSTU(5))+I K(I,5)=MSTU(5)*IST1 K(I,4)=MSTU(5)*IST2 IF(K(IST2,5)/MSTU(5).EQ.IST1) K(IST2,5)=MSTU(5)*I+ & MOD(K(IST2,5),MSTU(5)) IF(MOD(K(IST2,4),MSTU(5)).EQ.IST1) K(IST2,4)= & MSTU(5)*(K(IST2,4)/MSTU(5))+I KSTR(ISTM,2)=I KSTR(NSTR+1,1)=I KSTR(NSTR+1,2)=IST2 NSTR=NSTR+1 230 CONTINUE C...String drawing and colour flow for gluon loop. ELSEIF(K(N+1,2).EQ.21) THEN K(N+1,4)=MSTU(5)*(N+2) K(N+1,5)=MSTU(5)*(N+2) K(N+2,4)=MSTU(5)*(N+1) K(N+2,5)=MSTU(5)*(N+1) KSTR(NSTR+1,1)=N+1 KSTR(NSTR+1,2)=N+2 KSTR(NSTR+2,1)=N+2 KSTR(NSTR+2,2)=N+1 NSTR=NSTR+2 C...String drawing and colour flow for qqbar pair. ELSE K(N+1,4)=MSTU(5)*(N+2) K(N+2,5)=MSTU(5)*(N+1) KSTR(NSTR+1,1)=N+1 KSTR(NSTR+1,2)=N+2 NSTR=NSTR+1 ENDIF C...Update remaining energy; iterate. N=N+2 IF(N.GT.MSTU(4)-MSTU(32)-10) THEN CALL PYERRM(11,'(PYMULT:) no more memory left in PYJETS') IF(MSTU(21).GE.1) RETURN ENDIF MINT(31)=MINT(31)+1 VINT(151)=VINT(151)+VINT(41) VINT(152)=VINT(152)+VINT(42) VINT(143)=VINT(143)-VINT(41) VINT(144)=VINT(144)-VINT(42) IF(MINT(31).LT.240) GOTO 190 240 CONTINUE MINT(1)=ISUBSV DO 250 J=11,80 VINT(J)=VINTSV(J) 250 CONTINUE ENDIF C...Format statements for printout. 5000 FORMAT(/1X,'****** PYMULT: initialization of multiple inter', &'actions for MSTP(82) =',I2,' ******') 5100 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, &D9.2,' mb: rejected') 5200 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, &D9.2,' mb: accepted') RETURN END C********************************************************************* C...PYREMN C...Adds on target remnants (one or two from each side) and C...includes primordial kT for hadron beams. SUBROUTINE PYREMN(IPU1,IPU2) C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ C...Local arrays. DIMENSION KFLCH(2),KFLSP(2),CHI(2),PMS(0:6),IS(2),ISN(2),ROBO(5), &PSYS(0:2,5),PMIN(0:2),QOLD(4),QNEW(4),DBE(3),PSUM(4) C...Find event type and remaining energy. ISUB=MINT(1) NS=N IF(MINT(50).EQ.0.OR.MSTP(81).LE.0) THEN VINT(143)=1D0-VINT(141) VINT(144)=1D0-VINT(142) ENDIF C...Define initial partons. NTRY=0 100 NTRY=NTRY+1 DO 130 JT=1,2 I=MINT(83)+JT+2 IF(JT.EQ.1) IPU=IPU1 IF(JT.EQ.2) IPU=IPU2 K(I,1)=21 K(I,2)=K(IPU,2) K(I,3)=I-2 PMS(JT)=0D0 VINT(156+JT)=0D0 VINT(158+JT)=0D0 IF(MINT(47).EQ.1) THEN DO 110 J=1,5 P(I,J)=P(I-2,J) 110 CONTINUE ELSEIF(ISUB.EQ.95) THEN K(I,2)=21 ELSE P(I,5)=P(IPU,5) C...No primordial kT, or chosen according to truncated Gaussian or C...exponential, or (for photon) predetermined or power law. 120 IF(MINT(40+JT).EQ.2.AND.MINT(10+JT).NE.22) THEN IF(MSTP(91).LE.0) THEN PT=0D0 ELSEIF(MSTP(91).EQ.1) THEN PT=PARP(91)*SQRT(-LOG(PYR(0))) ELSE RPT1=PYR(0) RPT2=PYR(0) PT=-PARP(92)*LOG(RPT1*RPT2) ENDIF IF(PT.GT.PARP(93)) GOTO 120 ELSEIF(MINT(106+JT).EQ.3) THEN PT=SQRT(VINT(282+JT)) PT=PT*0.8D0**MINT(57) IF(NTRY.GT.10) PT=PT*0.8D0**(NTRY-10) ELSEIF(IABS(MINT(14+JT)).LE.8.OR.MINT(14+JT).EQ.21) THEN IF(MSTP(93).LE.0) THEN PT=0D0 ELSEIF(MSTP(93).EQ.1) THEN PT=PARP(99)*SQRT(-LOG(PYR(0))) ELSEIF(MSTP(93).EQ.2) THEN RPT1=PYR(0) RPT2=PYR(0) PT=-PARP(99)*LOG(RPT1*RPT2) ELSEIF(MSTP(93).EQ.3) THEN HA=PARP(99)**2 HB=PARP(100)**2 PT=SQRT(MAX(0D0,HA*(HA+HB)/(HA+HB-PYR(0)*HB)-HA)) ELSE HA=PARP(99)**2 HB=PARP(100)**2 IF(MSTP(93).EQ.5) HB=MIN(VINT(48),PARP(100)**2) PT=SQRT(MAX(0D0,HA*((HA+HB)/HA)**PYR(0)-HA)) ENDIF IF(PT.GT.PARP(100)) GOTO 120 ELSE PT=0D0 ENDIF VINT(156+JT)=PT PHI=PARU(2)*PYR(0) P(I,1)=PT*COS(PHI) P(I,2)=PT*SIN(PHI) PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 ENDIF 130 CONTINUE IF(MINT(47).EQ.1) RETURN C...Kinematics construction for initial partons. I1=MINT(83)+3 I2=MINT(83)+4 IF(ISUB.EQ.95) THEN SHS=0D0 SHR=0D0 ELSE SHS=VINT(141)*VINT(142)*VINT(2)+(P(I1,1)+P(I2,1))**2+ & (P(I1,2)+P(I2,2))**2 SHR=SQRT(MAX(0D0,SHS)) IF((SHS-PMS(1)-PMS(2))**2-4D0*PMS(1)*PMS(2).LE.0D0) GOTO 100 P(I1,4)=0.5D0*(SHR+(PMS(1)-PMS(2))/SHR) P(I1,3)=SQRT(MAX(0D0,P(I1,4)**2-PMS(1))) P(I2,4)=SHR-P(I1,4) P(I2,3)=-P(I1,3) C...Transform partons to overall CM-frame. ROBO(3)=(P(I1,1)+P(I2,1))/SHR ROBO(4)=(P(I1,2)+P(I2,2))/SHR CALL PYROBO(I1,I2,0D0,0D0,-ROBO(3),-ROBO(4),0D0) ROBO(2)=PYANGL(P(I1,1),P(I1,2)) CALL PYROBO(I1,I2,0D0,-ROBO(2),0D0,0D0,0D0) ROBO(1)=PYANGL(P(I1,3),P(I1,1)) CALL PYROBO(I1,I2,-ROBO(1),0D0,0D0,0D0,0D0) CALL PYROBO(I1,MINT(52),ROBO(1),ROBO(2),ROBO(3),ROBO(4),0D0) ROBO(5)=MAX(-0.999999D0,MIN(0.999999D0,(VINT(141)-VINT(142))/ & (VINT(141)+VINT(142)))) CALL PYROBO(I1,MINT(52),0D0,0D0,0D0,0D0,ROBO(5)) ENDIF C...Optionally fix up x and Q2 definitions for leptoproduction. IDISXQ=0 IF((MINT(43).EQ.2.OR.MINT(43).EQ.3).AND.((ISUB.EQ.10.AND. &MSTP(23).GE.1).OR.(ISUB.EQ.83.AND.MSTP(23).GE.2))) IDISXQ=1 IF(IDISXQ.EQ.1) THEN C...Find where incoming and outgoing leptons/partons are sitting. LESD=1 IF(MINT(42).EQ.1) LESD=2 LPIN=MINT(83)+3-LESD LEIN=MINT(84)+LESD LQIN=MINT(84)+3-LESD LEOUT=MINT(84)+2+LESD LQOUT=MINT(84)+5-LESD IF(K(LEIN,3).GT.LEIN) LEIN=K(LEIN,3) IF(K(LQIN,3).GT.LQIN) LQIN=K(LQIN,3) LSCMS=0 DO 140 I=MINT(84)+5,N IF(K(I,2).EQ.94) THEN LSCMS=I LEOUT=I+LESD LQOUT=I+3-LESD ENDIF 140 CONTINUE LQBG=IPU1 IF(LESD.EQ.1) LQBG=IPU2 C...Calculate actual and wanted momentum transfer. XNOM=VINT(43-LESD) Q2NOM=-VINT(45) HPK=2D0*(P(LPIN,4)*P(LEIN,4)-P(LPIN,1)*P(LEIN,1)- & P(LPIN,2)*P(LEIN,2)-P(LPIN,3)*P(LEIN,3))* & (P(MINT(83)+LESD,4)*VINT(40+LESD)/P(LEIN,4)) HPT2=MAX(0D0,Q2NOM*(1D0-Q2NOM/(XNOM*HPK))) FAC=SQRT(HPT2/(P(LEOUT,1)**2+P(LEOUT,2)**2)) P(N+1,1)=FAC*P(LEOUT,1) P(N+1,2)=FAC*P(LEOUT,2) P(N+1,3)=0.25D0*((HPK-Q2NOM/XNOM)/P(LPIN,4)- & Q2NOM/(P(MINT(83)+LESD,4)*VINT(40+LESD)))*(-1)**(LESD+1) P(N+1,4)=SQRT(P(LEOUT,5)**2+P(N+1,1)**2+P(N+1,2)**2+ & P(N+1,3)**2) DO 150 J=1,4 QOLD(J)=P(LEIN,J)-P(LEOUT,J) QNEW(J)=P(LEIN,J)-P(N+1,J) 150 CONTINUE C...Boost outgoing electron and daughters. IF(LSCMS.EQ.0) THEN DO 160 J=1,4 P(LEOUT,J)=P(N+1,J) 160 CONTINUE ELSE DO 170 J=1,3 P(N+2,J)=(P(N+1,J)-P(LEOUT,J))/(P(N+1,4)+P(LEOUT,4)) 170 CONTINUE PINV=2D0/(1D0+P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2) DO 180 J=1,3 DBE(J)=PINV*P(N+2,J) 180 CONTINUE DO 200 I=LSCMS+1,N IORIG=I 190 IORIG=K(IORIG,3) IF(IORIG.GT.LEOUT) GOTO 190 IF(I.EQ.LEOUT.OR.IORIG.EQ.LEOUT) & CALL PYROBO(I,I,0D0,0D0,DBE(1),DBE(2),DBE(3)) 200 CONTINUE ENDIF C...Copy shower initiator and all outgoing partons. NCOP=N+1 K(NCOP,3)=LQBG DO 210 J=1,5 P(NCOP,J)=P(LQBG,J) 210 CONTINUE DO 240 I=MINT(84)+1,N ICOP=0 IF(K(I,1).GT.10) GOTO 240 IF(I.EQ.LQBG.OR.I.EQ.LQOUT) THEN ICOP=I ELSE IORIG=I 220 IORIG=K(IORIG,3) IF(IORIG.EQ.LQBG.OR.IORIG.EQ.LQOUT) THEN ICOP=IORIG ELSEIF(IORIG.GT.MINT(84).AND.IORIG.LE.N) THEN GOTO 220 ENDIF ENDIF IF(ICOP.NE.0) THEN NCOP=NCOP+1 K(NCOP,3)=I DO 230 J=1,5 P(NCOP,J)=P(I,J) 230 CONTINUE ENDIF 240 CONTINUE C...Calculate relative rescaling factors. SLC=3-2*LESD PLCSUM=0D0 DO 250 I=N+2,NCOP PLCSUM=PLCSUM+(P(I,4)+SLC*P(I,3)) 250 CONTINUE DO 260 I=N+2,NCOP V(I,1)=(P(I,4)+SLC*P(I,3))/PLCSUM 260 CONTINUE C...Transfer extra three-momentum of current. DO 280 I=N+2,NCOP DO 270 J=1,3 P(I,J)=P(I,J)+V(I,1)*(QNEW(J)-QOLD(J)) 270 CONTINUE P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) 280 CONTINUE C...Iterate change of initiator momentum to get energy right. ITER=0 290 ITER=ITER+1 PEEX=-P(N+1,4)-QNEW(4) PEMV=-P(N+1,3)/P(N+1,4) DO 300 I=N+2,NCOP PEEX=PEEX+P(I,4) PEMV=PEMV+V(I,1)*P(I,3)/P(I,4) 300 CONTINUE IF(ABS(PEMV).LT.1D-10) THEN MINT(51)=1 MINT(57)=MINT(57)+1 RETURN ENDIF PZCH=-PEEX/PEMV P(N+1,3)=P(N+1,3)+PZCH P(N+1,4)=SQRT(P(N+1,5)**2+P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2) DO 310 I=N+2,NCOP P(I,3)=P(I,3)+V(I,1)*PZCH P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) 310 CONTINUE IF(ITER.LT.10.AND.ABS(PEEX).GT.1D-6*P(N+1,4)) GOTO 290 C...Modify momenta in event record. HBE=2D0*(P(N+1,4)+P(LQBG,4))*(P(N+1,3)-P(LQBG,3))/ & ((P(N+1,4)+P(LQBG,4))**2+(P(N+1,3)-P(LQBG,3))**2) IF(ABS(HBE).GT.0.999999D0) THEN MINT(51)=1 MINT(57)=MINT(57)+1 RETURN ENDIF I=MINT(83)+5-LESD CALL PYROBO(I,I,0D0,0D0,0D0,0D0,HBE) DO 330 I=N+1,NCOP ICOP=K(I,3) DO 320 J=1,4 P(ICOP,J)=P(I,J) 320 CONTINUE 330 CONTINUE ENDIF C...Check minimum invariant mass of remnant system(s). PSYS(0,4)=P(I1,4)+P(I2,4)+0.5D0*VINT(1)*(VINT(151)+VINT(152)) PSYS(0,3)=P(I1,3)+P(I2,3)+0.5D0*VINT(1)*(VINT(151)-VINT(152)) PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) PMIN(0)=SQRT(PMS(0)) DO 340 JT=1,2 PSYS(JT,4)=0.5D0*VINT(1)*VINT(142+JT) PSYS(JT,3)=PSYS(JT,4)*(-1)**(JT-1) PMIN(JT)=0D0 IF(MINT(44+JT).EQ.1) GOTO 340 MINT(105)=MINT(102+JT) MINT(109)=MINT(106+JT) CALL PYSPLI(MINT(10+JT),MINT(12+JT),KFLCH(JT),KFLSP(JT)) IF(KFLCH(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLCH(JT)) IF(KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLSP(JT)) IF(KFLCH(JT)*KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+0.5D0*PARP(111) PMIN(JT)=SQRT(PMIN(JT)**2+P(MINT(83)+JT+2,1)**2+ & P(MINT(83)+JT+2,2)**2) 340 CONTINUE IF(PMIN(0)+PMIN(1)+PMIN(2).GT.VINT(1).OR.(MINT(45).GE.2.AND. &PMIN(1).GT.PSYS(1,4)).OR.(MINT(46).GE.2.AND.PMIN(2).GT. &PSYS(2,4))) THEN MINT(51)=1 MINT(57)=MINT(57)+1 RETURN ENDIF C...Loop over two remnants; skip if none there. I=NS DO 410 JT=1,2 ISN(JT)=0 IF(MINT(44+JT).EQ.1) GOTO 410 IF(JT.EQ.1) IPU=IPU1 IF(JT.EQ.2) IPU=IPU2 C...Store first remnant parton. I=I+1 IS(JT)=I ISN(JT)=1 DO 350 J=1,5 K(I,J)=0 P(I,J)=0D0 V(I,J)=0D0 350 CONTINUE K(I,1)=1 K(I,2)=KFLSP(JT) K(I,3)=MINT(83)+JT P(I,5)=PYMASS(K(I,2)) C...First parton colour connections and kinematics. KCOL=KCHG(PYCOMP(KFLSP(JT)),2) IF(KCOL.EQ.2) THEN K(I,1)=3 K(I,4)=MSTU(5)*IPU+IPU K(I,5)=MSTU(5)*IPU+IPU K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I ELSEIF(KCOL.NE.0) THEN K(I,1)=3 KFLS=(3-KCOL*ISIGN(1,KFLSP(JT)))/2 K(I,KFLS+3)=IPU K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I ENDIF IF(KFLCH(JT).EQ.0) THEN P(I,1)=-P(MINT(83)+JT+2,1) P(I,2)=-P(MINT(83)+JT+2,2) PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) P(I,3)=PSYS(JT,3) P(I,4)=PSYS(JT,4) C...When extra remnant parton or hadron: store extra remnant. ELSE I=I+1 ISN(JT)=2 DO 360 J=1,5 K(I,J)=0 P(I,J)=0D0 V(I,J)=0D0 360 CONTINUE K(I,1)=1 K(I,2)=KFLCH(JT) K(I,3)=MINT(83)+JT P(I,5)=PYMASS(K(I,2)) C...Find parton colour connections of extra remnant. KCOL=KCHG(PYCOMP(KFLCH(JT)),2) IF(KCOL.EQ.2) THEN K(I,1)=3 K(I,4)=MSTU(5)*IPU+IPU K(I,5)=MSTU(5)*IPU+IPU K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I ELSEIF(KCOL.NE.0) THEN K(I,1)=3 KFLS=(3-KCOL*ISIGN(1,KFLCH(JT)))/2 K(I,KFLS+3)=IPU K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I ENDIF C...Relative transverse momentum when two remnants. LOOP=0 370 LOOP=LOOP+1 CALL PYPTDI(1,P(I-1,1),P(I-1,2)) IF(IABS(MINT(10+JT)).LT.20) THEN P(I-1,1)=0D0 P(I-1,2)=0D0 ENDIF PMS(JT+2)=P(I-1,5)**2+P(I-1,1)**2+P(I-1,2)**2 P(I,1)=-P(MINT(83)+JT+2,1)-P(I-1,1) P(I,2)=-P(MINT(83)+JT+2,2)-P(I-1,2) PMS(JT+4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 C...Meson or baryon; photon as meson. For splitup below. IMB=1 IF(MOD(MINT(10+JT)/1000,10).NE.0) IMB=2 C***Relative distribution for electron into two electrons. Temporary! IF(IABS(MINT(10+JT)).LT.20.AND.MINT(14+JT).EQ.-MINT(10+JT)) & THEN CHI(JT)=PYR(0) C...Relative distribution of electron energy into electron plus parton. ELSEIF(IABS(MINT(10+JT)).LT.20) THEN XHRD=VINT(140+JT) XE=VINT(154+JT) CHI(JT)=(XE-XHRD)/(1D0-XHRD) C...Relative distribution of energy for particle into two jets. ELSEIF(IABS(KFLCH(JT)).LE.10.OR.KFLCH(JT).EQ.21) THEN CHIK=PARP(92+2*IMB) IF(MSTP(92).LE.1) THEN IF(IMB.EQ.1) CHI(JT)=PYR(0) IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) ELSEIF(MSTP(92).EQ.2) THEN CHI(JT)=1D0-PYR(0)**(1D0/(1D0+CHIK)) ELSEIF(MSTP(92).EQ.3) THEN CUT=2D0*0.3D0/VINT(1) 380 CHI(JT)=PYR(0)**2 IF((CHI(JT)**2/(CHI(JT)**2+CUT**2))**0.25D0* & (1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 380 ELSEIF(MSTP(92).EQ.4) THEN CUT=2D0*0.3D0/VINT(1) CUTR=(1D0+SQRT(1D0+CUT**2))/CUT 390 CHIR=CUT*CUTR**PYR(0) CHI(JT)=(CHIR**2-CUT**2)/(2D0*CHIR) IF((1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 390 ELSE CUT=2D0*0.3D0/VINT(1) CUTA=CUT**(1D0-PARP(98)) CUTB=(1D0+CUT)**(1D0-PARP(98)) 400 CHI(JT)=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) IF(((CHI(JT)+CUT)**2/(2D0*(CHI(JT)**2+CUT**2)))** & (0.5D0*PARP(98))*(1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 400 ENDIF C...Relative distribution of energy for particle into jet plus particle. ELSE IF(MSTP(94).LE.1) THEN IF(IMB.EQ.1) CHI(JT)=PYR(0) IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) ELSEIF(MSTP(94).EQ.2) THEN CHI(JT)=1D0-PYR(0)**(1D0/(1D0+PARP(93+2*IMB))) IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) ELSEIF(MSTP(94).EQ.3) THEN CALL PYZDIS(1,0,PMS(JT+4),ZZ) CHI(JT)=ZZ ELSE CALL PYZDIS(1000,0,PMS(JT+4),ZZ) CHI(JT)=ZZ ENDIF ENDIF C...Construct total transverse mass; reject if too large. PMS(JT)=PMS(JT+4)/CHI(JT)+PMS(JT+2)/(1D0-CHI(JT)) IF(PMS(JT).GT.PSYS(JT,4)**2) THEN IF(LOOP.LT.10) THEN GOTO 370 ELSE MINT(51)=1 MINT(57)=MINT(57)+1 RETURN ENDIF ENDIF PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) VINT(158+JT)=CHI(JT) C...Subdivide longitudinal momentum according to value selected above. PW1=CHI(JT)*(PSYS(JT,4)+ABS(PSYS(JT,3))) P(IS(JT)+1,4)=0.5D0*(PW1+PMS(JT+4)/PW1) P(IS(JT)+1,3)=0.5D0*(PW1-PMS(JT+4)/PW1)*(-1)**(JT-1) P(IS(JT),4)=PSYS(JT,4)-P(IS(JT)+1,4) P(IS(JT),3)=PSYS(JT,3)-P(IS(JT)+1,3) ENDIF 410 CONTINUE N=I C...Check if longitudinal boosts needed - if so pick two systems. PDEV=ABS(PSYS(0,4)+PSYS(1,4)+PSYS(2,4)-VINT(1))+ &ABS(PSYS(0,3)+PSYS(1,3)+PSYS(2,3)) IF(PDEV.LE.1D-6*VINT(1)) RETURN IF(ISN(1).EQ.0) THEN IR=0 IL=2 ELSEIF(ISN(2).EQ.0) THEN IR=1 IL=0 ELSEIF(VINT(143).GT.0.2D0.AND.VINT(144).GT.0.2D0) THEN IR=1 IL=2 ELSEIF(VINT(143).GT.0.2D0) THEN IR=1 IL=0 ELSEIF(VINT(144).GT.0.2D0) THEN IR=0 IL=2 ELSEIF(PMS(1)/PSYS(1,4)**2.GT.PMS(2)/PSYS(2,4)**2) THEN IR=1 IL=0 ELSE IR=0 IL=2 ENDIF IG=3-IR-IL C...E+-pL wanted for system to be modified. IF((IG.EQ.1.AND.ISN(1).EQ.0).OR.(IG.EQ.2.AND.ISN(2).EQ.0)) THEN PPB=VINT(1) PNB=VINT(1) ELSE PPB=VINT(1)-(PSYS(IG,4)+PSYS(IG,3)) PNB=VINT(1)-(PSYS(IG,4)-PSYS(IG,3)) ENDIF C...To keep x and Q2 in leptoproduction: do not count scattered lepton. IF(IDISXQ.EQ.1.AND.IG.NE.0) THEN PMTB=PPB*PNB PMTR=PMS(IR) PMTL=PMS(IL) SQLAM=SQRT(MAX(0D0,(PMTB-PMTR-PMTL)**2-4D0*PMTR*PMTL)) SQSGN=SIGN(1D0,PSYS(IR,3)*PSYS(IL,4)-PSYS(IL,3)*PSYS(IR,4)) RKR=(PMTB+PMTR-PMTL+SQLAM*SQSGN)/(2D0*(PSYS(IR,4)+PSYS(IR,3)) & *PNB) RKL=(PMTB+PMTL-PMTR+SQLAM*SQSGN)/(2D0*(PSYS(IL,4)-PSYS(IL,3)) & *PPB) BER=(RKR**2-1D0)/(RKR**2+1D0) BEL=-(RKL**2-1D0)/(RKL**2+1D0) PPB=PPB-(PSYS(0,4)+PSYS(0,3)) PNB=PNB-(PSYS(0,4)-PSYS(0,3)) DO 420 J=1,4 PSYS(0,J)=0D0 420 CONTINUE DO 450 I=MINT(84)+1,NS IF(K(I,1).GT.10) GOTO 450 INCL=0 IORIG=I 430 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 IORIG=K(IORIG,3) IF(IORIG.GT.LPIN) GOTO 430 IF(INCL.EQ.0) GOTO 450 DO 440 J=1,4 PSYS(0,J)=PSYS(0,J)+P(I,J) 440 CONTINUE 450 CONTINUE PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) PPB=PPB+(PSYS(0,4)+PSYS(0,3)) PNB=PNB+(PSYS(0,4)-PSYS(0,3)) ENDIF C...Construct longitudinal boosts. DPMTB=PPB*PNB DPMTR=PMS(IR) DPMTL=PMS(IL) DSQLAM=SQRT(MAX(0D0,(DPMTB-DPMTR-DPMTL)**2-4D0*DPMTR*DPMTL)) IF(DSQLAM.LE.1D-6*DPMTB) THEN MINT(51)=1 MINT(57)=MINT(57)+1 RETURN ENDIF DSQSGN=SIGN(1D0,PSYS(IR,3)*PSYS(IL,4)-PSYS(IL,3)*PSYS(IR,4)) DRKR=(DPMTB+DPMTR-DPMTL+DSQLAM*DSQSGN)/ &(2D0*(PSYS(IR,4)+PSYS(IR,3))*PNB) DRKL=(DPMTB+DPMTL-DPMTR+DSQLAM*DSQSGN)/ &(2D0*(PSYS(IL,4)-PSYS(IL,3))*PPB) DBER=(DRKR**2-1D0)/(DRKR**2+1D0) DBEL=-(DRKL**2-1D0)/(DRKL**2+1D0) C...Perform longitudinal boosts. IF(IR.EQ.1.AND.ISN(1).EQ.1.AND.DBER.LE.-0.99999999D0) THEN P(IS(1),3)=0D0 P(IS(1),4)=SQRT(P(IS(1),5)**2+P(IS(1),1)**2+P(IS(1),2)**2) ELSEIF(IR.EQ.1) THEN CALL PYROBO(IS(1),IS(1)+ISN(1)-1,0D0,0D0,0D0,0D0,DBER) ELSEIF(IDISXQ.EQ.1) THEN DO 470 I=I1,NS INCL=0 IORIG=I 460 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 IORIG=K(IORIG,3) IF(IORIG.GT.LPIN) GOTO 460 IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBER) 470 CONTINUE ELSE CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBER) ENDIF IF(IL.EQ.2.AND.ISN(2).EQ.1.AND.DBEL.GE.0.99999999D0) THEN P(IS(2),3)=0D0 P(IS(2),4)=SQRT(P(IS(2),5)**2+P(IS(2),1)**2+P(IS(2),2)**2) ELSEIF(IL.EQ.2) THEN CALL PYROBO(IS(2),IS(2)+ISN(2)-1,0D0,0D0,0D0,0D0,DBEL) ELSEIF(IDISXQ.EQ.1) THEN DO 490 I=I1,NS INCL=0 IORIG=I 480 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 IORIG=K(IORIG,3) IF(IORIG.GT.LPIN) GOTO 480 IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBEL) 490 CONTINUE ELSE CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBEL) ENDIF C...Final check that energy-momentum conservation worked. PESUM=0D0 PZSUM=0D0 DO 500 I=MINT(84)+1,N IF(K(I,1).GT.10) GOTO 500 PESUM=PESUM+P(I,4) PZSUM=PZSUM+P(I,3) 500 CONTINUE PDEV=ABS(PESUM-VINT(1))+ABS(PZSUM) IF(PDEV.GT.1D-4*VINT(1)) THEN MINT(51)=1 MINT(57)=MINT(57)+1 RETURN ENDIF C...Calculate rotation and boost from overall CM frame to C...hadronic CM frame in leptoproduction. MINT(91)=0 IF(MINT(82).EQ.1.AND.(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN MINT(91)=1 LESD=1 IF(MINT(42).EQ.1) LESD=2 LPIN=MINT(83)+3-LESD C...Sum upp momenta of everything not lepton or photon to define boost. DO 510 J=1,4 PSUM(J)=0D0 510 CONTINUE DO 530 I=1,N IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 530 IF(IABS(K(I,2)).GE.11.AND.IABS(K(I,2)).LE.20) GOTO 530 IF(K(I,2).EQ.22) GOTO 530 DO 520 J=1,4 PSUM(J)=PSUM(J)+P(I,J) 520 CONTINUE 530 CONTINUE VINT(223)=-PSUM(1)/PSUM(4) VINT(224)=-PSUM(2)/PSUM(4) VINT(225)=-PSUM(3)/PSUM(4) C...Boost incoming hadron to hadronic CM frame to determine rotations. K(N+1,1)=1 DO 540 J=1,5 P(N+1,J)=P(LPIN,J) V(N+1,J)=V(LPIN,J) 540 CONTINUE CALL PYROBO(N+1,N+1,0D0,0D0,VINT(223),VINT(224),VINT(225)) VINT(222)=-PYANGL(P(N+1,1),P(N+1,2)) CALL PYROBO(N+1,N+1,0D0,VINT(222),0D0,0D0,0D0) IF(LESD.EQ.2) THEN VINT(221)=-PYANGL(P(N+1,3),P(N+1,1)) ELSE VINT(221)=PYANGL(-P(N+1,3),P(N+1,1)) ENDIF ENDIF RETURN END C********************************************************************* C...PYDIFF C...Handles diffractive and elastic scattering. SUBROUTINE PYDIFF C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ C...Reset K, P and V vectors. Store incoming particles. DO 110 JT=1,MSTP(126)+10 I=MINT(83)+JT DO 100 J=1,5 K(I,J)=0 P(I,J)=0D0 V(I,J)=0D0 100 CONTINUE 110 CONTINUE N=MINT(84) MINT(3)=0 MINT(21)=0 MINT(22)=0 MINT(23)=0 MINT(24)=0 MINT(4)=4 DO 130 JT=1,2 I=MINT(83)+JT K(I,1)=21 K(I,2)=MINT(10+JT) DO 120 J=1,5 P(I,J)=VINT(285+5*JT+J) 120 CONTINUE 130 CONTINUE MINT(6)=2 C...Subprocess; kinematics. SQLAM=(VINT(2)-VINT(63)-VINT(64))**2-4D0*VINT(63)*VINT(64) PZ=SQRT(SQLAM)/(2D0*VINT(1)) DO 200 JT=1,2 I=MINT(83)+JT PE=(VINT(2)+VINT(62+JT)-VINT(65-JT))/(2D0*VINT(1)) KFH=MINT(102+JT) C...Elastically scattered particle. IF(MINT(16+JT).LE.0) THEN N=N+1 K(N,1)=1 K(N,2)=KFH K(N,3)=I+2 P(N,3)=PZ*(-1)**(JT+1) P(N,4)=PE P(N,5)=SQRT(VINT(62+JT)) C...Decay rho from elastic scattering of gamma with sin**2(theta) C...distribution of decay products (in rho rest frame). IF(KFH.EQ.113.AND.MINT(10+JT).EQ.22.AND.MSTP(102).EQ.1) THEN NSAV=N DBETAZ=P(N,3)/SQRT(P(N,3)**2+P(N,5)**2) P(N,3)=0D0 P(N,4)=P(N,5) CALL PYDECY(NSAV) IF(N.EQ.NSAV+2.AND.IABS(K(NSAV+1,2)).EQ.211) THEN PHI=PYANGL(P(NSAV+1,1),P(NSAV+1,2)) CALL PYROBO(NSAV+1,NSAV+2,0D0,-PHI,0D0,0D0,0D0) THE=PYANGL(P(NSAV+1,3),P(NSAV+1,1)) CALL PYROBO(NSAV+1,NSAV+2,-THE,0D0,0D0,0D0,0D0) 140 CTHE=2D0*PYR(0)-1D0 IF(1D0-CTHE**2.LT.PYR(0)) GOTO 140 CALL PYROBO(NSAV+1,NSAV+2,ACOS(CTHE),PHI,0D0,0D0,0D0) ENDIF CALL PYROBO(NSAV,NSAV+2,0D0,0D0,0D0,0D0,DBETAZ) ENDIF C...Diffracted particle: low-mass system to two particles. ELSEIF(VINT(62+JT).LT.(VINT(66+JT)+PARP(103))**2) THEN N=N+2 K(N-1,1)=1 K(N,1)=1 K(N-1,3)=I+2 K(N,3)=I+2 PMMAS=SQRT(VINT(62+JT)) NTRY=0 150 NTRY=NTRY+1 IF(NTRY.LT.20) THEN MINT(105)=MINT(102+JT) MINT(109)=MINT(106+JT) CALL PYSPLI(KFH,21,KFL1,KFL2) CALL PYKFDI(KFL1,0,KFL3,KF1) IF(KF1.EQ.0) GOTO 150 CALL PYKFDI(KFL2,-KFL3,KFLDUM,KF2) IF(KF2.EQ.0) GOTO 150 ELSE KF1=KFH KF2=111 ENDIF PM1=PYMASS(KF1) PM2=PYMASS(KF2) IF(PM1+PM2+PARJ(64).GT.PMMAS) GOTO 150 K(N-1,2)=KF1 K(N,2)=KF2 P(N-1,5)=PM1 P(N,5)=PM2 PZP=SQRT(MAX(0D0,(PMMAS**2-PM1**2-PM2**2)**2- & 4D0*PM1**2*PM2**2))/(2D0*PMMAS) P(N-1,3)=PZP P(N,3)=-PZP P(N-1,4)=SQRT(PM1**2+PZP**2) P(N,4)=SQRT(PM2**2+PZP**2) CALL PYROBO(N-1,N,ACOS(2D0*PYR(0)-1D0),PARU(2)*PYR(0), & 0D0,0D0,0D0) DBETAZ=PZ*(-1)**(JT+1)/SQRT(PZ**2+PMMAS**2) CALL PYROBO(N-1,N,0D0,0D0,0D0,0D0,DBETAZ) C...Diffracted particle: valence quark kicked out. ELSEIF(MSTP(101).EQ.1.OR.(MSTP(101).EQ.3.AND.PYR(0).LT. & PARP(101))) THEN N=N+2 K(N-1,1)=2 K(N,1)=1 K(N-1,3)=I+2 K(N,3)=I+2 MINT(105)=MINT(102+JT) MINT(109)=MINT(106+JT) CALL PYSPLI(KFH,21,K(N,2),K(N-1,2)) P(N-1,5)=PYMASS(K(N-1,2)) P(N,5)=PYMASS(K(N,2)) SQLAM=(VINT(62+JT)-P(N-1,5)**2-P(N,5)**2)**2- & 4D0*P(N-1,5)**2*P(N,5)**2 P(N-1,3)=(PE*SQRT(SQLAM)+PZ*(VINT(62+JT)+P(N-1,5)**2- & P(N,5)**2))/(2D0*VINT(62+JT))*(-1)**(JT+1) P(N-1,4)=SQRT(P(N-1,3)**2+P(N-1,5)**2) P(N,3)=PZ*(-1)**(JT+1)-P(N-1,3) P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) C...Diffracted particle: gluon kicked out. ELSE N=N+3 K(N-2,1)=2 K(N-1,1)=2 K(N,1)=1 K(N-2,3)=I+2 K(N-1,3)=I+2 K(N,3)=I+2 MINT(105)=MINT(102+JT) MINT(109)=MINT(106+JT) CALL PYSPLI(KFH,21,K(N,2),K(N-2,2)) K(N-1,2)=21 P(N-2,5)=PYMASS(K(N-2,2)) P(N-1,5)=0D0 P(N,5)=PYMASS(K(N,2)) C...Energy distribution for particle into two jets. 160 IMB=1 IF(MOD(KFH/1000,10).NE.0) IMB=2 CHIK=PARP(92+2*IMB) IF(MSTP(92).LE.1) THEN IF(IMB.EQ.1) CHI=PYR(0) IF(IMB.EQ.2) CHI=1D0-SQRT(PYR(0)) ELSEIF(MSTP(92).EQ.2) THEN CHI=1D0-PYR(0)**(1D0/(1D0+CHIK)) ELSEIF(MSTP(92).EQ.3) THEN CUT=2D0*0.3D0/VINT(1) 170 CHI=PYR(0)**2 IF((CHI**2/(CHI**2+CUT**2))**0.25D0*(1D0-CHI)**CHIK.LT. & PYR(0)) GOTO 170 ELSEIF(MSTP(92).EQ.4) THEN CUT=2D0*0.3D0/VINT(1) CUTR=(1D0+SQRT(1D0+CUT**2))/CUT 180 CHIR=CUT*CUTR**PYR(0) CHI=(CHIR**2-CUT**2)/(2D0*CHIR) IF((1D0-CHI)**CHIK.LT.PYR(0)) GOTO 180 ELSE CUT=2D0*0.3D0/VINT(1) CUTA=CUT**(1D0-PARP(98)) CUTB=(1D0+CUT)**(1D0-PARP(98)) 190 CHI=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) IF(((CHI+CUT)**2/(2D0*(CHI**2+CUT**2)))** & (0.5D0*PARP(98))*(1D0-CHI)**CHIK.LT.PYR(0)) GOTO 190 ENDIF IF(CHI.LT.P(N,5)**2/VINT(62+JT).OR.CHI.GT.1D0-P(N-2,5)**2/ & VINT(62+JT)) GOTO 160 SQM=P(N-2,5)**2/(1D0-CHI)+P(N,5)**2/CHI IF((SQRT(SQM)+PARJ(32))**2.GE.VINT(62+JT)) GOTO 160 PZI=(PE*(VINT(62+JT)-SQM)+PZ*(VINT(62+JT)+SQM))/ & (2D0*VINT(62+JT)) PEI=SQRT(PZI**2+SQM) PQQP=(1D0-CHI)*(PEI+PZI) P(N-2,3)=0.5D0*(PQQP-P(N-2,5)**2/PQQP)*(-1)**(JT+1) P(N-2,4)=SQRT(P(N-2,3)**2+P(N-2,5)**2) P(N-1,4)=0.5D0*(VINT(62+JT)-SQM)/(PEI+PZI) P(N-1,3)=P(N-1,4)*(-1)**JT P(N,3)=PZI*(-1)**(JT+1)-P(N-2,3) P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) ENDIF C...Documentation lines. K(I+2,1)=21 IF(MINT(16+JT).EQ.0) K(I+2,2)=KFH IF(MINT(16+JT).NE.0) K(I+2,2)=10*(KFH/10) K(I+2,3)=I P(I+2,3)=PZ*(-1)**(JT+1) P(I+2,4)=PE P(I+2,5)=SQRT(VINT(62+JT)) 200 CONTINUE C...Rotate outgoing partons/particles using cos(theta). IF(VINT(23).LT.0.9D0) THEN CALL PYROBO(MINT(83)+3,N,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) ELSE CALL PYROBO(MINT(83)+3,N,ASIN(VINT(59)),VINT(24),0D0,0D0,0D0) ENDIF RETURN END C********************************************************************* C...PYDOCU C...Handles the documentation of the process in MSTI and PARI, C...and also computes cross-sections based on accumulated statistics. SUBROUTINE PYDOCU C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYINT1/MINT(400),VINT(400) COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) SAVE /PYJETS/,/PYDAT1/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, &/PYINT5/ C...Calculate Monte Carlo estimates of cross-sections. ISUB=MINT(1) IF(MSTP(111).NE.-1) NGEN(ISUB,3)=NGEN(ISUB,3)+1 NGEN(0,3)=NGEN(0,3)+1 XSEC(0,3)=0D0 DO 100 I=1,500 IF(I.EQ.96.OR.I.EQ.97) THEN XSEC(I,3)=0D0 ELSEIF(MSUB(95).EQ.1.AND.(I.EQ.11.OR.I.EQ.12.OR.I.EQ.13.OR. & I.EQ.28.OR.I.EQ.53.OR.I.EQ.68)) THEN XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1D0,DBLE(NGEN(96,1))* & DBLE(NGEN(96,2))) ELSEIF(MSUB(I).EQ.0.OR.NGEN(I,1).EQ.0) THEN XSEC(I,3)=0D0 ELSEIF(NGEN(I,2).EQ.0) THEN XSEC(I,3)=XSEC(I,2)*NGEN(0,3)/(DBLE(NGEN(I,1))* & DBLE(NGEN(0,2))) ELSE XSEC(I,3)=XSEC(I,2)*NGEN(I,3)/(DBLE(NGEN(I,1))* & DBLE(NGEN(I,2))) ENDIF XSEC(0,3)=XSEC(0,3)+XSEC(I,3) 100 CONTINUE C...Rescale to known low-pT cross-section for standard QCD processes. IF(MSUB(95).EQ.1) THEN XSECH=XSEC(11,3)+XSEC(12,3)+XSEC(13,3)+XSEC(28,3)+XSEC(53,3)+ & XSEC(68,3)+XSEC(95,3) XSECW=XSEC(97,2)/MAX(1D0,DBLE(NGEN(97,1))) IF(XSECH.GT.1D-10.AND.XSECW.GT.1D-10) THEN FAC=XSECW/XSECH XSEC(11,3)=FAC*XSEC(11,3) XSEC(12,3)=FAC*XSEC(12,3) XSEC(13,3)=FAC*XSEC(13,3) XSEC(28,3)=FAC*XSEC(28,3) XSEC(53,3)=FAC*XSEC(53,3) XSEC(68,3)=FAC*XSEC(68,3) XSEC(95,3)=FAC*XSEC(95,3) XSEC(0,3)=XSEC(0,3)-XSECH+XSECW ENDIF ENDIF C...Save information for gamma-p and gamma-gamma. IF(MINT(121).GT.1) THEN IGA=MINT(122) CALL PYSAVE(2,IGA) CALL PYSAVE(5,0) ENDIF C...Reset information on hard interaction. DO 110 J=1,200 MSTI(J)=0 PARI(J)=0D0 110 CONTINUE C...Copy integer valued information from MINT into MSTI. DO 120 J=1,31 MSTI(J)=MINT(J) 120 CONTINUE IF(MINT(121).GT.1) MSTI(9)=MINT(122) C...Store cross-section variables in PARI. PARI(1)=XSEC(0,3) PARI(2)=XSEC(0,3)/MINT(5) PARI(9)=VINT(99) PARI(10)=VINT(100) VINT(98)=VINT(98)+VINT(100) IF(MSTP(142).EQ.1) PARI(2)=XSEC(0,3)/VINT(98) C...Store kinematics variables in PARI. PARI(11)=VINT(1) PARI(12)=VINT(2) IF(ISUB.NE.95) THEN DO 130 J=13,26 PARI(J)=VINT(30+J) 130 CONTINUE PARI(31)=VINT(141) PARI(32)=VINT(142) PARI(33)=VINT(41) PARI(34)=VINT(42) PARI(35)=PARI(33)-PARI(34) PARI(36)=VINT(21) PARI(37)=VINT(22) PARI(38)=VINT(26) PARI(39)=VINT(157) PARI(40)=VINT(158) PARI(41)=VINT(23) PARI(42)=2D0*VINT(47)/VINT(1) ENDIF C...Store information on scattered partons in PARI. IF(ISUB.NE.95.AND.MINT(7)*MINT(8).NE.0) THEN DO 140 IS=7,8 I=MINT(IS) PARI(36+IS)=P(I,3)/VINT(1) PARI(38+IS)=P(I,4)/VINT(1) PR=MAX(1D-20,P(I,5)**2+P(I,1)**2+P(I,2)**2) PARI(40+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ & SQRT(PR),1D20)),P(I,3)) PR=MAX(1D-20,P(I,1)**2+P(I,2)**2) PARI(42+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ & SQRT(PR),1D20)),P(I,3)) PARI(44+IS)=P(I,3)/SQRT(1D-20+P(I,1)**2+P(I,2)**2+P(I,3)**2) PARI(46+IS)=PYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) PARI(48+IS)=PYANGL(P(I,1),P(I,2)) 140 CONTINUE ENDIF C...Store sum up transverse and longitudinal momenta. PARI(65)=2D0*PARI(17) IF(ISUB.LE.90.OR.ISUB.GE.95) THEN DO 150 I=MSTP(126)+1,N IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 PT=SQRT(P(I,1)**2+P(I,2)**2) PARI(69)=PARI(69)+PT IF(I.LE.MINT(52)) PARI(66)=PARI(66)+PT IF(I.GT.MINT(52).AND.I.LE.MINT(53)) PARI(68)=PARI(68)+PT 150 CONTINUE PARI(67)=PARI(68) PARI(71)=VINT(151) PARI(72)=VINT(152) PARI(73)=VINT(151) PARI(74)=VINT(152) ELSE PARI(66)=PARI(65) PARI(69)=PARI(65) ENDIF C...Store various other pieces of information into PARI. PARI(61)=VINT(148) PARI(75)=VINT(155) PARI(76)=VINT(156) PARI(77)=VINT(159) PARI(78)=VINT(160) PARI(81)=VINT(138) C...Set information for PYTABU. IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN MSTU(161)=MINT(21) MSTU(162)=0 ELSEIF(ISET(ISUB).EQ.5) THEN MSTU(161)=MINT(23) MSTU(162)=0 ELSE MSTU(161)=MINT(21) MSTU(162)=MINT(22) ENDIF RETURN END C********************************************************************* C...PYFRAM C...Performs transformations between different coordinate frames. SUBROUTINE PYFRAM(IFRAME) C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) SAVE /PYDAT1/,/PYPARS/,/PYINT1/ C...Check that transformation can and should be done. IF(IFRAME.EQ.1.OR.IFRAME.EQ.2.OR.(IFRAME.EQ.3.AND. &MINT(91).EQ.1)) THEN IF(IFRAME.EQ.MINT(6)) RETURN ELSE WRITE(MSTU(11),5000) IFRAME,MINT(6) RETURN ENDIF IF(MINT(6).EQ.1) THEN C...Transform from fixed target or user specified frame to C...overall CM frame. CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) ELSEIF(MINT(6).EQ.3) THEN C...Transform from hadronic CM frame in DIS to overall CM frame. CALL PYROBO(0,0,-VINT(221),-VINT(222),-VINT(223),-VINT(224), & -VINT(225)) ENDIF IF(IFRAME.EQ.1) THEN C...Transform from overall CM frame to fixed target or user specified C...frame. CALL PYROBO(0,0,VINT(6),VINT(7),VINT(8),VINT(9),VINT(10)) ELSEIF(IFRAME.EQ.3) THEN C...Transform from overall CM frame to hadronic CM frame in DIS. CALL PYROBO(0,0,0D0,0D0,VINT(223),VINT(224),VINT(225)) CALL PYROBO(0,0,0D0,VINT(222),0D0,0D0,0D0) CALL PYROBO(0,0,VINT(221),0D0,0D0,0D0,0D0) ENDIF C...Set information about new frame. MINT(6)=IFRAME MSTI(6)=IFRAME 5000 FORMAT(1X,'Error: illegal values in subroutine PYFRAM.',1X, &'No transformation performed.'/1X,'IFRAME =',1X,I5,'; MINT(6) =', &1X,I5) RETURN END C********************************************************************* C...PYWIDT C...Calculates full and partial widths of resonances. SUBROUTINE PYWIDT(KFLR,SH,WDTP,WDTE) C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) 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(4000,2),BRAT(4000),KFDP(4000,5) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) COMMON/PYINT4/MWID(500),WIDS(500,5) SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, &/PYINT4/ C...Local arrays and saved variables. DIMENSION WDTP(0:100),WDTE(0:100,0:5),MOFSV(3,2),WIDWSV(3,2), &WID2SV(3,2) SAVE MOFSV,WIDWSV,WID2SV DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/ C...Compressed code and sign; mass. KFLA=IABS(KFLR) KFLS=ISIGN(1,KFLR) KC=PYCOMP(KFLA) SHR=SQRT(SH) C...Reset width information. DO 110 I=0,100 WDTP(I)=0D0 DO 100 J=0,5 WDTE(I,J)=0D0 100 CONTINUE 110 CONTINUE C...Not to be treated as a resonance: return. IF(MWID(KC).LE.0.OR.MWID(KC).GE.6) THEN WDTP(0)=1D0 WDTE(0,1)=1D0 MINT(61)=0 MINT(62)=0 RETURN C...Treatment as a resonance based on tabulated branching ratios. ELSEIF(MWID(KC).NE.1) THEN DO 115 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 115 C...Read out decay products and check that phase space open. KFD1=KFDP(IDC,1) KFC1=PYCOMP(KFD1) IF(KCHG(KFC1,3).EQ.1) KFD1=KFLS*KFD1 PM1=PMAS(KFC1,1) KFD2=KFDP(IDC,2) KFC2=PYCOMP(KFD2) IF(KCHG(KFC2,3).EQ.1) KFD2=KFLS*KFD2 PM2=PMAS(KFC2,1) IF(KFDP(IDC,3).NE.0) PM2=PM2+PMAS(PYCOMP(KFDP(IDC,3)),1) IF(PM1+PM2.GE.SHR) GOTO 115 C...Naive partial width, optionally energy running and beta factor. WDTP(I)=PMAS(KC,2)*BRAT(IDC) IF(MWID(KC).EQ.3.OR.MWID(KC).EQ.5) WDTP(I)=WDTP(I)* & SHR/PMAS(KC,1) IF(MWID(KC).EQ.4.OR.MWID(KC).EQ.5) WDTP(I)=WDTP(I)* & SQRT(MAX(0D0,(SH-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2))/SH WDTP(0)=WDTP(0)+WDTP(I) C...Calculate secondary width (only first two decay products). IF(MDME(IDC,1).GT.0) THEN IF(KFD1.EQ.KFD2) THEN IF(KCHG(KFC1,3).EQ.0) THEN WID2=WIDS(KFC1,1) ELSEIF(KFD1.GT.0) THEN WID2=WIDS(KFC1,4) ELSE WID2=WIDS(KFC1,5) ENDIF ELSE IF(KFD1.GT.0) THEN WID2=WIDS(KFC1,2) ELSE WID2=WIDS(KFC1,3) ENDIF IF(KFD2.GT.0) THEN WID2=WID2*WIDS(KFC2,2) ELSE WID2=WID2*WIDS(KFC2,3) ENDIF ENDIF C...Store effective widths according to case. WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 115 CONTINUE C...Return. MINT(61)=0 MINT(62)=0 RETURN ENDIF C...Here begins detailed dynamical calculation of resonance widths. C...Shared treatment of Higgs states. KFHIGG=25 IHIGG=1 IF(KFLA.EQ.35.OR.KFLA.EQ.36) THEN KFHIGG=KFLA IHIGG=KFLA-33 ENDIF C...Common electroweak and strong constants. XW=PARU(102) XWV=XW IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 XW1=1D0-XW AEM=PYALEM(SH) IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) AS=PYALPS(SH) RADC=1D0+AS/PARU(1) IF(KFLA.EQ.6) THEN C...t quark. FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR DO 120 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 120 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 120 IF(I.GE.4.AND.I.LE.7) THEN C...t -> W + q. WDTP(I)=FAC*VCKM(3,I-3)* & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) IF(KFLR.GT.0) THEN WID2=WIDS(24,2) IF(I.EQ.7) WID2=WID2*WIDS(7,2) ELSE WID2=WIDS(24,3) IF(I.EQ.7) WID2=WID2*WIDS(7,3) ENDIF ELSEIF(I.EQ.9) THEN C...t -> H + b. WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) WID2=WIDS(37,2) IF(KFLR.LT.0) WID2=WIDS(37,3) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 120 CONTINUE ELSEIF(KFLA.EQ.7) THEN C...b' quark. FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR DO 130 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 130 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 130 IF(I.GE.4.AND.I.LE.7) THEN C...b' -> W + q. WDTP(I)=FAC*VCKM(I-3,4)* & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) IF(KFLR.GT.0) THEN WID2=WIDS(24,3) IF(I.EQ.6) WID2=WID2*WIDS(6,2) IF(I.EQ.7) WID2=WID2*WIDS(8,2) ELSE WID2=WIDS(24,2) IF(I.EQ.6) WID2=WID2*WIDS(6,3) IF(I.EQ.7) WID2=WID2*WIDS(8,3) ENDIF WID2=WIDS(24,3) IF(KFLR.LT.0) WID2=WIDS(24,2) ELSEIF(I.EQ.9.OR.I.EQ.10) THEN C...b' -> H + q. WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) IF(KFLR.GT.0) THEN WID2=WIDS(37,3) IF(I.EQ.10) WID2=WID2*WIDS(6,2) ELSE WID2=WIDS(37,2) IF(I.EQ.10) WID2=WID2*WIDS(6,3) ENDIF ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 130 CONTINUE ELSEIF(KFLA.EQ.8) THEN C...t' quark. FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR DO 140 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 140 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140 IF(I.GE.4.AND.I.LE.7) THEN C...t' -> W + q. WDTP(I)=FAC*VCKM(4,I-3)* & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) IF(KFLR.GT.0) THEN WID2=WIDS(24,2) IF(I.EQ.7) WID2=WID2*WIDS(7,2) ELSE WID2=WIDS(24,3) IF(I.EQ.7) WID2=WID2*WIDS(7,3) ENDIF ELSEIF(I.EQ.9.OR.I.EQ.10) THEN C...t' -> H + q. WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) IF(KFLR.GT.0) THEN WID2=WIDS(37,2) IF(I.EQ.10) WID2=WID2*WIDS(7,2) ELSE WID2=WIDS(37,3) IF(I.EQ.10) WID2=WID2*WIDS(7,3) ENDIF ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 140 CONTINUE ELSEIF(KFLA.EQ.17) THEN C...tau' lepton. FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR DO 150 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 150 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 150 IF(I.EQ.3) THEN C...tau' -> W + nu'_tau. WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) IF(KFLR.GT.0) THEN WID2=WIDS(24,3) WID2=WID2*WIDS(18,2) ELSE WID2=WIDS(24,2) WID2=WID2*WIDS(18,3) ENDIF ELSEIF(I.EQ.5) THEN C...tau' -> H + nu'_tau. WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) IF(KFLR.GT.0) THEN WID2=WIDS(37,3) WID2=WID2*WIDS(18,2) ELSE WID2=WIDS(37,2) WID2=WID2*WIDS(18,3) ENDIF ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 150 CONTINUE ELSEIF(KFLA.EQ.18) THEN C...nu'_tau neutrino. FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR DO 160 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 160 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 160 IF(I.EQ.2) THEN C...nu'_tau -> W + tau'. WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) IF(KFLR.GT.0) THEN WID2=WIDS(24,2) WID2=WID2*WIDS(17,2) ELSE WID2=WIDS(24,3) WID2=WID2*WIDS(17,3) ENDIF ELSEIF(I.EQ.3) THEN C...nu'_tau -> H + tau'. WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) IF(KFLR.GT.0) THEN WID2=WIDS(37,2) WID2=WID2*WIDS(17,2) ELSE WID2=WIDS(37,3) WID2=WID2*WIDS(17,3) ENDIF ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 160 CONTINUE ELSEIF(KFLA.EQ.21) THEN C...QCD: C***Note that widths are not given in dimensional quantities here. DO 170 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 170 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 170 WID2=1D0 IF(I.LE.8) THEN C...QCD -> q + qbar WDTP(I)=(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) IF(I.EQ.6) WID2=WIDS(6,1) IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 170 CONTINUE ELSEIF(KFLA.EQ.22) THEN C...QED photon. C***Note that widths are not given in dimensional quantities here. DO 180 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 180 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 180 WID2=1D0 IF(I.LE.8) THEN C...QED -> q + qbar. EF=KCHG(I,1)/3D0 FCOF=3D0*RADC IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) WDTP(I)=FCOF*EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) IF(I.EQ.6) WID2=WIDS(6,1) IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) ELSEIF(I.LE.12) THEN C...QED -> l+ + l-. EF=KCHG(9+2*(I-8),1)/3D0 WDTP(I)=EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) IF(I.EQ.12) WID2=WIDS(17,1) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 180 CONTINUE ELSEIF(KFLA.EQ.23) THEN C...Z0: ICASE=1 XWC=1D0/(16D0*XW*XW1) FAC=(AEM*XWC/3D0)*SHR 190 CONTINUE IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN VINT(111)=0D0 VINT(112)=0D0 VINT(114)=0D0 ENDIF IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN EI=KCHG(IABS(MINT(15)),1)/3D0 AI=SIGN(1D0,EI) VI=AI-4D0*EI*XWV SQMZ=PMAS(23,1)**2 HZ=SHR*WDTP(0) IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=1D0 IF(MSTP(43).EQ.3) VINT(112)= & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= & XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) ENDIF DO 200 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 200 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 200 WID2=1D0 IF(I.LE.8) THEN C...Z0 -> q + qbar EF=KCHG(I,1)/3D0 AF=SIGN(1D0,EF+0.1D0) VF=AF-4D0*EF*XWV FCOF=3D0*RADC IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) IF(I.EQ.6) WID2=WIDS(6,1) IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) ELSEIF(I.LE.16) THEN C...Z0 -> l+ + l-, nu + nubar EF=KCHG(I+2,1)/3D0 AF=SIGN(1D0,EF+0.1D0) VF=AF-4D0*EF*XWV FCOF=1D0 IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) ENDIF BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) IF(ICASE.EQ.1) THEN WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* & BE34 ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* & EF*VF+(VI**2+AI**2)*VINT(114)*VF**2)*(1D0+2D0*RM1)+ & (VI**2+AI**2)*VINT(114)*AF**2*(1D0-4D0*RM1))*BE34 ELSEIF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 ENDIF IF(ICASE.EQ.1) WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ & WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)= & VINT(111)+FGGF*WID2 IF(MSTP(43).EQ.3) VINT(112)=VINT(112)+FGZF*WID2 IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= & VINT(114)+FZZF*WID2 ENDIF ENDIF 200 CONTINUE IF(MINT(61).GE.1) ICASE=3-ICASE IF(ICASE.EQ.2) GOTO 190 ELSEIF(KFLA.EQ.24) THEN C...W+/-: FAC=(AEM/(24D0*XW))*SHR DO 210 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 210 RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 210 WID2=1D0 IF(I.LE.16) THEN C...W+/- -> q + qbar' FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1) IF(KFLR.GT.0) THEN IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) IF(I.GE.13) WID2=WID2*WIDS(7,3) ELSE IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) IF(I.GE.13) WID2=WID2*WIDS(7,2) ENDIF ELSEIF(I.LE.20) THEN C...W+/- -> l+/- + nu FCOF=1D0 IF(KFLR.GT.0) THEN IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) ELSE IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) ENDIF ENDIF WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 210 CONTINUE ELSEIF(KFLA.EQ.25.OR.KFLA.EQ.35.OR.KFLA.EQ.36) THEN C...h0 (or H0, or A0): FAC=(AEM/(8D0*XW))*(SH/PMAS(24,1)**2)*SHR DO 250 I=1,MDCY(KFHIGG,3) IDC=I+MDCY(KFHIGG,2)-1 IF(MDME(IDC,1).LT.0) GOTO 250 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(I.NE.16.AND.I.NE.17.AND.SQRT(RM1)+SQRT(RM2).GT.1D0) & GOTO 250 WID2=1D0 IF(I.LE.8) THEN C...h0 -> q + qbar WDTP(I)=FAC*3D0*RM1*(1D0-4D0*RM1)*SQRT(MAX(0D0, & 1D0-4D0*RM1))*RADC IF(MSTP(37).EQ.1.AND.MSTP(2).GE.1) WDTP(I)=WDTP(I)* & (LOG(MAX(4D0,PARP(37)**2*RM1*SH/PARU(117)**2))/ & LOG(MAX(4D0,SH/PARU(117)**2)))**(24D0/(33D0-2D0*MSTU(118))) IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN IF(MOD(I,2).EQ.1) WDTP(I)=WDTP(I)*PARU(151+10*IHIGG)**2 IF(MOD(I,2).EQ.0) WDTP(I)=WDTP(I)*PARU(152+10*IHIGG)**2 ENDIF IF(I.EQ.6) WID2=WIDS(6,1) IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) ELSEIF(I.LE.12) THEN C...h0 -> l+ + l- WDTP(I)=FAC*RM1*(1D0-4D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* & PARU(153+10*IHIGG)**2 IF(I.EQ.12) WID2=WIDS(17,1) ELSEIF(I.EQ.13) THEN C...h0 -> g + g; quark loop contribution only ETARE=0D0 ETAIM=0D0 DO 220 J=1,2*MSTP(1) EPS=(2D0*PMAS(J,1))**2/SH C...Loop integral; function of eps=4m^2/shat; different for A0. IF(EPS.LE.1D0) THEN IF(EPS.GT.1.D-4) THEN ROOT=SQRT(1D0-EPS) RLN=LOG((1D0+ROOT)/(1D0-ROOT)) ELSE RLN=LOG(4D0/EPS-2D0) ENDIF PHIRE=-0.25D0*(RLN**2-PARU(1)**2) PHIIM=0.5D0*PARU(1)*RLN ELSE PHIRE=(ASIN(1D0/SQRT(EPS)))**2 PHIIM=0D0 ENDIF IF(IHIGG.LE.2) THEN ETAREJ=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) ETAIMJ=-0.5D0*EPS*(1D0-EPS)*PHIIM ELSE ETAREJ=-0.5D0*EPS*PHIRE ETAIMJ=-0.5D0*EPS*PHIIM ENDIF C...Couplings (=1 for standard model Higgs). IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN IF(MOD(J,2).EQ.1) THEN ETAREJ=ETAREJ*PARU(151+10*IHIGG) ETAIMJ=ETAIMJ*PARU(151+10*IHIGG) ELSE ETAREJ=ETAREJ*PARU(152+10*IHIGG) ETAIMJ=ETAIMJ*PARU(152+10*IHIGG) ENDIF ENDIF ETARE=ETARE+ETAREJ ETAIM=ETAIM+ETAIMJ 220 CONTINUE ETA2=ETARE**2+ETAIM**2 WDTP(I)=FAC*(AS/PARU(1))**2*ETA2 ELSEIF(I.EQ.14) THEN C...h0 -> gamma + gamma; quark, lepton, W+- and H+- loop contributions ETARE=0D0 ETAIM=0D0 JMAX=3*MSTP(1)+1 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 DO 230 J=1,JMAX IF(J.LE.2*MSTP(1)) THEN EJ=KCHG(J,1)/3D0 EPS=(2D0*PMAS(J,1))**2/SH ELSEIF(J.LE.3*MSTP(1)) THEN JL=2*(J-2*MSTP(1))-1 EJ=KCHG(10+JL,1)/3D0 EPS=(2D0*PMAS(10+JL,1))**2/SH ELSEIF(J.EQ.3*MSTP(1)+1) THEN EPS=(2D0*PMAS(24,1))**2/SH ELSE EPS=(2D0*PMAS(37,1))**2/SH ENDIF C...Loop integral; function of eps=4m^2/shat. IF(EPS.LE.1D0) THEN IF(EPS.GT.1.D-4) THEN ROOT=SQRT(1D0-EPS) RLN=LOG((1D0+ROOT)/(1D0-ROOT)) ELSE RLN=LOG(4D0/EPS-2D0) ENDIF PHIRE=-0.25D0*(RLN**2-PARU(1)**2) PHIIM=0.5D0*PARU(1)*RLN ELSE PHIRE=(ASIN(1D0/SQRT(EPS)))**2 PHIIM=0D0 ENDIF IF(J.LE.3*MSTP(1)) THEN C...Fermion loops: loop integral different for A0; charges. IF(IHIGG.LE.2) THEN PHIPRE=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) PHIPIM=-0.5D0*EPS*(1D0-EPS)*PHIIM ELSE PHIPRE=-0.5D0*EPS*PHIRE PHIPIM=-0.5D0*EPS*PHIIM ENDIF IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN EJC=3D0*EJ**2 EJH=PARU(151+10*IHIGG) ELSEIF(J.LE.2*MSTP(1)) THEN EJC=3D0*EJ**2 EJH=PARU(152+10*IHIGG) ELSE EJC=EJ**2 EJH=PARU(153+10*IHIGG) ENDIF IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 ETAREJ=EJC*EJH*PHIPRE ETAIMJ=EJC*EJH*PHIPIM ELSEIF(J.EQ.3*MSTP(1)+1) THEN C...W loops: loop integral and charges. ETAREJ=0.5D0+0.75D0*EPS*(1D0+(2D0-EPS)*PHIRE) ETAIMJ=0.75D0*EPS*(2D0-EPS)*PHIIM IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN ETAREJ=ETAREJ*PARU(155+10*IHIGG) ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) ENDIF ELSE C...Charged H loops: loop integral and charges. FACHHH=(PMAS(24,1)/PMAS(37,1))**2* & PARU(158+10*IHIGG+2*(IHIGG/3)) ETAREJ=EPS*(1D0-EPS*PHIRE)*FACHHH ETAIMJ=-EPS**2*PHIIM*FACHHH ENDIF ETARE=ETARE+ETAREJ ETAIM=ETAIM+ETAIMJ 230 CONTINUE ETA2=ETARE**2+ETAIM**2 WDTP(I)=FAC*(AEM/PARU(1))**2*0.5D0*ETA2 ELSEIF(I.EQ.15) THEN C...h0 -> gamma + Z0; quark, lepton, W and H+- loop contributions ETARE=0D0 ETAIM=0D0 JMAX=3*MSTP(1)+1 IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 DO 240 J=1,JMAX IF(J.LE.2*MSTP(1)) THEN EJ=KCHG(J,1)/3D0 AJ=SIGN(1D0,EJ+0.1D0) VJ=AJ-4D0*EJ*XWV EPS=(2D0*PMAS(J,1))**2/SH EPSP=(2D0*PMAS(J,1)/PMAS(23,1))**2 ELSEIF(J.LE.3*MSTP(1)) THEN JL=2*(J-2*MSTP(1))-1 EJ=KCHG(10+JL,1)/3D0 AJ=SIGN(1D0,EJ+0.1D0) VJ=AJ-4D0*EJ*XWV EPS=(2D0*PMAS(10+JL,1))**2/SH EPSP=(2D0*PMAS(10+JL,1)/PMAS(23,1))**2 ELSE EPS=(2D0*PMAS(24,1))**2/SH EPSP=(2D0*PMAS(24,1)/PMAS(23,1))**2 ENDIF C...Loop integrals; functions of eps=4m^2/shat and eps'=4m^2/m_Z^2. IF(EPS.LE.1D0) THEN ROOT=SQRT(1D0-EPS) IF(EPS.GT.1.D-4) THEN RLN=LOG((1D0+ROOT)/(1D0-ROOT)) ELSE RLN=LOG(4D0/EPS-2D0) ENDIF PHIRE=-0.25D0*(RLN**2-PARU(1)**2) PHIIM=0.5D0*PARU(1)*RLN PSIRE=0.5D0*ROOT*RLN PSIIM=-0.5D0*ROOT*PARU(1) ELSE PHIRE=(ASIN(1D0/SQRT(EPS)))**2 PHIIM=0D0 PSIRE=SQRT(EPS-1D0)*ASIN(1D0/SQRT(EPS)) PSIIM=0D0 ENDIF IF(EPSP.LE.1D0) THEN ROOT=SQRT(1D0-EPSP) IF(EPSP.GT.1.D-4) THEN RLN=LOG((1D0+ROOT)/(1D0-ROOT)) ELSE RLN=LOG(4D0/EPSP-2D0) ENDIF PHIREP=-0.25D0*(RLN**2-PARU(1)**2) PHIIMP=0.5D0*PARU(1)*RLN PSIREP=0.5D0*ROOT*RLN PSIIMP=-0.5D0*ROOT*PARU(1) ELSE PHIREP=(ASIN(1D0/SQRT(EPSP)))**2 PHIIMP=0D0 PSIREP=SQRT(EPSP-1D0)*ASIN(1D0/SQRT(EPSP)) PSIIMP=0D0 ENDIF FXYRE=EPS*EPSP/(8D0*(EPS-EPSP))*(1D0+EPS*EPSP/(EPS-EPSP)* & (PHIRE-PHIREP)+2D0*EPS/(EPS-EPSP)*(PSIRE-PSIREP)) FXYIM=EPS**2*EPSP/(8D0*(EPS-EPSP)**2)* & (EPSP*(PHIIM-PHIIMP)+2D0*(PSIIM-PSIIMP)) F1RE=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIRE-PHIREP) F1IM=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIIM-PHIIMP) IF(J.LE.3*MSTP(1)) THEN C...Fermion loops: loop integral different for A0; charges. IF(IHIGG.EQ.3) FXYRE=0D0 IF(IHIGG.EQ.3) FXYIM=0D0 IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN EJC=-3D0*EJ*VJ EJH=PARU(151+10*IHIGG) ELSEIF(J.LE.2*MSTP(1)) THEN EJC=-3D0*EJ*VJ EJH=PARU(152+10*IHIGG) ELSE EJC=-EJ*VJ EJH=PARU(153+10*IHIGG) ENDIF IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 ETAREJ=EJC*EJH*(FXYRE-0.25D0*F1RE) ETAIMJ=EJC*EJH*(FXYIM-0.25D0*F1IM) ELSEIF(J.EQ.3*MSTP(1)+1) THEN C...W loops: loop integral and charges. HEPS=(1D0+2D0/EPS)*XW/XW1-(5D0+2D0/EPS) ETAREJ=-XW1*((3D0-XW/XW1)*F1RE+HEPS*FXYRE) ETAIMJ=-XW1*((3D0-XW/XW1)*F1IM+HEPS*FXYIM) IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN ETAREJ=ETAREJ*PARU(155+10*IHIGG) ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) ENDIF ELSE C...Charged H loops: loop integral and charges. FACHHH=(PMAS(24,1)/PMAS(37,1))**2*(1D0-2D0*XW)* & PARU(158+10*IHIGG+2*(IHIGG/3)) ETAREJ=FACHHH*FXYRE ETAIMJ=FACHHH*FXYIM ENDIF ETARE=ETARE+ETAREJ ETAIM=ETAIM+ETAIMJ 240 CONTINUE ETA2=(ETARE**2+ETAIM**2)/(XW*XW1) WDTP(I)=FAC*(AEM/PARU(1))**2*(1D0-PMAS(23,1)**2/SH)**3*ETA2 WID2=WIDS(23,2) ELSEIF(I.LE.17) THEN C...h0 -> Z0 + Z0, W+ + W- PM1=PMAS(IABS(KFDP(IDC,1)),1) PG1=PMAS(IABS(KFDP(IDC,1)),2) IF(MINT(62).GE.1) THEN IF(MSTP(42).EQ.0.OR.(4D0*(PM1+10D0*PG1)**2.LT.SH.AND. & CKIN(46).LT.CKIN(45).AND.CKIN(48).LT.CKIN(47).AND. & MAX(CKIN(45),CKIN(47)).LT.PM1-10D0*PG1)) THEN MOFSV(IHIGG,I-15)=0 WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, & 1D0-4D0*RM1)) WID2=1D0 ELSE MOFSV(IHIGG,I-15)=1 RMAS=SQRT(MAX(0D0,SH)) CALL PYOFSH(1,KFLA,KFDP(IDC,1),KFDP(IDC,2),RMAS,WIDW, & WID2) WIDWSV(IHIGG,I-15)=WIDW WID2SV(IHIGG,I-15)=WID2 ENDIF ELSE IF(MOFSV(IHIGG,I-15).EQ.0) THEN WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, & 1D0-4D0*RM1)) WID2=1D0 ELSE WIDW=WIDWSV(IHIGG,I-15) WID2=WID2SV(IHIGG,I-15) ENDIF ENDIF WDTP(I)=FAC*WIDW/(2D0*(18-I)) IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* & PARU(138+I+10*IHIGG)**2 WID2=WID2*WIDS(7+I,1) ELSEIF(I.EQ.18.AND.KFLA.EQ.35) THEN C***H0 -> Z0 + h0 (not yet implemented). ELSEIF(I.EQ.19.AND.KFLA.EQ.35) THEN C...H0 -> h0 + h0. WDTP(I)=FAC*PARU(176)**2*0.25D0*PMAS(23,1)**4/SH**2* & SQRT(MAX(0D0,1D0-4D0*RM1)) WID2=WIDS(25,2)**2 ELSEIF(I.EQ.20.AND.KFLA.EQ.35) THEN C...H0 -> A0 + A0. WDTP(I)=FAC*PARU(177)**2*0.25D0*PMAS(23,1)**4/SH**2* & SQRT(MAX(0D0,1D0-4D0*RM1)) WID2=WIDS(36,2)**2 ELSEIF(I.EQ.18.AND.KFLA.EQ.36) THEN C...A0 -> Z0 + h0. WDTP(I)=FAC*PARU(186)**2*0.5D0*SQRT(MAX(0D0, & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 WID2=WIDS(23,2)*WIDS(25,2) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 250 CONTINUE ELSEIF(KFLA.EQ.32) THEN C...Z'0: ICASE=1 XWC=1D0/(16D0*XW*XW1) FAC=(AEM*XWC/3D0)*SHR VINT(117)=0D0 260 CONTINUE IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN VINT(111)=0D0 VINT(112)=0D0 VINT(113)=0D0 VINT(114)=0D0 VINT(115)=0D0 VINT(116)=0D0 ENDIF IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN KFAI=IABS(MINT(15)) EI=KCHG(KFAI,1)/3D0 AI=SIGN(1D0,EI+0.1D0) VI=AI-4D0*EI*XWV KFAIC=1 IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2 IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3 IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4 VPI=PARU(119+2*KFAIC) API=PARU(120+2*KFAIC) SQMZ=PMAS(23,1)**2 HZ=SHR*FAC*VINT(117) SQMZP=PMAS(32,1)**2 HZP=SHR*FAC*WDTP(0) IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. & MSTP(44).EQ.7) VINT(111)=1D0 IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)= & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)= & 2D0*XWC*SH*(SH-SQMZP)/((SH-SQMZP)**2+HZP**2) IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. & MSTP(44).EQ.7) VINT(114)=XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)= & 2D0*XWC**2*SH**2*((SH-SQMZ)*(SH-SQMZP)+HZ*HZP)/ & (((SH-SQMZ)**2+HZ**2)*((SH-SQMZP)**2+HZP**2)) IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. & MSTP(44).EQ.7) VINT(116)=XWC**2*SH**2/((SH-SQMZP)**2+HZP**2) ENDIF DO 270 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 270 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0.OR.MDME(IDC,1).LT.0) GOTO 270 WID2=1D0 IF(I.LE.16) THEN IF(I.LE.8) THEN C...Z'0 -> q + qbar EF=KCHG(I,1)/3D0 AF=SIGN(1D0,EF+0.1D0) VF=AF-4D0*EF*XWV VPF=PARU(123-2*MOD(I,2)) APF=PARU(124-2*MOD(I,2)) FCOF=3D0*RADC IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF* & PYHFTH(SH,SH*RM1,1D0) IF(I.EQ.6) WID2=WIDS(6,1) IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) ELSEIF(I.LE.16) THEN C...Z'0 -> l+ + l-, nu + nubar EF=KCHG(I+2,1)/3D0 AF=SIGN(1D0,EF+0.1D0) VF=AF-4D0*EF*XWV VPF=PARU(127-2*MOD(I,2)) APF=PARU(128-2*MOD(I,2)) FCOF=1D0 IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) ENDIF BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) IF(ICASE.EQ.1) THEN WDTPZ=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 WDTP(I)=FAC*FCOF*(VPF**2*(1D0+2D0*RM1)+ & APF**2*(1D0-4D0*RM1))*BE34 ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* & EF*VF+EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* & VF**2+(VI*VPI+AI*API)*VINT(115)*VF*VPF+(VPI**2+API**2)* & VINT(116)*VPF**2)*(1D0+2D0*RM1)+((VI**2+AI**2)*VINT(114)* & AF**2+(VI*VPI+AI*API)*VINT(115)*AF*APF+(VPI**2+API**2)* & VINT(116)*APF**2)*(1D0-4D0*RM1))*BE34 ELSEIF(MINT(61).EQ.2) THEN FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 FGZPF=FCOF*EF*VPF*(1D0+2D0*RM1)*BE34 FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 FZZPF=FCOF*(VF*VPF*(1D0+2D0*RM1)+AF*APF*(1D0-4D0*RM1))* & BE34 FZPZPF=FCOF*(VPF**2*(1D0+2D0*RM1)+APF**2*(1D0-4D0*RM1))* & BE34 ENDIF ELSEIF(I.EQ.17) THEN C...Z'0 -> W+ + W- WDTPZP=PARU(129)**2*XW1**2* & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) IF(ICASE.EQ.1) THEN WDTPZ=0D0 WDTP(I)=FAC*WDTPZP ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP ELSEIF(MINT(61).EQ.2) THEN FGGF=0D0 FGZF=0D0 FGZPF=0D0 FZZF=0D0 FZZPF=0D0 FZPZPF=WDTPZP ENDIF WID2=WIDS(24,1) ELSEIF(I.EQ.18) THEN C...Z'0 -> H+ + H- CZC=2D0*(1D0-2D0*XW) BE34C=(1D0-4D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) IF(ICASE.EQ.1) THEN WDTPZ=0.25D0*PARU(142)**2*CZC**2*BE34C WDTP(I)=FAC*0.25D0*PARU(143)**2*CZC**2*BE34C ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN WDTP(I)=FAC*0.25D0*(EI**2*VINT(111)+PARU(142)*EI*VI* & VINT(112)*CZC+PARU(143)*EI*VPI*VINT(113)*CZC+PARU(142)**2* & (VI**2+AI**2)*VINT(114)*CZC**2+PARU(142)*PARU(143)* & (VI*VPI+AI*API)*VINT(115)*CZC**2+PARU(143)**2* & (VPI**2+API**2)*VINT(116)*CZC**2)*BE34C ELSEIF(MINT(61).EQ.2) THEN FGGF=0.25D0*BE34C FGZF=0.25D0*PARU(142)*CZC*BE34C FGZPF=0.25D0*PARU(143)*CZC*BE34C FZZF=0.25D0*PARU(142)**2*CZC**2*BE34C FZZPF=0.25D0*PARU(142)*PARU(143)*CZC**2*BE34C FZPZPF=0.25D0*PARU(143)**2*CZC**2*BE34C ENDIF WID2=WIDS(37,1) ELSEIF(I.EQ.19) THEN C...Z'0 -> Z0 + gamma. ELSEIF(I.EQ.20) THEN C...Z'0 -> Z0 + h0 FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) WDTPZP=PARU(145)**2*4D0*ABS(1D0-2D0*XW)* & (3D0*RM1+0.25D0*FLAM**2)*FLAM IF(ICASE.EQ.1) THEN WDTPZ=0D0 WDTP(I)=FAC*WDTPZP ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP ELSEIF(MINT(61).EQ.2) THEN FGGF=0D0 FGZF=0D0 FGZPF=0D0 FZZF=0D0 FZZPF=0D0 FZPZPF=WDTPZP ENDIF WID2=WIDS(23,2)*WIDS(25,2) ELSEIF(I.EQ.21.OR.I.EQ.22) THEN C...Z' -> h0 + A0 or H0 + A0. BE34C=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 IF(I.EQ.21) THEN CZAH=PARU(186) CZPAH=PARU(188) ELSE CZAH=PARU(187) CZPAH=PARU(189) ENDIF IF(ICASE.EQ.1) THEN WDTPZ=CZAH**2*BE34C WDTP(I)=FAC*CZPAH**2*BE34C ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN WDTP(I)=FAC*(CZAH**2*(VI**2+AI**2)*VINT(114)+CZAH*CZPAH* & (VI*VPI+AI*API)*VINT(115)+CZPAH**2*(VPI**2+API**2)* & VINT(116))*BE34C ELSEIF(MINT(61).EQ.2) THEN FGGF=0D0 FGZF=0D0 FGZPF=0D0 FZZF=CZAH**2*BE34C FZZPF=CZAH*CZPAH*BE34C FZPZPF=CZPAH**2*BE34C ENDIF IF(I.EQ.21) WID2=WIDS(25,2)*WIDS(36,2) IF(I.EQ.22) WID2=WIDS(35,2)*WIDS(36,2) ENDIF IF(ICASE.EQ.1) THEN VINT(117)=VINT(117)+WDTPZ WDTP(0)=WDTP(0)+WDTP(I) ENDIF IF(MDME(IDC,1).GT.0) THEN IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ & WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. & MSTP(44).EQ.7) VINT(111)=VINT(111)+FGGF*WID2 IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)=VINT(112)+ & FGZF*WID2 IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)=VINT(113)+ & FGZPF*WID2 IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. & MSTP(44).EQ.7) VINT(114)=VINT(114)+FZZF*WID2 IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)=VINT(115)+ & FZZPF*WID2 IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. & MSTP(44).EQ.7) VINT(116)=VINT(116)+FZPZPF*WID2 ENDIF ENDIF 270 CONTINUE IF(MINT(61).GE.1) ICASE=3-ICASE IF(ICASE.EQ.2) GOTO 260 ELSEIF(KFLA.EQ.34) THEN C...W'+/-: FAC=(AEM/(24D0*XW))*SHR DO 280 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 280 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 280 WID2=1D0 IF(I.LE.20) THEN IF(I.LE.16) THEN C...W'+/- -> q + qbar' FCOF=3D0*RADC*(PARU(131)**2+PARU(132)**2)* & VCKM((I-1)/4+1,MOD(I-1,4)+1) IF(KFLR.GT.0) THEN IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) IF(I.GE.13) WID2=WID2*WIDS(7,3) ELSE IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) IF(I.GE.13) WID2=WID2*WIDS(7,2) ENDIF ELSEIF(I.LE.20) THEN C...W'+/- -> l+/- + nu FCOF=PARU(133)**2+PARU(134)**2 IF(KFLR.GT.0) THEN IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) ELSE IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) ENDIF ENDIF WDTP(I)=FAC*FCOF*0.5D0*(2D0-RM1-RM2-(RM1-RM2)**2)* & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) ELSEIF(I.EQ.21) THEN C...W'+/- -> W+/- + Z0 WDTP(I)=FAC*PARU(135)**2*0.5D0*XW1*(RM1/RM2)* & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(23,2) IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(23,2) ELSEIF(I.EQ.23) THEN C...W'+/- -> W+/- + h0 FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) WDTP(I)=FAC*PARU(146)**2*2D0*(3D0*RM1+0.25D0*FLAM**2)*FLAM IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 280 CONTINUE ELSEIF(KFLA.EQ.37) THEN C...H+/-: FAC=(AEM/(8D0*XW))*(SH/PMAS(24,1)**2)*SHR DO 290 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 290 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 290 WID2=1D0 IF(I.LE.4) THEN C...H+/- -> q + qbar' RM1R=RM1 IF(MSTP(37).EQ.1.AND.MSTP(2).GE.1) RM1R=RM1* & (LOG(MAX(4D0,PARP(37)**2*RM1*SH/PARU(117)**2))/ & LOG(MAX(4D0,SH/PARU(117)**2)))**(24D0/(33D0-2D0*MSTU(118))) WDTP(I)=FAC*3D0*RADC*((RM1R*PARU(141)**2+RM2/PARU(141)**2)* & (1D0-RM1R-RM2)-4D0*RM1R*RM2)* & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) IF(KFLR.GT.0) THEN IF(I.EQ.3) WID2=WIDS(6,2) IF(I.EQ.4) WID2=WIDS(7,3)*WIDS(8,2) ELSE IF(I.EQ.3) WID2=WIDS(6,3) IF(I.EQ.4) WID2=WIDS(7,2)*WIDS(8,3) ENDIF ELSEIF(I.LE.8) THEN C...H+/- -> l+/- + nu WDTP(I)=FAC*((RM1*PARU(141)**2+RM2/PARU(141)**2)* & (1D0-RM1-RM2)-4D0*RM1*RM2)*SQRT(MAX(0D0,(1D0-RM1-RM2)**2- & 4D0*RM1*RM2)) IF(KFLR.GT.0) THEN IF(I.EQ.8) WID2=WIDS(17,3)*WIDS(18,2) ELSE IF(I.EQ.8) WID2=WIDS(17,2)*WIDS(18,3) ENDIF ELSEIF(I.EQ.9) THEN C...H+/- -> W+/- + h0. WDTP(I)=FAC*PARU(195)**2*0.5D0*SQRT(MAX(0D0, & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 290 CONTINUE ELSEIF(KFLA.EQ.38) THEN C...Techni-eta. FAC=(SH/PARP(46)**2)*SHR DO 300 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 300 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 300 WID2=1D0 IF(I.LE.2) THEN WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))/(4D0*PARU(1)) IF(I.EQ.2) WID2=WIDS(6,1) ELSE WDTP(I)=FAC*5D0*AS**2/(96D0*PARU(1)**3) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 300 CONTINUE ELSEIF(KFLA.EQ.39) THEN C...LQ (leptoquark). FAC=(AEM/4D0)*PARU(151)*SHR DO 310 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 310 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 310 WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 WID2=1D0 WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 310 CONTINUE ELSEIF(KFLA.EQ.40) THEN C...R: FAC=(AEM/(12D0*XW))*SHR DO 320 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 320 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 320 WID2=1D0 IF(I.LE.6) THEN C...R -> q + qbar' FCOF=3D0*RADC ELSEIF(I.LE.9) THEN C...R -> l+ + l'- FCOF=1D0 ENDIF WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) IF(KFLR.GT.0) THEN IF(I.EQ.4) WID2=WIDS(6,3) IF(I.EQ.5) WID2=WIDS(7,3) IF(I.EQ.6) WID2=WIDS(6,2)*WIDS(8,3) IF(I.EQ.9) WID2=WIDS(17,3) ELSE IF(I.EQ.4) WID2=WIDS(6,2) IF(I.EQ.5) WID2=WIDS(7,2) IF(I.EQ.6) WID2=WIDS(6,3)*WIDS(8,2) IF(I.EQ.9) WID2=WIDS(17,2) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 320 CONTINUE ELSEIF(KFLA.EQ.4000001) THEN C...d* excited quark. FAC=(SH/PARU(155)**2)*SHR DO 330 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 330 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 330 IF(I.EQ.1) THEN C...d* -> g + d. WDTP(I)=FAC*AS*PARU(159)**2/3D0 WID2=1D0 ELSEIF(I.EQ.2) THEN C...d* -> gamma + d. QF=-PARU(157)/2D0+PARU(158)/6D0 WDTP(I)=FAC*AEM*QF**2/4D0 WID2=1D0 ELSEIF(I.EQ.3) THEN C...d* -> Z0 + d. QF=-PARU(157)*XW1/2D0-PARU(158)*XW/6D0 WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* & (1D0-RM1)**2*(2D0+RM1) WID2=WIDS(23,2) ELSEIF(I.EQ.4) THEN C...d* -> W- + u. WDTP(I)=FAC*AEM*PARU(157)**2/(16D0*XW)* & (1D0-RM1)**2*(2D0+RM1) IF(KFLR.GT.0) WID2=WIDS(24,3) IF(KFLR.LT.0) WID2=WIDS(24,2) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 330 CONTINUE ELSEIF(KFLA.EQ.4000002) THEN C...u* excited quark. FAC=(SH/PARU(155)**2)*SHR DO 340 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 340 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 340 IF(I.EQ.1) THEN C...u* -> g + u. WDTP(I)=FAC*AS*PARU(159)**2/3D0 WID2=1D0 ELSEIF(I.EQ.2) THEN C...u* -> gamma + u. QF=PARU(157)/2D0+PARU(158)/6D0 WDTP(I)=FAC*AEM*QF**2/4D0 WID2=1D0 ELSEIF(I.EQ.3) THEN C...u* -> Z0 + u. QF=PARU(157)*XW1/2D0-PARU(158)*XW/6D0 WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* & (1D0-RM1)**2*(2D0+RM1) WID2=WIDS(23,2) ELSEIF(I.EQ.4) THEN C...u* -> W+ + d. WDTP(I)=FAC*AEM*PARU(157)**2/(16D0*XW)* & (1D0-RM1)**2*(2D0+RM1) IF(KFLR.GT.0) WID2=WIDS(24,2) IF(KFLR.LT.0) WID2=WIDS(24,3) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 340 CONTINUE ELSEIF(KFLA.EQ.4000011) THEN C...e* excited lepton. FAC=(SH/PARU(155)**2)*SHR DO 350 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 350 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 350 IF(I.EQ.1) THEN C...e* -> gamma + e. QF=-PARU(157)/2D0-PARU(158)/2D0 WDTP(I)=FAC*AEM*QF**2/4D0 WID2=1D0 ELSEIF(I.EQ.2) THEN C...e* -> Z0 + e. QF=-PARU(157)*XW1/2D0+PARU(158)*XW/2D0 WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* & (1D0-RM1)**2*(2D0+RM1) WID2=WIDS(23,2) ELSEIF(I.EQ.3) THEN C...e* -> W- + nu. WDTP(I)=FAC*AEM*PARU(157)**2/(16D0*XW)* & (1D0-RM1)**2*(2D0+RM1) IF(KFLR.GT.0) WID2=WIDS(24,3) IF(KFLR.LT.0) WID2=WIDS(24,2) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 350 CONTINUE ELSEIF(KFLA.EQ.4000012) THEN C...nu*_e excited neutrino. FAC=(SH/PARU(155)**2)*SHR DO 360 I=1,MDCY(KC,3) IDC=I+MDCY(KC,2)-1 IF(MDME(IDC,1).LT.0) GOTO 360 RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 360 IF(I.EQ.1) THEN C...nu*_e -> Z0 + nu*_e. QF=PARU(157)*XW1/2D0+PARU(158)*XW/2D0 WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* & (1D0-RM1)**2*(2D0+RM1) WID2=WIDS(23,2) ELSEIF(I.EQ.2) THEN C...nu*_e -> W+ + e. WDTP(I)=FAC*AEM*PARU(157)**2/(16D0*XW)* & (1D0-RM1)**2*(2D0+RM1) IF(KFLR.GT.0) WID2=WIDS(24,2) IF(KFLR.LT.0) WID2=WIDS(24,3) ENDIF WDTP(0)=WDTP(0)+WDTP(I) IF(MDME(IDC,1).GT.0) THEN WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) WDTE(I,0)=WDTE(I,MDME(IDC,1)) WDTE(0,0)=WDTE(0,0)+WDTE(I,0) ENDIF 360 CONTINUE ENDIF MINT(61)=0 MINT(62)=0 RETURN END C*********************************************************************** C...PYOFSH C...Calculates partial width and differential cross-section maxima C...of channels/processes not allowed on mass-shell, and selects C...masses in such channels/processes. SUBROUTINE PYOFSH(MOFSH,KFMO,KFD1,KFD2,PMMO,RET1,RET2) C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) 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(4000,2),BRAT(4000),KFDP(4000,5) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, &/PYINT2/,/PYINT5/ C...Local arrays. DIMENSION KFD(2),MBW(2),PMD(2),PGD(2),PMG(2),PML(2),PMU(2), &PMH(2),ATL(2),ATU(2),ATH(2),RMG(2),INX1(100),XPT1(100), &FPT1(100),INX2(100),XPT2(100),FPT2(100),WDTP(0:100), &WDTE(0:100,0:5) C...Find if particles equal, maximum mass, matrix elements, etc. MINT(51)=0 ISUB=MINT(1) KFD(1)=IABS(KFD1) KFD(2)=IABS(KFD2) MEQL=0 IF(KFD(1).EQ.KFD(2)) MEQL=1 MLM=0 IF(MOFSH.GE.2.AND.MEQL.EQ.1) MLM=INT(1.5D0+PYR(0)) IF(MOFSH.LE.2.OR.MOFSH.EQ.7) THEN NOFF=44 PMMX=PMMO ELSE NOFF=40 PMMX=VINT(1) IF(CKIN(2).GT.CKIN(1)) PMMX=MIN(CKIN(2),VINT(1)) ENDIF MMED=0 IF((KFMO.EQ.25.OR.KFMO.EQ.35.OR.KFMO.EQ.36).AND.MEQL.EQ.1.AND. &(KFD(1).EQ.23.OR.KFD(1).EQ.24)) MMED=1 IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(1).EQ.23.OR. &KFD(1).EQ.24).AND.(KFD(2).EQ.23.OR.KFD(2).EQ.24)) MMED=2 IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(2).EQ.25.OR. &KFD(2).EQ.35.OR.KFD(2).EQ.36)) MMED=3 LOOP=1 C...Find where Breit-Wigners are required, else select discrete masses. 100 DO 110 I=1,2 KFCA=PYCOMP(KFD(I)) IF(KFCA.GT.0) THEN PMD(I)=PMAS(KFCA,1) PGD(I)=PMAS(KFCA,2) ELSE PMD(I)=0D0 PGD(I)=0D0 ENDIF IF(MSTP(42).LE.0.OR.PGD(I).LT.PARP(41)) THEN MBW(I)=0 PMG(I)=PMD(I) RMG(I)=(PMG(I)/PMMX)**2 ELSE MBW(I)=1 ENDIF 110 CONTINUE C...Find allowed mass range and Breit-Wigner parameters. DO 120 I=1,2 IF(MOFSH.EQ.1.AND.LOOP.EQ.1.AND.MBW(I).EQ.1) THEN PML(I)=PARP(42) PMU(I)=PMMX-PARP(42) IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 ELSEIF((MBW(I).EQ.1.OR.MOFSH.GE.5).AND.MOFSH.NE.7) THEN ILM=I IF(MLM.EQ.2) ILM=3-I PML(I)=MAX(CKIN(NOFF+2*ILM-1),PARP(42)) IF(MOFSH.GE.5.AND.I.EQ.2) PML(I)=MAX(PML(I), & 2D0*PMAS(PYCOMP(KFD2),1)) PMU(I)=PMMX-MAX(CKIN(NOFF+5-2*ILM),PARP(42)) IF(MOFSH.GE.5.AND.I.EQ.1) PMU(I)=MIN(PMU(I),PMMX-2D0* & PMAS(PYCOMP(KFD2),1)) IF(CKIN(NOFF+2*ILM).GT.CKIN(NOFF+2*ILM-1)) PMU(I)=MIN(PMU(I), & CKIN(NOFF+2*ILM)) IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 IF(MBW(I).EQ.1) THEN ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* & PGD(I))) ENDIF ELSEIF(MBW(I).EQ.1.AND.MOFSH.EQ.7) THEN ILM=I IF(MLM.EQ.2) ILM=3-I PML(I)=PARP(42) PMU(I)=PMMX-PARP(42) IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 IF(MBW(I).EQ.1) THEN ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* & PGD(I))) ENDIF ENDIF 120 CONTINUE IF(MBW(1).LT.0.OR.MBW(2).LT.0.OR.(MBW(1).EQ.0.AND.MBW(2).EQ.0)) &THEN CALL PYERRM(13,'(PYOFSH:) no allowed decay product masses') MINT(51)=1 RETURN ENDIF C...Calculation of partial width of resonance. IF(MOFSH.EQ.1) THEN C..If only one integration, pick that to be the inner. IF(MBW(1).EQ.0) THEN PM2=PMD(1) PMD(1)=PMD(2) PGD(1)=PGD(2) PML(1)=PML(2) PMU(1)=PMU(2) ELSEIF(MBW(2).EQ.0) THEN PM2=PMD(2) ENDIF C...Start outer loop of integration. IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN ATL2=ATAN((PML(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) ATU2=ATAN((PMU(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) NPT2=1 XPT2(1)=1D0 INX2(1)=0 FMAX2=0D0 ENDIF 130 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN PM2S=PMD(2)**2+PMD(2)*PGD(2)*TAN(ATL2+XPT2(NPT2)*(ATU2-ATL2)) PM2=MIN(PMU(2),MAX(PML(2),SQRT(MAX(0D0,PM2S)))) ENDIF RM2=(PM2/PMMX)**2 C...Start inner loop of integration. PML1=PML(1) PMU1=MIN(PMU(1),PMMX-PM2) IF(MEQL.EQ.1) PMU1=MIN(PMU1,PM2) ATL1=ATAN((PML1**2-PMD(1)**2)/(PMD(1)*PGD(1))) ATU1=ATAN((PMU1**2-PMD(1)**2)/(PMD(1)*PGD(1))) IF(PML1+PARJ(64).GE.PMU1.OR.ATL1+1D-7.GE.ATU1) THEN FUNC2=0D0 GOTO 180 ENDIF NPT1=1 XPT1(1)=1D0 INX1(1)=0 FMAX1=0D0 140 PM1S=PMD(1)**2+PMD(1)*PGD(1)*TAN(ATL1+XPT1(NPT1)*(ATU1-ATL1)) PM1=MIN(PMU1,MAX(PML1,SQRT(MAX(0D0,PM1S)))) RM1=(PM1/PMMX)**2 C...Evaluate function value - inner loop. FUNC1=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) IF(MMED.EQ.1) FUNC1=FUNC1*((1D0-RM1-RM2)**2+8D0*RM1*RM2) IF(MMED.EQ.2) FUNC1=FUNC1**3*(1D0+10D0*RM1+10D0*RM2+RM1**2+ & RM2**2+10D0*RM1*RM2) IF(FUNC1.GT.FMAX1) FMAX1=FUNC1 FPT1(NPT1)=FUNC1 C...Go to next position in inner loop. IF(NPT1.EQ.1) THEN NPT1=NPT1+1 XPT1(NPT1)=0D0 INX1(NPT1)=1 GOTO 140 ELSEIF(NPT1.LE.8) THEN NPT1=NPT1+1 IF(NPT1.LE.4.OR.NPT1.EQ.6) ISH1=1 ISH1=ISH1+1 XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) INX1(NPT1)=INX1(ISH1) INX1(ISH1)=NPT1 GOTO 140 ELSEIF(NPT1.LT.100) THEN ISN1=ISH1 150 ISH1=ISH1+1 IF(ISH1.GT.NPT1) ISH1=2 IF(ISH1.EQ.ISN1) GOTO 160 DFPT1=ABS(FPT1(ISH1)-FPT1(INX1(ISH1))) IF(DFPT1.LT.PARP(43)*FMAX1) GOTO 150 NPT1=NPT1+1 XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) INX1(NPT1)=INX1(ISH1) INX1(ISH1)=NPT1 GOTO 140 ENDIF C...Calculate integral over inner loop. 160 FSUM1=0D0 DO 170 IPT1=2,NPT1 FSUM1=FSUM1+0.5D0*(FPT1(IPT1)+FPT1(INX1(IPT1)))* & (XPT1(INX1(IPT1))-XPT1(IPT1)) 170 CONTINUE FUNC2=FSUM1*(ATU1-ATL1)/PARU(1) 180 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN IF(FUNC2.GT.FMAX2) FMAX2=FUNC2 FPT2(NPT2)=FUNC2 C...Go to next position in outer loop. IF(NPT2.EQ.1) THEN NPT2=NPT2+1 XPT2(NPT2)=0D0 INX2(NPT2)=1 GOTO 130 ELSEIF(NPT2.LE.8) THEN NPT2=NPT2+1 IF(NPT2.LE.4.OR.NPT2.EQ.6) ISH2=1 ISH2=ISH2+1 XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) INX2(NPT2)=INX2(ISH2) INX2(ISH2)=NPT2 GOTO 130 ELSEIF(NPT2.LT.100) THEN ISN2=ISH2 190 ISH2=ISH2+1 IF(ISH2.GT.NPT2) ISH2=2 IF(ISH2.EQ.ISN2) GOTO 200 DFPT2=ABS(FPT2(ISH2)-FPT2(INX2(ISH2))) IF(DFPT2.LT.PARP(43)*FMAX2) GOTO 190 NPT2=NPT2+1 XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) INX2(NPT2)=INX2(ISH2) INX2(ISH2)=NPT2 GOTO 130 ENDIF C...Calculate integral over outer loop. 200 FSUM2=0D0 DO 210 IPT2=2,NPT2 FSUM2=FSUM2+0.5D0*(FPT2(IPT2)+FPT2(INX2(IPT2)))* & (XPT2(INX2(IPT2))-XPT2(IPT2)) 210 CONTINUE FSUM2=FSUM2*(ATU2-ATL2)/PARU(1) IF(MEQL.EQ.1) FSUM2=2D0*FSUM2 ELSE FSUM2=FUNC2 ENDIF C...Save result; second integration for user-selected mass range. IF(LOOP.EQ.1) WIDW=FSUM2 WID2=FSUM2 IF(LOOP.EQ.1.AND.(CKIN(46).GE.CKIN(45).OR.CKIN(48).GE.CKIN(47) & .OR.MAX(CKIN(45),CKIN(47)).GE.1.01D0*PARP(42))) THEN LOOP=2 GOTO 100 ENDIF RET1=WIDW RET2=WID2/WIDW C...Select two decay product masses of a resonance. ELSEIF(MOFSH.EQ.2.OR.MOFSH.EQ.7) THEN 220 DO 230 I=1,2 IF(MBW(I).EQ.0) GOTO 230 PMBW=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)*(ATU(I)-ATL(I))) PMG(I)=MIN(PMU(I),MAX(PML(I),SQRT(MAX(0D0,PMBW)))) RMG(I)=(PMG(I)/PMMX)**2 230 CONTINUE IF((MEQL.EQ.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) GOTO 220 C...Weight with matrix element (if none known, use beta factor). FLAM=SQRT(MAX(0D0,(1D0-RMG(1)-RMG(2))**2-4D0*RMG(1)*RMG(2))) IF(MMED.EQ.1) THEN WTBE=FLAM*((1D0-RMG(1)-RMG(2))**2+8D0*RMG(1)*RMG(2)) ELSEIF(MMED.EQ.2) THEN WTBE=FLAM**3*(1D0+10D0*RMG(1)+10D0*RMG(2)+RMG(1)**2+ & RMG(2)**2+10D0*RMG(1)*RMG(2)) ELSEIF(MMED.EQ.3) THEN WTBE=FLAM*(RMG(1)+FLAM**2/12D0) ELSE WTBE=FLAM ENDIF IF(WTBE.LT.PYR(0)) GOTO 220 RET1=PMG(1) RET2=PMG(2) C...Find suitable set of masses for initialization of 2 -> 2 processes. ELSEIF(MOFSH.EQ.3) THEN IF(MBW(1).NE.0.AND.MBW(2).EQ.0) THEN PMG(1)=MIN(PMD(1),0.5D0*(PML(1)+PMU(1))) PMG(2)=PMD(2) ELSEIF(MBW(2).NE.0.AND.MBW(1).EQ.0) THEN PMG(1)=PMD(1) PMG(2)=MIN(PMD(2),0.5D0*(PML(2)+PMU(2))) ELSE IDIV=-1 240 IDIV=IDIV+1 PMG(1)=MIN(PMD(1),0.1D0*(IDIV*PML(1)+(10-IDIV)*PMU(1))) PMG(2)=MIN(PMD(2),0.1D0*(IDIV*PML(2)+(10-IDIV)*PMU(2))) IF(IDIV.LE.9.AND.PMG(1)+PMG(2).GT.0.9D0*PMMX) GOTO 240 ENDIF RET1=PMG(1) RET2=PMG(2) C...Evaluate importance of excluded tails of Breit-Wigners. IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 IF(MEQL.LE.1) THEN VINT(80)=1D0 DO 250 I=1,2 IF(MBW(I).NE.0) VINT(80)=VINT(80)*1.25D0*(ATU(I)-ATL(I))/ & PARU(1) 250 CONTINUE ELSE VINT(80)=(1.25D0/PARU(1))**2*MAX((ATU(1)-ATL(1))* & (ATH(2)-ATL(2)),(ATH(1)-ATL(1))*(ATU(2)-ATL(2))) ENDIF IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.30.OR.ISUB.EQ.35).AND. & MSTP(43).NE.2) VINT(80)=2D0*VINT(80) IF(ISUB.EQ.22.AND.MSTP(43).NE.2) VINT(80)=4D0*VINT(80) IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) C...Pick one particle to be the lighter (if improves efficiency). ELSEIF(MOFSH.EQ.4) THEN IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 260 IF(MEQL.EQ.2) MLM=INT(1.5D0+PYR(0)) C...Select two masses according to Breit-Wigner + flat in s + 1/s. DO 270 I=1,2 IF(MBW(I).EQ.0) GOTO 270 PMV=PMU(I) IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) ATV=ATU(I) IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) RBR=PYR(0) IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. & ISUB.EQ.35).AND.MSTP(43).NE.2) RBR=2D0*RBR IF(RBR.LT.0.8D0) THEN PMSR=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)*(ATV-ATL(I))) PMG(I)=MIN(PMV,MAX(PML(I),SQRT(MAX(0D0,PMSR)))) ELSEIF(RBR.LT.0.9D0) THEN PMG(I)=SQRT(MAX(0D0,PML(I)**2+PYR(0)*(PMV**2-PML(I)**2))) ELSEIF(RBR.LT.1.5D0) THEN PMG(I)=PML(I)*(PMV/PML(I))**PYR(0) ELSE PMG(I)=SQRT(MAX(0D0,PML(I)**2*PMV**2/(PML(I)**2+PYR(0)* & (PMV**2-PML(I)**2)))) ENDIF 270 CONTINUE IF((MEQL.GE.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) THEN IF(MINT(48).EQ.1) THEN NGEN(0,1)=NGEN(0,1)+1 NGEN(MINT(1),1)=NGEN(MINT(1),1)+1 GOTO 260 ELSE MINT(51)=1 RETURN ENDIF ENDIF RET1=PMG(1) RET2=PMG(2) C...Give weight for selected mass distribution. VINT(80)=1D0 DO 280 I=1,2 IF(MBW(I).EQ.0) GOTO 280 PMV=PMU(I) IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) ATV=ATU(I) IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) F0=PMD(I)*PGD(I)/((PMG(I)**2-PMD(I)**2)**2+ & (PMD(I)*PGD(I))**2)/PARU(1) F1=1D0 F2=1D0/PMG(I)**2 F3=1D0/PMG(I)**4 FI0=(ATV-ATL(I))/PARU(1) FI1=PMV**2-PML(I)**2 FI2=2D0*LOG(PMV/PML(I)) FI3=1D0/PML(I)**2-1D0/PMV**2 IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. & ISUB.EQ.35).AND.MSTP(43).NE.2) THEN VINT(80)=VINT(80)*20D0/(8D0+(FI0/F0)*(F1/FI1+6D0*F2/FI2+ & 5D0*F3/FI3)) ELSE VINT(80)=VINT(80)*10D0/(8D0+(FI0/F0)*(F1/FI1+F2/FI2)) ENDIF VINT(80)=VINT(80)*FI0 280 CONTINUE IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) ELSEIF(MOFSH.EQ.5) THEN C...Find suitable set of masses for initialization of 2 -> 3 process. IDIV=6 290 IDIV=IDIV-1 IF(MBW(1).EQ.0) THEN PMG(1)=PMD(1) ELSE PMSR=PMD(1)**2+PMD(1)*PGD(1)*TAN(ATL(1)+0.1D0*IDIV*(ATU(1)- & ATL(1))) PMG(1)=MIN(PMU(1),MAX(PML(1),SQRT(MAX(0D0,PMSR)))) ENDIF PMG(2)=PML(2)*(PMU(2)/PML(2))**(0.1D0*IDIV) IF(IDIV.GE.1.AND.PMG(1)+PMG(2).GT.0.9D0*PMMX) GOTO 290 RET1=PMG(1) RET2=PMG(2) C...Evaluate size of selected phase space volume. VINT(80)=2D0*LOG(PMU(2)/PML(2)) IF(MBW(1).NE.0) VINT(80)=VINT(80)*1.25D0*(ATU(1)-ATL(1))/PARU(1) C...Pick decay angles. VINT(81)=0D0 VINT(82)=0.5D0*PARU(1) VINT(83)=1D0 VINT(84)=0D0 C...Select flavour of resonance decays. KFA=KFPR(ISUB,1) KCA=PYCOMP(KFA) CALL PYWIDT(KFA,PMG(1)**2,WDTP,WDTE) IF(KCHG(KCA,3).EQ.0) THEN IPM=2 ELSE IPM=(5-ISIGN(1,KFA))/2 ENDIF WDTE0S=WDTE(0,1)+WDTE(0,IPM)+WDTE(0,4) IF(WDTE0S.LE.0D0) THEN CALL PYERRM(12,'(PYOFSH:) no allowed resonace decay channel') MINT(51)=1 RETURN ENDIF WDTEC=0D0 DO 300 IDL=1,MDCY(KCA,3) WDTEK=WDTE(IDL,1)+WDTE(IDL,IPM)+WDTE(IDL,4) IF(WDTEK.GT.WDTEC) THEN IDC=IDL+MDCY(KCA,2)-1 WDTEC=WDTEK ENDIF 300 CONTINUE MINT(35)=IDC C...Compensating factor for all flavours. KFL=IABS(KFDP(IDC,1)) QFL=KCHG(PYCOMP(KFL),1)/3D0 AFL=SIGN(1D0,QFL+0.1D0) VFL=AFL-4D0*PARU(102)*QFL WDTEK=VFL**2+AFL**2 VINT(80)=VINT(80)*WDTE0S/WDTEK ELSEIF(MOFSH.EQ.6) THEN C...Select two masses, one basically Breit-Wigner, other dm^2/m^2. IF(MBW(1).NE.0) THEN RBR=PYR(0) IF(RBR.LT.0.8D0) THEN PMSR=PMD(1)**2+PMD(1)*PGD(1)*TAN(ATL(1)+PYR(0)* & (ATU(1)-ATL(1))) PMG(1)=MIN(PMU(1),MAX(PML(1),SQRT(MAX(0D0,PMSR)))) ELSEIF(RBR.LT.0.9D0) THEN PMG(1)=SQRT(MAX(0D0,PML(1)**2+PYR(0)*(PMU(1)**2-PML(1)**2))) ELSE PMG(1)=PML(1)*(PMU(1)/PML(1))**PYR(0) ENDIF ENDIF PMG(2)=PML(2)*(PMU(2)/PML(2))**PYR(0) IF(SQRT(MAX(0D0,1D0-(PML(2)/PMG(2))**2)).LT.PYR(0).OR. & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) THEN MINT(51)=1 RETURN ENDIF RET1=PMG(1) RET2=PMG(2) C...Give weight for selected mass distribution. VINT(80)=2D0*LOG(PMU(2)/PML(2)) IF(MBW(1).NE.0) THEN F0=PMD(1)*PGD(1)/((PMG(1)**2-PMD(1)**2)**2+ & (PMD(1)*PGD(1))**2)/PARU(1) F1=1D0 F2=1D0/PMG(1)**2 FI0=(ATU(1)-ATL(1))/PARU(1) FI1=PMU(1)**2-PML(1)**2 FI2=2D0*LOG(PMU(1)/PML(1)) VINT(80)=VINT(80)*10D0*FI0/(8D0+(FI0/F0)*(F1/FI1+F2/FI2)) ENDIF C...Select decay angles. VINT(81)=2D0*PYR(0)-1D0 VINT(82)=PARU(2)*PYR(0) VINT(83)=2D0*PYR(0)-1D0 VINT(84)=PARU(2)*PYR(0) C...Select flavour of resonance decays. KFA=KFPR(ISUB,1) KCA=PYCOMP(KFA) CALL PYWIDT(KFA,PMG(1)**2,WDTP,WDTE) IF(KCHG(KCA,3).EQ.0) THEN IPM=2 ELSE IPM=(5-ISIGN(1,KFA))/2 ENDIF WDTE0S=WDTE(0,1)+WDTE(0,IPM)+WDTE(0,4) IF(WDTE0S.LE.0D0) THEN CALL PYERRM(12,'(PYOFSH:) no allowed resonace decay channel') MINT(51)=1 RETURN ENDIF RKFL=WDTE0S*PYR(0) IDL=0 310 IDL=IDL+1 IDC=IDL+MDCY(KCA,2)-1 RKFL=RKFL-(WDTE(IDL,1)+WDTE(IDL,IPM)+WDTE(IDL,4)) IF(IDL.LT.MDCY(KCA,3).AND.RKFL.GT.0D0) GOTO 310 MINT(35)=IDC C...Compensating factor for all flavours. KFL=IABS(KFDP(IDC,1)) QFL=KCHG(PYCOMP(KFL),1)/3D0 AFL=SIGN(1D0,QFL+0.1D0) VFL=AFL-4D0*PARU(102)*QFL WDTEK=VFL**2+AFL**2 VINT(80)=VINT(80)*WDTE0S/WDTEK ENDIF RETURN END C*********************************************************************** C...PYKLIM C...Checks generated variables against pre-set kinematical limits; C...also calculates limits on variables used in generation. SUBROUTINE PYKLIM(ILIM) C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/PYDAT3/MDCY(500,3),MDME(4000,2),BRAT(4000),KFDP(4000,5) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, &/PYINT1/,/PYINT2/ C...Common kinematical expressions. MINT(51)=0 ISUB=MINT(1) ISTSB=ISET(ISUB) IF(ISUB.EQ.96) GOTO 110 SQM3=VINT(63) SQM4=VINT(64) IF(ILIM.NE.0) THEN IF(ABS(SQM3).LT.1D-4.AND.ABS(SQM4).LT.1D-4) THEN CKIN09=MAX(CKIN(9),CKIN(13)) CKIN10=MIN(CKIN(10),CKIN(14)) CKIN11=MAX(CKIN(11),CKIN(15)) CKIN12=MIN(CKIN(12),CKIN(16)) ELSE CKIN09=MAX(CKIN(9),MIN(0D0,CKIN(13))) CKIN10=MIN(CKIN(10),MAX(0D0,CKIN(14))) CKIN11=MAX(CKIN(11),MIN(0D0,CKIN(15))) CKIN12=MIN(CKIN(12),MAX(0D0,CKIN(16))) ENDIF ENDIF IF(ILIM.NE.1) THEN TAU=VINT(21) RM3=SQM3/(TAU*VINT(2)) RM4=SQM4/(TAU*VINT(2)) BE34=SQRT(MAX(1D-20,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) ENDIF PTHMIN=CKIN(3) IF(MIN(SQM3,SQM4).LT.CKIN(6)**2.AND.ISTSB.NE.1.AND.ISTSB.NE.3) &PTHMIN=MAX(CKIN(3),CKIN(5)) IF(ILIM.EQ.0) THEN C...Check generated values of tau, y*, cos(theta-hat), and tau' against C...pre-set kinematical limits. YST=VINT(22) CTH=VINT(23) TAUP=VINT(26) TAUE=TAU IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP X1=SQRT(TAUE)*EXP(YST) X2=SQRT(TAUE)*EXP(-YST) XF=X1-X2 IF(MINT(47).NE.1) THEN IF(TAU*VINT(2).LT.CKIN(1)**2) MINT(51)=1 IF(CKIN(2).GE.0D0.AND.TAU*VINT(2).GT.CKIN(2)**2) MINT(51)=1 IF(YST.LT.CKIN(7).OR.YST.GT.CKIN(8)) MINT(51)=1 IF(XF.LT.CKIN(25).OR.XF.GT.CKIN(26)) MINT(51)=1 ENDIF IF(MINT(45).NE.1) THEN IF(X1.LT.CKIN(21).OR.X1.GT.CKIN(22)) MINT(51)=1 ENDIF IF(MINT(46).NE.1) THEN IF(X2.LT.CKIN(23).OR.X2.GT.CKIN(24)) MINT(51)=1 ENDIF IF(ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6) THEN PTH=0.5D0*BE34*SQRT(TAU*VINT(2)*MAX(0D0,1D0-CTH**2)) EXPY3=MAX(1.D-10,(1D0+RM3-RM4+BE34*CTH)/ & MAX(1.D-10,(1D0+RM3-RM4-BE34*CTH))) EXPY4=MAX(1.D-10,(1D0-RM3+RM4-BE34*CTH)/ & MAX(1.D-10,(1D0-RM3+RM4+BE34*CTH))) Y3=YST+0.5D0*LOG(EXPY3) Y4=YST+0.5D0*LOG(EXPY4) YLARGE=MAX(Y3,Y4) YSMALL=MIN(Y3,Y4) ETALAR=10D0 ETASMA=-10D0 STH=SQRT(MAX(0D0,1D0-CTH**2)) EXSQ3=SQRT(MAX(1D-20,((1D0+RM3-RM4)*COSH(YST)+BE34*SINH(YST)* & CTH)**2-4D0*RM3)) EXSQ4=SQRT(MAX(1D-20,((1D0-RM3+RM4)*COSH(YST)-BE34*SINH(YST)* & CTH)**2-4D0*RM4)) IF(STH.GE.1.D-6) THEN EXPET3=((1D0+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH+EXSQ3)/ & (BE34*STH) EXPET4=((1D0-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH+EXSQ4)/ & (BE34*STH) ETA3=LOG(MIN(1.D10,MAX(1.D-10,EXPET3))) ETA4=LOG(MIN(1.D10,MAX(1.D-10,EXPET4))) ETALAR=MAX(ETA3,ETA4) ETASMA=MIN(ETA3,ETA4) ENDIF CTS3=((1D0+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH)/EXSQ3 CTS4=((1D0-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH)/EXSQ4 CTSLAR=MIN(1D0,MAX(CTS3,CTS4)) CTSSMA=MAX(-1D0,MIN(CTS3,CTS4)) SH=TAU*VINT(2) RPTS=4D0*VINT(71)**2/SH BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) RM34=MAX(1D-20,2D0*RM3*RM4) IF(2D0*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001D0) & RM34=MAX(RM34,2D0*VINT(71)**2/(VINT(21)*VINT(2))) RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) THA=0.5D0*SH*MAX(RTHM,1D0-RM3-RM4-BE34*CTH) UHA=0.5D0*SH*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) IF(PTH.LT.PTHMIN) MINT(51)=1 IF(CKIN(4).GE.0D0.AND.PTH.GT.CKIN(4)) MINT(51)=1 IF(YLARGE.LT.CKIN(9).OR.YLARGE.GT.CKIN(10)) MINT(51)=1 IF(YSMALL.LT.CKIN(11).OR.YSMALL.GT.CKIN(12)) MINT(51)=1 IF(ETALAR.LT.CKIN(13).OR.ETALAR.GT.CKIN(14)) MINT(51)=1 IF(ETASMA.LT.CKIN(15).OR.ETASMA.GT.CKIN(16)) MINT(51)=1 IF(CTSLAR.LT.CKIN(17).OR.CTSLAR.GT.CKIN(18)) MINT(51)=1 IF(CTSSMA.LT.CKIN(19).OR.CTSSMA.GT.CKIN(20)) MINT(51)=1 IF(CTH.LT.CKIN(27).OR.CTH.GT.CKIN(28)) MINT(51)=1 IF(THA.LT.CKIN(35)) MINT(51)=1 IF(CKIN(36).GE.0D0.AND.THA.GT.CKIN(36)) MINT(51)=1 IF(UHA.LT.CKIN(37)) MINT(51)=1 IF(CKIN(38).GE.0D0.AND.UHA.GT.CKIN(38)) MINT(51)=1 ENDIF IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN IF(TAUP*VINT(2).LT.CKIN(31)**2) MINT(51)=1 IF(CKIN(32).GE.0D0.AND.TAUP*VINT(2).GT.CKIN(32)**2) MINT(51)=1 ENDIF C...Additional cuts on W2 (approximately) in DIS. IF(ISUB.EQ.10) THEN XBJ=X2 IF(IABS(MINT(12)).LT.20) XBJ=X1 Q2BJ=THA W2BJ=Q2BJ*(1D0-XBJ)/XBJ IF(W2BJ.LT.CKIN(39)) MINT(51)=1 IF(CKIN(40).GT.0D0.AND.W2BJ.GT.CKIN(40)) MINT(51)=1 ENDIF C...Additional p_T cuts on 2 -> 3 process. IF(ISTSB.EQ.6) THEN KFQ=KFPR(131,2) PMQQ=SQRT(VINT(64)) PMQ=PMAS(PYCOMP(KFQ),1) PZQ=SQRT(MAX(0D0,(0.5D0*PMQQ)**2-PMQ**2)) DO 100 I=MINT(84)+1,MINT(84)+2 K(I,1)=1 P(I,1)=0D0 P(I,2)=0D0 P(I,3)=PZQ*(-1D0)**(I-1) P(I,4)=0.5D0*PMQQ P(I,5)=PMQ 100 CONTINUE PEQQ=0.5D0*SQRT(TAU*VINT(2))*(1D0+(VINT(64)-VINT(63))/ & (TAU*VINT(2))) PZQQ=SQRT(MAX(0D0,PEQQ**2-VINT(64))) CALL PYROBO(MINT(84)+1,MINT(84)+2,ACOS(VINT(83)),VINT(84), & 0D0,0D0,-PZQQ/PEQQ) CALL PYROBO(MINT(84)+1,MINT(84)+2,ACOS(VINT(23)),VINT(24), & 0D0,0D0,0D0) PTQ2=SQRT(P(MINT(84)+1,1)**2+P(MINT(84)+1,2)**2) PTQ3=SQRT(P(MINT(84)+2,1)**2+P(MINT(84)+2,2)**2) PTMNQ=MIN(PTQ2,PTQ3) PTMXQ=MAX(PTQ2,PTQ3) IF(PTMNQ.LT.CKIN(51)) MINT(51)=1 IF(CKIN(52).GE.0D0.AND.PTMNQ.GT.CKIN(52)) MINT(51)=1 IF(PTMXQ.LT.CKIN(53)) MINT(51)=1 IF(CKIN(54).GE.0D0.AND.PTMXQ.GT.CKIN(54)) MINT(51)=1 VINT(85)=PTMNQ VINT(86)=PTMXQ ENDIF ELSEIF(ILIM.EQ.1) THEN C...Calculate limits on tau C...0) due to definition TAUMN0=0D0 TAUMX0=1D0 C...1) due to limits on subsystem mass TAUMN1=CKIN(1)**2/VINT(2) TAUMX1=1D0 IF(CKIN(2).GE.0D0) TAUMX1=CKIN(2)**2/VINT(2) C...2) due to limits on pT-hat (and non-overlapping rapidity intervals) TM3=SQRT(SQM3+PTHMIN**2) TM4=SQRT(SQM4+PTHMIN**2) YDCOSH=1D0 IF(CKIN09.GT.CKIN12) YDCOSH=COSH(CKIN09-CKIN12) TAUMN2=(TM3**2+2D0*TM3*TM4*YDCOSH+TM4**2)/VINT(2) TAUMX2=1D0 C...3) due to limits on pT-hat and cos(theta-hat) CTH2MN=MIN(CKIN(27)**2,CKIN(28)**2) CTH2MX=MAX(CKIN(27)**2,CKIN(28)**2) TAUMN3=0D0 IF(CKIN(27)*CKIN(28).GT.0D0) TAUMN3= & (SQRT(SQM3+PTHMIN**2/(1D0-CTH2MN))+ & SQRT(SQM4+PTHMIN**2/(1D0-CTH2MN)))**2/VINT(2) TAUMX3=1D0 IF(CKIN(4).GE.0D0.AND.CTH2MX.LT.1D0) TAUMX3= & (SQRT(SQM3+CKIN(4)**2/(1D0-CTH2MX))+ & SQRT(SQM4+CKIN(4)**2/(1D0-CTH2MX)))**2/VINT(2) C...4) due to limits on x1 and x2 TAUMN4=CKIN(21)*CKIN(23) TAUMX4=CKIN(22)*CKIN(24) C...5) due to limits on xF TAUMN5=0D0 TAUMX5=MAX(1D0-CKIN(25),1D0+CKIN(26)) C...6) due to limits on that and uhat TAUMN6=(SQM3+SQM4+CKIN(35)+CKIN(37))/VINT(2) TAUMX6=1D0 IF(CKIN(36).GT.0D0.AND.CKIN(38).GT.0D0) TAUMX6= & (SQM3+SQM4+CKIN(36)+CKIN(38))/VINT(2) C...Net effect of all separate limits. VINT(11)=MAX(TAUMN0,TAUMN1,TAUMN2,TAUMN3,TAUMN4,TAUMN5,TAUMN6) VINT(31)=MIN(TAUMX0,TAUMX1,TAUMX2,TAUMX3,TAUMX4,TAUMX5,TAUMX6) IF(MINT(47).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2.OR.ISTSB.EQ.6)) & THEN VINT(11)=0.99999D0 VINT(31)=1.00001D0 ELSEIF(MINT(47).EQ.5) THEN VINT(31)=MIN(VINT(31),0.999998D0) ENDIF IF(VINT(31).LE.VINT(11)) MINT(51)=1 ELSEIF(ILIM.EQ.2) THEN C...Calculate limits on y* TAUE=TAU IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINT(26) TAURT=SQRT(TAUE) C...0) due to kinematics YSTMN0=LOG(TAURT) YSTMX0=-YSTMN0 C...1) due to explicit limits YSTMN1=CKIN(7) YSTMX1=CKIN(8) C...2) due to limits on x1 YSTMN2=LOG(MAX(TAUE,CKIN(21))/TAURT) YSTMX2=LOG(MAX(TAUE,CKIN(22))/TAURT) C...3) due to limits on x2 YSTMN3=-LOG(MAX(TAUE,CKIN(24))/TAURT) YSTMX3=-LOG(MAX(TAUE,CKIN(23))/TAURT) C...4) due to limits on xF YEPMN4=0.5D0*ABS(CKIN(25))/TAURT YSTMN4=SIGN(LOG(MAX(1D-20,SQRT(1D0+YEPMN4**2)+YEPMN4)),CKIN(25)) YEPMX4=0.5D0*ABS(CKIN(26))/TAURT YSTMX4=SIGN(LOG(MAX(1D-20,SQRT(1D0+YEPMX4**2)+YEPMX4)),CKIN(26)) C...5) due to simultaneous limits on y-large and y-small YEPSMN=(RM3-RM4)*SINH(CKIN09-CKIN11) YEPSMX=(RM3-RM4)*SINH(CKIN10-CKIN12) YDIFMN=ABS(LOG(MAX(1D-20,SQRT(1D0+YEPSMN**2)-YEPSMN))) YDIFMX=ABS(LOG(MAX(1D-20,SQRT(1D0+YEPSMX**2)-YEPSMX))) YSTMN5=0.5D0*(CKIN09+CKIN11-YDIFMN) YSTMX5=0.5D0*(CKIN10+CKIN12+YDIFMX) C...6) due to simultaneous limits on cos(theta-hat) and y-large or C... y-small CTHLIM=SQRT(MAX(0D0,1D0-4D0*PTHMIN**2/(BE34**2*TAUE*VINT(2)))) RZMN=BE34*MAX(CKIN(27),-CTHLIM) RZMX=BE34*MIN(CKIN(28),CTHLIM) YEX3MX=(1D0+RM3-RM4+RZMX)/MAX(1D-10,1D0+RM3-RM4-RZMX) YEX4MX=(1D0+RM4-RM3-RZMN)/MAX(1D-10,1D0+RM4-RM3+RZMN) YEX3MN=MAX(1D-10,1D0+RM3-RM4+RZMN)/(1D0+RM3-RM4-RZMN) YEX4MN=MAX(1D-10,1D0+RM4-RM3-RZMX)/(1D0+RM4-RM3+RZMX) YSTMN6=CKIN09-0.5D0*LOG(MAX(YEX3MX,YEX4MX)) YSTMX6=CKIN12-0.5D0*LOG(MIN(YEX3MN,YEX4MN)) C...Net effect of all separate limits. VINT(12)=MAX(YSTMN0,YSTMN1,YSTMN2,YSTMN3,YSTMN4,YSTMN5,YSTMN6) VINT(32)=MIN(YSTMX0,YSTMX1,YSTMX2,YSTMX3,YSTMX4,YSTMX5,YSTMX6) IF(MINT(47).EQ.1) THEN VINT(12)=-0.00001D0 VINT(32)=0.00001D0 ELSEIF(MINT(47).EQ.2) THEN VINT(12)=0.99999D0*YSTMX0 VINT(32)=1.00001D0*YSTMX0 ELSEIF(MINT(47).EQ.3) THEN VINT(12)=-1.00001D0*YSTMX0 VINT(32)=-0.99999D0*YSTMX0 ELSEIF(MINT(47).EQ.5) THEN YSTEE=LOG(0.999999D0/TAURT) VINT(12)=MAX(VINT(12),-YSTEE) VINT(32)=MIN(VINT(32),YSTEE) ENDIF IF(VINT(32).LE.VINT(12)) MINT(51)=1 ELSEIF(ILIM.EQ.3) THEN C...Calculate limits on cos(theta-hat) YST=VINT(22) C...0) due to definition CTNMN0=-1D0 CTNMX0=0D0 CTPMN0=0D0 CTPMX0=1D0 C...1) due to explicit limits CTNMN1=MIN(0D0,CKIN(27)) CTNMX1=MIN(0D0,CKIN(28)) CTPMN1=MAX(0D0,CKIN(27)) CTPMX1=MAX(0D0,CKIN(28)) C...2) due to limits on pT-hat CTNMN2=-SQRT(MAX(0D0,1D0-4D0*PTHMIN**2/(BE34**2*TAU*VINT(2)))) CTPMX2=-CTNMN2 CTNMX2=0D0 CTPMN2=0D0 IF(CKIN(4).GE.0D0) THEN CTNMX2=-SQRT(MAX(0D0,1D0-4D0*CKIN(4)**2/ & (BE34**2*TAU*VINT(2)))) CTPMN2=-CTNMX2 ENDIF C...3) due to limits on y-large and y-small CTNMN3=MIN(0D0,MAX((1D0+RM3-RM4)/BE34*TANH(CKIN11-YST), & -(1D0-RM3+RM4)/BE34*TANH(CKIN10-YST))) CTNMX3=MIN(0D0,(1D0+RM3-RM4)/BE34*TANH(CKIN12-YST), & -(1D0-RM3+RM4)/BE34*TANH(CKIN09-YST)) CTPMN3=MAX(0D0,(1D0+RM3-RM4)/BE34*TANH(CKIN09-YST), & -(1D0-RM3+RM4)/BE34*TANH(CKIN12-YST)) CTPMX3=MAX(0D0,MIN((1D0+RM3-RM4)/BE34*TANH(CKIN10-YST), & -(1D0-RM3+RM4)/BE34*TANH(CKIN11-YST))) C...4) due to limits on that CTNMN4=-1D0 CTNMX4=0D0 CTPMN4=0D0 CTPMX4=1D0 SH=TAU*VINT(2) IF(CKIN(35).GT.0D0) THEN CTLIM=(1D0-RM3-RM4-2D0*CKIN(35)/SH)/BE34 IF(CTLIM.GT.0D0) THEN CTPMX4=CTLIM ELSE CTPMX4=0D0 CTNMX4=CTLIM ENDIF ENDIF IF(CKIN(36).GT.0D0) THEN CTLIM=(1D0-RM3-RM4-2D0*CKIN(36)/SH)/BE34 IF(CTLIM.LT.0D0) THEN CTNMN4=CTLIM ELSE CTNMN4=0D0 CTPMN4=CTLIM ENDIF ENDIF C...5) due to limits on uhat CTNMN5=-1D0 CTNMX5=0D0 CTPMN5=0D0 CTPMX5=1D0 IF(CKIN(37).GT.0D0) THEN CTLIM=(2D0*CKIN(37)/SH-(1D0-RM3-RM4))/BE34 IF(CTLIM.LT.0D0) THEN CTNMN5=CTLIM ELSE CTNMN5=0D0 CTPMN5=CTLIM ENDIF ENDIF IF(CKIN(38).GT.0D0) THEN CTLIM=(2D0*CKIN(38)/SH-(1D0-RM3-RM4))/BE34 IF(CTLIM.GT.0D0) THEN CTPMX5=CTLIM ELSE CTPMX5=0D0 CTNMX5=CTLIM ENDIF ENDIF C...Net effect of all separate limits. VINT(13)=MAX(CTNMN0,CTNMN1,CTNMN2,CTNMN3,CTNMN4,CTNMN5) VINT(33)=MIN(CTNMX0,CTNMX1,CTNMX2,CTNMX3,CTNMX4,CTNMX5) VINT(14)=MAX(CTPMN0,CTPMN1,CTPMN2,CTPMN3,CTPMN4,CTPMN5) VINT(34)=MIN(CTPMX0,CTPMX1,CTPMX2,CTPMX3,CTPMX4,CTPMX5) IF(VINT(33).LE.VINT(13).AND.VINT(34).LE.VINT(14)) MINT(51)=1 ELSEIF(ILIM.EQ.4) THEN C...Calculate limits on tau' C...0) due to kinematics TAPMN0=TAU IF((ISTSB.EQ.5.OR.ISTSB.EQ.6).AND.KFPR(ISUB,2).GT.0) THEN PQRAT=2D0*PMAS(PYCOMP(KFPR(ISUB,2)),1)/VINT(1) TAPMN0=(SQRT(TAU)+PQRAT)**2 ENDIF TAPMX0=1D0 C...1) due to explicit limits TAPMN1=CKIN(31)**2/VINT(2) TAPMX1=1D0 IF(CKIN(32).GE.0D0) TAPMX1=CKIN(32)**2/VINT(2) C...Net effect of all separate limits. VINT(16)=MAX(TAPMN0,TAPMN1) VINT(36)=MIN(TAPMX0,TAPMX1) IF(MINT(47).EQ.1) THEN VINT(16)=0.99999D0 VINT(36)=1.00001D0 ENDIF IF(VINT(36).LE.VINT(16)) MINT(51)=1 ENDIF RETURN C...Special case for low-pT and multiple interactions: C...effective kinematical limits for tau, y*, cos(theta-hat). 110 IF(ILIM.EQ.0) THEN ELSEIF(ILIM.EQ.1) THEN IF(MSTP(82).LE.1) VINT(11)=4D0*PARP(81)**2/VINT(2) IF(MSTP(82).GE.2) VINT(11)=PARP(82)**2/VINT(2) VINT(31)=1D0 ELSEIF(ILIM.EQ.2) THEN VINT(12)=0.5D0*LOG(VINT(21)) VINT(32)=-VINT(12) ELSEIF(ILIM.EQ.3) THEN IF(MSTP(82).LE.1) ST2EFF=4D0*PARP(81)**2/(VINT(21)*VINT(2)) IF(MSTP(82).GE.2) ST2EFF=0.01D0*PARP(82)**2/(VINT(21)*VINT(2)) VINT(13)=-SQRT(MAX(0D0,1D0-ST2EFF)) VINT(33)=0D0 VINT(14)=0D0 VINT(34)=-VINT(13) ENDIF RETURN END C********************************************************************* C...PYKMAP C...Maps a uniform distribution into a distribution of a kinematical C...variable according to one of the possibilities allowed. It is C...assumed that kinematical limits have been set by a PYKLIM call. SUBROUTINE PYKMAP(IVAR,MVAR,VVAR) C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) 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/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) SAVE /PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/ C...Convert VVAR to tau variable. ISUB=MINT(1) ISTSB=ISET(ISUB) IF(IVAR.EQ.1) THEN TAUMIN=VINT(11) TAUMAX=VINT(31) IF(MVAR.EQ.3.OR.MVAR.EQ.4) THEN TAURE=VINT(73) GAMRE=VINT(74) ELSEIF(MVAR.EQ.5.OR.MVAR.EQ.6) THEN TAURE=VINT(75) GAMRE=VINT(76) ENDIF IF(MINT(47).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2.OR.ISTSB.EQ.6)) & THEN TAU=1D0 ELSEIF(MVAR.EQ.1) THEN TAU=TAUMIN*(TAUMAX/TAUMIN)**VVAR ELSEIF(MVAR.EQ.2) THEN TAU=TAUMAX*TAUMIN/(TAUMIN+(TAUMAX-TAUMIN)*VVAR) ELSEIF(MVAR.EQ.3.OR.MVAR.EQ.5) THEN RATGEN=(TAURE+TAUMAX)/(TAURE+TAUMIN)*TAUMIN/TAUMAX TAU=TAURE*TAUMIN/((TAURE+TAUMIN)*RATGEN**VVAR-TAUMIN) ELSEIF(MVAR.EQ.4.OR.MVAR.EQ.6) THEN AUPP=ATAN((TAUMAX-TAURE)/GAMRE) ALOW=ATAN((TAUMIN-TAURE)/GAMRE) TAU=TAURE+GAMRE*TAN(ALOW+(AUPP-ALOW)*VVAR) ELSE AUPP=LOG(MAX(2D-6,1D0-TAUMAX)) ALOW=LOG(MAX(2D-6,1D0-TAUMIN)) TAU=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) ENDIF VINT(21)=MIN(TAUMAX,MAX(TAUMIN,TAU)) C...Convert VVAR to y* variable. ELSEIF(IVAR.EQ.2) THEN YSTMIN=VINT(12) YSTMAX=VINT(32) TAUE=VINT(21) IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINT(26) IF(MINT(47).EQ.1) THEN YST=0D0 ELSEIF(MINT(47).EQ.2) THEN YST=-0.5D0*LOG(TAUE) ELSEIF(MINT(47).EQ.3) THEN YST=0.5D0*LOG(TAUE) ELSEIF(MVAR.EQ.1) THEN YST=YSTMIN+(YSTMAX-YSTMIN)*SQRT(VVAR) ELSEIF(MVAR.EQ.2) THEN YST=YSTMAX-(YSTMAX-YSTMIN)*SQRT(1D0-VVAR) ELSEIF(MVAR.EQ.3) THEN AUPP=ATAN(EXP(YSTMAX)) ALOW=ATAN(EXP(YSTMIN)) YST=LOG(TAN(ALOW+(AUPP-ALOW)*VVAR)) ELSEIF(MVAR.EQ.4) THEN YST0=-0.5D0*LOG(TAUE) AUPP=LOG(MAX(1D-6,EXP(YST0-YSTMIN)-1D0)) ALOW=LOG(MAX(1D-6,EXP(YST0-YSTMAX)-1D0)) YST=YST0-LOG(1D0+EXP(ALOW+VVAR*(AUPP-ALOW))) ELSE YST0=-0.5D0*LOG(TAUE) AUPP=LOG(MAX(1D-6,EXP(YST0+YSTMIN)-1D0)) ALOW=LOG(MAX(1D-6,EXP(YST0+YSTMAX)-1D0)) YST=LOG(1D0+EXP(AUPP+VVAR*(ALOW-AUPP)))-YST0 ENDIF VINT(22)=MIN(YSTMAX,MAX(YSTMIN,YST)) C...Convert VVAR to cos(theta-hat) variable. ELSEIF(IVAR.EQ.3) THEN RM34=MAX(1D-20,2D0*VINT(63)*VINT(64)/(VINT(21)*VINT(2))**2) RSQM=1D0+RM34 IF(2D0*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001D0) & RM34=MAX(RM34,2D0*VINT(71)**2/(VINT(21)*VINT(2))) CTNMIN=VINT(13) CTNMAX=VINT(33) CTPMIN=VINT(14) CTPMAX=VINT(34) IF(MVAR.EQ.1) THEN ANEG=CTNMAX-CTNMIN APOS=CTPMAX-CTPMIN IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN VCTN=VVAR*(ANEG+APOS)/ANEG CTH=CTNMIN+(CTNMAX-CTNMIN)*VCTN ELSE VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS CTH=CTPMIN+(CTPMAX-CTPMIN)*VCTP ENDIF ELSEIF(MVAR.EQ.2) THEN RMNMIN=MAX(RM34,RSQM-CTNMIN) RMNMAX=MAX(RM34,RSQM-CTNMAX) RMPMIN=MAX(RM34,RSQM-CTPMIN) RMPMAX=MAX(RM34,RSQM-CTPMAX) ANEG=LOG(RMNMIN/RMNMAX) APOS=LOG(RMPMIN/RMPMAX) IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN VCTN=VVAR*(ANEG+APOS)/ANEG CTH=RSQM-RMNMIN*(RMNMAX/RMNMIN)**VCTN ELSE VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS CTH=RSQM-RMPMIN*(RMPMAX/RMPMIN)**VCTP ENDIF ELSEIF(MVAR.EQ.3) THEN RMNMIN=MAX(RM34,RSQM+CTNMIN) RMNMAX=MAX(RM34,RSQM+CTNMAX) RMPMIN=MAX(RM34,RSQM+CTPMIN) RMPMAX=MAX(RM34,RSQM+CTPMAX) ANEG=LOG(RMNMAX/RMNMIN) APOS=LOG(RMPMAX/RMPMIN) IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN VCTN=VVAR*(ANEG+APOS)/ANEG CTH=RMNMIN*(RMNMAX/RMNMIN)**VCTN-RSQM ELSE VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS CTH=RMPMIN*(RMPMAX/RMPMIN)**VCTP-RSQM ENDIF ELSEIF(MVAR.EQ.4) THEN RMNMIN=MAX(RM34,RSQM-CTNMIN) RMNMAX=MAX(RM34,RSQM-CTNMAX) RMPMIN=MAX(RM34,RSQM-CTPMIN) RMPMAX=MAX(RM34,RSQM-CTPMAX) ANEG=1D0/RMNMAX-1D0/RMNMIN APOS=1D0/RMPMAX-1D0/RMPMIN IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN VCTN=VVAR*(ANEG+APOS)/ANEG CTH=RSQM-1D0/(1D0/RMNMIN+ANEG*VCTN) ELSE VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS CTH=RSQM-1D0/(1D0/RMPMIN+APOS*VCTP) ENDIF ELSEIF(MVAR.EQ.5) THEN RMNMIN=MAX(RM34,RSQM+CTNMIN) RMNMAX=MAX(RM34,RSQM+CTNMAX) RMPMIN=MAX(RM34,RSQM+CTPMIN) RMPMAX=MAX(RM34,RSQM+CTPMAX) ANEG=1D0/RMNMIN-1D0/RMNMAX APOS=1D0/RMPMIN-1D0/RMPMAX IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN VCTN=VVAR*(ANEG+APOS)/ANEG CTH=1D0/(1D0/RMNMIN-ANEG*VCTN)-RSQM ELSE VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS CTH=1D0/(1D0/RMPMIN-APOS*VCTP)-RSQM ENDIF ENDIF IF(CTH.LT.0D0) CTH=MIN(CTNMAX,MAX(CTNMIN,CTH)) IF(CTH.GT.0D0) CTH=MIN(CTPMAX,MAX(CTPMIN,CTH)) VINT(23)=CTH C...Convert VVAR to tau' variable. ELSEIF(IVAR.EQ.4) THEN TAU=VINT(21) TAUPMN=VINT(16) TAUPMX=VINT(36) IF(MINT(47).EQ.1) THEN TAUP=1D0 ELSEIF(MVAR.EQ.1) THEN TAUP=TAUPMN*(TAUPMX/TAUPMN)**VVAR ELSEIF(MVAR.EQ.2) THEN AUPP=(1D0-TAU/TAUPMX)**4 ALOW=(1D0-TAU/TAUPMN)**4 TAUP=TAU/MAX(1D-7,1D0-(ALOW+(AUPP-ALOW)*VVAR)**0.25D0) ELSE AUPP=LOG(MAX(2D-6,1D0-TAUPMX)) ALOW=LOG(MAX(2D-6,1D0-TAUPMN)) TAUP=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) ENDIF VINT(26)=MIN(TAUPMX,MAX(TAUPMN,TAUP)) C...Selection of extra variables needed in 2 -> 3 process: C...pT1, pT2, phi1, phi2, y3 for three outgoing particles. C...Since no options are available, the functions of PYKLIM C...and PYKMAP are joint for these choices. ELSEIF(IVAR.EQ.5) THEN C...Read out total energy and particle masses. MINT(51)=0 MPTPK=1 IF(ISUB.EQ.123.OR.ISUB.EQ.124.OR.ISUB.EQ.173.OR.ISUB.EQ.174 & .OR.ISUB.EQ.178.OR.ISUB.EQ.179) MPTPK=2 SHP=VINT(26)*VINT(2) SHPR=SQRT(SHP) PM1=VINT(201) PM2=VINT(206) PM3=SQRT(VINT(21))*VINT(1) IF(PM1+PM2+PM3.GT.0.9999D0*SHPR) THEN MINT(51)=1 RETURN ENDIF PMRS1=VINT(204)**2 PMRS2=VINT(209)**2 C...Specify coefficients of pT choice; upper and lower limits. IF(MPTPK.EQ.1) THEN HWT1=0.4D0 HWT2=0.4D0 ELSE HWT1=0.05D0 HWT2=0.05D0 ENDIF HWT3=1D0-HWT1-HWT2 PTSMX1=((SHP-PM1**2-(PM2+PM3)**2)**2-(2D0*PM1*(PM2+PM3))**2)/ & (4D0*SHP) IF(CKIN(52).GT.0D0) PTSMX1=MIN(PTSMX1,CKIN(52)**2) PTSMN1=CKIN(51)**2 PTSMX2=((SHP-PM2**2-(PM1+PM3)**2)**2-(2D0*PM2*(PM1+PM3))**2)/ & (4D0*SHP) IF(CKIN(54).GT.0D0) PTSMX2=MIN(PTSMX2,CKIN(54)**2) PTSMN2=CKIN(53)**2 C...Select transverse momenta according to C...dp_T^2 * (a + b/(M^2 + p_T^2) + c/(M^2 + p_T^2)^2). HMX=PMRS1+PTSMX1 HMN=PMRS1+PTSMN1 IF(HMX.LT.1.0001D0*HMN) THEN MINT(51)=1 RETURN ENDIF HDE=PTSMX1-PTSMN1 RPT=PYR(0) IF(RPT.LT.HWT1) THEN PTS1=PTSMN1+PYR(0)*HDE ELSEIF(RPT.LT.HWT1+HWT2) THEN PTS1=MAX(PTSMN1,HMN*(HMX/HMN)**PYR(0)-PMRS1) ELSE PTS1=MAX(PTSMN1,HMN*HMX/(HMN+PYR(0)*HDE)-PMRS1) ENDIF WTPTS1=HDE/(HWT1+HWT2*HDE/(LOG(HMX/HMN)*(PMRS1+PTS1))+ & HWT3*HMN*HMX/(PMRS1+PTS1)**2) HMX=PMRS2+PTSMX2 HMN=PMRS2+PTSMN2 IF(HMX.LT.1.0001D0*HMN) THEN MINT(51)=1 RETURN ENDIF HDE=PTSMX2-PTSMN2 RPT=PYR(0) IF(RPT.LT.HWT1) THEN PTS2=PTSMN2+PYR(0)*HDE ELSEIF(RPT.LT.HWT1+HWT2) THEN PTS2=MAX(PTSMN2,HMN*(HMX/HMN)**PYR(0)-PMRS2) ELSE PTS2=MAX(PTSMN2,HMN*HMX/(HMN+PYR(0)*HDE)-PMRS2) ENDIF WTPTS2=HDE/(HWT1+HWT2*HDE/(LOG(HMX/HMN)*(PMRS2+PTS2))+ & HWT3*HMN*HMX/(PMRS2+PTS2)**2) C...Select azimuthal angles and check pT choice. PHI1=PARU(2)*PYR(0) PHI2=PARU(2)*PYR(0) PHIR=PHI2-PHI1 PTS3=MAX(0D0,PTS1+PTS2+2D0*SQRT(PTS1*PTS2)*COS(PHIR)) IF(PTS3.LT.CKIN(55)**2.OR.(CKIN(56).GT.0D0.AND.PTS3.GT. & CKIN(56)**2)) THEN MINT(51)=1 RETURN ENDIF C...Calculate transverse masses and check phase space not closed. PMS1=PM1**2+PTS1 PMS2=PM2**2+PTS2 PMS3=PM3**2+PTS3 PMT1=SQRT(PMS1) PMT2=SQRT(PMS2) PMT3=SQRT(PMS3) PM12=(PMT1+PMT2)**2 IF(PMT1+PMT2+PMT3.GT.0.9999D0*SHPR) THEN MINT(51)=1 RETURN ENDIF C...Select rapidity for particle 3 and check phase space not closed. Y3MAX=LOG((SHP+PMS3-PM12+SQRT(MAX(0D0,(SHP-PMS3-PM12)**2- & 4D0*PMS3*PM12)))/(2D0*SHPR*PMT3)) IF(Y3MAX.LT.1D-6) THEN MINT(51)=1 RETURN ENDIF Y3=(2D0*PYR(0)-1D0)*0.999999D0*Y3MAX PZ3=PMT3*SINH(Y3) PE3=PMT3*COSH(Y3) C...Find momentum transfers in two mirror solutions (in 1-2 frame). PZ12=-PZ3 PE12=SHPR-PE3 PMS12=PE12**2-PZ12**2 SQL12=SQRT(MAX(0D0,(PMS12-PMS1-PMS2)**2-4D0*PMS1*PMS2)) IF(SQL12.LT.1D-6*SHP) THEN MINT(51)=1 RETURN ENDIF PMM1=PMS12+PMS1-PMS2 PMM2=PMS12+PMS2-PMS1 TFAC=-SHPR/(2D0*PMS12) T1P=TFAC*(PE12-PZ12)*(PMM1-SQL12) T1N=TFAC*(PE12-PZ12)*(PMM1+SQL12) T2P=TFAC*(PE12+PZ12)*(PMM2-SQL12) T2N=TFAC*(PE12+PZ12)*(PMM2+SQL12) C...Construct relative mirror weights and make choice. IF(MPTPK.EQ.1) THEN WTPU=1D0 WTNU=1D0 ELSE WTPU=1D0/((T1P-PMRS1)*(T2P-PMRS2))**2 WTNU=1D0/((T1N-PMRS1)*(T2N-PMRS2))**2 ENDIF WTP=WTPU/(WTPU+WTNU) WTN=WTNU/(WTPU+WTNU) EPS=1D0 IF(WTN.GT.PYR(0)) EPS=-1D0 C...Store result of variable choice and associated weights. VINT(202)=PTS1 VINT(207)=PTS2 VINT(203)=PHI1 VINT(208)=PHI2 VINT(205)=WTPTS1 VINT(210)=WTPTS2 VINT(211)=Y3 VINT(212)=Y3MAX VINT(213)=EPS IF(EPS.GT.0D0) THEN VINT(214)=1D0/WTP VINT(215)=T1P VINT(216)=T2P ELSE VINT(214)=1D0/WTN VINT(215)=T1N VINT(216)=T2N ENDIF VINT(217)=-0.5D0*TFAC*(PE12-PZ12)*(PMM2+EPS*SQL12) VINT(218)=-0.5D0*TFAC*(PE12+PZ12)*(PMM1+EPS*SQL12) VINT(219)=0.5D0*(PMS12-PTS3) VINT(220)=SQL12 ENDIF RETURN END C*********************************************************************** C...PYSIGH C...Differential matrix elements for all included subprocesses. C...Note that what is coded is (disregarding the COMFAC factor) C...1) for 2 -> 1 processes: s-hat/pi*d(sigma-hat), where, C...when d(sigma-hat) is given in the zero-width limit, the delta C...function in tau is replaced by a (modified) Breit-Wigner: C...1/pi*s*H_res/((s*tau-m_res^2)^2+H_res^2), C...where H_res = s-hat/m_res*Gamma_res(s-hat); C...2) for 2 -> 2 processes: (s-hat)**2/pi*d(sigma-hat)/d(t-hat); C...i.e., dimensionless quantities. C...3) for 2 -> 3 processes: abs(M)^2, where the total cross-section is C...Integral abs(M)^2/(2shat') * (prod_(i=1)^3 d^3p_i/((2pi)^3*2E_i)) * C...(2pi)^4 delta^4(P - sum p_i). C...COMFAC contains the factor pi/s (or equivalent) and C...the conversion factor from GeV^-2 to mb. SUBROUTINE PYSIGH(NCHN,SIGS) C...Double precision and integer declarations. IMPLICIT DOUBLE PRECISION(A-H, O-Z) INTEGER PYK,PYCHGE,PYCOMP C...Commonblocks. COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/PYDAT3/MDCY(500,3),MDME(4000,2),BRAT(4000),KFDP(4000,5) COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/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) SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/ C...Local arrays and complex variables. DIMENSION X(2),XPQ(-25:25),KFAC(2,-40:40),WDTP(0:100), &WDTE(0:100,0:5),HGZ(6,3),HL3(3),HR3(3),HL4(3),HR4(3) COMPLEX A004,A204,A114,A00U,A20U,A11U COMPLEX CIGTOT,CIZTOT,F0ALP,F1ALP,F2ALP,F0BET,F1BET,F2BET,FIF, &COULCK,COULCP,COULCD,COULCR,COULCS C...Reset number of channels and cross-section. NCHN=0 SIGS=0D0 C...Convert H' or A process into equivalent H one. ISUB=MINT(1) ISUBSV=ISUB 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 ENDIF C...Read kinematical variables and limits. ISTSB=ISET(ISUBSV) TAUMIN=VINT(11) YSTMIN=VINT(12) CTNMIN=VINT(13) CTPMIN=VINT(14) TAUPMN=VINT(16) TAU=VINT(21) YST=VINT(22) CTH=VINT(23) XT2=VINT(25) TAUP=VINT(26) TAUMAX=VINT(31) YSTMAX=VINT(32) CTNMAX=VINT(33) CTPMAX=VINT(34) TAUPMX=VINT(36) C...Derive kinematical quantities. TAUE=TAU IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP X(1)=SQRT(TAUE)*EXP(YST) X(2)=SQRT(TAUE)*EXP(-YST) IF(MINT(45).EQ.2.AND.ISTSB.GE.1) THEN IF(X(1).GT.0.9999D0) RETURN ELSEIF(MINT(45).EQ.3) THEN X(1)=MIN(0.9999989D0,X(1)) ENDIF IF(MINT(46).EQ.2.AND.ISTSB.GE.1) THEN IF(X(2).GT.0.9999D0) RETURN ELSEIF(MINT(46).EQ.3) THEN X(2)=MIN(0.9999989D0,X(2)) ENDIF SH=TAU*VINT(2) SQM3=VINT(63) SQM4=VINT(64) RM3=SQM3/SH RM4=SQM4/SH BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) RPTS=4D0*VINT(71)**2/SH BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) RM34=MAX(1D-20,2D0*RM3*RM4) RSQM=1D0+RM34 IF(2D0*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001D0) RM34=MAX(RM34, &2D0*VINT(71)**2/(VINT(21)*VINT(2))) RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) IF(ISTSB.EQ.0) THEN TH=VINT(45) UH=-0.5D0*SH*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) SQPTH=MAX(VINT(71)**2,0.25D0*SH*BE34**2*VINT(59)**2) ELSE TH=-0.5D0*SH*MAX(RTHM,1D0-RM3-RM4-BE34*CTH) UH=-0.5D0*SH*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) SQPTH=MAX(VINT(71)**2,0.25D0*SH*BE34**2*(1D0-CTH**2)) ENDIF SHR=SQRT(SH) SH2=SH**2 TH2=TH**2 UH2=UH**2 C...Choice of Q2 scale: hard, parton distributions, parton showers. IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN Q2=SH ELSEIF(MOD(ISTSB,2).EQ.0.OR.ISTSB.EQ.9) THEN IF(MSTP(32).EQ.1) THEN Q2=2D0*SH*TH*UH/(SH**2+TH**2+UH**2) ELSEIF(MSTP(32).EQ.2) THEN Q2=SQPTH+0.5D0*(SQM3+SQM4) ELSEIF(MSTP(32).EQ.3) THEN Q2=MIN(-TH,-UH) ELSEIF(MSTP(32).EQ.4) THEN Q2=SH ELSEIF(MSTP(32).EQ.5) THEN Q2=-TH ENDIF IF(ISTSB.EQ.9) Q2=SQPTH IF((ISTSB.EQ.9.AND.MSTP(82).GE.2).OR.(ISTSB.NE.9.AND. & MSTP(85).EQ.1)) Q2=Q2+PARP(82)**2 ENDIF Q2SF=Q2 IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN Q2SF=PMAS(23,1)**2 IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77.OR.ISUB.EQ.124) & Q2SF=PMAS(24,1)**2 IF(ISUB.EQ.121.OR.ISUB.EQ.122) THEN Q2SF=PMAS(PYCOMP(KFPR(ISUBSV,2)),1)**2 IF(MSTP(39).EQ.2) Q2SF=Q2SF+MAX(VINT(202),VINT(207)) IF(MSTP(39).EQ.3) Q2SF=SH IF(MSTP(39).EQ.4) Q2SF=VINT(26)*VINT(2) ENDIF ENDIF Q2PS=Q2SF Q2SF=Q2SF*PARP(34) IF(MSTP(68).GE.2.AND.MINT(47).EQ.5) Q2SF=VINT(2) IF(MSTP(22).GE.1.AND.(ISUB.EQ.10.OR.ISUB.EQ.83).AND. &(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN XBJ=X(2) IF(MINT(43).EQ.3) XBJ=X(1) IF(MSTP(22).EQ.1) THEN Q2PS=-TH ELSEIF(MSTP(22).EQ.2) THEN Q2PS=((1D0-XBJ)/XBJ)*(-TH) ELSEIF(MSTP(22).EQ.3) THEN Q2PS=SQRT((1D0-XBJ)/XBJ)*(-TH) ELSE Q2PS=(1D0-XBJ)*MAX(1D0,-LOG(XBJ))*(-TH) ENDIF ENDIF IF(MSTP(68).GE.1.AND.MINT(47).EQ.5) Q2PS=VINT(2) C...Store derived kinematical quantities. VINT(41)=X(1) VINT(42)=X(2) VINT(44)=SH VINT(43)=SQRT(SH) VINT(45)=TH VINT(46)=UH VINT(48)=SQPTH VINT(47)=SQRT(SQPTH) VINT(50)=TAUP*VINT(2) VINT(49)=SQRT(MAX(0D0,VINT(50))) VINT(52)=Q2 VINT(51)=SQRT(Q2) VINT(54)=Q2SF VINT(53)=SQRT(Q2SF) VINT(56)=Q2PS VINT(55)=SQRT(Q2PS) C...Calculate parton distributions. IF(ISTSB.LE.0) GOTO 160 IF(MINT(47).GE.2) THEN DO 110 I=3-MIN(2,MINT(45)),MIN(2,MINT(46)) XSF=X(I) IF(ISTSB.EQ.9) XSF=X(I)/VINT(142+I) MINT(105)=MINT(102+I) MINT(109)=MINT(106+I) IF(MSTP(57).LE.1) THEN CALL PYPDFU(MINT(10+I),XSF,Q2SF,XPQ) ELSE CALL PYPDFL(MINT(10+I),XSF,Q2SF,XPQ) ENDIF DO 100 KFL=-25,25 XSFX(I,KFL)=XPQ(KFL) 100 CONTINUE 110 CONTINUE ENDIF C...Calculate alpha_em, alpha_strong and K-factor. XW=PARU(102) XWV=XW IF(MSTP(8).GE.2.OR.(ISUB.GE.71.AND.ISUB.LE.77)) XW= &1D0-(PMAS(24,1)/PMAS(23,1))**2 XW1=1D0-XW XWC=1D0/(16D0*XW*XW1) AEM=PYALEM(Q2) IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) IF(MSTP(33).NE.3) AS=PYALPS(PARP(34)*Q2) FACK=1D0 FACA=1D0 IF(MSTP(33).EQ.1) THEN FACK=PARP(31) ELSEIF(MSTP(33).EQ.2) THEN FACK=PARP(31) FACA=PARP(32)/PARP(31) ELSEIF(MSTP(33).EQ.3) THEN Q2AS=PARP(33)*Q2 IF(ISTSB.EQ.9.AND.MSTP(82).GE.2) Q2AS=Q2AS+ & PARU(112)*PARP(82) AS=PYALPS(Q2AS) ENDIF VINT(138)=1D0 VINT(57)=AEM VINT(58)=AS C...Set flags for allowed reacting partons/leptons. DO 140 I=1,2 DO 120 J=-25,25 KFAC(I,J)=0 120 CONTINUE IF(MINT(44+I).EQ.1) THEN KFAC(I,MINT(10+I))=1 ELSEIF(MINT(40+I).EQ.1.AND.MSTP(12).EQ.0) THEN KFAC(I,MINT(10+I))=1 KFAC(I,22)=1 KFAC(I,24)=1 KFAC(I,-24)=1 ELSE DO 130 J=-25,25 KFAC(I,J)=KFIN(I,J) IF(IABS(J).GT.MSTP(58).AND.IABS(J).LE.10) KFAC(I,J)=0 IF(XSFX(I,J).LT.1D-10) KFAC(I,J)=0 130 CONTINUE ENDIF 140 CONTINUE C...Lower and upper limit for fermion flavour loops. MMIN1=0 MMAX1=0 MMIN2=0 MMAX2=0 DO 150 J=-20,20 IF(KFAC(1,-J).EQ.1) MMIN1=-J IF(KFAC(1,J).EQ.1) MMAX1=J IF(KFAC(2,-J).EQ.1) MMIN2=-J IF(KFAC(2,J).EQ.1) MMAX2=J 150 CONTINUE MMINA=MIN(MMIN1,MMIN2) MMAXA=MAX(MMAX1,MMAX2) C...Common resonance mass and width combinations. SQMZ=PMAS(23,1)**2 SQMW=PMAS(24,1)**2 SQMH=PMAS(KFHIGG,1)**2 GMMZ=PMAS(23,1)*PMAS(23,2) GMMW=PMAS(24,1)*PMAS(24,2) GMMH=PMAS(KFHIGG,1)*PMAS(KFHIGG,2) C...Phase space integral in tau. COMFAC=PARU(1)*PARU(5)/VINT(2) IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) COMFAC=COMFAC*FACK IF((MINT(47).GE.2.OR.(ISTSB.GE.3.AND.ISTSB.LE.5)).AND. &ISTSB.NE.9) THEN ATAU1=LOG(TAUMAX/TAUMIN) ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/TAU IF(MINT(72).GE.1) THEN TAUR1=VINT(73) GAMR1=VINT(74) ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1)) ATAU3=ATAUD/TAUR1 IF(ATAUD.GT.1D-6) H1=H1+ & (ATAU1/ATAU3)*COEF(ISUBSV,3)/(TAU+TAUR1) ATAUD=ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1) ATAU4=ATAUD/GAMR1 IF(ATAUD.GT.1D-6) H1=H1+ & (ATAU1/ATAU4)*COEF(ISUBSV,4)*TAU/((TAU-TAUR1)**2+GAMR1**2) ENDIF IF(MINT(72).EQ.2) THEN TAUR2=VINT(75) GAMR2=VINT(76) ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2)) ATAU5=ATAUD/TAUR2 IF(ATAUD.GT.1D-6) H1=H1+ & (ATAU1/ATAU5)*COEF(ISUBSV,5)/(TAU+TAUR2) ATAUD=ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2) ATAU6=ATAUD/GAMR2 IF(ATAUD.GT.1D-6) H1=H1+ & (ATAU1/ATAU6)*COEF(ISUBSV,6)*TAU/((TAU-TAUR2)**2+GAMR2**2) ENDIF IF(MINT(47).EQ.5.AND.(ISTSB.LE.2.OR.ISTSB.GE.6)) THEN ATAU7=LOG(MAX(2D-6,1D0-TAUMIN)/MAX(2D-6,1D0-TAUMAX)) IF(ATAU7.GT.1D-6) H1=H1+(ATAU1/ATAU7)*COEF(ISUBSV,7)*TAU/ & MAX(2D-6,1D0-TAU) ENDIF COMFAC=COMFAC*ATAU1/(TAU*H1) ENDIF C...Phase space integral in y*. IF(MINT(47).GE.4.AND.ISTSB.NE.9) THEN AYST0=YSTMAX-YSTMIN IF(AYST0.LT.1D-6) THEN COMFAC=0D0 ELSE AYST1=0.5D0*(YSTMAX-YSTMIN)**2 AYST2=AYST1 AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+ & (AYST0/AYST2)*COEF(ISUBSV,9)*(YSTMAX-YST)+ & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST) IF(MINT(45).EQ.3) THEN YST0=-0.5D0*LOG(TAUE) AYST4=LOG(MAX(1D-6,EXP(YST0-YSTMIN)-1D0)/ & MAX(1D-6,EXP(YST0-YSTMAX)-1D0)) IF(AYST4.GT.1D-6) H2=H2+(AYST0/AYST4)*COEF(ISUBSV,11)/ & MAX(1D-6,1D0-EXP(YST-YST0)) ENDIF IF(MINT(46).EQ.3) THEN YST0=-0.5D0*LOG(TAUE) AYST5=LOG(MAX(1D-6,EXP(YST0+YSTMAX)-1D0)/ & MAX(1D-6,EXP(YST0+YSTMIN)-1D0)) IF(AYST5.GT.1D-6) H2=H2+(AYST0/AYST5)*COEF(ISUBSV,12)/ & MAX(1D-6,1D0-EXP(-YST-YST0)) ENDIF COMFAC=COMFAC*AYST0/H2 ENDIF ENDIF C...2 -> 1 processes: reduction in angular part of phase space integral C...for case of decaying resonance. ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN IF((ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5)) THEN IF(MDCY(PYCOMP(KFPR(ISUBSV,1)),1).EQ.1) THEN IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37.OR. & KFPR(ISUB,1).EQ.39) THEN COMFAC=COMFAC*0.5D0*ACTH0 ELSE COMFAC=COMFAC*0.125D0*(3D0*ACTH0+CTNMAX**3-CTNMIN**3+ & CTPMAX**3-CTPMIN**3) ENDIF ENDIF C...2 -> 2 processes: angular part of phase space integral. ELSEIF(ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6) THEN ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/ & (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX))) ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/ & (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN))) ACTH3=1D0/MAX(RM34,RSQM-CTNMAX)-1D0/MAX(RM34,RSQM-CTNMIN)+ & 1D0/MAX(RM34,RSQM-CTPMAX)-1D0/MAX(RM34,RSQM-CTPMIN) ACTH4=1D0/MAX(RM34,RSQM+CTNMIN)-1D0/MAX(RM34,RSQM+CTNMAX)+ & 1D0/MAX(RM34,RSQM+CTPMIN)-1D0/MAX(RM34,RSQM+CTPMAX) H3=COEF(ISUBSV,13)+ & (ACTH0/ACTH1)*COEF(ISUBSV,14)/MAX(RM34,RSQM-CTH)+ & (ACTH0/ACTH2)*COEF(ISUBSV,15)/MAX(RM34,RSQM+CTH)+ & (ACTH0/ACTH3)*COEF(ISUBSV,16)/MAX(RM34,RSQM-CTH)**2+ & (ACTH0/ACTH4)*COEF(ISUBSV,17)/MAX(RM34,RSQM+CTH)**2 COMFAC=COMFAC*ACTH0*0.5D0*BE34/H3 C...2 -> 2 processes: take into account final state Breit-Wigners. COMFAC=COMFAC*VINT(80) ENDIF C...2 -> 3, 4 processes: phace space integral in tau'. IF(MINT(47).GE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5) THEN ATAUP1=LOG(TAUPMX/TAUPMN) ATAUP2=((1D0-TAU/TAUPMX)**4-(1D0-TAU/TAUPMN)**4)/(4D0*TAU) H4=COEF(ISUBSV,18)+ & (ATAUP1/ATAUP2)*COEF(ISUBSV,19)*(1D0-TAU/TAUP)**3/TAUP IF(MINT(47).EQ.5) THEN ATAUP3=LOG(MAX(2D-6,1D0-TAUPMN)/MAX(2D-6,1D0-TAUPMX)) H4=H4+(ATAUP1/ATAUP3)*COEF(ISUBSV,20)*TAUP/MAX(2D-6,1D0-TAUP) ENDIF COMFAC=COMFAC*ATAUP1/H4 ENDIF C...2 -> 3, 4 processes: effective W/Z parton distributions. IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) THEN IF(1D0-TAU/TAUP.GT.1.D-4) THEN FZW=(1D0+TAU/TAUP)*LOG(TAUP/TAU)-2D0*(1D0-TAU/TAUP) ELSE FZW=1D0/6D0*(1D0-TAU/TAUP)**3*TAU/TAUP ENDIF COMFAC=COMFAC*FZW ENDIF C...2 -> 3 processes: phase space integrals for pT1, pT2, y3, mirror. IF(ISTSB.EQ.5) THEN COMFAC=COMFAC*VINT(205)*VINT(210)*VINT(212)*VINT(214)/ & (128D0*PARU(1)**4*VINT(220))*(TAU**2/TAUP) ENDIF C...2 -> 2 processes: optional dampening by pT^4/(pT0^2+pT^2)^2. IF(MSTP(85).EQ.1.AND.MOD(ISTSB,2).EQ.0) COMFAC=COMFAC* &SQPTH**2/(PARP(82)**2+SQPTH)**2 C...gamma + gamma: include factor 2 when different nature. IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4) &COMFAC=2D0*COMFAC C...Phase space integral for low-pT and multiple interactions. IF(ISTSB.EQ.9) THEN COMFAC=PARU(1)*PARU(5)*FACK*0.5D0*VINT(2)/SH2 ATAU1=LOG(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0) ATAU2=2D0*ATAN(1D0/XT2-1D0)/SQRT(XT2) H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/SQRT(TAU) COMFAC=COMFAC*ATAU1/H1 AYST0=YSTMAX-YSTMIN AYST1=0.5D0*(YSTMAX-YSTMIN)**2 AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+ & (AYST0/AYST1)*COEF(ISUBSV,9)*(YSTMAX-YST)+ & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST) COMFAC=COMFAC*AYST0/H2 IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1D0/VINT(149)-1D0) C...For MSTP(82)>=2 an additional factor (xT2/(xT2+VINT(149))**2 is C...introduced to make cross-section finite for xT2 -> 0. IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)* & (1D0+VINT(149))) ENDIF C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron. IF((MSTP(46).GE.3.AND.MSTP(46).LE.6).AND.(ISUB.EQ.71.OR.ISUB.EQ. &72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR.ISUB.EQ.77)) THEN C...Calculate M_R and N_R functions for Higgs-like and QCD-like models. IF(MSTP(46).LE.4) THEN HDTLH=LOG(PMAS(25,1)/PARP(44)) HDTMR=(4.5D0*PARU(1)/SQRT(3D0)-74D0/9D0)/8D0+HDTLH/12D0 HDTNR=-1D0/18D0+HDTLH/6D0 ELSE HDTNM=0.125D0*(1D0/(288D0*PARU(1)**2)+(PARP(47)/PARP(45))**2) HDTLQ=LOG(PARP(45)/PARP(44)) HDTMR=-(4D0*PARU(1))**2*0.5D0*HDTNM+HDTLQ/12D0 HDTNR=(4D0*PARU(1))**2*HDTNM+HDTLQ/6D0 ENDIF C...Calculate lowest and next-to-lowest order partial wave amplitudes. HDTV=1D0/(16D0*PARU(1)*PARP(47)**2) A00L=HDTV*SH A20L=-0.5D0*A00L A11L=A00L/6D0 HDTLS=LOG(SH/PARP(44)**2) A004=(HDTV*SH)**2/(4D0*PARU(1))*CMPLX((176D0*HDTMR+ & 112D0*HDTNR)/3D0+11D0/27D0-(50D0/9D0)*HDTLS,4D0*PARU(1)) A204=(HDTV*SH)**2/(4D0*PARU(1))*CMPLX(32D0*(HDTMR+ & 2D0*HDTNR)/3D0+25D0/54D0-(20D0/9D0)*HDTLS,PARU(1)) A114=(HDTV*SH)**2/(6D0*PARU(1))*CMPLX(4D0*(-2D0*HDTMR+HDTNR)- & 1D0/18D0,PARU(1)/6D0) C...Unitarize partial wave amplitudes with Pade or K-matrix method. IF(MSTP(46).EQ.3.OR.MSTP(46).EQ.5) THEN A00U=A00L/(1D0-A004/A00L) A20U=A20L/(1D0-A204/A20L) A11U=A11L/(1D0-A114/A11L) ELSE A00U=(A00L+REAL(A004))/(1D0-CMPLX(0D0,A00L+REAL(A004))) A20U=(A20L+REAL(A204))/(1D0-CMPLX(0D0,A20L+REAL(A204))) A11U=(A11L+REAL(A114))/(1D0-CMPLX(0D0,A11L+REAL(A114))) ENDIF ENDIF C...A: 2 -> 1, tree diagrams. 160 IF(ISUB.LE.10) THEN IF(ISUB.EQ.1) THEN C...f + fbar -> gamma*/Z0. MINT(61)=2 CALL PYWIDT(23,SH,WDTP,WDTE) HS=SHR*WDTP(0) FACZ=4D0*COMFAC*3D0 HP0=AEM/3D0*SH HP1=AEM/3D0*XWC*SH DO 170 I=MMINA,MMAXA IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 170 EI=KCHG(IABS(I),1)/3D0 AI=SIGN(1D0,EI) VI=AI-4D0*EI*XWV HI0=HP0 IF(IABS(I).LE.10) HI0=HI0*FACA/3D0 HI1=HP1 IF(IABS(I).LE.10) HI1=HI1*FACA/3D0 NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=-I ISIG(NCHN,3)=1 SIGH(NCHN)=FACZ*(EI**2/SH2*HI0*HP0*VINT(111)+ & EI*VI*(1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)* & (HI0*HP1+HI1*HP0)*VINT(112)+(VI**2+AI**2)/ & ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)) 170 CONTINUE ELSEIF(ISUB.EQ.2) THEN C...f + fbar' -> W+/-. CALL PYWIDT(24,SH,WDTP,WDTE) HS=SHR*WDTP(0) FACBW=4D0*COMFAC/((SH-SQMW)**2+HS**2)*3D0 HP=AEM/(24D0*XW)*SH DO 190 I=MMIN1,MMAX1 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 190 IA=IABS(I) DO 180 J=MMIN2,MMAX2 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 180 JA=IABS(J) IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 180 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) & GOTO 180 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 HI=HP*2D0 IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=J ISIG(NCHN,3)=1 HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) SIGH(NCHN)=HI*FACBW*HF 180 CONTINUE 190 CONTINUE ELSEIF(ISUB.EQ.3) THEN C...f + fbar -> h0 (or H0, or A0). CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) HS=SHR*WDTP(0) FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) IF(ABS(SH-SQMH).GT.100D0*HS) FACBW=0D0 HP=AEM/(8D0*XW)*SH/SQMW*SH HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) DO 200 I=MMINA,MMAXA IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 200 IA=IABS(I) RMQ=PMAS(IA,1)**2/SH HI=HP*RMQ IF(IA.LE.10) HI=HP*RMQ*FACA/3D0 IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) HI=HI* & (LOG(MAX(4D0,PARP(37)**2*RMQ*SH/PARU(117)**2))/ & LOG(MAX(4D0,SH/PARU(117)**2)))**(24D0/(33D0-2D0*MSTU(118))) IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN IKFI=1 IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 IF(IA.GT.10) IKFI=3 HI=HI*PARU(150+10*IHIGG+IKFI)**2 ENDIF NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=-I ISIG(NCHN,3)=1 SIGH(NCHN)=HI*FACBW*HF 200 CONTINUE ELSEIF(ISUB.EQ.4) THEN C...gamma + W+/- -> W+/-. ELSEIF(ISUB.EQ.5) THEN C...Z0 + Z0 -> h0. CALL PYWIDT(25,SH,WDTP,WDTE) HS=SHR*WDTP(0) FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) IF(ABS(SH-SQMH).GT.100D0*HS) FACBW=0D0 HP=AEM/(8D0*XW)*SH/SQMW*SH HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) HI=HP/4D0 FACI=8D0/(PARU(1)**2*XW1)*(AEM*XWC)**2 DO 220 I=MMIN1,MMAX1 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 220 DO 210 J=MMIN2,MMAX2 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 210 EI=KCHG(IABS(I),1)/3D0 AI=SIGN(1D0,EI) VI=AI-4D0*EI*XWV EJ=KCHG(IABS(J),1)/3D0 AJ=SIGN(1D0,EJ) VJ=AJ-4D0*EJ*XWV NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=J ISIG(NCHN,3)=1 SIGH(NCHN)=FACI*(VI**2+AI**2)*(VJ**2+AJ**2)*HI*FACBW*HF 210 CONTINUE 220 CONTINUE 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. CALL PYWIDT(25,SH,WDTP,WDTE) HS=SHR*WDTP(0) FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) IF(ABS(SH-SQMH).GT.100D0*HS) FACBW=0D0 HP=AEM/(8D0*XW)*SH/SQMW*SH HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) HI=HP/2D0 FACI=1D0/(4D0*PARU(1)**2)*(AEM/XW)**2 DO 240 I=MMIN1,MMAX1 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240 EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) DO 230 J=MMIN2,MMAX2 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230 EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) IF(EI*EJ.GT.0D0) GOTO 230 NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=J ISIG(NCHN,3)=1 SIGH(NCHN)=FACI*VINT(180+I)*VINT(180+J)*HI*FACBW*HF 230 CONTINUE 240 CONTINUE C...B: 2 -> 2, tree diagrams. ELSEIF(ISUB.EQ.10) THEN C...f + f' -> f + f' (gamma/Z/W exchange). FACGGF=COMFAC*AEM**2*2D0*(SH2+UH2)/TH2 FACGZF=COMFAC*AEM**2*XWC*4D0*SH2/(TH*(TH-SQMZ)) FACZZF=COMFAC*(AEM*XWC)**2*2D0*SH2/(TH-SQMZ)**2 FACWWF=COMFAC*(0.5D0*AEM/XW)**2*SH2/(TH-SQMW)**2 DO 260 I=MMIN1,MMAX1 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 260 IA=IABS(I) DO 250 J=MMIN2,MMAX2 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 250 JA=IABS(J) C...Electroweak couplings. EI=KCHG(IA,1)*ISIGN(1,I)/3D0 AI=SIGN(1D0,KCHG(IA,1)+0.5D0)*ISIGN(1,I) VI=AI-4D0*EI*XWV EJ=KCHG(JA,1)*ISIGN(1,J)/3D0 AJ=SIGN(1D0,KCHG(JA,1)+0.5D0)*ISIGN(1,J) VJ=AJ-4D0*EJ*XWV EPSIJ=ISIGN(1,I*J) C...gamma/Z exchange, only gamma exchange, or only Z exchange. IF(MSTP(21).GE.1.AND.MSTP(21).LE.4) THEN IF(MSTP(21).EQ.1.OR.MSTP(21).EQ.4) THEN FACNCF=FACGGF*EI**2*EJ**2+FACGZF*EI*EJ* & (VI*VJ*(1D0+UH2/SH2)+AI*AJ*EPSIJ*(1D0-UH2/SH2))+ & FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*(1D0+UH2/SH2)+ & 4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2)) ELSEIF(MSTP(21).EQ.2) THEN FACNCF=FACGGF*EI**2*EJ**2 ELSE FACNCF=FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)* & (1D0+UH2/SH2)+4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2)) ENDIF NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=J ISIG(NCHN,3)=1 SIGH(NCHN)=FACNCF ENDIF C...W exchange. IF((MSTP(21).EQ.1.OR.MSTP(21).EQ.5).AND.AI*AJ.LT.0D0) THEN FACCCF=FACWWF*VINT(180+I)*VINT(180+J) IF(EPSIJ.LT.0D0) FACCCF=FACCCF*UH2/SH2 IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACCCF=2D0*FACCCF IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACCCF=2D0*FACCCF NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=J ISIG(NCHN,3)=2 SIGH(NCHN)=FACCCF ENDIF 250 CONTINUE 260 CONTINUE ENDIF ELSEIF(ISUB.LE.20) THEN IF(ISUB.EQ.11) THEN C...f + f' -> f + f' (g exchange). FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)/TH2 FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)/TH2*FACA- & MSTP(34)*2D0/3D0*UH2/(SH*TH)) FACQQ2=COMFAC*AS**2*4D0/9D0*((SH2+TH2)/UH2- & MSTP(34)*2D0/3D0*SH2/(TH*UH)) IF(MSTP(5).GE.1) THEN C...Modifications from contact interactions (compositeness). FACCI1=FACQQ1+COMFAC*(SH2/PARU(155)**4) FACCIB=FACQQB+COMFAC*(8D0/9D0)*(AS*PARU(156)/PARU(155)**2)* & (UH2/TH+UH2/SH)+COMFAC*(5D0/3D0)*(UH2/PARU(155)**4) FACCI2=FACQQ2+COMFAC*(8D0/9D0)*(AS*PARU(156)/PARU(155)**2)* & (SH2/TH+SH2/UH)+COMFAC*(5D0/3D0)*(SH2/PARU(155)**4) FACCI3=FACQQ1+COMFAC*(UH2/PARU(155)**4) ENDIF DO 280 I=MMIN1,MMAX1 IA=IABS(I) IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 280 DO 270 J=MMIN2,MMAX2 JA=IABS(J) IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 270 NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=J ISIG(NCHN,3)=1 IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.(IA.GE.3.OR.JA.GE.3))) & THEN SIGH(NCHN)=FACQQ1 IF(I.EQ.-J) SIGH(NCHN)=FACQQB ELSE SIGH(NCHN)=FACCI1 IF(I*J.LT.0) SIGH(NCHN)=FACCI3 IF(I.EQ.-J) SIGH(NCHN)=FACCIB ENDIF IF(I.EQ.J) THEN SIGH(NCHN)=0.5D0*SIGH(NCHN) NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=J ISIG(NCHN,3)=2 IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.IA.GE.3)) THEN SIGH(NCHN)=0.5D0*FACQQ2 ELSE SIGH(NCHN)=0.5D0*FACCI2 ENDIF ENDIF 270 CONTINUE 280 CONTINUE ELSEIF(ISUB.EQ.12) THEN C...f + fbar -> f' + fbar' (q + qbar -> q' + qbar' only). CALL PYWIDT(21,SH,WDTP,WDTE) FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+ & WDTE(0,4)) IF(MSTP(5).EQ.1) THEN C...Modifications from contact interactions (compositeness). FACCIB=FACQQB DO 290 I=1,2 FACCIB=FACCIB+COMFAC*(UH2/PARU(155)**4)*(WDTE(I,1)+ & WDTE(I,2)+WDTE(I,4)) 290 CONTINUE ELSEIF(MSTP(5).GE.2) THEN FACCIB=FACQQB+COMFAC*(UH2/PARU(155)**4)*(WDTE(0,1)+WDTE(0,2)+ & WDTE(0,4)) ENDIF DO 300 I=MMINA,MMAXA IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 300 NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=-I ISIG(NCHN,3)=1 IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.IABS(I).GE.3)) THEN SIGH(NCHN)=FACQQB ELSE SIGH(NCHN)=FACCIB ENDIF 300 CONTINUE ELSEIF(ISUB.EQ.13) THEN C...f + fbar -> g + g (q + qbar -> g + g only). FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* & UH2/SH2) FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* & TH2/SH2) DO 310 I=MMINA,MMAXA IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310 NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=-I ISIG(NCHN,3)=1 SIGH(NCHN)=0.5D0*FACGG1 NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=-I ISIG(NCHN,3)=2 SIGH(NCHN)=0.5D0*FACGG2 310 CONTINUE ELSEIF(ISUB.EQ.14) THEN C...f + fbar -> g + gamma (q + qbar -> g + gamma only). FACGG=COMFAC*AS*AEM*8D0/9D0*(TH2+UH2)/(TH*UH) DO 320 I=MMINA,MMAXA IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320 EI=KCHG(IABS(I),1)/3D0 NCHN=NCHN+1 ISIG(NCHN,1)=I ISIG(NCHN,2)=-I ISIG(NCHN,3)=1 SIGH(NCHN)=FACGG*EI**2 320 CONTINUE ELSEIF(ISUB.EQ.15) THEN C...f + fbar -> g + (gamma*/Z0) (q + qbar -> g + (gamma*/Z0) only). FACZG=COMFAC*AS*AEM*(8D0/9D0)*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) C...gamma, gamma/Z interference and Z couplin