42368 lines
1.4 MiB
Plaintext
42368 lines
1.4 MiB
Plaintext
C*********************************************************************
|
|
C*********************************************************************
|
|
C* **
|
|
C* March 1997 **
|
|
C* **
|
|
C* The Lund Monte Carlo for Hadronic Processes **
|
|
C* **
|
|
C* PYTHIA version 6.1 **
|
|
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* SUSY parts by **
|
|
C* Stephen Mrenna **
|
|
C* Argonne National Laboratory **
|
|
C* 9700 South Cass Avenue, Argonne, IL 60439, USA **
|
|
C* phone + 1 - 630 - 252 - 7615 **
|
|
C* E-mail mrenna@hep.anl.gov **
|
|
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* GRV 94 parton distributions are by Glueck, Reya and Vogt **
|
|
C* SaS photon parton distributions together with Gerhard Schuler **
|
|
C* g + g and q + qbar -> t + tbar + H code by Zoltan Kunszt **
|
|
C* MSSM Higgs mass calculation code by M. Carena, **
|
|
C* J.R. Espinosa, M. Quiros and C.E.M. Wagner **
|
|
C* PYGAUS adapted from CERN library (K.S. Kolbig) **
|
|
C* **
|
|
C* The latest program version and documentation is found on WWW **
|
|
C* http://thep.lu.se/tf2/staff/torbjorn/Pythia.html **
|
|
C* **
|
|
C* Copyright Torbjorn Sjostrand, Lund 1997 **
|
|
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 PYRECO to handle colour reconnection in W+W- events *
|
|
C S PYKLIM to calculate borders of allowed kinematical region *
|
|
C S PYKMAP to construct value of kinematical variable *
|
|
C S PYSIGH to calculate differential cross-sections *
|
|
C S PYPDFU to evaluate parton distributions *
|
|
C S PYPDFL to evaluate parton distributions at low x and Q^2 *
|
|
C S PYPDEL to evaluate electron parton distributions *
|
|
C S PYPDGA to evaluate photon parton distributions (generic) *
|
|
C S PYGGAM to evaluate photon parton distributions (SaS sets) *
|
|
C S PYGVMD to evaluate VMD part of photon parton distributions *
|
|
C S PYGANO to evaluate anomalous part of photon pdf's *
|
|
C S PYGBEH to evaluate Bethe-Heitler part of photon pdf's *
|
|
C S PYGDIR to evaluate direct contribution to photon pdf's *
|
|
C S PYPDPI to evaluate pion parton distributions *
|
|
C S PYPDPR to evaluate proton parton distributions *
|
|
C F PYCTEQ to evaluate the CTEQ 3 proton parton distributions *
|
|
C S PYGRVL to evaluate the GRV 94L pronton parton distributions *
|
|
C S PYGRVM to evaluate the GRV 94M pronton parton distributions *
|
|
C S PYGRVD to evaluate the GRV 94D pronton parton distributions *
|
|
C F PYGRVV auxiliary to the PYGRV* routines *
|
|
C F PYGRVW auxiliary to the PYGRV* routines *
|
|
C F PYGRVS auxiliary to the PYGRV* routines *
|
|
C F PYHFTH to evaluate threshold factor for heavy flavour *
|
|
C S PYSPLI to find flavours left in hadron when one removed *
|
|
C F PYGAMM to evaluate ordinary Gamma function Gamma(x) *
|
|
C S PYWAUX to evaluate auxiliary functions W1(s) and W2(s) *
|
|
C S PYI3AU to evaluate auxiliary function I3(s,t,u,v) *
|
|
C F PYSPEN to evaluate Spence (dilogarithm) function Sp(x) *
|
|
C S PYQQBH to evaluate matrix element for g + g -> Q + Qbar + H *
|
|
C *
|
|
C S PYMSIN to initialize the supersymmetry simulation *
|
|
C S PYAPPS to determine MSSM parameters from SUGRA input *
|
|
C F PYRNMQ to determine running quark masses *
|
|
C F PYRNMT to determine running top mass *
|
|
C S PYTHRG to calculate sfermion third-gen. mass eigenstates *
|
|
C S PYINOM to calculate neutralino/chargino mass eigenstates *
|
|
C F PYRNM3 to determine running M3, gluino mass *
|
|
C S PYEIG4 to calculate eigenvalues and -vectors in 4*4 matrix *
|
|
C S PYHGGM to determine Higgs mass spectrum *
|
|
C S PYSUBH to determine Higgs masses in the MSSM *
|
|
C S PYPOLE to determine Higgs masses in the MSSM *
|
|
C S PYVACU to determine Higgs masses in the MSSM *
|
|
C S PYRGHM auxiliary to PYVACU *
|
|
C S PYGFXX auxiliary to PYRGHM *
|
|
C F PYFINT auxiliary to PYVACU *
|
|
C F PYFISB auxiliary to PYFINT *
|
|
C S PYSFDC to calculate sfermion decay partial widths *
|
|
C S PYGLUI to calculate gluino decay partial widths *
|
|
C S PYTBBN to calculate 3-body decay of gluino to neutralino *
|
|
C S PYTBBC to calculate 3-body decay of gluino to chargino *
|
|
C S PYNJDC to calculate neutralino decay partial widths *
|
|
C S PYCJDC to calculate chargino decay partial widths *
|
|
C F PYXXZ5 auxiliary for neutralino 3-body decay *
|
|
C F PYXXW5 auxiliary for ino charge change 3-body decay *
|
|
C F PYXXGA auxiliary for ino -> ino + gamma decay *
|
|
C F PYX2XG auxiliary for ino -> ino + gauge boson decay *
|
|
C F PYX2XH auxiliary for ino -> ino + Higgs decay *
|
|
C F PYXXZ2 auxiliary for chargino 3-body decay *
|
|
C S PYHEXT to calculate non-SM Higgs decay partial widths *
|
|
C F PYH2XX auxiliary for H -> ino + ino decay *
|
|
C F PYGAUS to perform Gaussian integration *
|
|
C F PYSIMP to perform Simpson integration *
|
|
C F PYLAMF to evaluate the lambda kinematics function *
|
|
C S PYTBDY to perform 3-body decay of gauginos *
|
|
C *
|
|
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 PYBOOK to book a histogram *
|
|
C S PYFILL to fill an entry in a histogram *
|
|
C S PYFACT to multiply histogram contents by a factor *
|
|
C S PYOPER to perform operations between histograms *
|
|
C S PYHIST to print and reset all histograms *
|
|
C S PYPLOT to print a single histogram *
|
|
C S PYNULL to reset contents of a single histogram *
|
|
C S PYDUMP to dump histogram contents onto a file *
|
|
C *
|
|
C S PYKCUT dummy routine for user kinematical cuts *
|
|
C S PYEVWT dummy routine for weighting events *
|
|
C S 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/MRPY(6),RRPY(100)
|
|
COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
|
|
COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYINT1/MINT(400),VINT(400)
|
|
COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
|
|
COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
|
|
COMMON/PYINT4/MWID(500),WIDS(500,5)
|
|
COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
|
|
COMMON/PYINT6/PROC(0:500)
|
|
CHARACTER PROC*28
|
|
COMMON/PYINT7/SIGT(0:6,0:6,0:5)
|
|
COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/,/PYSUBS/,
|
|
&/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,
|
|
&/PYINT6/,/PYINT7/,/PYMSSM/,/PYSSMT/,/PYBINS/
|
|
|
|
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 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
|
2 1, 5, 3, 5, 0, 0, 0, 0, 0, 0,
|
|
& 80*0/
|
|
DATA PARU/
|
|
& 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, 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,12*0,3,2*0,3,28*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,
|
|
&11*0,1,2*0,1,26*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,
|
|
&100443,100553,1000001,1000002,1000003,1000004,1000005,1000006,
|
|
&1000011,1000012,1000013,1000014,1000015,1000016,1000021,1000022,
|
|
&1000023,1000024,1000025,1000035,1000037,1000039,2000001,2000002,
|
|
&2000003,2000004,2000005,2000006,2000011,2000012,2000013,2000014,
|
|
&2000015,2000016,4000001,4000002,4000011,4000012,163*0/
|
|
DATA (PMAS(I,1),I= 1, 214)/0.0099D0,0.0056D0,0.199D0,1.35D0,
|
|
&5D0,175D0,2*400D0,2*0D0,0.00051D0,0D0,0.10566D0,0D0,1.777D0,0D0,
|
|
&400D0,5*0D0,91.187D0,80.33D0,80D0,6*0D0,500D0,900D0,500D0,
|
|
&3*300D0,350D0,200D0,5000D0,10*0D0,3*100D0,3*200D0,26*0D0,1D0,2D0,
|
|
&5D0,16*0D0,0.13498D0,0.7685D0,1.318D0,0.49767D0,0D0,0.13957D0,
|
|
&0.7669D0,1.318D0,0D0,0.54745D0,0.78194D0,1.275D0,2*0.49767D0,
|
|
&0.8961D0,1.432D0,0.4936D0,0.8916D0,1.425D0,0D0,0.95777D0,
|
|
&1.0194D0,1.525D0,1.8693D0,2.01D0,2.46D0,1.8645D0,2.0067D0,2.46D0,
|
|
&1.9685D0,2.1124D0,2.5735D0,0D0,2.9798D0,3.09688D0,3.5562D0,
|
|
&5.2792D0,5.3248D0,5.83D0,5.2789D0,5.3248D0,5.83D0,5.3693D0,
|
|
&5.4163D0,6.07D0,6.594D0,6.602D0,7.35D0,9.4D0,9.4603D0,9.9132D0,
|
|
&0.77133D0,1.234D0,0.57933D0,0.77133D0,0D0,0.93957D0,1.233D0,
|
|
&0.77133D0,0D0,0.93827D0,1.232D0,1.231D0,0.80473D0,0.92953D0,
|
|
&1.19744D0,1.3872D0,1.11568D0,0.80473D0,0.92953D0,1.19255D0,
|
|
&1.3837D0,1.18937D0,1.3828D0,1.09361D0,1.3213D0,1.535D0,1.3149D0,
|
|
&1.5318D0,1.67245D0,1.96908D0,2.00808D0,2.4521D0,2.5D0,2.2849D0,
|
|
&2.4703D0,1.96908D0,2.00808D0,2.4535D0,2.5D0,2.4529D0,2.5D0,
|
|
&2.4656D0,2.15432D0,2.17967D0,2.55D0,2.63D0,2.55D0,2.63D0,2.704D0,
|
|
&2.8D0,3.27531D0,3.59798D0,3.65648D0,3.59798D0,3.65648D0,
|
|
&3.78663D0,3.82466D0,4.91594D0,5.38897D0,5.40145D0,5.8D0,5.81D0/
|
|
DATA (PMAS(I,1),I= 215, 500)/5.641D0,5.84D0,7.00575D0,5.38897D0,
|
|
&5.40145D0,5.8D0,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.9835D0,1.231D0,0.9835D0,
|
|
&1.231D0,1D0,1.17D0,1.429D0,1.29D0,1.429D0,1.29D0,2*1.4D0,2.272D0,
|
|
&2.424D0,2.272D0,2.424D0,2.5D0,2.536D0,3.4151D0,3.46D0,5.68D0,
|
|
&5.73D0,5.68D0,5.73D0,5.92D0,5.97D0,7.25D0,7.3D0,9.8598D0,9.875D0,
|
|
&2*1.23D0,1.282D0,2*1.402D0,1.427D0,2*2.372D0,2.56D0,3.5106D0,
|
|
&2*5.78D0,6.02D0,7.3D0,9.8919D0,3.686D0,10.0233D0,32*500D0,
|
|
&4*400D0,163*0D0/
|
|
DATA (PMAS(I,2),I= 1, 500)/5*0D0,1.4D0,16*0D0,2.47833D0,
|
|
&2.069D0,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.107D0,3*0D0,0.149D0,0.107D0,2*0D0,0.00843D0,0.185D0,
|
|
&2*0D0,0.0505D0,0.109D0,0D0,0.0498D0,0.098D0,0D0,0.0002D0,
|
|
&0.00443D0,0.076D0,2*0D0,0.023D0,2*0D0,0.023D0,2*0D0,0.015D0,0D0,
|
|
&0.0013D0,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.06D0,0.142D0,0.06D0,0.142D0,0D0,0.36D0,0.287D0,0.09D0,
|
|
&0.287D0,0.09D0,0.25D0,0.08D0,0.05D0,0.02D0,0.05D0,0.02D0,0.05D0,
|
|
&0D0,0.014D0,0.01D0,8*0.05D0,0D0,0.01D0,2*0.4D0,0.025D0,2*0.174D0,
|
|
&0.053D0,3*0.05D0,0.0009D0,4*0.05D0,3*0D0,19*1D0,0D0,7*1D0,0D0,
|
|
&1D0,0D0,1D0,0D0,2.60511D0,2.60839D0,0.42904D0,0.41921D0,163*0D0/
|
|
DATA (PMAS(I,3),I= 1, 500)/5*0D0,14D0,16*0D0,24.78326D0,
|
|
&20.69D0,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,19*10D0,0.00001D0,7*10D0,0.00001D0,10D0,0.00001D0,10D0,
|
|
&0.00001D0,26.05109D0,26.08388D0,4.29043D0,4.19206D0,163*0D0/
|
|
DATA (PMAS(I,4),I= 1, 500)/12*0D0,658654D0,0D0,0.0872D0,68*0D0,
|
|
&0.1D0,0.387D0,16*0D0,0.00003D0,2*0D0,15500D0,0D0,7804.5D0,6*0D0,
|
|
&26.762D0,3*0D0,3709D0,6*0D0,0.317D0,2*0D0,0.1244D0,2*0D0,0.14D0,
|
|
&6*0D0,0.468D0,2*0D0,0.462D0,2*0D0,0.483D0,2*0D0,0.15D0,19*0D0,
|
|
&44.34D0,0D0,78.88D0,4*0D0,23.96D0,2*0D0,49.1D0,0D0,87.1D0,0D0,
|
|
&24.6D0,4*0D0,0.0618D0,0.029D0,6*0D0,0.106D0,6*0D0,0.019D0,2*0D0,
|
|
&7*0.1D0,4*0D0,0.342D0,2*0.387D0,6*0D0,2*0.387D0,6*0D0,0.387D0,
|
|
&0D0,0.387D0,2*0D0,8*0.387D0,0D0,9*0.387D0,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)/
|
|
& 0.95113D0, 0.04884D0, 0.00003D0, 0.00000D0,
|
|
& 0.04884D0, 0.94940D0, 0.00176D0, 0.00000D0,
|
|
& 0.00003D0, 0.00176D0, 0.99821D0, 0.00000D0,
|
|
& 0.00000D0, 0.00000D0, 0.00000D0, 1.00000D0/
|
|
|
|
C...PYDAT3, with particle decay parameters and data.
|
|
DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0,
|
|
&7*1,10*0,2*1,0,3*1,26*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,75*1,0,7*1,0,1,0,
|
|
&1,0,4*1,163*0/
|
|
DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,54,64,2*0,74,78,80,
|
|
&85,87,141,143,148,2*0,151,160,172,188,208,6*0,287,0,309,332,414,
|
|
&494,521,524,525,10*0,534,539,0,544,564,588,26*0,606,607,611,16*0,
|
|
&620,622,627,636,0,645,647,649,0,656,664,670,679,681,683,686,696,
|
|
&702,705,0,716,722,733,739,802,805,813,874,876,884,917,919,0,923,
|
|
&924,927,929,965,966,974,1010,1011,1019,1058,1059,1063,1094,1095,
|
|
&1099,1100,1109,0,1111,4*0,1112,3*0,1115,1118,2*0,1119,1121,1124,
|
|
&2*0,1128,1129,1132,1135,0,1138,1143,1145,1148,1150,2*0,1154,1155,
|
|
&1156,1232,2*0,1236,1237,1238,1239,1240,2*0,1244,1245,1247,1248,
|
|
&1250,1254,0,1255,1259,1263,1267,1271,1275,1279,2*0,1283,1284,
|
|
&1285,1302,1311,2*0,1320,1321,1322,1323,1324,1333,2*0,1342,1343,
|
|
&1344,1345,1346,1355,1356,2*0,1365,1374,1383,1392,1401,1410,1419,
|
|
&1428,0,1437,1446,1455,1464,1473,1482,1491,1500,1509,1518,1519,
|
|
&1520,1521,1522,1527,1530,1532,1537,1539,1544,1551,1555,1557,1559,
|
|
&1561,1563,1565,1567,1569,1570,1572,1574,1576,1578,1580,1582,1584,
|
|
&1586,1588,1589,1591,1593,1607,1609,1611,1615,1617,1619,1621,1623,
|
|
&1625,1627,1629,1631,1633,1644,1658,1670,1682,1694,1706,1718,1731,
|
|
&1742,1753,1764,1775,1786,1797,1858,1863,1965,2021,2139,2273,0,
|
|
&2344,2360,2376,2392,2408,2424,2440,0,2455,0,2470,0,2485,2489,
|
|
&2493,2496,163*0/
|
|
DATA (MDCY(I,3),I= 1, 500)/5*8,13,2*10,2*0,4,2,5,2,54,2,5,3,
|
|
&2*0,9,12,16,20,79,6*0,22,0,23,82,80,27,3,1,9,10*0,2*5,0,20,24,18,
|
|
&26*0,1,4,9,16*0,2,5,2*9,0,2*2,7,0,8,6,9,2*2,3,10,6,3,11,0,6,11,6,
|
|
&63,3,8,61,2,8,33,2,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,5,2,3,2,4,2*0,2*1,76,4,2*0,
|
|
&4*1,4,2*0,1,2,1,2,4,1,0,7*4,2*0,2*1,17,2*9,2*0,4*1,2*9,2*0,4*1,9,
|
|
&1,9,2*0,8*9,0,9*9,4*1,5,3,2,5,2,5,7,4,7*2,1,9*2,1,2*2,14,2*2,4,
|
|
&9*2,11,14,5*12,13,6*11,61,5,102,56,118,134,71,0,6*16,15,0,15,0,
|
|
&15,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,12*1,2*-1,8*1,2*-1,73*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,85*1,2*-1,
|
|
&6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,197*1,2*-1,2*1,-1,20*1,
|
|
&2*-1,6*1,2*-1,7*1,-1,3*1,-1,3*1,5*-1,3*1,-1,1,-1,6*1,2*-1,6*1,
|
|
&2*-1,1892*1,1503*0/
|
|
DATA (MDME(I,2),I= 1,4000)/43*102,4*0,102,0,4*53,3*102,4*0,102,
|
|
&2*0,3*102,4*0,102,2*0,6*102,42,6*102,2*42,2*0,8*41,2*0,36*41,
|
|
&8*102,0,102,0,102,2*0,21*102,8*32,8*0,16*32,21*0,62*53,8*32,14*0,
|
|
&16*32,27*0,62*53,18*0,62*53,9*0,18*53,3*32,0,6*32,3*0,2*32,3*0,
|
|
&2*32,7*0,8*32,12*0,16*32,6*0,8*32,8*0,12,2*42,2*11,9*42,0,2,3,
|
|
&15*0,4*42,5*0,3,12*0,2,3*0,1,0,3,16*0,2*3,15*0,2*42,2*3,18*0,2*3,
|
|
&3*0,1,11*0,22*42,41*0,2*3,9*0,16*42,45*0,3,10*0,10*42,20*0,2*13,
|
|
&6*0,12,2*0,12,0,12,14*42,16*0,48,3*13,2*42,9*0,14*42,16*0,48,
|
|
&3*13,2*42,9*0,14*42,19*0,48,3*13,2*42,6*0,2*11,28*42,5*0,32,3*0,
|
|
&4*32,2*4,0,32,45*0,14*42,52*0,10*13,2*42,2*11,4*0,2*42,2*11,6*0,
|
|
&2*42,2*11,0,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,
|
|
&2*42,2*11,2*42,2*11,2*0,3*42,8*0,48,3*13,20*42,4*0,18*42,4*0,
|
|
&9*42,0,162*42,50*0,2*12,17*0,2*32,33*0,12,9*0,32,2*0,12,11*0,
|
|
&4*32,2*4,5*0,828*53,1515*0/
|
|
DATA (BRAT(I) ,I= 1, 418)/43*0D0,0.00003D0,0.00177D0,0.9982D0,
|
|
&33*0D0,1D0,6*0D0,0.1783D0,0.1735D0,0.1131D0,0.2494D0,0.003D0,
|
|
&0.09D0,0.0027D0,0.01D0,0.0014D0,0.0012D0,2*0.00025D0,0.0071D0,
|
|
&0.012D0,0.0004D0,0.00075D0,0.00006D0,2*0.00078D0,0.0034D0,0.08D0,
|
|
&0.011D0,0.0191D0,0.00006D0,0.005D0,0.0133D0,0.0067D0,0.0005D0,
|
|
&0.0035D0,0.0006D0,0.0015D0,0.00021D0,0.0002D0,0.00075D0,0.0001D0,
|
|
&0.0002D0,0.0011D0,3*0.0002D0,0.00022D0,0.0004D0,0.0001D0,
|
|
&2*0.00205D0,2*0.00069D0,0.00025D0,0.00051D0,0.00025D0,35*0D0,
|
|
&0.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,62*0D0,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,66*0D0,0.00008D0,0.00167D0/
|
|
DATA (BRAT(I) ,I= 419, 722)/5*0D0,0.00013D0,0D0,0.00294D0,
|
|
&0.00001D0,3*0D0,0.99517D0,63*0D0,0.00002D0,0.07231D0,2*0D0,
|
|
&0.00001D0,0.00269D0,0D0,0.92497D0,18*0D0,0.0024D0,0.99483D0,
|
|
&0.00278D0,1D0,3*0.21511D0,0.21478D0,2*0D0,2*0.06995D0,2*0D0,1D0,
|
|
&3*0D0,0.95D0,0.05D0,3*0D0,4*0.25D0,16*0D0,4*0.25D0,20*0D0,1D0,
|
|
&17*0D0,1D0,2*0.08D0,0.76D0,0.08D0,2*0.105D0,0.04D0,0.5D0,0.08D0,
|
|
&0.14D0,0.01D0,0.015D0,0.005D0,0.988D0,0.012D0,0.998739D0,
|
|
&0.00079D0,0.00038D0,0.000046D0,0.000045D0,2*0.34725D0,0.144D0,
|
|
&0.104D0,0.0245D0,2*0.01225D0,0.0028D0,0.0057D0,0.2112D0,0.1256D0,
|
|
&2*0.1939D0,2*0.1359D0,0.002D0,0.001D0,0.0006D0,0.999877D0,
|
|
&0.000123D0,0.99955D0,0.00045D0,2*0.34725D0,0.144D0,0.104D0,
|
|
&0.049D0,0.0028D0,0.0057D0,0.3923D0,0.321D0,0.2317D0,0.0478D0,
|
|
&0.0049D0,0.0013D0,0.0003D0,0.0007D0,0.89D0,0.08693D0,0.0221D0,
|
|
&0.00083D0,2*0.00007D0,0.564D0,0.282D0,0.072D0,0.028D0,0.023D0,
|
|
&2*0.0115D0,0.005D0,0.003D0,0.6861D0,0.3139D0,2*0.5D0,0.665D0,
|
|
&0.333D0,0.002D0,0.333D0,0.166D0,0.168D0,0.084D0,0.087D0,0.043D0,
|
|
&0.059D0,2*0.029D0,0.002D0,0.6352D0,0.2116D0,0.0559D0,0.0173D0,
|
|
&0.0482D0,0.0318D0,0.666D0,0.333D0,0.001D0,0.332D0,0.166D0,
|
|
&0.168D0,0.084D0,0.086D0,0.043D0,0.059D0,2*0.029D0,2*0.002D0,
|
|
&0.437D0,0.208D0,0.302D0,0.0302D0,0.0212D0,0.0016D0,0.48947D0/
|
|
DATA (BRAT(I) ,I= 723, 897)/0.34D0,3*0.043D0,0.027D0,0.0126D0,
|
|
&0.0013D0,0.0003D0,0.00025D0,0.00008D0,0.444D0,2*0.222D0,0.104D0,
|
|
&2*0.004D0,0.07D0,0.065D0,2*0.005D0,2*0.011D0,5*0.001D0,0.07D0,
|
|
&0.065D0,2*0.005D0,2*0.011D0,5*0.001D0,0.026D0,0.019D0,0.066D0,
|
|
&0.041D0,0.045D0,0.076D0,0.0073D0,2*0.0047D0,0.026D0,0.001D0,
|
|
&0.0006D0,0.0066D0,0.005D0,2*0.003D0,2*0.0006D0,2*0.001D0,0.006D0,
|
|
&0.005D0,0.012D0,0.0057D0,0.067D0,0.008D0,0.0022D0,0.027D0,
|
|
&0.004D0,0.019D0,0.012D0,0.002D0,0.009D0,0.0218D0,0.001D0,0.022D0,
|
|
&0.087D0,0.001D0,0.0019D0,0.0015D0,0.0028D0,0.683D0,0.306D0,
|
|
&0.011D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,
|
|
&0.034D0,0.027D0,2*0.002D0,2*0.004D0,2*0.002D0,0.034D0,0.027D0,
|
|
&2*0.002D0,2*0.004D0,2*0.002D0,0.0365D0,0.045D0,0.073D0,0.062D0,
|
|
&3*0.021D0,0.0061D0,0.015D0,0.025D0,0.0088D0,0.074D0,0.0109D0,
|
|
&0.0041D0,0.002D0,0.0035D0,0.0011D0,0.001D0,0.0027D0,2*0.0016D0,
|
|
&0.0018D0,0.011D0,0.0063D0,0.0052D0,0.018D0,0.016D0,0.0034D0,
|
|
&0.0036D0,0.0009D0,0.0006D0,0.015D0,0.0923D0,0.018D0,0.022D0,
|
|
&0.0077D0,0.009D0,0.0075D0,0.024D0,0.0085D0,0.067D0,0.0511D0,
|
|
&0.017D0,0.0004D0,0.0028D0,0.619D0,0.381D0,0.3D0,0.15D0,0.16D0,
|
|
&0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.01D0,2*0.02D0,0.03D0,
|
|
&2*0.005D0,2*0.02D0,0.03D0,2*0.005D0,0.015D0,0.037D0,0.028D0/
|
|
DATA (BRAT(I) ,I= 898,1063)/0.079D0,0.095D0,0.052D0,0.0078D0,
|
|
&4*0.001D0,0.028D0,0.033D0,0.026D0,0.05D0,0.01D0,4*0.005D0,0.25D0,
|
|
&0.0952D0,0.94D0,0.06D0,2*0.4D0,2*0.1D0,1D0,0.0602D0,0.0601D0,
|
|
&0.8797D0,0.135D0,0.865D0,0.02D0,0.055D0,2*0.005D0,0.008D0,
|
|
&0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,
|
|
&0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,
|
|
&0.0185D0,0.0135D0,0.025D0,0.0004D0,0.0007D0,0.0008D0,0.0014D0,
|
|
&0.0019D0,0.0025D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,
|
|
&1D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,
|
|
&0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0,
|
|
&2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0,
|
|
&0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0,0.0135D0,
|
|
&0.025D0,0.0004D0,0.0007D0,0.0008D0,0.0014D0,0.0019D0,0.0025D0,
|
|
&0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0,
|
|
&0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.02D0,0.055D0,
|
|
&2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0,
|
|
&0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0,
|
|
&0.018D0,0.015D0,0.0185D0,0.0135D0,0.025D0,2*0.0002D0,0.0007D0,
|
|
&2*0.0004D0,0.0014D0,0.001D0,0.0009D0,0.0025D0,0.4291D0,0.08D0,
|
|
&0.07D0,0.02D0,0.015D0,0.005D0,1D0,2*0.3D0,2*0.2D0,0.047D0/
|
|
DATA (BRAT(I) ,I=1064,1254)/0.122D0,0.006D0,0.012D0,0.035D0,
|
|
&0.012D0,0.035D0,0.003D0,0.007D0,0.15D0,0.037D0,0.008D0,0.002D0,
|
|
&0.05D0,0.015D0,0.003D0,0.001D0,0.014D0,0.042D0,0.014D0,0.042D0,
|
|
&0.24D0,0.065D0,0.012D0,0.003D0,0.001D0,0.002D0,0.001D0,0.002D0,
|
|
&0.014D0,0.003D0,1D0,2*0.3D0,2*0.2D0,1D0,0.0252D0,0.0248D0,
|
|
&0.0267D0,0.015D0,0.045D0,0.015D0,0.045D0,0.7743D0,0.029D0,0.22D0,
|
|
&0.78D0,1D0,0.331D0,0.663D0,0.006D0,0.663D0,0.331D0,0.006D0,1D0,
|
|
&0.999D0,0.001D0,0.88D0,2*0.06D0,0.639D0,0.358D0,0.002D0,0.001D0,
|
|
&1D0,0.88D0,2*0.06D0,0.516D0,0.483D0,0.001D0,0.88D0,2*0.06D0,
|
|
&0.9988D0,0.0001D0,0.0006D0,0.0004D0,0.0001D0,0.667D0,0.333D0,
|
|
&0.9954D0,0.0011D0,0.0035D0,0.333D0,0.667D0,0.676D0,0.234D0,
|
|
&0.085D0,0.005D0,2*1D0,0.018D0,2*0.005D0,0.003D0,0.002D0,
|
|
&2*0.006D0,0.018D0,2*0.005D0,0.003D0,0.002D0,2*0.006D0,0.0066D0,
|
|
&0.025D0,0.016D0,0.0088D0,2*0.005D0,0.0058D0,0.005D0,0.0055D0,
|
|
&4*0.004D0,2*0.002D0,2*0.004D0,0.003D0,0.002D0,2*0.003D0,
|
|
&3*0.002D0,2*0.001D0,0.002D0,2*0.001D0,2*0.002D0,0.0013D0,
|
|
&0.0018D0,5*0.001D0,4*0.003D0,2*0.005D0,2*0.002D0,2*0.001D0,
|
|
&2*0.002D0,2*0.001D0,0.2432D0,0.057D0,2*0.035D0,0.15D0,2*0.075D0,
|
|
&0.03D0,2*0.015D0,2*0.08D0,0.76D0,0.08D0,4*1D0,2*0.08D0,0.76D0,
|
|
&0.08D0,1D0,2*0.5D0,1D0,2*0.5D0,2*0.08D0,0.76D0,0.08D0,1D0/
|
|
DATA (BRAT(I) ,I=1255,1447)/2*0.08D0,0.76D0,3*0.08D0,0.76D0,
|
|
&3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,
|
|
&3*0.08D0,0.76D0,0.08D0,2*1D0,2*0.105D0,0.04D0,0.0077D0,0.02D0,
|
|
&0.0235D0,0.0285D0,0.0435D0,0.0011D0,0.0022D0,0.0044D0,0.4291D0,
|
|
&0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,
|
|
&0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,
|
|
&0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,4*1D0,2*0.105D0,0.04D0,
|
|
&0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0,
|
|
&0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,4*1D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,1D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
|
|
&0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0/
|
|
DATA (BRAT(I) ,I=1448,1648)/0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
|
|
&0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
|
|
&0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
|
|
&0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
|
|
&0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
|
|
&0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
|
|
&0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
|
|
&0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
|
|
&0.015D0,0.005D0,4*1D0,0.52D0,0.26D0,0.11D0,2*0.055D0,0.333D0,
|
|
&0.334D0,0.333D0,0.667D0,0.333D0,0.28D0,0.14D0,0.313D0,0.157D0,
|
|
&0.11D0,0.667D0,0.333D0,0.28D0,0.14D0,0.313D0,0.157D0,0.11D0,
|
|
&0.36D0,0.18D0,0.03D0,2*0.015D0,2*0.2D0,4*0.25D0,0.667D0,0.333D0,
|
|
&0.667D0,0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,4*0.5D0,0.007D0,
|
|
&0.993D0,1D0,0.667D0,0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,
|
|
&0.667D0,0.333D0,8*0.5D0,0.02D0,0.98D0,1D0,4*0.5D0,3*0.146D0,
|
|
&3*0.05D0,0.15D0,2*0.05D0,4*0.024D0,0.066D0,0.667D0,0.333D0,
|
|
&0.667D0,0.333D0,4*0.25D0,0.667D0,0.333D0,0.667D0,0.333D0,2*0.5D0,
|
|
&0.273D0,0.727D0,0.667D0,0.333D0,0.667D0,0.333D0,4*0.5D0,0.35D0,
|
|
&0.65D0,2*0.0083D0,0.1866D0,0.324D0,0.184D0,0.027D0,0.001D0,
|
|
&0.093D0,0.087D0,0.078D0,0.0028D0,3*0.014D0,0.008D0,0.024D0/
|
|
DATA (BRAT(I) ,I=1649,4000)/0.008D0,0.024D0,0.425D0,0.02D0,
|
|
&0.185D0,0.088D0,0.043D0,0.067D0,0.066D0,827*0D0,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,
|
|
&1503*0D0/
|
|
DATA (KFDP(I,1),I= 1, 375)/21,22,23,4*-24,25,21,22,23,4*24,25,
|
|
&21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23,
|
|
&4*24,25,37,1000022,1000023,1000025,1000035,21,22,23,4*-24,25,
|
|
&2*-37,21,22,23,4*24,25,2*37,22,23,-24,25,23,24,-12,22,23,-24,25,
|
|
&23,24,-12,-14,48*16,22,23,-24,25,23,24,22,23,-24,25,-37,23,24,37,
|
|
&1,2,3,4,5,6,7,8,21,1,2,3,4,5,6,7,8,11,13,15,17,1,2,3,4,5,6,7,8,
|
|
&11,12,13,14,15,16,17,18,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,1,2,
|
|
&3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,1000022,2*1000023,
|
|
&3*1000025,4*1000035,2*1000024,2*1000037,1000001,2000001,1000001,
|
|
&-1000001,1000002,2000002,1000002,-1000002,1000003,2000003,
|
|
&1000003,-1000003,1000004,2000004,1000004,-1000004,1000005,
|
|
&2000005,1000005,-1000005,1000006,2000006,1000006,-1000006,
|
|
&1000011,2000011,1000011,-1000011,1000012,2000012,1000012,
|
|
&-1000012,1000013,2000013,1000013,-1000013,1000014,2000014,
|
|
&1000014,-1000014,1000015,2000015,1000015,-1000015,1000016,
|
|
&2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,
|
|
&24,37,2*23,25,35,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,3*24,1,2,3,
|
|
&4,5,6,7,8,11,13,15,17,21,2*22,23,24,23,25,36,1000022,2*1000023,
|
|
&3*1000025,4*1000035,2*1000024,2*1000037,1000001,2000001,1000001,
|
|
&-1000001,1000002,2000002,1000002,-1000002,1000003,2000003/
|
|
DATA (KFDP(I,1),I= 376, 606)/1000003,-1000003,1000004,2000004,
|
|
&1000004,-1000004,1000005,2000005,1000005,-1000005,1000006,
|
|
&2000006,1000006,-1000006,1000011,2000011,1000011,-1000011,
|
|
&1000012,2000012,1000012,-1000012,1000013,2000013,1000013,
|
|
&-1000013,1000014,2000014,1000014,-1000014,1000015,2000015,
|
|
&1000015,-1000015,1000016,2000016,1000016,-1000016,1,2,3,4,5,6,7,
|
|
&8,11,13,15,17,21,2*22,23,24,23,1000022,2*1000023,3*1000025,
|
|
&4*1000035,2*1000024,2*1000037,1000001,2000001,1000001,-1000001,
|
|
&1000002,2000002,1000002,-1000002,1000003,2000003,1000003,
|
|
&-1000003,1000004,2000004,1000004,-1000004,1000005,2000005,
|
|
&1000005,-1000005,1000006,2000006,1000006,-1000006,1000011,
|
|
&2000011,1000011,-1000011,1000012,2000012,1000012,-1000012,
|
|
&1000013,2000013,1000013,-1000013,1000014,2000014,1000014,
|
|
&-1000014,1000015,2000015,1000015,-1000015,1000016,2000016,
|
|
&1000016,-1000016,-1,-3,-5,-7,-11,-13,-15,-17,24,2*1000022,
|
|
&2*1000023,2*1000025,2*1000035,1000006,2000006,1000006,2000006,
|
|
&-1000001,-1000003,-1000011,-1000013,-1000015,-2000015,5,6,21,2,1,
|
|
&2,3,4,5,6,11,13,15,4,5,11,13,15,2*4,-11,-13,-15,2*24,2*52,1,2,3,
|
|
&4,5,6,7,8,11,12,13,14,15,16,17,18,2*24,2*52,4*-1,4*-3,4*-5,4*-7,
|
|
&-11,-13,-15,-17,22,23,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,82/
|
|
DATA (KFDP(I,1),I= 607,1001)/-11,-13,2*2,-12,-14,-16,2*-2,2*-4,
|
|
&-2,-4,2*22,211,111,221,13,11,213,-213,221,223,321,130,310,111,
|
|
&331,111,211,-12,12,-14,14,211,111,22,-13,-11,2*211,213,113,221,
|
|
&223,321,211,331,22,111,211,2*22,211,22,111,211,22,211,221,111,11,
|
|
&211,111,2*211,321,130,310,221,111,211,111,130,310,321,2*311,321,
|
|
&311,323,313,323,313,321,3*311,-13,3*211,12,14,311,2*321,311,321,
|
|
&313,323,313,323,311,4*321,211,111,3*22,111,321,130,-213,113,213,
|
|
&211,22,111,11,13,211,321,130,310,221,211,111,11*-11,11*-13,-311,
|
|
&-313,-311,-313,-20313,2*-311,-313,-311,-313,2*111,2*221,2*331,
|
|
&2*113,2*223,2*333,-311,-313,2*-321,211,-311,-321,333,-311,-313,
|
|
&-321,211,2*-321,2*-311,-321,211,113,421,2*411,421,411,423,413,
|
|
&423,413,421,411,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311,
|
|
&-313,2*-311,-321,-10323,-321,-323,-321,-311,2*-313,211,111,333,
|
|
&3*-321,-311,-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211,
|
|
&-321,3*-311,211,113,321,2*421,411,421,413,423,413,423,411,421,
|
|
&-15,5*-11,5*-13,221,331,333,221,331,333,10221,211,213,211,213,
|
|
&321,323,321,323,2212,221,331,333,221,2*2,2*431,421,411,423,413,
|
|
&82,11,13,82,443,82,6*12,6*14,2*16,3*-411,3*-413,2*-411,2*-413,
|
|
&2*441,2*443,2*20443,2*2,2*4,2,4,511,521,511,523,513,523,513,521,
|
|
&511,6*12,6*14,2*16,3*-421,3*-423,2*-421,2*-423,2*441,2*443/
|
|
DATA (KFDP(I,1),I=1002,1428)/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,3112,-12,-14,-12,
|
|
&3322,3312,2*3122,3212,3322,3312,3122,3322,3312,-12,2*4122,7*-11,
|
|
&7*-13,2*2224,2*2212,2*2214,2*3122,2*3212,2*3214,5*3222,4*3224,
|
|
&2*3322,3324,2*2224,7*2212,5*2214,2*2112,2*2114,2*3122,2*3212,
|
|
&2*3214,2*3222,2*3224,4*2,3,2*2,1,2*2,-11,-13,2*2,4*4122,-11,-13,
|
|
&2*2,3*4132,3*4232,-11,-13,2*2,4332,-11,-13,2*2,-11,-13,2*2,-11,
|
|
&-13,2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,2*5122,
|
|
&-12,-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4,-12,-14,-16,
|
|
&2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,4*5122,-12,-14,-16,
|
|
&2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,2*5132,2*5232,-12,
|
|
&-14,-16,2*-2,2*-4,-2,-4,5332,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,
|
|
&-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,
|
|
&2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,
|
|
&-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12/
|
|
DATA (KFDP(I,1),I=1429,1710)/-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,2*211,313,-313,
|
|
&323,-323,421,411,423,413,411,421,413,423,411,421,423,413,443,
|
|
&2*82,521,511,523,513,511,521,513,523,521,511,523,513,511,521,513,
|
|
&523,553,2*21,213,-213,113,213,10211,10111,-10211,2*221,213,2*113,
|
|
&-213,2*321,2*311,113,323,2*313,323,313,-313,323,-323,423,2*413,
|
|
&2*423,413,443,82,523,2*513,2*523,2*513,523,553,21,11,13,82,4*443,
|
|
&10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553,10551,20553,555,
|
|
&1000039,-1000024,-1000037,1000022,1000023,1000025,1000035,
|
|
&1000002,2000002,1000002,2000002,1000021,1000039,1000024,1000037,
|
|
&1000022,1000023,1000025,1000035,1000001,2000001,1000001,2000001,
|
|
&1000021,1000039,-1000024,-1000037,1000022,1000023,1000025,
|
|
&1000035,1000004,2000004,1000004,2000004,1000021,1000039,1000024,
|
|
&1000037,1000022,1000023,1000025,1000035,1000003,2000003,1000003,
|
|
&2000003,1000021,1000039,-1000024,-1000037,1000022,1000023/
|
|
DATA (KFDP(I,1),I=1711,1900)/1000025,1000035,1000006,2000006,
|
|
&1000006,2000006,1000021,1000039,1000024,1000037,1000022,1000023,
|
|
&1000025,1000035,1000005,2000005,1000005,2000005,1000021,1000022,
|
|
&1000039,-1000024,-1000037,1000022,1000023,1000025,1000035,
|
|
&1000012,2000012,1000012,2000012,1000039,1000024,1000037,1000022,
|
|
&1000023,1000025,1000035,1000011,2000011,1000011,2000011,1000039,
|
|
&-1000024,-1000037,1000022,1000023,1000025,1000035,1000014,
|
|
&2000014,1000014,2000014,1000039,1000024,1000037,1000022,1000023,
|
|
&1000025,1000035,1000013,2000013,1000013,2000013,1000039,-1000024,
|
|
&-1000037,1000022,1000023,1000025,1000035,1000016,2000016,1000016,
|
|
&2000016,1000039,1000024,1000037,1000022,1000023,1000025,1000035,
|
|
&1000015,2000015,1000015,2000015,1000039,1000001,-1000001,2000001,
|
|
&-2000001,1000002,-1000002,2000002,-2000002,1000003,-1000003,
|
|
&2000003,-2000003,1000004,-1000004,2000004,-2000004,1000005,
|
|
&-1000005,2000005,-2000005,1000006,-1000006,2000006,-2000006,
|
|
&6*1000022,6*1000023,6*1000025,6*1000035,1000024,-1000024,1000024,
|
|
&-1000024,1000024,-1000024,1000037,-1000037,1000037,-1000037,
|
|
&1000037,-1000037,10*1000039,16*1000022,1000024,-1000024,1000024,
|
|
&-1000024,1000024,-1000024,1000024,-1000024,1000024,-1000024,
|
|
&1000024,-1000024,1000037,-1000037,1000037,-1000037,1000037/
|
|
DATA (KFDP(I,1),I=1901,2095)/-1000037,1000037,-1000037,1000037,
|
|
&-1000037,1000037,-1000037,1000024,-1000024,1000037,-1000037,
|
|
&1000001,-1000001,2000001,-2000001,1000002,-1000002,2000002,
|
|
&-2000002,1000003,-1000003,2000003,-2000003,1000004,-1000004,
|
|
&2000004,-2000004,1000005,-1000005,2000005,-2000005,1000006,
|
|
&-1000006,2000006,-2000006,1000011,-1000011,2000011,-2000011,
|
|
&1000012,-1000012,2000012,-2000012,1000013,-1000013,2000013,
|
|
&-2000013,1000014,-1000014,2000014,-2000014,1000015,-1000015,
|
|
&2000015,-2000015,1000016,-1000016,2000016,-2000016,5*1000021,
|
|
&2*1000039,6*1000022,6*1000023,6*1000025,6*1000035,1000022,
|
|
&1000023,1000025,1000035,1000002,2000002,-1000001,-2000001,
|
|
&1000004,2000004,-1000003,-2000003,1000006,2000006,-1000005,
|
|
&-2000005,1000012,2000012,-1000011,-2000011,1000014,2000014,
|
|
&-1000013,-2000013,1000016,2000016,-1000015,-2000015,2*1000021,
|
|
&5*1000039,16*1000022,16*1000023,1000024,-1000024,1000024,
|
|
&-1000024,1000024,-1000024,1000024,-1000024,1000024,-1000024,
|
|
&1000024,-1000024,1000037,-1000037,1000037,-1000037,1000037,
|
|
&-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037,
|
|
&1000024,-1000024,1000037,-1000037,1000001,-1000001,2000001,
|
|
&-2000001,1000002,-1000002,2000002,-2000002,1000003,-1000003/
|
|
DATA (KFDP(I,1),I=2096,2323)/2000003,-2000003,1000004,-1000004,
|
|
&2000004,-2000004,1000005,-1000005,2000005,-2000005,1000006,
|
|
&-1000006,2000006,-2000006,1000011,-1000011,2000011,-2000011,
|
|
&1000012,-1000012,2000012,-2000012,1000013,-1000013,2000013,
|
|
&-2000013,1000014,-1000014,2000014,-2000014,1000015,-1000015,
|
|
&2000015,-2000015,1000016,-1000016,2000016,-2000016,5*1000021,
|
|
&5*1000039,16*1000022,16*1000023,16*1000025,1000024,-1000024,
|
|
&1000024,-1000024,1000024,-1000024,1000024,-1000024,1000024,
|
|
&-1000024,1000024,-1000024,1000037,-1000037,1000037,-1000037,
|
|
&1000037,-1000037,1000037,-1000037,1000037,-1000037,1000037,
|
|
&-1000037,1000024,-1000024,1000037,-1000037,1000001,-1000001,
|
|
&2000001,-2000001,1000002,-1000002,2000002,-2000002,1000003,
|
|
&-1000003,2000003,-2000003,1000004,-1000004,2000004,-2000004,
|
|
&1000005,-1000005,2000005,-2000005,1000006,-1000006,2000006,
|
|
&-2000006,1000011,-1000011,2000011,-2000011,1000012,-1000012,
|
|
&2000012,-2000012,1000013,-1000013,2000013,-2000013,1000014,
|
|
&-1000014,2000014,-2000014,1000015,-1000015,2000015,-2000015,
|
|
&1000016,-1000016,2000016,-2000016,5*1000021,2*1000039,15*1000024,
|
|
&6*1000022,6*1000023,6*1000025,6*1000035,1000022,1000023,1000025,
|
|
&1000035,1000002,2000002,-1000001,-2000001,1000004,2000004/
|
|
DATA (KFDP(I,1),I=2324,4000)/-1000003,-2000003,1000006,2000006,
|
|
&-1000005,-2000005,1000012,2000012,-1000011,-2000011,1000014,
|
|
&2000014,-1000013,-2000013,1000016,2000016,-1000015,-2000015,
|
|
&2*1000021,1000039,-1000024,-1000037,1000022,1000023,1000025,
|
|
&1000035,4*1000001,1000002,2000002,1000002,2000002,1000021,
|
|
&1000039,1000024,1000037,1000022,1000023,1000025,1000035,
|
|
&4*1000002,1000001,2000001,1000001,2000001,1000021,1000039,
|
|
&-1000024,-1000037,1000022,1000023,1000025,1000035,4*1000003,
|
|
&1000004,2000004,1000004,2000004,1000021,1000039,1000024,1000037,
|
|
&1000022,1000023,1000025,1000035,4*1000004,1000003,2000003,
|
|
&1000003,2000003,1000021,1000039,-1000024,-1000037,1000022,
|
|
&1000023,1000025,1000035,4*1000005,1000006,2000006,1000006,
|
|
&2000006,1000021,1000039,1000024,1000037,1000022,1000023,1000025,
|
|
&1000035,4*1000006,1000005,2000005,1000005,2000005,1000021,
|
|
&1000039,-1000024,-1000037,1000022,1000023,1000025,1000035,
|
|
&4*1000011,1000012,2000012,1000012,2000012,1000039,-1000024,
|
|
&-1000037,1000022,1000023,1000025,1000035,4*1000013,1000014,
|
|
&2000014,1000014,2000014,1000039,-1000024,-1000037,1000022,
|
|
&1000023,1000025,1000035,4*1000015,1000016,2000016,1000016,
|
|
&2000016,21,22,23,-24,21,22,23,24,22,23,-24,23,24,1503*0/
|
|
DATA (KFDP(I,2),I= 1, 337)/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,4*1000006,3*7,
|
|
&2,4,6,8,7,4,6,3*8,1,3,5,7,8,5,7,2*11,12,11,12,2*11,2*13,14,13,14,
|
|
&13,11,13,-211,-213,-211,-213,-211,-213,-211,-213,2*-211,-321,
|
|
&-323,-321,2*-323,3*-321,4*-211,-213,-211,-213,-211,-213,-211,
|
|
&-213,-211,-213,3*-211,-213,4*-211,-323,-321,2*-211,2*-321,3*-211,
|
|
&2*15,16,15,16,15,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21,
|
|
&-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8,
|
|
&-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,
|
|
&12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,
|
|
&-24,2*1000022,1000023,1000022,1000023,1000025,1000022,1000023,
|
|
&1000025,1000035,-1000024,-1000037,-1000024,-1000037,-1000001,
|
|
&2*-2000001,2000001,-1000002,2*-2000002,2000002,-1000003,
|
|
&2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005,
|
|
&2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011,
|
|
&2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013,
|
|
&2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015,
|
|
&2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6,
|
|
&-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,-37,22,25,2*36,2,4,6,8,
|
|
&2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22,25,-1,-2,-3,-4,-5,-6/
|
|
DATA (KFDP(I,2),I= 338, 524)/-7,-8,-11,-13,-15,-17,21,22,2*23,
|
|
&-24,2*25,36,2*1000022,1000023,1000022,1000023,1000025,1000022,
|
|
&1000023,1000025,1000035,-1000024,-1000037,-1000024,-1000037,
|
|
&-1000001,2*-2000001,2000001,-1000002,2*-2000002,2000002,-1000003,
|
|
&2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005,
|
|
&2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011,
|
|
&2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013,
|
|
&2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015,
|
|
&2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6,
|
|
&-7,-8,-11,-13,-15,-17,21,22,2*23,-24,25,2*1000022,1000023,
|
|
&1000022,1000023,1000025,1000022,1000023,1000025,1000035,-1000024,
|
|
&-1000037,-1000024,-1000037,-1000001,2*-2000001,2000001,-1000002,
|
|
&2*-2000002,2000002,-1000003,2*-2000003,2000003,-1000004,
|
|
&2*-2000004,2000004,-1000005,2*-2000005,2000005,-1000006,
|
|
&2*-2000006,2000006,-1000011,2*-2000011,2000011,-1000012,
|
|
&2*-2000012,2000012,-1000013,2*-2000013,2000013,-1000014,
|
|
&2*-2000014,2000014,-1000015,2*-2000015,2000015,-1000016,
|
|
&2*-2000016,2000016,2,4,6,8,12,14,16,18,25,1000024,1000037,
|
|
&1000024,1000037,1000024,1000037,1000024,1000037,2*-1000005,
|
|
&2*-2000005,1000002,1000004,1000012,1000014,2*1000016,-5,-6,21,11/
|
|
DATA (KFDP(I,2),I= 525, 940)/-3,-4,-5,-6,-7,-8,-13,-15,-17,-4,-5,
|
|
&-11,-13,-15,-5,-3,12,14,16,-24,-52,-24,-52,-1,-2,-3,-4,-5,-6,-7,
|
|
&-8,-11,-12,-13,-14,-15,-16,-17,-18,23,51,23,51,2,4,6,8,2,4,6,8,2,
|
|
&4,6,8,2,4,6,8,12,14,16,18,2*51,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,
|
|
&-13,-14,-15,-16,-17,-18,-82,12,14,-1,-3,11,13,15,1,4,3,4,1,3,22,
|
|
&11,-211,2*22,-13,-11,-211,211,111,211,-321,130,310,22,2*111,-211,
|
|
&11,-11,13,-13,-211,111,22,14,12,111,22,111,3*211,-311,22,211,22,
|
|
&111,-211,211,11,-211,13,22,-211,111,-211,22,111,-11,-211,111,
|
|
&2*-211,-321,130,310,221,111,-211,111,2*0,-211,111,22,-211,111,
|
|
&-211,111,-211,211,-213,113,223,221,14,111,211,111,-11,-13,211,
|
|
&111,22,211,111,211,111,2*211,213,113,223,221,22,-211,111,113,223,
|
|
&22,111,-321,310,211,111,2*-211,221,22,-11,-13,-211,-321,130,310,
|
|
&221,-211,111,11*12,11*14,2*211,2*213,211,20213,2*321,2*323,211,
|
|
&213,211,213,211,213,211,213,211,213,211,213,3*211,213,211,2*321,
|
|
&8*211,2*113,3*211,111,22,211,111,211,111,4*211,8*12,8*14,2*211,
|
|
&2*213,2*111,221,2*113,223,333,20213,211,2*321,323,2*311,313,-211,
|
|
&111,113,2*211,321,2*211,311,321,310,211,-211,4*211,321,4*211,113,
|
|
&2*211,-321,111,22,-211,111,-211,111,-211,211,-211,211,16,5*12,
|
|
&5*14,3*211,3*213,211,2*111,2*113,2*-311,2*-313,-2112,3*321,323,
|
|
&2*-1,22,111,321,311,321,311,-82,-11,-13,-82,22,-82,6*-11,6*-13/
|
|
DATA (KFDP(I,2),I= 941,1318)/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,-211,22,11,13,11,-211,
|
|
&2*111,2*22,111,211,-321,-211,111,11,2*-211,7*12,7*14,-321,-323,
|
|
&-311,-313,-311,-313,211,213,211,213,211,213,111,221,331,113,223,
|
|
&111,221,113,223,321,323,321,-211,-213,111,221,331,113,223,333,
|
|
&10221,111,221,331,113,223,211,213,211,213,321,323,321,323,321,
|
|
&323,311,313,311,313,2*-1,-3,-1,2203,3201,3203,2203,2101,2103,12,
|
|
&14,-1,-3,2*111,2*211,12,14,-1,-3,22,111,2*22,111,22,12,14,-1,-3,
|
|
&22,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,
|
|
&12,14,-1,-3,12,14,-1,-3,2*-211,11,13,15,-211,-213,-20213,-431,
|
|
&-433,3*3122,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1/
|
|
DATA (KFDP(I,2),I=1319,1774)/3,2*111,2*211,11,13,15,1,4,3,4,1,3,
|
|
&11,13,15,1,4,3,4,1,3,4*22,11,13,15,1,4,3,4,1,3,22,11,13,15,1,4,3,
|
|
&4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,
|
|
&1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,
|
|
&3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,
|
|
&11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,
|
|
&11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,
|
|
&11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,2*111,2*211,-211,111,
|
|
&-321,130,310,-211,111,211,-211,111,-213,113,-211,111,223,211,111,
|
|
&213,113,211,111,223,-211,111,-321,130,310,2*-211,-311,311,-321,
|
|
&321,211,111,211,111,-211,111,-211,111,311,2*321,311,22,2*-82,
|
|
&-211,111,-211,111,211,111,211,111,-321,-311,-321,-311,411,421,
|
|
&411,421,22,2*21,-211,2*211,111,-211,111,2*211,111,-211,211,111,
|
|
&211,-321,2*-311,-321,22,-211,111,211,111,-311,311,-321,321,211,
|
|
&111,-211,111,321,311,22,-82,-211,111,211,111,-321,-311,411,421,
|
|
&22,21,-11,-13,-82,211,111,221,111,4*22,-11,-13,-15,-1,-2,-3,-4,
|
|
&2*21,211,111,3*22,1,2*2,4*1,2*-24,2*-37,1,2,2*1,4*2,2*24,2*37,2,
|
|
&3,2*4,4*3,2*-24,2*-37,3,4,2*3,4*4,2*24,2*37,4,5,2*6,4*5,2*-24,
|
|
&2*-37,5,6,2*5,4*6,2*24,2*37,6,4,11,2*12,4*11,2*-24,2*-37,12,2*11,
|
|
&4*12,2*24,2*37,13,2*14,4*13,2*-24,2*-37,14,2*13,4*14,2*24,2*37/
|
|
DATA (KFDP(I,2),I=1775,2218)/15,2*16,4*15,2*-24,2*-37,16,2*15,
|
|
&4*16,2*24,2*37,21,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5,5,
|
|
&-5,5,-6,6,-6,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6,1,
|
|
&-1,3,-3,5,-5,1,-1,3,-3,5,-5,22,23,25,35,36,22,23,25,35,36,22,23,
|
|
&11,13,15,12,14,16,1,3,5,2,4,25,35,36,-24,24,11,-11,13,-13,15,-15,
|
|
&1,-1,3,-3,-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-37,37,-37,37,-1,
|
|
&1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,
|
|
&-11,11,-12,12,-12,12,-13,13,-13,13,-14,14,-14,14,-15,15,-15,15,
|
|
&-16,16,-16,16,1,3,5,2,4,24,37,24,-11,-13,-15,-1,-3,24,-11,-13,
|
|
&-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,4*37,2*-1,
|
|
&2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13,2*14,2*-15,2*16,-1,-3,22,
|
|
&23,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,
|
|
&13,15,12,14,16,1,3,5,2,4,25,35,36,-24,24,11,-11,13,-13,15,-15,1,
|
|
&-1,3,-3,-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-37,37,-37,37,-1,1,
|
|
&-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,
|
|
&-11,11,-12,12,-12,12,-13,13,-13,13,-14,14,-14,14,-15,15,-15,15,
|
|
&-16,16,-16,16,1,3,5,2,4,22,23,25,35,36,22,23,11,13,15,12,14,16,1,
|
|
&3,5,2,4,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,22,
|
|
&23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,-24,24,11,-11,13,-13,15,
|
|
&-15,1,-1,3,-3,-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-37,37,-37/
|
|
DATA (KFDP(I,2),I=2219,4000)/37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,
|
|
&4,-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,
|
|
&-13,13,-14,14,-14,14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,24,37,
|
|
&23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,24,-11,-13,-15,-1,-3,24,
|
|
&-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,4*37,
|
|
&2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13,2*14,2*-15,2*16,-1,
|
|
&-3,1,2*2,4*1,23,25,35,36,2*-24,2*-37,1,2,2*1,4*2,23,25,35,36,
|
|
&2*24,2*37,2,3,2*4,4*3,23,25,35,36,2*-24,2*-37,3,4,2*3,4*4,23,25,
|
|
&35,36,2*24,2*37,4,5,2*6,4*5,23,25,35,36,2*-24,2*-37,5,6,2*5,4*6,
|
|
&23,25,35,36,2*24,2*37,6,11,2*12,4*11,23,25,35,36,2*-24,2*-37,13,
|
|
&2*14,4*13,23,25,35,36,2*-24,2*-37,15,2*16,4*15,23,25,35,36,2*-24,
|
|
&2*-37,3*1,4*2,1,2*11,2*12,11,1503*0/
|
|
DATA (KFDP(I,3),I= 1,1087)/79*0,14,6*0,2*16,2*0,6*111,310,130,
|
|
&2*0,3*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221,
|
|
&2*113,221,2*113,2*213,-213,113,2*111,310,130,310,130,2*310,130,
|
|
&470*0,4*3,4*4,1,4,3,2*2,0,-11,8*0,-211,5*0,2*111,211,-211,211,
|
|
&-211,10*0,111,4*0,2*111,-211,-11,11,-13,22,111,3*0,22,3*0,111,
|
|
&211,4*0,111,11*0,111,-211,6*0,-211,3*111,7*0,111,-211,5*0,2*221,
|
|
&3*0,111,5*0,111,11*0,-311,-313,-311,-321,-313,-323,111,221,331,
|
|
&113,223,-311,-313,-311,-321,-313,-323,111,221,331,113,223,22*0,
|
|
&111,113,2*211,-211,-311,211,111,3*211,-211,7*211,7*0,111,-211,
|
|
&111,-211,-321,-323,-311,-321,-313,-323,-211,-213,-321,-323,-311,
|
|
&-321,-313,-323,-211,-213,22*0,111,113,-311,2*-211,211,-211,310,
|
|
&-211,2*111,211,2*-211,-321,-211,2*211,-211,111,-211,2*211,6*0,
|
|
&111,-211,111,-211,0,221,331,333,321,311,221,331,333,321,311,20*0,
|
|
&3,13*0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413,
|
|
&-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211,
|
|
&111,-211,-421,-423,-10423,-10421,-20423,-425,-421,-423,-10423,
|
|
&-10421,-20423,-425,-421,-423,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211,
|
|
&111,-211,-431,-433,-10433,-10431,-20433,-435,-431,-433,-10433,
|
|
&-10431,-20433,-435,-431,-433,19*0,-4,-1,-4,-3,2*-2,8*0,441,443,
|
|
&441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531,533,531,533,3,2,3,2/
|
|
DATA (KFDP(I,3),I=1088,2186)/511,513,511,513,1,2,13*0,2*21,11*0,
|
|
&2112,6*0,2212,12*0,2*3122,3212,10*0,3322,2*0,3122,3212,3214,2112,
|
|
&2114,2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,6*0,
|
|
&4*3,4*0,4*3,6*0,4*3,0,28*3,2*0,3*4122,8*0,4,1,4,3,2*2,4*4,1,4,3,
|
|
&2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3,
|
|
&2*2,0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,
|
|
&4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,
|
|
&3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,
|
|
&4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,
|
|
&3,2*2,31*0,211,111,45*0,-211,2*111,-211,3*111,-211,111,211,30*0,
|
|
&-211,111,13*0,2*21,-211,111,167*0,-1,-3,-5,-2,-4,-6,-1,-3,-5,-2,
|
|
&-4,-6,-1,-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-2,2,-4,4,-6,6,-2,2,-4,
|
|
&4,-6,6,12*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-12,12,
|
|
&-14,14,-16,16,-2,2,-4,4,2*0,-12,12,-14,14,-16,16,-2,2,-4,4,52*0,
|
|
&-1,-3,-5,-2,-4,3*0,12,14,16,2,4,0,12,14,16,2,4,0,12,14,16,2,4,0,
|
|
&12,14,16,2,4,28*0,2,4,7*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,
|
|
&5*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,
|
|
&16,-2,2,-4,4,2*0,-12,12,-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,
|
|
&-4,7*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-11,-13,-15,
|
|
&-12,-14,-16,-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14,-16,-1,-3,-5/
|
|
DATA (KFDP(I,3),I=2187,4000)/-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,
|
|
&-4,4,2*0,-12,12,-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,3*0,
|
|
&-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,4*0,12,14,16,2,4,0,12,14,
|
|
&16,2,4,0,12,14,16,2,4,0,12,14,16,2,4,28*0,2,4,1657*0/
|
|
DATA (KFDP(I,4),I= 1,4000)/92*0,4*111,6*0,111,2*0,-211,0,-211,
|
|
&3*0,111,2*-211,0,111,0,2*111,113,221,2*111,-213,-211,211,113,
|
|
&6*111,310,2*130,470*0,13*81,41*0,-11,10*0,111,-211,4*0,111,62*0,
|
|
&111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111,
|
|
&-211,2*211,2*-211,13*0,-211,111,-211,111,4*0,-211,111,-211,111,
|
|
&34*0,111,-211,3*111,3*-211,2*111,3*-211,14*0,-321,-311,3*0,-321,
|
|
&-311,20*0,-3,43*0,6*1,39*0,6*2,42*0,6*3,14*0,8*4,4*0,4*-5,4*0,
|
|
&2*-5,67*0,-211,111,5*0,-211,111,52*0,2101,2103,2*2101,6*0,4*81,
|
|
&4*0,4*81,6*0,4*81,0,28*81,13*0,6*2101,18*81,4*0,18*81,4*0,9*81,0,
|
|
&162*81,31*0,-211,111,2450*0/
|
|
DATA (KFDP(I,5),I= 1,4000)/94*0,2*111,17*0,111,7*0,2*111,0,
|
|
&3*111,0,111,665*0,-211,2*111,-211,111,-211,111,65*0,111,-211,
|
|
&3*111,-211,111,3127*0/
|
|
|
|
C...PYDAT4, with particle names (character strings).
|
|
DATA (CHAF(I,1),I= 1, 190)/'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',10*' ','pi_tech0','pi_tech+','pi''_tech0',
|
|
&'rho_tech0','rho_tech+','omega_tech',24*' ','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+'/
|
|
DATA (CHAF(I,1),I= 191, 317)/'Sigma*_c+','Sigma_c++',
|
|
&'Sigma*_c++','Xi_c+','cs_0','cs_1','Xi''_c0','Xi*_c0','Xi''_c+',
|
|
&'Xi*_c+','Omega_c0','Omega*_c0','cc_1','Xi_cc+','Xi*_cc+',
|
|
&'Xi_cc++','Xi*_cc++','Omega_cc+','Omega*_cc+','Omega*_ccc++',
|
|
&'bd_0','bd_1','Sigma_b-','Sigma*_b-','Lambda_b0','Xi_b-',
|
|
&'Xi_bc0','bu_0','bu_1','Sigma_b0','Sigma*_b0','Sigma_b+',
|
|
&'Sigma*_b+','Xi_b0','Xi_bc+','bs_0','bs_1','Xi''_b-','Xi*_b-',
|
|
&'Xi''_b0','Xi*_b0','Omega_b-','Omega*_b-','Omega_bc0','bc_0',
|
|
&'bc_1','Xi''_bc0','Xi*_bc0','Xi''_bc+','Xi*_bc+','Omega''_bc0',
|
|
&'Omega*_bc0','Omega_bcc+','Omega*_bcc+','bb_1','Xi_bb-',
|
|
&'Xi*_bb-','Xi_bb0','Xi*_bb0','Omega_bb-','Omega*_bb-',
|
|
&'Omega_bbc0','Omega*_bbc0','Omega*_bbb-','a_00','b_10','a_0+',
|
|
&'b_1+','f_0','h_1','K*_00','K_10','K*_0+','K_1+','f''_0','h''_1',
|
|
&'D*_0+','D_1+','D*_00','D_10','D*_0s+','D_1s+','chi_0c','h_1c',
|
|
&'B*_00','B_10','B*_0+','B_1+','B*_0s0','B_1s0','B*_0c+','B_1c+',
|
|
&'chi_0b','h_1b','a_10','a_1+','f_1','K*_10','K*_1+','f''_1',
|
|
&'D*_1+','D*_10','D*_1s+','chi_1c','B*_10','B*_1+','B*_1s0',
|
|
&'B*_1c+','chi_1b','psi''','Upsilon''','~d_L','~u_L','~s_L',
|
|
&'~c_L','~b_1','~t_1','~e_L-','~nu_eL','~mu_L-','~nu_muL',
|
|
&'~tau_1-','~nu_tauL','~g','~chi_10','~chi_20','~chi_1+'/
|
|
DATA (CHAF(I,1),I= 318, 500)/'~chi_30','~chi_40','~chi_2+',
|
|
&'~gravitino','~d_R','~u_R','~s_R','~c_R','~b_2','~t_2','~e_R-',
|
|
&'~nu_eR','~mu_R-','~nu_muR','~tau_2-','~nu_tauR','d*','u*','e*-',
|
|
&'nu*_e0',163*' '/
|
|
DATA (CHAF(I,2),I= 1, 206)/'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',11*' ','pi_tech-',2*' ',
|
|
&'rho_tech-',26*' ','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--'/
|
|
DATA (CHAF(I,2),I= 207, 324)/'Xi*_ccbar--','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_1bar','~t_1bar','~e_L+',
|
|
&'~nu_eLbar','~mu_L+','~nu_muLbar','~tau_1+','~nu_tauLbar',3*' ',
|
|
&'~chi_1-',2*' ','~chi_2-',' ','~d_Rbar','~u_Rbar','~s_Rbar'/
|
|
DATA (CHAF(I,2),I= 325, 500)/'~c_Rbar','~b_2bar','~t_2bar',
|
|
&'~e_R+','~nu_eRbar','~mu_R+','~nu_muRbar','~tau_2+',
|
|
&'~nu_tauRbar','d*bar','u*bar','e*bar+','nu*_ebar0',163*' '/
|
|
|
|
C...PYDATR, with initial values for the random number generator.
|
|
DATA MRPY/19780503,0,0,97,33,0/
|
|
|
|
C...Default values for allowed processes and kinematics constraints.
|
|
DATA MSEL/1/
|
|
DATA MSUB/500*0/
|
|
DATA ((KFIN(I,J),J=-40,40),I=1,2)/16*0,4*1,4*0,6*1,5*0,5*1,0,
|
|
&5*1,5*0,6*1,4*0,4*1,16*0,16*0,4*1,4*0,6*1,5*0,5*1,0,5*1,5*0,
|
|
&6*1,4*0,4*1,16*0/
|
|
DATA CKIN/
|
|
& 2.0D0, -1.0D0, 0.0D0, -1.0D0, 1.0D0,
|
|
& 1.0D0, -10D0, 10D0, -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, 1, 0,
|
|
5 4, 1, 3, 1, 5, 1, 1, 6, 1, 7,
|
|
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, 50, 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, 102, 1997, 04, 22, 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,0D0,2.0D0,0.70D0,0.006D0,0D0,
|
|
4 0.02D0,2.0D0,0.10D0,1000D0,2054D0, 123D0, 246D0, 50D0, 2*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,3.0D0,1.0D0,0.75D0,0.44D0,2.0D0/
|
|
DATA (PARP(I),I=101,200)/
|
|
& 0.5D0, 0.28D0, 1.0D0, 0.8D0, 6*0D0,
|
|
1 2.0D0, 3*0D0, 1.5D0, 0.5D0, 0.6D0, 2.5D0, 2.0D0, 1.0D0,
|
|
2 1.0D0, 0.4D0, 8*0D0,
|
|
3 0.01D0, 9*0D0,
|
|
4 0.33333D0, 82D0, 1D0, 4D0, 200D0, 5*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 1, 1, 1, 2, -2, -2, -2, -2, -2, -2/
|
|
DATA (ISET(I),I=201,300)/
|
|
& 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
|
1 2, 2, 2, 2, -2, 2, 2, 2, 2, 2,
|
|
2 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
|
3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
|
4 2, 2, 2, 2, -1, 2, 2, 2, 2, 2,
|
|
5 2, 2, 2, 2, -1, 2, -1, 2, 2, -2,
|
|
6 2, 2, 2, 2, 2, -1, -1, -1, -1, -1,
|
|
7 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
|
|
8 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2,
|
|
9 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2/
|
|
DATA (ISET(I),I=301,500)/200*-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 54, 0, 55, 0, 56, 0, 11, 0, 0, 0,
|
|
9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
|
|
DATA ((KFPR(I,J),J=1,2),I=201,240)/
|
|
& 1000011, 1000011, 2000011, 2000011, 1000011,
|
|
& 2000011, 1000013, 1000013, 2000013, 2000013,
|
|
& 1000013, 2000013, 1000015, 1000015, 2000015,
|
|
& 2000015, 1000015, 2000015, 1000011, 1000012,
|
|
1 1000015, 1000016, 2000015, 1000016, 1000012,
|
|
1 1000012, 1000016, 1000016, 0, 0,
|
|
1 1000022, 1000022, 1000023, 1000023, 1000025,
|
|
1 1000025, 1000035, 1000035, 1000022, 1000023,
|
|
2 1000022, 1000025, 1000022, 1000035, 1000023,
|
|
2 1000025, 1000023, 1000035, 1000025, 1000035,
|
|
2 1000024, 1000024, 1000037, 1000037, 1000024,
|
|
2 1000037, 1000022, 1000024, 1000023, 1000024,
|
|
3 1000025, 1000024, 1000035, 1000024, 1000022,
|
|
3 1000037, 1000023, 1000037, 1000025, 1000037,
|
|
3 1000035, 1000037, 1000021, 1000022, 1000021,
|
|
3 1000023, 1000021, 1000025, 1000021, 1000035/
|
|
DATA ((KFPR(I,J),J=1,2),I=241,280)/
|
|
4 1000021, 1000024, 1000021, 1000037, 1000021,
|
|
4 1000021, 1000021, 1000021, 0, 0,
|
|
4 1000002, 1000022, 2000002, 1000022, 1000002,
|
|
4 1000023, 2000002, 1000023, 1000002, 1000025,
|
|
5 2000002, 1000025, 1000002, 1000035, 2000002,
|
|
5 1000035, 1000001, 1000024, 2000005, 1000024,
|
|
5 1000001, 1000037, 2000005, 1000037, 1000002,
|
|
5 1000021, 2000002, 1000021, 0, 0,
|
|
6 1000006, 1000006, 2000006, 2000006, 1000006,
|
|
6 2000006, 1000006, 1000006, 2000006, 2000006,
|
|
6 0, 0, 0, 0, 0,
|
|
6 0, 0, 0, 0, 0,
|
|
7 1000002, 1000002, 2000002, 2000002, 1000002,
|
|
7 2000002, 1000002, 1000002, 2000002, 2000002,
|
|
7 1000002, 2000002, 1000002, 1000002, 2000002,
|
|
7 2000002, 1000002, 1000002, 2000002, 2000002/
|
|
DATA ((KFPR(I,J),J=1,2),I=281,500)/440*0/
|
|
DATA COEF/10000*0D0/
|
|
DATA (((ICOL(I,J,K),K=1,2),J=1,4),I=1,40)/
|
|
&4,0,3,0,2,0,1,0,3,0,4,0,1,0,2,0,2,0,0,1,4,0,0,3,3,0,0,4,1,0,0,2,
|
|
&3,0,0,4,1,4,3,2,4,0,0,3,4,2,1,3,2,0,4,1,4,0,2,3,4,0,3,4,2,0,1,2,
|
|
&3,2,1,0,1,4,3,0,4,3,3,0,2,1,1,0,3,2,1,4,1,0,0,2,2,4,3,1,2,0,0,1,
|
|
&3,2,1,4,1,4,3,2,4,2,1,3,4,2,1,3,3,4,4,3,1,2,2,1,2,0,3,1,2,0,0,0,
|
|
&4,2,1,0,0,0,1,0,3,0,0,3,1,2,0,0,4,0,0,4,0,0,1,2,2,0,0,1,4,4,3,3,
|
|
&2,2,1,1,4,4,3,3,3,3,4,4,1,1,2,2,3,2,1,3,1,2,0,0,4,2,1,4,0,0,1,2,
|
|
&4,0,0,0,4,0,1,3,0,0,3,0,2,4,3,0,3,4,0,0,1,0,0,1,0,0,3,4,2,0,0,2,
|
|
&3,0,0,0,1,0,0,0,0,0,3,0,2,0,0,0,2,0,3,1,2,0,0,0,3,2,1,0,1,0,0,0,
|
|
&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,1,5*0,3*1,6*0,1,0,7*1,
|
|
&10*0,2*1,0,3*1,245*0,19*2,0,7*2,0,2,0,2,0,4*1,163*0/
|
|
|
|
C...Character constants: name of processes.
|
|
DATA PROC(0)/ 'All included subprocesses '/
|
|
DATA (PROC(I),I=1,20)/
|
|
&'f + fbar -> gamma*/Z0 ', 'f + fbar'' -> W+/- ',
|
|
&'f + fbar -> h0 ', 'gamma + W+/- -> W+/- ',
|
|
&'Z0 + Z0 -> h0 ', 'Z0 + W+/- -> W+/- ',
|
|
&' ', 'W+ + W- -> h0 ',
|
|
&' ', 'f + f'' -> f + f'' (QFD) ',
|
|
1'f + f'' -> f + f'' (QCD) ','f + fbar -> f'' + fbar'' ',
|
|
1'f + fbar -> g + g ', 'f + fbar -> g + gamma ',
|
|
1'f + fbar -> g + Z0 ', 'f + fbar'' -> g + W+/- ',
|
|
1'f + fbar -> g + h0 ', 'f + fbar -> gamma + gamma ',
|
|
1'f + fbar -> gamma + Z0 ', 'f + fbar'' -> gamma + W+/- '/
|
|
DATA (PROC(I),I=21,40)/
|
|
2'f + fbar -> gamma + h0 ', 'f + fbar -> Z0 + Z0 ',
|
|
2'f + fbar'' -> Z0 + W+/- ', 'f + fbar -> Z0 + h0 ',
|
|
2'f + fbar -> W+ + W- ', 'f + fbar'' -> W+/- + h0 ',
|
|
2'f + fbar -> h0 + h0 ', 'f + g -> f + g ',
|
|
2'f + g -> f + gamma ', 'f + g -> f + Z0 ',
|
|
3'f + g -> f'' + W+/- ', 'f + g -> f + h0 ',
|
|
3'f + gamma -> f + g ', 'f + gamma -> f + gamma ',
|
|
3'f + gamma -> f + Z0 ', 'f + gamma -> f'' + W+/- ',
|
|
3'f + gamma -> f + h0 ', 'f + Z0 -> f + g ',
|
|
3'f + Z0 -> f + gamma ', 'f + Z0 -> f + Z0 '/
|
|
DATA (PROC(I),I=41,60)/
|
|
4'f + Z0 -> f'' + W+/- ', 'f + Z0 -> f + h0 ',
|
|
4'f + W+/- -> f'' + g ', 'f + W+/- -> f'' + gamma ',
|
|
4'f + W+/- -> f'' + Z0 ', 'f + W+/- -> f'' + W+/- ',
|
|
4'f + W+/- -> f'' + h0 ', 'f + h0 -> f + g ',
|
|
4'f + h0 -> f + gamma ', 'f + h0 -> f + Z0 ',
|
|
5'f + h0 -> f'' + W+/- ', 'f + h0 -> f + h0 ',
|
|
5'g + g -> f + fbar ', 'g + gamma -> f + fbar ',
|
|
5'g + Z0 -> f + fbar ', 'g + W+/- -> f + fbar'' ',
|
|
5'g + h0 -> f + fbar ', 'gamma + gamma -> f + fbar ',
|
|
5'gamma + Z0 -> f + fbar ', 'gamma + W+/- -> f + fbar'' '/
|
|
DATA (PROC(I),I=61,80)/
|
|
6'gamma + h0 -> f + fbar ', 'Z0 + Z0 -> f + fbar ',
|
|
6'Z0 + W+/- -> f + fbar'' ', 'Z0 + h0 -> f + fbar ',
|
|
6'W+ + W- -> f + fbar ', 'W+/- + h0 -> f + fbar'' ',
|
|
6'h0 + h0 -> f + fbar ', 'g + g -> g + g ',
|
|
6'gamma + gamma -> W+ + W- ', 'gamma + W+/- -> Z0 + W+/- ',
|
|
7'Z0 + Z0 -> Z0 + Z0 ', 'Z0 + Z0 -> W+ + W- ',
|
|
7'Z0 + W+/- -> Z0 + W+/- ', 'Z0 + Z0 -> Z0 + h0 ',
|
|
7'W+ + W- -> gamma + gamma ', 'W+ + W- -> Z0 + Z0 ',
|
|
7'W+/- + W+/- -> W+/- + W+/- ', 'W+/- + h0 -> W+/- + h0 ',
|
|
7'h0 + h0 -> h0 + h0 ', 'q + gamma -> q'' + pi+/- '/
|
|
DATA (PROC(I),I=81,100)/
|
|
8'q + qbar -> Q + Qbar, mass ', 'g + g -> Q + Qbar, massive ',
|
|
8'f + q -> f'' + Q, massive ', 'g + gamma -> Q + Qbar, mass ',
|
|
8'gamma + gamma -> F + Fbar, m', 'g + g -> J/Psi + g ',
|
|
8'g + g -> chi_0c + g ', 'g + g -> chi_1c + g ',
|
|
8'g + g -> chi_2c + g ', ' ',
|
|
9'Elastic scattering ', 'Single diffractive (XB) ',
|
|
9'Single diffractive (AX) ', 'Double diffractive ',
|
|
9'Low-pT scattering ', 'Semihard QCD 2 -> 2 ',
|
|
9' ', ' ',
|
|
9' ', ' '/
|
|
DATA (PROC(I),I=101,120)/
|
|
&'g + g -> gamma*/Z0 ', 'g + g -> h0 ',
|
|
&'gamma + gamma -> h0 ', ' ',
|
|
&' ', ' ',
|
|
&' ', ' ',
|
|
&' ', 'f + fbar -> gamma + h0 ',
|
|
1'f + fbar -> g + h0 ', 'q + g -> q + h0 ',
|
|
1'g + g -> g + h0 ', 'g + g -> gamma + gamma ',
|
|
1'g + g -> g + gamma ', 'g + g -> gamma + Z0 ',
|
|
1'g + g -> Z0 + Z0 ', 'g + g -> W+ + W- ',
|
|
1' ', ' '/
|
|
DATA (PROC(I),I=121,140)/
|
|
2'g + g -> Q + Qbar + h0 ', 'q + qbar -> Q + Qbar + h0 ',
|
|
2'f + f'' -> f + f'' + h0 ',
|
|
2'f + f'' -> f" + f"'' + h0 ',
|
|
2' ', ' ',
|
|
2' ', ' ',
|
|
2' ', ' ',
|
|
3'g + g -> Z0 + q + qbar ', ' ',
|
|
3' ', ' ',
|
|
3' ', ' ',
|
|
3' ', ' ',
|
|
3' ', ' '/
|
|
DATA (PROC(I),I=141,160)/
|
|
4'f + fbar -> gamma*/Z0/Z''0 ', 'f + fbar'' -> W''+/- ',
|
|
4'f + fbar'' -> H+/- ', 'f + fbar'' -> R ',
|
|
4'q + l -> LQ ', ' ',
|
|
4'd + g -> d* ', 'u + g -> u* ',
|
|
4'g + g -> eta_techni ', ' ',
|
|
5'f + fbar -> H0 ', 'g + g -> H0 ',
|
|
5'gamma + gamma -> H0 ', ' ',
|
|
5' ', 'f + fbar -> A0 ',
|
|
5'g + g -> A0 ', 'gamma + gamma -> A0 ',
|
|
5' ', ' '/
|
|
DATA (PROC(I),I=161,180)/
|
|
6'f + g -> f'' + H+/- ', 'q + g -> LQ + lbar ',
|
|
6'g + g -> LQ + LQbar ', 'q + qbar -> LQ + LQbar ',
|
|
6'f + fbar -> f'' + fbar'' (g/Z)',
|
|
6'f +fbar'' -> f" + fbar"'' (W) ',
|
|
6'q + q'' -> q" + d* ', 'q + q'' -> q" + u* ',
|
|
6' ', ' ',
|
|
7'f + fbar -> Z0 + H0 ', 'f + fbar'' -> W+/- + H0 ',
|
|
7'f + f'' -> f + f'' + H0 ',
|
|
7'f + f'' -> f" + f"'' + H0 ',
|
|
7' ', 'f + fbar -> Z0 + A0 ',
|
|
7'f + fbar'' -> W+/- + A0 ',
|
|
7'f + f'' -> f + f'' + A0 ',
|
|
7'f + f'' -> f" + f"'' + A0 ',
|
|
7' '/
|
|
DATA (PROC(I),I=181,200)/
|
|
8'g + g -> Q + Qbar + H0 ', 'q + qbar -> Q + Qbar + H0 ',
|
|
8' ', ' ',
|
|
8' ', 'g + g -> Q + Qbar + A0 ',
|
|
8'q + qbar -> Q + Qbar + A0 ', ' ',
|
|
8' ', ' ',
|
|
9'f + fbar -> rho_tech0 ', 'f + f'' -> rho_tech+/- ',
|
|
9'f + fbar -> omega_tech0 ', 'f+fbar -> f''+fbar'' (technic)',
|
|
9' ', ' ',
|
|
9' ', ' ',
|
|
9' ', ' '/
|
|
DATA (PROC(I),I=201,220)/
|
|
&'f + fbar -> ~e_L + ~e_Lbar ', 'f + fbar -> ~e_R + ~e_Rbar ',
|
|
&'f + fbar -> ~e_R + ~e_Lbar ', 'f + fbar -> ~mu_L + ~mu_Lbar',
|
|
&'f + fbar -> ~mu_R + ~mu_Rbar', 'f + fbar -> ~mu_L + ~mu_Rbar',
|
|
&'f+fbar -> ~tau_1 + ~tau_1bar', 'f+fbar -> ~tau_2 + ~tau_2bar',
|
|
&'f+fbar -> ~tau_1 + ~tau_2bar', 'q + qbar'' -> ~l_L + ~nulbar ',
|
|
1'q+qbar''-> ~tau_1 + ~nutaubar', 'q+qbar''-> ~tau_2 + ~nutaubar',
|
|
1'f + fbar -> ~nul + ~nulbar ', 'f+fbar -> ~nutau + ~nutaubar',
|
|
1' ', 'f + fbar -> ~chi1 + ~chi1 ',
|
|
1'f + fbar -> ~chi2 + ~chi2 ', 'f + fbar -> ~chi3 + ~chi3 ',
|
|
1'f + fbar -> ~chi4 + ~chi4 ', 'f + fbar -> ~chi1 + ~chi2 '/
|
|
DATA (PROC(I),I=221,240)/
|
|
2'f + fbar -> ~chi1 + ~chi3 ', 'f + fbar -> ~chi1 + ~chi4 ',
|
|
2'f + fbar -> ~chi2 + ~chi3 ', 'f + fbar -> ~chi2 + ~chi4 ',
|
|
2'f + fbar -> ~chi3 + ~chi4 ', 'f+fbar -> ~chi+-1 + ~chi-+1 ',
|
|
2'f+fbar -> ~chi+-2 + ~chi-+2 ', 'f+fbar -> ~chi+-1 + ~chi-+2 ',
|
|
2'q + qbar'' -> ~chi1 + ~chi+-1', 'q + qbar'' -> ~chi2 + ~chi+-1',
|
|
3'q + qbar'' -> ~chi3 + ~chi+-1', 'q + qbar'' -> ~chi4 + ~chi+-1',
|
|
3'q + qbar'' -> ~chi1 + ~chi+-2', 'q + qbar'' -> ~chi2 + ~chi+-2',
|
|
3'q + qbar'' -> ~chi3 + ~chi+-2', 'q + qbar'' -> ~chi4 + ~chi+-2',
|
|
3'q + qbar -> ~chi1 + ~g ', 'q + qbar -> ~chi2 + ~g ',
|
|
3'q + qbar -> ~chi3 + ~g ', 'q + qbar -> ~chi4 + ~g '/
|
|
DATA (PROC(I),I=241,260)/
|
|
4'q + qbar'' -> ~chi+-1 + ~g ', 'q + qbar'' -> ~chi+-2 + ~g ',
|
|
4'q + qbar -> ~g + ~g ', 'g + g -> ~g + ~g ',
|
|
4' ', 'qj + g -> ~qj_L + ~chi1 ',
|
|
4'qj + g -> ~qj_R + ~chi1 ', 'qj + g -> ~qj_L + ~chi2 ',
|
|
4'qj + g -> ~qj_R + ~chi2 ', 'qj + g -> ~qj_L + ~chi3 ',
|
|
5'qj + g -> ~qj_R + ~chi3 ', 'qj + g -> ~qj_L + ~chi4 ',
|
|
5'qj + g -> ~qj_R + ~chi4 ', 'qj + g -> ~qk_L + ~chi+-1 ',
|
|
5'qj + g -> ~qk_R + ~chi+-1 ', 'qj + g -> ~qk_L + ~chi+-2 ',
|
|
5'qj + g -> ~qk_R + ~chi+-2 ', 'qj + g -> ~qj_L + ~g ',
|
|
5'qj + g -> ~qj_R + ~g ', ' '/
|
|
DATA (PROC(I),I=261,280)/
|
|
6'f + fbar -> ~t_1 + ~t_1bar ', 'f + fbar -> ~t_2 + ~t_2bar ',
|
|
6'f + fbar -> ~t_1 + ~t_2bar ', 'g + g -> ~t_1 + ~t_1bar ',
|
|
6'g + g -> ~t_2 + ~t_2bar ', ' ',
|
|
6' ', ' ',
|
|
6' ', ' ',
|
|
7'qi + qj -> ~qi_L + ~qj_L ', 'qi + qj -> ~qi_R + ~qj_R ',
|
|
7'qi + qj -> ~qi_L + ~qj_R ', 'qi+qjbar -> ~qi_L + ~qj_Lbar',
|
|
7'qi+qjbar -> ~qi_R + ~qj_Rbar', 'qi+qjbar -> ~qi_L + ~qj_Rbar',
|
|
7'f + fbar -> ~qi_L + ~qi_Lbar', 'f + fbar -> ~qi_R + ~qi_Rbar',
|
|
7'g + g -> ~qi_L + ~qi_Lbar ', 'g + g -> ~qi_R + ~qi_Rbar '/
|
|
DATA (PROC(I),I=281,500)/220*' '/
|
|
|
|
C...Cross sections and slope offsets.
|
|
DATA SIGT/294*0D0/
|
|
|
|
C...Supersymmetry switches and parameters.
|
|
DATA IMSS/0,
|
|
& 0, 0, 0, 1, 0, 0, 0, 1, 0, 0,
|
|
1 89*0/
|
|
DATA RMSS/0D0,
|
|
& 80D0,160D0,500D0,800D0,2D0,250D0,200D0,800D0,700D0,800D0,
|
|
1 700D0,500D0,250D0,200D0,800D0,400D0,0D0,0.1D0,850D0,0.041D0,
|
|
2 1D0,800D0,1D4,1D4,1D4,0D0,0D0,24D17,2*0D0,
|
|
3 69*0D0/
|
|
|
|
C...Data for histogramming routines.
|
|
DATA IHIST/1000,20000,55,1/
|
|
DATA INDX/1000*0/
|
|
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYTEST
|
|
C...A simple program (disguised as subroutine) to run at installation
|
|
C...as a check that the program works as intended.
|
|
|
|
SUBROUTINE PYTEST(MTEST)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
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 190 ISUB=1,500
|
|
MSUB(ISUB)=0
|
|
190 CONTINUE
|
|
CKIN(1)=2D0
|
|
CKIN(3)=0D0
|
|
MSTP(2)=1
|
|
MSTP(11)=0
|
|
MSTP(33)=0
|
|
MSTP(81)=1
|
|
MSTP(82)=1
|
|
MSTP(111)=1
|
|
MSTP(131)=0
|
|
MSTP(133)=0
|
|
PARP(131)=0.01D0
|
|
|
|
C...Prompt photon production at fixed target.
|
|
IF(IPROC.EQ.1) THEN
|
|
PZSUM=300D0
|
|
PESUM=SQRT(PZSUM**2+PYMASS(211)**2)+PYMASS(2212)
|
|
PQSUM=2D0
|
|
MSEL=10
|
|
CKIN(3)=5D0
|
|
CALL PYINIT('FIXT','pi+','p',PZSUM)
|
|
|
|
C...QCD processes at ISR energies.
|
|
ELSEIF(IPROC.EQ.2) THEN
|
|
PESUM=63D0
|
|
PZSUM=0D0
|
|
PQSUM=2D0
|
|
MSEL=1
|
|
CKIN(3)=5D0
|
|
CALL PYINIT('CMS','p','p',PESUM)
|
|
|
|
C...W production + multiple interactions at CERN Collider.
|
|
ELSEIF(IPROC.EQ.3) THEN
|
|
PESUM=630D0
|
|
PZSUM=0D0
|
|
PQSUM=0D0
|
|
MSEL=12
|
|
CKIN(1)=20D0
|
|
MSTP(82)=4
|
|
MSTP(2)=2
|
|
MSTP(33)=3
|
|
CALL PYINIT('CMS','p','pbar',PESUM)
|
|
|
|
C...W/Z gauge boson pairs + pileup events at the Tevatron.
|
|
ELSEIF(IPROC.EQ.4) THEN
|
|
PESUM=1800D0
|
|
PZSUM=0D0
|
|
PQSUM=0D0
|
|
MSUB(22)=1
|
|
MSUB(23)=1
|
|
MSUB(25)=1
|
|
CKIN(1)=200D0
|
|
MSTP(111)=0
|
|
MSTP(131)=1
|
|
MSTP(133)=2
|
|
PARP(131)=0.04D0
|
|
CALL PYINIT('CMS','p','pbar',PESUM)
|
|
|
|
C...Higgs production at LHC.
|
|
ELSEIF(IPROC.EQ.5) THEN
|
|
PESUM=15400D0
|
|
PZSUM=0D0
|
|
PQSUM=2D0
|
|
MSUB(3)=1
|
|
MSUB(102)=1
|
|
MSUB(123)=1
|
|
MSUB(124)=1
|
|
PMAS(25,1)=300D0
|
|
CKIN(1)=200D0
|
|
MSTP(81)=0
|
|
MSTP(111)=0
|
|
CALL PYINIT('CMS','p','p',PESUM)
|
|
|
|
C...Z' production at SSC.
|
|
ELSEIF(IPROC.EQ.6) THEN
|
|
PESUM=40000D0
|
|
PZSUM=0D0
|
|
PQSUM=2D0
|
|
MSEL=21
|
|
PMAS(32,1)=600D0
|
|
CKIN(1)=400D0
|
|
MSTP(81)=0
|
|
MSTP(111)=0
|
|
CALL PYINIT('CMS','p','p',PESUM)
|
|
|
|
C...W pair production at 1 TeV e+e- collider.
|
|
ELSEIF(IPROC.EQ.7) THEN
|
|
PESUM=1000D0
|
|
PZSUM=0D0
|
|
PQSUM=0D0
|
|
MSUB(25)=1
|
|
MSUB(69)=1
|
|
MSTP(11)=1
|
|
CALL PYINIT('CMS','e+','e-',PESUM)
|
|
|
|
C...Deep inelastic scattering at a LEP+LHC ep collider.
|
|
ELSEIF(IPROC.EQ.8) THEN
|
|
P(1,1)=0D0
|
|
P(1,2)=0D0
|
|
P(1,3)=8000D0
|
|
P(2,1)=0D0
|
|
P(2,2)=0D0
|
|
P(2,3)=-80D0
|
|
PESUM=8080D0
|
|
PZSUM=7920D0
|
|
PQSUM=0D0
|
|
MSUB(10)=1
|
|
CKIN(3)=50D0
|
|
MSTP(111)=0
|
|
CALL PYINIT('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 200 J=1,4
|
|
PFIN(J)=PYP(0,J)
|
|
200 CONTINUE
|
|
PFIN(6)=PYP(0,6)
|
|
MERR=0
|
|
DEVE=ABS(PFIN(4)-PINI(4))+ABS(PFIN(3)-PINI(3))
|
|
DEVT=ABS(PFIN(1)-PINI(1))+ABS(PFIN(2)-PINI(2))
|
|
DEVQ=ABS(PFIN(6)-PINI(6))
|
|
IF(DEVE.GT.2D-3*PESUM.OR.DEVT.GT.MAX(0.01D0,1D-4*PESUM).OR.
|
|
& DEVQ.GT.0.1D0) MERR=1
|
|
IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6),
|
|
& (PFIN(J),J=1,4),PFIN(6)
|
|
|
|
C...Check that all KF codes are known ones, and that partons/particles
|
|
C...satisfy energy-momentum-mass relation.
|
|
DO 210 I=1,N
|
|
IF(K(I,1).GT.20) GOTO 210
|
|
IF(PYCOMP(K(I,2)).EQ.0) THEN
|
|
WRITE(MSTU(11),5100) I
|
|
MERR=MERR+1
|
|
ENDIF
|
|
PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2*
|
|
& SIGN(1D0,P(I,5))
|
|
IF(ABS(PD).GT.MAX(0.1D0,0.002D0*P(I,4)**2,0.002D0*P(I,5)**2)
|
|
& .OR.(P(I,5).GE.0D0.AND.P(I,4).LT.0D0)) THEN
|
|
WRITE(MSTU(11),5200) I
|
|
MERR=MERR+1
|
|
ENDIF
|
|
210 CONTINUE
|
|
|
|
C...Listing of erroneous events, and first event of each type.
|
|
IF(MERR.GE.1) NERR=NERR+1
|
|
IF(NERR.GE.10) THEN
|
|
WRITE(MSTU(11),6300)
|
|
CALL PYLIST(1)
|
|
STOP
|
|
ENDIF
|
|
IF(MTEST.GE.1.AND.(MERR.GE.1.OR.IEV.EQ.1)) THEN
|
|
IF(MERR.GE.1) WRITE(MSTU(11),6400)
|
|
CALL PYLIST(1)
|
|
ENDIF
|
|
220 CONTINUE
|
|
|
|
C...List statistics for each process type.
|
|
IF(MTEST.GE.1) CALL PYSTAT(1)
|
|
230 CONTINUE
|
|
|
|
C...Summarize result of run.
|
|
IF(NERR.EQ.0) WRITE(MSTU(11),6500)
|
|
IF(NERR.GT.0) WRITE(MSTU(11),6600) NERR
|
|
|
|
C...Format statements for output.
|
|
5000 FORMAT(/' Momentum, energy and/or charge were not conserved ',
|
|
&'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X,
|
|
&'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X,
|
|
&4(1X,F12.5),1X,F8.2)
|
|
5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code')
|
|
5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ',
|
|
&'kinematics')
|
|
6300 FORMAT(/5X,'This is the tenth error experienced! Something is ',
|
|
&'wrong.'/5X,'Execution will be stopped after listing of event.')
|
|
6400 FORMAT(5X,'Faulty event follows:')
|
|
6500 FORMAT(//5X,'End result of PYTEST: no errors detected.')
|
|
6600 FORMAT(//5X,'End result of PYTEST:',I2,' errors detected.'/
|
|
&5X,'This should not have happened!')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYHEPC
|
|
C...Converts PYTHIA event record contents to or from
|
|
C...the standard event record commonblock.
|
|
|
|
SUBROUTINE PYHEPC(MCONV)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
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.2322D0,0.248D0,0.248D0,
|
|
&14*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)
|
|
IF(IB.GE.6.AND.MSTP(9).EQ.0) GOTO 110
|
|
IPM=(5-ISIGN(1,I))/2
|
|
IDC=J+MDCY(IA,2)+2
|
|
IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) VINT(180+I)=
|
|
& VINT(180+I)+VCKM((IA+1)/2,(IB+1)/2)
|
|
110 CONTINUE
|
|
ELSEIF(IA.GE.11.AND.IA.LE.10+2*MSTP(1)) THEN
|
|
VINT(180+I)=1D0
|
|
ENDIF
|
|
120 CONTINUE
|
|
|
|
C...Initialize parton distributions: PDFLIB.
|
|
IF(MSTP(52).EQ.2) THEN
|
|
PARM(1)='NPTYPE'
|
|
VALUE(1)=1
|
|
PARM(2)='NGROUP'
|
|
VALUE(2)=MSTP(51)/1000
|
|
PARM(3)='NSET'
|
|
VALUE(3)=MOD(MSTP(51),1000)
|
|
PARM(4)='TMAS'
|
|
VALUE(4)=PMAS(6,1)
|
|
CALL PDFSET(PARM,VALUE)
|
|
MINT(93)=1000000+MSTP(51)
|
|
ENDIF
|
|
|
|
C...Choose Lambda value to use in alpha-strong.
|
|
MSTU(111)=MSTP(2)
|
|
IF(MSTP(3).GE.2) THEN
|
|
ALAM=0.2D0
|
|
NF=4
|
|
IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.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 the SUSY generation: couplings, masses,
|
|
C...decay modes, branching ratios, and so on.
|
|
CALL PYMSIN
|
|
|
|
C...Initialize widths and partial widths for resonances.
|
|
CALL PYINRE
|
|
C...Set Z0 mass and width for e+e- routines.
|
|
PARJ(123)=PMAS(23,1)
|
|
PARJ(124)=PMAS(23,2)
|
|
|
|
C...Identify beam and target particles and frame of process.
|
|
CHFRAM=FRAME//' '
|
|
CHBEAM=BEAM//' '
|
|
CHTARG=TARGET//' '
|
|
CALL PYINBM(CHFRAM,CHBEAM,CHTARG,WIN)
|
|
IF(MINT(65).EQ.1) GOTO 170
|
|
|
|
C...For gamma-p or gamma-gamma allow many (3 or 6) alternatives.
|
|
C...For e-gamma allow 2 alternatives.
|
|
MINT(121)=1
|
|
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/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/,/PYPARS/,/PYINT1/,/PYINT2/,
|
|
&/PYINT4/,/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 260 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 270
|
|
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 250
|
|
|
|
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.
|
|
MINT(32)=0
|
|
IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10) CALL PYRESD(0)
|
|
IF(MINT(51).EQ.1) GOTO 100
|
|
MINT(52)=N
|
|
|
|
C...Multiple interactions.
|
|
IF(MSTP(81).GE.1.AND.MINT(50).EQ.1) CALL PYMULT(6)
|
|
MINT(53)=N
|
|
|
|
C...Hadron remnants and primordial kT.
|
|
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...Check that no odd resonance left undecayed.
|
|
IF(MSTP(111).GE.1) THEN
|
|
NFIX=N
|
|
DO 140 I=MINT(84)+1,NFIX
|
|
IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND.
|
|
& K(I,2).NE.22) THEN
|
|
IF(MWID(PYCOMP(K(I,2))).NE.0) THEN
|
|
CALL PYRESD(I)
|
|
IF(MINT(51).EQ.1) GOTO 100
|
|
ENDIF
|
|
ENDIF
|
|
140 CONTINUE
|
|
ENDIF
|
|
|
|
C...Recalculate energies from momenta and masses (if desired).
|
|
IF(MSTP(113).GE.1) THEN
|
|
DO 150 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)
|
|
150 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 180 I=MINT(84)+1,N
|
|
IF(K(I,2).EQ.94) THEN
|
|
DO 170 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 160 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
|
|
160 CONTINUE
|
|
IF(K(I+1,3).EQ.0) K(I+1,3)=K(I,3)
|
|
ENDIF
|
|
ENDIF
|
|
170 CONTINUE
|
|
ENDIF
|
|
180 CONTINUE
|
|
CALL PYEDIT(12)
|
|
CALL PYEDIT(14)
|
|
IF(MSTP(125).EQ.0) CALL PYEDIT(15)
|
|
IF(MSTP(125).EQ.0) MINT(4)=0
|
|
DO 200 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 190 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
|
|
190 CONTINUE
|
|
ENDIF
|
|
200 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 210 J=1,4
|
|
VTX(J)=PARP(150+J)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0))))*
|
|
& SIN(PARU(2)*PYR(0))
|
|
210 CONTINUE
|
|
DO 230 I=MINT(83)+1,N
|
|
DO 220 J=1,4
|
|
V(I,J)=V(I,J)+VTX(J)
|
|
220 CONTINUE
|
|
230 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 240 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)
|
|
240 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.
|
|
250 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)
|
|
260 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.
|
|
270 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...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,
|
|
&/PYINT2/,/PYINT4/,/PYINT5/,/PYINT6/,/PYMSSM/
|
|
C...Local arrays, character variables and data.
|
|
DIMENSION WDTP(0:200),WDTE(0:200,0:5)
|
|
CHARACTER PROGA(6)*28,CHAU*16,CHKF*16,CHD1*16,CHD2*16,CHD3*16,
|
|
&CHIN(2)*12,STATE(-1:5)*4,CHKIN(21)*18,DISGA(2)*28
|
|
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 140 KC=1,500
|
|
KF=KCHG(KC,4)
|
|
CALL PYNAME(KF,CHKF)
|
|
IOFF=0
|
|
IF(KC.LE.22) THEN
|
|
IF(KC.GT.2*MSTP(1).AND.KC.LE.10) GOTO 140
|
|
IF(KC.GT.10+2*MSTP(1).AND.KC.LE.20) GOTO 140
|
|
IF(KC.LE.5.OR.(KC.GE.11.AND.KC.LE.16)) IOFF=1
|
|
IF(KC.EQ.18.AND.PMAS(18,1).LT.1D0) IOFF=1
|
|
IF(KC.EQ.21.OR.KC.EQ.22) IOFF=1
|
|
ELSE
|
|
IF(MWID(KC).LE.0) GOTO 140
|
|
IF(IMSS(1).LE.0.AND.(KF/KSUSY1.EQ.1.OR.
|
|
& KF/KSUSY1.EQ.2)) GOTO 140
|
|
ENDIF
|
|
C...Off-shell branchings.
|
|
IF(IOFF.EQ.1) THEN
|
|
NGP=0
|
|
IF(KC.LE.20) NGP=(MOD(KC,10)+1)/2
|
|
IF(NGP.LE.MSTP(1)) WRITE(MSTU(11),5700) KF,CHKF(1:10),
|
|
& PMAS(KC,1),0D0,0D0,STATE(MDCY(KC,1)),0D0
|
|
DO 120 J=1,MDCY(KC,3)
|
|
IDC=J+MDCY(KC,2)-1
|
|
NGP1=0
|
|
IF(IABS(KFDP(IDC,1)).LE.20) NGP1=
|
|
& (MOD(IABS(KFDP(IDC,1)),10)+1)/2
|
|
NGP2=0
|
|
IF(IABS(KFDP(IDC,2)).LE.20) NGP2=
|
|
& (MOD(IABS(KFDP(IDC,2)),10)+1)/2
|
|
CALL PYNAME(KFDP(IDC,1),CHD1)
|
|
CALL PYNAME(KFDP(IDC,2),CHD2)
|
|
IF(KFDP(IDC,3).EQ.0) THEN
|
|
IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND.
|
|
& NGP2.LE.MSTP(1)) WRITE(MSTU(11),5800) IDC,CHD1(1:10),
|
|
& CHD2(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0
|
|
ELSE
|
|
CALL PYNAME(KFDP(IDC,3),CHD3)
|
|
IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND.
|
|
& NGP2.LE.MSTP(1)) WRITE(MSTU(11),5850) IDC,CHD1(1:10),
|
|
& CHD2(1:10),CHD3(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0
|
|
ENDIF
|
|
120 CONTINUE
|
|
C...On-shell decays.
|
|
ELSE
|
|
CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE)
|
|
BRFIN=1D0
|
|
IF(WDTE(0,0).LE.0D0) BRFIN=0D0
|
|
WRITE(MSTU(11),5700) KF,CHKF(1:10),PMAS(KC,1),WDTP(0),1D0,
|
|
& STATE(MDCY(KC,1)),BRFIN
|
|
DO 130 J=1,MDCY(KC,3)
|
|
IDC=J+MDCY(KC,2)-1
|
|
NGP1=0
|
|
IF(IABS(KFDP(IDC,1)).LE.20) NGP1=
|
|
& (MOD(IABS(KFDP(IDC,1)),10)+1)/2
|
|
NGP2=0
|
|
IF(IABS(KFDP(IDC,2)).LE.20) NGP2=
|
|
& (MOD(IABS(KFDP(IDC,2)),10)+1)/2
|
|
BRFIN=0D0
|
|
IF(WDTE(0,0).GT.0D0) BRFIN=WDTE(J,0)/WDTE(0,0)
|
|
CALL PYNAME(KFDP(IDC,1),CHD1)
|
|
CALL PYNAME(KFDP(IDC,2),CHD2)
|
|
IF(KFDP(IDC,3).EQ.0) THEN
|
|
IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1))
|
|
& WRITE(MSTU(11),5800) IDC,CHD1(1:10),
|
|
& CHD2(1:10),WDTP(J),WDTP(J)/WDTP(0),
|
|
& STATE(MDME(IDC,1)),BRFIN
|
|
ELSE
|
|
CALL PYNAME(KFDP(IDC,3),CHD3)
|
|
IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1))
|
|
& WRITE(MSTU(11),5850) IDC,CHD1(1:10),
|
|
& CHD2(1:10),CHD3(1:10),WDTP(J),WDTP(J)/WDTP(0),
|
|
& STATE(MDME(IDC,1)),BRFIN
|
|
ENDIF
|
|
130 CONTINUE
|
|
ENDIF
|
|
140 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 150 I=-20,22
|
|
IF(I.EQ.0) GOTO 150
|
|
IA=IABS(I)
|
|
IF(IA.GT.MSTP(58).AND.IA.LE.10) GOTO 150
|
|
IF(IA.GT.10+2*MSTP(1).AND.IA.LE.20) GOTO 150
|
|
CALL PYNAME(I,CHAU)
|
|
WRITE(MSTU(11),6200) CHAU,STATE(KFIN(1,I)),CHAU,
|
|
& STATE(KFIN(2,I))
|
|
150 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 160 I=4,14
|
|
WRITE(MSTU(11),6600) CKIN(2*I-1),CHKIN(I),CKIN(2*I)
|
|
160 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 170 I=1,100
|
|
WRITE(MSTU(11),7200) I,MSTP(I),PARP(I),100+I,MSTP(100+I),
|
|
& PARP(100+I)
|
|
170 CONTINUE
|
|
|
|
C...List of all processes implemented in the program.
|
|
ELSEIF(MSTAT.EQ.6) THEN
|
|
WRITE(MSTU(11),7300)
|
|
WRITE(MSTU(11),7400)
|
|
DO 180 I=1,500
|
|
IF(ISET(I).LT.0) GOTO 180
|
|
WRITE(MSTU(11),7500) I,PROC(I),ISET(I),KFPR(I,1),KFPR(I,2)
|
|
180 CONTINUE
|
|
WRITE(MSTU(11),7600)
|
|
ENDIF
|
|
|
|
C...Formats for printouts.
|
|
5000 FORMAT('1',9('*'),1X,'PYSTAT: Statistics on Number of ',
|
|
&'Events and Cross-sections',1X,9('*'))
|
|
5100 FORMAT(/1X,78('=')/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',12X,
|
|
&'Subprocess',12X,'I',6X,'Number of points',6X,'I',4X,'Sigma',3X,
|
|
&'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',34('-'),'I',28('-'),
|
|
&'I',4X,'(mb)',4X,'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',1X,
|
|
&'N:o',1X,'Type',25X,'I',4X,'Generated',9X,'Tried',1X,'I',12X,
|
|
&'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/1X,'I',34X,'I',28X,
|
|
&'I',12X,'I')
|
|
5200 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I12,1X,I13,1X,'I',1X,1P,
|
|
&D10.3,1X,'I')
|
|
5300 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/
|
|
&1X,'I',34X,'I',28X,'I',12X,'I')
|
|
5400 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')//
|
|
&1X,'********* Fraction of events that fail fragmentation ',
|
|
&'cuts =',1X,F8.5,' *********'/)
|
|
5500 FORMAT('1',27('*'),1X,'PYSTAT: Decay Widths and Branching ',
|
|
&'Ratios',1X,27('*'))
|
|
5600 FORMAT(/1X,98('=')/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/
|
|
&1X,'I',5X,'Mother --> Branching/Decay Channel',8X,'I',1X,
|
|
&'Width (GeV)',1X,'I',7X,'B.R.',1X,'I',1X,'Stat',1X,'I',2X,
|
|
&'Eff. B.R.',1X,'I'/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/
|
|
&1X,98('='))
|
|
5700 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,'I',1X,
|
|
&I8,2X,A10,3X,'(m =',F10.3,')',2X,'-->',5X,'I',2X,1P,D10.3,0P,1X,
|
|
&'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,1P,D10.3,0P,1X,'I')
|
|
5800 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,15X,'I',2X,
|
|
&1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,
|
|
&1P,D10.3,0P,1X,'I')
|
|
5850 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,1X,'+',1X,A10,2X,'I',2X,
|
|
&1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,
|
|
&1P,D10.3,0P,1X,'I')
|
|
5900 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,98('='))
|
|
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)
|
|
7300 FORMAT('1',13('*'),1X,'PYSTAT: List of implemented processes',
|
|
&1X,13('*'))
|
|
7400 FORMAT(/1X,65('=')/1X,'I',34X,'I',28X,'I'/1X,'I',12X,
|
|
&'Subprocess',12X,'I',1X,'ISET',2X,'KFPR(I,1)',2X,'KFPR(I,2)',1X,
|
|
&'I'/1X,'I',34X,'I',28X,'I'/1X,65('=')/1X,'I',34X,'I',28X,'I')
|
|
7500 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I4,1X,I10,1X,I10,1X,'I')
|
|
7600 FORMAT(1X,'I',34X,'I',28X,'I'/1X,65('='))
|
|
|
|
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...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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
|
|
COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/,
|
|
&/PYINT1/,/PYINT2/,/PYINT4/,/PYINT6/,/PYMSSM/
|
|
C...Local arrays and data.
|
|
DIMENSION WDTP(0:200),WDTE(0:200,0:5),WDTPM(0:200),
|
|
&WDTEM(0:200,0:5),KCORD(500),PMORD(500)
|
|
|
|
C...Born level couplings in MSSM Higgs doublet sector.
|
|
XW=PARU(102)
|
|
XWV=XW
|
|
IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2
|
|
XW1=1D0-XW
|
|
IF(MSTP(4).EQ.2) THEN
|
|
TANBE=PARU(141)
|
|
RATBE=((1D0-TANBE**2)/(1D0+TANBE**2))**2
|
|
SQMZ=PMAS(23,1)**2
|
|
SQMW=PMAS(24,1)**2
|
|
SQMH=PMAS(25,1)**2
|
|
SQMA=SQMH*(SQMZ-SQMH)/(SQMZ*RATBE-SQMH)
|
|
SQMHP=0.5D0*(SQMA+SQMZ+SQRT((SQMA+SQMZ)**2-4D0*SQMA*SQMZ*RATBE))
|
|
SQMHC=SQMA+SQMW
|
|
IF(SQMH.GE.SQMZ.OR.MIN(SQMA,SQMHP,SQMHC).LE.0D0) THEN
|
|
WRITE(MSTU(11),5000)
|
|
STOP
|
|
ENDIF
|
|
PMAS(35,1)=SQRT(SQMHP)
|
|
PMAS(36,1)=SQRT(SQMA)
|
|
PMAS(37,1)=SQRT(SQMHC)
|
|
ALSU=0.5D0*ATAN(2D0*TANBE*(SQMA+SQMZ)/((1D0-TANBE**2)*
|
|
& (SQMA-SQMZ)))
|
|
BESU=ATAN(TANBE)
|
|
PARU(142)=1D0
|
|
PARU(143)=1D0
|
|
PARU(161)=-SIN(ALSU)/COS(BESU)
|
|
PARU(162)=COS(ALSU)/SIN(BESU)
|
|
PARU(163)=PARU(161)
|
|
PARU(164)=SIN(BESU-ALSU)
|
|
PARU(165)=PARU(164)
|
|
PARU(168)=SIN(BESU-ALSU)+0.5D0*COS(2D0*BESU)*SIN(BESU+ALSU)/XW
|
|
PARU(171)=COS(ALSU)/COS(BESU)
|
|
PARU(172)=SIN(ALSU)/SIN(BESU)
|
|
PARU(173)=PARU(171)
|
|
PARU(174)=COS(BESU-ALSU)
|
|
PARU(175)=PARU(174)
|
|
PARU(176)=COS(2D0*ALSU)*COS(BESU+ALSU)-2D0*SIN(2D0*ALSU)*
|
|
& SIN(BESU+ALSU)
|
|
PARU(177)=COS(2D0*BESU)*COS(BESU+ALSU)
|
|
PARU(178)=COS(BESU-ALSU)-0.5D0*COS(2D0*BESU)*COS(BESU+ALSU)/XW
|
|
PARU(181)=TANBE
|
|
PARU(182)=1D0/TANBE
|
|
PARU(183)=PARU(181)
|
|
PARU(184)=0D0
|
|
PARU(185)=PARU(184)
|
|
PARU(186)=COS(BESU-ALSU)
|
|
PARU(187)=SIN(BESU-ALSU)
|
|
PARU(188)=PARU(186)
|
|
PARU(189)=PARU(187)
|
|
PARU(190)=0D0
|
|
PARU(195)=COS(BESU-ALSU)
|
|
ENDIF
|
|
|
|
C...Reset effective widths of gauge bosons.
|
|
DO 110 I=1,500
|
|
DO 100 J=1,5
|
|
WIDS(I,J)=1D0
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
C...Order resonances by increasing mass (except Z0 and W+/-).
|
|
NRES=0
|
|
DO 140 KC=1,500
|
|
KF=KCHG(KC,4)
|
|
IF(KF.EQ.0) GOTO 140
|
|
IF(MWID(KC).EQ.0) GOTO 140
|
|
IF(KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18) THEN
|
|
IF(MSTP(1).LE.3) GOTO 140
|
|
ENDIF
|
|
IF(KF/KSUSY1.EQ.1.OR.KF/KSUSY1.EQ.2) THEN
|
|
IF(IMSS(1).LE.0) GOTO 140
|
|
ENDIF
|
|
NRES=NRES+1
|
|
PMRES=PMAS(KC,1)
|
|
IF(KC.EQ.23.OR.KC.EQ.24) PMRES=0D0
|
|
DO 120 I1=NRES-1,1,-1
|
|
IF(PMRES.GE.PMORD(I1)) GOTO 130
|
|
KCORD(I1+1)=KCORD(I1)
|
|
PMORD(I1+1)=PMORD(I1)
|
|
120 CONTINUE
|
|
130 KCORD(I1+1)=KC
|
|
PMORD(I1+1)=PMRES
|
|
140 CONTINUE
|
|
|
|
C...Loop over possible resonances.
|
|
DO 180 I=1,NRES
|
|
KC=KCORD(I)
|
|
KF=KCHG(KC,4)
|
|
|
|
C...Check that no fourth generation channels on by mistake.
|
|
IF(MSTP(1).LE.3) THEN
|
|
DO 150 J=1,MDCY(KC,3)
|
|
IDC=J+MDCY(KC,2)-1
|
|
KFA1=IABS(KFDP(IDC,1))
|
|
KFA2=IABS(KFDP(IDC,2))
|
|
IF(KFA1.EQ.7.OR.KFA1.EQ.8.OR.KFA1.EQ.17.OR.KFA1.EQ.18.OR.
|
|
& KFA2.EQ.7.OR.KFA2.EQ.8.OR.KFA2.EQ.17.OR.KFA2.EQ.18)
|
|
& MDME(IDC,1)=-1
|
|
150 CONTINUE
|
|
ENDIF
|
|
|
|
C...Check that no supersymmetric channels on by mistake.
|
|
IF(IMSS(1).LE.0) THEN
|
|
DO 160 J=1,MDCY(KC,3)
|
|
IDC=J+MDCY(KC,2)-1
|
|
KFA1S=IABS(KFDP(IDC,1))/KSUSY1
|
|
KFA2S=IABS(KFDP(IDC,2))/KSUSY1
|
|
IF(KFA1S.EQ.1.OR.KFA1S.EQ.2.OR.KFA2S.EQ.1.OR.KFA2S.EQ.2)
|
|
& MDME(IDC,1)=-1
|
|
160 CONTINUE
|
|
ENDIF
|
|
|
|
C...Find mass and evaluate width.
|
|
PMR=PMAS(KC,1)
|
|
IF(KF.EQ.25.OR.KF.EQ.35.OR.KF.EQ.36) MINT(62)=1
|
|
IF(MWID(KC).EQ.3) MINT(63)=1
|
|
CALL PYWIDT(KF,PMR**2,WDTP,WDTE)
|
|
MINT(51)=0
|
|
|
|
C...Evaluate suppression factors due to non-simulated channels.
|
|
IF(KCHG(KC,3).EQ.0) THEN
|
|
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
|
|
IF(MWID(KC).EQ.3) MINT(63)=1
|
|
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.OR.MWID(KC).EQ.3) 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 170 J=1,MDCY(KC,3)
|
|
IDC=J+MDCY(KC,2)-1
|
|
BRAT(IDC)=0D0
|
|
IF(WDTP(0).GT.0D0) BRAT(IDC)=WDTP(J)/WDTP(0)
|
|
170 CONTINUE
|
|
ENDIF
|
|
180 CONTINUE
|
|
|
|
C...Flavours of leptoquark: redefine charge and name.
|
|
KFLQQ=KFDP(MDCY(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
|
|
|
|
CMRENNA++Define SUSY alternatives.
|
|
ELSEIF(MSEL.EQ.39) THEN
|
|
C...Turn on all SUSY processes.
|
|
IF(MINT(43).EQ.4) THEN
|
|
C...Hadron-hadron processes.
|
|
DO 160 I=201,280
|
|
IF(ISET(I).GE.0) MSUB(I)=1
|
|
160 CONTINUE
|
|
ELSEIF(MINT(43).EQ.1) THEN
|
|
C...Lepton-lepton processes: QED production of squarks.
|
|
DO 170 I=201,214
|
|
MSUB(I)=1
|
|
170 CONTINUE
|
|
MSUB(210)=0
|
|
MSUB(211)=0
|
|
MSUB(212)=0
|
|
DO 180 I=216,228
|
|
MSUB(I)=1
|
|
180 CONTINUE
|
|
DO 190 I=261,263
|
|
MSUB(I)=1
|
|
190 CONTINUE
|
|
MSUB(277)=1
|
|
MSUB(278)=1
|
|
ENDIF
|
|
|
|
ELSEIF(MSEL.EQ.40) THEN
|
|
C...Gluinos and squarks.
|
|
IF(MINT(43).EQ.4) THEN
|
|
MSUB(243)=1
|
|
MSUB(244)=1
|
|
MSUB(258)=1
|
|
MSUB(259)=1
|
|
MSUB(261)=1
|
|
MSUB(262)=1
|
|
MSUB(264)=1
|
|
MSUB(265)=1
|
|
DO 200 I=271,280
|
|
MSUB(I)=1
|
|
200 CONTINUE
|
|
ELSEIF(MINT(43).EQ.1) THEN
|
|
MSUB(277)=1
|
|
MSUB(278)=1
|
|
ENDIF
|
|
|
|
ELSEIF(MSEL.EQ.41) THEN
|
|
C...Stop production.
|
|
MSUB(261)=1
|
|
MSUB(262)=1
|
|
MSUB(263)=1
|
|
IF(MINT(43).EQ.4) THEN
|
|
MSUB(264)=1
|
|
MSUB(265)=1
|
|
ENDIF
|
|
|
|
ELSEIF(MSEL.EQ.42) THEN
|
|
C...Slepton production.
|
|
DO 210 I=201,214
|
|
MSUB(I)=1
|
|
210 CONTINUE
|
|
IF(MINT(43).NE.4) THEN
|
|
MSUB(210)=0
|
|
MSUB(211)=0
|
|
MSUB(212)=0
|
|
ENDIF
|
|
|
|
ELSEIF(MSEL.EQ.43) THEN
|
|
C...Neutralino/Chargino + Gluino/Squark.
|
|
IF(MINT(43).EQ.4) THEN
|
|
DO 220 I=237,242
|
|
MSUB(I)=1
|
|
220 CONTINUE
|
|
DO 230 I=246,257
|
|
MSUB(I)=1
|
|
230 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(MSEL.EQ.44) THEN
|
|
C...Neutralino/Chargino pair production.
|
|
IF(MINT(43).EQ.4) THEN
|
|
DO 240 I=216,236
|
|
MSUB(I)=1
|
|
240 CONTINUE
|
|
ELSEIF(MINT(43).EQ.1) THEN
|
|
DO 250 I=216,228
|
|
MSUB(I)=1
|
|
250 CONTINUE
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Find heaviest new quark flavour allowed in processes 81-84.
|
|
KFLQM=1
|
|
DO 260 I=1,MIN(8,MDCY(21,3))
|
|
IDC=I+MDCY(21,2)-1
|
|
IF(MDME(IDC,1).LE.0) GOTO 260
|
|
KFLQM=I
|
|
260 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 270 I=1,MIN(12,MDCY(22,3))
|
|
IDC=I+MDCY(22,2)-1
|
|
IF(MDME(IDC,1).LE.0) GOTO 270
|
|
KFLFM=KFDP(IDC,1)
|
|
270 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.PMA+PMB+PARP(104)) GOTO 110
|
|
|
|
C...Total cross-section. Elastic slope parameter and cross-section.
|
|
SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA
|
|
BEL=2D0*BHA+2D0*BHB+4D0*SEPS-4.2D0
|
|
SIGTMP(I,1)=FACEL*SIGTMP(I,0)**2/BEL
|
|
|
|
C...Diffractive scattering A + B -> X + B.
|
|
BSD=2D0*BHB
|
|
SQML=(PMA+PMTH)**2
|
|
SQMU=S*CEFFS(ISD,1)+CEFFS(ISD,2)
|
|
SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/
|
|
& (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP)
|
|
BXB=CEFFS(ISD,3)+CEFFS(ISD,4)/S
|
|
SUM2=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)/
|
|
& (BSD+2D0*ALP*LOG(S/((PMA+PMTH)*(PMA+PMRC)))+BXB)
|
|
SIGTMP(I,2)=FACSD*XPAR(IPR)*BETP(IHB)*MAX(0D0,SUM1+SUM2)
|
|
|
|
C...Diffractive scattering A + B -> A + X.
|
|
BSD=2D0*BHA
|
|
SQML=(PMB+PMTH)**2
|
|
SQMU=S*CEFFS(ISD,5)+CEFFS(ISD,6)
|
|
SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/
|
|
& (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP)
|
|
BAX=CEFFS(ISD,7)+CEFFS(ISD,8)/S
|
|
SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/
|
|
& (BSD+2D0*ALP*LOG(S/((PMB+PMTH)*(PMB+PMRC)))+BAX)
|
|
SIGTMP(I,3)=FACSD*XPAR(IPR)*BETP(IHA)*MAX(0D0,SUM1+SUM2)
|
|
|
|
C...Order single diffractive correctly.
|
|
IF(IORD.EQ.2) THEN
|
|
SIGSAV=SIGTMP(I,2)
|
|
SIGTMP(I,2)=SIGTMP(I,3)
|
|
SIGTMP(I,3)=SIGSAV
|
|
ENDIF
|
|
|
|
C...Double diffractive scattering A + B -> X1 + X2.
|
|
YEFF=LOG(S*SMP/((PMA+PMTH)*(PMB+PMTH))**2)
|
|
DEFF=CEFFD(IDD,1)+CEFFD(IDD,2)/SLOG+CEFFD(IDD,3)/SLOG**2
|
|
SUM1=DEFF+YEFF*(LOG(MAX(1D-10,YEFF/DEFF))-1D0)/(2D0*ALP)
|
|
IF(YEFF.LE.0) SUM1=0D0
|
|
SQMU=S*(CEFFD(IDD,4)+CEFFD(IDD,5)/SLOG+CEFFD(IDD,6)/SLOG**2)
|
|
SLUP=LOG(MAX(1.1D0,S/(ALP*(PMA+PMTH)**2*(PMB+PMTH)*(PMB+PMRC))))
|
|
SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMB+PMTH)*(PMB+PMRC))))
|
|
SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)*LOG(SLUP/SLDN)/
|
|
& (2D0*ALP)
|
|
SLUP=LOG(MAX(1.1D0,S/(ALP*(PMB+PMTH)**2*(PMA+PMTH)*(PMA+PMRC))))
|
|
SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMA+PMTH)*(PMA+PMRC))))
|
|
SUM3=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*LOG(SLUP/SLDN)/
|
|
& (2D0*ALP)
|
|
BXX=CEFFD(IDD,7)+CEFFD(IDD,8)/SRT+CEFFD(IDD,9)/S
|
|
SLRR=LOG(S/(ALP*(PMA+PMTH)*(PMA+PMRC)*(PMB+PMTH)*(PMB*PMRC)))
|
|
SUM4=CRES**2*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*
|
|
& LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/MAX(0.1D0,2D0*ALP*SLRR+BXX)
|
|
SIGTMP(I,4)=FACDD*XPAR(IPR)*MAX(0D0,SUM1+SUM2+SUM3+SUM4)
|
|
|
|
C...Non-diffractive by unitarity.
|
|
SIGTMP(I,5)=SIGTMP(I,0)-SIGTMP(I,1)-SIGTMP(I,2)-SIGTMP(I,3)-
|
|
& SIGTMP(I,4)
|
|
110 CONTINUE
|
|
|
|
C...Put temporary results in output array: only one process.
|
|
IF(MINT(101).EQ.1.AND.MINT(102).EQ.1) THEN
|
|
DO 120 J=0,5
|
|
SIGT(0,0,J)=SIGTMP(1,J)
|
|
120 CONTINUE
|
|
|
|
C...Beam multiple processes.
|
|
ELSEIF(MINT(101).EQ.4.AND.MINT(102).EQ.1) THEN
|
|
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...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
|
|
COMMON/PYINT4/MWID(500),WIDS(500,5)
|
|
COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
|
|
COMMON/PYINT6/PROC(0:500)
|
|
CHARACTER PROC*28
|
|
COMMON/PYINT7/SIGT(0:6,0:6,0:5)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,
|
|
&/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT6/,/PYINT7/
|
|
C...Local arrays, character variables and data.
|
|
CHARACTER CVAR(4)*4
|
|
DIMENSION NPTS(4),MVARPT(500,4),VINTPT(500,30),SIGSPT(500),
|
|
&NAREL(7),WTREL(7),WTMAT(7,7),WTRELN(7),COEFU(7),COEFO(7),
|
|
&IACCMX(4),SIGSMX(4),SIGSSM(3),PMMN(2)
|
|
DATA CVAR/'tau ','tau''','y* ','cth '/
|
|
DATA SIGSSM/3*0D0/
|
|
|
|
C...Select subprocess to study: skip cases not applicable.
|
|
NPOSI=0
|
|
VINT(143)=1D0
|
|
VINT(144)=1D0
|
|
XSEC(0,1)=0D0
|
|
DO 460 ISUB=1,500
|
|
MINT(51)=0
|
|
IF(ISET(ISUB).EQ.11) THEN
|
|
XSEC(ISUB,1)=1.00001D0*COEF(ISUB,1)
|
|
NPOSI=NPOSI+1
|
|
GOTO 450
|
|
ELSEIF(ISUB.GE.91.AND.ISUB.LE.95) THEN
|
|
XSEC(ISUB,1)=SIGT(0,0,ISUB-90)
|
|
IF(MSUB(ISUB).NE.1) GOTO 460
|
|
NPOSI=NPOSI+1
|
|
GOTO 450
|
|
ELSEIF(ISUB.EQ.96) THEN
|
|
IF(MINT(50).EQ.0) GOTO 460
|
|
IF(MSUB(95).NE.1.AND.MSTP(81).LE.0.AND.MSTP(131).LE.0)
|
|
& GOTO 460
|
|
IF(MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 460
|
|
ELSEIF(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.ISUB.EQ.28.OR.
|
|
& ISUB.EQ.53.OR.ISUB.EQ.68) THEN
|
|
IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460
|
|
ELSE
|
|
IF(MSUB(ISUB).NE.1) GOTO 460
|
|
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
|
|
ELSEIF(ISUB.EQ.194) THEN
|
|
KFR1=54
|
|
ENDIF
|
|
CKMX=CKIN(2)
|
|
IF(CKMX.LE.0D0) CKMX=VINT(1)
|
|
KCR1=PYCOMP(KFR1)
|
|
IF(KFR1.NE.0) THEN
|
|
IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR.
|
|
& CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0
|
|
ENDIF
|
|
IF(KFR1.NE.0) THEN
|
|
TAUR1=PMAS(KCR1,1)**2/VINT(2)
|
|
GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2)
|
|
MINT(72)=1
|
|
MINT(73)=KFR1
|
|
VINT(73)=TAUR1
|
|
VINT(74)=GAMR1
|
|
ENDIF
|
|
KFR2=0
|
|
IF(ISUB.EQ.141.OR.ISUB.EQ.194) THEN
|
|
KFR2=23
|
|
IF(ISUB.EQ.194) KFR2=56
|
|
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
|
|
KFR2=0
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Find product masses and minimum pT of process.
|
|
SQM3=0D0
|
|
SQM4=0D0
|
|
MINT(71)=0
|
|
VINT(71)=CKIN(3)
|
|
VINT(80)=1D0
|
|
IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
|
|
NBW=0
|
|
DO 110 I=1,2
|
|
PMMN(I)=0D0
|
|
IF(KFPR(ISUB,I).EQ.0) THEN
|
|
ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT.
|
|
& PARP(41)) THEN
|
|
IF(I.EQ.1) SQM3=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2
|
|
IF(I.EQ.2) SQM4=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2
|
|
ELSE
|
|
NBW=NBW+1
|
|
C...This prevents SUSY/t particles from becoming too light.
|
|
KFLW=KFPR(ISUB,I)
|
|
IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN
|
|
KCW=PYCOMP(KFLW)
|
|
PMMN(I)=PMAS(KCW,1)
|
|
DO 100 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1
|
|
IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN
|
|
PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+
|
|
& PMAS(PYCOMP(KFDP(IDC,2)),1)
|
|
IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+
|
|
& PMAS(PYCOMP(KFDP(IDC,3)),1)
|
|
PMMN(I)=MIN(PMMN(I),PMSUM)
|
|
ENDIF
|
|
100 CONTINUE
|
|
ELSEIF(KFLW.EQ.6) THEN
|
|
PMMN(I)=PMAS(24,1)+PMAS(5,1)
|
|
ENDIF
|
|
ENDIF
|
|
110 CONTINUE
|
|
IF(NBW.GE.1) THEN
|
|
CKIN41=CKIN(41)
|
|
CKIN43=CKIN(43)
|
|
CKIN(41)=MAX(PMMN(1),CKIN(41))
|
|
CKIN(43)=MAX(PMMN(2),CKIN(43))
|
|
CALL PYOFSH(3,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4)
|
|
CKIN(41)=CKIN41
|
|
CKIN(43)=CKIN43
|
|
IF(MINT(51).EQ.1) THEN
|
|
WRITE(MSTU(11),5100) ISUB
|
|
MSUB(ISUB)=0
|
|
GOTO 460
|
|
ENDIF
|
|
SQM3=PQM3**2
|
|
SQM4=PQM4**2
|
|
ENDIF
|
|
IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) MINT(71)=1
|
|
IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5))
|
|
IF(ISUB.EQ.96.AND.MSTP(82).LE.1) VINT(71)=PARP(81)
|
|
IF(ISUB.EQ.96.AND.MSTP(82).GE.2) VINT(71)=0.08D0*PARP(82)
|
|
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) NPTS(1)=1
|
|
ELSEIF(MINT(47).EQ.5) THEN
|
|
IF(ISTSB.LE.2.OR.ISTSB.GT.5) NPTS(1)=NPTS(1)+1
|
|
ENDIF
|
|
NPTS(2)=1
|
|
IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN
|
|
IF(MINT(47).GE.2) NPTS(2)=2
|
|
IF(MINT(47).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) NPTS(4)=5
|
|
NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4)
|
|
|
|
C...Reset coefficients of cross-section weighting.
|
|
DO 120 J=1,20
|
|
COEF(ISUB,J)=0D0
|
|
120 CONTINUE
|
|
COEF(ISUB,1)=1D0
|
|
COEF(ISUB,8)=0.5D0
|
|
COEF(ISUB,9)=0.5D0
|
|
COEF(ISUB,13)=1D0
|
|
COEF(ISUB,18)=1D0
|
|
MCTH=0
|
|
MTAUP=0
|
|
METAUP=0
|
|
VINT(23)=0D0
|
|
VINT(26)=0D0
|
|
SIGSAM=0D0
|
|
|
|
C...Find limits and select tau, y*, cos(theta-hat) and tau' values,
|
|
C...in grid of phase space points.
|
|
CALL PYKLIM(1)
|
|
METAU=MINT(51)
|
|
NACC=0
|
|
DO 150 ITRY=1,NTRY
|
|
MINT(51)=0
|
|
IF(METAU.EQ.1) GOTO 150
|
|
IF(MOD(ITRY-1,NPTS(2)*NPTS(3)*NPTS(4)).EQ.0) THEN
|
|
MTAU=1+(ITRY-1)/(NPTS(2)*NPTS(3)*NPTS(4))
|
|
IF(MTAU.GT.2+2*MINT(72)) MTAU=7
|
|
RTAU=0.5D0
|
|
C...Special case when both resonances have same mass,
|
|
C...as is often the case in process 194.
|
|
IF(MINT(72).EQ.2) THEN
|
|
IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LT.
|
|
& 0.01D0*(PMAS(KCR2,1)+PMAS(KCR1,1))) THEN
|
|
IF(MTAU.EQ.3.OR.MTAU.EQ.4) THEN
|
|
RTAU=0.4D0
|
|
ELSEIF(MTAU.EQ.5.OR.MTAU.EQ.6) THEN
|
|
RTAU=0.6D0
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
CALL PYKMAP(1,MTAU,RTAU)
|
|
IF(ISTSB.GE.3.AND.ISTSB.LE.5) CALL PYKLIM(4)
|
|
METAUP=MINT(51)
|
|
ENDIF
|
|
IF(METAUP.EQ.1) GOTO 150
|
|
IF(ISTSB.GE.3.AND.ISTSB.LE.5.AND.MOD(ITRY-1,NPTS(3)*NPTS(4))
|
|
& .EQ.0) THEN
|
|
MTAUP=1+MOD((ITRY-1)/(NPTS(3)*NPTS(4)),NPTS(2))
|
|
CALL PYKMAP(4,MTAUP,0.5D0)
|
|
ENDIF
|
|
IF(MOD(ITRY-1,NPTS(3)*NPTS(4)).EQ.0) THEN
|
|
CALL PYKLIM(2)
|
|
MEYST=MINT(51)
|
|
ENDIF
|
|
IF(MEYST.EQ.1) GOTO 150
|
|
IF(MOD(ITRY-1,NPTS(4)).EQ.0) THEN
|
|
MYST=1+MOD((ITRY-1)/NPTS(4),NPTS(3))
|
|
IF(MYST.EQ.4.AND.MINT(45).NE.3) MYST=5
|
|
CALL PYKMAP(2,MYST,0.5D0)
|
|
CALL PYKLIM(3)
|
|
MECTH=MINT(51)
|
|
ENDIF
|
|
IF(MECTH.EQ.1) GOTO 150
|
|
IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
|
|
MCTH=1+MOD(ITRY-1,NPTS(4))
|
|
CALL PYKMAP(3,MCTH,0.5D0)
|
|
ENDIF
|
|
IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1D0-VINT(23)**2)
|
|
|
|
C...Store position and limits.
|
|
MINT(51)=0
|
|
CALL PYKLIM(0)
|
|
IF(MINT(51).EQ.1) GOTO 150
|
|
NACC=NACC+1
|
|
MVARPT(NACC,1)=MTAU
|
|
MVARPT(NACC,2)=MTAUP
|
|
MVARPT(NACC,3)=MYST
|
|
MVARPT(NACC,4)=MCTH
|
|
DO 130 J=1,30
|
|
VINTPT(NACC,J)=VINT(10+J)
|
|
130 CONTINUE
|
|
|
|
C...Normal case: calculate cross-section.
|
|
IF(ISTSB.NE.5) THEN
|
|
CALL PYSIGH(NCHN,SIGS)
|
|
IF(MWTXS.EQ.1) THEN
|
|
CALL PYEVWT(WTXS)
|
|
SIGS=WTXS*SIGS
|
|
ENDIF
|
|
|
|
C..2 -> 3: find highest value out of a number of tries.
|
|
ELSE
|
|
SIGS=0D0
|
|
DO 140 IKIN3=1,MSTP(129)
|
|
CALL PYKMAP(5,0,0D0)
|
|
IF(MINT(51).EQ.1) GOTO 140
|
|
CALL PYSIGH(NCHN,SIGTMP)
|
|
IF(MWTXS.EQ.1) THEN
|
|
CALL PYEVWT(WTXS)
|
|
SIGTMP=WTXS*SIGTMP
|
|
ENDIF
|
|
IF(SIGTMP.GT.SIGS) SIGS=SIGTMP
|
|
140 CONTINUE
|
|
ENDIF
|
|
|
|
C...Store cross-section.
|
|
SIGSPT(NACC)=SIGS
|
|
IF(SIGS.GT.SIGSAM) SIGSAM=SIGS
|
|
IF(MSTP(122).GE.2) WRITE(MSTU(11),5200) MTAU,MYST,MCTH,MTAUP,
|
|
& VINT(21),VINT(22),VINT(23),VINT(26),SIGS
|
|
150 CONTINUE
|
|
IF(NACC.EQ.0) THEN
|
|
WRITE(MSTU(11),5100) ISUB
|
|
MSUB(ISUB)=0
|
|
GOTO 460
|
|
ELSEIF(SIGSAM.EQ.0D0) THEN
|
|
WRITE(MSTU(11),5300) ISUB
|
|
MSUB(ISUB)=0
|
|
GOTO 460
|
|
ENDIF
|
|
IF(ISUB.NE.96) NPOSI=NPOSI+1
|
|
|
|
C...Calculate integrals in tau over maximal phase space limits.
|
|
TAUMIN=VINT(11)
|
|
TAUMAX=VINT(31)
|
|
ATAU1=LOG(TAUMAX/TAUMIN)
|
|
IF(NPTS(1).GE.2) THEN
|
|
ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN)
|
|
ENDIF
|
|
IF(NPTS(1).GE.4) THEN
|
|
ATAU3=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1
|
|
ATAU4=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/
|
|
& GAMR1
|
|
ENDIF
|
|
IF(NPTS(1).GE.6) THEN
|
|
ATAU5=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2
|
|
ATAU6=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/
|
|
& GAMR2
|
|
ENDIF
|
|
IF(NPTS(1).GT.2+2*MINT(72)) THEN
|
|
ATAU7=LOG(MAX(2D-6,1D0-TAUMIN)/MAX(2D-6,1D0-TAUMAX))
|
|
ENDIF
|
|
|
|
C...Reset. Sum up cross-sections in points calculated.
|
|
DO 320 IVAR=1,4
|
|
IF(NPTS(IVAR).EQ.1) GOTO 320
|
|
IF(ISUB.EQ.96.AND.IVAR.EQ.4) GOTO 320
|
|
NBIN=NPTS(IVAR)
|
|
DO 170 J1=1,NBIN
|
|
NAREL(J1)=0
|
|
WTREL(J1)=0D0
|
|
COEFU(J1)=0D0
|
|
DO 160 J2=1,NBIN
|
|
WTMAT(J1,J2)=0D0
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
DO 180 IACC=1,NACC
|
|
IBIN=MVARPT(IACC,IVAR)
|
|
IF(IVAR.EQ.1.AND.IBIN.EQ.7) IBIN=3+2*MINT(72)
|
|
IF(IVAR.EQ.3.AND.IBIN.EQ.5.AND.MINT(45).NE.3) IBIN=4
|
|
NAREL(IBIN)=NAREL(IBIN)+1
|
|
WTREL(IBIN)=WTREL(IBIN)+SIGSPT(IACC)
|
|
|
|
C...Sum up tau cross-section pieces in points used.
|
|
IF(IVAR.EQ.1) THEN
|
|
TAU=VINTPT(IACC,11)
|
|
WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0
|
|
WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAU1/ATAU2)/TAU
|
|
IF(NBIN.GE.4) THEN
|
|
WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAU1/ATAU3)/(TAU+TAUR1)
|
|
WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ATAU1/ATAU4)*TAU/
|
|
& ((TAU-TAUR1)**2+GAMR1**2)
|
|
ENDIF
|
|
IF(NBIN.GE.6) THEN
|
|
WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ATAU1/ATAU5)/(TAU+TAUR2)
|
|
WTMAT(IBIN,6)=WTMAT(IBIN,6)+(ATAU1/ATAU6)*TAU/
|
|
& ((TAU-TAUR2)**2+GAMR2**2)
|
|
ENDIF
|
|
IF(NBIN.GT.2+2*MINT(72)) THEN
|
|
WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(ATAU1/ATAU7)*
|
|
& TAU/MAX(2D-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
|
|
180 CONTINUE
|
|
|
|
C...Check that equation system solvable.
|
|
IF(MSTP(122).GE.2) WRITE(MSTU(11),5400) CVAR(IVAR)
|
|
MSOLV=1
|
|
WTRELS=0D0
|
|
DO 190 IBIN=1,NBIN
|
|
IF(MSTP(122).GE.2) WRITE(MSTU(11),5500) (WTMAT(IBIN,IRED),
|
|
& IRED=1,NBIN),WTREL(IBIN)
|
|
IF(NAREL(IBIN).EQ.0) MSOLV=0
|
|
WTRELS=WTRELS+WTREL(IBIN)
|
|
190 CONTINUE
|
|
IF(ABS(WTRELS).LT.1D-20) MSOLV=0
|
|
|
|
C...Solve to find relative importance of cross-section pieces.
|
|
IF(MSOLV.EQ.1) THEN
|
|
DO 200 IBIN=1,NBIN
|
|
WTRELN(IBIN)=MAX(0.1D0,WTREL(IBIN)/WTRELS)
|
|
200 CONTINUE
|
|
DO 230 IRED=1,NBIN-1
|
|
DO 220 IBIN=IRED+1,NBIN
|
|
IF(ABS(WTMAT(IRED,IRED)).LT.1D-20) THEN
|
|
MSOLV=0
|
|
GOTO 260
|
|
ENDIF
|
|
RQT=WTMAT(IBIN,IRED)/WTMAT(IRED,IRED)
|
|
WTREL(IBIN)=WTREL(IBIN)-RQT*WTREL(IRED)
|
|
DO 210 ICOE=IRED,NBIN
|
|
WTMAT(IBIN,ICOE)=WTMAT(IBIN,ICOE)-RQT*WTMAT(IRED,ICOE)
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
230 CONTINUE
|
|
DO 250 IRED=NBIN,1,-1
|
|
DO 240 ICOE=IRED+1,NBIN
|
|
WTREL(IRED)=WTREL(IRED)-WTMAT(IRED,ICOE)*COEFU(ICOE)
|
|
240 CONTINUE
|
|
COEFU(IRED)=WTREL(IRED)/WTMAT(IRED,IRED)
|
|
250 CONTINUE
|
|
ENDIF
|
|
|
|
C...Share evenly if failure.
|
|
260 IF(MSOLV.EQ.0) THEN
|
|
DO 270 IBIN=1,NBIN
|
|
COEFU(IBIN)=1D0
|
|
WTRELN(IBIN)=0.1D0
|
|
IF(WTRELS.GT.0D0) WTRELN(IBIN)=MAX(0.1D0,
|
|
& WTREL(IBIN)/WTRELS)
|
|
270 CONTINUE
|
|
ENDIF
|
|
|
|
C...Normalize coefficients, with piece shared democratically.
|
|
COEFSU=0D0
|
|
WTRELS=0D0
|
|
DO 280 IBIN=1,NBIN
|
|
COEFU(IBIN)=MAX(0D0,COEFU(IBIN))
|
|
COEFSU=COEFSU+COEFU(IBIN)
|
|
WTRELS=WTRELS+WTRELN(IBIN)
|
|
280 CONTINUE
|
|
IF(COEFSU.GT.0D0) THEN
|
|
DO 290 IBIN=1,NBIN
|
|
COEFO(IBIN)=PARP(122)/NBIN+(1D0-PARP(122))*0.5D0*
|
|
& (COEFU(IBIN)/COEFSU+WTRELN(IBIN)/WTRELS)
|
|
290 CONTINUE
|
|
ELSE
|
|
DO 300 IBIN=1,NBIN
|
|
COEFO(IBIN)=1D0/NBIN
|
|
300 CONTINUE
|
|
ENDIF
|
|
IF(IVAR.EQ.1) IOFF=0
|
|
IF(IVAR.EQ.2) IOFF=17
|
|
IF(IVAR.EQ.3) IOFF=7
|
|
IF(IVAR.EQ.4) IOFF=12
|
|
DO 310 IBIN=1,NBIN
|
|
ICOF=IOFF+IBIN
|
|
IF(IVAR.EQ.1.AND.IBIN.GT.2+2*MINT(72)) ICOF=7
|
|
IF(IVAR.EQ.3.AND.IBIN.EQ.4.AND.MINT(45).NE.3) ICOF=ICOF+1
|
|
COEF(ISUB,ICOF)=COEFO(IBIN)
|
|
310 CONTINUE
|
|
IF(MSTP(122).GE.2) WRITE(MSTU(11),5600) CVAR(IVAR),
|
|
& (COEFO(IBIN),IBIN=1,NBIN)
|
|
320 CONTINUE
|
|
|
|
C...Find two most promising maxima among points previously determined.
|
|
DO 330 J=1,4
|
|
IACCMX(J)=0
|
|
SIGSMX(J)=0D0
|
|
330 CONTINUE
|
|
NMAX=0
|
|
DO 390 IACC=1,NACC
|
|
DO 340 J=1,30
|
|
VINT(10+J)=VINTPT(IACC,J)
|
|
340 CONTINUE
|
|
IF(ISTSB.NE.5) THEN
|
|
CALL PYSIGH(NCHN,SIGS)
|
|
IF(MWTXS.EQ.1) THEN
|
|
CALL PYEVWT(WTXS)
|
|
SIGS=WTXS*SIGS
|
|
ENDIF
|
|
ELSE
|
|
SIGS=0D0
|
|
DO 350 IKIN3=1,MSTP(129)
|
|
CALL PYKMAP(5,0,0D0)
|
|
IF(MINT(51).EQ.1) GOTO 350
|
|
CALL PYSIGH(NCHN,SIGTMP)
|
|
IF(MWTXS.EQ.1) THEN
|
|
CALL PYEVWT(WTXS)
|
|
SIGTMP=WTXS*SIGTMP
|
|
ENDIF
|
|
IF(SIGTMP.GT.SIGS) SIGS=SIGTMP
|
|
350 CONTINUE
|
|
ENDIF
|
|
IEQ=0
|
|
DO 360 IMV=1,NMAX
|
|
IF(ABS(SIGS-SIGSMX(IMV)).LT.1D-4*(SIGS+SIGSMX(IMV))) IEQ=IMV
|
|
360 CONTINUE
|
|
IF(IEQ.EQ.0) THEN
|
|
DO 370 IMV=NMAX,1,-1
|
|
IIN=IMV+1
|
|
IF(SIGS.LE.SIGSMX(IMV)) GOTO 380
|
|
IACCMX(IMV+1)=IACCMX(IMV)
|
|
SIGSMX(IMV+1)=SIGSMX(IMV)
|
|
370 CONTINUE
|
|
IIN=1
|
|
380 IACCMX(IIN)=IACC
|
|
SIGSMX(IIN)=SIGS
|
|
IF(NMAX.LE.1) NMAX=NMAX+1
|
|
ENDIF
|
|
390 CONTINUE
|
|
|
|
C...Read out starting position for search.
|
|
IF(MSTP(122).GE.2) WRITE(MSTU(11),5700)
|
|
SIGSAM=SIGSMX(1)
|
|
DO 440 IMAX=1,NMAX
|
|
IACC=IACCMX(IMAX)
|
|
MTAU=MVARPT(IACC,1)
|
|
MTAUP=MVARPT(IACC,2)
|
|
MYST=MVARPT(IACC,3)
|
|
MCTH=MVARPT(IACC,4)
|
|
VTAU=0.5D0
|
|
VYST=0.5D0
|
|
VCTH=0.5D0
|
|
VTAUP=0.5D0
|
|
|
|
C...Starting point and step size in parameter space.
|
|
DO 430 IRPT=1,2
|
|
DO 420 IVAR=1,4
|
|
IF(NPTS(IVAR).EQ.1) GOTO 420
|
|
IF(IVAR.EQ.1) VVAR=VTAU
|
|
IF(IVAR.EQ.2) VVAR=VTAUP
|
|
IF(IVAR.EQ.3) VVAR=VYST
|
|
IF(IVAR.EQ.4) VVAR=VCTH
|
|
IF(IVAR.EQ.1) MVAR=MTAU
|
|
IF(IVAR.EQ.2) MVAR=MTAUP
|
|
IF(IVAR.EQ.3) MVAR=MYST
|
|
IF(IVAR.EQ.4) MVAR=MCTH
|
|
IF(IRPT.EQ.1) VDEL=0.1D0
|
|
IF(IRPT.EQ.2) VDEL=MAX(0.01D0,MIN(0.05D0,VVAR-0.02D0,
|
|
& 0.98D0-VVAR))
|
|
IF(IRPT.EQ.1) VMAR=0.02D0
|
|
IF(IRPT.EQ.2) VMAR=0.002D0
|
|
IMOV0=1
|
|
IF(IRPT.EQ.1.AND.IVAR.EQ.1) IMOV0=0
|
|
DO 410 IMOV=IMOV0,8
|
|
|
|
C...Define new point in parameter space.
|
|
IF(IMOV.EQ.0) THEN
|
|
INEW=2
|
|
VNEW=VVAR
|
|
ELSEIF(IMOV.EQ.1) THEN
|
|
INEW=3
|
|
VNEW=VVAR+VDEL
|
|
ELSEIF(IMOV.EQ.2) THEN
|
|
INEW=1
|
|
VNEW=VVAR-VDEL
|
|
ELSEIF(SIGSSM(3).GE.MAX(SIGSSM(1),SIGSSM(2)).AND.
|
|
& VVAR+2D0*VDEL.LT.1D0-VMAR) THEN
|
|
VVAR=VVAR+VDEL
|
|
SIGSSM(1)=SIGSSM(2)
|
|
SIGSSM(2)=SIGSSM(3)
|
|
INEW=3
|
|
VNEW=VVAR+VDEL
|
|
ELSEIF(SIGSSM(1).GE.MAX(SIGSSM(2),SIGSSM(3)).AND.
|
|
& VVAR-2D0*VDEL.GT.VMAR) THEN
|
|
VVAR=VVAR-VDEL
|
|
SIGSSM(3)=SIGSSM(2)
|
|
SIGSSM(2)=SIGSSM(1)
|
|
INEW=1
|
|
VNEW=VVAR-VDEL
|
|
ELSEIF(SIGSSM(3).GE.SIGSSM(1)) THEN
|
|
VDEL=0.5D0*VDEL
|
|
VVAR=VVAR+VDEL
|
|
SIGSSM(1)=SIGSSM(2)
|
|
INEW=2
|
|
VNEW=VVAR
|
|
ELSE
|
|
VDEL=0.5D0*VDEL
|
|
VVAR=VVAR-VDEL
|
|
SIGSSM(3)=SIGSSM(2)
|
|
INEW=2
|
|
VNEW=VVAR
|
|
ENDIF
|
|
|
|
C...Convert to relevant variables and find derived new limits.
|
|
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) 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 400 IKIN3=1,MSTP(129)
|
|
CALL PYKMAP(5,0,0D0)
|
|
IF(MINT(51).EQ.1) GOTO 400
|
|
CALL PYSIGH(NCHN,SIGTMP)
|
|
IF(MWTXS.EQ.1) THEN
|
|
CALL PYEVWT(WTXS)
|
|
SIGTMP=WTXS*SIGTMP
|
|
ENDIF
|
|
IF(SIGTMP.GT.SIGS) SIGS=SIGTMP
|
|
400 CONTINUE
|
|
ENDIF
|
|
SIGSSM(INEW)=SIGS
|
|
IF(SIGS.GT.SIGSAM) SIGSAM=SIGS
|
|
IF(MSTP(122).GE.2) WRITE(MSTU(11),5800) IMAX,IVAR,MVAR,
|
|
& IMOV,VNEW,VINT(21),VINT(22),VINT(23),VINT(26),SIGS
|
|
410 CONTINUE
|
|
420 CONTINUE
|
|
430 CONTINUE
|
|
440 CONTINUE
|
|
IF(MSTP(121).EQ.1) SIGSAM=PARP(121)*SIGSAM
|
|
XSEC(ISUB,1)=1.05D0*SIGSAM
|
|
450 CONTINUE
|
|
IF(MSTP(173).EQ.1.AND.ISUB.NE.96) XSEC(ISUB,1)=
|
|
& PARP(174)*XSEC(ISUB,1)
|
|
IF(ISUB.NE.96) XSEC(0,1)=XSEC(0,1)+XSEC(ISUB,1)
|
|
460 CONTINUE
|
|
MINT(51)=0
|
|
|
|
C...Print summary table.
|
|
IF(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 470 ISUB=1,500
|
|
IF(MSUB(ISUB).NE.1.AND.ISUB.NE.96) GOTO 470
|
|
IF(ISUB.EQ.96.AND.MINT(50).EQ.0) GOTO 470
|
|
IF(ISUB.EQ.96.AND.MSUB(95).NE.1.AND.MSTP(81).LE.0) GOTO 470
|
|
IF(ISUB.EQ.96.AND.MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 470
|
|
IF(MSUB(95).EQ.1.AND.(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13
|
|
& .OR.ISUB.EQ.28.OR.ISUB.EQ.53.OR.ISUB.EQ.68)) GOTO 470
|
|
WRITE(MSTU(11),6200) ISUB,PROC(ISUB),XSEC(ISUB,1)
|
|
470 CONTINUE
|
|
WRITE(MSTU(11),6300)
|
|
ENDIF
|
|
|
|
C...Format statements for maximization results.
|
|
5000 FORMAT(/1X,'Coefficient optimization and maximum search for ',
|
|
&'subprocess no',I4/1X,'Coefficient modes tau',10X,'y*',9X,
|
|
&'cth',9X,'tau''',7X,'sigma')
|
|
5100 FORMAT(1X,'Warning: requested subprocess ',I3,' has no allowed ',
|
|
&'phase space.'/1X,'Process switched off!')
|
|
5200 FORMAT(1X,4I4,F12.8,F12.6,F12.7,F12.8,1P,D12.4)
|
|
5300 FORMAT(1X,'Warning: requested subprocess ',I3,' has vanishing ',
|
|
&'cross-section.'/1X,'Process switched off!')
|
|
5400 FORMAT(1X,'Coefficients of equation system to be solved for ',A4)
|
|
5500 FORMAT(1X,1P,8D11.3)
|
|
5600 FORMAT(1X,'Result for ',A4,':',7F9.4)
|
|
5700 FORMAT(1X,'Maximum search for given coefficients'/2X,'MAX VAR ',
|
|
&'MOD MOV VNEW',7X,'tau',7X,'y*',8X,'cth',7X,'tau''',7X,'sigma')
|
|
5800 FORMAT(1X,4I4,F8.4,F11.7,F9.3,F11.6,F11.7,1P,D12.4)
|
|
5900 FORMAT(1X,'Error: no requested process has non-vanishing ',
|
|
&'cross-section.'/1X,'Execution stopped!')
|
|
6000 FORMAT(/1X,8('*'),1X,'PYMAXI: summary of differential ',
|
|
&'cross-section maximum search',1X,8('*'))
|
|
6100 FORMAT(/11X,58('=')/11X,'I',38X,'I',17X,'I'/11X,'I ISUB ',
|
|
&'Subprocess name',15X,'I Maximum value I'/11X,'I',38X,'I',
|
|
&17X,'I'/11X,58('=')/11X,'I',38X,'I',17X,'I')
|
|
6200 FORMAT(11X,'I',2X,I3,3X,A28,2X,'I',2X,1P,D12.4,3X,'I')
|
|
6300 FORMAT(11X,'I',38X,'I',17X,'I'/11X,58('='))
|
|
|
|
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...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/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)
|
|
COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,
|
|
&/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/,/PYUPPR/,/PYMSSM/
|
|
C...Local arrays.
|
|
DIMENSION XPQ(-25:25),PMM(2),PDIF(4),BHAD(4),PMMN(2)
|
|
|
|
C...Parameters and data used in elastic/diffractive treatment.
|
|
DATA EPS/0.0808D0/, ALP/0.25D0/, CRES/2D0/, PMRC/1.062D0/,
|
|
&SMP/0.880D0/, BHAD/2.3D0,1.4D0,1.4D0,0.23D0/
|
|
|
|
C...Initial values, specifically for (first) semihard interaction.
|
|
MINT(10)=0
|
|
MINT(17)=0
|
|
MINT(18)=0
|
|
VINT(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...Random choice of flavour for some SUSY processes.
|
|
IF(ISUB.GE.201.AND.ISUB.LE.280) THEN
|
|
C...~e_L ~nu_e or ~mu_L ~nu_mu.
|
|
IF(ISUB.EQ.210) THEN
|
|
KFPR(ISUB,1)=KSUSY1+11+2*INT(0.5D0+PYR(0))
|
|
KFPR(ISUB,2)=KFPR(ISUB,1)+1
|
|
C...~nu_e ~nu_e(bar) or ~nu_mu ~nu_mu(bar).
|
|
ELSEIF(ISUB.EQ.213) THEN
|
|
KFPR(ISUB,1)=KSUSY1+12+2*INT(0.5D0+PYR(0))
|
|
KFPR(ISUB,2)=KFPR(ISUB,1)
|
|
C...~q ~chi/~g; ~q = ~d, ~u, ~s, ~c or ~b.
|
|
ELSEIF(ISUB.GE.246.AND.ISUB.LE.259) THEN
|
|
IF(MOD(ISUB,2).EQ.0) THEN
|
|
KFPR(ISUB,1)=KSUSY1+1+INT(5D0*PYR(0))
|
|
ELSE
|
|
KFPR(ISUB,1)=KSUSY2+1+INT(5D0*PYR(0))
|
|
ENDIF
|
|
C...~q1 ~q2; ~q = ~d, ~u, ~s, ~c or ~b.
|
|
ELSEIF(ISUB.GE.271.AND.ISUB.LE.276) THEN
|
|
IF(ISUB.EQ.271.OR.ISUB.EQ.274) THEN
|
|
KSU1=KSUSY1
|
|
KSU2=KSUSY1
|
|
ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.275) THEN
|
|
KSU1=KSUSY2
|
|
KSU2=KSUSY2
|
|
ELSEIF(PYR(0).LT.0.5D0) THEN
|
|
KSU1=KSUSY1
|
|
KSU2=KSUSY2
|
|
ELSE
|
|
KSU1=KSUSY2
|
|
KSU2=KSUSY1
|
|
ENDIF
|
|
KFPR(ISUB,1)=KSU1+1+INT(5D0*PYR(0))
|
|
KFPR(ISUB,2)=KSU2+1+INT(5D0*PYR(0))
|
|
C...~q ~q(bar); ~q = ~d, ~u, ~s, ~c or ~b.
|
|
ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.279) THEN
|
|
KFPR(ISUB,1)=KSUSY1+1+INT(5D0*PYR(0))
|
|
KFPR(ISUB,2)=KFPR(ISUB,1)
|
|
ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.280) THEN
|
|
KFPR(ISUB,1)=KSUSY2+1+INT(5D0*PYR(0))
|
|
KFPR(ISUB,2)=KFPR(ISUB,1)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Find resonances (explicit or implicit in cross-section).
|
|
MINT(72)=0
|
|
KFR1=0
|
|
IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN
|
|
KFR1=KFPR(ISUB,1)
|
|
ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165.OR.
|
|
& ISUB.EQ.171.OR.ISUB.EQ.176) THEN
|
|
KFR1=23
|
|
ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172.OR.
|
|
& ISUB.EQ.177) THEN
|
|
KFR1=24
|
|
ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN
|
|
KFR1=25
|
|
IF(MSTP(46).EQ.5) THEN
|
|
KFR1=30
|
|
PMAS(30,1)=PARP(45)
|
|
PMAS(30,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2)
|
|
ENDIF
|
|
ELSEIF(ISUB.EQ.194) THEN
|
|
KFR1=54
|
|
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.OR.ISUB.EQ.194) THEN
|
|
KFR2=23
|
|
IF(ISUB.EQ.194) KFR2=56
|
|
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 140 I=1,2
|
|
PMMN(I)=0D0
|
|
IF(KFPR(ISUB,I).EQ.0) THEN
|
|
ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT.
|
|
& PARP(41)) THEN
|
|
VINT(62+I)=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2
|
|
ELSE
|
|
NBW=NBW+1
|
|
C...This prevents SUSY/t particles from becoming too light.
|
|
KFLW=KFPR(ISUB,I)
|
|
IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN
|
|
KCW=PYCOMP(KFLW)
|
|
PMMN(I)=PMAS(KCW,1)
|
|
DO 130 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1
|
|
IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN
|
|
PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+
|
|
& PMAS(PYCOMP(KFDP(IDC,2)),1)
|
|
IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+
|
|
& PMAS(PYCOMP(KFDP(IDC,3)),1)
|
|
PMMN(I)=MIN(PMMN(I),PMSUM)
|
|
ENDIF
|
|
130 CONTINUE
|
|
ELSEIF(KFLW.EQ.6) THEN
|
|
PMMN(I)=PMAS(24,1)+PMAS(5,1)
|
|
ENDIF
|
|
ENDIF
|
|
140 CONTINUE
|
|
IF(NBW.GE.1) THEN
|
|
CKIN41=CKIN(41)
|
|
CKIN43=CKIN(43)
|
|
CKIN(41)=MAX(PMMN(1),CKIN(41))
|
|
CKIN(43)=MAX(PMMN(2),CKIN(43))
|
|
CALL PYOFSH(4,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4)
|
|
CKIN(41)=CKIN41
|
|
CKIN(43)=CKIN43
|
|
IF(MINT(51).EQ.1) THEN
|
|
IF(MINT(121).GT.1) CALL PYSAVE(2,IGA)
|
|
IF(MFAIL.EQ.1) THEN
|
|
MSTI(61)=1
|
|
RETURN
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
VINT(63)=PQM3**2
|
|
VINT(64)=PQM4**2
|
|
ENDIF
|
|
IF(MIN(VINT(63),VINT(64)).LT.CKIN(6)**2) MINT(71)=1
|
|
IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5))
|
|
ENDIF
|
|
|
|
C...Prepare for additional variable choices in 2 -> 3.
|
|
IF(ISTSB.EQ.5) THEN
|
|
VINT(201)=0D0
|
|
IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1)
|
|
VINT(206)=VINT(201)
|
|
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 160 I1=I1MN,I1MX
|
|
KFV1=110*I1+3
|
|
DO 150 I2=I2MN,I2MX
|
|
KFV2=110*I2+3
|
|
VRN=VRN-SIGT(I1,I2,5)
|
|
IF(VRN.LE.0D0) GOTO 170
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
170 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 190 I1=I1MN,I1MX
|
|
KFV1=110*I1+3
|
|
DO 180 I2=I2MN,I2MX
|
|
KFV2=110*I2+3
|
|
VRN=VRN-SIGT(I1,I2,JJ)
|
|
IF(VRN.LE.0D0) GOTO 200
|
|
180 CONTINUE
|
|
190 CONTINUE
|
|
200 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 210 JT=1,2
|
|
PDIF(JT)=PMM(JT)
|
|
VINT(66+JT)=PDIF(JT)
|
|
IF(MINT(16+JT).EQ.1) PDIF(JT)=PDIF(JT)+PARP(102)
|
|
210 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.
|
|
220 DO 230 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
|
|
230 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 220
|
|
IF(ISUB.EQ.92) THEN
|
|
FSD=(1D0-SQM3/SH)*(1D0+CRES*SMRES1/(SMRES1+SQM3))
|
|
IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 220
|
|
ELSEIF(ISUB.EQ.93) THEN
|
|
FSD=(1D0-SQM4/SH)*(1D0+CRES*SMRES2/(SMRES2+SQM4))
|
|
IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 220
|
|
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 220
|
|
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 220
|
|
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 220
|
|
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 220
|
|
|
|
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.5) THEN
|
|
CALL PYKLIM(1)
|
|
IF(MINT(51).NE.0) THEN
|
|
IF(MINT(121).GT.1) CALL PYSAVE(2,IGA)
|
|
IF(MFAIL.EQ.1) THEN
|
|
MSTI(61)=1
|
|
RETURN
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
RTAU=PYR(0)
|
|
MTAU=1
|
|
IF(RTAU.GT.COEF(ISUB,1)) MTAU=2
|
|
IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)) MTAU=3
|
|
IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)) MTAU=4
|
|
IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4))
|
|
& MTAU=5
|
|
IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+
|
|
& COEF(ISUB,5)) MTAU=6
|
|
IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+
|
|
& COEF(ISUB,5)+COEF(ISUB,6)) MTAU=7
|
|
CALL PYKMAP(1,MTAU,PYR(0))
|
|
|
|
C...2 -> 3, 4 processes:
|
|
C...Choose tau' according to h4(tau,tau')/tau', where
|
|
C...h4(tau,tau') = c1 + I1/I2*c2*(1 - tau/tau')^3/tau' +
|
|
C...I1/I3*c3*1/(1 - tau'), and c1 + c2 + c3 = 1.
|
|
IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN
|
|
CALL PYKLIM(4)
|
|
IF(MINT(51).NE.0) THEN
|
|
IF(MINT(121).GT.1) CALL PYSAVE(2,IGA)
|
|
IF(MFAIL.EQ.1) THEN
|
|
MSTI(61)=1
|
|
RETURN
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
RTAUP=PYR(0)
|
|
MTAUP=1
|
|
IF(RTAUP.GT.COEF(ISUB,18)) MTAUP=2
|
|
IF(RTAUP.GT.COEF(ISUB,18)+COEF(ISUB,19)) MTAUP=3
|
|
CALL PYKMAP(4,MTAUP,PYR(0))
|
|
ENDIF
|
|
|
|
C...Choose y* according to h2(y*), where
|
|
C...h2(y*) = I0/I1*c1*(y*-y*min) + I0/I2*c2*(y*max-y*) +
|
|
C...I0/I3*c3*1/cosh(y*) + I0/I4*c4*1/(1-exp(y*-y*max)) +
|
|
C...I0/I5*c5*1/(1-exp(-y*-y*min)), I0 = y*max-y*min,
|
|
C...and c1 + c2 + c3 + c4 + c5 = 1.
|
|
CALL PYKLIM(2)
|
|
IF(MINT(51).NE.0) THEN
|
|
IF(MINT(121).GT.1) CALL PYSAVE(2,IGA)
|
|
IF(MFAIL.EQ.1) THEN
|
|
MSTI(61)=1
|
|
RETURN
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
RYST=PYR(0)
|
|
MYST=1
|
|
IF(RYST.GT.COEF(ISUB,8)) MYST=2
|
|
IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3
|
|
IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)) MYST=4
|
|
IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)+
|
|
& COEF(ISUB,11)) MYST=5
|
|
CALL PYKMAP(2,MYST,PYR(0))
|
|
|
|
C...2 -> 2 processes:
|
|
C...Choose cos(theta-hat) (cth) according to h3(cth), where
|
|
C...h3(cth) = c0 + I0/I1*c1*1/(A - cth) + I0/I2*c2*1/(A + cth) +
|
|
C...I0/I3*c3*1/(A - cth)^2 + I0/I4*c4*1/(A + cth)^2,
|
|
C...A = 1 + 2*(m3*m4/sh)^2 (= 1 for massless products),
|
|
C...and c0 + c1 + c2 + c3 + c4 = 1.
|
|
CALL PYKLIM(3)
|
|
IF(MINT(51).NE.0) THEN
|
|
IF(MINT(121).GT.1) CALL PYSAVE(2,IGA)
|
|
IF(MFAIL.EQ.1) THEN
|
|
MSTI(61)=1
|
|
RETURN
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
|
|
RCTH=PYR(0)
|
|
MCTH=1
|
|
IF(RCTH.GT.COEF(ISUB,13)) MCTH=2
|
|
IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)) MCTH=3
|
|
IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)) MCTH=4
|
|
IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)+
|
|
& COEF(ISUB,16)) MCTH=5
|
|
CALL PYKMAP(3,MCTH,PYR(0))
|
|
ENDIF
|
|
|
|
C...2 -> 3 : select pT1, phi1, pT2, phi2, y3 for 3 outgoing.
|
|
IF(ISTSB.EQ.5) THEN
|
|
CALL PYKMAP(5,0,0D0)
|
|
IF(MINT(51).NE.0) THEN
|
|
IF(MINT(121).GT.1) CALL PYSAVE(2,IGA)
|
|
IF(MFAIL.EQ.1) THEN
|
|
MSTI(61)=1
|
|
RETURN
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...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 240 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)
|
|
240 CONTINUE
|
|
VINT(47)=SQRT(VINT(48))
|
|
|
|
C...Calculate parton distribution weights.
|
|
IF(MINT(47).GE.2) THEN
|
|
DO 260 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 250 KFL=-25,25
|
|
XSFX(I,KFL)=XPQ(KFL)
|
|
250 CONTINUE
|
|
260 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 270 ICHN=1,NCHN
|
|
SIGH(ICHN)=PARP(173)*SIGH(ICHN)
|
|
270 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
|
|
IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21),
|
|
& VINT(22),VINT(23),VINT(26)
|
|
STOP
|
|
ENDIF
|
|
ELSE
|
|
IF(VIOL.LT.MIN(-1D-3,VINT(109))) THEN
|
|
VINT(109)=VIOL
|
|
WRITE(MSTU(11),5200) VIOL,NGEN(0,3)+1
|
|
IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21),
|
|
& VINT(22),VINT(23),VINT(26)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Weighting using estimate of maximum of differential cross-section.
|
|
IF(MFAIL.EQ.0) 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
|
|
IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21),
|
|
& VINT(22),VINT(23),VINT(26)
|
|
STOP
|
|
ENDIF
|
|
ELSEIF(MSTP(123).EQ.1) THEN
|
|
IF(VIOL.GT.VINT(108)) THEN
|
|
VINT(108)=VIOL
|
|
IF(VIOL.GT.1D0) THEN
|
|
MINT(10)=1
|
|
WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1
|
|
IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21),
|
|
& VINT(22),VINT(23),VINT(26)
|
|
ENDIF
|
|
ENDIF
|
|
ELSEIF(VIOL.GT.VINT(108)) THEN
|
|
VINT(108)=VIOL
|
|
IF(VIOL.GT.1D0) THEN
|
|
MINT(10)=1
|
|
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
|
|
IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21),
|
|
& VINT(22),VINT(23),VINT(26)
|
|
IF(ISUB.LE.9) THEN
|
|
WRITE(MSTU(11),5500) ISUB,XSEC(ISUB,1)
|
|
ELSEIF(ISUB.LE.99) THEN
|
|
WRITE(MSTU(11),5600) ISUB,XSEC(ISUB,1)
|
|
ELSE
|
|
WRITE(MSTU(11),5700) ISUB,XSEC(ISUB,1)
|
|
ENDIF
|
|
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 290
|
|
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 280 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 290
|
|
280 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.
|
|
290 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 320 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
|
|
300 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 300
|
|
MINT(18+JT)=1
|
|
VINT(154+JT)=XE
|
|
DO 310 KFLS=-25,25
|
|
XSFX(JT,KFLS)=XPQ(KFLS)
|
|
310 CONTINUE
|
|
ENDIF
|
|
320 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,'Advisory warning: maximum violated by',1P,D11.3,1X,
|
|
&'in event',1X,I7)
|
|
5500 FORMAT(1X,'XSEC(',I1,',1) increased to',1P,D11.3)
|
|
5600 FORMAT(1X,'XSEC(',I2,',1) increased to',1P,D11.3)
|
|
5700 FORMAT(1X,'XSEC(',I3,',1) increased to',1P,D11.3)
|
|
|
|
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...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,
|
|
&/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYUPPR/,/PYSSMT/
|
|
C...Local arrays and saved variables
|
|
DIMENSION WDTP(0:200),WDTE(0:200,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
|
|
C...(p(fbar')-p(W+))**2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
|
|
MINT(20+JS)=22
|
|
MINT(23-JS)=ISIGN(24,KCH1+KCH2)
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.30) THEN
|
|
IF(ISUB.EQ.21) THEN
|
|
C...f + fbar -> gamma + h0; th arbitrary
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=22
|
|
MINT(23-JS)=25
|
|
|
|
ELSEIF(ISUB.EQ.22) THEN
|
|
C...f + fbar -> Z0 + Z0; th arbitrary
|
|
MINT(21)=23
|
|
MINT(22)=23
|
|
|
|
ELSEIF(ISUB.EQ.23) THEN
|
|
C...f + fbar' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
|
|
MINT(20+JS)=23
|
|
MINT(23-JS)=ISIGN(24,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.24) THEN
|
|
C...f + fbar -> Z0 + h0 (or H0, or A0); th arbitrary
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=23
|
|
MINT(23-JS)=KFHIGG
|
|
|
|
ELSEIF(ISUB.EQ.25) THEN
|
|
C...f + fbar -> W+ + W-; th = (p(f)-p(W-))**2
|
|
MINT(21)=-ISIGN(24,MINT(15))
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.26) THEN
|
|
C...f + fbar' -> W+/- + h0 (or H0, or A0);
|
|
C...th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
|
|
MINT(20+JS)=ISIGN(24,KCH1+KCH2)
|
|
MINT(23-JS)=KFHIGG
|
|
|
|
ELSEIF(ISUB.EQ.27) THEN
|
|
C...f + fbar -> h0 + h0
|
|
|
|
ELSEIF(ISUB.EQ.28) THEN
|
|
C...f + g -> f + g; th = (p(f)-p(f))**2
|
|
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
|
|
|
|
ELSEIF(ISUB.LE.200) THEN
|
|
IF(ISUB.EQ.161) THEN
|
|
C...f + g -> f' + H+/-; th = (p(f)-p(f'))**2
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(23-JS)=ISIGN(37,KCHG(IA,1)*I)
|
|
IB=IA+MOD(IA,2)-MOD(IA+1,2)
|
|
MINT(20+JS)=ISIGN(IB,I)
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.162) THEN
|
|
C...q + g -> LQ + lbar; LQ=leptoquark; th=(p(q)-p(LQ))^2
|
|
IF(MINT(15).EQ.21) JS=2
|
|
MINT(20+JS)=ISIGN(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,KEXCIT)
|
|
JS=MINT(2)
|
|
MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS))
|
|
IF(IABS(MINT(15)).NE.KFQEXC.AND.IABS(MINT(16)).NE.KFQEXC)
|
|
& MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS))
|
|
KCC=22
|
|
|
|
ELSEIF(ISUB.EQ.191) THEN
|
|
C...f + fbar -> rho_tech0.
|
|
KFRES=54
|
|
|
|
ELSEIF(ISUB.EQ.192) THEN
|
|
C...f + fbar' -> rho_tech+/-
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
KFRES=ISIGN(55,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.193) THEN
|
|
C...f + fbar -> omega_tech0.
|
|
KFRES=56
|
|
|
|
ELSEIF(ISUB.EQ.194) THEN
|
|
C...f + fbar -> f' + fbar' via mixture of s-channel
|
|
C...rho_tech and omega_tech; th=(p(f)-p(f'))**2
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
|
|
MINT(22)=-MINT(21)
|
|
ENDIF
|
|
|
|
CMRENNA++
|
|
ELSEIF(ISUB.LE.215) THEN
|
|
IF(ISUB.EQ.201) THEN
|
|
C...f + fbar -> ~e_L + ~e_Lbar
|
|
MINT(21)=ISIGN(KSUSY1+11,KCS)
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.202) THEN
|
|
C...f + fbar -> ~e_R + ~e_Rbar
|
|
MINT(21)=ISIGN(KSUSY2+11,KCS)
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.203) THEN
|
|
C...f + fbar -> ~e_R + ~e_Lbar
|
|
KCS=1
|
|
IF(MINT(2).EQ.2) KCS=-1
|
|
MINT(21)=ISIGN(KSUSY1+11,KCS)
|
|
MINT(22)=-ISIGN(KSUSY2+11,KCS)
|
|
|
|
ELSEIF(ISUB.EQ.204) THEN
|
|
C...f + fbar -> ~mu_L + ~mu_Lbar
|
|
MINT(21)=ISIGN(KSUSY1+13,KCS)
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.205) THEN
|
|
C...f + fbar -> ~mu_R + ~mu_Rbar
|
|
MINT(21)=ISIGN(KSUSY2+13,KCS)
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.206) THEN
|
|
C...f + fbar -> ~mu_L + ~mu_Rbar
|
|
KCS=1
|
|
IF(MINT(2).EQ.2) KCS=-1
|
|
MINT(21)=ISIGN(KSUSY1+13,KCS)
|
|
MINT(22)=-ISIGN(KSUSY2+13,KCS)
|
|
|
|
ELSEIF(ISUB.EQ.207) THEN
|
|
C...f + fbar -> ~tau_1 + ~tau_1bar
|
|
MINT(21)=ISIGN(KSUSY1+15,KCS)
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.208) THEN
|
|
C...f + fbar -> ~tau_2 + ~tau_2bar
|
|
MINT(21)=ISIGN(KSUSY2+15,KCS)
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.209) THEN
|
|
C...f + fbar -> ~tau_1 + ~tau_2bar
|
|
KCS=1
|
|
IF(MINT(2).EQ.2) KCS=-1
|
|
MINT(21)=ISIGN(KSUSY1+15,KCS)
|
|
MINT(22)=-ISIGN(KSUSY2+15,KCS)
|
|
|
|
ELSEIF(ISUB.EQ.210) THEN
|
|
C...q + qbar' -> ~l_L + ~nulbar; th arbitrary
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
MINT(21)=-ISIGN(KFPR(ISUB,1),KCH1+KCH2)
|
|
MINT(22)=ISIGN(KFPR(ISUB,2),KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.211) THEN
|
|
C...q + qbar'-> ~tau_1 + ~nutaubar; th arbitrary
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
MINT(21)=-ISIGN(KSUSY1+15,KCH1+KCH2)
|
|
MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.212) THEN
|
|
C...q + qbar'-> ~tau_2 + ~nutaubar; th arbitrary
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
MINT(21)=-ISIGN(KSUSY2+15,KCH1+KCH2)
|
|
MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.213) THEN
|
|
C...f + fbar -> ~nul + ~nulbar
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.214) THEN
|
|
C...f + fbar -> ~nutau + ~nutaubar
|
|
MINT(21)=ISIGN(KSUSY1+16,KCS)
|
|
MINT(22)=-MINT(21)
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.225) THEN
|
|
IF(ISUB.EQ.216) THEN
|
|
C...f + fbar -> ~chi01 + ~chi01
|
|
MINT(21)=KSUSY1+22
|
|
MINT(22)=KSUSY1+22
|
|
|
|
ELSEIF(ISUB.EQ.217) THEN
|
|
C...f + fbar -> ~chi02 + ~chi02
|
|
MINT(21)=KSUSY1+23
|
|
MINT(22)=KSUSY1+23
|
|
|
|
ELSEIF(ISUB.EQ.218 ) THEN
|
|
C...f + fbar -> ~chi03 + ~chi03
|
|
MINT(21)=KSUSY1+25
|
|
MINT(22)=KSUSY1+25
|
|
|
|
ELSEIF(ISUB.EQ.219 ) THEN
|
|
C...f + fbar -> ~chi04 + ~chi04
|
|
MINT(21)=KSUSY1+35
|
|
MINT(22)=KSUSY1+35
|
|
|
|
ELSEIF(ISUB.EQ.220 ) THEN
|
|
C...f + fbar -> ~chi01 + ~chi02
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+22
|
|
MINT(23-JS)=KSUSY1+23
|
|
|
|
ELSEIF(ISUB.EQ.221 ) THEN
|
|
C...f + fbar -> ~chi01 + ~chi03
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+22
|
|
MINT(23-JS)=KSUSY1+25
|
|
|
|
ELSEIF(ISUB.EQ.222) THEN
|
|
C...f + fbar -> ~chi01 + ~chi04
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+22
|
|
MINT(23-JS)=KSUSY1+35
|
|
|
|
ELSEIF(ISUB.EQ.223) THEN
|
|
C...f + fbar -> ~chi02 + ~chi03
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+23
|
|
MINT(23-JS)=KSUSY1+25
|
|
|
|
ELSEIF(ISUB.EQ.224) THEN
|
|
C...f + fbar -> ~chi02 + ~chi04
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+23
|
|
MINT(23-JS)=KSUSY1+35
|
|
|
|
ELSEIF(ISUB.EQ.225) THEN
|
|
C...f + fbar -> ~chi03 + ~chi04
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+25
|
|
MINT(23-JS)=KSUSY1+35
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.236) THEN
|
|
IF(ISUB.EQ.226) THEN
|
|
C...f + fbar -> ~chi+-1 + ~chi-+1
|
|
C...th=(p(q)-p(chi+))**2 or (p(qbar)-p(chi-))**2
|
|
MINT(21)=ISIGN(KSUSY1+24,MINT(15))
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.227) THEN
|
|
C...f + fbar -> ~chi+-2 + ~chi-+2
|
|
MINT(21)=ISIGN(KSUSY1+37,MINT(15))
|
|
MINT(22)=-MINT(21)
|
|
|
|
ELSEIF(ISUB.EQ.228) THEN
|
|
C...f + fbar -> ~chi+-1 + ~chi-+2
|
|
C...th=(p(q)-p(chi1+))**2 or th=(p(qbar)-p(chi1-))**2
|
|
C...js=1 if pyr<.5, js=2 if pyr>.5
|
|
C...if 15=q, 16=qbar and js=1, chi1+ + chi2-, th=(q-chi1+)**2
|
|
C...if 15=qbar, 16=q and js=1, chi2- + chi1+, th=(q-chi1+)**2
|
|
C...if 15=q, 16=qbar and js=2, chi1- + chi2+, th=(qbar-chi1-)**2
|
|
C...if 15=qbar, 16=q and js=2, chi2+ + chi1-, th=(q-chi1-)**2
|
|
KCH1=ISIGN(1,MINT(15))
|
|
KCH2=INT(1-KCH1)/2
|
|
IF(MINT(2).EQ.1) THEN
|
|
MINT(22-KCH2)= -(KSUSY1+24)
|
|
MINT(21+KCH2)= KSUSY1+37
|
|
IF(KCH2.EQ.0) JS=2
|
|
ELSE
|
|
MINT(21+KCH2)= KSUSY1+24
|
|
MINT(22-KCH2)= -(KSUSY1+37)
|
|
IF(KCH2.EQ.1) JS=2
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.229) THEN
|
|
C...q + qbar' -> ~chi01 + ~chi+-1
|
|
C...th=(p(u)-p(chi+))**2 or (p(ubar)-p(chi-))**2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
C...CHECK THIS
|
|
IF(MOD(MINT(15),2).NE.0) JS=2
|
|
MINT(20+JS)=KSUSY1+22
|
|
MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.230) THEN
|
|
C...q + qbar' -> ~chi02 + ~chi+-1
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MOD(MINT(15),2).NE.0) JS=2
|
|
MINT(20+JS)=KSUSY1+23
|
|
MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.231) THEN
|
|
C...q + qbar' -> ~chi03 + ~chi+-1
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MOD(MINT(15),2).NE.0) JS=2
|
|
MINT(20+JS)=KSUSY1+25
|
|
MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.232) THEN
|
|
C...q + qbar' -> ~chi04 + ~chi+-1
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MOD(MINT(15),2).NE.0) JS=2
|
|
MINT(20+JS)=KSUSY1+35
|
|
MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.233) THEN
|
|
C...q + qbar' -> ~chi01 + ~chi+-2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MOD(MINT(15),2).NE.0) JS=2
|
|
MINT(20+JS)=KSUSY1+22
|
|
MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.234) THEN
|
|
C...q + qbar' -> ~chi02 + ~chi+-2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MOD(MINT(15),2).NE.0) JS=2
|
|
MINT(20+JS)=KSUSY1+23
|
|
MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.235) THEN
|
|
C...q + qbar' -> ~chi03 + ~chi+-2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MOD(MINT(15),2).NE.0) JS=2
|
|
MINT(20+JS)=KSUSY1+25
|
|
MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
|
|
|
|
ELSEIF(ISUB.EQ.236) THEN
|
|
C...q + qbar' -> ~chi04 + ~chi+-2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
IF(MOD(MINT(15),2).NE.0) JS=2
|
|
MINT(20+JS)=KSUSY1+35
|
|
MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.245) THEN
|
|
IF(ISUB.EQ.237) THEN
|
|
C...q + qbar -> ~chi01 + ~g
|
|
C...th arbitrary
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+21
|
|
MINT(23-JS)=KSUSY1+22
|
|
KCC=17+JS
|
|
|
|
ELSEIF(ISUB.EQ.238) THEN
|
|
C...q + qbar -> ~chi02 + ~g
|
|
C...th arbitrary
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+21
|
|
MINT(23-JS)=KSUSY1+23
|
|
KCC=17+JS
|
|
|
|
ELSEIF(ISUB.EQ.239) THEN
|
|
C...q + qbar -> ~chi03 + ~g
|
|
C...th arbitrary
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+21
|
|
MINT(23-JS)=KSUSY1+25
|
|
KCC=17+JS
|
|
|
|
ELSEIF(ISUB.EQ.240) THEN
|
|
C...q + qbar -> ~chi04 + ~g
|
|
C...th arbitrary
|
|
IF(PYR(0).GT.0.5D0) JS=2
|
|
MINT(20+JS)=KSUSY1+21
|
|
MINT(23-JS)=KSUSY1+35
|
|
KCC=17+JS
|
|
|
|
ELSEIF(ISUB.EQ.241) THEN
|
|
C...q + qbar' -> ~chi+-1 + ~g
|
|
C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+
|
|
C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi-
|
|
C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi-
|
|
C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+
|
|
C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
JS=1
|
|
IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
|
|
MINT(20+JS)=KSUSY1+21
|
|
MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2)
|
|
KCC=17+JS
|
|
|
|
ELSEIF(ISUB.EQ.242) THEN
|
|
C...q + qbar' -> ~chi+-2 + ~g
|
|
C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+
|
|
C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi-
|
|
C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi-
|
|
C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+
|
|
C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2
|
|
KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
|
|
KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
|
|
JS=1
|
|
IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
|
|
MINT(20+JS)=KSUSY1+21
|
|
MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2)
|
|
KCC=17+JS
|
|
|
|
ELSEIF(ISUB.EQ.243) THEN
|
|
C...q + qbar -> ~g + ~g ; th arbitrary
|
|
MINT(21)=KSUSY1+21
|
|
MINT(22)=KSUSY1+21
|
|
KCC=MINT(2)+4
|
|
|
|
ELSEIF(ISUB.EQ.244) THEN
|
|
C...g + g -> ~g + ~g ; th arbitrary
|
|
KCC=MINT(2)+12
|
|
KCS=(-1)**INT(1.5D0+PYR(0))
|
|
MINT(21)=KSUSY1+21
|
|
MINT(22)=KSUSY1+21
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.260) THEN
|
|
IF(ISUB.EQ.246) THEN
|
|
C...qj + g -> ~qj_L + ~chi01
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY1+IA,I)
|
|
MINT(23-JS)=KSUSY1+22
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.247) THEN
|
|
C...qj + g -> ~qj_R + ~chi01
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY2+IA,I)
|
|
MINT(23-JS)=KSUSY1+22
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.248) THEN
|
|
C...qj + g -> ~qj_L + ~chi02
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY1+IA,I)
|
|
MINT(23-JS)=KSUSY1+23
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.249) THEN
|
|
C...qj + g -> ~qj_R + ~chi02
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY2+IA,I)
|
|
MINT(23-JS)=KSUSY1+23
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.250) THEN
|
|
C...qj + g -> ~qj_L + ~chi03
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY1+IA,I)
|
|
MINT(23-JS)=KSUSY1+25
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.251) THEN
|
|
C...qj + g -> ~qj_R + ~chi03
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY2+IA,I)
|
|
MINT(23-JS)=KSUSY1+25
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.252) THEN
|
|
C...qj + g -> ~qj_L + ~chi04
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY1+IA,I)
|
|
MINT(23-JS)=KSUSY1+35
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.253) THEN
|
|
C...qj + g -> ~qj_R + ~chi04
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY2+IA,I)
|
|
MINT(23-JS)=KSUSY1+35
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.254) THEN
|
|
C...qj + g -> ~qk_L + ~chi+-1
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I)
|
|
IB=-IA+INT((IA+1)/2)*4-1
|
|
MINT(20+JS)=ISIGN(KSUSY1+IB,I)
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.255) THEN
|
|
C...qj + g -> ~qk_L + ~chi+-1
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I)
|
|
IB=-IA+INT((IA+1)/2)*4-1
|
|
MINT(20+JS)=ISIGN(KSUSY2+IB,I)
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.256) THEN
|
|
C...qj + g -> ~qk_L + ~chi+-2
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
IB=-IA+INT((IA+1)/2)*4-1
|
|
MINT(20+JS)=ISIGN(KSUSY1+IB,I)
|
|
MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I)
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.257) THEN
|
|
C...qj + g -> ~qk_R + ~chi+-2
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
IB=-IA+INT((IA+1)/2)*4-1
|
|
MINT(20+JS)=ISIGN(KSUSY2+IB,I)
|
|
MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I)
|
|
KCC=15+JS
|
|
KCS=ISIGN(1,MINT(14+JS))
|
|
|
|
ELSEIF(ISUB.EQ.258) THEN
|
|
C...qj + g -> ~qj_L + ~g
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY1+IA,I)
|
|
MINT(23-JS)=KSUSY1+21
|
|
KCC=MINT(2)+6
|
|
IF(JS.EQ.2) KCC=KCC+2
|
|
KCS=ISIGN(1,I)
|
|
|
|
ELSEIF(ISUB.EQ.259) THEN
|
|
C...qj + g -> ~qj_R + ~g
|
|
IF(MINT(15).EQ.21) JS=2
|
|
I=MINT(14+JS)
|
|
IA=IABS(I)
|
|
MINT(20+JS)=ISIGN(KSUSY2+IA,I)
|
|
MINT(23-JS)=KSUSY1+21
|
|
KCC=MINT(2)+6
|
|
IF(JS.EQ.2) KCC=KCC+2
|
|
KCS=ISIGN(1,I)
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.270) THEN
|
|
IF(ISUB.EQ.261) THEN
|
|
C...f + fbar -> ~t_1 + ~t_1bar; th = (p(q)-p(sq))**2
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-MINT(21)
|
|
C...Correct color combination
|
|
IF(MINT(43).EQ.4) KCC=4
|
|
|
|
ELSEIF(ISUB.EQ.262) THEN
|
|
C...f + fbar -> ~t_2 + ~t_2bar; th = (p(q)-p(sq))**2
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-MINT(21)
|
|
C...Correct color combination
|
|
IF(MINT(43).EQ.4) KCC=4
|
|
|
|
ELSEIF(ISUB.EQ.263) THEN
|
|
C...f + fbar -> ~t_1 + ~t_2bar; th = (p(q)-p(sq))**2
|
|
IF((KCS.GT.0.AND.MINT(2).EQ.1).OR.
|
|
& (KCS.LT.0.AND.MINT(2).EQ.2)) THEN
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-ISIGN(KFPR(ISUB,2),KCS)
|
|
ELSE
|
|
JS=2
|
|
MINT(21)=ISIGN(KFPR(ISUB,2),KCS)
|
|
MINT(22)=-ISIGN(KFPR(ISUB,1),KCS)
|
|
ENDIF
|
|
C...Correct color combination
|
|
IF(MINT(43).EQ.4) KCC=4
|
|
|
|
ELSEIF(ISUB.EQ.264) THEN
|
|
C...g + g -> ~t_1 + ~t_1bar; th arbitrary
|
|
KCS=(-1)**INT(1.5D0+PYR(0))
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-MINT(21)
|
|
KCC=MINT(2)+10
|
|
|
|
ELSEIF(ISUB.EQ.265) THEN
|
|
C...g + g -> ~t_2 + ~t_2bar; th arbitrary
|
|
KCS=(-1)**INT(1.5D0+PYR(0))
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-MINT(21)
|
|
KCC=MINT(2)+10
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.280) THEN
|
|
IF(ISUB.EQ.271) THEN
|
|
C...qi + qj -> ~qi_L + ~qj_L
|
|
KCC=MINT(2)
|
|
IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
|
|
MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15))
|
|
MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16))
|
|
|
|
ELSEIF(ISUB.EQ.272) THEN
|
|
C...qi + qj -> ~qi_R + ~qj_R
|
|
KCC=MINT(2)
|
|
IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
|
|
MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15))
|
|
MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16))
|
|
|
|
ELSEIF(ISUB.EQ.273) THEN
|
|
C...qi + qj -> ~qi_L + ~qj_R
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
|
|
MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16))
|
|
KCC=MINT(2)
|
|
IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
|
|
|
|
ELSEIF(ISUB.EQ.274) THEN
|
|
C...qi + qjbar -> ~qi_L + ~qj_Lbar; th = (p(f)-p(sf'))**2
|
|
MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15))
|
|
MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16))
|
|
KCC=MINT(2)
|
|
IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
|
|
|
|
ELSEIF(ISUB.EQ.275) THEN
|
|
C...qi + qjbar -> ~qi_R + ~qj_Rbar ; th = (p(f)-p(sf'))**2
|
|
MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15))
|
|
MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16))
|
|
KCC=MINT(2)
|
|
IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
|
|
|
|
ELSEIF(ISUB.EQ.276) THEN
|
|
C...qi + qjbar -> ~qi_L + ~qj_Rbar ; th = (p(f)-p(sf'))**2
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15))
|
|
MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16))
|
|
KCC=MINT(2)
|
|
IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
|
|
|
|
ELSEIF(ISUB.EQ.277) THEN
|
|
C...f + fbar -> ~qi_L + ~qi_Lbar ; th = (p(q)-p(sq))**2
|
|
ISGN=1
|
|
IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1
|
|
MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-MINT(21)
|
|
IF(MINT(43).EQ.4) KCC=4
|
|
|
|
ELSEIF(ISUB.EQ.278) THEN
|
|
C...f + fbar -> ~qi_R + ~qi_Rbar; th = (p(q)-p(sq))**2
|
|
ISGN=1
|
|
IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1
|
|
MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-MINT(21)
|
|
IF(MINT(43).EQ.4) KCC=4
|
|
|
|
ELSEIF(ISUB.EQ.279) THEN
|
|
C...g + g -> ~qi_L + ~qi_Lbar ; th arbitrary
|
|
C...pure LL + RR
|
|
KCS=(-1)**INT(1.5D0+PYR(0))
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-MINT(21)
|
|
KCC=MINT(2)+10
|
|
|
|
ELSEIF(ISUB.EQ.280) THEN
|
|
C...g + g -> ~qi_R + ~qi_Rbar ; th arbitrary
|
|
KCS=(-1)**INT(1.5D0+PYR(0))
|
|
MINT(21)=ISIGN(KFPR(ISUB,1),KCS)
|
|
MINT(22)=-MINT(21)
|
|
KCC=MINT(2)+10
|
|
ENDIF
|
|
|
|
CMRENNA--
|
|
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
|
|
KFAA=IABS(K(I,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
|
|
IF((KFAA.EQ.6.OR.KFAA.EQ.7.OR.KFAA.EQ.8).AND.
|
|
& P(I,5).LT.PARP(42)) P(I,5)=PYMASS(K(I,2))
|
|
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) THEN
|
|
C...2 -> 3 processes: 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.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 520 JT=1,2
|
|
I=MINT(84)+2+JT
|
|
K(I,1)=1
|
|
IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3
|
|
K(I,2)=MINT(20+JT)
|
|
K(I,3)=MINT(83)+IDOC+JT-2
|
|
P(I,5)=PYMASS(K(I,2))
|
|
IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) THEN
|
|
MINT(51)=1
|
|
RETURN
|
|
ENDIF
|
|
PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2))
|
|
PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2))
|
|
P(I,1)=PTABS*COS(PHI(JT))
|
|
P(I,2)=PTABS*SIN(PHI(JT))
|
|
P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
|
|
P(I,4)=0.5D0*SHPR*Z(JT)
|
|
IZW=MINT(83)+6+JT
|
|
K(IZW,1)=21
|
|
K(IZW,2)=23
|
|
IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT)))
|
|
K(IZW,3)=IZW-2
|
|
P(IZW,1)=-P(I,1)
|
|
P(IZW,2)=-P(I,2)
|
|
P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
|
|
P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT))
|
|
P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
|
|
520 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 530 J=1,5
|
|
P(I,J)=P(IPU5,J)
|
|
530 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 540 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)
|
|
540 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 560 JT=1,2
|
|
I1=MINT(83)+8+JT
|
|
I2=MINT(84)+4+JT
|
|
K(I1,1)=21
|
|
K(I1,2)=K(I2,2)
|
|
DO 550 J=1,5
|
|
P(I1,J)=P(I2,J)
|
|
550 CONTINUE
|
|
560 CONTINUE
|
|
N=IPU6
|
|
MINT(7)=MINT(83)+9
|
|
MINT(8)=MINT(83)+10
|
|
ENDIF
|
|
|
|
IF(ISET(ISUB).EQ.11) THEN
|
|
ELSEIF(IDOC.GE.8) THEN
|
|
C...Store colour connection indices
|
|
DO 570 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))
|
|
570 CONTINUE
|
|
|
|
C...Copy outgoing partons to documentation lines
|
|
IMAX=2
|
|
IF(IDOC.EQ.9) IMAX=3
|
|
DO 590 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 580 J=1,5
|
|
P(I1,J)=P(I2,J)
|
|
580 CONTINUE
|
|
590 CONTINUE
|
|
|
|
ELSEIF(IDOC.EQ.9) THEN
|
|
C...Store colour connection indices
|
|
DO 600 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))
|
|
600 CONTINUE
|
|
|
|
C...Copy outgoing partons to documentation lines
|
|
DO 620 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 610 J=1,5
|
|
P(I1,J)=P(I2,J)
|
|
610 CONTINUE
|
|
620 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 630 J=41,66
|
|
VINTSV(J)=VINT(J)
|
|
VINT(J)=0D0
|
|
630 CONTINUE
|
|
DO 650 I=MINT(83)+5,MINT(83)+8
|
|
DO 640 J=1,5
|
|
P(I,J)=0D0
|
|
640 CONTINUE
|
|
650 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(IRES)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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 and character variables.
|
|
DIMENSION IREF(50,8),KDCY(3),KFL1(3),KFL2(3),KFL3(3),KEQL(3),
|
|
&KCQM(3),KCQ1(3),KCQ2(3),KCQ3(3),NSD(3),PMMN(3),ILIN(6),
|
|
&HGZ(3,3),COUP(6,4),CORL(2,2,2),PK(6,4),PKK(6,6),CTHE(3),
|
|
&PHI(3),WDTP(0:200),WDTE(0:200,0:5),DBEZQQ(3),DPMO(5),XM(5)
|
|
COMPLEX FGK,HA(6,6),HC(6,6)
|
|
REAL TIR,UIR
|
|
CHARACTER CODE*9,MASS*9
|
|
|
|
C...The F, Xi and Xj functions of Gunion and Kunszt
|
|
C...(Phys. Rev. D33, 665, plus errata from the authors).
|
|
FGK(I1,I2,I3,I4,I5,I6)=4.*HA(I1,I3)*HC(I2,I6)*(HA(I1,I5)*
|
|
&HC(I1,I4)+HA(I3,I5)*HC(I3,I4))
|
|
DIGK(DT,DU)=-4D0*D34*D56+DT*(3D0*DT+4D0*DU)+DT**2*(DT*DU/
|
|
&(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+2D0*(D34/D56+D56/D34))
|
|
DJGK(DT,DU)=8D0*(D34+D56)**2-8D0*(D34+D56)*(DT+DU)-6D0*DT*DU-
|
|
&2D0*DT*DU*(DT*DU/(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+
|
|
&2D0*(D34/D56+D56/D34))
|
|
|
|
C...Some general constants.
|
|
XW=PARU(102)
|
|
XWV=XW
|
|
IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2
|
|
XW1=1D0-XW
|
|
SQMZ=PMAS(23,1)**2
|
|
GMMZ=PMAS(23,1)*PMAS(23,2)
|
|
SQMW=PMAS(24,1)**2
|
|
GMMW=PMAS(24,1)*PMAS(24,2)
|
|
SH=VINT(44)
|
|
|
|
C...Reset original resonance configuration.
|
|
DO 100 JT=1,8
|
|
IREF(1,JT)=0
|
|
100 CONTINUE
|
|
|
|
C...Define initial one, two or three objects for subprocess.
|
|
IF(IRES.EQ.0) THEN
|
|
ISUB=MINT(1)
|
|
IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN
|
|
IREF(1,1)=MINT(84)+2+ISET(ISUB)
|
|
IREF(1,4)=MINT(83)+6+ISET(ISUB)
|
|
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...Define original resonance for odd cases.
|
|
ELSE
|
|
ISUB=0
|
|
IREF(1,1)=IRES
|
|
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(IREF(IP,2).EQ.0) JTMAX=1
|
|
IF(IREF(IP,3).NE.0) JTMAX=3
|
|
IT4=0
|
|
NSAV=N
|
|
|
|
C...Start treatment of one, two or three resonances in parallel.
|
|
140 N=NSAV
|
|
DO 220 JT=1,JTMAX
|
|
ID=IREF(IP,JT)
|
|
KDCY(JT)=0
|
|
KFL1(JT)=0
|
|
KFL2(JT)=0
|
|
KFL3(JT)=0
|
|
KEQL(JT)=0
|
|
NSD(JT)=ID
|
|
|
|
C...Check whether particle can/is allowed to decay.
|
|
IF(ID.EQ.0) GOTO 210
|
|
KFA=IABS(K(ID,2))
|
|
KCA=PYCOMP(KFA)
|
|
IF(MWID(KCA).EQ.0) GOTO 210
|
|
IF(K(ID,1).GT.10.OR.MDCY(KCA,1).EQ.0) GOTO 210
|
|
IF(KFA.EQ.6.OR.KFA.EQ.7.OR.KFA.EQ.8.OR.KFA.EQ.17.OR.
|
|
& KFA.EQ.18) IT4=IT4+1
|
|
K(ID,4)=MSTU(5)*(K(ID,4)/MSTU(5))
|
|
K(ID,5)=MSTU(5)*(K(ID,5)/MSTU(5))
|
|
|
|
C...Info for selection of decay channel: sign, pairings.
|
|
IF(KCHG(KCA,3).EQ.0) THEN
|
|
IPM=2
|
|
ELSE
|
|
IPM=(5-ISIGN(1,K(ID,2)))/2
|
|
ENDIF
|
|
KFB=0
|
|
IF(JTMAX.EQ.2) THEN
|
|
KFB=IABS(K(IREF(IP,3-JT),2))
|
|
ELSEIF(JTMAX.EQ.3) THEN
|
|
JT2=JT+1-3*(JT/3)
|
|
KFB=IABS(K(IREF(IP,JT2),2))
|
|
IF(KFB.NE.KFA) THEN
|
|
JT2=JT+2-3*((JT+1)/3)
|
|
KFB=IABS(K(IREF(IP,JT2),2))
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Select decay channel.
|
|
IF(ISUB.EQ.1.OR.ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.
|
|
& ISUB.EQ.30.OR.ISUB.EQ.35.OR.ISUB.EQ.141) MINT(61)=1
|
|
CALL PYWIDT(KFA,P(ID,5)**2,WDTP,WDTE)
|
|
WDTE0S=WDTE(0,1)+WDTE(0,IPM)+WDTE(0,4)
|
|
IF(KFB.EQ.KFA) WDTE0S=WDTE0S+WDTE(0,5)
|
|
IF(WDTE0S.LE.0D0) GOTO 210
|
|
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
|
|
|
|
C...Read out flavours and colour charges of decay channel chosen.
|
|
KCQM(JT)=KCHG(KCA,2)*ISIGN(1,K(ID,2))
|
|
IF(KCQM(JT).EQ.-2) KCQM(JT)=2
|
|
KFL1(JT)=KFDP(IDC,1)*ISIGN(1,K(ID,2))
|
|
KFC1A=PYCOMP(IABS(KFL1(JT)))
|
|
IF(KCHG(KFC1A,3).EQ.0) KFL1(JT)=IABS(KFL1(JT))
|
|
KCQ1(JT)=KCHG(KFC1A,2)*ISIGN(1,KFL1(JT))
|
|
IF(KCQ1(JT).EQ.-2) KCQ1(JT)=2
|
|
KFL2(JT)=KFDP(IDC,2)*ISIGN(1,K(ID,2))
|
|
KFC2A=PYCOMP(IABS(KFL2(JT)))
|
|
IF(KCHG(KFC2A,3).EQ.0) KFL2(JT)=IABS(KFL2(JT))
|
|
KCQ2(JT)=KCHG(KFC2A,2)*ISIGN(1,KFL2(JT))
|
|
IF(KCQ2(JT).EQ.-2) KCQ2(JT)=2
|
|
KFL3(JT)=KFDP(IDC,3)*ISIGN(1,K(ID,2))
|
|
IF(KFL3(JT).NE.0) THEN
|
|
KFC3A=PYCOMP(IABS(KFL3(JT)))
|
|
IF(KCHG(KFC3A,3).EQ.0) KFL3(JT)=IABS(KFL3(JT))
|
|
KCQ3(JT)=KCHG(KFC3A,2)*ISIGN(1,KFL3(JT))
|
|
IF(KCQ3(JT).EQ.-2) KCQ3(JT)=2
|
|
ENDIF
|
|
|
|
C...Set/save further info on channel.
|
|
KDCY(JT)=1
|
|
IF(KFB.EQ.KFA) KEQL(JT)=MDME(IDC,1)
|
|
NSD(JT)=N
|
|
HGZ(JT,1)=VINT(111)
|
|
HGZ(JT,2)=VINT(112)
|
|
HGZ(JT,3)=VINT(114)
|
|
|
|
C...Select masses; to begin with assume resonances narrow.
|
|
DO 170 I=1,3
|
|
P(N+I,5)=0D0
|
|
PMMN(I)=0D0
|
|
IF(I.EQ.1) THEN
|
|
KFLW=IABS(KFL1(JT))
|
|
KCW=KFC1A
|
|
ELSEIF(I.EQ.2) THEN
|
|
KFLW=IABS(KFL2(JT))
|
|
KCW=KFC2A
|
|
ELSEIF(I.EQ.3) THEN
|
|
IF(KFL3(JT).EQ.0) GOTO 170
|
|
KFLW=IABS(KFL3(JT))
|
|
KCW=KFC3A
|
|
ENDIF
|
|
P(N+I,5)=PMAS(KCW,1)
|
|
CMRENNA++
|
|
C...This prevents SUSY/t particles from becoming too light.
|
|
IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN
|
|
PMMN(I)=PMAS(KCW,1)
|
|
DO 160 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1
|
|
IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN
|
|
PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+
|
|
& PMAS(PYCOMP(KFDP(IDC,2)),1)
|
|
IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+
|
|
& PMAS(PYCOMP(KFDP(IDC,3)),1)
|
|
PMMN(I)=MIN(PMMN(I),PMSUM)
|
|
ENDIF
|
|
160 CONTINUE
|
|
CMRENNA--
|
|
ELSEIF(KFLW.EQ.6) THEN
|
|
PMMN(I)=PMAS(24,1)+PMAS(5,1)
|
|
ENDIF
|
|
170 CONTINUE
|
|
|
|
C...Check which two out of three are widest.
|
|
IWID1=1
|
|
IWID2=2
|
|
PWID1=PMAS(KFC1A,2)
|
|
PWID2=PMAS(KFC2A,2)
|
|
KFLW1=IABS(KFL1(JT))
|
|
KFLW2=IABS(KFL2(JT))
|
|
IF(KFL3(JT).NE.0) THEN
|
|
PWID3=PMAS(KFC3A,2)
|
|
IF(PWID3.GT.PWID1.AND.PWID2.GE.PWID1) THEN
|
|
IWID1=3
|
|
PWID1=PWID3
|
|
KFLW1=IABS(KFL3(JT))
|
|
ELSEIF(PWID3.GT.PWID2) THEN
|
|
IWID2=3
|
|
PWID2=PWID3
|
|
KFLW2=IABS(KFL3(JT))
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...If all narrow then only check that masses consistent.
|
|
IF(MSTP(42).LE.0.OR.(PWID1.LT.PARP(41).AND.
|
|
& PWID2.LT.PARP(41))) THEN
|
|
CMRENNA++
|
|
C....Handle near degeneracy cases.
|
|
IF(KFA/KSUSY1.EQ.1.OR.KFA/KSUSY1.EQ.2) THEN
|
|
IF(P(N+1,5)+P(N+2,5)+P(N+3,5).GT.P(ID,5)) THEN
|
|
P(N+1,5)=P(ID,5)-P(N+2,5)-0.5D0
|
|
IF(P(N+1,5).LT.0D0) P(N+1,5)=0D0
|
|
ENDIF
|
|
ENDIF
|
|
CMRENNA--
|
|
IF(P(N+1,5)+P(N+2,5)+P(N+3,5)+PARJ(64).GT.P(ID,5)) THEN
|
|
CALL PYERRM(13,'(PYRESD:) daughter masses too large')
|
|
MINT(51)=1
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...For three wide resonances select narrower of three
|
|
C...according to BW decoupled from rest.
|
|
ELSE
|
|
PMTOT=P(ID,5)
|
|
IF(KFL3(JT).NE.0) THEN
|
|
IWID3=6-IWID1-IWID2
|
|
KFLW3=IABS(KFL1(JT))+IABS(KFL2(JT))+IABS(KFL3(JT))-
|
|
& KFLW1-KFLW2
|
|
LOOP=0
|
|
180 LOOP=LOOP+1
|
|
P(N+IWID3,5)=PYMASS(KFLW3)
|
|
IF(LOOP.LE.10.AND. P(N+IWID3,5).LE.PMMN(IWID3)) GOTO 180
|
|
PMTOT=PMTOT-P(N+IWID3,5)
|
|
ENDIF
|
|
C...Select other two correlated within remaining phase space.
|
|
IF(IP.EQ.1) THEN
|
|
CKIN45=CKIN(45)
|
|
CKIN47=CKIN(47)
|
|
CKIN(45)=MAX(PMMN(IWID1),CKIN(45))
|
|
CKIN(47)=MAX(PMMN(IWID2),CKIN(47))
|
|
CALL PYOFSH(2,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5),
|
|
& P(N+IWID2,5))
|
|
CKIN(45)=CKIN45
|
|
CKIN(47)=CKIN47
|
|
ELSE
|
|
CKIN(49)=PMMN(IWID1)
|
|
CKIN(50)=PMMN(IWID2)
|
|
CALL PYOFSH(5,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5),
|
|
& P(N+IWID2,5))
|
|
CKIN(49)=0D0
|
|
CKIN(50)=0D0
|
|
ENDIF
|
|
IF(MINT(51).EQ.1) RETURN
|
|
ENDIF
|
|
|
|
C...Begin fill decay products, with colour flow for coloured objects.
|
|
MSTU10=MSTU(10)
|
|
MSTU(10)=1
|
|
MSTU(19)=1
|
|
|
|
CMRENNA++
|
|
C...1) Three-body decays of SUSY particles.
|
|
IF(KFL3(JT).NE.0) THEN
|
|
DO 200 I=N+1,N+3
|
|
DO 190 J=1,5
|
|
K(I,J)=0
|
|
V(I,J)=0D0
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
XM(1)=P(N+1,5)
|
|
XM(2)=P(N+2,5)
|
|
XM(3)=P(N+3,5)
|
|
XM(5)=P(ID,5)
|
|
CALL PYTBDY(XM)
|
|
K(N+1,1)=1
|
|
K(N+1,2)=KFL1(JT)
|
|
K(N+2,1)=1
|
|
K(N+2,2)=KFL2(JT)
|
|
K(N+3,1)=1
|
|
K(N+3,2)=KFL3(JT)
|
|
C...Set colour flow in three-body decays - programmed as special cases.
|
|
IF(KFC2A.LE.6) THEN
|
|
K(N+2,1)=3
|
|
K(N+3,1)=3
|
|
ISID=4
|
|
IF(KFL2(JT).LT.0) ISID=5
|
|
K(N+2,ISID)=MSTU(5)*(N+3)
|
|
K(N+3,9-ISID)=MSTU(5)*(N+2)
|
|
ENDIF
|
|
IF(KFL1(JT).EQ.KSUSY1+21) THEN
|
|
K(N+1,1)=3
|
|
K(N+2,1)=3
|
|
K(N+3,1)=3
|
|
ISID=4
|
|
IF(KFL2(JT).LT.0) ISID=5
|
|
K(N+1,ISID)=MSTU(5)*(N+2)
|
|
K(N+1,9-ISID)=MSTU(5)*(N+3)
|
|
K(N+2,ISID)=MSTU(5)*(N+1)
|
|
K(N+3,9-ISID)=MSTU(5)*(N+1)
|
|
ENDIF
|
|
IF(KFA.EQ.KSUSY1+21) THEN
|
|
K(N+2,1)=3
|
|
K(N+3,1)=3
|
|
ISID=4
|
|
IF(KFL2(JT).LT.0) ISID=5
|
|
K(ID,ISID)=K(ID,ISID)+(N+2)
|
|
K(ID,9-ISID)=K(ID,9-ISID)+(N+3)
|
|
K(N+2,ISID)=MSTU(5)*ID
|
|
K(N+3,9-ISID)=MSTU(5)*ID
|
|
ENDIF
|
|
N=N+3
|
|
CMRENNA--
|
|
|
|
C...2) Everything else two-body decay.
|
|
ELSE
|
|
CALL PY2ENT(N+1,KFL1(JT),KFL2(JT),P(ID,5))
|
|
C...First set colour flow as if mother colour singlet.
|
|
IF(KCQ1(JT).NE.0) THEN
|
|
K(N-1,1)=3
|
|
IF(KCQ1(JT).NE.-1) K(N-1,4)=MSTU(5)*N
|
|
IF(KCQ1(JT).NE.1) K(N-1,5)=MSTU(5)*N
|
|
ENDIF
|
|
IF(KCQ2(JT).NE.0) THEN
|
|
K(N,1)=3
|
|
IF(KCQ2(JT).NE.-1) K(N,4)=MSTU(5)*(N-1)
|
|
IF(KCQ2(JT).NE.1) K(N,5)=MSTU(5)*(N-1)
|
|
ENDIF
|
|
C...Then redirect colour flow if mother (anti)triplet.
|
|
IF(KCQM(JT).EQ.0) THEN
|
|
ELSEIF(KCQM(JT).NE.2) THEN
|
|
ISID=4
|
|
IF(KCQM(JT).EQ.-1) ISID=5
|
|
IDAU=N-1
|
|
IF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.2) IDAU=N
|
|
K(ID,ISID)=K(ID,ISID)+IDAU
|
|
K(IDAU,ISID)=MSTU(5)*ID
|
|
C...Then redirect colour flow if mother octet.
|
|
ELSEIF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.0) THEN
|
|
IDAU=N-1
|
|
IF(KCQ1(JT).EQ.0) IDAU=N
|
|
K(ID,4)=K(ID,4)+IDAU
|
|
K(ID,5)=K(ID,5)+IDAU
|
|
K(IDAU,4)=MSTU(5)*ID
|
|
K(IDAU,5)=MSTU(5)*ID
|
|
ELSE
|
|
ISID=4
|
|
IF(KCQ1(JT).EQ.-1) ISID=5
|
|
IF(KCQ1(JT).EQ.2) ISID=INT(4.5D0+PYR(0))
|
|
K(ID,ISID)=K(ID,ISID)+(N-1)
|
|
K(ID,9-ISID)=K(ID,9-ISID)+N
|
|
K(N-1,ISID)=MSTU(5)*ID
|
|
K(N,9-ISID)=MSTU(5)*ID
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...End loop over resonances for daughter flavour and mass selection.
|
|
MSTU(10)=MSTU10
|
|
210 IF(MWID(KCA).NE.0.AND.(KFL1(JT).EQ.0.OR.KFL3(JT).NE.0))
|
|
& NINH=NINH+1
|
|
IF(IRES.GT.0.AND.MWID(KCA).NE.0.AND.KFL1(JT).EQ.0) THEN
|
|
WRITE(CODE,'(I9)') K(ID,2)
|
|
WRITE(MASS,'(F9.3)') P(ID,5)
|
|
CALL PYERRM(3,'(PYRESD:) Failed to decay particle'//
|
|
& CODE//' with mass'//MASS)
|
|
MINT(51)=1
|
|
RETURN
|
|
ENDIF
|
|
220 CONTINUE
|
|
|
|
C...Check for allowed combinations. Skip if no decays.
|
|
IF(JTMAX.EQ.1) THEN
|
|
IF(KDCY(1).EQ.0) GOTO 560
|
|
ELSEIF(JTMAX.EQ.2) THEN
|
|
IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0) GOTO 560
|
|
IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 140
|
|
IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 140
|
|
ELSEIF(JTMAX.EQ.3) THEN
|
|
IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0.AND.KDCY(3).EQ.0) GOTO 560
|
|
IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 140
|
|
IF(KEQL(1).EQ.4.AND.KEQL(3).EQ.4) GOTO 140
|
|
IF(KEQL(2).EQ.4.AND.KEQL(3).EQ.4) GOTO 140
|
|
IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 140
|
|
IF(KEQL(1).EQ.5.AND.KEQL(3).EQ.5) GOTO 140
|
|
IF(KEQL(2).EQ.5.AND.KEQL(3).EQ.5) GOTO 140
|
|
ENDIF
|
|
|
|
C...Special case: matrix element option for Z0 decay to quarks.
|
|
IF(MSTP(48).EQ.1.AND.ISUB.EQ.1.AND.JTMAX.EQ.1.AND.
|
|
&IABS(MINT(11)).EQ.11.AND.IABS(KFL1(1)).LE.5) THEN
|
|
|
|
C...Check consistency of MSTJ options set.
|
|
IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN
|
|
CALL PYERRM(6,
|
|
& '(PYRESD:) MSTJ(109) value requires MSTJ(110) = 1')
|
|
MSTJ(110)=1
|
|
ENDIF
|
|
IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN
|
|
CALL PYERRM(6,
|
|
& '(PYRESD) MSTJ(109) value requires MSTJ(111) = 0')
|
|
MSTJ(111)=0
|
|
ENDIF
|
|
|
|
C...Select alpha_strong behaviour.
|
|
MST111=MSTU(111)
|
|
PAR112=PARU(112)
|
|
MSTU(111)=MSTJ(108)
|
|
IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
|
|
& MSTU(111)=1
|
|
PARU(112)=PARJ(121)
|
|
IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
|
|
|
|
C...Find axial fraction in total cross section for scalar gluon model.
|
|
PARJ(171)=0D0
|
|
IF((IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.1).OR.
|
|
& (MSTJ(101).EQ.5.AND.MSTJ(49).EQ.1)) THEN
|
|
POLL=1D0-PARJ(131)*PARJ(132)
|
|
SFF=1D0/(16D0*XW*XW1)
|
|
SFW=P(ID,5)**4/((P(ID,5)**2-PARJ(123)**2)**2+
|
|
& (PARJ(123)*PARJ(124))**2)
|
|
SFI=SFW*(1D0-(PARJ(123)/P(ID,5))**2)
|
|
VE=4D0*XW-1D0
|
|
HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131))
|
|
HF1W=SFW*SFF**2*((VE**2+1D0)*POLL+2D0*VE*
|
|
& (PARJ(132)-PARJ(131)))
|
|
KFLC=IABS(KFL1(1))
|
|
PMQ=PYMASS(KFLC)
|
|
QF=KCHG(KFLC,1)/3D0
|
|
VQ=1D0
|
|
IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,
|
|
& 1D0-(2D0*PMQ/P(ID,5))**2))
|
|
VF=SIGN(1D0,QF)-4D0*QF*XW
|
|
RFV=0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-2D0*QF*VF*HF1I+
|
|
& VF**2*HF1W)+VQ**3*HF1W
|
|
IF(RFV.GT.0D0) PARJ(171)=MIN(1D0,VQ**3*HF1W/RFV)
|
|
ENDIF
|
|
|
|
C...Choice of jet configuration.
|
|
CALL PYXJET(P(ID,5),NJET,CUT)
|
|
KFLC=IABS(KFL1(1))
|
|
KFLN=21
|
|
IF(NJET.EQ.4) THEN
|
|
CALL PYX4JT(NJET,CUT,KFLC,P(ID,5),KFLN,X1,X2,X4,X12,X14)
|
|
ELSEIF(NJET.EQ.3) THEN
|
|
CALL PYX3JT(NJET,CUT,KFLC,P(ID,5),X1,X3)
|
|
ELSE
|
|
MSTJ(120)=1
|
|
ENDIF
|
|
|
|
C...Fill jet configuration; return if incorrect kinematics.
|
|
NC=N-2
|
|
IF(NJET.EQ.2.AND.MSTJ(101).NE.5) THEN
|
|
CALL PY2ENT(NC+1,KFLC,-KFLC,P(ID,5))
|
|
ELSEIF(NJET.EQ.2) THEN
|
|
CALL PY2ENT(-(NC+1),KFLC,-KFLC,P(ID,5))
|
|
ELSEIF(NJET.EQ.3) THEN
|
|
CALL PY3ENT(NC+1,KFLC,21,-KFLC,P(ID,5),X1,X3)
|
|
ELSEIF(KFLN.EQ.21) THEN
|
|
CALL PY4ENT(NC+1,KFLC,KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4,
|
|
& X12,X14)
|
|
ELSE
|
|
CALL PY4ENT(NC+1,KFLC,-KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4,
|
|
& X12,X14)
|
|
ENDIF
|
|
IF(MSTU(24).NE.0) THEN
|
|
MINT(51)=1
|
|
MSTU(111)=MST111
|
|
PARU(112)=PAR112
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Angular orientation according to matrix element.
|
|
IF(MSTJ(106).EQ.1) THEN
|
|
CALL PYXDIF(NC,NJET,KFLC,P(ID,5),CHI,THE,PHI)
|
|
IF(MINT(11).LT.0) THE=PARU(1)-THE
|
|
CTHE(1)=COS(THE)
|
|
CALL PYROBO(NC+1,N,0D0,CHI,0D0,0D0,0D0)
|
|
CALL PYROBO(NC+1,N,THE,PHI,0D0,0D0,0D0)
|
|
ENDIF
|
|
|
|
C...Boost partons to Z0 rest frame.
|
|
CALL PYROBO(NC+1,N,0D0,0D0,P(ID,1)/P(ID,4),
|
|
& P(ID,2)/P(ID,4),P(ID,3)/P(ID,4))
|
|
|
|
C...Mark decayed resonance and add documentation lines,
|
|
K(ID,1)=K(ID,1)+10
|
|
IDOC=MINT(83)+MINT(4)
|
|
DO 240 I=NC+1,N
|
|
I1=MINT(83)+MINT(4)+1
|
|
K(I,3)=I1
|
|
IF(MSTP(128).GE.1) K(I,3)=ID
|
|
IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN
|
|
MINT(4)=MINT(4)+1
|
|
K(I1,1)=21
|
|
K(I1,2)=K(I,2)
|
|
K(I1,3)=IREF(IP,4)
|
|
DO 230 J=1,5
|
|
P(I1,J)=P(I,J)
|
|
230 CONTINUE
|
|
ENDIF
|
|
240 CONTINUE
|
|
|
|
C...Generate parton shower.
|
|
IF(MSTJ(101).EQ.5) CALL PYSHOW(N-1,N,P(ID,5))
|
|
|
|
C... End special case for Z0: skip ahead.
|
|
MSTU(111)=MST111
|
|
PARU(112)=PAR112
|
|
GOTO 550
|
|
ENDIF
|
|
|
|
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 250 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
|
|
250 CONTINUE
|
|
|
|
C...Find charge, isospin, left- and righthanded couplings.
|
|
DO 270 I=IMIN,IMAX
|
|
DO 260 J=1,4
|
|
COUP(I,J)=0D0
|
|
260 CONTINUE
|
|
KFA=IABS(K(ILIN(I),2))
|
|
IF(KFA.EQ.0.OR.KFA.GT.20) GOTO 270
|
|
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)
|
|
270 CONTINUE
|
|
|
|
C...Full propagator dependence and flavour correlations for 2 gamma*/Z.
|
|
IF(ISUB.EQ.22) THEN
|
|
DO 300 I=3,5,2
|
|
I1=IORD
|
|
IF(I.EQ.5) I1=3-IORD
|
|
DO 290 J1=1,2
|
|
DO 280 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
|
|
280 CONTINUE
|
|
290 CONTINUE
|
|
300 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).
|
|
310 DO 320 JT=1,JTMAX
|
|
IF(KDCY(JT).EQ.0) GOTO 320
|
|
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
|
|
320 CONTINUE
|
|
|
|
IF(JTMAX.EQ.2.AND.MSTP(47).GE.1.AND.NINH.EQ.0) THEN
|
|
C...Construct massless four-vectors.
|
|
DO 340 I=N+1,N+4
|
|
K(I,1)=1
|
|
DO 330 J=1,5
|
|
P(I,J)=0D0
|
|
V(I,J)=0D0
|
|
330 CONTINUE
|
|
340 CONTINUE
|
|
DO 350 JT=1,JTMAX
|
|
IF(KDCY(JT).EQ.0) GOTO 350
|
|
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))
|
|
350 CONTINUE
|
|
|
|
C...Store incoming and outgoing momenta, with random rotation to
|
|
C...avoid accidental zeroes in HA expressions.
|
|
DO 370 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 360 J=1,3
|
|
P(N+4+I,J)=P(ILIN(I),J)
|
|
360 CONTINUE
|
|
370 CONTINUE
|
|
380 THERR=ACOS(2D0*PYR(0)-1D0)
|
|
PHIRR=PARU(2)*PYR(0)
|
|
CALL PYROBO(N+5,N+4+IMAX,THERR,PHIRR,0D0,0D0,0D0)
|
|
DO 400 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 380
|
|
DO 390 J=1,4
|
|
PK(I,J)=P(N+4+I,J)
|
|
390 CONTINUE
|
|
400 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 420 I1=IMIN,IMAX-1
|
|
DO 410 I2=I1+1,IMAX
|
|
HA(I1,I2)=SNGL(SQRT((PK(I1,4)-PK(I1,3))*(PK(I2,4)+
|
|
& PK(I2,3))/(1D-20+PK(I1,1)**2+PK(I1,2)**2)))*
|
|
& CMPLX(SNGL(PK(I1,1)),SNGL(PK(I1,2)))-
|
|
& SNGL(SQRT((PK(I1,4)+PK(I1,3))*(PK(I2,4)-PK(I2,3))/
|
|
& (1D-20+PK(I2,1)**2+PK(I2,2)**2)))*
|
|
& CMPLX(SNGL(PK(I2,1)),SNGL(PK(I2,2)))
|
|
HC(I1,I2)=CONJG(HA(I1,I2))
|
|
IF(I1.LE.2) HA(I1,I2)=CMPLX(0.,1.)*HA(I1,I2)
|
|
IF(I1.LE.2) HC(I1,I2)=CMPLX(0.,1.)*HC(I1,I2)
|
|
HA(I2,I1)=-HA(I1,I2)
|
|
HC(I2,I1)=-HC(I1,I2)
|
|
410 CONTINUE
|
|
420 CONTINUE
|
|
ENDIF
|
|
DO 440 I=1,2
|
|
DO 430 J=1,4
|
|
PK(I,J)=-PK(I,J)
|
|
430 CONTINUE
|
|
440 CONTINUE
|
|
DO 460 I1=IMIN,IMAX-1
|
|
DO 450 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)
|
|
450 CONTINUE
|
|
460 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(IT4.GE.1) THEN
|
|
C... Isotropic decay t -> b + W etc for 4th generation q and l.
|
|
WT=1D0
|
|
WTMAX=1D0
|
|
|
|
ELSEIF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR.
|
|
& IREF(IP,7).EQ.36) THEN
|
|
C...Angular weight for h0 -> Z0 + Z0 or W+ + W- -> 4 quarks/leptons.
|
|
IF(IP.EQ.1) WTMAX=SH**2
|
|
IF(IP.GE.2) WTMAX=P(IREF(IP,8),5)**4
|
|
KFA=IABS(K(IREF(IP,1),2))
|
|
IF(KFA.EQ.23) THEN
|
|
KFLF1A=IABS(KFL1(1))
|
|
EF1=KCHG(KFLF1A,1)/3D0
|
|
AF1=SIGN(1D0,EF1+0.1D0)
|
|
VF1=AF1-4D0*EF1*XWV
|
|
KFLF2A=IABS(KFL1(2))
|
|
EF2=KCHG(KFLF2A,1)/3D0
|
|
AF2=SIGN(1D0,EF2+0.1D0)
|
|
VF2=AF2-4D0*EF2*XWV
|
|
VA12AS=4D0*VF1*AF1*VF2*AF2/((VF1**2+AF1**2)*(VF2**2+AF2**2))
|
|
WT=8D0*(1D0+VA12AS)*PKK(3,5)*PKK(4,6)+
|
|
& 8D0*(1D0-VA12AS)*PKK(3,6)*PKK(4,5)
|
|
ELSEIF(KFA.EQ.24) THEN
|
|
WT=16D0*PKK(3,5)*PKK(4,6)
|
|
ELSE
|
|
WT=WTMAX
|
|
ENDIF
|
|
|
|
ELSEIF((KFAGM.EQ.6.OR.KFAGM.EQ.7.OR.KFAGM.EQ.8.OR.
|
|
& KFAGM.EQ.17.OR.KFAGM.EQ.18).AND.IABS(K(IREF(IP,1),2)).EQ.24)
|
|
& THEN
|
|
C...Angular correlation in f -> f' + W -> f' + 2 quarks/leptons.
|
|
I1=IREF(IP,8)
|
|
IF(MOD(KFAGM,2).EQ.0) THEN
|
|
I2=N+1
|
|
I3=N+2
|
|
ELSE
|
|
I2=N+2
|
|
I3=N+1
|
|
ENDIF
|
|
I4=IREF(IP,2)
|
|
WT=(P(I1,4)*P(I2,4)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-
|
|
& P(I1,3)*P(I2,3))*(P(I3,4)*P(I4,4)-P(I3,1)*P(I4,1)-
|
|
& P(I3,2)*P(I4,2)-P(I3,3)*P(I4,3))
|
|
WTMAX=(P(I1,5)**4-P(IREF(IP,1),5)**4)/8D0
|
|
|
|
ELSEIF(ISUB.EQ.1) THEN
|
|
C...Angular weight for gamma*/Z0 -> 2 quarks/leptons.
|
|
EI=KCHG(IABS(MINT(15)),1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
EF=KCHG(IABS(KFL1(1)),1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
RMF=MIN(1D0,4D0*PMAS(IABS(KFL1(1)),1)**2/SH)
|
|
WT1=EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+
|
|
& (VI**2+AI**2)*VINT(114)*(VF**2+(1D0-RMF)*AF**2)
|
|
WT2=RMF*(EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+
|
|
& (VI**2+AI**2)*VINT(114)*VF**2)
|
|
WT3=SQRT(1D0-RMF)*(EI*AI*VINT(112)*EF*AF+
|
|
& 4D0*VI*AI*VINT(114)*VF*AF)
|
|
WT=WT1*(1D0+CTHE(1)**2)+WT2*(1D0-CTHE(1)**2)+
|
|
& 2D0*WT3*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))
|
|
WTMAX=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
|
|
TIR=REAL(TI)
|
|
UIR=REAL(UI)
|
|
FGK135=ABS(FGK(1,2,3,4,5,6)/TIR+FGK(1,2,5,6,3,4)/UIR)**2
|
|
FGK145=ABS(FGK(1,2,4,3,5,6)/TIR+FGK(1,2,5,6,4,3)/UIR)**2
|
|
FGK136=ABS(FGK(1,2,3,4,6,5)/TIR+FGK(1,2,6,5,3,4)/UIR)**2
|
|
FGK146=ABS(FGK(1,2,4,3,6,5)/TIR+FGK(1,2,6,5,4,3)/UIR)**2
|
|
FGK253=ABS(FGK(2,1,5,6,3,4)/TIR+FGK(2,1,3,4,5,6)/UIR)**2
|
|
FGK263=ABS(FGK(2,1,6,5,3,4)/TIR+FGK(2,1,3,4,6,5)/UIR)**2
|
|
FGK254=ABS(FGK(2,1,5,6,4,3)/TIR+FGK(2,1,4,3,5,6)/UIR)**2
|
|
FGK264=ABS(FGK(2,1,6,5,4,3)/TIR+FGK(2,1,4,3,6,5)/UIR)**2
|
|
WT=
|
|
& CORL(1,1,1)*CORL(2,1,1)*FGK135+CORL(1,1,2)*CORL(2,1,1)*FGK145+
|
|
& CORL(1,1,1)*CORL(2,1,2)*FGK136+CORL(1,1,2)*CORL(2,1,2)*FGK146+
|
|
& CORL(1,2,1)*CORL(2,2,1)*FGK253+CORL(1,2,2)*CORL(2,2,1)*FGK263+
|
|
& CORL(1,2,1)*CORL(2,2,2)*FGK254+CORL(1,2,2)*CORL(2,2,2)*FGK264
|
|
WTMAX=16D0*((CORL(1,1,1)+CORL(1,1,2))*(CORL(2,1,1)+CORL(2,1,2))+
|
|
& (CORL(1,2,1)+CORL(1,2,2))*(CORL(2,2,1)+CORL(2,2,2)))*S34*S56*
|
|
& ((TI**2+UI**2+2D0*SH*(S34+S56))/(TI*UI)-S34*S56*(1D0/TI**2+
|
|
& 1D0/UI**2))
|
|
|
|
ELSEIF(ISUB.EQ.23) THEN
|
|
C...Angular weight for f + fbar' -> Z0 + W+/- -> 4 quarks/leptons.
|
|
D34=P(IREF(IP,IORD),5)**2
|
|
D56=P(IREF(IP,3-IORD),5)**2
|
|
DT=PKK(1,3)+PKK(1,4)+D34
|
|
DU=PKK(1,5)+PKK(1,6)+D56
|
|
FACBW=1D0/((SH-SQMW)**2+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(REAL(CAWZ)*FGK(1,2,3,4,5,6)+
|
|
& REAL(CBWZ)*FGK(1,2,5,6,3,4))
|
|
FGK136=ABS(REAL(CAWZ)*FGK(1,2,3,4,6,5)+
|
|
& REAL(CBWZ)*FGK(1,2,6,5,3,4))
|
|
WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2
|
|
WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)*(CAWZ**2*
|
|
& DIGK(DT,DU)+CBWZ**2*DIGK(DU,DT)+CAWZ*CBWZ*DJGK(DT,DU))
|
|
|
|
ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN
|
|
C...Angular weight for f + fbar -> Z0 + h0 -> 2 quarks/leptons + h0
|
|
C...(or H0, or A0).
|
|
WT=((COUP(1,3)*COUP(3,3))**2+(COUP(1,4)*COUP(3,4))**2)*
|
|
& PKK(1,3)*PKK(2,4)+((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)*
|
|
& COUP(3,3))**2)*PKK(1,4)*PKK(2,3)
|
|
WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)*
|
|
& (PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4))
|
|
|
|
ELSEIF(ISUB.EQ.25) THEN
|
|
C...Angular weight for f + fbar -> W+ + W- -> 4 quarks/leptons.
|
|
D34=P(IREF(IP,IORD),5)**2
|
|
D56=P(IREF(IP,3-IORD),5)**2
|
|
DT=PKK(1,3)+PKK(1,4)+D34
|
|
DU=PKK(1,5)+PKK(1,6)+D56
|
|
FACBW=1D0/((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2)
|
|
CDWW=(COUP(1,3)*SQMZ*(SH-SQMZ)*FACBW+COUP(1,2))/SH
|
|
CAWW=CDWW+0.5D0*(COUP(1,2)+1D0)/DT
|
|
CBWW=CDWW+0.5D0*(COUP(1,2)-1D0)/DU
|
|
CCWW=COUP(1,4)*SQMZ*(SH-SQMZ)*FACBW/SH
|
|
FGK135=ABS(REAL(CAWW)*FGK(1,2,3,4,5,6)-
|
|
& REAL(CBWW)*FGK(1,2,5,6,3,4))
|
|
FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6))
|
|
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.IABS(KFL1(1)).LT.20) THEN
|
|
C...Angular weight for f + fbar -> gamma*/Z0/Z'0 -> 2 quarks/leptons.
|
|
C...Couplings of incoming flavour.
|
|
KFAI=IABS(MINT(15))
|
|
EI=KCHG(KFAI,1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
KFAIC=1
|
|
IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2
|
|
IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3
|
|
IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4
|
|
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.KFL2(1).EQ.25) THEN
|
|
C...Angular weight for f + fbar -> Z' -> Z0 + h0.
|
|
RM1=P(NSD(1)+1,5)**2/SH
|
|
RM2=P(NSD(1)+2,5)**2/SH
|
|
FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)
|
|
WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1)
|
|
WTMAX=1D0+FLAM2/(8D0*RM1)
|
|
ELSEIF(MZPWP.EQ.0) THEN
|
|
C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons
|
|
C...(W:s like if intermediate Z).
|
|
D34=P(IREF(IP,IORD),5)**2
|
|
D56=P(IREF(IP,3-IORD),5)**2
|
|
DT=PKK(1,3)+PKK(1,4)+D34
|
|
DU=PKK(1,5)+PKK(1,6)+D56
|
|
FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4))
|
|
FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6))
|
|
WT=(COUP(1,3)*FGK135)**2+(COUP(1,4)*FGK253)**2
|
|
WTMAX=4D0*D34*D56*(COUP(1,3)**2+COUP(1,4)**2)*
|
|
& (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU))
|
|
ELSEIF(MZPWP.EQ.1) THEN
|
|
C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons
|
|
C...(W:s approximately longitudinal, like if intermediate H).
|
|
WT=16D0*PKK(3,5)*PKK(4,6)
|
|
WTMAX=SH**2
|
|
ELSE
|
|
C...Angular weight for f + fbar -> Z' -> H+ + H-, Z0 + h0, h0 + A0,
|
|
C...H0 + A0 -> 4 quarks/leptons.
|
|
WT=1D0
|
|
WTMAX=1D0
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.142) THEN
|
|
IF(IP.EQ.1.AND.IABS(KFL1(1)).LT.20) THEN
|
|
C...Angular weight for f + fbar' -> W'+/- -> 2 quarks/leptons.
|
|
KFAI=IABS(MINT(15))
|
|
KFAIC=1
|
|
IF(KFAI.GT.10) KFAIC=2
|
|
VI=PARU(129+2*KFAIC)
|
|
AI=PARU(130+2*KFAIC)
|
|
KFAF=IABS(KFL1(1))
|
|
KFAFC=1
|
|
IF(KFAF.GT.10) KFAFC=2
|
|
VF=PARU(129+2*KFAFC)
|
|
AF=PARU(130+2*KFAFC)
|
|
ASYM=8D0*VI*AI*VF*AF/((VI**2+AI**2)*(VF**2+AF**2))
|
|
WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2
|
|
WTMAX=2D0+ABS(ASYM)
|
|
ELSEIF(IP.EQ.1.AND.IABS(KFL2(1)).EQ.23) THEN
|
|
C...Angular weight for f + fbar' -> W'+/- -> W+/- + Z0.
|
|
RM1=P(NSD(1)+1,5)**2/SH
|
|
RM2=P(NSD(1)+2,5)**2/SH
|
|
CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)*
|
|
& (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2)
|
|
CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+
|
|
& (RM2-RM1)**2)
|
|
WT=CFLAT+CCOS2*CTHE(1)**2
|
|
WTMAX=CFLAT+MAX(0D0,CCOS2)
|
|
ELSEIF(IP.EQ.1.AND.KFL2(1).EQ.25) THEN
|
|
C...Angular weight for f + fbar -> W'+/- -> W+/- + h0.
|
|
RM1=P(NSD(1)+1,5)**2/SH
|
|
RM2=P(NSD(1)+2,5)**2/SH
|
|
FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)
|
|
WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1)
|
|
WTMAX=1D0+FLAM2/(8D0*RM1)
|
|
ELSEIF(MZPWP.EQ.0) THEN
|
|
C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons
|
|
C...(W/Z like if intermediate W).
|
|
D34=P(IREF(IP,IORD),5)**2
|
|
D56=P(IREF(IP,3-IORD),5)**2
|
|
DT=PKK(1,3)+PKK(1,4)+D34
|
|
DU=PKK(1,5)+PKK(1,6)+D56
|
|
FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4))
|
|
FGK136=ABS(FGK(1,2,3,4,6,5)-FGK(1,2,6,5,3,4))
|
|
WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2
|
|
WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)*
|
|
& (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU))
|
|
ELSEIF(MZPWP.EQ.1) THEN
|
|
C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons
|
|
C...(W/Z approximately longitudinal, like if intermediate H).
|
|
WT=16D0*PKK(3,5)*PKK(4,6)
|
|
WTMAX=SH**2
|
|
ELSE
|
|
C...Angular weight for f + fbar -> W' -> W + h0 -> whatever.
|
|
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
|
|
|
|
ELSEIF(ISUB.EQ.191) THEN
|
|
IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN
|
|
C...Angular weight for f + fbar -> rho_tech0 -> W+ W-,
|
|
C...W+ pi_tech-, pi_tech+ W- or pi_tech+ pi_tech-.
|
|
WT=1D0-CTHE(1)**2
|
|
WTMAX=1D0
|
|
ELSEIF(IP.EQ.1) THEN
|
|
C...Angular weight for f + fbar -> rho_tech0 -> f fbar.
|
|
CTHESG=CTHE(1)*ISIGN(1,MINT(15))
|
|
XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW))
|
|
BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
|
|
BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
|
|
KFAI=IABS(MINT(15))
|
|
EI=KCHG(KFAI,1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
VALI=0.5D0*(VI+AI)
|
|
VARI=0.5D0*(VI-AI)
|
|
ALEFTI=(EI+VALI*BWZR)**2+(VALI*BWZI)**2
|
|
ARIGHI=(EI+VARI*BWZR)**2+(VARI*BWZI)**2
|
|
KFAF=IABS(KFL1(1))
|
|
EF=KCHG(KFAF,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
VALF=0.5D0*(VF+AF)
|
|
VARF=0.5D0*(VF-AF)
|
|
ALEFTF=(EF+VALF*BWZR)**2+(VALF*BWZI)**2
|
|
ARIGHF=(EF+VARF*BWZR)**2+(VARF*BWZI)**2
|
|
ASAME=ALEFTI*ALEFTF+ARIGHI*ARIGHF
|
|
AFLIP=ALEFTI*ARIGHF+ARIGHI*ALEFTF
|
|
WT=ASAME*(1D0+CTHESG)**2+AFLIP*(1D0-CTHESG)**2
|
|
WTMAX=4D0*MAX(ASAME,AFLIP)
|
|
ELSE
|
|
C...Isotropic decay of W/pi_tech produced in rho_tech decay.
|
|
WT=1D0
|
|
WTMAX=1D0
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.192) THEN
|
|
IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN
|
|
C...Angular weight for f + fbar' -> rho_tech+ -> W+ Z0,
|
|
C...W+ pi_tech0, pi_tech+ Z0 or pi_tech+ pi_tech0.
|
|
WT=1D0-CTHE(1)**2
|
|
WTMAX=1D0
|
|
ELSEIF(IP.EQ.1) THEN
|
|
C...Angular weight for f + fbar' -> rho_tech+ -> f fbar'.
|
|
CTHESG=CTHE(1)*ISIGN(1,MINT(15))
|
|
WT=(1D0+CTHESG)**2
|
|
WTMAX=4D0
|
|
ELSE
|
|
C...Isotropic decay of W/Z/pi_tech produced in rho_tech+ decay.
|
|
WT=1D0
|
|
WTMAX=1D0
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.193) THEN
|
|
IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN
|
|
C...Angular weight for f + fbar -> omega_tech0 ->
|
|
C...gamma pi_tech0 or Z0 pi_tech0.
|
|
WT=1D0+CTHE(1)**2
|
|
WTMAX=2D0
|
|
ELSEIF(IP.EQ.1) THEN
|
|
C...Angular weight for f + fbar -> omega_tech0 -> f fbar.
|
|
CTHESG=CTHE(1)*ISIGN(1,MINT(15))
|
|
BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
|
|
BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
|
|
KFAI=IABS(MINT(15))
|
|
EI=KCHG(KFAI,1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
VALI=0.5D0*(VI+AI)
|
|
VARI=0.5D0*(VI-AI)
|
|
BLEFTI=(EI-VALI*BWZR)**2+(VALI*BWZI)**2
|
|
BRIGHI=(EI-VARI*BWZR)**2+(VARI*BWZI)**2
|
|
KFAF=IABS(KFL1(1))
|
|
EF=KCHG(KFAF,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
VALF=0.5D0*(VF+AF)
|
|
VARF=0.5D0*(VF-AF)
|
|
BLEFTF=(EF-VALF*BWZR)**2+(VALF*BWZI)**2
|
|
BRIGHF=(EF-VARF*BWZR)**2+(VARF*BWZI)**2
|
|
BSAME=BLEFTI*BLEFTF+BRIGHI*BRIGHF
|
|
BFLIP=BLEFTI*BRIGHF+BRIGHI*BLEFTF
|
|
WT=BSAME*(1D0+CTHESG)**2+BFLIP*(1D0-CTHESG)**2
|
|
WTMAX=4D0*MAX(BSAME,BFLIP)
|
|
ELSE
|
|
C...Isotropic decay of Z/pi_tech produced in omega_tech decay.
|
|
WT=1D0
|
|
WTMAX=1D0
|
|
ENDIF
|
|
|
|
C...Obtain correct angular distribution by rejection techniques.
|
|
ELSE
|
|
WT=1D0
|
|
WTMAX=1D0
|
|
ENDIF
|
|
IF(WT.LT.PYR(0)*WTMAX) GOTO 310
|
|
|
|
C...Construct massive four-vectors using angles chosen.
|
|
470 DO 540 JT=1,JTMAX
|
|
IF(KDCY(JT).EQ.0) GOTO 540
|
|
ID=IREF(IP,JT)
|
|
DO 480 J=1,5
|
|
DPMO(J)=P(ID,J)
|
|
480 CONTINUE
|
|
DPMO(4)=SQRT(DPMO(1)**2+DPMO(2)**2+DPMO(3)**2+DPMO(5)**2)
|
|
CMRENNA++
|
|
IF(KFL3(JT).EQ.0) THEN
|
|
CALL PYROBO(NSD(JT)+1,NSD(JT)+2,ACOS(CTHE(JT)),PHI(JT),
|
|
& DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4))
|
|
ELSE
|
|
CALL PYROBO(NSD(JT)+1,NSD(JT)+3,ACOS(CTHE(JT)),PHI(JT),
|
|
& DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4))
|
|
ENDIF
|
|
CMRENNA--
|
|
|
|
C...Mark decayed resonances; trace history.
|
|
K(ID,1)=K(ID,1)+10
|
|
KFA=IABS(K(ID,2))
|
|
KCA=PYCOMP(KFA)
|
|
IF(KCQM(JT).NE.0) THEN
|
|
C...Do not kill colour flow through coloured resonance!
|
|
ELSE
|
|
K(ID,4)=NSD(JT)+1
|
|
K(ID,5)=NSD(JT)+2
|
|
IF(KFL3(JT).NE.0) K(ID,5)=NSD(JT)+3
|
|
ENDIF
|
|
|
|
C...Add documentation lines.
|
|
IF(ISUB.NE.0) THEN
|
|
IDOC=MINT(83)+MINT(4)
|
|
CMRENNA+++
|
|
IHI=NSD(JT)+2
|
|
IF(KFL3(JT).NE.0) IHI=IHI+1
|
|
DO 500 I=NSD(JT)+1,IHI
|
|
CMRENNA---
|
|
I1=MINT(83)+MINT(4)+1
|
|
K(I,3)=I1
|
|
IF(MSTP(128).GE.1) K(I,3)=ID
|
|
IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN
|
|
MINT(4)=MINT(4)+1
|
|
K(I1,1)=21
|
|
K(I1,2)=K(I,2)
|
|
K(I1,3)=IREF(IP,JT+3)
|
|
DO 490 J=1,5
|
|
P(I1,J)=P(I,J)
|
|
490 CONTINUE
|
|
ENDIF
|
|
500 CONTINUE
|
|
ELSE
|
|
K(I,3)=ID
|
|
ENDIF
|
|
|
|
C...Do showering if any of the two/three products can shower.
|
|
NSHBEF=N
|
|
IF(MSTP(71).GE.1) THEN
|
|
ISHOW1=0
|
|
KFL1A=IABS(KFL1(JT))
|
|
IF(KFL1A.LE.22) ISHOW1=1
|
|
ISHOW2=0
|
|
KFL2A=IABS(KFL2(JT))
|
|
IF(KFL2A.LE.22) ISHOW2=1
|
|
ISHOW3=0
|
|
IF(KFL3(JT).NE.0) THEN
|
|
KFL3A=IABS(KFL3(JT))
|
|
IF(KFL3A.LE.22) ISHOW3=1
|
|
ENDIF
|
|
IF(ISHOW1.EQ.0.AND.ISHOW2.EQ.0.AND.ISHOW3.EQ.0) THEN
|
|
ELSEIF(KFL3(JT).EQ.0) THEN
|
|
CALL PYSHOW(NSD(JT)+1,NSD(JT)+2,P(ID,5))
|
|
ELSE
|
|
NSD1=NSD(JT)+1
|
|
NSD2=NSD(JT)+2
|
|
IF(ISHOW1.EQ.0.AND.ISHOW3.NE.0) THEN
|
|
NSD1=NSD(JT)+3
|
|
ELSEIF(ISHOW2.EQ.0.AND.ISHOW3.NE.0) THEN
|
|
NSD2=NSD(JT)+3
|
|
ENDIF
|
|
PMSHOW=SQRT(MAX(0D0,(P(NSD1,4)+P(NSD2,4))**2-
|
|
& (P(NSD1,1)+P(NSD2,1))**2-(P(NSD1,2)+P(NSD2,2))**2-
|
|
& (P(NSD1,3)+P(NSD2,3))**2))
|
|
CALL PYSHOW(NSD1,NSD2,PMSHOW)
|
|
ENDIF
|
|
ENDIF
|
|
NSHAFT=N
|
|
IF(JT.EQ.1) NAFT1=N
|
|
|
|
C...Check if decay products moved by shower.
|
|
NSD1=NSD(JT)+1
|
|
NSD2=NSD(JT)+2
|
|
NSD3=NSD(JT)+3
|
|
IF(NSHAFT.GT.NSHBEF) THEN
|
|
IF(K(NSD1,1).GT.10) THEN
|
|
DO 510 I=NSHBEF+1,NSHAFT
|
|
IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD1,2)) NSD1=I
|
|
510 CONTINUE
|
|
ENDIF
|
|
IF(K(NSD2,1).GT.10) THEN
|
|
DO 520 I=NSHBEF+1,NSHAFT
|
|
IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD2,2).AND.
|
|
& I.NE.NSD1) NSD2=I
|
|
520 CONTINUE
|
|
ENDIF
|
|
IF(KFL3(JT).NE.0.AND.K(NSD3,1).GT.10) THEN
|
|
DO 530 I=NSHBEF+1,NSHAFT
|
|
IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD3,2).AND.
|
|
& I.NE.NSD1.AND.I.NE.NSD2) NSD3=I
|
|
530 CONTINUE
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Store decay products for further treatment.
|
|
NP=NP+1
|
|
IREF(NP,1)=NSD1
|
|
IREF(NP,2)=NSD2
|
|
IREF(NP,3)=0
|
|
IF(KFL3(JT).NE.0) IREF(NP,3)=NSD3
|
|
IREF(NP,4)=IDOC+1
|
|
IREF(NP,5)=IDOC+2
|
|
IREF(NP,6)=0
|
|
IF(KFL3(JT).NE.0) IREF(NP,6)=IDOC+3
|
|
IREF(NP,7)=K(IREF(IP,JT),2)
|
|
IREF(NP,8)=IREF(IP,JT)
|
|
540 CONTINUE
|
|
|
|
C...Fill information for 2 -> 1 -> 2.
|
|
550 IF(JTMAX.EQ.1.AND.KDCY(1).NE.0.AND.ISUB.NE.0) THEN
|
|
MINT(7)=MINT(83)+6+2*ISET(ISUB)
|
|
MINT(8)=MINT(83)+7+2*ISET(ISUB)
|
|
MINT(25)=KFL1(1)
|
|
MINT(26)=KFL2(1)
|
|
VINT(23)=CTHE(1)
|
|
RM3=P(N-1,5)**2/SH
|
|
RM4=P(N,5)**2/SH
|
|
BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4))
|
|
VINT(45)=-0.5D0*SH*(1D0-RM3-RM4-BE34*CTHE(1))
|
|
VINT(46)=-0.5D0*SH*(1D0-RM3-RM4+BE34*CTHE(1))
|
|
VINT(48)=0.25D0*SH*BE34**2*MAX(0D0,1D0-CTHE(1)**2)
|
|
VINT(47)=SQRT(VINT(48))
|
|
ENDIF
|
|
|
|
C...Possibility of colour rearrangement in W+W- events.
|
|
IF(ISUB.EQ.25.AND.MSTP(115).GE.1) THEN
|
|
IAKF1=IABS(KFL1(1))
|
|
IAKF2=IABS(KFL1(2))
|
|
IAKF3=IABS(KFL2(1))
|
|
IAKF4=IABS(KFL2(2))
|
|
IF(MIN(IAKF1,IAKF2,IAKF3,IAKF4).GE.1.AND.
|
|
& MAX(IAKF1,IAKF2,IAKF3,IAKF4).LE.5) CALL
|
|
& PYRECO(IREF(1,1),IREF(1,2),NSD(1),NAFT1)
|
|
ENDIF
|
|
|
|
C...Loop back if needed.
|
|
560 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.01001D0*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,32
|
|
MSTI(J)=MINT(J)
|
|
120 CONTINUE
|
|
IF(MINT(121).GT.1) MSTI(9)=MINT(122)
|
|
|
|
C...Store cross-section variables in PARI.
|
|
PARI(1)=XSEC(0,3)
|
|
PARI(2)=XSEC(0,3)/MINT(5)
|
|
PARI(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...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,
|
|
&/PYINT4/,/PYMSSM/,/PYSSMT/
|
|
C...Local arrays and saved variables.
|
|
DIMENSION WDTP(0:200),WDTE(0:200,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)
|
|
PMR=PMAS(KC,1)
|
|
|
|
C...Reset width information.
|
|
DO 110 I=0,200
|
|
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.4).AND.KFLA.NE.21.AND.
|
|
&KFLA.NE.22) THEN
|
|
WDTP(0)=1D0
|
|
WDTE(0,0)=1D0
|
|
MINT(61)=0
|
|
MINT(62)=0
|
|
MINT(63)=0
|
|
RETURN
|
|
|
|
C...Treatment as a resonance based on tabulated branching ratios.
|
|
ELSEIF(MWID(KC).EQ.2.OR.(MWID(KC).EQ.3.AND.MINT(63).EQ.0)) THEN
|
|
C...Loop over possible decay channels; skip irrelevant ones.
|
|
DO 120 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 120
|
|
|
|
C...Read out decay products and nominal masses.
|
|
KFD1=KFDP(IDC,1)
|
|
KFC1=PYCOMP(KFD1)
|
|
IF(KCHG(KFC1,3).EQ.1) KFD1=KFLS*KFD1
|
|
PM1=PMAS(KFC1,1)
|
|
KFD2=KFDP(IDC,2)
|
|
KFC2=PYCOMP(KFD2)
|
|
IF(KCHG(KFC2,3).EQ.1) KFD2=KFLS*KFD2
|
|
PM2=PMAS(KFC2,1)
|
|
KFD3=KFDP(IDC,3)
|
|
PM3=0D0
|
|
IF(KFD3.NE.0) THEN
|
|
KFC3=PYCOMP(KFD3)
|
|
IF(KCHG(KFC3,3).EQ.1) KFD3=KFLS*KFD3
|
|
PM3=PMAS(KFC3,1)
|
|
ENDIF
|
|
|
|
C...Naive partial width and alternative threshold factors.
|
|
WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR)
|
|
IF(MDME(IDC,2).GE.51.AND.MDME(IDC,2).LE.53.AND.
|
|
& PM1+PM2+PM3.GE.SHR) THEN
|
|
WDTP(I)=0D0
|
|
ELSEIF(MDME(IDC,2).EQ.52.AND.KFD3.EQ.0) THEN
|
|
WDTP(I)=WDTP(I)*SQRT(MAX(0D0,(SH-PM1**2-PM2**2)**2-
|
|
& 4D0*PM1**2*PM2**2))/SH
|
|
ELSEIF(MDME(IDC,2).EQ.52) THEN
|
|
PMA=MAX(PM1,PM2,PM3)
|
|
PMC=MIN(PM1,PM2,PM3)
|
|
PMB=PM1+PM2+PM3-PMA-PMC
|
|
PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMC-PMC)
|
|
PMAN=PMA**2/SH
|
|
PMBN=PMB**2/SH
|
|
PMCN=PMC**2/SH
|
|
PMBCN=PMBC**2/SH
|
|
WDTP(I)=WDTP(I)*SQRT(MAX(0D0,
|
|
& ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)*
|
|
& ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))*
|
|
& ((SHR-PMA)**2-(PMB+PMC)**2)*
|
|
& (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/
|
|
& ((1D0-PMBCN)*PMBCN*SH)
|
|
ELSEIF(MDME(IDC,2).EQ.53.AND.KFD3.EQ.0) THEN
|
|
WDTP(I)=WDTP(I)*SQRT(
|
|
& MAX(0D0,(SH-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)/
|
|
& MAX(1D-4,(PMR**2-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2))
|
|
ELSEIF(MDME(IDC,2).EQ.53) THEN
|
|
PMA=MAX(PM1,PM2,PM3)
|
|
PMC=MIN(PM1,PM2,PM3)
|
|
PMB=PM1+PM2+PM3-PMA-PMC
|
|
PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMB-PMC)
|
|
PMAN=PMA**2/SH
|
|
PMBN=PMB**2/SH
|
|
PMCN=PMC**2/SH
|
|
PMBCN=PMBC**2/SH
|
|
FACACT=SQRT(MAX(0D0,
|
|
& ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)*
|
|
& ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))*
|
|
& ((SHR-PMA)**2-(PMB+PMC)**2)*
|
|
& (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/
|
|
& ((1D0-PMBCN)*PMBCN*SH)
|
|
PMBC=PMB+PMC+0.5D0*(PMR-PMA-PMB-PMC)
|
|
PMAN=PMA**2/PMR**2
|
|
PMBN=PMB**2/PMR**2
|
|
PMCN=PMC**2/PMR**2
|
|
PMBCN=PMBC**2/PMR**2
|
|
FACNOM=SQRT(MAX(0D0,
|
|
& ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)*
|
|
& ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))*
|
|
& ((PMR-PMA)**2-(PMB+PMC)**2)*
|
|
& (1D0+0.25D0*(PMA+PMB+PMC)/PMR)/
|
|
& ((1D0-PMBCN)*PMBCN*PMR**2)
|
|
WDTP(I)=WDTP(I)*FACACT/MAX(1D-6,FACNOM)
|
|
ENDIF
|
|
WDTP(0)=WDTP(0)+WDTP(I)
|
|
|
|
C...Calculate secondary width (at most two identical/opposite).
|
|
IF(MDME(IDC,1).GT.0) THEN
|
|
IF(KFD2.EQ.KFD1) THEN
|
|
IF(KCHG(KFC1,3).EQ.0) THEN
|
|
WID2=WIDS(KFC1,1)
|
|
ELSEIF(KFD1.GT.0) THEN
|
|
WID2=WIDS(KFC1,4)
|
|
ELSE
|
|
WID2=WIDS(KFC1,5)
|
|
ENDIF
|
|
IF(KFD3.GT.0) THEN
|
|
WID2=WID2*WIDS(KFC3,2)
|
|
ELSEIF(KFD3.LT.0) THEN
|
|
WID2=WID2*WIDS(KFC3,3)
|
|
ENDIF
|
|
ELSEIF(KFD2.EQ.-KFD1) THEN
|
|
WID2=WIDS(KFC1,1)
|
|
IF(KFD3.GT.0) THEN
|
|
WID2=WID2*WIDS(KFC3,2)
|
|
ELSEIF(KFD3.LT.0) THEN
|
|
WID2=WID2*WIDS(KFC3,3)
|
|
ENDIF
|
|
ELSEIF(KFD3.EQ.KFD1) THEN
|
|
IF(KCHG(KFC1,3).EQ.0) THEN
|
|
WID2=WIDS(KFC1,1)
|
|
ELSEIF(KFD1.GT.0) THEN
|
|
WID2=WIDS(KFC1,4)
|
|
ELSE
|
|
WID2=WIDS(KFC1,5)
|
|
ENDIF
|
|
IF(KFD2.GT.0) THEN
|
|
WID2=WID2*WIDS(KFC2,2)
|
|
ELSEIF(KFD2.LT.0) THEN
|
|
WID2=WID2*WIDS(KFC2,3)
|
|
ENDIF
|
|
ELSEIF(KFD3.EQ.-KFD1) THEN
|
|
WID2=WIDS(KFC1,1)
|
|
IF(KFD2.GT.0) THEN
|
|
WID2=WID2*WIDS(KFC2,2)
|
|
ELSEIF(KFD2.LT.0) THEN
|
|
WID2=WID2*WIDS(KFC2,3)
|
|
ENDIF
|
|
ELSEIF(KFD3.EQ.KFD2) THEN
|
|
IF(KCHG(KFC2,3).EQ.0) THEN
|
|
WID2=WIDS(KFC2,1)
|
|
ELSEIF(KFD2.GT.0) THEN
|
|
WID2=WIDS(KFC2,4)
|
|
ELSE
|
|
WID2=WIDS(KFC2,5)
|
|
ENDIF
|
|
IF(KFD1.GT.0) THEN
|
|
WID2=WID2*WIDS(KFC1,2)
|
|
ELSEIF(KFD1.LT.0) THEN
|
|
WID2=WID2*WIDS(KFC1,3)
|
|
ENDIF
|
|
ELSEIF(KFD3.EQ.-KFD2) THEN
|
|
WID2=WIDS(KFC2,1)
|
|
IF(KFD1.GT.0) THEN
|
|
WID2=WID2*WIDS(KFC1,2)
|
|
ELSEIF(KFD1.LT.0) THEN
|
|
WID2=WID2*WIDS(KFC1,3)
|
|
ENDIF
|
|
ELSE
|
|
IF(KFD1.GT.0) THEN
|
|
WID2=WIDS(KFC1,2)
|
|
ELSE
|
|
WID2=WIDS(KFC1,3)
|
|
ENDIF
|
|
IF(KFD2.GT.0) THEN
|
|
WID2=WID2*WIDS(KFC2,2)
|
|
ELSE
|
|
WID2=WID2*WIDS(KFC2,3)
|
|
ENDIF
|
|
IF(KFD3.GT.0) THEN
|
|
WID2=WID2*WIDS(KFC3,2)
|
|
ELSEIF(KFD3.LT.0) THEN
|
|
WID2=WID2*WIDS(KFC3,3)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Store effective widths according to case.
|
|
WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
|
|
WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
|
|
WDTE(I,0)=WDTE(I,MDME(IDC,1))
|
|
WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
|
|
ENDIF
|
|
120 CONTINUE
|
|
C...Return.
|
|
MINT(61)=0
|
|
MINT(62)=0
|
|
MINT(63)=0
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Here begins detailed dynamical calculation of resonance widths.
|
|
C...Shared treatment of Higgs states.
|
|
KFHIGG=25
|
|
IHIGG=1
|
|
IF(KFLA.EQ.35.OR.KFLA.EQ.36) THEN
|
|
KFHIGG=KFLA
|
|
IHIGG=KFLA-33
|
|
ENDIF
|
|
|
|
C...Common electroweak and strong constants.
|
|
XW=PARU(102)
|
|
XWV=XW
|
|
IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2
|
|
XW1=1D0-XW
|
|
AEM=PYALEM(SH)
|
|
IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1)
|
|
AS=PYALPS(SH)
|
|
RADC=1D0+AS/PARU(1)
|
|
|
|
IF(KFLA.EQ.6) THEN
|
|
C...t quark.
|
|
FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR
|
|
RADCT=1D0-2.5D0*AS/PARU(1)
|
|
DO 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...t -> W + q; including approximate QCD correction factor.
|
|
WDTP(I)=FAC*VCKM(3,I-3)*RADCT*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*
|
|
& ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2)
|
|
IF(KFLR.GT.0) THEN
|
|
WID2=WIDS(24,2)
|
|
IF(I.EQ.7) WID2=WID2*WIDS(7,2)
|
|
ELSE
|
|
WID2=WIDS(24,3)
|
|
IF(I.EQ.7) WID2=WID2*WIDS(7,3)
|
|
ENDIF
|
|
ELSEIF(I.EQ.9) THEN
|
|
C...t -> H + b.
|
|
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)
|
|
CMRENNA++
|
|
ELSEIF(I.GE.10.AND.I.LE.13.AND.IMSS(1).NE.0) THEN
|
|
C...t -> ~t + ~chi_i0, i = 1, 2, 3 or 4.
|
|
BETA=ATAN(RMSS(5))
|
|
SINB=SIN(BETA)
|
|
TANW=SQRT(PARU(102)/(1D0-PARU(102)))
|
|
ET=KCHG(6,1)/3D0
|
|
T3L=SIGN(0.5D0,ET)
|
|
KFC1=PYCOMP(KFDP(IDC,1))
|
|
KFC2=PYCOMP(KFDP(IDC,2))
|
|
PMNCHI=PMAS(KFC1,1)
|
|
PMSTOP=PMAS(KFC2,1)
|
|
IF(SHR.GT.PMNCHI+PMSTOP) THEN
|
|
IZ=I-9
|
|
AL=SHR*ZMIX(IZ,4)/(2.0D0*PMAS(24,1)*SINB)
|
|
AR=-ET*ZMIX(IZ,1)*TANW
|
|
BL=T3L*(ZMIX(IZ,2)-ZMIX(IZ,1)*TANW)-AR
|
|
BR=AL
|
|
FL=SFMIX(6,1)*AL+SFMIX(6,2)*AR
|
|
FR=SFMIX(6,1)*BL+SFMIX(6,2)*BR
|
|
PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)*
|
|
& (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR)
|
|
WDTP(I)=(0.5D0*PYALEM(SH)/PARU(102))*PCM*((FL**2+FR**2)*
|
|
& (SH+PMNCHI**2-PMSTOP**2)+SMZ(IZ)*4D0*SHR*FL*FR)
|
|
IF(KFLR.GT.0) THEN
|
|
WID2=WIDS(KFC1,2)*WIDS(KFC2,2)
|
|
ELSE
|
|
WID2=WIDS(KFC1,2)*WIDS(KFC2,3)
|
|
ENDIF
|
|
ENDIF
|
|
CMRENNA--
|
|
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.7) THEN
|
|
C...b' 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...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
|
|
140 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.8) THEN
|
|
C...t' quark.
|
|
FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR
|
|
DO 150 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 150
|
|
RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
|
|
RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 150
|
|
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
|
|
150 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.17) THEN
|
|
C...tau' lepton.
|
|
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.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
|
|
160 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.18) THEN
|
|
C...nu'_tau neutrino.
|
|
FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR
|
|
DO 170 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 170
|
|
RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
|
|
RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 170
|
|
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
|
|
170 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.21) THEN
|
|
C...QCD:
|
|
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...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
|
|
180 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.22) THEN
|
|
C...QED photon.
|
|
C***Note that widths are not given in dimensional quantities here.
|
|
DO 190 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 190
|
|
RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
|
|
RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 190
|
|
WID2=1D0
|
|
IF(I.LE.8) THEN
|
|
C...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
|
|
190 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.23) THEN
|
|
C...Z0:
|
|
ICASE=1
|
|
XWC=1D0/(16D0*XW*XW1)
|
|
FAC=(AEM*XWC/3D0)*SHR
|
|
200 CONTINUE
|
|
IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN
|
|
VINT(111)=0D0
|
|
VINT(112)=0D0
|
|
VINT(114)=0D0
|
|
ENDIF
|
|
IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN
|
|
KFI=IABS(MINT(15))
|
|
IF(KFI.GT.20) KFI=IABS(MINT(16))
|
|
EI=KCHG(KFI,1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
SQMZ=PMAS(23,1)**2
|
|
HZ=SHR*WDTP(0)
|
|
IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=1D0
|
|
IF(MSTP(43).EQ.3) VINT(112)=
|
|
& 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2)
|
|
IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)=
|
|
& XWC**2*SH**2/((SH-SQMZ)**2+HZ**2)
|
|
ENDIF
|
|
DO 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.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
|
|
210 CONTINUE
|
|
IF(MINT(61).GE.1) ICASE=3-ICASE
|
|
IF(ICASE.EQ.2) GOTO 200
|
|
|
|
ELSEIF(KFLA.EQ.24) THEN
|
|
C...W+/-:
|
|
FAC=(AEM/(24D0*XW))*SHR
|
|
DO 220 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 220
|
|
RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
|
|
RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 220
|
|
WID2=1D0
|
|
IF(I.LE.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
|
|
220 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.25.OR.KFLA.EQ.35.OR.KFLA.EQ.36) THEN
|
|
C...h0 (or H0, or A0):
|
|
IF(MSTP(49).EQ.0) THEN
|
|
FAC=(AEM/(8D0*XW))*(SH/PMAS(24,1)**2)*SHR
|
|
ELSE
|
|
FAC=(AEM/(8D0*XW))*(PMAS(KFHIGG,1)/PMAS(24,1))**2*SHR
|
|
ENDIF
|
|
DO 260 I=1,MDCY(KFHIGG,3)
|
|
IDC=I+MDCY(KFHIGG,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 260
|
|
KFC1=PYCOMP(KFDP(IDC,1))
|
|
KFC2=PYCOMP(KFDP(IDC,2))
|
|
RM1=PMAS(KFC1,1)**2/SH
|
|
RM2=PMAS(KFC2,1)**2/SH
|
|
IF(I.NE.16.AND.I.NE.17.AND.SQRT(RM1)+SQRT(RM2).GT.1D0)
|
|
& GOTO 260
|
|
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 230 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
|
|
230 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 240 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
|
|
240 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 250 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
|
|
250 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)
|
|
|
|
CMRENNA++
|
|
ELSE
|
|
C...Add in SUSY decays (two-body) by rescaling by phase space factor.
|
|
RM10=RM1*SH/PMR**2
|
|
RM20=RM2*SH/PMR**2
|
|
WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20)
|
|
WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2)
|
|
IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN
|
|
WFAC=0D0
|
|
ELSE
|
|
WFAC=WFAC/WFAC0
|
|
ENDIF
|
|
WDTP(I)=PMAS(KFLA,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC)
|
|
CMRENNA--
|
|
IF(KFC2.EQ.KFC1) THEN
|
|
WID2=WIDS(KFC1,1)
|
|
ELSE
|
|
KSGN1=2
|
|
IF(KFDP(IDC,1).LT.0) KSGN1=3
|
|
KSGN2=2
|
|
IF(KFDP(IDC,2).LT.0) KSGN2=3
|
|
WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2)
|
|
ENDIF
|
|
ENDIF
|
|
WDTP(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
|
|
260 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.32) THEN
|
|
C...Z'0:
|
|
ICASE=1
|
|
XWC=1D0/(16D0*XW*XW1)
|
|
FAC=(AEM*XWC/3D0)*SHR
|
|
VINT(117)=0D0
|
|
270 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 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.OR.MDME(IDC,1).LT.0) GOTO 280
|
|
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
|
|
280 CONTINUE
|
|
IF(MINT(61).GE.1) ICASE=3-ICASE
|
|
IF(ICASE.EQ.2) GOTO 270
|
|
|
|
ELSEIF(KFLA.EQ.34) THEN
|
|
C...W'+/-:
|
|
FAC=(AEM/(24D0*XW))*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.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
|
|
290 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.37) THEN
|
|
C...H+/-:
|
|
FAC=(AEM/(8D0*XW))*(SH/PMAS(24,1)**2)*SHR
|
|
DO 300 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 300
|
|
KFC1=PYCOMP(KFDP(IDC,1))
|
|
KFC2=PYCOMP(KFDP(IDC,2))
|
|
RM1=PMAS(KFC1,1)**2/SH
|
|
RM2=PMAS(KFC2,1)**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 300
|
|
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)
|
|
|
|
CMRENNA++
|
|
ELSE
|
|
C...Add in SUSY decays (two-body) by rescaling by phase space factor.
|
|
RM10=RM1*SH/PMR**2
|
|
RM20=RM2*SH/PMR**2
|
|
WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20)
|
|
WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2)
|
|
IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN
|
|
WFAC=0D0
|
|
ELSE
|
|
WFAC=WFAC/WFAC0
|
|
ENDIF
|
|
WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC)
|
|
CMRENNA--
|
|
KSGN1=2
|
|
IF(KFLS*KFDP(IDC,1).LT.0.AND.KCHG(KFC1,3).EQ.1) KSGN1=3
|
|
KSGN2=2
|
|
IF(KFLS*KFDP(IDC,2).LT.0.AND.KCHG(KFC2,3).EQ.1) KSGN2=3
|
|
WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2)
|
|
ENDIF
|
|
WDTP(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.38) THEN
|
|
C...Techni-eta.
|
|
FAC=(SH/PARP(46)**2)*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
|
|
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
|
|
310 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.39) THEN
|
|
C...LQ (leptoquark).
|
|
FAC=(AEM/4D0)*PARU(151)*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
|
|
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
|
|
320 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.40) THEN
|
|
C...R:
|
|
FAC=(AEM/(12D0*XW))*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
|
|
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
|
|
330 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.51.OR.KFLA.EQ.52) THEN
|
|
C...Techni-pi0 and techni-pi+-:
|
|
FAC=(3D0/(32D0*PARU(1)*PARP(142)**2))*SHR
|
|
DO 340 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 340
|
|
PM1=PMAS(PYCOMP(KFDP(IDC,1)),1)
|
|
PM2=PMAS(PYCOMP(KFDP(IDC,2)),1)
|
|
RM1=PM1**2/SH
|
|
RM2=PM2**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 340
|
|
WID2=1D0
|
|
C...pi_tech -> f + f'.
|
|
FCOF=1D0
|
|
IF(IABS(KFDP(IDC,1)).LT.10) FCOF=3D0*RADC
|
|
WDTP(I)=FAC*FCOF*(PM1+PM2)**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
|
|
340 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.53) THEN
|
|
C...Techni-pi'0 not yet implemented.
|
|
|
|
ELSEIF(KFLA.EQ.54) THEN
|
|
C...Techni-rho0:
|
|
ALPRHT=2.91D0*(3D0/PARP(144))
|
|
FAC=(ALPRHT/12D0)*SHR
|
|
FACF=(1D0/6D0)*(AEM**2/ALPRHT)*(PMAS(KFLA,1)**4/SHR**3)
|
|
SQMZ=PMAS(23,1)**2
|
|
GMMZ=PMAS(23,1)*PMAS(23,2)
|
|
XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW))
|
|
BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
|
|
BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
|
|
DO 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...rho_tech0 -> W+ + W-.
|
|
WDTP(I)=FAC*PARP(141)**4*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
|
|
WID2=WIDS(24,1)
|
|
ELSEIF(I.EQ.2) THEN
|
|
C...rho_tech0 -> W+ + pi_tech-.
|
|
WDTP(I)=FAC*PARP(141)**2*(1D0-PARP(141)**2)*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
|
|
WID2=WIDS(24,2)*WIDS(52,3)
|
|
ELSEIF(I.EQ.3) THEN
|
|
C...rho_tech0 -> pi_tech+ + W-.
|
|
WDTP(I)=FAC*PARP(141)**2*(1D0-PARP(141)**2)*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
|
|
WID2=WIDS(52,2)*WIDS(24,3)
|
|
ELSEIF(I.EQ.4) THEN
|
|
C...rho_tech0 -> pi_tech+ + pi_tech-.
|
|
WDTP(I)=FAC*(1D0-PARP(141)**2)**2*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
|
|
WID2=WIDS(52,1)
|
|
ELSE
|
|
C...rho_tech0 -> f + fbar.
|
|
WID2=1D0
|
|
IF(I.LE.12) THEN
|
|
IA=I-4
|
|
FCOF=3D0*RADC
|
|
IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1)
|
|
ELSE
|
|
IA=I-2
|
|
FCOF=1D0
|
|
IF(IA.GE.17) WID2=WIDS(IA,1)
|
|
ENDIF
|
|
EI=KCHG(IA,1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
VALI=0.5D0*(VI+AI)
|
|
VARI=0.5D0*(VI-AI)
|
|
WDTP(I)=FACF*FCOF*(1D0-RM1)*SQRT(MAX(0D0,1D0-4D0*RM1))*
|
|
& ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+
|
|
& (EI+VARI*BWZR)**2+(VARI*BWZI)**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.55) THEN
|
|
C...Techni-rho+/-:
|
|
ALPRHT=2.91D0*(3D0/PARP(144))
|
|
FAC=(ALPRHT/12D0)*SHR
|
|
SQMW=PMAS(24,1)**2
|
|
GMMW=PMAS(24,1)*PMAS(24,2)
|
|
FACF=(1D0/6D0)*(AEM**2/ALPRHT)*(PMAS(KFLA,1)**4/SHR**3)*
|
|
& (0.25D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2)
|
|
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...rho_tech+ -> W+ + Z0.
|
|
WDTP(I)=FAC*PARP(141)**4*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
|
|
IF(KFLR.GT.0) THEN
|
|
WID2=WIDS(24,2)*WIDS(23,2)
|
|
ELSE
|
|
WID2=WIDS(24,3)*WIDS(23,2)
|
|
ENDIF
|
|
ELSEIF(I.EQ.2) THEN
|
|
C...rho_tech+ -> W+ + pi_tech0.
|
|
WDTP(I)=FAC*PARP(141)**2*(1D0-PARP(141)**2)*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
|
|
IF(KFLR.GT.0) THEN
|
|
WID2=WIDS(24,2)*WIDS(51,2)
|
|
ELSE
|
|
WID2=WIDS(24,3)*WIDS(51,2)
|
|
ENDIF
|
|
ELSEIF(I.EQ.3) THEN
|
|
C...rho_tech+ -> pi_tech+ + Z0.
|
|
WDTP(I)=FAC*PARP(141)**2*(1D0-PARP(141)**2)*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
|
|
IF(KFLR.GT.0) THEN
|
|
WID2=WIDS(52,2)*WIDS(23,2)
|
|
ELSE
|
|
WID2=WIDS(52,3)*WIDS(23,2)
|
|
ENDIF
|
|
ELSEIF(I.EQ.4) THEN
|
|
C...rho_tech+ -> pi_tech+ + pi_tech0.
|
|
WDTP(I)=FAC*(1D0-PARP(141)**2)**2*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
|
|
IF(KFLR.GT.0) THEN
|
|
WID2=WIDS(52,2)*WIDS(51,2)
|
|
ELSE
|
|
WID2=WIDS(52,3)*WIDS(51,2)
|
|
ENDIF
|
|
ELSE
|
|
C...rho_tech+ -> f + fbar'.
|
|
IA=I-4
|
|
WID2=1D0
|
|
IF(IA.LE.16) THEN
|
|
FCOF=3D0*RADC*VCKM((IA-1)/4+1,MOD(IA-1,4)+1)
|
|
IF(KFLR.GT.0) THEN
|
|
IF(MOD(IA,4).EQ.3) WID2=WIDS(6,2)
|
|
IF(MOD(IA,4).EQ.0) WID2=WIDS(8,2)
|
|
IF(IA.GE.13) WID2=WID2*WIDS(7,3)
|
|
ELSE
|
|
IF(MOD(IA,4).EQ.3) WID2=WIDS(6,3)
|
|
IF(MOD(IA,4).EQ.0) WID2=WIDS(8,3)
|
|
IF(IA.GE.13) WID2=WID2*WIDS(7,2)
|
|
ENDIF
|
|
ELSE
|
|
FCOF=1D0
|
|
IF(KFLR.GT.0) THEN
|
|
IF(IA.EQ.20) WID2=WIDS(17,3)*WIDS(18,2)
|
|
ELSE
|
|
IF(IA.EQ.20) WID2=WIDS(17,2)*WIDS(18,3)
|
|
ENDIF
|
|
ENDIF
|
|
WDTP(I)=FACF*FCOF*0.5D0*(2D0-RM1-RM2-(RM1-RM2)**2)*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
|
|
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
|
|
|
|
ELSEIF(KFLA.EQ.56) THEN
|
|
C...Techni-omega:
|
|
ALPRHT=2.91D0*(3D0/PARP(144))
|
|
FAC=(AEM/24D0)*(SHR**3/PARP(145)**2)
|
|
FACF=(1D0/6D0)*(AEM**2/ALPRHT)*(PMAS(KFLA,1)**4/SHR**3)*
|
|
& (2D0*PARP(143)-1D0)**2
|
|
SQMZ=PMAS(23,1)**2
|
|
GMMZ=PMAS(23,1)*PMAS(23,2)
|
|
BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
|
|
BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
|
|
DO 370 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 370
|
|
RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
|
|
RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 370
|
|
IF(I.EQ.1) THEN
|
|
C...omega_tech0 -> gamma + pi_tech0.
|
|
WDTP(I)=FAC*
|
|
& SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3
|
|
WID2=WIDS(51,2)
|
|
ELSEIF(I.EQ.2) THEN
|
|
C...omega_tech0 -> Z0 + pi_tech0 not known.
|
|
WDTP(I)=0D0
|
|
WID2=WIDS(23,2)*WIDS(51,2)
|
|
ELSE
|
|
C...omega_tech0 -> f + fbar.
|
|
WID2=1D0
|
|
IF(I.LE.10) THEN
|
|
IA=I-2
|
|
FCOF=3D0*RADC
|
|
IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1)
|
|
ELSE
|
|
IA=I
|
|
FCOF=1D0
|
|
IF(IA.GE.17) WID2=WIDS(IA,1)
|
|
ENDIF
|
|
EI=KCHG(IA,1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
VALI=0.5D0*(VI+AI)
|
|
VARI=0.5D0*(VI-AI)
|
|
WDTP(I)=FACF*FCOF*(1D0-RM1)*SQRT(MAX(0D0,1D0-4D0*RM1))*
|
|
& ((EI-VALI*BWZR)**2+(VALI*BWZI)**2+
|
|
& (EI-VARI*BWZR)**2+(VARI*BWZI)**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
|
|
370 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.KEXCIT+1) THEN
|
|
C...d* excited quark.
|
|
FAC=(SH/PARU(155)**2)*SHR
|
|
DO 380 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 380
|
|
RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
|
|
RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 380
|
|
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
|
|
380 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.KEXCIT+2) THEN
|
|
C...u* excited quark.
|
|
FAC=(SH/PARU(155)**2)*SHR
|
|
DO 390 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 390
|
|
RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
|
|
RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 390
|
|
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
|
|
390 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.KEXCIT+11) THEN
|
|
C...e* excited lepton.
|
|
FAC=(SH/PARU(155)**2)*SHR
|
|
DO 400 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 400
|
|
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 400
|
|
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
|
|
400 CONTINUE
|
|
|
|
ELSEIF(KFLA.EQ.KEXCIT+12) THEN
|
|
C...nu*_e excited neutrino.
|
|
FAC=(SH/PARU(155)**2)*SHR
|
|
DO 410 I=1,MDCY(KC,3)
|
|
IDC=I+MDCY(KC,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 410
|
|
RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH
|
|
RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH
|
|
IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 410
|
|
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
|
|
410 CONTINUE
|
|
|
|
ENDIF
|
|
MINT(61)=0
|
|
MINT(62)=0
|
|
MINT(63)=0
|
|
|
|
RETURN
|
|
END
|
|
|
|
C***********************************************************************
|
|
|
|
C...PYOFSH
|
|
C...Calculates partial width and differential cross-section maxima
|
|
C...of channels/processes not allowed on mass-shell, and selects
|
|
C...masses in such channels/processes.
|
|
|
|
SUBROUTINE PYOFSH(MOFSH,KFMO,KFD1,KFD2,PMMO,RET1,RET2)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
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:200),
|
|
&WDTE(0:200,0:5)
|
|
|
|
C...Find if particles equal, maximum mass, matrix elements, etc.
|
|
MINT(51)=0
|
|
ISUB=MINT(1)
|
|
KFD(1)=IABS(KFD1)
|
|
KFD(2)=IABS(KFD2)
|
|
MEQL=0
|
|
IF(KFD(1).EQ.KFD(2)) MEQL=1
|
|
MLM=0
|
|
IF(MOFSH.GE.2.AND.MEQL.EQ.1) MLM=INT(1.5D0+PYR(0))
|
|
IF(MOFSH.LE.2.OR.MOFSH.EQ.5) THEN
|
|
NOFF=44
|
|
PMMX=PMMO
|
|
ELSE
|
|
NOFF=40
|
|
PMMX=VINT(1)
|
|
IF(CKIN(2).GT.CKIN(1)) PMMX=MIN(CKIN(2),VINT(1))
|
|
ENDIF
|
|
MMED=0
|
|
IF((KFMO.EQ.25.OR.KFMO.EQ.35.OR.KFMO.EQ.36).AND.MEQL.EQ.1.AND.
|
|
&(KFD(1).EQ.23.OR.KFD(1).EQ.24)) MMED=1
|
|
IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(1).EQ.23.OR.
|
|
&KFD(1).EQ.24).AND.(KFD(2).EQ.23.OR.KFD(2).EQ.24)) MMED=2
|
|
IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(2).EQ.25.OR.
|
|
&KFD(2).EQ.35.OR.KFD(2).EQ.36)) MMED=3
|
|
LOOP=1
|
|
|
|
C...Find where Breit-Wigners are required, else select discrete masses.
|
|
100 DO 110 I=1,2
|
|
KFCA=PYCOMP(KFD(I))
|
|
IF(KFCA.GT.0) THEN
|
|
PMD(I)=PMAS(KFCA,1)
|
|
PGD(I)=PMAS(KFCA,2)
|
|
ELSE
|
|
PMD(I)=0D0
|
|
PGD(I)=0D0
|
|
ENDIF
|
|
IF(MSTP(42).LE.0.OR.PGD(I).LT.PARP(41)) THEN
|
|
MBW(I)=0
|
|
PMG(I)=PMD(I)
|
|
RMG(I)=(PMG(I)/PMMX)**2
|
|
ELSE
|
|
MBW(I)=1
|
|
ENDIF
|
|
110 CONTINUE
|
|
|
|
C...Find allowed mass range and Breit-Wigner parameters.
|
|
DO 120 I=1,2
|
|
IF(MOFSH.EQ.1.AND.LOOP.EQ.1.AND.MBW(I).EQ.1) THEN
|
|
PML(I)=PARP(42)
|
|
PMU(I)=PMMX-PARP(42)
|
|
IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I))
|
|
IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1
|
|
ELSEIF(MBW(I).EQ.1.AND.MOFSH.NE.5) THEN
|
|
ILM=I
|
|
IF(MLM.EQ.2) ILM=3-I
|
|
PML(I)=MAX(CKIN(NOFF+2*ILM-1),PARP(42))
|
|
PMU(I)=PMMX-MAX(CKIN(NOFF+5-2*ILM),PARP(42))
|
|
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.5) THEN
|
|
ILM=I
|
|
IF(MLM.EQ.2) ILM=3-I
|
|
PML(I)=MAX(CKIN(48+I),PARP(42))
|
|
PMU(I)=PMMX-MAX(CKIN(51-I),PARP(42))
|
|
IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I))
|
|
IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX)
|
|
IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX)
|
|
IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1
|
|
IF(MBW(I).EQ.1) THEN
|
|
ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I)))
|
|
ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I)))
|
|
IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)*
|
|
& PGD(I)))
|
|
ENDIF
|
|
ENDIF
|
|
120 CONTINUE
|
|
IF(MBW(1).LT.0.OR.MBW(2).LT.0.OR.(MBW(1).EQ.0.AND.MBW(2).EQ.0))
|
|
&THEN
|
|
CALL PYERRM(3,'(PYOFSH:) no allowed decay product masses')
|
|
MINT(51)=1
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Calculation of partial width of resonance.
|
|
IF(MOFSH.EQ.1) THEN
|
|
|
|
C..If only one integration, pick that to be the inner.
|
|
IF(MBW(1).EQ.0) THEN
|
|
PM2=PMD(1)
|
|
PMD(1)=PMD(2)
|
|
PGD(1)=PGD(2)
|
|
PML(1)=PML(2)
|
|
PMU(1)=PMU(2)
|
|
ELSEIF(MBW(2).EQ.0) THEN
|
|
PM2=PMD(2)
|
|
ENDIF
|
|
|
|
C...Start outer loop of integration.
|
|
IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN
|
|
ATL2=ATAN((PML(2)**2-PMD(2)**2)/(PMD(2)*PGD(2)))
|
|
ATU2=ATAN((PMU(2)**2-PMD(2)**2)/(PMD(2)*PGD(2)))
|
|
NPT2=1
|
|
XPT2(1)=1D0
|
|
INX2(1)=0
|
|
FMAX2=0D0
|
|
ENDIF
|
|
130 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN
|
|
PM2S=PMD(2)**2+PMD(2)*PGD(2)*TAN(ATL2+XPT2(NPT2)*(ATU2-ATL2))
|
|
PM2=MIN(PMU(2),MAX(PML(2),SQRT(MAX(0D0,PM2S))))
|
|
ENDIF
|
|
RM2=(PM2/PMMX)**2
|
|
|
|
C...Start inner loop of integration.
|
|
PML1=PML(1)
|
|
PMU1=MIN(PMU(1),PMMX-PM2)
|
|
IF(MEQL.EQ.1) PMU1=MIN(PMU1,PM2)
|
|
ATL1=ATAN((PML1**2-PMD(1)**2)/(PMD(1)*PGD(1)))
|
|
ATU1=ATAN((PMU1**2-PMD(1)**2)/(PMD(1)*PGD(1)))
|
|
IF(PML1+PARJ(64).GE.PMU1.OR.ATL1+1D-7.GE.ATU1) THEN
|
|
FUNC2=0D0
|
|
GOTO 180
|
|
ENDIF
|
|
NPT1=1
|
|
XPT1(1)=1D0
|
|
INX1(1)=0
|
|
FMAX1=0D0
|
|
140 PM1S=PMD(1)**2+PMD(1)*PGD(1)*TAN(ATL1+XPT1(NPT1)*(ATU1-ATL1))
|
|
PM1=MIN(PMU1,MAX(PML1,SQRT(MAX(0D0,PM1S))))
|
|
RM1=(PM1/PMMX)**2
|
|
|
|
C...Evaluate function value - inner loop.
|
|
FUNC1=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
|
|
IF(MMED.EQ.1) FUNC1=FUNC1*((1D0-RM1-RM2)**2+8D0*RM1*RM2)
|
|
IF(MMED.EQ.2) FUNC1=FUNC1**3*(1D0+10D0*RM1+10D0*RM2+RM1**2+
|
|
& RM2**2+10D0*RM1*RM2)
|
|
IF(FUNC1.GT.FMAX1) FMAX1=FUNC1
|
|
FPT1(NPT1)=FUNC1
|
|
|
|
C...Go to next position in inner loop.
|
|
IF(NPT1.EQ.1) THEN
|
|
NPT1=NPT1+1
|
|
XPT1(NPT1)=0D0
|
|
INX1(NPT1)=1
|
|
GOTO 140
|
|
ELSEIF(NPT1.LE.8) THEN
|
|
NPT1=NPT1+1
|
|
IF(NPT1.LE.4.OR.NPT1.EQ.6) ISH1=1
|
|
ISH1=ISH1+1
|
|
XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1)))
|
|
INX1(NPT1)=INX1(ISH1)
|
|
INX1(ISH1)=NPT1
|
|
GOTO 140
|
|
ELSEIF(NPT1.LT.100) THEN
|
|
ISN1=ISH1
|
|
150 ISH1=ISH1+1
|
|
IF(ISH1.GT.NPT1) ISH1=2
|
|
IF(ISH1.EQ.ISN1) GOTO 160
|
|
DFPT1=ABS(FPT1(ISH1)-FPT1(INX1(ISH1)))
|
|
IF(DFPT1.LT.PARP(43)*FMAX1) GOTO 150
|
|
NPT1=NPT1+1
|
|
XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1)))
|
|
INX1(NPT1)=INX1(ISH1)
|
|
INX1(ISH1)=NPT1
|
|
GOTO 140
|
|
ENDIF
|
|
|
|
C...Calculate integral over inner loop.
|
|
160 FSUM1=0D0
|
|
DO 170 IPT1=2,NPT1
|
|
FSUM1=FSUM1+0.5D0*(FPT1(IPT1)+FPT1(INX1(IPT1)))*
|
|
& (XPT1(INX1(IPT1))-XPT1(IPT1))
|
|
170 CONTINUE
|
|
FUNC2=FSUM1*(ATU1-ATL1)/PARU(1)
|
|
180 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN
|
|
IF(FUNC2.GT.FMAX2) FMAX2=FUNC2
|
|
FPT2(NPT2)=FUNC2
|
|
|
|
C...Go to next position in outer loop.
|
|
IF(NPT2.EQ.1) THEN
|
|
NPT2=NPT2+1
|
|
XPT2(NPT2)=0D0
|
|
INX2(NPT2)=1
|
|
GOTO 130
|
|
ELSEIF(NPT2.LE.8) THEN
|
|
NPT2=NPT2+1
|
|
IF(NPT2.LE.4.OR.NPT2.EQ.6) ISH2=1
|
|
ISH2=ISH2+1
|
|
XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2)))
|
|
INX2(NPT2)=INX2(ISH2)
|
|
INX2(ISH2)=NPT2
|
|
GOTO 130
|
|
ELSEIF(NPT2.LT.100) THEN
|
|
ISN2=ISH2
|
|
190 ISH2=ISH2+1
|
|
IF(ISH2.GT.NPT2) ISH2=2
|
|
IF(ISH2.EQ.ISN2) GOTO 200
|
|
DFPT2=ABS(FPT2(ISH2)-FPT2(INX2(ISH2)))
|
|
IF(DFPT2.LT.PARP(43)*FMAX2) GOTO 190
|
|
NPT2=NPT2+1
|
|
XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2)))
|
|
INX2(NPT2)=INX2(ISH2)
|
|
INX2(ISH2)=NPT2
|
|
GOTO 130
|
|
ENDIF
|
|
|
|
C...Calculate integral over outer loop.
|
|
200 FSUM2=0D0
|
|
DO 210 IPT2=2,NPT2
|
|
FSUM2=FSUM2+0.5D0*(FPT2(IPT2)+FPT2(INX2(IPT2)))*
|
|
& (XPT2(INX2(IPT2))-XPT2(IPT2))
|
|
210 CONTINUE
|
|
FSUM2=FSUM2*(ATU2-ATL2)/PARU(1)
|
|
IF(MEQL.EQ.1) FSUM2=2D0*FSUM2
|
|
ELSE
|
|
FSUM2=FUNC2
|
|
ENDIF
|
|
|
|
C...Save result; second integration for user-selected mass range.
|
|
IF(LOOP.EQ.1) WIDW=FSUM2
|
|
WID2=FSUM2
|
|
IF(LOOP.EQ.1.AND.(CKIN(46).GE.CKIN(45).OR.CKIN(48).GE.CKIN(47)
|
|
& .OR.MAX(CKIN(45),CKIN(47)).GE.1.01D0*PARP(42))) THEN
|
|
LOOP=2
|
|
GOTO 100
|
|
ENDIF
|
|
RET1=WIDW
|
|
RET2=WID2/WIDW
|
|
|
|
C...Select two decay product masses of a resonance.
|
|
ELSEIF(MOFSH.EQ.2.OR.MOFSH.EQ.5) THEN
|
|
220 DO 230 I=1,2
|
|
IF(MBW(I).EQ.0) GOTO 230
|
|
PMBW=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)*
|
|
& (ATU(I)-ATL(I)))
|
|
PMG(I)=MIN(PMU(I),MAX(PML(I),SQRT(MAX(0D0,PMBW))))
|
|
RMG(I)=(PMG(I)/PMMX)**2
|
|
230 CONTINUE
|
|
IF((MEQL.EQ.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR.
|
|
& PMG(1)+PMG(2)+PARJ(64).GT.PMMX) GOTO 220
|
|
|
|
C...Weight with matrix element (if none known, use beta factor).
|
|
FLAM=SQRT(MAX(0D0,(1D0-RMG(1)-RMG(2))**2-4D0*RMG(1)*RMG(2)))
|
|
IF(MMED.EQ.1) THEN
|
|
WTBE=FLAM*((1D0-RMG(1)-RMG(2))**2+8D0*RMG(1)*RMG(2))
|
|
ELSEIF(MMED.EQ.2) THEN
|
|
WTBE=FLAM**3*(1D0+10D0*RMG(1)+10D0*RMG(2)+RMG(1)**2+
|
|
& RMG(2)**2+10D0*RMG(1)*RMG(2))
|
|
ELSEIF(MMED.EQ.3) THEN
|
|
WTBE=FLAM*(RMG(1)+FLAM**2/12D0)
|
|
ELSE
|
|
WTBE=FLAM
|
|
ENDIF
|
|
IF(WTBE.LT.PYR(0)) GOTO 220
|
|
RET1=PMG(1)
|
|
RET2=PMG(2)
|
|
|
|
C...Find suitable set of masses for initialization of 2 -> 2 processes.
|
|
ELSEIF(MOFSH.EQ.3) THEN
|
|
IF(MBW(1).NE.0.AND.MBW(2).EQ.0) THEN
|
|
PMG(1)=MIN(PMD(1),0.5D0*(PML(1)+PMU(1)))
|
|
PMG(2)=PMD(2)
|
|
ELSEIF(MBW(2).NE.0.AND.MBW(1).EQ.0) THEN
|
|
PMG(1)=PMD(1)
|
|
PMG(2)=MIN(PMD(2),0.5D0*(PML(2)+PMU(2)))
|
|
ELSE
|
|
IDIV=-1
|
|
240 IDIV=IDIV+1
|
|
PMG(1)=MIN(PMD(1),0.1D0*(IDIV*PML(1)+(10-IDIV)*PMU(1)))
|
|
PMG(2)=MIN(PMD(2),0.1D0*(IDIV*PML(2)+(10-IDIV)*PMU(2)))
|
|
IF(IDIV.LE.9.AND.PMG(1)+PMG(2).GT.0.9D0*PMMX) GOTO 240
|
|
ENDIF
|
|
RET1=PMG(1)
|
|
RET2=PMG(2)
|
|
|
|
C...Evaluate importance of excluded tails of Breit-Wigners.
|
|
IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2)
|
|
& .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2
|
|
IF(MEQL.LE.1) THEN
|
|
VINT(80)=1D0
|
|
DO 250 I=1,2
|
|
IF(MBW(I).NE.0) VINT(80)=VINT(80)*1.25D0*(ATU(I)-ATL(I))/
|
|
& PARU(1)
|
|
250 CONTINUE
|
|
ELSE
|
|
VINT(80)=(1.25D0/PARU(1))**2*MAX((ATU(1)-ATL(1))*
|
|
& (ATH(2)-ATL(2)),(ATH(1)-ATL(1))*(ATU(2)-ATL(2)))
|
|
ENDIF
|
|
IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.30.OR.ISUB.EQ.35).AND.
|
|
& MSTP(43).NE.2) VINT(80)=2D0*VINT(80)
|
|
IF(ISUB.EQ.22.AND.MSTP(43).NE.2) VINT(80)=4D0*VINT(80)
|
|
IF(MEQL.GE.1) VINT(80)=2D0*VINT(80)
|
|
|
|
C...Pick one particle to be the lighter (if improves efficiency).
|
|
ELSEIF(MOFSH.EQ.4) THEN
|
|
IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2)
|
|
& .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2
|
|
260 IF(MEQL.EQ.2) MLM=INT(1.5D0+PYR(0))
|
|
|
|
C...Select two masses according to Breit-Wigner + flat in s + 1/s.
|
|
DO 270 I=1,2
|
|
IF(MBW(I).EQ.0) GOTO 270
|
|
PMV=PMU(I)
|
|
IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I)
|
|
ATV=ATU(I)
|
|
IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I)
|
|
RBR=PYR(0)
|
|
IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR.
|
|
& ISUB.EQ.35).AND.MSTP(43).NE.2) RBR=2D0*RBR
|
|
IF(RBR.LT.0.8D0) THEN
|
|
PMSR=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)*(ATV-ATL(I)))
|
|
PMG(I)=MIN(PMV,MAX(PML(I),SQRT(MAX(0D0,PMSR))))
|
|
ELSEIF(RBR.LT.0.9D0) THEN
|
|
PMG(I)=SQRT(MAX(0D0,PML(I)**2+PYR(0)*(PMV**2-PML(I)**2)))
|
|
ELSEIF(RBR.LT.1.5D0) THEN
|
|
PMG(I)=PML(I)*(PMV/PML(I))**PYR(0)
|
|
ELSE
|
|
PMG(I)=SQRT(MAX(0D0,PML(I)**2*PMV**2/(PML(I)**2+PYR(0)*
|
|
& (PMV**2-PML(I)**2))))
|
|
ENDIF
|
|
270 CONTINUE
|
|
IF((MEQL.GE.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR.
|
|
& PMG(1)+PMG(2)+PARJ(64).GT.PMMX) THEN
|
|
IF(MINT(48).EQ.1) THEN
|
|
NGEN(0,1)=NGEN(0,1)+1
|
|
NGEN(MINT(1),1)=NGEN(MINT(1),1)+1
|
|
GOTO 260
|
|
ELSE
|
|
MINT(51)=1
|
|
RETURN
|
|
ENDIF
|
|
ENDIF
|
|
RET1=PMG(1)
|
|
RET2=PMG(2)
|
|
|
|
C...Give weight for selected mass distribution.
|
|
VINT(80)=1D0
|
|
DO 280 I=1,2
|
|
IF(MBW(I).EQ.0) GOTO 280
|
|
PMV=PMU(I)
|
|
IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I)
|
|
ATV=ATU(I)
|
|
IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I)
|
|
F0=PMD(I)*PGD(I)/((PMG(I)**2-PMD(I)**2)**2+
|
|
& (PMD(I)*PGD(I))**2)/PARU(1)
|
|
F1=1D0
|
|
F2=1D0/PMG(I)**2
|
|
F3=1D0/PMG(I)**4
|
|
FI0=(ATV-ATL(I))/PARU(1)
|
|
FI1=PMV**2-PML(I)**2
|
|
FI2=2D0*LOG(PMV/PML(I))
|
|
FI3=1D0/PML(I)**2-1D0/PMV**2
|
|
IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR.
|
|
& ISUB.EQ.35).AND.MSTP(43).NE.2) THEN
|
|
VINT(80)=VINT(80)*20D0/(8D0+(FI0/F0)*(F1/FI1+6D0*F2/FI2+
|
|
& 5D0*F3/FI3))
|
|
ELSE
|
|
VINT(80)=VINT(80)*10D0/(8D0+(FI0/F0)*(F1/FI1+F2/FI2))
|
|
ENDIF
|
|
VINT(80)=VINT(80)*FI0
|
|
280 CONTINUE
|
|
IF(MEQL.GE.1) VINT(80)=2D0*VINT(80)
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C***********************************************************************
|
|
|
|
C...PYRECO
|
|
C...Handles the possibility of colour reconnection in W+W- events,
|
|
C...Based on the main scenarios of the Sjostrand and Khoze study:
|
|
C...I, II, II', intermediate and instantaneous; plus one model
|
|
C...along the lines of the Gustafson and Hakkinen: GH.
|
|
|
|
SUBROUTINE PYRECO(IW1,IW2,NSD1,NAFT1)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter value; number of points in MC integration.
|
|
PARAMETER (NPT=100)
|
|
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 NBEG(2),NEND(2),INP(50),INM(50),BEWW(3),XP(3),XM(3),
|
|
&V1(3),V2(3),BETP(50,4),DIRP(50,3),BETM(50,4),DIRM(50,3),
|
|
&XD(4),XB(4),IAP(NPT),IAM(NPT),WTA(NPT),V1P(3),V2P(3),V1M(3),
|
|
&V2M(3),Q(4,3),XPP(3),XMM(3),IPC(20),IMC(20),TC(0:20),TPC(20),
|
|
&TMC(20),IJOIN(100)
|
|
|
|
C...Functions to give four-product and to do determinants.
|
|
FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3)
|
|
DETER(I,J,L)=Q(I,1)*Q(J,2)*Q(L,3)-Q(I,1)*Q(L,2)*Q(J,3)+
|
|
&Q(J,1)*Q(L,2)*Q(I,3)-Q(J,1)*Q(I,2)*Q(L,3)+
|
|
&Q(L,1)*Q(I,2)*Q(J,3)-Q(L,1)*Q(J,2)*Q(I,3)
|
|
|
|
C...Only allow fraction of recoupling for GH, intermediate and
|
|
C...instantaneous.
|
|
IF(MSTP(115).EQ.5.OR.MSTP(115).EQ.11.OR.MSTP(115).EQ.12) THEN
|
|
IF(PYR(0).GT.PARP(120)) RETURN
|
|
ENDIF
|
|
|
|
C...Common part for scenarios I, II, II', and GH.
|
|
IF(MSTP(115).EQ.1.OR.MSTP(115).EQ.2.OR.MSTP(115).EQ.3.OR.
|
|
&MSTP(115).EQ.5) THEN
|
|
|
|
C...Read out frequently-used parameters.
|
|
PI=PARU(1)
|
|
HBAR=PARU(3)
|
|
PMW=PMAS(24,1)
|
|
PGW=PMAS(24,2)
|
|
TFRAG=PARP(115)
|
|
RHAD=PARP(116)
|
|
FACT=PARP(117)
|
|
BLOWR=PARP(118)
|
|
BLOWT=PARP(119)
|
|
|
|
C...Find range of decay products of the W's.
|
|
C...Background: the W's are stored in IW1 and IW2.
|
|
C...Their direct decay products in NSD1+1 through NSD1+4.
|
|
C...Products after shower (if any) in NSD1+5 through NAFT1
|
|
C...for first W and in NAFT1+1 through N for the second.
|
|
IF(K(IW1,2).GT.0) THEN
|
|
JT=1
|
|
ELSE
|
|
JT=2
|
|
ENDIF
|
|
JR=3-JT
|
|
IF(NAFT1.GT.NSD1+4) THEN
|
|
NBEG(JT)=NSD1+5
|
|
NEND(JT)=NAFT1
|
|
ELSE
|
|
NBEG(JT)=NSD1+1
|
|
NEND(JT)=NSD1+2
|
|
ENDIF
|
|
IF(N.GT.NAFT1) THEN
|
|
NBEG(JR)=NAFT1+1
|
|
NEND(JR)=N
|
|
ELSE
|
|
NBEG(JR)=NSD1+3
|
|
NEND(JR)=NSD1+4
|
|
ENDIF
|
|
|
|
C...Rearrange parton shower products along strings.
|
|
NOLD=N
|
|
CALL PYPREP(NSD1+1)
|
|
|
|
C...Find partons pointing back to W+ and W-; store them with quark
|
|
C...end of string first.
|
|
NNP=0
|
|
NNM=0
|
|
ISGP=0
|
|
ISGM=0
|
|
DO 120 I=NOLD+1,N
|
|
IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 120
|
|
IF(IABS(K(I,2)).GE.22) GOTO 120
|
|
IF(K(I,3).GE.NBEG(1).AND.K(I,3).LE.NEND(1)) THEN
|
|
IF(ISGP.EQ.0) ISGP=ISIGN(1,K(I,2))
|
|
NNP=NNP+1
|
|
IF(ISGP.EQ.1) THEN
|
|
INP(NNP)=I
|
|
ELSE
|
|
DO 100 I1=NNP,2,-1
|
|
INP(I1)=INP(I1-1)
|
|
100 CONTINUE
|
|
INP(1)=I
|
|
ENDIF
|
|
IF(K(I,1).EQ.1) ISGP=0
|
|
ELSEIF(K(I,3).GE.NBEG(2).AND.K(I,3).LE.NEND(2)) THEN
|
|
IF(ISGM.EQ.0) ISGM=ISIGN(1,K(I,2))
|
|
NNM=NNM+1
|
|
IF(ISGM.EQ.1) THEN
|
|
INM(NNM)=I
|
|
ELSE
|
|
DO 110 I1=NNM,2,-1
|
|
INM(I1)=INM(I1-1)
|
|
110 CONTINUE
|
|
INM(1)=I
|
|
ENDIF
|
|
IF(K(I,1).EQ.1) ISGM=0
|
|
ENDIF
|
|
120 CONTINUE
|
|
|
|
C...Boost to W+W- rest frame (not strictly needed).
|
|
DO 130 J=1,3
|
|
BEWW(J)=(P(IW1,J)+P(IW2,J))/(P(IW1,4)+P(IW2,4))
|
|
130 CONTINUE
|
|
CALL PYROBO(IW1,IW1,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3))
|
|
CALL PYROBO(IW2,IW2,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3))
|
|
CALL PYROBO(NOLD+1,N,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3))
|
|
|
|
C...Select decay vertices of W+ and W-.
|
|
TP=HBAR*(-LOG(PYR(0)))*P(IW1,4)/
|
|
& SQRT((P(IW1,5)**2-PMW**2)**2+(P(IW1,5)**2*PGW/PMW)**2)
|
|
TM=HBAR*(-LOG(PYR(0)))*P(IW2,4)/
|
|
& SQRT((P(IW2,5)**2-PMW**2)**2+(P(IW2,5)**2*PGW/PMW)**2)
|
|
GTMAX=MAX(TP,TM)
|
|
DO 140 J=1,3
|
|
XP(J)=TP*P(IW1,J)/P(IW1,4)
|
|
XM(J)=TM*P(IW2,J)/P(IW2,4)
|
|
140 CONTINUE
|
|
|
|
C...Begin scenario I specifics.
|
|
IF(MSTP(115).EQ.1) THEN
|
|
|
|
C...Reconstruct velocity and direction of W+ string pieces.
|
|
DO 170 IIP=1,NNP-1
|
|
IF(K(INP(IIP),2).LT.0) GOTO 170
|
|
I1=INP(IIP)
|
|
I2=INP(IIP+1)
|
|
P1A=SQRT(P(I1,1)**2+P(I1,2)**2+P(I1,3)**2)
|
|
P2A=SQRT(P(I2,1)**2+P(I2,2)**2+P(I2,3)**2)
|
|
DO 150 J=1,3
|
|
V1(J)=P(I1,J)/P1A
|
|
V2(J)=P(I2,J)/P2A
|
|
BETP(IIP,J)=0.5D0*(V1(J)+V2(J))
|
|
DIRP(IIP,J)=V1(J)-V2(J)
|
|
150 CONTINUE
|
|
BETP(IIP,4)=1D0/SQRT(1D0-BETP(IIP,1)**2-BETP(IIP,2)**2-
|
|
& BETP(IIP,3)**2)
|
|
DIRL=SQRT(DIRP(IIP,1)**2+DIRP(IIP,2)**2+DIRP(IIP,3)**2)
|
|
DO 160 J=1,3
|
|
DIRP(IIP,J)=DIRP(IIP,J)/DIRL
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
|
|
C...Reconstruct velocity and direction of W- string pieces.
|
|
DO 200 IIM=1,NNM-1
|
|
IF(K(INM(IIM),2).LT.0) GOTO 200
|
|
I1=INM(IIM)
|
|
I2=INM(IIM+1)
|
|
P1A=SQRT(P(I1,1)**2+P(I1,2)**2+P(I1,3)**2)
|
|
P2A=SQRT(P(I2,1)**2+P(I2,2)**2+P(I2,3)**2)
|
|
DO 180 J=1,3
|
|
V1(J)=P(I1,J)/P1A
|
|
V2(J)=P(I2,J)/P2A
|
|
BETM(IIM,J)=0.5D0*(V1(J)+V2(J))
|
|
DIRM(IIM,J)=V1(J)-V2(J)
|
|
180 CONTINUE
|
|
BETM(IIM,4)=1D0/SQRT(1D0-BETM(IIM,1)**2-BETM(IIM,2)**2-
|
|
& BETM(IIM,3)**2)
|
|
DIRL=SQRT(DIRM(IIM,1)**2+DIRM(IIM,2)**2+DIRM(IIM,3)**2)
|
|
DO 190 J=1,3
|
|
DIRM(IIM,J)=DIRM(IIM,J)/DIRL
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
|
|
C...Loop over number of space-time points.
|
|
NACC=0
|
|
SUM=0D0
|
|
DO 250 IPT=1,NPT
|
|
|
|
C...Pick x,y,z,t Gaussian (width RHAD and TFRAG, respectively).
|
|
R=SQRT(-LOG(PYR(0)))
|
|
PHI=2D0*PI*PYR(0)
|
|
X=BLOWR*RHAD*R*COS(PHI)
|
|
Y=BLOWR*RHAD*R*SIN(PHI)
|
|
R=SQRT(-LOG(PYR(0)))
|
|
PHI=2D0*PI*PYR(0)
|
|
Z=BLOWR*RHAD*R*COS(PHI)
|
|
T=GTMAX+BLOWT*SQRT(0.5D0)*TFRAG*R*ABS(SIN(PHI))
|
|
|
|
C...Weight for sample distribution.
|
|
WTSMP=EXP(-(X**2+Y**2+Z**2)/(BLOWR*RHAD)**2)*
|
|
& EXP(-2D0*(T-GTMAX)**2/(BLOWT*TFRAG)**2)
|
|
|
|
C...Loop over W+ string pieces and find one with largest weight.
|
|
IMAXP=0
|
|
WTMAXP=1D-10
|
|
XD(1)=X-XP(1)
|
|
XD(2)=Y-XP(2)
|
|
XD(3)=Z-XP(3)
|
|
XD(4)=T-TP
|
|
DO 220 IIP=1,NNP-1
|
|
IF(K(INP(IIP),2).LT.0) GOTO 220
|
|
BED=BETP(IIP,1)*XD(1)+BETP(IIP,2)*XD(2)+BETP(IIP,3)*XD(3)
|
|
BEDG=BETP(IIP,4)*(BETP(IIP,4)*BED/(1D0+BETP(IIP,4))-XD(4))
|
|
DO 210 J=1,3
|
|
XB(J)=XD(J)+BEDG*BETP(IIP,J)
|
|
210 CONTINUE
|
|
XB(4)=BETP(IIP,4)*(XD(4)-BED)
|
|
SR2=XB(1)**2+XB(2)**2+XB(3)**2
|
|
SZ2=(DIRP(IIP,1)*XB(1)+DIRP(IIP,2)*XB(2)+
|
|
& DIRP(IIP,3)*XB(3))**2
|
|
WTP=EXP(-(SR2-SZ2)/(2D0*RHAD**2))*EXP(-(XB(4)**2-SZ2)/
|
|
& TFRAG**2)
|
|
IF(XB(4)-SQRT(SR2).LT.0D0) WTP=0D0
|
|
IF(WTP.GT.WTMAXP) THEN
|
|
IMAXP=IIP
|
|
WTMAXP=WTP
|
|
ENDIF
|
|
220 CONTINUE
|
|
|
|
C...Loop over W- string pieces and find one with largest weight.
|
|
IMAXM=0
|
|
WTMAXM=1D-10
|
|
XD(1)=X-XM(1)
|
|
XD(2)=Y-XM(2)
|
|
XD(3)=Z-XM(3)
|
|
XD(4)=T-TM
|
|
DO 240 IIM=1,NNM-1
|
|
IF(K(INM(IIM),2).LT.0) GOTO 240
|
|
BED=BETM(IIM,1)*XD(1)+BETM(IIM,2)*XD(2)+BETM(IIM,3)*XD(3)
|
|
BEDG=BETM(IIM,4)*(BETM(IIM,4)*BED/(1D0+BETM(IIM,4))-XD(4))
|
|
DO 230 J=1,3
|
|
XB(J)=XD(J)+BEDG*BETM(IIM,J)
|
|
230 CONTINUE
|
|
XB(4)=BETM(IIM,4)*(XD(4)-BED)
|
|
SR2=XB(1)**2+XB(2)**2+XB(3)**2
|
|
SZ2=(DIRM(IIM,1)*XB(1)+DIRM(IIM,2)*XB(2)+
|
|
& DIRM(IIM,3)*XB(3))**2
|
|
WTM=EXP(-(SR2-SZ2)/(2D0*RHAD**2))*EXP(-(XB(4)**2-SZ2)/
|
|
& TFRAG**2)
|
|
IF(XB(4)-SQRT(SR2).LT.0D0) WTM=0D0
|
|
IF(WTM.GT.WTMAXM) THEN
|
|
IMAXM=IIM
|
|
WTMAXM=WTM
|
|
ENDIF
|
|
240 CONTINUE
|
|
|
|
C...Result of integration.
|
|
WT=0D0
|
|
IF(IMAXP.NE.0.AND.IMAXM.NE.0) THEN
|
|
WT=WTMAXP*WTMAXM/WTSMP
|
|
SUM=SUM+WT
|
|
NACC=NACC+1
|
|
IAP(NACC)=IMAXP
|
|
IAM(NACC)=IMAXM
|
|
WTA(NACC)=WT
|
|
ENDIF
|
|
250 CONTINUE
|
|
RES=BLOWR**3*BLOWT*SUM/NPT
|
|
|
|
C...Decide whether to reconnect and, if so, where.
|
|
IACC=0
|
|
PREC=1D0-EXP(-FACT*RES)
|
|
IF(PREC.GT.PYR(0)) THEN
|
|
RSUM=PYR(0)*SUM
|
|
DO 260 IA=1,NACC
|
|
IACC=IA
|
|
RSUM=RSUM-WTA(IA)
|
|
IF(RSUM.LE.0D0) GOTO 270
|
|
260 CONTINUE
|
|
270 IIP=IAP(IACC)
|
|
IIM=IAM(IACC)
|
|
ENDIF
|
|
|
|
C...Begin scenario II and II' specifics.
|
|
ELSEIF(MSTP(115).EQ.2.OR.MSTP(115).EQ.3) THEN
|
|
|
|
C...Loop through all string pieces, one from W+ and one from W-.
|
|
NCROSS=0
|
|
TC(0)=0D0
|
|
DO 340 IIP=1,NNP-1
|
|
IF(K(INP(IIP),2).LT.0) GOTO 340
|
|
I1P=INP(IIP)
|
|
I2P=INP(IIP+1)
|
|
DO 330 IIM=1,NNM-1
|
|
IF(K(INM(IIM),2).LT.0) GOTO 330
|
|
I1M=INM(IIM)
|
|
I2M=INM(IIM+1)
|
|
|
|
C...Find endpoint velocity vectors.
|
|
DO 280 J=1,3
|
|
V1P(J)=P(I1P,J)/P(I1P,4)
|
|
V2P(J)=P(I2P,J)/P(I2P,4)
|
|
V1M(J)=P(I1M,J)/P(I1M,4)
|
|
V2M(J)=P(I2M,J)/P(I2M,4)
|
|
280 CONTINUE
|
|
|
|
C...Define q matrix and find t.
|
|
DO 290 J=1,3
|
|
Q(1,J)=V2P(J)-V1P(J)
|
|
Q(2,J)=-(V2M(J)-V1M(J))
|
|
Q(3,J)=XP(J)-XM(J)-TP*V1P(J)+TM*V1M(J)
|
|
Q(4,J)=V1P(J)-V1M(J)
|
|
290 CONTINUE
|
|
T=-DETER(1,2,3)/DETER(1,2,4)
|
|
|
|
C...Find alpha and beta; i.e. coordinates of crossing point.
|
|
S11=Q(1,1)*(T-TP)
|
|
S12=Q(2,1)*(T-TM)
|
|
S13=Q(3,1)+Q(4,1)*T
|
|
S21=Q(1,2)*(T-TP)
|
|
S22=Q(2,2)*(T-TM)
|
|
S23=Q(3,2)+Q(4,2)*T
|
|
DEN=S11*S22-S12*S21
|
|
ALP=(S12*S23-S22*S13)/DEN
|
|
BET=(S21*S13-S11*S23)/DEN
|
|
|
|
C...Check if solution acceptable.
|
|
IANSW=1
|
|
IF(T.LT.GTMAX) IANSW=0
|
|
IF(ALP.LT.0D0.OR.ALP.GT.1D0) IANSW=0
|
|
IF(BET.LT.0D0.OR.BET.GT.1D0) IANSW=0
|
|
|
|
C...Find point of crossing and check that not inconsistent.
|
|
DO 300 J=1,3
|
|
XPP(J)=XP(J)+(V1P(J)+ALP*(V2P(J)-V1P(J)))*(T-TP)
|
|
XMM(J)=XM(J)+(V1M(J)+BET*(V2M(J)-V1M(J)))*(T-TM)
|
|
300 CONTINUE
|
|
D2PM=(XPP(1)-XMM(1))**2+(XPP(2)-XMM(2))**2+
|
|
& (XPP(3)-XMM(3))**2
|
|
D2P=XPP(1)**2+XPP(2)**2+XPP(3)**2
|
|
D2M=XMM(1)**2+XMM(2)**2+XMM(3)**2
|
|
IF(D2PM.GT.1D-4*(D2P+D2M)) IANSW=-1
|
|
|
|
C...Find string eigentimes at crossing.
|
|
IF(IANSW.EQ.1) THEN
|
|
TAUP=SQRT(MAX(0D0,(T-TP)**2-(XPP(1)-XP(1))**2-
|
|
& (XPP(2)-XP(2))**2-(XPP(3)-XP(3))**2))
|
|
TAUM=SQRT(MAX(0D0,(T-TM)**2-(XMM(1)-XM(1))**2-
|
|
& (XMM(2)-XM(2))**2-(XMM(3)-XM(3))**2))
|
|
ELSE
|
|
TAUP=0D0
|
|
TAUM=0D0
|
|
ENDIF
|
|
|
|
C...Order crossings by time. End loop over crossings.
|
|
IF(IANSW.EQ.1.AND.NCROSS.LT.20) THEN
|
|
NCROSS=NCROSS+1
|
|
DO 310 I1=NCROSS,1,-1
|
|
IF(T.GT.TC(I1-1).OR.I1.EQ.1) THEN
|
|
IPC(I1)=IIP
|
|
IMC(I1)=IIM
|
|
TC(I1)=T
|
|
TPC(I1)=TAUP
|
|
TMC(I1)=TAUM
|
|
GOTO 320
|
|
ELSE
|
|
IPC(I1)=IPC(I1-1)
|
|
IMC(I1)=IMC(I1-1)
|
|
TC(I1)=TC(I1-1)
|
|
TPC(I1)=TPC(I1-1)
|
|
TMC(I1)=TMC(I1-1)
|
|
ENDIF
|
|
310 CONTINUE
|
|
320 CONTINUE
|
|
ENDIF
|
|
330 CONTINUE
|
|
340 CONTINUE
|
|
|
|
C...Loop over crossings; find first (if any) acceptable one.
|
|
IACC=0
|
|
IF(NCROSS.GE.1) THEN
|
|
DO 350 IC=1,NCROSS
|
|
PNFRAG=EXP(-(TPC(IC)**2+TMC(IC)**2)/TFRAG**2)
|
|
IF(PNFRAG.GT.PYR(0)) THEN
|
|
C...Scenario II: only compare with fragmentation time.
|
|
IF(MSTP(115).EQ.2) THEN
|
|
IACC=IC
|
|
IIP=IPC(IACC)
|
|
IIM=IMC(IACC)
|
|
GOTO 360
|
|
C...Scenario II': also require that string length decreases.
|
|
ELSE
|
|
IIP=IPC(IC)
|
|
IIM=IMC(IC)
|
|
I1P=INP(IIP)
|
|
I2P=INP(IIP+1)
|
|
I1M=INM(IIM)
|
|
I2M=INM(IIM+1)
|
|
ELOLD=FOUR(I1P,I2P)*FOUR(I1M,I2M)
|
|
ELNEW=FOUR(I1P,I2M)*FOUR(I1M,I2P)
|
|
IF(ELNEW.LT.ELOLD) THEN
|
|
IACC=IC
|
|
IIP=IPC(IACC)
|
|
IIM=IMC(IACC)
|
|
GOTO 360
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
350 CONTINUE
|
|
360 CONTINUE
|
|
ENDIF
|
|
|
|
C...Begin scenario GH specifics.
|
|
ELSEIF(MSTP(115).EQ.5) THEN
|
|
|
|
C...Loop through all string pieces, one from W+ and one from W-.
|
|
IACC=0
|
|
ELMIN=1D0
|
|
DO 380 IIP=1,NNP-1
|
|
IF(K(INP(IIP),2).LT.0) GOTO 380
|
|
I1P=INP(IIP)
|
|
I2P=INP(IIP+1)
|
|
DO 370 IIM=1,NNM-1
|
|
IF(K(INM(IIM),2).LT.0) GOTO 370
|
|
I1M=INM(IIM)
|
|
I2M=INM(IIM+1)
|
|
|
|
C...Look for largest decrease of (exponent of) Lambda measure.
|
|
ELOLD=FOUR(I1P,I2P)*FOUR(I1M,I2M)
|
|
ELNEW=FOUR(I1P,I2M)*FOUR(I1M,I2P)
|
|
ELDIF=ELNEW/MAX(1D-10,ELOLD)
|
|
IF(ELDIF.LT.ELMIN) THEN
|
|
IACC=IIP+IIM
|
|
ELMIN=ELDIF
|
|
IPC(1)=IIP
|
|
IMC(1)=IIM
|
|
ENDIF
|
|
370 CONTINUE
|
|
380 CONTINUE
|
|
IIP=IPC(1)
|
|
IIM=IMC(1)
|
|
ENDIF
|
|
|
|
C...Common for scenarios I, II, II' and GH: reconnect strings.
|
|
IF(IACC.NE.0) THEN
|
|
MINT(32)=1
|
|
NJOIN=0
|
|
DO 390 IS=1,NNP+NNM
|
|
NJOIN=NJOIN+1
|
|
IF(IS.LE.IIP) THEN
|
|
I=INP(IS)
|
|
ELSEIF(IS.LE.IIP+NNM-IIM) THEN
|
|
I=INM(IS-IIP+IIM)
|
|
ELSEIF(IS.LE.IIP+NNM) THEN
|
|
I=INM(IS-IIP-NNM+IIM)
|
|
ELSE
|
|
I=INP(IS-NNM)
|
|
ENDIF
|
|
IJOIN(NJOIN)=I
|
|
IF(K(I,2).LT.0) THEN
|
|
CALL PYJOIN(NJOIN,IJOIN)
|
|
NJOIN=0
|
|
ENDIF
|
|
390 CONTINUE
|
|
|
|
C...Restore original event record if no reconnection.
|
|
ELSE
|
|
DO 400 I=NSD1+1,NOLD
|
|
IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) THEN
|
|
K(I,4)=MOD(K(I,4),MSTU(5)**2)
|
|
K(I,5)=MOD(K(I,5),MSTU(5)**2)
|
|
ENDIF
|
|
400 CONTINUE
|
|
DO 410 I=NOLD+1,N
|
|
K(K(I,3),1)=3
|
|
410 CONTINUE
|
|
N=NOLD
|
|
ENDIF
|
|
|
|
C...Boost back system.
|
|
CALL PYROBO(IW1,IW1,0D0,0D0,BEWW(1),BEWW(2),BEWW(3))
|
|
CALL PYROBO(IW2,IW2,0D0,0D0,BEWW(1),BEWW(2),BEWW(3))
|
|
IF(N.GT.NOLD) CALL PYROBO(NOLD+1,N,0D0,0D0,
|
|
& BEWW(1),BEWW(2),BEWW(3))
|
|
|
|
C...Common part for intermediate and instantaneous scenarios.
|
|
ELSEIF(MSTP(115).EQ.11.OR.MSTP(115).EQ.12) THEN
|
|
MINT(32)=1
|
|
|
|
C...Remove old shower products and reset showering ones.
|
|
N=NSD1+4
|
|
DO 420 I=NSD1+1,NSD1+4
|
|
K(I,1)=3
|
|
K(I,4)=MOD(K(I,4),MSTU(5)**2)
|
|
K(I,5)=MOD(K(I,5),MSTU(5)**2)
|
|
420 CONTINUE
|
|
|
|
C...Identify quark-antiquark pairs.
|
|
IQ1=NSD1+1
|
|
IQ2=NSD1+2
|
|
IQ3=NSD1+3
|
|
IF(K(IQ1,2)*K(IQ3,2).LT.0) IQ3=NSD1+4
|
|
IQ4=2*NSD1+7-IQ3
|
|
|
|
C...Reconnect strings.
|
|
IJOIN(1)=IQ1
|
|
IJOIN(2)=IQ4
|
|
CALL PYJOIN(2,IJOIN)
|
|
IJOIN(1)=IQ3
|
|
IJOIN(2)=IQ2
|
|
CALL PYJOIN(2,IJOIN)
|
|
|
|
C...Do new parton showers in intermediate scenario.
|
|
IF(MSTP(71).GE.1.AND.MSTP(115).EQ.11) THEN
|
|
CALL PYSHOW(IQ1,IQ2,P(IW1,5))
|
|
CALL PYSHOW(IQ3,IQ4,P(IW2,5))
|
|
|
|
C...Do new parton showers in instantaneous scenario.
|
|
ELSEIF(MSTP(71).GE.1.AND.MSTP(115).EQ.12) THEN
|
|
PPM2=(P(IQ1,4)+P(IQ4,4))**2-(P(IQ1,1)+P(IQ4,1))**2-
|
|
& (P(IQ1,2)+P(IQ4,2))**2-(P(IQ1,3)+P(IQ4,3))**2
|
|
PPM=SQRT(MAX(0D0,PPM2))
|
|
CALL PYSHOW(IQ1,IQ4,PPM)
|
|
PPM2=(P(IQ3,4)+P(IQ2,4))**2-(P(IQ3,1)+P(IQ2,1))**2-
|
|
& (P(IQ3,2)+P(IQ2,2))**2-(P(IQ3,3)+P(IQ2,3))**2
|
|
PPM=SQRT(MAX(0D0,PPM2))
|
|
CALL PYSHOW(IQ3,IQ2,PPM)
|
|
ENDIF
|
|
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 100
|
|
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) 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
|
|
|
|
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)) 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.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).
|
|
100 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)) 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...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,
|
|
&/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/,
|
|
&/PYSSMT/
|
|
C...Local arrays and complex variables
|
|
DIMENSION X(2),XPQ(-25:25),KFAC(2,-40:40),WDTP(0:200),
|
|
&WDTE(0:200,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
|
|
REAL A00L,A11L,A20L,COULXX
|
|
|
|
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
|
|
|
|
CMRENNA++
|
|
C...Convert almost equivalent SUSY processes into each other
|
|
C...Extract differences in flavours and couplings
|
|
IF(ISUB.GE.200.AND.ISUB.LE.280) THEN
|
|
|
|
C...Sleptons and sneutrinos
|
|
IF(ISUB.EQ.201.OR.ISUB.EQ.204.OR.ISUB.EQ.207) THEN
|
|
KFID=MOD(KFPR(ISUB,1),KSUSY1)
|
|
ISUB=201
|
|
ILR=0
|
|
ELSEIF(ISUB.EQ.202.OR.ISUB.EQ.205.OR.ISUB.EQ.208) THEN
|
|
KFID=MOD(KFPR(ISUB,1),KSUSY1)
|
|
ISUB=201
|
|
ILR=1
|
|
ELSEIF(ISUB.EQ.203.OR.ISUB.EQ.206.OR.ISUB.EQ.209) THEN
|
|
KFID=MOD(KFPR(ISUB,1),KSUSY1)
|
|
ISUB=203
|
|
ELSEIF(ISUB.GE.210.AND.ISUB.LE.212) THEN
|
|
IF(ISUB.EQ.210) THEN
|
|
RKF=2.0D0
|
|
ELSEIF(ISUB.EQ.211) THEN
|
|
RKF=SFMIX(15,1)**2
|
|
ELSEIF(ISUB.EQ.212) THEN
|
|
RKF=SFMIX(15,2)**2
|
|
ENDIF
|
|
ISUB=210
|
|
ELSEIF(ISUB.EQ.213.OR.ISUB.EQ.214) THEN
|
|
IF(ISUB.EQ.213) THEN
|
|
KFID=MOD(KFPR(ISUB,1),KSUSY1)
|
|
RKF=2.0D0
|
|
ELSEIF(ISUB.EQ.214) THEN
|
|
KFID=16
|
|
RKF=1.0D0
|
|
ENDIF
|
|
ISUB=213
|
|
|
|
C...Neutralinos
|
|
ELSEIF(ISUB.GE.216.AND.ISUB.LE.225) THEN
|
|
IF(ISUB.EQ.216) THEN
|
|
IZID1=1
|
|
IZID2=1
|
|
ELSEIF(ISUB.EQ.217) THEN
|
|
IZID1=2
|
|
IZID2=2
|
|
ELSEIF(ISUB.EQ.218) THEN
|
|
IZID1=3
|
|
IZID2=3
|
|
ELSEIF(ISUB.EQ.219) THEN
|
|
IZID1=4
|
|
IZID2=4
|
|
ELSEIF(ISUB.EQ.220) THEN
|
|
IZID1=1
|
|
IZID2=2
|
|
ELSEIF(ISUB.EQ.221) THEN
|
|
IZID1=1
|
|
IZID2=3
|
|
ELSEIF(ISUB.EQ.222) THEN
|
|
IZID1=1
|
|
IZID2=4
|
|
ELSEIF(ISUB.EQ.223) THEN
|
|
IZID1=2
|
|
IZID2=3
|
|
ELSEIF(ISUB.EQ.224) THEN
|
|
IZID1=2
|
|
IZID2=4
|
|
ELSEIF(ISUB.EQ.225) THEN
|
|
IZID1=3
|
|
IZID2=4
|
|
ENDIF
|
|
ISUB=216
|
|
|
|
C...Charginos
|
|
ELSEIF(ISUB.GE.226.AND.ISUB.LE.228) THEN
|
|
IF(ISUB.EQ.226) THEN
|
|
IZID1=1
|
|
IZID2=1
|
|
ELSEIF(ISUB.EQ.227) THEN
|
|
IZID1=2
|
|
IZID2=2
|
|
ELSEIF(ISUB.EQ.228) THEN
|
|
IZID1=1
|
|
IZID2=2
|
|
ENDIF
|
|
ISUB=226
|
|
|
|
C...Neutralino + chargino
|
|
ELSEIF(ISUB.GE.229.AND.ISUB.LE.236) THEN
|
|
IF(ISUB.EQ.229) THEN
|
|
IZID1=1
|
|
IZID2=1
|
|
ELSEIF(ISUB.EQ.230) THEN
|
|
IZID1=1
|
|
IZID2=2
|
|
ELSEIF(ISUB.EQ.231) THEN
|
|
IZID1=1
|
|
IZID2=3
|
|
ELSEIF(ISUB.EQ.232) THEN
|
|
IZID1=1
|
|
IZID2=4
|
|
ELSEIF(ISUB.EQ.233) THEN
|
|
IZID1=2
|
|
IZID2=1
|
|
ELSEIF(ISUB.EQ.234) THEN
|
|
IZID1=2
|
|
IZID2=2
|
|
ELSEIF(ISUB.EQ.235) THEN
|
|
IZID1=2
|
|
IZID2=3
|
|
ELSEIF(ISUB.EQ.236) THEN
|
|
IZID1=2
|
|
IZID2=4
|
|
ENDIF
|
|
ISUB=229
|
|
|
|
C...Gluino + neutralino
|
|
ELSEIF(ISUB.GE.237.AND.ISUB.LE.240) THEN
|
|
IF(ISUB.EQ.237) THEN
|
|
IZID=1
|
|
ELSEIF(ISUB.EQ.238) THEN
|
|
IZID=2
|
|
ELSEIF(ISUB.EQ.239) THEN
|
|
IZID=3
|
|
ELSEIF(ISUB.EQ.240) THEN
|
|
IZID=4
|
|
ENDIF
|
|
ISUB=237
|
|
|
|
C...Gluino + chargino
|
|
ELSEIF(ISUB.GE.241.AND.ISUB.LE.242) THEN
|
|
IF(ISUB.EQ.241) THEN
|
|
IZID=1
|
|
ELSEIF(ISUB.EQ.242) THEN
|
|
IZID=2
|
|
ENDIF
|
|
ISUB=241
|
|
|
|
C...Squark + neutralino
|
|
ELSEIF(ISUB.GE.246.AND.ISUB.LE.253) THEN
|
|
ILR=0
|
|
IF(MOD(ISUB,2).NE.0) ILR=1
|
|
IF(ISUB.LE.247) THEN
|
|
IZID=1
|
|
ELSEIF(ISUB.LE.249) THEN
|
|
IZID=2
|
|
ELSEIF(ISUB.LE.251) THEN
|
|
IZID=3
|
|
ELSEIF(ISUB.LE.253) THEN
|
|
IZID=4
|
|
ENDIF
|
|
ISUB=246
|
|
RKF=5D0
|
|
|
|
C...Squark + chargino
|
|
ELSEIF(ISUB.GE.254.AND.ISUB.LE.257) THEN
|
|
IF(ISUB.LE.255) THEN
|
|
IZID=1
|
|
ELSEIF(ISUB.LE.257) THEN
|
|
IZID=2
|
|
ENDIF
|
|
IF(MOD(ISUB,2).EQ.0) THEN
|
|
ILR=0
|
|
ELSE
|
|
ILR=1
|
|
ENDIF
|
|
ISUB=254
|
|
RKF=5D0
|
|
|
|
C...Squark + gluino
|
|
ELSEIF(ISUB.EQ.258.OR.ISUB.EQ.259) THEN
|
|
ISUB=258
|
|
RKF=5D0
|
|
|
|
C...Stops
|
|
ELSEIF(ISUB.EQ.261.OR.ISUB.EQ.262) THEN
|
|
ILR=0
|
|
IF(ISUB.EQ.262) ILR=1
|
|
ISUB=261
|
|
ELSEIF(ISUB.EQ.265) THEN
|
|
ISUB=264
|
|
|
|
C...Squarks
|
|
ELSEIF(ISUB.GE.271.AND.ISUB.LE.280) THEN
|
|
ILR=0
|
|
IF(ISUB.LE.273) THEN
|
|
IF(ISUB.EQ.273) ILR=1
|
|
ISUB=271
|
|
RKF=25D0
|
|
ELSEIF(ISUB.LE.276) THEN
|
|
IF(ISUB.EQ.276) ILR=1
|
|
ISUB=274
|
|
RKF=25D0
|
|
ELSEIF(ISUB.LE.278) THEN
|
|
IF(ISUB.EQ.278) ILR=1
|
|
ISUB=277
|
|
RKF=5D0
|
|
ELSE
|
|
IF(ISUB.EQ.280) ILR=1
|
|
ISUB=279
|
|
RKF=5D0
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
CMRENNA--
|
|
|
|
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 170
|
|
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...MRENNA+++
|
|
ZWID=PMAS(23,2)
|
|
WWID=PMAS(24,2)
|
|
C...MRENNA---
|
|
|
|
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.5)) 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) 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=SNGL(HDTV*SH)
|
|
A20L=-0.5*A00L
|
|
A11L=A00L/6.
|
|
HDTLS=LOG(SH/PARP(44)**2)
|
|
A004=SNGL((HDTV*SH)**2/(4D0*PARU(1)))*
|
|
& CMPLX(SNGL((176D0*HDTMR+112D0*HDTNR)/3D0+11D0/27D0-
|
|
& (50D0/9D0)*HDTLS),SNGL(4D0*PARU(1)))
|
|
A204=SNGL((HDTV*SH)**2/(4D0*PARU(1)))*
|
|
& CMPLX(SNGL(32D0*(HDTMR+2D0*HDTNR)/3D0+25D0/54D0-
|
|
& (20D0/9D0)*HDTLS),SNGL(PARU(1)))
|
|
A114=SNGL((HDTV*SH)**2/(6D0*PARU(1)))*
|
|
& CMPLX(SNGL(4D0*(-2D0*HDTMR+HDTNR)-1D0/18D0),SNGL(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/(1.-A004/A00L)
|
|
A20U=A20L/(1.-A204/A20L)
|
|
A11U=A11L/(1.-A114/A11L)
|
|
ELSE
|
|
A00U=(A00L+REAL(A004))/(1.-CMPLX(0.,A00L+REAL(A004)))
|
|
A20U=(A20L+REAL(A204))/(1.-CMPLX(0.,A20L+REAL(A204)))
|
|
A11U=(A11L+REAL(A114))/(1.-CMPLX(0.,A11L+REAL(A114)))
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Supersymmetric processes - all of type 2 -> 2 :
|
|
C...correct final-state Breit-Wigners from fixed to running width.
|
|
IF(ISUB.GE.200.AND.ISUB.LE.280.AND.MSTP(42).GT.0) THEN
|
|
DO 160 I=1,2
|
|
KFLW=KFPR(ISUBSV,I)
|
|
KCW=PYCOMP(KFLW)
|
|
IF(PMAS(KCW,2).LT.PARP(41)) GOTO 160
|
|
IF(I.EQ.1) SQMI=SQM3
|
|
IF(I.EQ.2) SQMI=SQM4
|
|
SQMS=PMAS(KCW,1)**2
|
|
GMMS=PMAS(KCW,1)*PMAS(KCW,2)
|
|
HBWS=GMMS/((SQMI-SQMS)**2+GMMS**2)
|
|
CALL PYWIDT(KFLW,SQMI,WDTP,WDTE)
|
|
GMMI=SQRT(SQMI)*WDTP(0)
|
|
HBWI=GMMI/((SQMI-SQMS)**2+GMMI**2)
|
|
COMFAC=COMFAC*(HBWI/HBWS)
|
|
160 CONTINUE
|
|
ENDIF
|
|
|
|
C...A: 2 -> 1, tree diagrams
|
|
|
|
170 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 180 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 180
|
|
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))
|
|
180 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 200 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 200
|
|
IA=IABS(I)
|
|
DO 190 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 190
|
|
JA=IABS(J)
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 190
|
|
IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
|
|
& GOTO 190
|
|
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
|
|
190 CONTINUE
|
|
200 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(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2))
|
|
& FACBW=0D0
|
|
HP=AEM/(8D0*XW)*SH/SQMW*SH
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
DO 210 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 210
|
|
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
|
|
210 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(SHR-PMAS(25,1)).GT.PARP(48)*PMAS(25,2)) 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 230 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 230
|
|
DO 220 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 220
|
|
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
|
|
220 CONTINUE
|
|
230 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(SHR-PMAS(25,1)).GT.PARP(48)*PMAS(25,2)) 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 250 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 250
|
|
EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1)
|
|
DO 240 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 240
|
|
EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1)
|
|
IF(EI*EJ.GT.0D0) GOTO 240
|
|
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
|
|
240 CONTINUE
|
|
250 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 270 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 270
|
|
IA=IABS(I)
|
|
DO 260 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 260
|
|
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
|
|
260 CONTINUE
|
|
270 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 290 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 290
|
|
DO 280 J=MMIN2,MMAX2
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 280
|
|
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
|
|
280 CONTINUE
|
|
290 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 300 I=1,2
|
|
FACCIB=FACCIB+COMFAC*(UH2/PARU(155)**4)*(WDTE(I,1)+
|
|
& WDTE(I,2)+WDTE(I,4))
|
|
300 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 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
|
|
IF(MSTP(5).LE.0.OR.(MSTP(5).EQ.1.AND.IABS(I).GE.3)) THEN
|
|
SIGH(NCHN)=FACQQB
|
|
ELSE
|
|
SIGH(NCHN)=FACCIB
|
|
ENDIF
|
|
310 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 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
|
|
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
|
|
320 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 330 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
|
|
& KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 330
|
|
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
|
|
330 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 couplings to final fermion pairs
|
|
HFGG=0D0
|
|
HFGZ=0D0
|
|
HFZZ=0D0
|
|
RADC4=1D0+PYALPS(SQM4)/PARU(1)
|
|
DO 340 I=1,MIN(16,MDCY(23,3))
|
|
IDC=I+MDCY(23,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 340
|
|
IMDM=0
|
|
IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
|
|
& IMDM=1
|
|
IF(I.LE.8) THEN
|
|
EF=KCHG(I,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ELSEIF(I.LE.16) THEN
|
|
EF=KCHG(I+2,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ENDIF
|
|
RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
|
|
IF(4D0*RM1.LT.1D0) THEN
|
|
FCOF=1D0
|
|
IF(I.LE.8) FCOF=3D0*RADC4
|
|
BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
|
|
IF(IMDM.EQ.1) THEN
|
|
HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34
|
|
HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
|
|
HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+
|
|
& AF**2*(1D0-4D0*RM1))*BE34
|
|
ENDIF
|
|
ENDIF
|
|
340 CONTINUE
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
|
|
MINT(15)=1
|
|
MINT(61)=1
|
|
CALL PYWIDT(23,SQM4,WDTP,WDTE)
|
|
HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
|
|
HFGG=HFGG*HFAEM*VINT(111)/SQM4
|
|
HFGZ=HFGZ*HFAEM*VINT(112)/SQM4
|
|
HFZZ=HFZZ*HFAEM*VINT(114)/SQM4
|
|
C...Loop over flavours; consider full gamma/Z structure
|
|
DO 350 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
|
|
& KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 350
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACZG*(EI**2*HFGG+EI*VI*HFGZ+
|
|
& (VI**2+AI**2)*HFZZ)/HBW4
|
|
350 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.16) THEN
|
|
C...f + fbar' -> g + W+/- (q + qbar' -> g + W+/- only)
|
|
FACWG=COMFAC*AS*AEM/XW*2D0/9D0*(TH2+UH2+2D0*SQM4*SH)/(TH*UH)
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
|
|
CALL PYWIDT(24,SQM4,WDTP,WDTE)
|
|
GMMWC=SQRT(SQM4)*WDTP(0)
|
|
HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
|
|
FACWG=FACWG*HBW4C/HBW4
|
|
DO 370 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 370
|
|
DO 360 J=MMIN2,MMAX2
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 360
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 360
|
|
KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
|
|
WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
|
|
FCKM=VCKM((IA+1)/2,(JA+1)/2)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACWG*FCKM*WIDSC
|
|
360 CONTINUE
|
|
370 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.17) THEN
|
|
C...f + fbar -> g + h0 (q + qbar -> g + h0 only)
|
|
|
|
ELSEIF(ISUB.EQ.18) THEN
|
|
C...f + fbar -> gamma + gamma
|
|
FACGG=COMFAC*AEM**2*2D0*(TH2+UH2)/(TH*UH)
|
|
DO 380 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
FCOI=1D0
|
|
IF(IABS(I).LE.10) FCOI=FACA/3D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=0.5D0*FACGG*FCOI*EI**4
|
|
380 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.19) THEN
|
|
C...f + fbar -> gamma + (gamma*/Z0)
|
|
FACGZ=COMFAC*2D0*AEM**2*(TH2+UH2+2D0*SQM4*SH)/(TH*UH)
|
|
C...gamma, gamma/Z interference and Z couplings to final fermion pairs
|
|
HFGG=0D0
|
|
HFGZ=0D0
|
|
HFZZ=0D0
|
|
RADC4=1D0+PYALPS(SQM4)/PARU(1)
|
|
DO 390 I=1,MIN(16,MDCY(23,3))
|
|
IDC=I+MDCY(23,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 390
|
|
IMDM=0
|
|
IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
|
|
& IMDM=1
|
|
IF(I.LE.8) THEN
|
|
EF=KCHG(I,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ELSEIF(I.LE.16) THEN
|
|
EF=KCHG(I+2,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ENDIF
|
|
RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
|
|
IF(4D0*RM1.LT.1D0) THEN
|
|
FCOF=1D0
|
|
IF(I.LE.8) FCOF=3D0*RADC4
|
|
BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
|
|
IF(IMDM.EQ.1) THEN
|
|
HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34
|
|
HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
|
|
HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+
|
|
& AF**2*(1D0-4D0*RM1))*BE34
|
|
ENDIF
|
|
ENDIF
|
|
390 CONTINUE
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
|
|
MINT(15)=1
|
|
MINT(61)=1
|
|
CALL PYWIDT(23,SQM4,WDTP,WDTE)
|
|
HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
|
|
HFGG=HFGG*HFAEM*VINT(111)/SQM4
|
|
HFGZ=HFGZ*HFAEM*VINT(112)/SQM4
|
|
HFZZ=HFZZ*HFAEM*VINT(114)/SQM4
|
|
C...Loop over flavours; consider full gamma/Z structure
|
|
DO 400 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
FCOI=1D0
|
|
IF(IABS(I).LE.10) FCOI=FACA/3D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACGZ*FCOI*EI**2*(EI**2*HFGG+EI*VI*HFGZ+
|
|
& (VI**2+AI**2)*HFZZ)/HBW4
|
|
400 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.20) THEN
|
|
C...f + fbar' -> gamma + W+/-
|
|
FACGW=COMFAC*0.5D0*AEM**2/XW
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
|
|
CALL PYWIDT(24,SQM4,WDTP,WDTE)
|
|
GMMWC=SQRT(SQM4)*WDTP(0)
|
|
HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
|
|
FACGW=FACGW*HBW4C/HBW4
|
|
C...Anomalous couplings
|
|
TERM1=(TH2+UH2+2D0*SQM4*SH)/(TH*UH)
|
|
TERM2=0D0
|
|
TERM3=0D0
|
|
IF(MSTP(5).GE.1) THEN
|
|
TERM2=PARU(153)*(TH-UH)/(TH+UH)
|
|
TERM3=0.5D0*PARU(153)**2*(TH*UH+(TH2+UH2)*SH/
|
|
& (4D0*SQMW))/(TH+UH)**2
|
|
ENDIF
|
|
DO 420 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 420
|
|
DO 410 J=MMIN2,MMAX2
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 410
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 410
|
|
IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
|
|
& GOTO 410
|
|
KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
|
|
WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
|
|
IF(IA.LE.10) THEN
|
|
FACWR=UH/(TH+UH)-1D0/3D0
|
|
FCKM=VCKM((IA+1)/2,(JA+1)/2)
|
|
FCOI=FACA/3D0
|
|
ELSE
|
|
FACWR=-TH/(TH+UH)
|
|
FCKM=1D0
|
|
FCOI=1D0
|
|
ENDIF
|
|
FACWK=TERM1*FACWR**2+TERM2*FACWR+TERM3
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACGW*FACWK*FCOI*FCKM*WIDSC
|
|
410 CONTINUE
|
|
420 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.30) THEN
|
|
IF(ISUB.EQ.21) THEN
|
|
C...f + fbar -> gamma + h0
|
|
|
|
ELSEIF(ISUB.EQ.22) THEN
|
|
C...f + fbar -> (gamma*/Z0) + (gamma*/Z0)
|
|
C...Kinematics dependence
|
|
FACZZ=COMFAC*AEM**2*((TH2+UH2+2D0*(SQM3+SQM4)*SH)/(TH*UH)-
|
|
& SQM3*SQM4*(1D0/TH2+1D0/UH2))
|
|
C...gamma, gamma/Z interference and Z couplings to final fermion pairs
|
|
DO 440 I=1,6
|
|
DO 430 J=1,3
|
|
HGZ(I,J)=0D0
|
|
430 CONTINUE
|
|
440 CONTINUE
|
|
RADC3=1D0+PYALPS(SQM3)/PARU(1)
|
|
RADC4=1D0+PYALPS(SQM4)/PARU(1)
|
|
DO 450 I=1,MIN(16,MDCY(23,3))
|
|
IDC=I+MDCY(23,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 450
|
|
IMDM=0
|
|
IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2) IMDM=1
|
|
IF(MDME(IDC,1).EQ.4.OR.MDME(IDC,1).EQ.5) IMDM=MDME(IDC,1)-2
|
|
IF(I.LE.8) THEN
|
|
EF=KCHG(I,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ELSEIF(I.LE.16) THEN
|
|
EF=KCHG(I+2,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ENDIF
|
|
RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM3
|
|
IF(4D0*RM1.LT.1D0) THEN
|
|
FCOF=1D0
|
|
IF(I.LE.8) FCOF=3D0*RADC3
|
|
BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
|
|
IF(IMDM.GE.1) THEN
|
|
HGZ(1,IMDM)=HGZ(1,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34
|
|
HGZ(2,IMDM)=HGZ(2,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
|
|
HGZ(3,IMDM)=HGZ(3,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+
|
|
& AF**2*(1D0-4D0*RM1))*BE34
|
|
ENDIF
|
|
ENDIF
|
|
RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
|
|
IF(4D0*RM1.LT.1D0) THEN
|
|
FCOF=1D0
|
|
IF(I.LE.8) FCOF=3D0*RADC4
|
|
BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
|
|
IF(IMDM.GE.1) THEN
|
|
HGZ(4,IMDM)=HGZ(4,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34
|
|
HGZ(5,IMDM)=HGZ(5,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
|
|
HGZ(6,IMDM)=HGZ(6,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+
|
|
& AF**2*(1D0-4D0*RM1))*BE34
|
|
ENDIF
|
|
ENDIF
|
|
450 CONTINUE
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
HBW3=(1D0/PARU(1))*GMMZ/((SQM3-SQMZ)**2+GMMZ**2)
|
|
HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
|
|
MINT(15)=1
|
|
MINT(61)=1
|
|
CALL PYWIDT(23,SQM3,WDTP,WDTE)
|
|
HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
|
|
DO 460 J=1,3
|
|
HGZ(1,J)=HGZ(1,J)*HFAEM*VINT(111)/SQM3
|
|
HGZ(2,J)=HGZ(2,J)*HFAEM*VINT(112)/SQM3
|
|
HGZ(3,J)=HGZ(3,J)*HFAEM*VINT(114)/SQM3
|
|
460 CONTINUE
|
|
MINT(61)=1
|
|
CALL PYWIDT(23,SQM4,WDTP,WDTE)
|
|
HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
|
|
DO 470 J=1,3
|
|
HGZ(4,J)=HGZ(4,J)*HFAEM*VINT(111)/SQM4
|
|
HGZ(5,J)=HGZ(5,J)*HFAEM*VINT(112)/SQM4
|
|
HGZ(6,J)=HGZ(6,J)*HFAEM*VINT(114)/SQM4
|
|
470 CONTINUE
|
|
C...Loop over flavours; separate left- and right-handed couplings
|
|
DO 490 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 490
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
VALI=VI-AI
|
|
VARI=VI+AI
|
|
FCOI=1D0
|
|
IF(IABS(I).LE.10) FCOI=FACA/3D0
|
|
DO 480 J=1,3
|
|
HL3(J)=EI**2*HGZ(1,J)+EI*VALI*HGZ(2,J)+VALI**2*HGZ(3,J)
|
|
HR3(J)=EI**2*HGZ(1,J)+EI*VARI*HGZ(2,J)+VARI**2*HGZ(3,J)
|
|
HL4(J)=EI**2*HGZ(4,J)+EI*VALI*HGZ(5,J)+VALI**2*HGZ(6,J)
|
|
HR4(J)=EI**2*HGZ(4,J)+EI*VARI*HGZ(5,J)+VARI**2*HGZ(6,J)
|
|
480 CONTINUE
|
|
FACLR=HL3(1)*HL4(1)+HL3(1)*(HL4(2)+HL4(3))+
|
|
& HL4(1)*(HL3(2)+HL3(3))+HL3(2)*HL4(3)+HL4(2)*HL3(3)+
|
|
& HR3(1)*HR4(1)+HR3(1)*(HR4(2)+HR4(3))+
|
|
& HR4(1)*(HR3(2)+HR3(3))+HR3(2)*HR4(3)+HR4(2)*HR3(3)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=0.5D0*FACZZ*FCOI*FACLR/(HBW3*HBW4)
|
|
490 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.23) THEN
|
|
C...f + fbar' -> Z0 + W+/-
|
|
FACZW=COMFAC*0.5D0*(AEM/XW)**2
|
|
FACZW=FACZW*WIDS(23,2)
|
|
THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
|
|
FACBW=1D0/((SH-SQMW)**2+GMMW**2)
|
|
DO 510 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 510
|
|
DO 500 J=MMIN2,MMAX2
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 500
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 500
|
|
IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
|
|
& GOTO 500
|
|
KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
|
|
EI=KCHG(IA,1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
EJ=KCHG(JA,1)/3D0
|
|
AJ=SIGN(1D0,EJ+0.1D0)
|
|
VJ=AJ-4D0*EJ*XWV
|
|
IF(VI+AI.GT.0) THEN
|
|
VISAV=VI
|
|
AISAV=AI
|
|
VI=VJ
|
|
AI=AJ
|
|
VJ=VISAV
|
|
AJ=AISAV
|
|
ENDIF
|
|
FCKM=1D0
|
|
IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
|
|
FCOI=1D0
|
|
IF(IA.LE.10) FCOI=FACA/3D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACZW*FCOI*FCKM*(FACBW*((9D0-8D0*XW)/4D0*THUH+
|
|
& (8D0*XW-6D0)/4D0*SH*(SQM3+SQM4))+(THUH-SH*(SQM3+SQM4))*
|
|
& (SH-SQMW)*FACBW*0.5D0*((VJ+AJ)/TH-(VI+AI)/UH)+
|
|
& THUH/(16D0*XW1)*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+
|
|
& SH*(SQM3+SQM4)/(8D0*XW1)*(VI+AI)*(VJ+AJ)/(TH*UH))*
|
|
& WIDS(24,(5-KCHW)/2)
|
|
500 CONTINUE
|
|
510 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.24) THEN
|
|
C...f + fbar -> Z0 + h0 (or H0, or A0)
|
|
THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
|
|
FACHZ=COMFAC*8D0*(AEM*XWC)**2*
|
|
& (THUH+2D0*SH*SQM3)/((SH-SQMZ)**2+GMMZ**2)
|
|
FACHZ=FACHZ*WIDS(23,2)*WIDS(KFHIGG,2)
|
|
IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHZ=FACHZ*
|
|
& PARU(154+10*IHIGG)**2
|
|
DO 520 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 520
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
FCOI=1D0
|
|
IF(IABS(I).LE.10) FCOI=FACA/3D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACHZ*FCOI*(VI**2+AI**2)
|
|
520 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.25) THEN
|
|
C...f + fbar -> W+ + W-
|
|
C...Propagators: Z0, W+- as simulated in PYOFSH and as desired
|
|
CALL PYWIDT(23,SH,WDTP,WDTE)
|
|
GMMZC=SHR*WDTP(0)
|
|
HBWZC=SH**2/((SH-SQMZ)**2+GMMZC**2)
|
|
HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2)
|
|
CALL PYWIDT(24,SQM3,WDTP,WDTE)
|
|
GMMW3=SQRT(SQM3)*WDTP(0)
|
|
HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2)
|
|
HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
|
|
CALL PYWIDT(24,SQM4,WDTP,WDTE)
|
|
GMMW4=SQRT(SQM4)*WDTP(0)
|
|
HBW4C=GMMW4/((SQM4-SQMW)**2+GMMW4**2)
|
|
C...Kinematical functions
|
|
THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
|
|
THUH34=(2D0*SH*(SQM3+SQM4)+THUH)/(SQM3*SQM4)
|
|
GS=(((SH-SQM3-SQM4)**2-4D0*SQM3*SQM4)*THUH34+12D0*THUH)/SH2
|
|
GT=THUH34+4D0*THUH/TH2
|
|
GST=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/TH)/SH
|
|
GU=THUH34+4D0*THUH/UH2
|
|
GSU=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/UH)/SH
|
|
C...Common factors and couplings
|
|
FACWW=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)
|
|
FACWW=FACWW*WIDS(24,1)
|
|
CGG=AEM**2/2D0
|
|
CGZ=AEM**2/(4D0*XW)*HBWZC*(1D0-SQMZ/SH)
|
|
CZZ=AEM**2/(32D0*XW**2)*HBWZC
|
|
CNG=AEM**2/(4D0*XW)
|
|
CNZ=AEM**2/(16D0*XW**2)*HBWZC*(1D0-SQMZ/SH)
|
|
CNN=AEM**2/(16D0*XW**2)
|
|
C...Coulomb factor for W+W- pair
|
|
IF(MSTP(40).GE.1.AND.MSTP(40).LE.3) THEN
|
|
COULE=(SH-4D0*SQMW)/(4D0*PMAS(24,1))
|
|
COULP=MAX(1D-10,0.5D0*BE34*SQRT(SH))
|
|
IF(COULE.LT.100D0*PMAS(24,2)) THEN
|
|
COULP1=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+
|
|
& PMAS(24,2)**2)-COULE))
|
|
ELSE
|
|
COULP1=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/COULE))
|
|
ENDIF
|
|
IF(COULE.GT.-100D0*PMAS(24,2)) THEN
|
|
COULP2=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+
|
|
& PMAS(24,2)**2)+COULE))
|
|
ELSE
|
|
COULP2=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/
|
|
& ABS(COULE)))
|
|
ENDIF
|
|
IF(MSTP(40).EQ.1) THEN
|
|
COULDC=PARU(1)-2D0*ATAN((COULP1**2+COULP2**2-COULP**2)/
|
|
& MAX(1D-10,2D0*COULP*COULP1))
|
|
FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34)
|
|
ELSEIF(MSTP(40).EQ.2) THEN
|
|
COULCK=CMPLX(SNGL(COULP1),SNGL(COULP2))
|
|
COULCP=CMPLX(0.,SNGL(COULP))
|
|
COULCD=(COULCK+COULCP)/(COULCK-COULCP)
|
|
COULCR=1.+SNGL(PARU(101)*SQRT(SH))/(4.*COULCP)*LOG(COULCD)
|
|
COULCS=CMPLX(0.,0.)
|
|
NSTP=100
|
|
DO 530 ISTP=1,NSTP
|
|
COULXX=(ISTP-0.5)/NSTP
|
|
COULCS=COULCS+(1./COULXX)*LOG((1.+COULXX*COULCD)/
|
|
& (1.+COULXX/COULCD))
|
|
530 CONTINUE
|
|
COULCR=COULCR+SNGL(PARU(101)**2*SH)/(16.*COULCP*COULCK)*
|
|
& (COULCS/NSTP)
|
|
FACCOU=ABS(COULCR)**2
|
|
ELSEIF(MSTP(40).EQ.3) THEN
|
|
COULDC=PARU(1)-2D0*(1D0-BE34)**2*ATAN((COULP1**2+
|
|
& COULP2**2-COULP**2)/MAX(1D-10,2D0*COULP*COULP1))
|
|
FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34)
|
|
ENDIF
|
|
ELSEIF(MSTP(40).EQ.4) THEN
|
|
FACCOU=1D0+0.5D0*PARU(101)*PARU(1)/MAX(1D-5,BE34)
|
|
ELSE
|
|
FACCOU=1D0
|
|
ENDIF
|
|
VINT(95)=FACCOU
|
|
FACWW=FACWW*FACCOU
|
|
C...Loop over allowed flavours
|
|
DO 540 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 540
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
FCOI=1D0
|
|
IF(IABS(I).LE.10) FCOI=FACA/3D0
|
|
IF(AI.LT.0D0) THEN
|
|
DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS+
|
|
& (CNG*EI+CNZ*(VI+AI))*GST+CNN*GT
|
|
ELSE
|
|
DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS-
|
|
& (CNG*EI+CNZ*(VI+AI))*GSU+CNN*GU
|
|
ENDIF
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACWW*FCOI*DSIGWW
|
|
540 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.26) THEN
|
|
C...f + fbar' -> W+/- + h0 (or H0, or A0)
|
|
THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
|
|
FACHW=COMFAC*0.125D0*(AEM/XW)**2*(THUH+2D0*SH*SQM3)/
|
|
& ((SH-SQMW)**2+GMMW**2)
|
|
FACHW=FACHW*WIDS(KFHIGG,2)
|
|
IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHW=FACHW*
|
|
& PARU(155+10*IHIGG)**2
|
|
DO 560 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 560
|
|
DO 550 J=MMIN2,MMAX2
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(1,J).EQ.0) GOTO 550
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 550
|
|
IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
|
|
& GOTO 550
|
|
KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
|
|
FCKM=1D0
|
|
IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
|
|
FCOI=1D0
|
|
IF(IA.LE.10) FCOI=FACA/3D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACHW*FCOI*FCKM*WIDS(24,(5-KCHW)/2)
|
|
550 CONTINUE
|
|
560 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.27) THEN
|
|
C...f + fbar -> h0 + h0
|
|
|
|
ELSEIF(ISUB.EQ.28) THEN
|
|
C...f + g -> f + g (q + g -> q + g only)
|
|
FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2-
|
|
& UH/SH)*FACA
|
|
FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2-
|
|
& SH/UH)
|
|
DO 580 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 580
|
|
DO 570 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 570
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 570
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQG1
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQG2
|
|
570 CONTINUE
|
|
580 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.29) THEN
|
|
C...f + g -> f + gamma (q + g -> q + gamma only)
|
|
FGQ=COMFAC*FACA*AS*AEM*1D0/3D0*(SH2+UH2)/(-SH*UH)
|
|
DO 600 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 600
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
FACGQ=FGQ*EI**2
|
|
DO 590 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 590
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 590
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACGQ
|
|
590 CONTINUE
|
|
600 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.30) THEN
|
|
C...f + g -> f + (gamma*/Z0) (q + g -> q + (gamma*/Z0) only)
|
|
FZQ=COMFAC*FACA*AS*AEM*(1D0/3D0)*(SH2+UH2+2D0*SQM4*TH)/
|
|
& (-SH*UH)
|
|
C...gamma, gamma/Z interference and Z couplings to final fermion pairs
|
|
HFGG=0D0
|
|
HFGZ=0D0
|
|
HFZZ=0D0
|
|
RADC4=1D0+PYALPS(SQM4)/PARU(1)
|
|
DO 610 I=1,MIN(16,MDCY(23,3))
|
|
IDC=I+MDCY(23,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 610
|
|
IMDM=0
|
|
IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
|
|
& IMDM=1
|
|
IF(I.LE.8) THEN
|
|
EF=KCHG(I,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ELSEIF(I.LE.16) THEN
|
|
EF=KCHG(I+2,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ENDIF
|
|
RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
|
|
IF(4D0*RM1.LT.1D0) THEN
|
|
FCOF=1D0
|
|
IF(I.LE.8) FCOF=3D0*RADC4
|
|
BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
|
|
IF(IMDM.EQ.1) THEN
|
|
HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34
|
|
HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
|
|
HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+
|
|
& AF**2*(1D0-4D0*RM1))*BE34
|
|
ENDIF
|
|
ENDIF
|
|
610 CONTINUE
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
|
|
MINT(15)=1
|
|
MINT(61)=1
|
|
CALL PYWIDT(23,SQM4,WDTP,WDTE)
|
|
HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
|
|
HFGG=HFGG*HFAEM*VINT(111)/SQM4
|
|
HFGZ=HFGZ*HFAEM*VINT(112)/SQM4
|
|
HFZZ=HFZZ*HFAEM*VINT(114)/SQM4
|
|
C...Loop over flavours; consider full gamma/Z structure
|
|
DO 630 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 630
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
FACZQ=FZQ*(EI**2*HFGG+EI*VI*HFGZ+
|
|
& (VI**2+AI**2)*HFZZ)/HBW4
|
|
DO 620 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 620
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 620
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACZQ
|
|
620 CONTINUE
|
|
630 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.40) THEN
|
|
IF(ISUB.EQ.31) THEN
|
|
C...f + g -> f' + W+/- (q + g -> q' + W+/- only)
|
|
FACWQ=COMFAC*FACA*AS*AEM/XW*1D0/12D0*
|
|
& (SH2+UH2+2D0*SQM4*TH)/(-SH*UH)
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
|
|
CALL PYWIDT(24,SQM4,WDTP,WDTE)
|
|
GMMWC=SQRT(SQM4)*WDTP(0)
|
|
HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
|
|
FACWQ=FACWQ*HBW4C/HBW4
|
|
DO 650 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 650
|
|
IA=IABS(I)
|
|
KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
|
|
WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
|
|
DO 640 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 640
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 640
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC
|
|
640 CONTINUE
|
|
650 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.32) THEN
|
|
C...f + g -> f + h0 (q + g -> q + h0 only)
|
|
|
|
ELSEIF(ISUB.EQ.33) THEN
|
|
C...f + gamma -> f + g (q + gamma -> q + g only)
|
|
FGQ=COMFAC*AS*AEM*8D0/3D0*(SH2+UH2)/(-SH*UH)
|
|
DO 670 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 670
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
FACGQ=FGQ*EI**2
|
|
DO 660 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 660
|
|
IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 660
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACGQ
|
|
660 CONTINUE
|
|
670 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.34) THEN
|
|
C...f + gamma -> f + gamma
|
|
FGQ=COMFAC*AEM**2*2D0*(SH2+UH2)/(-SH*UH)
|
|
DO 690 I=MMINA,MMAXA
|
|
IF(I.EQ.0) GOTO 690
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
FACGQ=FGQ*EI**4
|
|
DO 680 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 680
|
|
IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 680
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACGQ
|
|
680 CONTINUE
|
|
690 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.35) THEN
|
|
C...f + gamma -> f + (gamma*/Z0)
|
|
FZQN=COMFAC*2D0*AEM**2*(SH2+UH2+2D0*SQM4*TH)
|
|
FZQD=SQPTH*SQM4-SH*UH
|
|
C...gamma, gamma/Z interference and Z couplings to final fermion pairs
|
|
HFGG=0D0
|
|
HFGZ=0D0
|
|
HFZZ=0D0
|
|
RADC4=1D0+PYALPS(SQM4)/PARU(1)
|
|
DO 700 I=1,MIN(16,MDCY(23,3))
|
|
IDC=I+MDCY(23,2)-1
|
|
IF(MDME(IDC,1).LT.0) GOTO 700
|
|
IMDM=0
|
|
IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4)
|
|
& IMDM=1
|
|
IF(I.LE.8) THEN
|
|
EF=KCHG(I,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ELSEIF(I.LE.16) THEN
|
|
EF=KCHG(I+2,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
ENDIF
|
|
RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4
|
|
IF(4D0*RM1.LT.1D0) THEN
|
|
FCOF=1D0
|
|
IF(I.LE.8) FCOF=3D0*RADC4
|
|
BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
|
|
IF(IMDM.EQ.1) THEN
|
|
HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34
|
|
HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34
|
|
HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+
|
|
& AF**2*(1D0-4D0*RM1))*BE34
|
|
ENDIF
|
|
ENDIF
|
|
700 CONTINUE
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2)
|
|
MINT(15)=1
|
|
MINT(61)=1
|
|
CALL PYWIDT(23,SQM4,WDTP,WDTE)
|
|
HFAEM=(PARU(108)/PARU(2))*(2D0/3D0)
|
|
HFGG=HFGG*HFAEM*VINT(111)/SQM4
|
|
HFGZ=HFGZ*HFAEM*VINT(112)/SQM4
|
|
HFZZ=HFZZ*HFAEM*VINT(114)/SQM4
|
|
C...Loop over flavours; consider full gamma/Z structure
|
|
DO 720 I=MMINA,MMAXA
|
|
IF(I.EQ.0) GOTO 720
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
FACZQ=EI**2*(EI**2*HFGG+EI*VI*HFGZ+
|
|
& (VI**2+AI**2)*HFZZ)/HBW4
|
|
DO 710 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 710
|
|
IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 710
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACZQ*FZQN/MAX(PMAS(IABS(I),1)**2*SQM4,FZQD)
|
|
710 CONTINUE
|
|
720 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.36) THEN
|
|
C...f + gamma -> f' + W+/-
|
|
FWQ=COMFAC*AEM**2/(2D0*XW)*
|
|
& (SH2+UH2+2D0*SQM4*TH)/(SQPTH*SQM4-SH*UH)
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2)
|
|
CALL PYWIDT(24,SQM4,WDTP,WDTE)
|
|
GMMWC=SQRT(SQM4)*WDTP(0)
|
|
HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2)
|
|
FWQ=FWQ*HBW4C/HBW4
|
|
DO 740 I=MMINA,MMAXA
|
|
IF(I.EQ.0) GOTO 740
|
|
IA=IABS(I)
|
|
EIA=ABS(KCHG(IABS(I),1)/3D0)
|
|
FACWQ=FWQ*(EIA-SH/(SH+UH))**2
|
|
KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
|
|
WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0)
|
|
DO 730 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 730
|
|
IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 730
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC
|
|
730 CONTINUE
|
|
740 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.37) THEN
|
|
C...f + gamma -> f + h0
|
|
|
|
ELSEIF(ISUB.EQ.38) THEN
|
|
C...f + Z0 -> f + g (q + Z0 -> q + g only)
|
|
|
|
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 (q + W+/- -> q' + g only)
|
|
|
|
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 (q + h0 -> q + g only)
|
|
|
|
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 (g + g -> q + qbar only)
|
|
CALL PYWIDT(21,SH,WDTP,WDTE)
|
|
FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)*
|
|
& UH2/SH2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
|
|
FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)*
|
|
& TH2/SH2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 750
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQQ2
|
|
750 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.54) THEN
|
|
C...g + gamma -> f + fbar (g + gamma -> q + qbar only)
|
|
CALL PYWIDT(21,SH,WDTP,WDTE)
|
|
WDTESU=0D0
|
|
DO 760 I=1,MIN(8,MDCY(21,3))
|
|
EF=KCHG(I,1)/3D0
|
|
WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+
|
|
& WDTE(I,4))
|
|
760 CONTINUE
|
|
FACQQ=COMFAC*AEM*AS*WDTESU*(TH2+UH2)/(TH*UH)
|
|
IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ
|
|
ENDIF
|
|
IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=22
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.55) THEN
|
|
C...g + Z -> f + fbar (g + Z -> q + qbar only)
|
|
|
|
ELSEIF(ISUB.EQ.56) THEN
|
|
C...g + W -> f + f'bar (g + W -> q + q'bar only)
|
|
|
|
ELSEIF(ISUB.EQ.57) THEN
|
|
C...g + h0 -> f + fbar (g + h0 -> q + qbar only)
|
|
|
|
ELSEIF(ISUB.EQ.58) THEN
|
|
C...gamma + gamma -> f + fbar
|
|
CALL PYWIDT(22,SH,WDTP,WDTE)
|
|
WDTESU=0D0
|
|
DO 770 I=1,MIN(12,MDCY(22,3))
|
|
IF(I.LE.8) EF= KCHG(I,1)/3D0
|
|
IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3D0
|
|
WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+
|
|
& WDTE(I,4))
|
|
770 CONTINUE
|
|
FACFF=COMFAC*AEM**2*WDTESU*2D0*(TH2+UH2)/(TH*UH)
|
|
IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=22
|
|
ISIG(NCHN,2)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACFF
|
|
ENDIF
|
|
|
|
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
|
|
FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+2D0*TH/SH+
|
|
& TH2/SH2)*FACA
|
|
FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+2D0*SH/UH+
|
|
& SH2/UH2)*FACA
|
|
FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3D0+2D0*UH/TH+
|
|
& UH2/TH2)
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 780
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=0.5D0*FACGG1
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=0.5D0*FACGG2
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=3
|
|
SIGH(NCHN)=0.5D0*FACGG3
|
|
780 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.69) THEN
|
|
C...gamma + gamma -> W+ + W-
|
|
SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4))
|
|
FPROP=SH2/((SQMWE-TH)*(SQMWE-UH))
|
|
FACWW=COMFAC*6D0*AEM**2*(1D0-FPROP*(4D0/3D0+2D0*SQMWE/SH)+
|
|
& FPROP**2*(2D0/3D0+2D0*(SQMWE/SH)**2))*WIDS(24,1)
|
|
IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 790
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=22
|
|
ISIG(NCHN,2)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACWW
|
|
790 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.70) THEN
|
|
C...gamma + W+/- -> Z0 + W+/-
|
|
SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4))
|
|
FPROP=(TH-SQMWE)**2/(-SH*(SQMWE-UH))
|
|
FACZW=COMFAC*6D0*AEM**2*(XW1/XW)*
|
|
& (1D0-FPROP*(4D0/3D0+2D0*SQMWE/(TH-SQMWE))+
|
|
& FPROP**2*(2D0/3D0+2D0*(SQMWE/(TH-SQMWE))**2))*WIDS(23,2)
|
|
DO 810 KCHW=1,-1,-2
|
|
DO 800 ISDE=1,2
|
|
IF(KFAC(ISDE,22)*KFAC(3-ISDE,24*KCHW).EQ.0) GOTO 800
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=22
|
|
ISIG(NCHN,3-ISDE)=24*KCHW
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACZW*WIDS(24,(5-KCHW)/2)
|
|
800 CONTINUE
|
|
810 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.80) THEN
|
|
IF(ISUB.EQ.71) THEN
|
|
C...Z0 + Z0 -> Z0 + Z0
|
|
IF(SH.LE.4.01D0*SQMZ) GOTO 840
|
|
|
|
IF(MSTP(46).LE.2) THEN
|
|
C...Exact scattering ME:s for on-mass-shell gauge bosons
|
|
BE2=1D0-4D0*SQMZ/SH
|
|
TH=-0.5D0*SH*BE2*(1D0-CTH)
|
|
UH=-0.5D0*SH*BE2*(1D0+CTH)
|
|
IF(MAX(TH,UH).GT.-1D0) GOTO 840
|
|
SHANG=1D0/XW1*SQMW/SQMZ*(1D0+BE2)**2
|
|
ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
|
|
ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
|
|
THANG=1D0/XW1*SQMW/SQMZ*(BE2-CTH)**2
|
|
ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
|
|
ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
|
|
UHANG=1D0/XW1*SQMW/SQMZ*(BE2+CTH)**2
|
|
AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG
|
|
AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG
|
|
FACZZ=COMFAC*1D0/(4096D0*PARU(1)**2*16D0*XW1**2)*
|
|
& (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2
|
|
IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2)
|
|
IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATHRE+AUHRE)**2+
|
|
& (ASHIM+ATHIM+AUHIM)**2)
|
|
IF(MSTP(46).EQ.2) FACZZ=0D0
|
|
|
|
ELSE
|
|
C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron
|
|
FACZZ=COMFAC*(AEM/(16D0*PARU(1)*XW*XW1))**2*(64D0/9D0)*
|
|
& ABS(A00U+2.*A20U)**2
|
|
ENDIF
|
|
FACZZ=FACZZ*WIDS(23,1)
|
|
|
|
DO 830 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 830
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
AVI=AI**2+VI**2
|
|
DO 820 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 820
|
|
EJ=KCHG(IABS(J),1)/3D0
|
|
AJ=SIGN(1D0,EJ)
|
|
VJ=AJ-4D0*EJ*XWV
|
|
AVJ=AJ**2+VJ**2
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=0.5D0*FACZZ*AVI*AVJ
|
|
820 CONTINUE
|
|
830 CONTINUE
|
|
840 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.72) THEN
|
|
C...Z0 + Z0 -> W+ + W-
|
|
IF(SH.LE.4.01D0*SQMZ) GOTO 870
|
|
|
|
IF(MSTP(46).LE.2) THEN
|
|
C...Exact scattering ME:s for on-mass-shell gauge bosons
|
|
BE2=SQRT((1D0-4D0*SQMW/SH)*(1D0-4D0*SQMZ/SH))
|
|
CTH2=CTH**2
|
|
TH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH-BE2*CTH)
|
|
UH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH+BE2*CTH)
|
|
IF(MAX(TH,UH).GT.-1D0) GOTO 870
|
|
SHANG=4D0*SQRT(SQMW/(SQMZ*XW1))*(1D0-2D0*SQMW/SH)*
|
|
& (1D0-2D0*SQMZ/SH)
|
|
ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
|
|
ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
|
|
ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3D0/2D0+BE2/2D0*
|
|
& CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0*
|
|
& ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2*
|
|
& (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2+
|
|
& 2D0*(SQMW+SQMZ)/SH*BE2*CTH))
|
|
ATWIM=0D0
|
|
AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3D0/2D0-BE2/2D0*
|
|
& CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0*
|
|
& ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2*
|
|
& (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2-
|
|
& 2D0*(SQMW+SQMZ)/SH*BE2*CTH))
|
|
AUWIM=0D0
|
|
A4RE=2D0*XW1/SQMZ*(3D0-CTH2-4D0*(SQMW+SQMZ)/SH)
|
|
A4IM=0D0
|
|
FACWW=COMFAC*1D0/(4096D0*PARU(1)**2*16D0*XW1**2)*
|
|
& (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2
|
|
IF(MSTP(46).LE.0) FACWW=FACWW*(ASHRE**2+ASHIM**2)
|
|
IF(MSTP(46).EQ.1) FACWW=FACWW*((ASHRE+ATWRE+AUWRE+A4RE)**2+
|
|
& (ASHIM+ATWIM+AUWIM+A4IM)**2)
|
|
IF(MSTP(46).EQ.2) FACWW=FACWW*((ATWRE+AUWRE+A4RE)**2+
|
|
& (ATWIM+AUWIM+A4IM)**2)
|
|
|
|
ELSE
|
|
C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron
|
|
FACWW=COMFAC*(AEM/(16D0*PARU(1)*XW*XW1))**2*(64D0/9D0)*
|
|
& ABS(A00U-A20U)**2
|
|
ENDIF
|
|
FACWW=FACWW*WIDS(24,1)
|
|
|
|
DO 860 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 860
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
AVI=AI**2+VI**2
|
|
DO 850 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 850
|
|
EJ=KCHG(IABS(J),1)/3D0
|
|
AJ=SIGN(1D0,EJ)
|
|
VJ=AJ-4D0*EJ*XWV
|
|
AVJ=AJ**2+VJ**2
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACWW*AVI*AVJ
|
|
850 CONTINUE
|
|
860 CONTINUE
|
|
870 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.73) THEN
|
|
C...Z0 + W+/- -> Z0 + W+/-
|
|
IF(SH.LE.2D0*SQMZ+2D0*SQMW) GOTO 900
|
|
|
|
IF(MSTP(46).LE.2) THEN
|
|
C...Exact scattering ME:s for on-mass-shell gauge bosons
|
|
BE2=1D0-2D0*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2
|
|
EP1=1D0-(SQMZ-SQMW)/SH
|
|
EP2=1D0+(SQMZ-SQMW)/SH
|
|
TH=-0.5D0*SH*BE2*(1D0-CTH)
|
|
UH=(SQMZ-SQMW)**2/SH-0.5D0*SH*BE2*(1D0+CTH)
|
|
IF(MAX(TH,UH).GT.-1D0) GOTO 900
|
|
THANG=(BE2-EP1*CTH)*(BE2-EP2*CTH)
|
|
ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
|
|
ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
|
|
ASWRE=-XW1/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+
|
|
& 1D0/4D0*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4D0*BE2*CTH)+
|
|
& 2D0*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH-
|
|
& 1D0/16D0*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2)
|
|
ASWIM=0D0
|
|
AUWRE=XW1/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)*
|
|
& (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)*
|
|
& (BE2+EP1*EP2*CTH)*(2D0*EP2-EP2*CTH+EP1)-
|
|
& BE2*(EP2+EP1*CTH)**2*(BE2-EP2**2*CTH)-1D0/8D0*
|
|
& (BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2D0*BE2*(1D0-CTH))+
|
|
& 1D0/32D0*SH/SQMW*(BE2+EP1*EP2*CTH)**2*
|
|
& (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)*
|
|
& (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)*
|
|
& (2D0*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2*
|
|
& (BE2-EP1**2*CTH)-1D0/8D0*(BE2+EP1*EP2*CTH)**2*
|
|
& ((EP1+EP2)**2+2D0*BE2*(1D0-CTH))+1D0/32D0*SH/SQMW*
|
|
& (BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2)
|
|
AUWIM=0D0
|
|
A4RE=XW1/SQMZ*(EP1**2*EP2**2*(CTH**2-1D0)-
|
|
& 2D0*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2D0*BE2*EP1*EP2)
|
|
A4IM=0D0
|
|
FACZW=COMFAC*1D0/(4096D0*PARU(1)**2*4D0*XW1)*(AEM/XW)**4*
|
|
& (SH/SQMW)**2*SQRT(SQMZ/SQMW)*SH2
|
|
IF(MSTP(46).LE.0) FACZW=0D0
|
|
IF(MSTP(46).EQ.1) FACZW=FACZW*((ATHRE+ASWRE+AUWRE+A4RE)**2+
|
|
& (ATHIM+ASWIM+AUWIM+A4IM)**2)
|
|
IF(MSTP(46).EQ.2) FACZW=FACZW*((ASWRE+AUWRE+A4RE)**2+
|
|
& (ASWIM+AUWIM+A4IM)**2)
|
|
|
|
ELSE
|
|
C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron
|
|
FACZW=COMFAC*AEM**2/(64D0*PARU(1)**2*XW**2*XW1)*16D0*
|
|
& ABS(A20U+3.*A11U*SNGL(CTH))**2
|
|
ENDIF
|
|
FACZW=FACZW*WIDS(23,2)
|
|
|
|
DO 890 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 890
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
AVI=AI**2+VI**2
|
|
KCHWI=ISIGN(1,KCHG(IABS(I),1)*ISIGN(1,I))
|
|
DO 880 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 880
|
|
EJ=KCHG(IABS(J),1)/3D0
|
|
AJ=SIGN(1D0,EJ)
|
|
VJ=AI-4D0*EJ*XWV
|
|
AVJ=AJ**2+VJ**2
|
|
KCHWJ=ISIGN(1,KCHG(IABS(J),1)*ISIGN(1,J))
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACZW*AVI*VINT(180+J)*WIDS(24,(5-KCHWJ)/2)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACZW*VINT(180+I)*WIDS(24,(5-KCHWI)/2)*AVJ
|
|
880 CONTINUE
|
|
890 CONTINUE
|
|
900 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.75) THEN
|
|
C...W+ + W- -> gamma + gamma
|
|
|
|
ELSEIF(ISUB.EQ.76) THEN
|
|
C...W+ + W- -> Z0 + Z0
|
|
IF(SH.LE.4.01D0*SQMZ) GOTO 930
|
|
|
|
IF(MSTP(46).LE.2) THEN
|
|
C...Exact scattering ME:s for on-mass-shell gauge bosons
|
|
BE2=SQRT((1D0-4D0*SQMW/SH)*(1D0-4D0*SQMZ/SH))
|
|
CTH2=CTH**2
|
|
TH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH-BE2*CTH)
|
|
UH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH+BE2*CTH)
|
|
IF(MAX(TH,UH).GT.-1D0) GOTO 930
|
|
SHANG=4D0*SQRT(SQMW/(SQMZ*XW1))*(1D0-2D0*SQMW/SH)*
|
|
& (1D0-2D0*SQMZ/SH)
|
|
ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
|
|
ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
|
|
ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3D0/2D0+BE2/2D0*
|
|
& CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0*
|
|
& ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2*
|
|
& (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2+
|
|
& 2D0*(SQMW+SQMZ)/SH*BE2*CTH))
|
|
ATWIM=0D0
|
|
AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3D0/2D0-BE2/2D0*
|
|
& CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0*
|
|
& ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2*
|
|
& (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2-
|
|
& 2D0*(SQMW+SQMZ)/SH*BE2*CTH))
|
|
AUWIM=0D0
|
|
A4RE=2D0*XW1/SQMZ*(3D0-CTH2-4D0*(SQMW+SQMZ)/SH)
|
|
A4IM=0D0
|
|
FACZZ=COMFAC*1D0/(4096D0*PARU(1)**2)*(AEM/XW)**4*
|
|
& (SH/SQMW)**2*SH2
|
|
IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2)
|
|
IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATWRE+AUWRE+A4RE)**2+
|
|
& (ASHIM+ATWIM+AUWIM+A4IM)**2)
|
|
IF(MSTP(46).EQ.2) FACZZ=FACZZ*((ATWRE+AUWRE+A4RE)**2+
|
|
& (ATWIM+AUWIM+A4IM)**2)
|
|
|
|
ELSE
|
|
C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron
|
|
FACZZ=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*(64D0/9D0)*
|
|
& ABS(A00U-A20U)**2
|
|
ENDIF
|
|
FACZZ=FACZZ*WIDS(23,1)
|
|
|
|
DO 920 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 920
|
|
EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1)
|
|
DO 910 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 910
|
|
EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1)
|
|
IF(EI*EJ.GT.0D0) GOTO 910
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=0.5D0*FACZZ*VINT(180+I)*VINT(180+J)
|
|
910 CONTINUE
|
|
920 CONTINUE
|
|
930 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.77) THEN
|
|
C...W+/- + W+/- -> W+/- + W+/-
|
|
IF(SH.LE.4.01D0*SQMW) GOTO 960
|
|
|
|
IF(MSTP(46).LE.2) THEN
|
|
C...Exact scattering ME:s for on-mass-shell gauge bosons
|
|
BE2=1D0-4D0*SQMW/SH
|
|
BE4=BE2**2
|
|
CTH2=CTH**2
|
|
CTH3=CTH**3
|
|
TH=-0.5D0*SH*BE2*(1D0-CTH)
|
|
UH=-0.5D0*SH*BE2*(1D0+CTH)
|
|
IF(MAX(TH,UH).GT.-1D0) GOTO 960
|
|
SHANG=(1D0+BE2)**2
|
|
ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
|
|
ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
|
|
THANG=(BE2-CTH)**2
|
|
ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
|
|
ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
|
|
UHANG=(BE2+CTH)**2
|
|
AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG
|
|
AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG
|
|
SGZANG=1D0/SQMW*BE2*(3D0-BE2)**2*CTH
|
|
ASGRE=XW*SGZANG
|
|
ASGIM=0D0
|
|
ASZRE=XW1*SH/(SH-SQMZ)*SGZANG
|
|
ASZIM=0D0
|
|
TGZANG=1D0/SQMW*(BE2*(4D0-2D0*BE2+BE4)+BE2*(4D0-10D0*BE2+
|
|
& BE4)*CTH+(2D0-11D0*BE2+10D0*BE4)*CTH2+BE2*CTH3)
|
|
ATGRE=0.5D0*XW*SH/TH*TGZANG
|
|
ATGIM=0D0
|
|
ATZRE=0.5D0*XW1*SH/(TH-SQMZ)*TGZANG
|
|
ATZIM=0D0
|
|
UGZANG=1D0/SQMW*(BE2*(4D0-2D0*BE2+BE4)-BE2*(4D0-10D0*BE2+
|
|
& BE4)*CTH+(2D0-11D0*BE2+10D0*BE4)*CTH2-BE2*CTH3)
|
|
AUGRE=0.5D0*XW*SH/UH*UGZANG
|
|
AUGIM=0D0
|
|
AUZRE=0.5D0*XW1*SH/(UH-SQMZ)*UGZANG
|
|
AUZIM=0D0
|
|
A4ARE=1D0/SQMW*(1D0+2D0*BE2-6D0*BE2*CTH-CTH2)
|
|
A4AIM=0D0
|
|
A4SRE=2D0/SQMW*(1D0+2D0*BE2-CTH2)
|
|
A4SIM=0D0
|
|
FWW=COMFAC*1D0/(4096D0*PARU(1)**2)*(AEM/XW)**4*
|
|
& (SH/SQMW)**2*SH2
|
|
IF(MSTP(46).LE.0) THEN
|
|
AWWARE=ASHRE
|
|
AWWAIM=ASHIM
|
|
AWWSRE=0D0
|
|
AWWSIM=0D0
|
|
ELSEIF(MSTP(46).EQ.1) THEN
|
|
AWWARE=ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4ARE
|
|
AWWAIM=ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4AIM
|
|
AWWSRE=-ATHRE-AUHRE+ATGRE+ATZRE+AUGRE+AUZRE+A4SRE
|
|
AWWSIM=-ATHIM-AUHIM+ATGIM+ATZIM+AUGIM+AUZIM+A4SIM
|
|
ELSE
|
|
AWWARE=ASGRE+ASZRE+ATGRE+ATZRE+A4ARE
|
|
AWWAIM=ASGIM+ASZIM+ATGIM+ATZIM+A4AIM
|
|
AWWSRE=ATGRE+ATZRE+AUGRE+AUZRE+A4SRE
|
|
AWWSIM=ATGIM+ATZIM+AUGIM+AUZIM+A4SIM
|
|
ENDIF
|
|
AWWA2=AWWARE**2+AWWAIM**2
|
|
AWWS2=AWWSRE**2+AWWSIM**2
|
|
|
|
ELSE
|
|
C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron
|
|
FWWA=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*(64D0/9D0)*
|
|
& ABS(A00U+0.5*A20U+4.5*A11U*SNGL(CTH))**2
|
|
FWWS=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*64D0*ABS(A20U)**2
|
|
ENDIF
|
|
|
|
DO 950 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 950
|
|
EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1)
|
|
DO 940 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 940
|
|
EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1)
|
|
IF(EI*EJ.LT.0D0) THEN
|
|
C...W+W-
|
|
IF(MSTP(45).EQ.1) GOTO 940
|
|
IF(MSTP(46).LE.2) FACWW=FWW*AWWA2*WIDS(24,1)
|
|
IF(MSTP(46).GE.3) FACWW=FWWA*WIDS(24,1)
|
|
ELSE
|
|
C...W+W+/W-W-
|
|
IF(MSTP(45).EQ.2) GOTO 940
|
|
IF(MSTP(46).LE.2) FACWW=FWW*AWWS2
|
|
IF(MSTP(46).GE.3) FACWW=FWWS
|
|
IF(EI.GT.0D0) FACWW=FACWW*WIDS(24,4)
|
|
IF(EI.LT.0D0) FACWW=FACWW*WIDS(24,5)
|
|
ENDIF
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACWW*VINT(180+I)*VINT(180+J)
|
|
IF(EI*EJ.GT.0D0) SIGH(NCHN)=0.5D0*SIGH(NCHN)
|
|
940 CONTINUE
|
|
950 CONTINUE
|
|
960 CONTINUE
|
|
|
|
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+/-
|
|
FQPI=COMFAC*(2D0*AEM/9D0)*(-SH/TH)*(1D0/SH2+1D0/TH2)
|
|
ASSH=PYALPS(MAX(0.5D0,0.5D0*SH))
|
|
Q2FPSH=0.55D0/LOG(MAX(2D0,2D0*SH))
|
|
DELSH=UH*SQRT(ASSH*Q2FPSH)
|
|
ASUH=PYALPS(MAX(0.5D0,-0.5D0*UH))
|
|
Q2FPUH=0.55D0/LOG(MAX(2D0,-2D0*UH))
|
|
DELUH=SH*SQRT(ASUH*Q2FPUH)
|
|
DO 980 I=MAX(-2,MMINA),MIN(2,MMAXA)
|
|
IF(I.EQ.0) GOTO 980
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
EJ=SIGN(1D0-ABS(EI),EI)
|
|
DO 970 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 970
|
|
IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 970
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FQPI*(EI*DELSH+EJ*DELUH)**2
|
|
970 CONTINUE
|
|
980 CONTINUE
|
|
|
|
ENDIF
|
|
|
|
C...C: 2 -> 2, tree diagrams with masses
|
|
|
|
ELSEIF(ISUB.LE.90) THEN
|
|
IF(ISUB.EQ.81) THEN
|
|
C...q + qbar -> Q + Qbar
|
|
FACQQB=COMFAC*AS**2*4D0/9D0*(((TH-SQM3)**2+
|
|
& (UH-SQM3)**2)/SH2+2D0*SQM3/SH)
|
|
IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQM3,0D0)
|
|
WID2=1D0
|
|
IF(MINT(55).EQ.6) WID2=WIDS(6,1)
|
|
IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1)
|
|
FACQQB=FACQQB*WID2
|
|
DO 990 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
|
|
& KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 990
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQB
|
|
990 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.82) THEN
|
|
C...g + g -> Q + Qbar
|
|
IF(MSTP(34).EQ.0) THEN
|
|
FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*((UH-SQM3)/(TH-SQM3)-
|
|
& 2D0*(UH-SQM3)**2/SH2+4D0*(SQM3/SH)*(TH*UH-SQM3**2)/
|
|
& (TH-SQM3)**2)
|
|
FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*((TH-SQM3)/(UH-SQM3)-
|
|
& 2D0*(TH-SQM3)**2/SH2+4D0*(SQM3/SH)*(TH*UH-SQM3**2)/
|
|
& (UH-SQM3)**2)
|
|
ELSE
|
|
FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*((UH-SQM3)/(TH-SQM3)-
|
|
& 2.25D0*(UH-SQM3)**2/SH2+4.5D0*(SQM3/SH)*(TH*UH-SQM3**2)/
|
|
& (TH-SQM3)**2+0.5D0*SQM3*TH/(TH-SQM3)**2-SQM3**2/
|
|
& (SH*(TH-SQM3)))
|
|
FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*((TH-SQM3)/(UH-SQM3)-
|
|
& 2.25D0*(TH-SQM3)**2/SH2+4.5D0*(SQM3/SH)*(TH*UH-SQM3**2)/
|
|
& (UH-SQM3)**2+0.5D0*SQM3*UH/(UH-SQM3)**2-SQM3**2/
|
|
& (SH*(UH-SQM3)))
|
|
ENDIF
|
|
IF(MSTP(35).GE.1) THEN
|
|
FATRE=PYHFTH(SH,SQM3,2D0/7D0)
|
|
FACQQ1=FACQQ1*FATRE
|
|
FACQQ2=FACQQ2*FATRE
|
|
ENDIF
|
|
WID2=1D0
|
|
IF(MINT(55).EQ.6) WID2=WIDS(6,1)
|
|
IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1)
|
|
FACQQ1=FACQQ1*WID2
|
|
FACQQ2=FACQQ2*WID2
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1000
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQQ2
|
|
1000 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.83) THEN
|
|
C...f + q -> f' + Q
|
|
FACQQS=COMFAC*(0.5D0*AEM/XW)**2*SH*(SH-SQM3)/(SQMW-TH)**2
|
|
FACQQU=COMFAC*(0.5D0*AEM/XW)**2*UH*(UH-SQM3)/(SQMW-TH)**2
|
|
DO 1020 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1020
|
|
DO 1010 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1010
|
|
IF(I*J.GT.0.AND.MOD(IABS(I+J),2).EQ.0) GOTO 1010
|
|
IF(I*J.LT.0.AND.MOD(IABS(I+J),2).EQ.1) GOTO 1010
|
|
IF(IABS(I).LT.MINT(55).AND.MOD(IABS(I+MINT(55)),2).EQ.1)
|
|
& THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2,
|
|
& (IABS(I)+1)/2)*VINT(180+J)
|
|
IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(I)/2,
|
|
& (MINT(55)+1)/2)*VINT(180+J)
|
|
WID2=1D0
|
|
IF(I.GT.0) THEN
|
|
IF(MINT(55).EQ.6) WID2=WIDS(6,2)
|
|
IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=
|
|
& WIDS(MINT(55),2)
|
|
ELSE
|
|
IF(MINT(55).EQ.6) WID2=WIDS(6,3)
|
|
IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=
|
|
& WIDS(MINT(55),3)
|
|
ENDIF
|
|
IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2
|
|
IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2
|
|
ENDIF
|
|
IF(IABS(J).LT.MINT(55).AND.MOD(IABS(J+MINT(55)),2).EQ.1)
|
|
& THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=2
|
|
IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2,
|
|
& (IABS(J)+1)/2)*VINT(180+I)
|
|
IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(J)/2,
|
|
& (MINT(55)+1)/2)*VINT(180+I)
|
|
IF(J.GT.0) THEN
|
|
IF(MINT(55).EQ.6) WID2=WIDS(6,2)
|
|
IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=
|
|
& WIDS(MINT(55),2)
|
|
ELSE
|
|
IF(MINT(55).EQ.6) WID2=WIDS(6,3)
|
|
IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=
|
|
& WIDS(MINT(55),3)
|
|
ENDIF
|
|
IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2
|
|
IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2
|
|
ENDIF
|
|
1010 CONTINUE
|
|
1020 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.84) THEN
|
|
C...g + gamma -> Q + Qbar
|
|
FMTU=SQM3/(SQM3-TH)+SQM3/(SQM3-UH)
|
|
FACQQ=COMFAC*AS*AEM*(KCHG(IABS(MINT(55)),1)/3D0)**2*
|
|
& ((SQM3-TH)/(SQM3-UH)+(SQM3-UH)/(SQM3-TH)+4D0*FMTU*(1D0-FMTU))
|
|
IF(MSTP(35).GE.1) FACQQ=FACQQ*PYHFTH(SH,SQM3,0D0)
|
|
WID2=1D0
|
|
IF(MINT(55).EQ.6) WID2=WIDS(6,1)
|
|
IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1)
|
|
FACQQ=FACQQ*WID2
|
|
IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ
|
|
ENDIF
|
|
IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=22
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.85) THEN
|
|
C...gamma + gamma -> F + Fbar (heavy fermion, quark or lepton)
|
|
FMTU=SQM3/(SQM3-TH)+SQM3/(SQM3-UH)
|
|
FACFF=COMFAC*AEM**2*(KCHG(IABS(MINT(56)),1)/3D0)**4*2D0*
|
|
& ((SQM3-TH)/(SQM3-UH)+(SQM3-UH)/(SQM3-TH)+4D0*FMTU*(1D0-FMTU))
|
|
IF(IABS(MINT(56)).LT.10) FACFF=3D0*FACFF
|
|
IF(IABS(MINT(56)).LT.10.AND.MSTP(35).GE.1)
|
|
& FACFF=FACFF*PYHFTH(SH,SQM3,1D0)
|
|
WID2=1D0
|
|
IF(MINT(56).EQ.6) WID2=WIDS(6,1)
|
|
IF(MINT(56).EQ.7.OR.MINT(56).EQ.8) WID2=WIDS(MINT(56),1)
|
|
IF(MINT(56).EQ.17) WID2=WIDS(17,1)
|
|
FACFF=FACFF*WID2
|
|
IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=22
|
|
ISIG(NCHN,2)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACFF
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.86) THEN
|
|
C...g + g -> J/Psi + g
|
|
FACQQG=COMFAC*AS**3*(5D0/9D0)*PARP(38)*SQRT(SQM3)*
|
|
& (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/
|
|
& ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2
|
|
IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQG
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.87) THEN
|
|
C...g + g -> chi_0c + g
|
|
PGTW=(SH*TH+TH*UH+UH*SH)/SH2
|
|
QGTW=(SH*TH*UH)/SH**3
|
|
RGTW=SQM3/SH
|
|
FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)*
|
|
& (9D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)-
|
|
& 6D0*RGTW*PGTW**3*QGTW*(2D0*RGTW**4-5D0*RGTW**2*PGTW+PGTW**2)-
|
|
& PGTW**2*QGTW**2*(RGTW**4+2D0*RGTW**2*PGTW-PGTW**2)+
|
|
& 2D0*RGTW*PGTW*QGTW**3*(RGTW**2-PGTW)+6D0*RGTW**2*QGTW**4)/
|
|
& (QGTW*(QGTW-RGTW*PGTW)**4)
|
|
IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQG
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.88) THEN
|
|
C...g + g -> chi_1c + g
|
|
PGTW=(SH*TH+TH*UH+UH*SH)/SH2
|
|
QGTW=(SH*TH*UH)/SH**3
|
|
RGTW=SQM3/SH
|
|
FACQQG=COMFAC*AS**3*12D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)*
|
|
& PGTW**2*(RGTW*PGTW**2*(RGTW**2-4D0*PGTW)+2D0*QGTW*(-RGTW**4+
|
|
& 5D0*RGTW**2*PGTW+PGTW**2)-15D0*RGTW*QGTW**2)/
|
|
& (QGTW-RGTW*PGTW)**4
|
|
IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQG
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.EQ.89) THEN
|
|
C...g + g -> chi_2c + g
|
|
PGTW=(SH*TH+TH*UH+UH*SH)/SH2
|
|
QGTW=(SH*TH*UH)/SH**3
|
|
RGTW=SQM3/SH
|
|
FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)*
|
|
& (12D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)-
|
|
& 3D0*RGTW*PGTW**3*QGTW*(8D0*RGTW**4-RGTW**2*PGTW+4D0*PGTW**2)+
|
|
& 2D0*PGTW**2*QGTW**2*(-7D0*RGTW**4+43D0*RGTW**2*PGTW+PGTW**2)+
|
|
& RGTW*PGTW*QGTW**3*(16D0*RGTW**2-61D0*PGTW)+12D0*RGTW**2*
|
|
& QGTW**4)/(QGTW*(QGTW-RGTW*PGTW)**4)
|
|
IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQG
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...D: Mimimum bias processes
|
|
|
|
ELSEIF(ISUB.LE.100) THEN
|
|
IF(ISUB.EQ.91) THEN
|
|
C...Elastic scattering
|
|
SIGS=SIGT(0,0,1)
|
|
|
|
ELSEIF(ISUB.EQ.92) THEN
|
|
C...Single diffractive scattering (first side, i.e. XB)
|
|
SIGS=SIGT(0,0,2)
|
|
|
|
ELSEIF(ISUB.EQ.93) THEN
|
|
C...Single diffractive scattering (second side, i.e. AX)
|
|
SIGS=SIGT(0,0,3)
|
|
|
|
ELSEIF(ISUB.EQ.94) THEN
|
|
C...Double diffractive scattering
|
|
SIGS=SIGT(0,0,4)
|
|
|
|
ELSEIF(ISUB.EQ.95) THEN
|
|
C...Low-pT scattering
|
|
SIGS=SIGT(0,0,5)
|
|
|
|
ELSEIF(ISUB.EQ.96) THEN
|
|
C...Multiple interactions: sum of QCD processes
|
|
CALL PYWIDT(21,SH,WDTP,WDTE)
|
|
|
|
C...q + q' -> q + q'
|
|
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))
|
|
DO 1040 I=-3,3
|
|
IF(I.EQ.0) GOTO 1040
|
|
DO 1030 J=-3,3
|
|
IF(J.EQ.0) GOTO 1030
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=111
|
|
SIGH(NCHN)=FACQQ1
|
|
IF(I.EQ.-J) SIGH(NCHN)=FACQQB
|
|
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)=112
|
|
SIGH(NCHN)=0.5D0*FACQQ2
|
|
ENDIF
|
|
1030 CONTINUE
|
|
1040 CONTINUE
|
|
|
|
C...q + qbar -> q' + qbar' or g + g
|
|
FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2*
|
|
& (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))
|
|
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 1050 I=-3,3
|
|
IF(I.EQ.0) GOTO 1050
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=121
|
|
SIGH(NCHN)=FACQQB
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=131
|
|
SIGH(NCHN)=0.5D0*FACGG1
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=132
|
|
SIGH(NCHN)=0.5D0*FACGG2
|
|
1050 CONTINUE
|
|
|
|
C...q + g -> q + g
|
|
FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2-
|
|
& UH/SH)*FACA
|
|
FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2-
|
|
& SH/UH)
|
|
DO 1070 I=-3,3
|
|
IF(I.EQ.0) GOTO 1070
|
|
DO 1060 ISDE=1,2
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=281
|
|
SIGH(NCHN)=FACQG1
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=282
|
|
SIGH(NCHN)=FACQG2
|
|
1060 CONTINUE
|
|
1070 CONTINUE
|
|
|
|
C...g + g -> q + qbar or g + g
|
|
FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)*
|
|
& UH2/SH2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
|
|
FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)*
|
|
& TH2/SH2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
|
|
FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+
|
|
& 2D0*TH/SH+TH2/SH2)*FACA
|
|
FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+
|
|
& 2D0*SH/UH+SH2/UH2)*FACA
|
|
FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3+
|
|
& 2D0*UH/TH+UH2/TH2)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=531
|
|
SIGH(NCHN)=FACQQ1
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=532
|
|
SIGH(NCHN)=FACQQ2
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=681
|
|
SIGH(NCHN)=0.5D0*FACGG1
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=682
|
|
SIGH(NCHN)=0.5D0*FACGG2
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=683
|
|
SIGH(NCHN)=0.5D0*FACGG3
|
|
ENDIF
|
|
|
|
C...E: 2 -> 1, loop diagrams
|
|
|
|
ELSEIF(ISUB.LE.110) THEN
|
|
IF(ISUB.EQ.101) THEN
|
|
C...g + g -> gamma*/Z0
|
|
|
|
ELSEIF(ISUB.EQ.102) THEN
|
|
C...g + g -> h0 (or H0, or A0)
|
|
CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2))
|
|
& FACBW=0D0
|
|
HI=SHR*WDTP(13)/32D0
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1080
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1080 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.103) THEN
|
|
C...gamma + gamma -> h0 (or H0, or A0)
|
|
CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2))
|
|
& FACBW=0D0
|
|
HI=SHR*WDTP(14)*2D0
|
|
IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 1090
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=22
|
|
ISIG(NCHN,2)=22
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1090 CONTINUE
|
|
|
|
C...F: 2 -> 2, box diagrams
|
|
|
|
ELSEIF(ISUB.EQ.110) THEN
|
|
C...f + fbar -> gamma + h0
|
|
THUH=MAX(TH*UH,SH*CKIN(3)**2)
|
|
FACHG=COMFAC*(3D0*AEM**4)/(2D0*PARU(1)**2*XW*SQMW)*SH*THUH
|
|
FACHG=FACHG*WIDS(KFHIGG,2)
|
|
C...Calculate loop contributions for intermediate gamma* and Z0
|
|
CIGTOT=CMPLX(0.,0.)
|
|
CIZTOT=CMPLX(0.,0.)
|
|
JMAX=3*MSTP(1)+1
|
|
DO 1100 J=1,JMAX
|
|
IF(J.LE.2*MSTP(1)) THEN
|
|
FNC=1D0
|
|
EJ=KCHG(J,1)/3D0
|
|
AJ=SIGN(1D0,EJ+0.1D0)
|
|
VJ=AJ-4D0*EJ*XWV
|
|
BALP=SQM4/(2D0*PMAS(J,1))**2
|
|
BBET=SH/(2D0*PMAS(J,1))**2
|
|
ELSEIF(J.LE.3*MSTP(1)) THEN
|
|
FNC=3D0
|
|
JL=2*(J-2*MSTP(1))-1
|
|
EJ=KCHG(10+JL,1)/3D0
|
|
AJ=SIGN(1D0,EJ+0.1D0)
|
|
VJ=AJ-4D0*EJ*XWV
|
|
BALP=SQM4/(2D0*PMAS(10+JL,1))**2
|
|
BBET=SH/(2D0*PMAS(10+JL,1))**2
|
|
ELSE
|
|
BALP=SQM4/(2D0*PMAS(24,1))**2
|
|
BBET=SH/(2D0*PMAS(24,1))**2
|
|
ENDIF
|
|
BABI=1D0/(BALP-BBET)
|
|
IF(BALP.LT.1D0) THEN
|
|
F0ALP=CMPLX(SNGL(ASIN(SQRT(BALP))),0.)
|
|
F1ALP=F0ALP**2
|
|
ELSE
|
|
F0ALP=CMPLX(SNGL(LOG(SQRT(BALP)+SQRT(BALP-1D0))),
|
|
& -SNGL(0.5D0*PARU(1)))
|
|
F1ALP=-F0ALP**2
|
|
ENDIF
|
|
F2ALP=SNGL(SQRT(ABS(BALP-1D0)/BALP))*F0ALP
|
|
IF(BBET.LT.1D0) THEN
|
|
F0BET=CMPLX(SNGL(ASIN(SQRT(BBET))),0.)
|
|
F1BET=F0BET**2
|
|
ELSE
|
|
F0BET=CMPLX(SNGL(LOG(SQRT(BBET)+SQRT(BBET-1D0))),
|
|
& -SNGL(0.5D0*PARU(1)))
|
|
F1BET=-F0BET**2
|
|
ENDIF
|
|
F2BET=SNGL(SQRT(ABS(BBET-1D0)/BBET))*F0BET
|
|
IF(J.LE.3*MSTP(1)) THEN
|
|
FIF=SNGL(0.5D0*BABI)+SNGL(BABI**2)*(SNGL(0.5D0*(1D0-BALP+
|
|
& BBET))*(F1BET-F1ALP)+SNGL(BBET)*(F2BET-F2ALP))
|
|
CIGTOT=CIGTOT+SNGL(FNC*EJ**2)*FIF
|
|
CIZTOT=CIZTOT+SNGL(FNC*EJ*VJ)*FIF
|
|
ELSE
|
|
TXW=XW/XW1
|
|
CIGTOT=CIGTOT-0.5*(SNGL(BABI*(1.5D0+BALP))+SNGL(BABI**2)*
|
|
& (SNGL(1.5D0-3D0*BALP+4D0*BBET)*(F1BET-F1ALP)+
|
|
& SNGL(BBET*(2D0*BALP+3D0))*(F2BET-F2ALP)))
|
|
CIZTOT=CIZTOT-SNGL(0.5D0*BABI*XW1)*(SNGL(5D0-TXW+2D0*BALP*
|
|
& (1D0-TXW))*(1.+SNGL(2D0*BABI*BBET)*(F2BET-F2ALP))+
|
|
& SNGL(BABI*(4D0*BBET*(3D0-TXW)-(2D0*BALP-1D0)*(5D0-TXW)))*
|
|
& (F1BET-F1ALP))
|
|
ENDIF
|
|
1100 CONTINUE
|
|
CIGTOT=CIGTOT/SNGL(SH)
|
|
CIZTOT=CIZTOT*SNGL(XWC)/CMPLX(SNGL(SH-SQMZ),SNGL(GMMZ))
|
|
C...Loop over initial flavours
|
|
DO 1110 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1110
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
FCOI=1D0
|
|
IF(IABS(I).LE.10) FCOI=FACA/3D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACHG*FCOI*(ABS(SNGL(EI)*CIGTOT+SNGL(VI)*
|
|
& CIZTOT)**2+AI**2*ABS(CIZTOT)**2)
|
|
1110 CONTINUE
|
|
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.120) THEN
|
|
IF(ISUB.EQ.111) THEN
|
|
C...f + fbar -> g + h0 (q + qbar -> g + h0 only)
|
|
A5STUR=0D0
|
|
A5STUI=0D0
|
|
DO 1120 I=1,2*MSTP(1)
|
|
SQMQ=PMAS(I,1)**2
|
|
EPSS=4D0*SQMQ/SH
|
|
EPSH=4D0*SQMQ/SQMH
|
|
CALL PYWAUX(1,EPSS,W1SR,W1SI)
|
|
CALL PYWAUX(1,EPSH,W1HR,W1HI)
|
|
CALL PYWAUX(2,EPSS,W2SR,W2SI)
|
|
CALL PYWAUX(2,EPSH,W2HR,W2HI)
|
|
A5STUR=A5STUR+EPSH*(1D0+SH/(TH+UH)*(W1SR-W1HR)+
|
|
& (0.25D0-SQMQ/(TH+UH))*(W2SR-W2HR))
|
|
A5STUI=A5STUI+EPSH*(SH/(TH+UH)*(W1SI-W1HI)+
|
|
& (0.25D0-SQMQ/(TH+UH))*(W2SI-W2HI))
|
|
1120 CONTINUE
|
|
FACGH=COMFAC*FACA/(144D0*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
|
|
& SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2)
|
|
FACGH=FACGH*WIDS(25,2)
|
|
DO 1130 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
|
|
& KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1130
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACGH
|
|
1130 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.112) THEN
|
|
C...f + g -> f + h0 (q + g -> q + h0 only)
|
|
A5TSUR=0D0
|
|
A5TSUI=0D0
|
|
DO 1140 I=1,2*MSTP(1)
|
|
SQMQ=PMAS(I,1)**2
|
|
EPST=4D0*SQMQ/TH
|
|
EPSH=4D0*SQMQ/SQMH
|
|
CALL PYWAUX(1,EPST,W1TR,W1TI)
|
|
CALL PYWAUX(1,EPSH,W1HR,W1HI)
|
|
CALL PYWAUX(2,EPST,W2TR,W2TI)
|
|
CALL PYWAUX(2,EPSH,W2HR,W2HI)
|
|
A5TSUR=A5TSUR+EPSH*(1D0+TH/(SH+UH)*(W1TR-W1HR)+
|
|
& (0.25D0-SQMQ/(SH+UH))*(W2TR-W2HR))
|
|
A5TSUI=A5TSUI+EPSH*(TH/(SH+UH)*(W1TI-W1HI)+
|
|
& (0.25D0-SQMQ/(SH+UH))*(W2TI-W2HI))
|
|
1140 CONTINUE
|
|
FACQH=COMFAC*FACA/(384D0*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
|
|
& SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2)
|
|
FACQH=FACQH*WIDS(25,2)
|
|
DO 1160 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 1160
|
|
DO 1150 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1150
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1150
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQH
|
|
1150 CONTINUE
|
|
1160 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.113) THEN
|
|
C...g + g -> g + h0
|
|
A2STUR=0D0
|
|
A2STUI=0D0
|
|
A2USTR=0D0
|
|
A2USTI=0D0
|
|
A2TUSR=0D0
|
|
A2TUSI=0D0
|
|
A4STUR=0D0
|
|
A4STUI=0D0
|
|
DO 1170 I=1,2*MSTP(1)
|
|
SQMQ=PMAS(I,1)**2
|
|
EPSS=4D0*SQMQ/SH
|
|
EPST=4D0*SQMQ/TH
|
|
EPSU=4D0*SQMQ/UH
|
|
EPSH=4D0*SQMQ/SQMH
|
|
IF(EPSH.LT.1.D-6) GOTO 1170
|
|
CALL PYWAUX(1,EPSS,W1SR,W1SI)
|
|
CALL PYWAUX(1,EPST,W1TR,W1TI)
|
|
CALL PYWAUX(1,EPSU,W1UR,W1UI)
|
|
CALL PYWAUX(1,EPSH,W1HR,W1HI)
|
|
CALL PYWAUX(2,EPSS,W2SR,W2SI)
|
|
CALL PYWAUX(2,EPST,W2TR,W2TI)
|
|
CALL PYWAUX(2,EPSU,W2UR,W2UI)
|
|
CALL PYWAUX(2,EPSH,W2HR,W2HI)
|
|
CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI)
|
|
CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI)
|
|
CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI)
|
|
CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI)
|
|
CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI)
|
|
CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI)
|
|
CALL PYI3AU(EPSH,SQMH/SH*TH/UH,YHSTUR,YHSTUI)
|
|
CALL PYI3AU(EPSH,SQMH/SH*UH/TH,YHSUTR,YHSUTI)
|
|
CALL PYI3AU(EPSH,SQMH/TH*SH/UH,YHTSUR,YHTSUI)
|
|
CALL PYI3AU(EPSH,SQMH/TH*UH/SH,YHTUSR,YHTUSI)
|
|
CALL PYI3AU(EPSH,SQMH/UH*SH/TH,YHUSTR,YHUSTI)
|
|
CALL PYI3AU(EPSH,SQMH/UH*TH/SH,YHUTSR,YHUTSI)
|
|
W3STUR=YHSTUR-Y3STUR-Y3UTSR
|
|
W3STUI=YHSTUI-Y3STUI-Y3UTSI
|
|
W3SUTR=YHSUTR-Y3SUTR-Y3TUSR
|
|
W3SUTI=YHSUTI-Y3SUTI-Y3TUSI
|
|
W3TSUR=YHTSUR-Y3TSUR-Y3USTR
|
|
W3TSUI=YHTSUI-Y3TSUI-Y3USTI
|
|
W3TUSR=YHTUSR-Y3TUSR-Y3SUTR
|
|
W3TUSI=YHTUSI-Y3TUSI-Y3SUTI
|
|
W3USTR=YHUSTR-Y3USTR-Y3TSUR
|
|
W3USTI=YHUSTI-Y3USTI-Y3TSUI
|
|
W3UTSR=YHUTSR-Y3UTSR-Y3STUR
|
|
W3UTSI=YHUTSI-Y3UTSI-Y3STUI
|
|
B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2D0*TH*UH*
|
|
& (UH+2D0*SH)/(SH+UH)**2*(W1TR-W1HR)+(SQMQ-SH/4D0)*
|
|
& (0.5D0*W2SR+0.5D0*W2HR-W2TR+W3STUR)+SH2*(2D0*SQMQ/
|
|
& (SH+UH)**2-0.5D0/(SH+UH))*(W2TR-W2HR)+0.5D0*TH*UH/SH*
|
|
& (W2HR-2D0*W2TR)+0.125D0*(SH-12D0*SQMQ-4D0*TH*UH/SH)*W3TSUR)
|
|
B2STUI=SQMQ/SQMH**2*(2D0*TH*UH*(UH+2D0*SH)/(SH+UH)**2*
|
|
& (W1TI-W1HI)+(SQMQ-SH/4D0)*(0.5D0*W2SI+0.5D0*W2HI-W2TI+
|
|
& W3STUI)+SH2*(2D0*SQMQ/(SH+UH)**2-0.5D0/(SH+UH))*
|
|
& (W2TI-W2HI)+0.5D0*TH*UH/SH*(W2HI-2D0*W2TI)+0.125D0*
|
|
& (SH-12D0*SQMQ-4D0*TH*UH/SH)*W3TSUI)
|
|
B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2D0*UH*TH*
|
|
& (TH+2D0*SH)/(SH+TH)**2*(W1UR-W1HR)+(SQMQ-SH/4D0)*
|
|
& (0.5D0*W2SR+0.5D0*W2HR-W2UR+W3SUTR)+SH2*(2D0*SQMQ/
|
|
& (SH+TH)**2-0.5D0/(SH+TH))*(W2UR-W2HR)+0.5D0*UH*TH/SH*
|
|
& (W2HR-2D0*W2UR)+0.125D0*(SH-12D0*SQMQ-4D0*UH*TH/SH)*W3USTR)
|
|
B2SUTI=SQMQ/SQMH**2*(2D0*UH*TH*(TH+2D0*SH)/(SH+TH)**2*
|
|
& (W1UI-W1HI)+(SQMQ-SH/4D0)*(0.5D0*W2SI+0.5D0*W2HI-W2UI+
|
|
& W3SUTI)+SH2*(2D0*SQMQ/(SH+TH)**2-0.5D0/(SH+TH))*
|
|
& (W2UI-W2HI)+0.5D0*UH*TH/SH*(W2HI-2D0*W2UI)+0.125D0*
|
|
& (SH-12D0*SQMQ-4D0*UH*TH/SH)*W3USTI)
|
|
B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2D0*SH*UH*
|
|
& (UH+2D0*TH)/(TH+UH)**2*(W1SR-W1HR)+(SQMQ-TH/4D0)*
|
|
& (0.5D0*W2TR+0.5D0*W2HR-W2SR+W3TSUR)+TH2*(2D0*SQMQ/
|
|
& (TH+UH)**2-0.5D0/(TH+UH))*(W2SR-W2HR)+0.5D0*SH*UH/TH*
|
|
& (W2HR-2D0*W2SR)+0.125D0*(TH-12D0*SQMQ-4D0*SH*UH/TH)*W3STUR)
|
|
B2TSUI=SQMQ/SQMH**2*(2D0*SH*UH*(UH+2D0*TH)/(TH+UH)**2*
|
|
& (W1SI-W1HI)+(SQMQ-TH/4D0)*(0.5D0*W2TI+0.5D0*W2HI-W2SI+
|
|
& W3TSUI)+TH2*(2D0*SQMQ/(TH+UH)**2-0.5D0/(TH+UH))*
|
|
& (W2SI-W2HI)+0.5D0*SH*UH/TH*(W2HI-2D0*W2SI)+0.125D0*
|
|
& (TH-12D0*SQMQ-4D0*SH*UH/TH)*W3STUI)
|
|
B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2D0*UH*SH*
|
|
& (SH+2D0*TH)/(TH+SH)**2*(W1UR-W1HR)+(SQMQ-TH/4D0)*
|
|
& (0.5D0*W2TR+0.5D0*W2HR-W2UR+W3TUSR)+TH2*(2D0*SQMQ/
|
|
& (TH+SH)**2-0.5D0/(TH+SH))*(W2UR-W2HR)+0.5D0*UH*SH/TH*
|
|
& (W2HR-2D0*W2UR)+0.125D0*(TH-12D0*SQMQ-4D0*UH*SH/TH)*W3UTSR)
|
|
B2TUSI=SQMQ/SQMH**2*(2D0*UH*SH*(SH+2D0*TH)/(TH+SH)**2*
|
|
& (W1UI-W1HI)+(SQMQ-TH/4D0)*(0.5D0*W2TI+0.5D0*W2HI-W2UI+
|
|
& W3TUSI)+TH2*(2D0*SQMQ/(TH+SH)**2-0.5D0/(TH+SH))*
|
|
& (W2UI-W2HI)+0.5D0*UH*SH/TH*(W2HI-2D0*W2UI)+0.125D0*
|
|
& (TH-12D0*SQMQ-4D0*UH*SH/TH)*W3UTSI)
|
|
B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2D0*SH*TH*
|
|
& (TH+2D0*UH)/(UH+TH)**2*(W1SR-W1HR)+(SQMQ-UH/4D0)*
|
|
& (0.5D0*W2UR+0.5D0*W2HR-W2SR+W3USTR)+UH2*(2D0*SQMQ/
|
|
& (UH+TH)**2-0.5D0/(UH+TH))*(W2SR-W2HR)+0.5D0*SH*TH/UH*
|
|
& (W2HR-2D0*W2SR)+0.125D0*(UH-12D0*SQMQ-4D0*SH*TH/UH)*W3SUTR)
|
|
B2USTI=SQMQ/SQMH**2*(2D0*SH*TH*(TH+2D0*UH)/(UH+TH)**2*
|
|
& (W1SI-W1HI)+(SQMQ-UH/4D0)*(0.5D0*W2UI+0.5D0*W2HI-W2SI+
|
|
& W3USTI)+UH2*(2D0*SQMQ/(UH+TH)**2-0.5D0/(UH+TH))*
|
|
& (W2SI-W2HI)+0.5D0*SH*TH/UH*(W2HI-2D0*W2SI)+0.125D0*
|
|
& (UH-12D0*SQMQ-4D0*SH*TH/UH)*W3SUTI)
|
|
B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2D0*TH*SH*
|
|
& (SH+2D0*UH)/(UH+SH)**2*(W1TR-W1HR)+(SQMQ-UH/4D0)*
|
|
& (0.5D0*W2UR+0.5D0*W2HR-W2TR+W3UTSR)+UH2*(2D0*SQMQ/
|
|
& (UH+SH)**2-0.5D0/(UH+SH))*(W2TR-W2HR)+0.5D0*TH*SH/UH*
|
|
& (W2HR-2D0*W2TR)+0.125D0*(UH-12D0*SQMQ-4D0*TH*SH/UH)*W3TUSR)
|
|
B2UTSI=SQMQ/SQMH**2*(2D0*TH*SH*(SH+2D0*UH)/(UH+SH)**2*
|
|
& (W1TI-W1HI)+(SQMQ-UH/4D0)*(0.5D0*W2UI+0.5D0*W2HI-W2TI+
|
|
& W3UTSI)+UH2*(2D0*SQMQ/(UH+SH)**2-0.5D0/(UH+SH))*
|
|
& (W2TI-W2HI)+0.5D0*TH*SH/UH*(W2HI-2D0*W2TI)+0.125D0*
|
|
& (UH-12D0*SQMQ-4D0*TH*SH/UH)*W3TUSI)
|
|
B4STUR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)*
|
|
& (W2SR-W2HR+W3STUR))
|
|
B4STUI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2SI-W2HI+W3STUI)
|
|
B4TUSR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)*
|
|
& (W2TR-W2HR+W3TUSR))
|
|
B4TUSI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2TI-W2HI+W3TUSI)
|
|
B4USTR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)*
|
|
& (W2UR-W2HR+W3USTR))
|
|
B4USTI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2UI-W2HI+W3USTI)
|
|
A2STUR=A2STUR+B2STUR+B2SUTR
|
|
A2STUI=A2STUI+B2STUI+B2SUTI
|
|
A2USTR=A2USTR+B2USTR+B2UTSR
|
|
A2USTI=A2USTI+B2USTI+B2UTSI
|
|
A2TUSR=A2TUSR+B2TUSR+B2TSUR
|
|
A2TUSI=A2TUSI+B2TUSI+B2TSUI
|
|
A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR
|
|
A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI
|
|
1170 CONTINUE
|
|
FACGH=COMFAC*FACA*3D0/(128D0*PARU(1)**2)*AEM/XW*AS**3*
|
|
& SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+
|
|
& A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2)
|
|
FACGH=FACGH*WIDS(25,2)
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1180
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACGH
|
|
1180 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.114.OR.ISUB.EQ.115) THEN
|
|
C...g + g -> gamma + gamma or g + g -> g + gamma
|
|
A0STUR=0D0
|
|
A0STUI=0D0
|
|
A0TSUR=0D0
|
|
A0TSUI=0D0
|
|
A0UTSR=0D0
|
|
A0UTSI=0D0
|
|
A1STUR=0D0
|
|
A1STUI=0D0
|
|
A2STUR=0D0
|
|
A2STUI=0D0
|
|
ALST=LOG(-SH/TH)
|
|
ALSU=LOG(-SH/UH)
|
|
ALTU=LOG(TH/UH)
|
|
IMAX=2*MSTP(1)
|
|
IF(MSTP(38).GE.1.AND.MSTP(38).LE.8) IMAX=MSTP(38)
|
|
DO 1190 I=1,IMAX
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
EIWT=EI**2
|
|
IF(ISUB.EQ.115) EIWT=EI
|
|
SQMQ=PMAS(I,1)**2
|
|
EPSS=4D0*SQMQ/SH
|
|
EPST=4D0*SQMQ/TH
|
|
EPSU=4D0*SQMQ/UH
|
|
IF((MSTP(38).GE.1.AND.MSTP(38).LE.8).OR.EPSS.LT.1.D-4) THEN
|
|
B0STUR=1D0+(TH-UH)/SH*ALTU+0.5D0*(TH2+UH2)/SH2*(ALTU**2+
|
|
& PARU(1)**2)
|
|
B0STUI=0D0
|
|
B0TSUR=1D0+(SH-UH)/TH*ALSU+0.5D0*(SH2+UH2)/TH2*ALSU**2
|
|
B0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*ALSU)
|
|
B0UTSR=1D0+(SH-TH)/UH*ALST+0.5D0*(SH2+TH2)/UH2*ALST**2
|
|
B0UTSI=-PARU(1)*((SH-TH)/UH+(SH2+TH2)/UH2*ALST)
|
|
B1STUR=-1D0
|
|
B1STUI=0D0
|
|
B2STUR=-1D0
|
|
B2STUI=0D0
|
|
ELSE
|
|
CALL PYWAUX(1,EPSS,W1SR,W1SI)
|
|
CALL PYWAUX(1,EPST,W1TR,W1TI)
|
|
CALL PYWAUX(1,EPSU,W1UR,W1UI)
|
|
CALL PYWAUX(2,EPSS,W2SR,W2SI)
|
|
CALL PYWAUX(2,EPST,W2TR,W2TI)
|
|
CALL PYWAUX(2,EPSU,W2UR,W2UI)
|
|
CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI)
|
|
CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI)
|
|
CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI)
|
|
CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI)
|
|
CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI)
|
|
CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI)
|
|
B0STUR=1D0+(1D0+2D0*TH/SH)*W1TR+(1D0+2D0*UH/SH)*W1UR+
|
|
& 0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TR+W2UR)-
|
|
& 0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTR+Y3TUSR)-
|
|
& 0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUR+Y3UTSR)+
|
|
& 0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+
|
|
& 0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR)
|
|
B0STUI=(1D0+2D0*TH/SH)*W1TI+(1D0+2D0*UH/SH)*W1UI+
|
|
& 0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TI+W2UI)-
|
|
& 0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTI+Y3TUSI)-
|
|
& 0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUI+Y3UTSI)+
|
|
& 0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+
|
|
& 0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI)
|
|
B0TSUR=1D0+(1D0+2D0*SH/TH)*W1SR+(1D0+2D0*UH/TH)*W1UR+
|
|
& 0.5D0*((SH2+UH2)/TH2-EPST)*(W2SR+W2UR)-
|
|
& 0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSR+Y3SUTR)-
|
|
& 0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUR+Y3USTR)+
|
|
& 0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+
|
|
& 0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR)
|
|
B0TSUI=(1D0+2D0*SH/TH)*W1SI+(1D0+2D0*UH/TH)*W1UI+
|
|
& 0.5D0*((SH2+UH2)/TH2-EPST)*(W2SI+W2UI)-
|
|
& 0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSI+Y3SUTI)-
|
|
& 0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUI+Y3USTI)+
|
|
& 0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+
|
|
& 0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI)
|
|
B0UTSR=1D0+(1D0+2D0*TH/UH)*W1TR+(1D0+2D0*SH/UH)*W1SR+
|
|
& 0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TR+W2SR)-
|
|
& 0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTR+Y3TSUR)-
|
|
& 0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSR+Y3STUR)+
|
|
& 0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+
|
|
& 0.5D0*EPST*EPSS)*(Y3TUSR+Y3SUTR)
|
|
B0UTSI=(1D0+2D0*TH/UH)*W1TI+(1D0+2D0*SH/UH)*W1SI+
|
|
& 0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TI+W2SI)-
|
|
& 0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTI+Y3TSUI)-
|
|
& 0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSI+Y3STUI)+
|
|
& 0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+
|
|
& 0.5D0*EPST*EPSS)*(Y3TUSI+Y3SUTI)
|
|
B1STUR=-1D0-0.25D0*(EPSS+EPST+EPSU)*(W2SR+W2TR+W2UR)+
|
|
& 0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTR+Y3TUSR)+
|
|
& 0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR)+
|
|
& 0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR)
|
|
B1STUI=-0.25D0*(EPSS+EPST+EPSU)*(W2SI+W2TI+W2UI)+
|
|
& 0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTI+Y3TUSI)+
|
|
& 0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI)+
|
|
& 0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI)
|
|
B2STUR=-1D0+0.125D0*EPSS*EPST*(Y3SUTR+Y3TUSR)+
|
|
& 0.125D0*EPSS*EPSU*(Y3STUR+Y3UTSR)+
|
|
& 0.125D0*EPST*EPSU*(Y3TSUR+Y3USTR)
|
|
B2STUI=0.125D0*EPSS*EPST*(Y3SUTI+Y3TUSI)+
|
|
& 0.125D0*EPSS*EPSU*(Y3STUI+Y3UTSI)+
|
|
& 0.125D0*EPST*EPSU*(Y3TSUI+Y3USTI)
|
|
ENDIF
|
|
A0STUR=A0STUR+EIWT*B0STUR
|
|
A0STUI=A0STUI+EIWT*B0STUI
|
|
A0TSUR=A0TSUR+EIWT*B0TSUR
|
|
A0TSUI=A0TSUI+EIWT*B0TSUI
|
|
A0UTSR=A0UTSR+EIWT*B0UTSR
|
|
A0UTSI=A0UTSI+EIWT*B0UTSI
|
|
A1STUR=A1STUR+EIWT*B1STUR
|
|
A1STUI=A1STUI+EIWT*B1STUI
|
|
A2STUR=A2STUR+EIWT*B2STUR
|
|
A2STUI=A2STUI+EIWT*B2STUI
|
|
1190 CONTINUE
|
|
ASQSUM=A0STUR**2+A0STUI**2+A0TSUR**2+A0TSUI**2+A0UTSR**2+
|
|
& A0UTSI**2+4D0*A1STUR**2+4D0*A1STUI**2+A2STUR**2+A2STUI**2
|
|
FACGG=COMFAC*FACA/(16D0*PARU(1)**2)*AS**2*AEM**2*ASQSUM
|
|
FACGP=COMFAC*FACA*5D0/(192D0*PARU(1)**2)*AS**3*AEM*ASQSUM
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1200
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
IF(ISUB.EQ.114) SIGH(NCHN)=0.5D0*FACGG
|
|
IF(ISUB.EQ.115) SIGH(NCHN)=FACGP
|
|
1200 CONTINUE
|
|
|
|
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
|
|
|
|
C...G: 2 -> 3, tree diagrams
|
|
|
|
ELSEIF(ISUB.LE.140) THEN
|
|
IF(ISUB.EQ.121) THEN
|
|
C...g + g -> Q + Qbar + h0
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1210
|
|
IA=KFPR(ISUBSV,2)
|
|
PMF=PMAS(IA,1)
|
|
FACQQH=COMFAC*(4D0*PARU(1)*AEM/XW)*(4D0*PARU(1)*AS)**2*
|
|
& (0.5D0*PMF/PMAS(24,1))**2
|
|
IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) FACQQH=
|
|
& FACQQH*(LOG(MAX(4D0,PARP(37)**2*PMF**2/PARU(117)**2))/
|
|
& LOG(MAX(4D0,SH/PARU(117)**2)))**(24D0/(33D0-2D0*MSTU(118)))
|
|
WID2=1D0
|
|
IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1)
|
|
FACQQH=FACQQH*WID2
|
|
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
|
|
FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2
|
|
ENDIF
|
|
CALL PYQQBH(WTQQBH)
|
|
CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2))
|
|
& FACBW=0D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQH*WTQQBH*FACBW
|
|
1210 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.122) THEN
|
|
C...q + qbar -> Q + Qbar + h0
|
|
IA=KFPR(ISUBSV,2)
|
|
PMF=PMAS(IA,1)
|
|
FACQQH=COMFAC*(4D0*PARU(1)*AEM/XW)*(4D0*PARU(1)*AS)**2*
|
|
& (0.5D0*PMF/PMAS(24,1))**2
|
|
IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) FACQQH=
|
|
& FACQQH*(LOG(MAX(4D0,PARP(37)**2*PMF**2/PARU(117)**2))/
|
|
& LOG(MAX(4D0,SH/PARU(117)**2)))**(24D0/(33D0-2D0*MSTU(118)))
|
|
WID2=1D0
|
|
IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1)
|
|
FACQQH=FACQQH*WID2
|
|
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
|
|
FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2
|
|
ENDIF
|
|
CALL PYQQBH(WTQQBH)
|
|
CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2))
|
|
& FACBW=0D0
|
|
DO 1220 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
|
|
& KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1220
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQH*WTQQBH*FACBW
|
|
1220 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.123) THEN
|
|
C...f + f' -> f + f' + h0 (or H0, or A0) (Z0 + Z0 -> h0 as
|
|
C...inner process)
|
|
FACNOR=COMFAC*(4D0*PARU(1)*AEM/(XW*XW1))**3*SQMZ/32D0
|
|
IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR*
|
|
& PARU(154+10*IHIGG)**2
|
|
FACPRP=1D0/((VINT(215)-VINT(204)**2)*
|
|
& (VINT(216)-VINT(209)**2))**2
|
|
FACZZ1=FACNOR*FACPRP*(0.5D0*TAUP*VINT(2))*VINT(219)
|
|
FACZZ2=FACNOR*FACPRP*VINT(217)*VINT(218)
|
|
CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2))
|
|
& FACBW=0D0
|
|
DO 1240 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1240
|
|
IA=IABS(I)
|
|
DO 1230 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1230
|
|
JA=IABS(J)
|
|
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
|
|
FACLR1=(VI**2+AI**2)*(VJ**2+AJ**2)+4D0*VI*AI*VJ*AJ
|
|
FACLR2=(VI**2+AI**2)*(VJ**2+AJ**2)-4D0*VI*AI*VJ*AJ
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=(FACLR1*FACZZ1+FACLR2*FACZZ2)*FACBW
|
|
1230 CONTINUE
|
|
1240 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.124) THEN
|
|
C...f + f' -> f" + f"' + h0 (or H0, or A0) (W+ + W- -> h0 as
|
|
C...inner process)
|
|
FACNOR=COMFAC*(4D0*PARU(1)*AEM/XW)**3*SQMW
|
|
IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR*
|
|
& PARU(155+10*IHIGG)**2
|
|
FACPRP=1D0/((VINT(215)-VINT(204)**2)*
|
|
& (VINT(216)-VINT(209)**2))**2
|
|
FACWW=FACNOR*FACPRP*(0.5D0*TAUP*VINT(2))*VINT(219)
|
|
CALL PYWIDT(KFHIGG,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2))
|
|
& FACBW=0D0
|
|
DO 1260 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1260
|
|
EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1)
|
|
DO 1250 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1250
|
|
EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1)
|
|
IF(EI*EJ.GT.0D0) GOTO 1250
|
|
FACLR=VINT(180+I)*VINT(180+J)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACLR*FACWW*FACBW
|
|
1250 CONTINUE
|
|
1260 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.131) THEN
|
|
C...g + g -> Z0 + q + qbar
|
|
|
|
ENDIF
|
|
|
|
C...H: 2 -> 1, tree diagrams, non-standard model processes
|
|
|
|
ELSEIF(ISUB.LE.160) THEN
|
|
IF(ISUB.EQ.141) THEN
|
|
C...f + fbar -> gamma*/Z0/Z'0
|
|
SQMZP=PMAS(32,1)**2
|
|
MINT(61)=2
|
|
CALL PYWIDT(32,SH,WDTP,WDTE)
|
|
HP0=AEM/3D0*SH
|
|
HP1=AEM/3D0*XWC*SH
|
|
HP2=HP1
|
|
HS=SHR*VINT(117)
|
|
HSP=SHR*WDTP(0)
|
|
FACZP=4D0*COMFAC*3D0
|
|
DO 1270 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1270
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI)
|
|
VI=AI-4D0*EI*XWV
|
|
IF(IABS(I).LT.10) THEN
|
|
VPI=PARU(123-2*MOD(IABS(I),2))
|
|
API=PARU(124-2*MOD(IABS(I),2))
|
|
ELSE
|
|
VPI=PARU(127-2*MOD(IABS(I),2))
|
|
API=PARU(128-2*MOD(IABS(I),2))
|
|
ENDIF
|
|
HI0=HP0
|
|
IF(IABS(I).LE.10) HI0=HI0*FACA/3D0
|
|
HI1=HP1
|
|
IF(IABS(I).LE.10) HI1=HI1*FACA/3D0
|
|
HI2=HP2
|
|
IF(IABS(I).LE.10) HI2=HI2*FACA/3D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACZP*(EI**2/SH2*HI0*HP0*VINT(111)+EI*VI*
|
|
& (1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)*(HI0*HP1+HI1*HP0)*
|
|
& VINT(112)+EI*VPI*(1D0-SQMZP/SH)/((SH-SQMZP)**2+HSP**2)*
|
|
& (HI0*HP2+HI2*HP0)*VINT(113)+(VI**2+AI**2)/
|
|
& ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)+(VI*VPI+AI*API)*
|
|
& ((SH-SQMZ)*(SH-SQMZP)+HS*HSP)/(((SH-SQMZ)**2+HS**2)*
|
|
& ((SH-SQMZP)**2+HSP**2))*(HI1*HP2+HI2*HP1)*VINT(115)+
|
|
& (VPI**2+API**2)/((SH-SQMZP)**2+HSP**2)*HI2*HP2*VINT(116))
|
|
1270 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.142) THEN
|
|
C...f + fbar' -> W'+/-
|
|
SQMWP=PMAS(34,1)**2
|
|
CALL PYWIDT(34,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
FACBW=4D0*COMFAC/((SH-SQMWP)**2+HS**2)*3D0
|
|
HP=AEM/(24D0*XW)*SH
|
|
DO 1290 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1290
|
|
IA=IABS(I)
|
|
DO 1280 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1280
|
|
JA=IABS(J)
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1280
|
|
IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
|
|
& GOTO 1280
|
|
KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
|
|
HI=HP*(PARU(133)**2+PARU(134)**2)
|
|
IF(IA.LE.10) HI=HP*(PARU(131)**2+PARU(132)**2)*
|
|
& 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
|
|
1280 CONTINUE
|
|
1290 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.143) THEN
|
|
C...f + fbar' -> H+/-
|
|
SQMHC=PMAS(37,1)**2
|
|
CALL PYWIDT(37,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
FACBW=4D0*COMFAC/((SH-SQMHC)**2+HS**2)
|
|
HP=AEM/(8D0*XW)*SH/SQMW*SH
|
|
DO 1310 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1310
|
|
IA=IABS(I)
|
|
IM=(MOD(IA,10)+1)/2
|
|
DO 1300 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1300
|
|
JA=IABS(J)
|
|
JM=(MOD(JA,10)+1)/2
|
|
IF(I*J.GT.0.OR.IA.EQ.JA.OR.IM.NE.JM) GOTO 1300
|
|
IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
|
|
& GOTO 1300
|
|
IF(MOD(IA,2).EQ.0) THEN
|
|
IU=IA
|
|
IL=JA
|
|
ELSE
|
|
IU=JA
|
|
IL=IA
|
|
ENDIF
|
|
RML=PMAS(IL,1)**2/SH
|
|
RMU=PMAS(IU,1)**2/SH
|
|
IF(IL.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) RML=
|
|
& RML*(LOG(MAX(4D0,PARP(37)**2*RML*SH/PARU(117)**2))/
|
|
& LOG(MAX(4D0,SH/PARU(117)**2)))**(24D0/(33D0-
|
|
& 2D0*MSTU(118)))
|
|
HI=HP*(RML*PARU(141)**2+RMU/PARU(141)**2)
|
|
IF(IA.LE.10) HI=HI*FACA/3D0
|
|
KCHHC=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1300 CONTINUE
|
|
1310 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.144) THEN
|
|
C...f + fbar' -> R
|
|
SQMR=PMAS(40,1)**2
|
|
CALL PYWIDT(40,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
FACBW=4D0*COMFAC/((SH-SQMR)**2+HS**2)*3D0
|
|
HP=AEM/(12D0*XW)*SH
|
|
DO 1330 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1330
|
|
IA=IABS(I)
|
|
DO 1320 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1320
|
|
JA=IABS(J)
|
|
IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 1320
|
|
HI=HP
|
|
IF(IA.LE.10) HI=HI*FACA/3D0
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4))
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1320 CONTINUE
|
|
1330 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.145) THEN
|
|
C...q + l -> LQ (leptoquark)
|
|
SQMLQ=PMAS(39,1)**2
|
|
CALL PYWIDT(39,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
FACBW=4D0*COMFAC/((SH-SQMLQ)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(39,1)).GT.PARP(48)*PMAS(39,2)) FACBW=0D0
|
|
HP=AEM/4D0*SH
|
|
KFLQQ=KFDP(MDCY(39,2),1)
|
|
KFLQL=KFDP(MDCY(39,2),2)
|
|
DO 1350 I=MMIN1,MMAX1
|
|
IF(KFAC(1,I).EQ.0) GOTO 1350
|
|
IA=IABS(I)
|
|
IF(IA.NE.KFLQQ.AND.IA.NE.IABS(KFLQL)) GOTO 1350
|
|
DO 1340 J=MMIN2,MMAX2
|
|
IF(KFAC(2,J).EQ.0) GOTO 1340
|
|
JA=IABS(J)
|
|
IF(JA.NE.KFLQQ.AND.JA.NE.IABS(KFLQL)) GOTO 1340
|
|
IF(JA.EQ.IA) GOTO 1340
|
|
IF(I*J.NE.KFLQQ*KFLQL) GOTO 1340
|
|
IF(IA.EQ.KFLQQ) KCHLQ=ISIGN(1,I)
|
|
IF(JA.EQ.KFLQQ) KCHLQ=ISIGN(1,J)
|
|
HI=HP*PARU(151)
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHLQ)/2)+WDTE(0,4))
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1340 CONTINUE
|
|
1350 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN
|
|
C...d + g -> d* and u + g -> u* (excited quarks)
|
|
KFQSTR=KFPR(ISUB,1)
|
|
KCQSTR=PYCOMP(KFQSTR)
|
|
KFQEXC=MOD(KFQSTR,KEXCIT)
|
|
CALL PYWIDT(KFQSTR,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
FACBW=COMFAC/((SH-PMAS(KCQSTR,1)**2)**2+HS**2)
|
|
FACBW=FACBW*AS*PARU(159)**2*SH/(3D0*PARU(155)**2)
|
|
IF(ABS(SHR-PMAS(KCQSTR,1)).GT.PARP(48)*PMAS(KCQSTR,2))
|
|
& FACBW=0D0
|
|
HP=SH
|
|
DO 1370 I=-KFQEXC,KFQEXC,2*KFQEXC
|
|
DO 1360 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1360
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1360
|
|
HI=HP
|
|
IF(I.GT.0) HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
IF(I.LT.0) HF=SHR*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1360 CONTINUE
|
|
1370 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.149) THEN
|
|
C...g + g -> eta_techni
|
|
CALL PYWIDT(38,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
FACBW=COMFAC*0.5D0/((SH-PMAS(38,1)**2)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(38,1)).GT.PARP(48)*PMAS(38,2)) FACBW=0D0
|
|
HP=SH
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1380
|
|
HI=HP*WDTP(3)
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1380 CONTINUE
|
|
|
|
ENDIF
|
|
|
|
C...I: 2 -> 2, tree diagrams, non-standard model processes
|
|
|
|
ELSEIF(ISUB.LE.200) THEN
|
|
IF(ISUB.EQ.161) THEN
|
|
C...f + g -> f' + H+/- (b + g -> t + H+/- only)
|
|
C...(choice of only b and t to avoid kinematics problems)
|
|
SQMHC=PMAS(37,1)**2
|
|
FHCQ=COMFAC*FACA*AS*AEM/XW*1D0/24
|
|
DO 1400 I=MMINA,MMAXA
|
|
IA=IABS(I)
|
|
IF(IA.NE.5) GOTO 1400
|
|
SQML=PMAS(IA,1)**2
|
|
IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) SQML=SQML*
|
|
& (LOG(MAX(4D0,PARP(37)**2*SQML/PARU(117)**2))/
|
|
& LOG(MAX(4D0,SH/PARU(117)**2)))**(24D0/(33D0-2D0*MSTU(118)))
|
|
IUA=IA+MOD(IA,2)
|
|
SQMQ=PMAS(IUA,1)**2
|
|
FACHCQ=FHCQ*(SQML*PARU(141)**2+SQMQ/PARU(141)**2)/SQMW*
|
|
& (SH/(SQMQ-UH)+2D0*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH+
|
|
& 2D0*SQMQ/(SQMQ-UH)+2D0*(SQMHC-UH)/(SQMQ-UH)*
|
|
& (SQMHC-SQMQ-SH)/SH)
|
|
KCHHC=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
|
|
DO 1390 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1390
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,1).EQ.0) GOTO 1390
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACHCQ*WIDS(37,(5-KCHHC)/2)
|
|
1390 CONTINUE
|
|
1400 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.162) THEN
|
|
C...q + g -> LQ + lbar; LQ=leptoquark
|
|
SQMLQ=PMAS(39,1)**2
|
|
FACLQ=COMFAC*FACA*PARU(151)*(AS*AEM/6D0)*(-TH/SH)*
|
|
& (UH2+SQMLQ**2)/(UH-SQMLQ)**2
|
|
KFLQQ=KFDP(MDCY(39,2),1)
|
|
DO 1420 I=MMINA,MMAXA
|
|
IF(IABS(I).NE.KFLQQ) GOTO 1420
|
|
KCHLQ=ISIGN(1,I)
|
|
DO 1410 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1410
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1410
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACLQ*WIDS(39,(5-KCHLQ)/2)
|
|
1410 CONTINUE
|
|
1420 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.163) THEN
|
|
C...g + g -> LQ + LQbar; LQ=leptoquark
|
|
SQMLQ=PMAS(39,1)**2
|
|
FACLQ=COMFAC*FACA*WIDS(39,1)*(AS**2/2D0)*
|
|
& (7D0/48D0+3D0*(UH-TH)**2/(16D0*SH2))*(1D0+2D0*SQMLQ*TH/
|
|
& (TH-SQMLQ)**2+2D0*SQMLQ*UH/(UH-SQMLQ)**2+4D0*SQMLQ**2/
|
|
& ((TH-SQMLQ)*(UH-SQMLQ)))
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1430
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
C...Since don't know proper colour flow, randomize between alternatives
|
|
ISIG(NCHN,3)=INT(1.5D0+PYR(0))
|
|
SIGH(NCHN)=FACLQ
|
|
1430 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.164) THEN
|
|
C...q + qbar -> LQ + LQbar; LQ=leptoquark
|
|
SQMLQ=PMAS(39,1)**2
|
|
FACLQA=COMFAC*WIDS(39,1)*(AS**2/9D0)*
|
|
& (SH*(SH-4D0*SQMLQ)-(UH-TH)**2)/SH2
|
|
FACLQS=COMFAC*WIDS(39,1)*((PARU(151)**2*AEM**2/8D0)*
|
|
& (-SH*TH-(SQMLQ-TH)**2)/TH2+(PARU(151)*AEM*AS/18D0)*
|
|
& ((SQMLQ-TH)*(UH-TH)+SH*(SQMLQ+TH))/(SH*TH))
|
|
KFLQQ=KFDP(MDCY(39,2),1)
|
|
DO 1440 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
|
|
& KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1440
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACLQA
|
|
IF(IABS(I).EQ.KFLQQ) SIGH(NCHN)=FACLQA+FACLQS
|
|
1440 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.165) THEN
|
|
C...q + qbar -> l+ + l- (including contact term for compositeness)
|
|
ZRATR=XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
|
|
ZRATI=XWC*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
|
|
KFF=IABS(KFPR(ISUB,1))
|
|
EF=KCHG(KFF,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
VALF=VF+AF
|
|
VARF=VF-AF
|
|
FCOF=1D0
|
|
IF(KFF.LE.10) FCOF=3D0
|
|
WID2=1D0
|
|
IF(KFF.EQ.6) WID2=WIDS(6,1)
|
|
IF(KFF.EQ.7.OR.KFF.EQ.8) WID2=WIDS(KFF,1)
|
|
IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1)
|
|
DO 1450 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1450
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
VALI=VI+AI
|
|
VARI=VI-AI
|
|
FCOI=1D0
|
|
IF(IABS(I).LE.10) FCOI=FACA/3D0
|
|
IF((MSTP(5).EQ.1.AND.IABS(I).LE.2).OR.MSTP(5).EQ.2) THEN
|
|
FGZA=(EI*EF+VALI*VALF*ZRATR+PARU(156)*SH/
|
|
& (AEM*PARU(155)**2))**2+(VALI*VALF*ZRATI)**2+
|
|
& (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2
|
|
ELSE
|
|
FGZA=(EI*EF+VALI*VALF*ZRATR)**2+(VALI*VALF*ZRATI)**2+
|
|
& (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2
|
|
ENDIF
|
|
FGZB=(EI*EF+VALI*VARF*ZRATR)**2+(VALI*VARF*ZRATI)**2+
|
|
& (EI*EF+VARI*VALF*ZRATR)**2+(VARI*VALF*ZRATI)**2
|
|
FGZAB=AEM**2*(FGZA*UH2/SH2+FGZB*TH2/SH2)
|
|
IF((MSTP(5).EQ.3.AND.IABS(I).EQ.2).OR.(MSTP(5).EQ.4.AND.
|
|
& MOD(IABS(I),2).EQ.0)) FGZAB=FGZAB+SH2/(2D0*PARU(155)**4)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=COMFAC*FCOI*FCOF*FGZAB*WID2
|
|
1450 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.166) THEN
|
|
C...q + q'bar -> l + nu_l (including contact term for compositeness)
|
|
WFAC=(1D0/4D0)*(AEM/XW)**2*UH2/((SH-SQMW)**2+GMMW**2)
|
|
WCIFAC=WFAC+SH2/(4D0*PARU(155)**4)
|
|
KFF=IABS(KFPR(ISUB,1))
|
|
FCOF=1D0
|
|
IF(KFF.LE.10) FCOF=3D0
|
|
DO 1470 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1470
|
|
IA=IABS(I)
|
|
DO 1460 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1460
|
|
JA=IABS(J)
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1460
|
|
IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
|
|
& GOTO 1460
|
|
FCOI=1D0
|
|
IF(IA.LE.10) FCOI=VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0
|
|
WID2=1D0
|
|
IF((I.GT.0.AND.MOD(I,2).EQ.0).OR.(J.GT.0.AND.
|
|
& MOD(J,2).EQ.0)) THEN
|
|
IF(KFF.EQ.5) WID2=WIDS(6,2)
|
|
IF(KFF.EQ.7) WID2=WIDS(8,2)*WIDS(7,3)
|
|
IF(KFF.EQ.17) WID2=WIDS(18,2)*WIDS(17,3)
|
|
ELSE
|
|
IF(KFF.EQ.5) WID2=WIDS(6,3)
|
|
IF(KFF.EQ.7) WID2=WIDS(8,3)*WIDS(7,2)
|
|
IF(KFF.EQ.17) WID2=WIDS(18,3)*WIDS(17,2)
|
|
ENDIF
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=COMFAC*FCOI*FCOF*WFAC*WID2
|
|
IF((MSTP(5).EQ.3.AND.IA.LE.2.AND.JA.LE.2).OR.MSTP(5).EQ.4)
|
|
& SIGH(NCHN)=COMFAC*FCOI*FCOF*WCIFAC*WID2
|
|
1460 CONTINUE
|
|
1470 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN
|
|
C...d + g -> d* and u + g -> u* (excited quarks)
|
|
KFQSTR=KFPR(ISUB,2)
|
|
KCQSTR=PYCOMP(KFQSTR)
|
|
KFQEXC=MOD(KFQSTR,KEXCIT)
|
|
FACQSA=COMFAC*(SH/PARU(155)**2)**2*(1D0-SQM4/SH)
|
|
FACQSB=COMFAC*0.25D0*(SH/PARU(155)**2)**2*(1D0-SQM4/SH)*
|
|
& (1D0+SQM4/SH)*(1D0+CTH)*(1D0+((SH-SQM4)/(SH+SQM4))*CTH)
|
|
C...Propagators: as simulated in PYOFSH and as desired
|
|
GMMQ=PMAS(KCQSTR,1)*PMAS(KCQSTR,2)
|
|
HBW4=GMMQ/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQ**2)
|
|
CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE)
|
|
GMMQC=SQRT(SQM4)*WDTP(0)
|
|
HBW4C=GMMQC/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQC**2)
|
|
FACQSA=FACQSA*HBW4C/HBW4
|
|
FACQSB=FACQSB*HBW4C/HBW4
|
|
DO 1490 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 1490
|
|
DO 1480 J=MMIN2,MMAX2
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 1480
|
|
IF(IA.EQ.KFQEXC.AND.I.EQ.J) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=(4D0/3D0)*FACQSA
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=(4D0/3D0)*FACQSA
|
|
ELSEIF((IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC).AND.I*J.GT.0) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQSA
|
|
ELSEIF(IA.EQ.KFQEXC.AND.I.EQ.-J) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=(8D0/3D0)*FACQSB
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=(8D0/3D0)*FACQSB
|
|
ELSEIF(I.EQ.-J) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQSB
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQSB
|
|
ELSEIF(IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC) THEN
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQSB
|
|
ENDIF
|
|
1480 CONTINUE
|
|
1490 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.191) THEN
|
|
C...q + qbar -> rho_tech0.
|
|
SQMRHT=PMAS(54,1)**2
|
|
CALL PYWIDT(54,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(54,1)).GT.PARP(48)*PMAS(54,2)) FACBW=0D0
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
ALPRHT=2.91D0*(3D0/PARP(144))
|
|
HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH)
|
|
XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW))
|
|
BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
|
|
BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
|
|
DO 1500 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1500
|
|
IA=IABS(I)
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
VALI=0.5D0*(VI+AI)
|
|
VARI=0.5D0*(VI-AI)
|
|
HI=HP*((EI+VALI*BWZR)**2+(VALI*BWZI)**2+
|
|
& (EI+VARI*BWZR)**2+(VARI*BWZI)**2)
|
|
IF(IA.LE.10) HI=HI*FACA/3D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1500 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.192) THEN
|
|
C...q + qbar' -> rho_tech+/-.
|
|
SQMRHT=PMAS(55,1)**2
|
|
CALL PYWIDT(55,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(55,1)).GT.PARP(48)*PMAS(55,2)) FACBW=0D0
|
|
ALPRHT=2.91D0*(3D0/PARP(144))
|
|
HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH)*
|
|
& (0.25D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2)
|
|
DO 1520 I=MMIN1,MMAX1
|
|
IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 1520
|
|
IA=IABS(I)
|
|
DO 1510 J=MMIN2,MMAX2
|
|
IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 1510
|
|
JA=IABS(J)
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1510
|
|
IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10))
|
|
& GOTO 1510
|
|
KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHR)/2)+WDTE(0,4))
|
|
HI=HP
|
|
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
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1510 CONTINUE
|
|
1520 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.193) THEN
|
|
C...q + qbar -> omega_tech0.
|
|
SQMOMT=PMAS(56,1)**2
|
|
CALL PYWIDT(56,SH,WDTP,WDTE)
|
|
HS=SHR*WDTP(0)
|
|
FACBW=12D0*COMFAC/((SH-SQMOMT)**2+HS**2)
|
|
IF(ABS(SHR-PMAS(56,1)).GT.PARP(48)*PMAS(56,2)) FACBW=0D0
|
|
HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
|
|
ALPRHT=2.91D0*(3D0/PARP(144))
|
|
HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMOMT**2/SH)*
|
|
& (2D0*PARP(143)-1D0)**2
|
|
BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)
|
|
BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2)
|
|
DO 1530 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1530
|
|
IA=IABS(I)
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
VALI=0.5D0*(VI+AI)
|
|
VARI=0.5D0*(VI-AI)
|
|
HI=HP*((EI-VALI*BWZR)**2+(VALI*BWZI)**2+
|
|
& (EI-VARI*BWZR)**2+(VARI*BWZI)**2)
|
|
IF(IA.LE.10) HI=HI*FACA/3D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=HI*FACBW*HF
|
|
1530 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.194) THEN
|
|
C...f + fbar -> f' + fbar' via s-channel rho_tech and omega_tech.
|
|
SQMRHT=PMAS(54,1)**2
|
|
CALL PYWIDT(54,SH,WDTP,WDTE)
|
|
HSRHT=SHR*WDTP(0)
|
|
BWRHTR=SQMRHT**2*(SH-SQMRHT)/((SH-SQMRHT)**2+HSRHT**2)
|
|
BWRHTI=SQMRHT**2*HSRHT/((SH-SQMRHT)**2+HSRHT**2)
|
|
XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW))
|
|
SQMOMT=PMAS(56,1)**2
|
|
CALL PYWIDT(56,SH,WDTP,WDTE)
|
|
HSOMT=SHR*WDTP(0)
|
|
BWOMTR=SQMOMT**2*(SH-SQMOMT)/((SH-SQMOMT)**2+HSOMT**2)
|
|
BWOMTI=SQMOMT**2*HSOMT/((SH-SQMOMT)**2+HSOMT**2)
|
|
XWOMT=0.5D0/(1D0-XW)
|
|
KFF=IABS(KFPR(ISUB,1))
|
|
EF=KCHG(KFF,1)/3D0
|
|
AF=SIGN(1D0,EF+0.1D0)
|
|
VF=AF-4D0*EF*XWV
|
|
VALF=0.5D0*(VF+AF)
|
|
VARF=0.5D0*(VF-AF)
|
|
FCOF=1D0
|
|
IF(KFF.LE.10) FCOF=3D0
|
|
WID2=1D0
|
|
IF(KFF.GE.6.AND.KFF.LE.8) WID2=WIDS(KFF,1)
|
|
IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1)
|
|
ALPRHT=2.91D0*(3D0/PARP(144))
|
|
FACTC=COMFAC*(AEM**2/(ALPRHT*SH2))**2*FCOF*WID2
|
|
BWZ=SH/(SH-SQMZ)
|
|
ALEFTF=EF+VALF*XWRHT*BWZ
|
|
ARIGHF=EF+VARF*XWRHT*BWZ
|
|
BLEFTF=(EF-VALF*XWOMT*BWZ)*(2D0*PARP(143)-1D0)
|
|
BRIGHF=(EF-VARF*XWOMT*BWZ)*(2D0*PARP(143)-1D0)
|
|
DO 1540 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1540
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
AI=SIGN(1D0,EI+0.1D0)
|
|
VI=AI-4D0*EI*XWV
|
|
VALI=0.5D0*(VI+AI)
|
|
VARI=0.5D0*(VI-AI)
|
|
FCOI=1D0
|
|
IF(IABS(I).LE.10) FCOI=FACA/3D0
|
|
ALEFTI=EI+VALI*XWRHT*BWZ
|
|
ARIGHI=EI+VARI*XWRHT*BWZ
|
|
BLEFTI=(EI-VALI*XWOMT*BWZ)*(2D0*PARP(143)-1D0)
|
|
BRIGHI=(EI-VARI*XWOMT*BWZ)*(2D0*PARP(143)-1D0)
|
|
DIFLL=(ALEFTI*ALEFTF*BWRHTR+BLEFTI*BLEFTF*BWOMTR)**2+
|
|
& (ALEFTI*ALEFTF*BWRHTI+BLEFTI*BLEFTF*BWOMTI)**2
|
|
DIFRR=(ARIGHI*ARIGHF*BWRHTR+BRIGHI*BRIGHF*BWOMTR)**2+
|
|
& (ARIGHI*ARIGHF*BWRHTI+BRIGHI*BRIGHF*BWOMTI)**2
|
|
DIFLR=(ALEFTI*ARIGHF*BWRHTR+BLEFTI*BRIGHF*BWOMTR)**2+
|
|
& (ALEFTI*ARIGHF*BWRHTI+BLEFTI*BRIGHF*BWOMTI)**2
|
|
DIFRL=(ARIGHI*ALEFTF*BWRHTR+BRIGHI*BLEFTF*BWOMTR)**2+
|
|
& (ARIGHI*ALEFTF*BWRHTI+BRIGHI*BLEFTF*BWOMTI)**2
|
|
FACSIG=(DIFLL+DIFRR)*UH2+(DIFLR+DIFRL)*TH2
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACTC*FCOI*FACSIG
|
|
1540 CONTINUE
|
|
|
|
ENDIF
|
|
|
|
CMRENNA++
|
|
C...J: 2 -> 2, tree diagrams, SUSY processes
|
|
|
|
ELSEIF(ISUB.LE.210) THEN
|
|
IF(ISUB.EQ.201) THEN
|
|
C...f + fbar -> e_L + e_Lbar
|
|
COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
DO 1570 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1570
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
TT3I=SIGN(1D0,EI+1D-6)/2D0
|
|
EJ=-1D0
|
|
TT3J=-1D0/2D0
|
|
FCOL=1D0
|
|
C...Color factor for e+ e-
|
|
IF(IA.GE.11) FCOL=3D0
|
|
IF(ILR.EQ.1) THEN
|
|
XLQ=2D0*(TT3J-EJ*XW)*SFMIX(KFID,3)**2
|
|
XRQ=2D0*(-EJ*XW)*SFMIX(KFID,4)**2
|
|
ELSEIF(ILR.EQ.0) THEN
|
|
XLQ=2D0*(TT3J-EJ*XW)*SFMIX(KFID,1)**2
|
|
XRQ=2D0*(-EJ*XW)*SFMIX(KFID,2)**2
|
|
ENDIF
|
|
XLF=2D0*(TT3I-EI*XW)
|
|
XRF=2D0*(-EI*XW)
|
|
TAA=0.5D0*(EI*EJ)**2
|
|
TZZ=(XLF**2+XRF**2)*(XLQ+XRQ)**2/64D0/XW**2/(1D0-XW)**2
|
|
TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*ZWID/SH**2)
|
|
TAZ=EI*EJ*(XLQ+XRQ)*(XLF+XRF)/8D0/XW/(1D0-XW)
|
|
TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH)
|
|
TNN=0.0D0
|
|
TAN=0.0D0
|
|
TZN=0.0D0
|
|
IF(IA.GE.11.AND.IA.LE.18.AND.KFID.EQ.IA) THEN
|
|
IF(ILR.EQ.0) THEN
|
|
A1=SFMIX(KFID,1)
|
|
A2=SFMIX(KFID,2)
|
|
ELSE
|
|
A1=SFMIX(KFID,3)
|
|
A2=SFMIX(KFID,4)
|
|
ENDIF
|
|
FAC2=SQRT(2D0)
|
|
TNN1=0D0
|
|
TNN2=0D0
|
|
TNN3=0D0
|
|
DO 1560 II=1,4
|
|
DK=1D0/(TH-SMZ(II)**2)
|
|
FLEK=-FAC2*(TT3I*ZMIX(II,2)-TANW*(TT3I-2D0*EI)*
|
|
& ZMIX(II,1))/2D0
|
|
FREK=FAC2*TANW*EI*ZMIX(II,1)
|
|
TNN1=TNN1+FLEK**2*DK
|
|
TNN2=TNN2+FREK**2*DK
|
|
DO 1550 JJ=1,4
|
|
DL=1D0/(TH-SMZ(JJ)**2)
|
|
FLEL=-FAC2*(TT3J*ZMIX(JJ,2)-TANW*(TT3J-2D0*EJ)*
|
|
& ZMIX(JJ,1))/2D0
|
|
FREL=FAC2*TANW*EJ*ZMIX(JJ,1)
|
|
TNN3=TNN3+FLEK*FREK*FLEL*FREL*DK*DL*SMZ(II)*SMZ(JJ)
|
|
1550 CONTINUE
|
|
1560 CONTINUE
|
|
TNN=(UH*TH - SQM3*SQM4)*(A1**4*TNN1**2+A2**4*TNN2**2)
|
|
TNN=(TNN+2D0*SH*A1**2*A2**2*TNN3)/4D0
|
|
TZN=(UH*TH-SQM3*SQM4)*(XLQ+XRQ)/2D0*
|
|
& (TNN1*XLQ+TNN2*XRQ)/2D0
|
|
TZN=TZN/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*
|
|
& (1D0-SQMZ/SH)/SH
|
|
TZN=TZN/XW**2/(1D0-XW)
|
|
TAN=(UH*TH-SQM3*SQM4)/SH*(A1**2*TNN1+A2**2*TNN2)/XW
|
|
ENDIF
|
|
FACQQ1=COMFAC*AEM**2*(TAA+TZZ+TAZ)*FCOL*4D0/3D0
|
|
FACQQ1=FACQQ1*( UH*TH-SQM3*SQM4 )/SH**2
|
|
FACQQ2=COMFAC*AEM**2*(TNN+TZN+TAN)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1+FACQQ2
|
|
1570 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.203) THEN
|
|
C...f + fbar -> e_L + e_Rbar
|
|
DO 1600 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1600
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
TT3I=SIGN(1D0,EI)/2D0
|
|
EJ=-1
|
|
TT3J=-1D0/2D0
|
|
FCOL=1D0
|
|
C...Asymmetry factor for e1+ e2- vs. e2+ e1-
|
|
PASY=0D0
|
|
IF(IA.GE.11.AND.KFID.EQ.IA) THEN
|
|
IF(ABS(MINT(21)).EQ.KFPR(ISUB,1)) THEN
|
|
PASY=-ISIGN(1,MINT(21))
|
|
ELSE
|
|
PASY=-ISIGN(1,MINT(22))
|
|
ENDIF
|
|
ENDIF
|
|
C...Color factor for e+ e-
|
|
IF(IA.GE.11) FCOL=3D0
|
|
A1=SFMIX(KFID,1)**2
|
|
A2=SFMIX(KFID,2)**2
|
|
XLQ=2D0*(TT3J-EJ*XW)
|
|
XRQ=2D0*(-EJ*XW)
|
|
XLF=2D0*(TT3I-EI*XW)
|
|
XRF=2D0*(-EI*XW)
|
|
TZZ=(XLF**2-XRF**2)*(XLQ-XRQ)**2/64D0/XW**2/(1D0-
|
|
& XW)**2*A1*A2
|
|
TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)
|
|
TNN=0.0D0
|
|
TZN=0.0D0
|
|
IF(IA.GE.11.AND.IA.LE.18.AND.KFID.EQ.IA) THEN
|
|
FAC2=SQRT(2D0)
|
|
TNN1=0D0
|
|
TNN2=0D0
|
|
TNN3=0D0
|
|
DO 1590 II=1,4
|
|
DK=1D0/(TH-SMZ(II)**2)
|
|
FLEK=-FAC2*(TT3I*ZMIX(II,2)-TANW*(TT3I-EI)*
|
|
& ZMIX(II,1))
|
|
FREK=FAC2*TANW*EI*ZMIX(II,1)
|
|
TNN1=TNN1+FLEK**2*DK
|
|
TNN2=TNN2+FREK**2*DK
|
|
DO 1580 JJ=1,4
|
|
DL=1D0/(TH-SMZ(JJ)**2)
|
|
FLEL=-FAC2*(TT3J*ZMIX(JJ,2)-TANW*(TT3J-EJ)*
|
|
& ZMIX(JJ,1))
|
|
FREL=FAC2*TANW*EJ*ZMIX(JJ,1)
|
|
TNN3=TNN3+FLEK*FREK*FLEL*FREL*DK*DL*SMZ(II)*SMZ(JJ)
|
|
1580 CONTINUE
|
|
1590 CONTINUE
|
|
TNN=(UH*TH-SQM3*SQM4)*A1*A2*(TNN2**2-TNN1**2)
|
|
TNN=(TNN+SH*(A2-A1)*PASY*TNN3)/4D0
|
|
TZN=(UH*TH-SQM3*SQM4)*A1*A2
|
|
TZN=TZN*(XLF-XRF)*(XLQ*TNN1+XRQ*TNN2)/4D0/(1D0-XW)
|
|
TZN=TZN/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*
|
|
& (1D0-SQMZ/SH)/SH
|
|
ENDIF
|
|
FACQQ1=COMFAC*AEM**2*TZZ*FCOL*4D0/3D0*(UH*TH-SQM3*SQM4)/SH2
|
|
FACQQ2=COMFAC*AEM**2/XW**2*(TNN+TZN)
|
|
FACQQ=2D0*(FACQQ1+FACQQ2)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),3)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQQ*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),2)
|
|
1600 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.210) THEN
|
|
C...q + qbar' -> W*- > ~l_L + ~nu_L
|
|
FAC0=RKF*COMFAC*AEM**2/XW**2/12D0
|
|
FAC1=(TH*UH-SQM3*SQM4)/((SH-SQMW)**2+WWID**2*SQMW)
|
|
DO 1620 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 1620
|
|
DO 1610 J=MMIN2,MMAX2
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 1610
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1610
|
|
FCKM=3D0
|
|
IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
|
|
KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J)
|
|
KCHW=2
|
|
IF(KCHSUM.LT.0) KCHW=3
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FAC0*FAC1*FCKM*WIDS(PYCOMP(KFPR(ISUBSV,1)),
|
|
& 5-KCHW)*WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW)
|
|
1610 CONTINUE
|
|
1620 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.220) THEN
|
|
IF(ISUB.EQ.213) THEN
|
|
C...f + fbar -> ~nu_L + ~nu_Lbar
|
|
COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
FAC0=RKF*COMFAC/3D0*AEM**2
|
|
FAC1=XW*(1D0-XW)
|
|
PROPZ=(SH-SQMZ)**2+ZWID**2*SQMZ
|
|
XLL=0.5D0
|
|
XLR=0.0D0
|
|
DO 1630 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1630
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
FCOL=1D0
|
|
C...Color factor for e+ e-
|
|
IF(IA.GE.11) FCOL=3D0
|
|
XLQ=(SIGN(1D0,EI)-2D0*EI*XW)/2D0
|
|
XRQ=-EI*XW
|
|
FACQQ1=(XLQ**2+XRQ**2)*(XLL+XLR)**2/FAC1**2/PROPZ
|
|
& *(UH*TH-SQM3*SQM4)
|
|
TZC=0.0D0
|
|
IF(IA.GE.11.AND.KFID.EQ.IA+1) THEN
|
|
TZC=VMIX(1,1)**2/(TH-SMW(1)**2)+VMIX(2,1)**2/
|
|
& (TH-SMW(2)**2)
|
|
TCC=TZC**2
|
|
TZC=TZC/(1D0-XW)*(SH-SQMZ)/PROPZ+TCC
|
|
ENDIF
|
|
FACQQ2=RKF*(UH*TH-SQM3*SQM4)/4D0*TZC*COMFAC*AEM**2/XW**2
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1*FCOL*FAC0+FACQQ2
|
|
1630 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.216) THEN
|
|
C...q + qbar -> ~chi0_1 + ~chi0_1
|
|
IF(IZID1.EQ.IZID2) THEN
|
|
COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
ELSE
|
|
COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),2)
|
|
ENDIF
|
|
FACGG1=COMFAC*AEM**2/3D0/XW**2
|
|
IF(IZID1.EQ.IZID2) FACGG1=FACGG1/2D0
|
|
ZM12=SQM3
|
|
ZM22=SQM4
|
|
SR2=SQRT(2D0)
|
|
TANW=SQRT(XW/(1D0-XW))
|
|
WU2 = (UH-ZM12)*(UH-ZM22)/SH2
|
|
WT2 = (TH-ZM12)*(TH-ZM22)/SH2
|
|
XS2 = SMZ(IZID1)*SMZ(IZID2)/SH
|
|
PROPZ2 = (SH-SQMZ)**2 + SQMZ*ZWID**2
|
|
REPRPZ = (SH-SQMZ)/PROPZ2
|
|
OLPP=(-ZMIX(IZID1,3)*ZMIX(IZID2,3)+
|
|
& ZMIX(IZID1,4)*ZMIX(IZID2,4))/2D0
|
|
DO 1640 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1640
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
FCOL=1D0
|
|
IF(ABS(I).GE.11) FCOL=3D0
|
|
XLQ=(SIGN(1D0,EI)-2D0*EI*XW)/2D0
|
|
XRQ=-EI*XW
|
|
XLQ=XLQ/(1D0-XW)
|
|
XRQ=XRQ/(1D0-XW)
|
|
C...Factored out sqrt(2)
|
|
FR1=TANW*EI*ZMIX(IZID1,1)
|
|
FR2=TANW*EI*ZMIX(IZID2,1)
|
|
FL1=-(SIGN(1D0,EI)*ZMIX(IZID1,2)-TANW*
|
|
& (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID1,1))/2D0
|
|
FL2=-(SIGN(1D0,EI)*ZMIX(IZID2,2)-TANW*
|
|
& (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID2,1))/2D0
|
|
FR12=FR1**2
|
|
FR22=FR2**2
|
|
FL12=FL1**2
|
|
FL22=FL2**2
|
|
XML2=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2
|
|
XMR2=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2
|
|
FACS=OLPP**2*(XLQ**2+XRQ**2)*(WU2+WT2-2D0*XS2)*(SH2/PROPZ2)
|
|
FACT=FL12*FL22*(WT2*SH2/(TH-XML2)**2+WU2*SH2/(UH-XML2)**2-
|
|
& 2D0*XS2*SH2/(TH-XML2)/(UH-XML2))
|
|
FACU=FR12*FR22*(WT2*SH2/(TH-XMR2)**2+WU2*SH2/(UH-XMR2)**2-
|
|
& 2D0*XS2*SH2/(TH-XMR2)/(UH-XMR2))
|
|
FACST=2D0*REPRPZ*OLPP*XLQ*FL1*FL2*( (WT2-XS2)*SH2/
|
|
& (TH-XML2) + (WU2-XS2)*SH2/(UH-XML2) )
|
|
FACSU=-2D0*REPRPZ*OLPP*XRQ*FR1*FR2*( (WT2-XS2)*SH2/
|
|
& (TH-XMR2) + (WU2-XS2)*SH2/(UH-XMR2) )
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACGG1*FCOL*(FACS+FACT+FACU+FACST+FACSU)
|
|
1640 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.230) THEN
|
|
IF(ISUB.EQ.226) THEN
|
|
C...f + fbar -> ~chi+_1 + ~chi-_1
|
|
FACGG1=COMFAC*AEM**2/3D0/XW**2
|
|
ZM12=SQM3
|
|
ZM22=SQM4
|
|
WU2 = (UH-ZM12)*(UH-ZM22)/SH2
|
|
WT2 = (TH-ZM12)*(TH-ZM22)/SH2
|
|
WS2 = SMW(IZID1)*SMW(IZID2)/SH
|
|
PROPZ2 = (SH-SQMZ)**2 + SQMZ*ZWID**2
|
|
REPRPZ = (SH-SQMZ)/PROPZ2
|
|
DIFF=0D0
|
|
IF(IZID1.EQ.IZID2) DIFF=1D0
|
|
DO 1650 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1650
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
FCOL=1D0
|
|
IF(IABS(I).GE.11) FCOL=3D0
|
|
XLQ=(SIGN(1D0,EI)-2D0*EI*XW)/2D0
|
|
XRQ=-EI*XW
|
|
XLQ=XLQ/(1D0-XW)
|
|
XRQ=XRQ/(1D0-XW)
|
|
XLQ2=XLQ**2
|
|
XRQ2=XRQ**2
|
|
OLP=-VMIX(IZID1,1)*VMIX(IZID2,1)-
|
|
& VMIX(IZID1,2)*VMIX(IZID2,2)/2D0+XW*DIFF
|
|
ORP=-UMIX(IZID1,1)*UMIX(IZID2,1)-
|
|
& UMIX(IZID1,2)*UMIX(IZID2,2)/2D0+XW*DIFF
|
|
ORP2=ORP**2
|
|
OLP2=OLP**2
|
|
C...u-type quark - d-type squark
|
|
IF(MOD(I,2).EQ.0) THEN
|
|
FACT0 = UMIX(IZID1,1)*UMIX(IZID2,1)
|
|
XML2=PMAS(PYCOMP(KSUSY1+IABS(I)-1),1)**2
|
|
C...d-type quark - u-type squark
|
|
ELSE
|
|
FACT0 = VMIX(IZID1,1)*VMIX(IZID2,1)
|
|
XML2=PMAS(PYCOMP(KSUSY1+IABS(I)+1),1)**2
|
|
ENDIF
|
|
FACA=2D0*XW**2*DIFF*(WT2+WU2+2D0*ABS(WS2))*EI**2
|
|
FACZ=0.5D0*((XLQ2+XRQ2)*(OLP2+ORP2)*(WT2+WU2)+
|
|
& 4D0*(XLQ2+XRQ2)*OLP*ORP*WS2-(XLQ2-XRQ2)*(OLP2-ORP2)*
|
|
& (WU2-WT2))*SH2/PROPZ2
|
|
FACT=FACT0**2/4D0*WT2*SH2/(TH-XML2)**2
|
|
FACAZ=XW*REPRPZ*DIFF*( (XLQ+XRQ)*(OLP+ORP)*(WU2+
|
|
& WT2+2D0*ABS(WS2))-(XLQ-XRQ)*(OLP-ORP)*(WU2-WT2) )*SH*(-EI)
|
|
FACTA=XW*DIFF/(TH-XML2)*(WT2+ABS(WS2))*SH*FACT0*(-EI)
|
|
FACTZ=REPRPZ/(TH-XML2)*XLQ*FACT0*(OLP*WT2+ORP*WS2)*SH2
|
|
FACSUM=FACGG1*(FACA+FACAZ+FACZ+FACT+FACTA+FACTZ)*FCOL
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
IF(IZID1.EQ.IZID2) THEN
|
|
SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
ELSE
|
|
SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,1)),2)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,1)),3)
|
|
ENDIF
|
|
1650 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.229) THEN
|
|
C...q + qbar' -> ~chi0_1 + ~chi+-_1
|
|
FACGG1=COMFAC*AEM**2/6D0/XW**2
|
|
TANW = SQRT(XW/(1D0-XW))
|
|
ZM12=SQM3
|
|
ZM22=SQM4
|
|
ZMU2 = PMAS(PYCOMP(KSUSY1+2),1)**2
|
|
ZMD2 = PMAS(PYCOMP(KSUSY1+1),1)**2
|
|
WU2 = (UH-ZM12)*(UH-ZM22)/SH2
|
|
WT2 = (TH-ZM12)*(TH-ZM22)/SH2
|
|
WS2 = SMW(IZID1)*SMZ(IZID2)/SH
|
|
RT2I = 1D0/SQRT(2D0)
|
|
PROPW = ((SH-SQMW)**2+WWID**2*SQMW)
|
|
OL=-RT2I*ZMIX(IZID2,4)*VMIX(IZID1,2)+
|
|
& ZMIX(IZID2,2)*VMIX(IZID1,1)
|
|
OR= RT2I*ZMIX(IZID2,3)*UMIX(IZID1,2)+
|
|
& ZMIX(IZID2,2)*UMIX(IZID1,1)
|
|
OL2=OL**2
|
|
OR2=OR**2
|
|
CROSS=2D0*OL*OR
|
|
FACST0=UMIX(IZID1,1)
|
|
FACSU0=VMIX(IZID1,1)
|
|
FACSU0=FACSU0*(0.5D0*ZMIX(IZID2,2)+TANW*ZMIX(IZID2,1)/6D0)
|
|
FACST0=FACST0*(-0.5D0*ZMIX(IZID2,2)+TANW*ZMIX(IZID2,1)/6D0)
|
|
FACT0=FACST0**2
|
|
FACU0=FACSU0**2
|
|
FACTU0=FACSU0*FACST0
|
|
FACST = -2D0*(SH-SQMW)/PROPW/(TH-ZMD2)*(WT2*SH2*OR
|
|
& + SH2*WS2*OL)*FACST0
|
|
FACSU = 2D0*(SH-SQMW)/PROPW/(UH-ZMU2)*(WU2*SH2*OL
|
|
& + SH2*WS2*OR)*FACSU0
|
|
FACT = WT2*SH2/(TH-ZMD2)**2*FACT0
|
|
FACU = WU2*SH2/(UH-ZMU2)**2*FACU0
|
|
FACTU = -2D0*WS2*SH2/(TH-ZMD2)/(UH-ZMU2)*FACTU0
|
|
FACW = (OR2*WT2+OL2*WU2+CROSS*WS2)/PROPW*SH2
|
|
FACGG1=FACGG1*(FACW+FACT+FACTU+FACU+FACSU+FACST)
|
|
DO 1670 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 1670
|
|
DO 1660 J=MMIN2,MMAX2
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 1660
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1660
|
|
FCKM=3D0
|
|
IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
|
|
KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J)
|
|
KCHW=2
|
|
IF(KCHSUM.LT.0) KCHW=3
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACGG1*FCKM*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW)
|
|
1660 CONTINUE
|
|
1670 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.240) THEN
|
|
IF(ISUB.EQ.237) THEN
|
|
C...q + qbar -> gluino + ~chi0_1
|
|
COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),2)
|
|
FAC0=COMFAC*AS*AEM*4D0/9D0/XW
|
|
GM2=SQM3
|
|
ZM2=SQM4
|
|
TANW=SQRT(XW/(1D0-XW))
|
|
DO 1680 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 1680
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
IA=IABS(I)
|
|
XLQC = -TANW*EI*ZMIX(IZID,1)
|
|
XRQC =(SIGN(1D0,EI)*ZMIX(IZID,2)-TANW*
|
|
& (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID,1))/2D0
|
|
XLQ2=XLQC**2
|
|
XRQ2=XRQC**2
|
|
XML2=PMAS(PYCOMP(KSUSY1+IA),1)**2
|
|
XMR2=PMAS(PYCOMP(KSUSY2+IA),1)**2
|
|
ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XML2)**2
|
|
AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XML2)**2
|
|
ATUKIN=SMZ(IZID)*SQRT(GM2)*SH/(TH-XML2)/(UH-XML2)
|
|
SGCHIL=XLQ2*(ATKIN+AUKIN-2D0*ATUKIN)
|
|
ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XMR2)**2
|
|
AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XMR2)**2
|
|
ATUKIN=SMZ(IZID)*SQRT(GM2)*SH/(TH-XMR2)/(UH-XMR2)
|
|
SGCHIR=XRQ2*(ATKIN+AUKIN-2D0*ATUKIN)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FAC0*(SGCHIL+SGCHIR)
|
|
1680 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.250) THEN
|
|
IF(ISUB.EQ.241) THEN
|
|
C...q + qbar' -> ~chi+-_1 + gluino
|
|
FACWG=COMFAC*AS*AEM/XW*2D0/9D0
|
|
GM2=SQM3
|
|
ZM2=SQM4
|
|
FAC01=2D0*UMIX(IZID,1)*VMIX(IZID,1)
|
|
FAC0=UMIX(IZID,1)**2
|
|
FAC1=VMIX(IZID,1)**2
|
|
DO 1700 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 1700
|
|
DO 1690 J=MMIN2,MMAX2
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 1690
|
|
IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 1690
|
|
FCKM=1D0
|
|
IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2)
|
|
KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J)
|
|
KCHW=2
|
|
IF(KCHSUM.LT.0) KCHW=3
|
|
XMU2=PMAS(PYCOMP(KSUSY1+2),1)**2
|
|
XMD2=PMAS(PYCOMP(KSUSY1+1),1)**2
|
|
ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XMU2)**2
|
|
AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XMD2)**2
|
|
ATUKIN=SMW(IZID)*SQRT(GM2)*SH/(TH-XMU2)/(UH-XMD2)
|
|
XMU2=PMAS(PYCOMP(KSUSY2+2),1)**2
|
|
XMD2=PMAS(PYCOMP(KSUSY2+1),1)**2
|
|
ATKIN=(ATKIN+(TH-GM2)*(TH-ZM2)/(TH-XMU2)**2)/2D0
|
|
AUKIN=(AUKIN+(UH-GM2)*(UH-ZM2)/(UH-XMD2)**2)/2D0
|
|
ATUKIN=(ATUKIN+SMW(IZID)*SQRT(GM2)*
|
|
& SH/(TH-XMU2)/(UH-XMD2))/2D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACWG*FCKM*(FAC0*ATKIN+FAC1*AUKIN-
|
|
& FAC01*ATUKIN)*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW)
|
|
1690 CONTINUE
|
|
1700 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.243) THEN
|
|
C...q + qbar -> gluino + gluino
|
|
COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
XMT=SQM3-TH
|
|
XMU=SQM3-UH
|
|
DO 1710 I=MMINA,MMAXA
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR.
|
|
& KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1710
|
|
NCHN=NCHN+1
|
|
XSU=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2-UH
|
|
XST=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2-TH
|
|
FACGG1=COMFAC*AS**2*8D0/3D0*( (XMT**2+XMU**2+
|
|
& 2D0*SQM3*SH)/SH2 +4D0/9D0*(XMT**2/XST**2+
|
|
& XMU**2/XSU**2) - (XMT**2+SH*SQM3)/SH/XST +
|
|
& SQM3*SH/XST/XSU/9D0- (XMU**2+SH*SQM3)/SH/XSU )
|
|
XSU=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2-UH
|
|
XST=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2-TH
|
|
FACGG2=COMFAC*AS**2*8D0/3D0*( (XMT**2+XMU**2+
|
|
& 2D0*SQM3*SH)/SH2 +4D0/9D0*(XMT**2/XST**2+
|
|
& XMU**2/XSU**2) - (XMT**2+SH*SQM3)/SH/XST +
|
|
& SQM3*SH/XST/XSU/9D0- (XMU**2+SH*SQM3)/SH/XSU )
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
C...1/2 for identical particles
|
|
SIGH(NCHN)=0.25D0*(FACGG1+FACGG2)
|
|
1710 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.244) THEN
|
|
C...g + g -> gluino + gluino
|
|
COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
XMT=SQM3-TH
|
|
XMU=SQM3-UH
|
|
FACQQ1=COMFAC*AS**2*9D0/4D0*(
|
|
& (XMT*XMU-2D0*SQM3*(TH+SQM3))/XMT**2 -
|
|
& (XMT*XMU+SQM3*(UH-TH))/SH/XMT )
|
|
FACQQ2=COMFAC*AS**2*9D0/4D0*(
|
|
& (XMU*XMT-2D0*SQM3*(UH+SQM3))/XMU**2 -
|
|
& (XMU*XMT+SQM3*(TH-UH))/SH/XMU )
|
|
FACQQ3=COMFAC*AS**2*9D0/4D0*(2D0*XMT*XMU/SH2 +
|
|
& SQM3*(SH-4D0*SQM3)/XMT/XMU)
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1720
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1/2D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQQ2/2D0
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=3
|
|
SIGH(NCHN)=FACQQ3/2D0
|
|
1720 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.246) THEN
|
|
C...g + q_j -> ~chi0_1 + ~q_j
|
|
FAC0=COMFAC*AS*AEM/6D0/XW
|
|
ZM2=SQM4
|
|
QM2=SQM3
|
|
TANW=SQRT(XW/(1D0-XW))
|
|
FACZQ0=FAC0*( (ZM2-TH)/SH +
|
|
& (UH-ZM2)*(UH+QM2)/(UH-QM2)**2 -
|
|
& (SH*(UH+ZM2)+2D0*(QM2-ZM2)*(ZM2-UH))/SH/(UH-QM2) )
|
|
KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1)
|
|
DO 1740 I=-KFNSQ,KFNSQ,2*KFNSQ
|
|
IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 1740
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 1740
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
IA=IABS(I)
|
|
XRQZ = -TANW*EI*ZMIX(IZID,1)
|
|
XLQZ =(SIGN(1D0,EI)*ZMIX(IZID,2)-TANW*
|
|
& (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID,1))/2D0
|
|
IF(ILR.EQ.0) THEN
|
|
BS=XLQZ**2*SFMIX(IA,1)**2+XRQZ**2*SFMIX(IA,2)**2
|
|
ELSE
|
|
BS=XLQZ**2*SFMIX(IA,3)**2+XRQZ**2*SFMIX(IA,4)**2
|
|
ENDIF
|
|
FACZQ=FACZQ0*BS
|
|
KCHQ=2
|
|
IF(I.LT.0) KCHQ=3
|
|
DO 1730 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1730
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1730
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACZQ*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),2)
|
|
1730 CONTINUE
|
|
1740 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.260) THEN
|
|
IF(ISUB.EQ.254) THEN
|
|
C...g + q_j -> ~chi1_1 + ~q_i
|
|
FAC0=COMFAC*AS*AEM/12D0/XW
|
|
ZM2=SQM4
|
|
QM2=SQM3
|
|
AU=UMIX(IZID,1)**2
|
|
AD=VMIX(IZID,1)**2
|
|
FACZQ0=FAC0*( (ZM2-TH)/SH +
|
|
& (UH-ZM2)*(UH+QM2)/(UH-QM2)**2 -
|
|
& (SH*(UH+ZM2)+2D0*(QM2-ZM2)*(ZM2-UH))/SH/(UH-QM2) )
|
|
KFNSQ1=MOD(KFPR(ISUBSV,1),KSUSY1)
|
|
IF(MOD(KFNSQ1,2).EQ.0) THEN
|
|
KFNSQ=KFNSQ1-1
|
|
KCHW=2
|
|
ELSE
|
|
KFNSQ=KFNSQ1+1
|
|
KCHW=3
|
|
ENDIF
|
|
DO 1760 I=-KFNSQ,KFNSQ,2*KFNSQ
|
|
IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 1760
|
|
IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 1760
|
|
IA=IABS(I)
|
|
IF(MOD(IA,2).EQ.0) THEN
|
|
FACZQ=FACZQ0*AU
|
|
ELSE
|
|
FACZQ=FACZQ0*AD
|
|
ENDIF
|
|
FACZQ=FACZQ*SFMIX(KFNSQ1,1+2*ILR)**2
|
|
KCHQ=2
|
|
IF(I.LT.0) KCHQ=3
|
|
KCHWQ=KCHW
|
|
IF(I.LT.0) KCHWQ=5-KCHW
|
|
DO 1750 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1750
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1750
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACZQ*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHWQ)
|
|
1750 CONTINUE
|
|
1760 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.258) THEN
|
|
C...g + q_j -> gluino + ~q_i
|
|
XG2=SQM4
|
|
XQ2=SQM3
|
|
XMT=XG2-TH
|
|
XMU=XG2-UH
|
|
XST=XQ2-TH
|
|
XSU=XQ2-UH
|
|
FACQG1=0.5D0*4D0/9D0*XMT/SH + (XMT*SH+2D0*XG2*XST)/XMT**2 -
|
|
& ( (SH-XQ2+XG2)*(-XST)-SH*XG2 )/SH/(-XMT) +
|
|
& 0.5D0*1D0/2D0*( XST*(TH+2D0*UH+XG2)-XMT*(SH-2D0*XST) +
|
|
& (-XMU)*(TH+XG2+2D0*XQ2) )/2D0/XMT/XSU
|
|
FACQG2= 4D0/9D0*(-XMU)*(UH+XQ2)/XSU**2 + 1D0/18D0*
|
|
& (SH*(UH+XG2)
|
|
& +2D0*(XQ2-XG2)*XMU)/SH/(-XSU) + 0.5D0*4D0/9D0*XMT/SH +
|
|
& 0.5D0*1D0/2D0*(XST*(TH+2D0*UH+XG2)-XMT*(SH-2D0*XST)+
|
|
& (-XMU)*(TH+XG2+2D0*XQ2))/2D0/XMT/XSU
|
|
FACQG1=COMFAC*AS**2*FACQG1/2D0
|
|
FACQG2=COMFAC*AS**2*FACQG2/2D0
|
|
KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1)
|
|
DO 1780 I=-KFNSQ,KFNSQ,2*KFNSQ
|
|
IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 1780
|
|
IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 1780
|
|
KCHQ=2
|
|
IF(I.LT.0) KCHQ=3
|
|
FACSEL=RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),2)
|
|
DO 1770 ISDE=1,2
|
|
IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 1770
|
|
IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 1770
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQG1*FACSEL
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,ISDE)=I
|
|
ISIG(NCHN,3-ISDE)=21
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQG2*FACSEL
|
|
1770 CONTINUE
|
|
1780 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.270) THEN
|
|
IF(ISUB.EQ.261) THEN
|
|
C...q_i + q_ibar -> ~t_1 + ~t_1bar
|
|
FACQQ1=COMFAC*( (UH*TH-SQM3*SQM4)/ SH**2 )*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1)
|
|
FAC0=AS**2*4D0/9D0
|
|
DO 1790 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1790
|
|
IF(IA.GE.11.AND.IA.LE.18) THEN
|
|
EI=KCHG(IA,1)/3D0
|
|
EJ=KCHG(KFNSQ,1)/3D0
|
|
T3I=SIGN(1D0,EI)/2D0
|
|
T3J=SIGN(1D0,EJ)/2D0
|
|
XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,2*ILR+1)**2
|
|
XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,2*ILR+2)**2
|
|
XLF=2D0*(T3I-EI*XW)
|
|
XRF=2D0*(-EI*XW)
|
|
TAA=0.5D0*(EI*EJ)**2
|
|
TZZ=(XLF**2+XRF**2)*(XLQ+XRQ)**2/64D0/XW**2/(1D0-XW)**2
|
|
TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)
|
|
TAZ=EI*EJ*(XLQ+XRQ)*(XLF+XRF)/8D0/XW/(1D0-XW)
|
|
TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH)
|
|
FAC0=AEM**2*12D0*(TAA+TZZ+TAZ)
|
|
ENDIF
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1*FAC0
|
|
1790 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.263) THEN
|
|
C...f + fbar -> ~t1 + ~t2bar
|
|
DO 1800 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1800
|
|
EI=KCHG(IABS(I),1)/3D0
|
|
TT3I=SIGN(1D0,EI)/2D0
|
|
EJ=2D0/3D0
|
|
TT3J=1D0/2D0
|
|
FCOL=1D0
|
|
C...Color factor for e+ e-
|
|
IF(IA.GE.11) FCOL=3D0
|
|
XLQ=2D0*(TT3J-EJ*XW)
|
|
XRQ=2D0*(-EJ*XW)
|
|
XLF=2D0*(TT3I-EI*XW)
|
|
XRF=2D0*(-EI*XW)
|
|
TZZ=(XLF**2+XRF**2)*(XLQ-XRQ)**2/64D0/XW**2/(1D0-XW)**2
|
|
TZZ=TZZ*(SFMIX(6,1)*SFMIX(6,2))**2
|
|
TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)
|
|
C...Factor of 2 for t1 t2bar + t2 t1bar
|
|
FACQQ1=2D0*COMFAC*AEM**2*TZZ*FCOL*4D0
|
|
FACQQ1=FACQQ1*( UH*TH-SQM3*SQM4 )/SH2
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),3)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQQ1*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),2)
|
|
1800 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.264) THEN
|
|
C...g + g -> ~t_1 + ~t_1bar
|
|
XSU=SQM3-UH
|
|
XST=SQM3-TH
|
|
FAC0=COMFAC*AS**2*(7D0/48D0+3D0*(UH-TH)**2/16D0/SH2 )*0.5D0*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
FACQQ1=FAC0*(0.5D0+2D0*SQM3*TH/XST**2 + 2D0*SQM3**2/XSU/XST)
|
|
FACQQ2=FAC0*(0.5D0+2D0*SQM3*UH/XSU**2 + 2D0*SQM3**2/XSU/XST)
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1810
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQQ2
|
|
1810 CONTINUE
|
|
ENDIF
|
|
|
|
ELSEIF(ISUB.LE.280) THEN
|
|
IF(ISUB.EQ.271) THEN
|
|
C...q + q' -> ~q + ~q' (~g exchange)
|
|
XMG2=PMAS(PYCOMP(KSUSY1+21),1)**2
|
|
XMT=XMG2-TH
|
|
XMU=XMG2-UH
|
|
XSU1=SQM3-UH
|
|
XSU2=SQM4-UH
|
|
XST1=SQM3-TH
|
|
XST2=SQM4-TH
|
|
IF(ILR.EQ.1) THEN
|
|
FACQQ1=COMFAC*AS**2*4D0/9D0*( -(XST1*XST2+SH*TH)/XMT**2 )
|
|
FACQQ2=COMFAC*AS**2*4D0/9D0*( -(XSU1*XSU2+SH*UH)/XMU**2 )
|
|
FACQQB=0.0D0
|
|
ELSE
|
|
FACQQ1=0.5D0*COMFAC*AS**2*4D0/9D0*( SH*XMG2/XMT**2 )
|
|
FACQQ2=0.5D0*COMFAC*AS**2*4D0/9D0*( SH*XMG2/XMU**2 )
|
|
FACQQB=0.5D0*COMFAC*AS**2*4D0/9D0*( -2D0*SH*XMG2/3D0/
|
|
& XMT/XMU )
|
|
ENDIF
|
|
KFNSQI=MOD(KFPR(ISUBSV,1),KSUSY1)
|
|
KFNSQJ=MOD(KFPR(ISUBSV,2),KSUSY1)
|
|
DO 1830 I=-KFNSQI,KFNSQI,2*KFNSQI
|
|
IF(I.LT.MMIN1.OR.I.GT.MMAX1) GOTO 1830
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 1830
|
|
KCHQ=2
|
|
IF(I.LT.0) KCHQ=3
|
|
DO 1820 J=-KFNSQJ,KFNSQJ,2*KFNSQJ
|
|
IF(J.LT.MMIN2.OR.J.GT.MMAX2) GOTO 1820
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 1820
|
|
IF(I*J.LT.0) GOTO 1820
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ)
|
|
IF(I.EQ.J) THEN
|
|
IF(ISUBSV.LE.272) THEN
|
|
SIGH(NCHN)=(FACQQ1+0.5D0*FACQQB)*RKF*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ+2)
|
|
ELSE
|
|
SIGH(NCHN)=(FACQQ1+0.5D0*FACQQB)*RKF*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ)
|
|
ENDIF
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=2
|
|
IF(ISUBSV.LE.272) THEN
|
|
SIGH(NCHN)=(FACQQ2+0.5D0*FACQQB)*RKF*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ+2)
|
|
ELSE
|
|
SIGH(NCHN)=(FACQQ2+0.5D0*FACQQB)*RKF*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ)
|
|
ENDIF
|
|
ENDIF
|
|
1820 CONTINUE
|
|
1830 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.274) THEN
|
|
C...q + qbar -> ~q' + ~qbar'
|
|
XMG2=PMAS(PYCOMP(KSUSY1+21),1)**2
|
|
XMT=XMG2-TH
|
|
XMU=XMG2-UH
|
|
IF(ILR.EQ.0) THEN
|
|
FACQQ1=COMFAC*AS**2*4D0/9D0*(
|
|
& (UH*TH-SQM3*SQM4)/XMT**2 )
|
|
FACQQB=COMFAC*AS**2*4D0/9D0*(
|
|
& (UH*TH-SQM3*SQM4)/SH2*(2D0-2D0/3D0*SH/XMT**2))
|
|
FACQQB=FACQQB+FACQQ1
|
|
ELSE
|
|
FACQQ1=COMFAC*AS**2*4D0/9D0*( XMG2*SH/XMT**2 )
|
|
FACQQB=FACQQ1
|
|
ENDIF
|
|
KFNSQI=MOD(KFPR(ISUBSV,1),KSUSY1)
|
|
KFNSQJ=MOD(KFPR(ISUBSV,2),KSUSY1)
|
|
DO 1850 I=-KFNSQI,KFNSQI,2*KFNSQI
|
|
IF(I.LT.MMIN1.OR.I.GT.MMAX1) GOTO 1850
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 1850
|
|
KCHQ=2
|
|
IF(I.LT.0) KCHQ=3
|
|
DO 1840 J=-KFNSQJ,KFNSQJ,2*KFNSQJ
|
|
IF(J.LT.MMIN2.OR.J.GT.MMAX2) GOTO 1840
|
|
JA=IABS(J)
|
|
IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 1840
|
|
IF(I*J.GT.0) GOTO 1840
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=J
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,2)),5-KCHQ)
|
|
IF(I.EQ.-J) SIGH(NCHN)=FACQQB*RKF*
|
|
& WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
1840 CONTINUE
|
|
1850 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.277) THEN
|
|
C...q_i + q_ibar -> ~q_j + ~q_jbar ,i .ne. j
|
|
C...if i .eq. j covered in 274
|
|
FACQQ1=COMFAC*( (UH*TH-SQM3*SQM4)/ SH**2 )
|
|
KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1)
|
|
FAC0=0D0
|
|
DO 1860 I=MMIN1,MMAX1
|
|
IA=IABS(I)
|
|
IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.
|
|
& KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 1860
|
|
IF(IA.EQ.KFNSQ) GOTO 1860
|
|
IF(IA.EQ.11.OR.IA.EQ.13.OR.IA.EQ.15) THEN
|
|
EI=KCHG(IA,1)/3D0
|
|
EJ=KCHG(KFNSQ,1)/3D0
|
|
T3J=SIGN(0.5D0,EJ)
|
|
T3I=SIGN(1D0,EI)/2D0
|
|
IF(ILR.EQ.0) THEN
|
|
XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,1)
|
|
XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,2)
|
|
ELSE
|
|
XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,3)
|
|
XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,4)
|
|
ENDIF
|
|
XLF=2D0*(T3I-EI*XW)
|
|
XRF=2D0*(-EI*XW)
|
|
IF(ILR.EQ.0) THEN
|
|
XRQ=0D0
|
|
ELSE
|
|
XLQ=0D0
|
|
ENDIF
|
|
TAA=0.5D0*(EI*EJ)**2
|
|
TZZ=(XLF**2+XRF**2)*(XLQ+XRQ)**2/64D0/XW**2/(1D0-XW)**2
|
|
TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)
|
|
TAZ=EI*EJ*(XLQ+XRQ)*(XLF+XRF)/8D0/XW/(1D0-XW)
|
|
TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH)
|
|
FAC0=AEM**2*12D0*(TAA+TZZ+TAZ)
|
|
ELSEIF(IA.LE.6) THEN
|
|
FAC0=AS**2*8D0/9D0/2D0
|
|
ENDIF
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=I
|
|
ISIG(NCHN,2)=-I
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1*FAC0*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
1860 CONTINUE
|
|
|
|
ELSEIF(ISUB.EQ.279) THEN
|
|
C...g + g -> ~q_j + ~q_jbar
|
|
XSU=SQM3-UH
|
|
XST=SQM3-TH
|
|
C...5=RKF because ~t ~tbar treated separately
|
|
FAC0=RKF*COMFAC*AS**2*( 7D0/48D0+3D0*(UH-TH)**2/16D0/SH2 )
|
|
FACQQ1=FAC0*(0.5D0+2D0*SQM3*TH/XST**2 + 2D0*SQM3**2/XSU/XST)
|
|
FACQQ2=FAC0*(0.5D0+2D0*SQM3*UH/XSU**2 + 2D0*SQM3**2/XSU/XST)
|
|
IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 1870
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=1
|
|
SIGH(NCHN)=FACQQ1/2D0*WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
NCHN=NCHN+1
|
|
ISIG(NCHN,1)=21
|
|
ISIG(NCHN,2)=21
|
|
ISIG(NCHN,3)=2
|
|
SIGH(NCHN)=FACQQ2/2D0*WIDS(PYCOMP(KFPR(ISUBSV,1)),1)
|
|
1870 CONTINUE
|
|
|
|
ENDIF
|
|
CMRENNA--
|
|
ENDIF
|
|
|
|
C...Multiply with parton distributions
|
|
IF(ISUB.LE.90.OR.ISUB.GE.96) THEN
|
|
DO 1880 ICHN=1,NCHN
|
|
IF(MINT(45).GE.2) THEN
|
|
KFL1=ISIG(ICHN,1)
|
|
SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1)
|
|
ENDIF
|
|
IF(MINT(46).GE.2) THEN
|
|
KFL2=ISIG(ICHN,2)
|
|
SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2)
|
|
ENDIF
|
|
SIGS=SIGS+SIGH(ICHN)
|
|
1880 CONTINUE
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPDFU
|
|
C...Gives electron, photon, pi+, neutron, proton and hyperon
|
|
C...parton distributions according to a few different parametrizations.
|
|
C...Note that what is coded is x times the probability distribution,
|
|
C...i.e. xq(x,Q2) etc.
|
|
|
|
SUBROUTINE PYPDFU(KF,X,Q2,XPQ)
|
|
|
|
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/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYINT1/MINT(400),VINT(400)
|
|
COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
|
|
&XPDIR(-6:6)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT8/
|
|
C...Local arrays.
|
|
DIMENSION XPQ(-25:25),XPEL(-25:25),XPGA(-6:6),VXPGA(-6:6),
|
|
&XPPI(-6:6),XPPR(-6:6)
|
|
|
|
C...Interface to PDFLIB.
|
|
COMMON/W50513/XMIN,XMAX,Q2MIN,Q2MAX
|
|
SAVE /W50513/
|
|
DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU,
|
|
&VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX
|
|
CHARACTER*20 PARM(20)
|
|
DATA VALUE/20*0D0/,PARM/20*' '/
|
|
|
|
C...Data related to Schuler-Sjostrand photon distributions.
|
|
DATA ALAMGA/0.2D0/, PMCGA/1.3D0/, PMBGA/4.6D0/
|
|
|
|
C...Reset parton distributions.
|
|
MINT(92)=0
|
|
DO 100 KFL=-25,25
|
|
XPQ(KFL)=0D0
|
|
100 CONTINUE
|
|
|
|
C...Check x and particle species.
|
|
IF(X.LE.0D0.OR.X.GE.1D0) THEN
|
|
WRITE(MSTU(11),5000) X
|
|
RETURN
|
|
ENDIF
|
|
KFA=IABS(KF)
|
|
IF(KFA.NE.11.AND.KFA.NE.22.AND.KFA.NE.211.AND.KFA.NE.2112.AND.
|
|
&KFA.NE.2212.AND.KFA.NE.3122.AND.KFA.NE.3112.AND.KFA.NE.3212
|
|
&.AND.KFA.NE.3222.AND.KFA.NE.3312.AND.KFA.NE.3322.AND.
|
|
&KFA.NE.3334.AND.KFA.NE.111) THEN
|
|
WRITE(MSTU(11),5100) KF
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Electron parton distribution call.
|
|
IF(KFA.EQ.11) THEN
|
|
CALL PYPDEL(X,Q2,XPEL)
|
|
DO 110 KFL=-25,25
|
|
XPQ(KFL)=XPEL(KFL)
|
|
110 CONTINUE
|
|
|
|
C...Photon parton distribution call (VDM+anomalous).
|
|
ELSEIF(KFA.EQ.22.AND.MINT(109).LE.1) THEN
|
|
IF(MSTP(56).EQ.1.AND.MSTP(55).EQ.1) THEN
|
|
CALL PYPDGA(X,Q2,XPGA)
|
|
DO 120 KFL=-6,6
|
|
XPQ(KFL)=XPGA(KFL)
|
|
120 CONTINUE
|
|
ELSEIF(MSTP(56).EQ.1.AND.MSTP(55).GE.5.AND.MSTP(55).LE.8) THEN
|
|
Q2MX=Q2
|
|
P2MX=0.36D0
|
|
IF(MSTP(55).GE.7) P2MX=4.0D0
|
|
IF(MSTP(57).EQ.0) Q2MX=P2MX
|
|
CALL PYGGAM(MSTP(55)-4,X,Q2MX,0D0,MSTP(60),F2GAM,XPGA)
|
|
DO 130 KFL=-6,6
|
|
XPQ(KFL)=XPGA(KFL)
|
|
130 CONTINUE
|
|
VINT(231)=P2MX
|
|
ELSEIF(MSTP(56).EQ.1.AND.MSTP(55).GE.9.AND.MSTP(55).LE.12) THEN
|
|
Q2MX=Q2
|
|
P2MX=0.36D0
|
|
IF(MSTP(55).GE.11) P2MX=4.0D0
|
|
IF(MSTP(57).EQ.0) Q2MX=P2MX
|
|
CALL PYGGAM(MSTP(55)-8,X,Q2MX,0D0,MSTP(60),F2GAM,XPGA)
|
|
DO 140 KFL=-6,6
|
|
XPQ(KFL)=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL)
|
|
140 CONTINUE
|
|
VINT(231)=P2MX
|
|
ELSEIF(MSTP(56).EQ.2) THEN
|
|
C...Call PDFLIB parton distributions.
|
|
PARM(1)='NPTYPE'
|
|
VALUE(1)=3
|
|
PARM(2)='NGROUP'
|
|
VALUE(2)=MSTP(55)/1000
|
|
PARM(3)='NSET'
|
|
VALUE(3)=MOD(MSTP(55),1000)
|
|
IF(MINT(93).NE.3000000+MSTP(55)) THEN
|
|
CALL PDFSET(PARM,VALUE)
|
|
MINT(93)=3000000+MSTP(55)
|
|
ENDIF
|
|
XX=X
|
|
QQ=SQRT(MAX(0D0,Q2MIN,Q2))
|
|
IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN)
|
|
CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU)
|
|
VINT(231)=Q2MIN
|
|
XPQ(0)=GLU
|
|
XPQ(1)=DNV
|
|
XPQ(-1)=DNV
|
|
XPQ(2)=UPV
|
|
XPQ(-2)=UPV
|
|
XPQ(3)=STR
|
|
XPQ(-3)=STR
|
|
XPQ(4)=CHM
|
|
XPQ(-4)=CHM
|
|
XPQ(5)=BOT
|
|
XPQ(-5)=BOT
|
|
XPQ(6)=TOP
|
|
XPQ(-6)=TOP
|
|
ELSE
|
|
WRITE(MSTU(11),5200) KF,MSTP(56),MSTP(55)
|
|
ENDIF
|
|
|
|
C...Pion/gammaVDM parton distribution call.
|
|
ELSEIF(KFA.EQ.211.OR.KFA.EQ.111.OR.(KFA.EQ.22.AND.
|
|
& MINT(109).EQ.2)) THEN
|
|
IF(KFA.EQ.22.AND.MSTP(56).EQ.1.AND.MSTP(55).GE.5.AND.
|
|
& MSTP(55).LE.12) THEN
|
|
ISET=1+MOD(MSTP(55)-1,4)
|
|
Q2MX=Q2
|
|
P2MX=0.36D0
|
|
IF(ISET.GE.3) P2MX=4.0D0
|
|
IF(MSTP(57).EQ.0) Q2MX=P2MX
|
|
CALL PYGVMD(ISET,2,X,Q2MX,P2MX,ALAMGA,XPGA,VXPGA)
|
|
DO 150 KFL=-6,6
|
|
XPQ(KFL)=XPGA(KFL)
|
|
150 CONTINUE
|
|
VINT(231)=P2MX
|
|
ELSEIF(MSTP(54).EQ.1.AND.MSTP(53).GE.1.AND.MSTP(53).LE.3) THEN
|
|
CALL PYPDPI(X,Q2,XPPI)
|
|
DO 160 KFL=-6,6
|
|
XPQ(KFL)=XPPI(KFL)
|
|
160 CONTINUE
|
|
ELSEIF(MSTP(54).EQ.2) THEN
|
|
C...Call PDFLIB parton distributions.
|
|
PARM(1)='NPTYPE'
|
|
VALUE(1)=2
|
|
PARM(2)='NGROUP'
|
|
VALUE(2)=MSTP(53)/1000
|
|
PARM(3)='NSET'
|
|
VALUE(3)=MOD(MSTP(53),1000)
|
|
IF(MINT(93).NE.2000000+MSTP(53)) THEN
|
|
CALL PDFSET(PARM,VALUE)
|
|
MINT(93)=2000000+MSTP(53)
|
|
ENDIF
|
|
XX=X
|
|
QQ=SQRT(MAX(0D0,Q2MIN,Q2))
|
|
IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN)
|
|
CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU)
|
|
VINT(231)=Q2MIN
|
|
XPQ(0)=GLU
|
|
XPQ(1)=DSEA
|
|
XPQ(-1)=UPV+DSEA
|
|
XPQ(2)=UPV+USEA
|
|
XPQ(-2)=USEA
|
|
XPQ(3)=STR
|
|
XPQ(-3)=STR
|
|
XPQ(4)=CHM
|
|
XPQ(-4)=CHM
|
|
XPQ(5)=BOT
|
|
XPQ(-5)=BOT
|
|
XPQ(6)=TOP
|
|
XPQ(-6)=TOP
|
|
ELSE
|
|
WRITE(MSTU(11),5200) KF,MSTP(54),MSTP(53)
|
|
ENDIF
|
|
|
|
C...Anomalous photon parton distribution call.
|
|
ELSEIF(KFA.EQ.22.AND.MINT(109).EQ.3) THEN
|
|
Q2MX=Q2
|
|
P2MX=PARP(15)**2
|
|
IF(MSTP(56).EQ.1.AND.MSTP(55).LE.8) THEN
|
|
IF(MSTP(55).EQ.5.OR.MSTP(55).EQ.6) P2MX=0.36D0
|
|
IF(MSTP(55).EQ.7.OR.MSTP(55).EQ.8) P2MX=4.0D0
|
|
IF(MSTP(57).EQ.0) Q2MX=P2MX
|
|
CALL PYGANO(0,X,Q2MX,P2MX,ALAMGA,XPGA,VXPGA)
|
|
DO 170 KFL=-6,6
|
|
XPQ(KFL)=XPGA(KFL)
|
|
170 CONTINUE
|
|
VINT(231)=P2MX
|
|
ELSEIF(MSTP(56).EQ.1) THEN
|
|
IF(MSTP(55).EQ.9.OR.MSTP(55).EQ.10) P2MX=0.36D0
|
|
IF(MSTP(55).EQ.11.OR.MSTP(55).EQ.12) P2MX=4.0D0
|
|
IF(MSTP(57).EQ.0) Q2MX=P2MX
|
|
CALL PYGGAM(MSTP(55)-8,X,Q2MX,0D0,MSTP(60),F2GM,XPGA)
|
|
DO 180 KFL=-6,6
|
|
XPQ(KFL)=MAX(0D0,XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL))
|
|
180 CONTINUE
|
|
VINT(231)=P2MX
|
|
ELSEIF(MSTP(56).EQ.2) THEN
|
|
IF(MSTP(57).EQ.0) Q2MX=P2MX
|
|
CALL PYGANO(0,X,Q2MX,P2MX,ALAMGA,XPGA,VXPGA)
|
|
DO 190 KFL=-6,6
|
|
XPQ(KFL)=XPGA(KFL)
|
|
190 CONTINUE
|
|
VINT(231)=P2MX
|
|
ELSEIF(MSTP(55).GE.1.AND.MSTP(55).LE.5) THEN
|
|
IF(MSTP(57).EQ.0) Q2MX=P2MX
|
|
CALL PYGVMD(0,MSTP(55),X,Q2MX,P2MX,PARP(1),XPGA,VXPGA)
|
|
DO 200 KFL=-6,6
|
|
XPQ(KFL)=XPGA(KFL)
|
|
200 CONTINUE
|
|
VINT(231)=P2MX
|
|
ELSE
|
|
210 RKF=11D0*PYR(0)
|
|
KFR=1
|
|
IF(RKF.GT.1D0) KFR=2
|
|
IF(RKF.GT.5D0) KFR=3
|
|
IF(RKF.GT.6D0) KFR=4
|
|
IF(RKF.GT.10D0) KFR=5
|
|
IF(KFR.EQ.4.AND.Q2.LT.PMCGA**2) GOTO 210
|
|
IF(KFR.EQ.5.AND.Q2.LT.PMBGA**2) GOTO 210
|
|
IF(MSTP(57).EQ.0) Q2MX=P2MX
|
|
CALL PYGVMD(0,KFR,X,Q2MX,P2MX,PARP(1),XPGA,VXPGA)
|
|
DO 220 KFL=-6,6
|
|
XPQ(KFL)=XPGA(KFL)
|
|
220 CONTINUE
|
|
VINT(231)=P2MX
|
|
ENDIF
|
|
|
|
C...Proton parton distribution call.
|
|
ELSE
|
|
IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.11) THEN
|
|
CALL PYPDPR(X,Q2,XPPR)
|
|
DO 230 KFL=-6,6
|
|
XPQ(KFL)=XPPR(KFL)
|
|
230 CONTINUE
|
|
ELSEIF(MSTP(52).EQ.2) THEN
|
|
C...Call PDFLIB parton distributions.
|
|
PARM(1)='NPTYPE'
|
|
VALUE(1)=1
|
|
PARM(2)='NGROUP'
|
|
VALUE(2)=MSTP(51)/1000
|
|
PARM(3)='NSET'
|
|
VALUE(3)=MOD(MSTP(51),1000)
|
|
IF(MINT(93).NE.1000000+MSTP(51)) THEN
|
|
CALL PDFSET(PARM,VALUE)
|
|
MINT(93)=1000000+MSTP(51)
|
|
ENDIF
|
|
XX=X
|
|
QQ=SQRT(MAX(0D0,Q2MIN,Q2))
|
|
IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN)
|
|
CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU)
|
|
VINT(231)=Q2MIN
|
|
XPQ(0)=GLU
|
|
XPQ(1)=DNV+DSEA
|
|
XPQ(-1)=DSEA
|
|
XPQ(2)=UPV+USEA
|
|
XPQ(-2)=USEA
|
|
XPQ(3)=STR
|
|
XPQ(-3)=STR
|
|
XPQ(4)=CHM
|
|
XPQ(-4)=CHM
|
|
XPQ(5)=BOT
|
|
XPQ(-5)=BOT
|
|
XPQ(6)=TOP
|
|
XPQ(-6)=TOP
|
|
ELSE
|
|
WRITE(MSTU(11),5200) KF,MSTP(52),MSTP(51)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Isospin average for pi0/gammaVDM.
|
|
IF(KFA.EQ.111.OR.(KFA.EQ.22.AND.MINT(109).EQ.2)) THEN
|
|
IF(KFA.EQ.22.AND.MSTP(55).GE.5.AND.MSTP(55).LE.12) THEN
|
|
XPV=XPQ(2)-XPQ(1)
|
|
XPQ(2)=XPQ(1)
|
|
XPQ(-2)=XPQ(-1)
|
|
ELSE
|
|
XPS=0.5D0*(XPQ(1)+XPQ(-2))
|
|
XPV=0.5D0*(XPQ(2)+XPQ(-1))-XPS
|
|
XPQ(2)=XPS
|
|
XPQ(-1)=XPS
|
|
ENDIF
|
|
IF(KFA.EQ.22.AND.MINT(105).LE.223) THEN
|
|
XPQ(1)=XPQ(1)+0.2D0*XPV
|
|
XPQ(-1)=XPQ(-1)+0.2D0*XPV
|
|
XPQ(2)=XPQ(2)+0.8D0*XPV
|
|
XPQ(-2)=XPQ(-2)+0.8D0*XPV
|
|
ELSEIF(KFA.EQ.22.AND.MINT(105).EQ.333) THEN
|
|
XPQ(3)=XPQ(3)+XPV
|
|
XPQ(-3)=XPQ(-3)+XPV
|
|
ELSEIF(KFA.EQ.22.AND.MINT(105).EQ.443) THEN
|
|
XPQ(4)=XPQ(4)+XPV
|
|
XPQ(-4)=XPQ(-4)+XPV
|
|
IF(MSTP(55).GE.9) THEN
|
|
DO 240 KFL=-6,6
|
|
XPQ(KFL)=0D0
|
|
240 CONTINUE
|
|
ENDIF
|
|
ELSE
|
|
XPQ(1)=XPQ(1)+0.5D0*XPV
|
|
XPQ(-1)=XPQ(-1)+0.5D0*XPV
|
|
XPQ(2)=XPQ(2)+0.5D0*XPV
|
|
XPQ(-2)=XPQ(-2)+0.5D0*XPV
|
|
ENDIF
|
|
|
|
C...Rescale for gammaVDM by effective gamma -> rho coupling.
|
|
IF(KFA.EQ.22.AND.MINT(109).EQ.2) THEN
|
|
DO 250 KFL=-6,6
|
|
XPQ(KFL)=VINT(281)*XPQ(KFL)
|
|
250 CONTINUE
|
|
VINT(232)=VINT(281)*XPV
|
|
ENDIF
|
|
|
|
C...Isospin conjugation for neutron.
|
|
ELSEIF(KFA.EQ.2112) THEN
|
|
XPS=XPQ(1)
|
|
XPQ(1)=XPQ(2)
|
|
XPQ(2)=XPS
|
|
XPS=XPQ(-1)
|
|
XPQ(-1)=XPQ(-2)
|
|
XPQ(-2)=XPS
|
|
|
|
C...Simple recipes for hyperon (average valence parton distribution).
|
|
ELSEIF(KFA.EQ.3122.OR.KFA.EQ.3112.OR.KFA.EQ.3212.OR.KFA.EQ.3222
|
|
& .OR.KFA.EQ.3312.OR.KFA.EQ.3322.OR.KFA.EQ.3334) THEN
|
|
XPVAL=(XPQ(1)+XPQ(2)-XPQ(-1)-XPQ(-2))/3D0
|
|
XPSEA=0.5D0*(XPQ(-1)+XPQ(-2))
|
|
XPQ(1)=XPSEA
|
|
XPQ(2)=XPSEA
|
|
XPQ(-1)=XPSEA
|
|
XPQ(-2)=XPSEA
|
|
XPQ(KFA/1000)=XPQ(KFA/1000)+XPVAL
|
|
XPQ(MOD(KFA/100,10))=XPQ(MOD(KFA/100,10))+XPVAL
|
|
XPQ(MOD(KFA/10,10))=XPQ(MOD(KFA/10,10))+XPVAL
|
|
ENDIF
|
|
|
|
C...Charge conjugation for antiparticle.
|
|
IF(KF.LT.0) THEN
|
|
DO 260 KFL=1,25
|
|
IF(KFL.EQ.21.OR.KFL.EQ.22.OR.KFL.EQ.23.OR.KFL.EQ.25) GOTO 260
|
|
XPS=XPQ(KFL)
|
|
XPQ(KFL)=XPQ(-KFL)
|
|
XPQ(-KFL)=XPS
|
|
260 CONTINUE
|
|
ENDIF
|
|
|
|
C...Allow gluon also in position 21.
|
|
XPQ(21)=XPQ(0)
|
|
|
|
C...Check positivity and reset above maximum allowed flavour.
|
|
DO 270 KFL=-25,25
|
|
XPQ(KFL)=MAX(0D0,XPQ(KFL))
|
|
IF(IABS(KFL).GT.MSTP(58).AND.IABS(KFL).LE.8) XPQ(KFL)=0D0
|
|
270 CONTINUE
|
|
|
|
C...Formats for error printouts.
|
|
5000 FORMAT(' Error: x value outside physical range; x =',1P,D12.3)
|
|
5100 FORMAT(' Error: illegal particle code for parton distribution;',
|
|
&' KF =',I5)
|
|
5200 FORMAT(' Error: unknown parton distribution; KF, library, set =',
|
|
&3I5)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPDFL
|
|
C...Gives proton parton distribution at small x and/or Q^2 according to
|
|
C...correct limiting behaviour.
|
|
|
|
SUBROUTINE PYPDFL(KF,X,Q2,XPQ)
|
|
|
|
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/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYINT1/MINT(400),VINT(400)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/
|
|
C...Local arrays.
|
|
DIMENSION XPQ(-25:25),XPA(-25:25),XPB(-25:25),WTSB(-3:3)
|
|
DATA RMR/0.92D0/,RMP/0.38D0/,WTSB/0.5D0,1D0,1D0,5D0,1D0,1D0,0.5D0/
|
|
|
|
C...Send everything but protons/neutrons/VMD pions directly to PYPDFU.
|
|
MINT(92)=0
|
|
KFA=IABS(KF)
|
|
IACC=0
|
|
IF((KFA.EQ.2212.OR.KFA.EQ.2112).AND.MSTP(57).GE.2) IACC=1
|
|
IF(KFA.EQ.211.AND.MSTP(57).GE.3) IACC=1
|
|
IF(KFA.EQ.22.AND.MINT(109).EQ.2.AND.MSTP(57).GE.3) IACC=1
|
|
IF(IACC.EQ.0) THEN
|
|
CALL PYPDFU(KF,X,Q2,XPQ)
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Reset. Check x.
|
|
DO 100 KFL=-25,25
|
|
XPQ(KFL)=0D0
|
|
100 CONTINUE
|
|
IF(X.LE.0D0.OR.X.GE.1D0) THEN
|
|
WRITE(MSTU(11),5000) X
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Define valence content.
|
|
KFC=KF
|
|
NV1=2
|
|
NV2=1
|
|
IF(KF.EQ.2212) THEN
|
|
KFV1=2
|
|
KFV2=1
|
|
ELSEIF(KF.EQ.-2212) THEN
|
|
KFV1=-2
|
|
KFV2=-1
|
|
ELSEIF(KF.EQ.2112) THEN
|
|
KFV1=1
|
|
KFV2=2
|
|
ELSEIF(KF.EQ.-2112) THEN
|
|
KFV1=-1
|
|
KFV2=-2
|
|
ELSEIF(KF.EQ.211) THEN
|
|
NV1=1
|
|
KFV1=2
|
|
KFV2=-1
|
|
ELSEIF(KF.EQ.-211) THEN
|
|
NV1=1
|
|
KFV1=-2
|
|
KFV2=1
|
|
ELSEIF(MINT(105).LE.223) THEN
|
|
KFV1=1
|
|
WTV1=0.2D0
|
|
KFV2=2
|
|
WTV2=0.8D0
|
|
ELSEIF(MINT(105).EQ.333) THEN
|
|
KFV1=3
|
|
WTV1=1.0D0
|
|
KFV2=1
|
|
WTV2=0.0D0
|
|
ELSEIF(MINT(105).EQ.443) THEN
|
|
KFV1=4
|
|
WTV1=1.0D0
|
|
KFV2=1
|
|
WTV2=0.0D0
|
|
ENDIF
|
|
|
|
C...Do naive evaluation and find min Q^2, boundary Q^2 and x_0.
|
|
CALL PYPDFU(KFC,X,Q2,XPA)
|
|
Q2MN=MAX(3D0,VINT(231))
|
|
Q2B=2D0+0.052D0**2*EXP(3.56D0*SQRT(MAX(0D0,-LOG(3D0*X))))
|
|
XMN=EXP(-(LOG((Q2MN-2D0)/0.052D0**2)/3.56D0)**2)/3D0
|
|
|
|
C...Large Q2 and large x: naive call is enough.
|
|
IF(Q2.GT.Q2MN.AND.Q2.GT.Q2B) THEN
|
|
DO 110 KFL=-25,25
|
|
XPQ(KFL)=XPA(KFL)
|
|
110 CONTINUE
|
|
MINT(92)=1
|
|
|
|
C...Small Q2 and large x: dampen boundary value.
|
|
ELSEIF(X.GT.XMN) THEN
|
|
|
|
C...Evaluate at boundary and define dampening factors.
|
|
CALL PYPDFU(KFC,X,Q2MN,XPA)
|
|
FV=(Q2*(Q2MN+RMR)/(Q2MN*(Q2+RMR)))**(0.55D0*(1D0-X)/(1D0-XMN))
|
|
FS=(Q2*(Q2MN+RMP)/(Q2MN*(Q2+RMP)))**1.08D0
|
|
|
|
C...Separate valence and sea parts of parton distribution.
|
|
IF(KFA.NE.22) THEN
|
|
XFV1=XPA(KFV1)-XPA(-KFV1)
|
|
XPA(KFV1)=XPA(-KFV1)
|
|
XFV2=XPA(KFV2)-XPA(-KFV2)
|
|
XPA(KFV2)=XPA(-KFV2)
|
|
ELSE
|
|
XPA(KFV1)=XPA(KFV1)-WTV1*VINT(232)
|
|
XPA(-KFV1)=XPA(-KFV1)-WTV1*VINT(232)
|
|
XPA(KFV2)=XPA(KFV2)-WTV2*VINT(232)
|
|
XPA(-KFV2)=XPA(-KFV2)-WTV2*VINT(232)
|
|
ENDIF
|
|
|
|
C...Dampen valence and sea separately. Put back together.
|
|
DO 120 KFL=-25,25
|
|
XPQ(KFL)=FS*XPA(KFL)
|
|
120 CONTINUE
|
|
IF(KFA.NE.22) THEN
|
|
XPQ(KFV1)=XPQ(KFV1)+FV*XFV1
|
|
XPQ(KFV2)=XPQ(KFV2)+FV*XFV2
|
|
ELSE
|
|
XPQ(KFV1)=XPQ(KFV1)+FV*WTV1*VINT(232)
|
|
XPQ(-KFV1)=XPQ(-KFV1)+FV*WTV1*VINT(232)
|
|
XPQ(KFV2)=XPQ(KFV2)+FV*WTV2*VINT(232)
|
|
XPQ(-KFV2)=XPQ(-KFV2)+FV*WTV2*VINT(232)
|
|
ENDIF
|
|
MINT(92)=2
|
|
|
|
C...Large Q2 and small x: interpolate behaviour.
|
|
ELSEIF(Q2.GT.Q2MN) THEN
|
|
|
|
C...Evaluate at extremes and define coefficients for interpolation.
|
|
CALL PYPDFU(KFC,XMN,Q2MN,XPA)
|
|
VI232A=VINT(232)
|
|
CALL PYPDFU(KFC,X,Q2B,XPB)
|
|
VI232B=VINT(232)
|
|
FLA=LOG(Q2B/Q2)/LOG(Q2B/Q2MN)
|
|
FVA=(X/XMN)**0.45D0*FLA
|
|
FSA=(X/XMN)**(-0.08D0)*FLA
|
|
FB=1D0-FLA
|
|
|
|
C...Separate valence and sea parts of parton distribution.
|
|
IF(KFA.NE.22) THEN
|
|
XFVA1=XPA(KFV1)-XPA(-KFV1)
|
|
XPA(KFV1)=XPA(-KFV1)
|
|
XFVA2=XPA(KFV2)-XPA(-KFV2)
|
|
XPA(KFV2)=XPA(-KFV2)
|
|
XFVB1=XPB(KFV1)-XPB(-KFV1)
|
|
XPB(KFV1)=XPB(-KFV1)
|
|
XFVB2=XPB(KFV2)-XPB(-KFV2)
|
|
XPB(KFV2)=XPB(-KFV2)
|
|
ELSE
|
|
XPA(KFV1)=XPA(KFV1)-WTV1*VI232A
|
|
XPA(-KFV1)=XPA(-KFV1)-WTV1*VI232A
|
|
XPA(KFV2)=XPA(KFV2)-WTV2*VI232A
|
|
XPA(-KFV2)=XPA(-KFV2)-WTV2*VI232A
|
|
XPB(KFV1)=XPB(KFV1)-WTV1*VI232B
|
|
XPB(-KFV1)=XPB(-KFV1)-WTV1*VI232B
|
|
XPB(KFV2)=XPB(KFV2)-WTV2*VI232B
|
|
XPB(-KFV2)=XPB(-KFV2)-WTV2*VI232B
|
|
ENDIF
|
|
|
|
C...Interpolate for valence and sea. Put back together.
|
|
DO 130 KFL=-25,25
|
|
XPQ(KFL)=FSA*XPA(KFL)+FB*XPB(KFL)
|
|
130 CONTINUE
|
|
IF(KFA.NE.22) THEN
|
|
XPQ(KFV1)=XPQ(KFV1)+(FVA*XFVA1+FB*XFVB1)
|
|
XPQ(KFV2)=XPQ(KFV2)+(FVA*XFVA2+FB*XFVB2)
|
|
ELSE
|
|
XPQ(KFV1)=XPQ(KFV1)+WTV1*(FVA*VI232A+FB*VI232B)
|
|
XPQ(-KFV1)=XPQ(-KFV1)+WTV1*(FVA*VI232A+FB*VI232B)
|
|
XPQ(KFV2)=XPQ(KFV2)+WTV2*(FVA*VI232A+FB*VI232B)
|
|
XPQ(-KFV2)=XPQ(-KFV2)+WTV2*(FVA*VI232A+FB*VI232B)
|
|
ENDIF
|
|
MINT(92)=3
|
|
|
|
C...Small Q2 and small x: dampen boundary value and add term.
|
|
ELSE
|
|
|
|
C...Evaluate at boundary and define dampening factors.
|
|
CALL PYPDFU(KFC,XMN,Q2MN,XPA)
|
|
FB=(XMN-X)*(Q2MN-Q2)/(XMN*Q2MN)
|
|
FA=1D0-FB
|
|
FVC=(X/XMN)**0.45D0*(Q2/(Q2+RMR))**0.55D0
|
|
FVA=FVC*FA*((Q2MN+RMR)/Q2MN)**0.55D0
|
|
FVB=FVC*FB*1.10D0*XMN**0.45D0*0.11D0
|
|
FSC=(X/XMN)**(-0.08D0)*(Q2/(Q2+RMP))**1.08D0
|
|
FSA=FSC*FA*((Q2MN+RMP)/Q2MN)**1.08D0
|
|
FSB=FSC*FB*0.21D0*XMN**(-0.08D0)*0.21D0
|
|
|
|
C...Separate valence and sea parts of parton distribution.
|
|
IF(KFA.NE.22) THEN
|
|
XFV1=XPA(KFV1)-XPA(-KFV1)
|
|
XPA(KFV1)=XPA(-KFV1)
|
|
XFV2=XPA(KFV2)-XPA(-KFV2)
|
|
XPA(KFV2)=XPA(-KFV2)
|
|
ELSE
|
|
XPA(KFV1)=XPA(KFV1)-WTV1*VINT(232)
|
|
XPA(-KFV1)=XPA(-KFV1)-WTV1*VINT(232)
|
|
XPA(KFV2)=XPA(KFV2)-WTV2*VINT(232)
|
|
XPA(-KFV2)=XPA(-KFV2)-WTV2*VINT(232)
|
|
ENDIF
|
|
|
|
C...Dampen valence and sea separately. Add constant terms.
|
|
C...Put back together.
|
|
DO 140 KFL=-25,25
|
|
XPQ(KFL)=FSA*XPA(KFL)
|
|
140 CONTINUE
|
|
IF(KFA.NE.22) THEN
|
|
DO 150 KFL=-3,3
|
|
XPQ(KFL)=XPQ(KFL)+FSB*WTSB(KFL)
|
|
150 CONTINUE
|
|
XPQ(KFV1)=XPQ(KFV1)+(FVA*XFV1+FVB*NV1)
|
|
XPQ(KFV2)=XPQ(KFV2)+(FVA*XFV2+FVB*NV2)
|
|
ELSE
|
|
DO 160 KFL=-3,3
|
|
XPQ(KFL)=XPQ(KFL)+VINT(281)*FSB*WTSB(KFL)
|
|
160 CONTINUE
|
|
XPQ(KFV1)=XPQ(KFV1)+WTV1*(FVA*VINT(232)+FVB*VINT(281))
|
|
XPQ(-KFV1)=XPQ(-KFV1)+WTV1*(FVA*VINT(232)+FVB*VINT(281))
|
|
XPQ(KFV2)=XPQ(KFV2)+WTV2*(FVA*VINT(232)+FVB*VINT(281))
|
|
XPQ(-KFV2)=XPQ(-KFV2)+WTV2*(FVA*VINT(232)+FVB*VINT(281))
|
|
ENDIF
|
|
XPQ(21)=XPQ(0)
|
|
MINT(92)=4
|
|
ENDIF
|
|
|
|
C...Format for error printout.
|
|
5000 FORMAT(' Error: x value outside physical range; x =',1P,D12.3)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPDEL
|
|
C...Gives electron parton distribution.
|
|
|
|
SUBROUTINE PYPDEL(X,Q2,XPEL)
|
|
|
|
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/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYINT1/MINT(400),VINT(400)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/
|
|
C...Local arrays.
|
|
DIMENSION XPEL(-25:25),XPGA(-6:6),SXP(0:6)
|
|
|
|
C...Interface to PDFLIB.
|
|
COMMON/W50513/XMIN,XMAX,Q2MIN,Q2MAX
|
|
SAVE /W50513/
|
|
DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU,
|
|
&VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX
|
|
CHARACTER*20 PARM(20)
|
|
DATA VALUE/20*0D0/,PARM/20*' '/
|
|
|
|
C...Some common constants.
|
|
DO 100 KFL=-25,25
|
|
XPEL(KFL)=0D0
|
|
100 CONTINUE
|
|
AEM=PARU(101)
|
|
PME=PMAS(11,1)
|
|
XL=LOG(MAX(1D-10,X))
|
|
X1L=LOG(MAX(1D-10,1D0-X))
|
|
HLE=LOG(MAX(3D0,Q2/PME**2))
|
|
HBE2=(AEM/PARU(1))*(HLE-1D0)
|
|
|
|
C...Electron inside electron, see R. Kleiss et al., in Z physics at
|
|
C...LEP 1, CERN 89-08, p. 34
|
|
IF(MSTP(59).LE.1) THEN
|
|
HDE=1D0+(AEM/PARU(1))*(1.5D0*HLE+1.289868D0)+(AEM/PARU(1))**2*
|
|
& (-2.164868D0*HLE**2+9.840808D0*HLE-10.130464D0)
|
|
HEE=HBE2*(1D0-X)**(HBE2-1D0)*SQRT(MAX(0D0,HDE))-
|
|
& 0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)*(-4D0*X1L+3D0*XL)-
|
|
& 4D0*XL/(1D0-X)-5D0-X)
|
|
ELSE
|
|
HEE=HBE2*(1D0-X)**(HBE2-1D0)*EXP(0.172784D0*HBE2)/
|
|
& PYGAMM(1D0+HBE2)-0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)*
|
|
& (-4D0*X1L+3D0*XL)-4D0*XL/(1D0-X)-5D0-X)
|
|
ENDIF
|
|
IF(X.GT.0.9999D0.AND.X.LE.0.999999D0) THEN
|
|
HEE=HEE*100D0**HBE2/(100D0**HBE2-1D0)
|
|
ELSEIF(X.GT.0.999999D0) THEN
|
|
HEE=0D0
|
|
ENDIF
|
|
XPEL(11)=X*HEE
|
|
|
|
C...Photon and (transverse) W- inside electron.
|
|
AEMP=PYALEM(PME*SQRT(MAX(0D0,Q2)))/PARU(2)
|
|
IF(MSTP(13).LE.1) THEN
|
|
HLG=HLE
|
|
ELSE
|
|
HLG=LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-X)/X**2))
|
|
ENDIF
|
|
XPEL(22)=AEMP*HLG*(1D0+(1D0-X)**2)
|
|
HLW=LOG(1D0+Q2/PMAS(24,1)**2)/(4D0*PARU(102))
|
|
XPEL(-24)=AEMP*HLW*(1D0+(1D0-X)**2)
|
|
|
|
C...Electron or positron inside photon inside electron.
|
|
IF(MSTP(12).EQ.1) THEN
|
|
XFSEA=0.5D0*(AEMP*(HLE-1D0))**2*(4D0/3D0+X-X**2-4D0*X**3/3D0+
|
|
& 2D0*X*(1D0+X)*XL)
|
|
XPEL(11)=XPEL(11)+XFSEA
|
|
XPEL(-11)=XFSEA
|
|
|
|
C...Initialize PDFLIB photon parton distributions.
|
|
IF(MSTP(56).EQ.2) THEN
|
|
PARM(1)='NPTYPE'
|
|
VALUE(1)=3
|
|
PARM(2)='NGROUP'
|
|
VALUE(2)=MSTP(55)/1000
|
|
PARM(3)='NSET'
|
|
VALUE(3)=MOD(MSTP(55),1000)
|
|
IF(MINT(93).NE.3000000+MSTP(55)) THEN
|
|
CALL PDFSET(PARM,VALUE)
|
|
MINT(93)=3000000+MSTP(55)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Quarks and gluons inside photon inside electron:
|
|
C...numerical convolution required.
|
|
DO 110 KFL=0,6
|
|
SXP(KFL)=0D0
|
|
110 CONTINUE
|
|
SUMXPP=0D0
|
|
ITER=-1
|
|
120 ITER=ITER+1
|
|
SUMXP=SUMXPP
|
|
NSTP=2**(ITER-1)
|
|
IF(ITER.EQ.0) NSTP=2
|
|
DO 130 KFL=0,6
|
|
SXP(KFL)=0.5D0*SXP(KFL)
|
|
130 CONTINUE
|
|
WTSTP=0.5D0/NSTP
|
|
IF(ITER.EQ.0) WTSTP=0.5D0
|
|
C...Pick grid of x_{gamma} values logarithmically even.
|
|
DO 150 ISTP=1,NSTP
|
|
IF(ITER.EQ.0) THEN
|
|
XLE=XL*(ISTP-1)
|
|
ELSE
|
|
XLE=XL*(ISTP-0.5D0)/NSTP
|
|
ENDIF
|
|
XE=MIN(0.999999D0,EXP(XLE))
|
|
XG=MIN(0.999999D0,X/XE)
|
|
C...Evaluate photon inside electron parton distribution for convolution.
|
|
XPGP=1D0+(1D0-XE)**2
|
|
IF(MSTP(13).LE.1) THEN
|
|
XPGP=XPGP*HLE
|
|
ELSE
|
|
XPGP=XPGP*LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-XE)/XE**2))
|
|
ENDIF
|
|
C...Evaluate photon parton distributions for convolution.
|
|
IF(MSTP(56).EQ.1) THEN
|
|
CALL PYPDGA(XG,Q2,XPGA)
|
|
DO 140 KFL=0,5
|
|
SXP(KFL)=SXP(KFL)+WTSTP*XPGP*XPGA(KFL)
|
|
140 CONTINUE
|
|
ELSEIF(MSTP(56).EQ.2) THEN
|
|
C...Call PDFLIB parton distributions.
|
|
XX=XG
|
|
QQ=SQRT(MAX(0D0,Q2MIN,Q2))
|
|
IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN)
|
|
CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU)
|
|
SXP(0)=SXP(0)+WTSTP*XPGP*GLU
|
|
SXP(1)=SXP(1)+WTSTP*XPGP*DNV
|
|
SXP(2)=SXP(2)+WTSTP*XPGP*UPV
|
|
SXP(3)=SXP(3)+WTSTP*XPGP*STR
|
|
SXP(4)=SXP(4)+WTSTP*XPGP*CHM
|
|
SXP(5)=SXP(5)+WTSTP*XPGP*BOT
|
|
SXP(6)=SXP(6)+WTSTP*XPGP*TOP
|
|
ENDIF
|
|
150 CONTINUE
|
|
SUMXPP=SXP(0)+2D0*SXP(1)+2D0*SXP(2)
|
|
IF(ITER.LE.2.OR.(ITER.LE.7.AND.ABS(SUMXPP-SUMXP).GT.
|
|
& PARP(14)*(SUMXPP+SUMXP))) GOTO 120
|
|
|
|
C...Put convolution into output arrays.
|
|
FCONV=AEMP*(-XL)
|
|
XPEL(0)=FCONV*SXP(0)
|
|
DO 160 KFL=1,6
|
|
XPEL(KFL)=FCONV*SXP(KFL)
|
|
XPEL(-KFL)=XPEL(KFL)
|
|
160 CONTINUE
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPDGA
|
|
C...Gives photon parton distribution.
|
|
|
|
SUBROUTINE PYPDGA(X,Q2,XPGA)
|
|
|
|
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...Local arrays.
|
|
DIMENSION XPGA(-6:6),DGAG(4,3),DGBG(4,3),DGCG(4,3),DGAN(4,3),
|
|
&DGBN(4,3),DGCN(4,3),DGDN(4,3),DGEN(4,3),DGAS(4,3),DGBS(4,3),
|
|
&DGCS(4,3),DGDS(4,3),DGES(4,3)
|
|
|
|
C...The following data lines are coefficients needed in the
|
|
C...Drees and Grassie photon parton distribution parametrization.
|
|
DATA DGAG/-.207D0,.6158D0,1.074D0,0.D0,.8926D-2,.6594D0,
|
|
&.4766D0,.1975D-1,.03197D0,1.018D0,.2461D0,.2707D-1/
|
|
DATA DGBG/-.1987D0,.6257D0,8.352D0,5.024D0,.5085D-1,.2774D0,
|
|
&-.3906D0,-.3212D0,-.618D-2,.9476D0,-.6094D0,-.1067D-1/
|
|
DATA DGCG/5.119D0,-.2752D0,-6.993D0,2.298D0,-.2313D0,.1382D0,
|
|
&6.542D0,.5162D0,-.1216D0,.9047D0,2.653D0,.2003D-2/
|
|
DATA DGAN/2.285D0,-.1526D-1,1330.D0,4.219D0,-.3711D0,1.061D0,
|
|
&4.758D0,-.1503D-1,15.8D0,-.9464D0,-.5D0,-.2118D0/
|
|
DATA DGBN/6.073D0,-.8132D0,-41.31D0,3.165D0,-.1717D0,.7815D0,
|
|
&1.535D0,.7067D-2,2.742D0,-.7332D0,.7148D0,3.287D0/
|
|
DATA DGCN/-.4202D0,.1778D-1,.9216D0,.18D0,.8766D-1,.2197D-1,
|
|
&.1096D0,.204D0,.2917D-1,.4657D-1,.1785D0,.4811D-1/
|
|
DATA DGDN/-.8083D-1,.6346D0,1.208D0,.203D0,-.8915D0,.2857D0,
|
|
&2.973D0,.1185D0,-.342D-1,.7196D0,.7338D0,.8139D-1/
|
|
DATA DGEN/.5526D-1,1.136D0,.9512D0,.1163D-1,-.1816D0,.5866D0,
|
|
&2.421D0,.4059D0,-.2302D-1,.9229D0,.5873D0,-.79D-4/
|
|
DATA DGAS/16.69D0,-.7916D0,1099.D0,4.428D0,-.1207D0,1.071D0,
|
|
&1.977D0,-.8625D-2,6.734D0,-1.008D0,-.8594D-1,.7625D-1/
|
|
DATA DGBS/.176D0,.4794D-1,1.047D0,.25D-1,25.D0,-1.648D0,
|
|
&-.1563D-1,6.438D0,59.88D0,-2.983D0,4.48D0,.9686D0/
|
|
DATA DGCS/-.208D-1,.3386D-2,4.853D0,.8404D0,-.123D-1,1.162D0,
|
|
&.4824D0,-.11D-1,-.3226D-2,.8432D0,.3616D0,.1383D-2/
|
|
DATA DGDS/-.1685D-1,1.353D0,1.426D0,1.239D0,-.9194D-1,.7912D0,
|
|
&.6397D0,2.327D0,-.3321D-1,.9475D0,-.3198D0,.2132D-1/
|
|
DATA DGES/-.1986D0,1.1D0,1.136D0,-.2779D0,.2015D-1,.9869D0,
|
|
&-.7036D-1,.1694D-1,.1059D0,.6954D0,-.6663D0,.3683D0/
|
|
|
|
C...Photon parton distribution from Drees and Grassie.
|
|
C...Allowed variable range: 1 GeV^2 < Q^2 < 10000 GeV^2.
|
|
DO 100 KFL=-6,6
|
|
XPGA(KFL)=0D0
|
|
100 CONTINUE
|
|
VINT(231)=1D0
|
|
IF(MSTP(57).LE.0) THEN
|
|
T=LOG(1D0/0.16D0)
|
|
ELSE
|
|
T=LOG(MIN(1D4,MAX(1D0,Q2))/0.16D0)
|
|
ENDIF
|
|
X1=1D0-X
|
|
NF=3
|
|
IF(Q2.GT.25D0) NF=4
|
|
IF(Q2.GT.300D0) NF=5
|
|
NFE=NF-2
|
|
AEM=PARU(101)
|
|
|
|
C...Evaluate gluon content.
|
|
DGA=DGAG(1,NFE)*T**DGAG(2,NFE)+DGAG(3,NFE)*T**(-DGAG(4,NFE))
|
|
DGB=DGBG(1,NFE)*T**DGBG(2,NFE)+DGBG(3,NFE)*T**(-DGBG(4,NFE))
|
|
DGC=DGCG(1,NFE)*T**DGCG(2,NFE)+DGCG(3,NFE)*T**(-DGCG(4,NFE))
|
|
XPGL=DGA*X**DGB*X1**DGC
|
|
|
|
C...Evaluate up- and down-type quark content.
|
|
DGA=DGAN(1,NFE)*T**DGAN(2,NFE)+DGAN(3,NFE)*T**(-DGAN(4,NFE))
|
|
DGB=DGBN(1,NFE)*T**DGBN(2,NFE)+DGBN(3,NFE)*T**(-DGBN(4,NFE))
|
|
DGC=DGCN(1,NFE)*T**DGCN(2,NFE)+DGCN(3,NFE)*T**(-DGCN(4,NFE))
|
|
DGD=DGDN(1,NFE)*T**DGDN(2,NFE)+DGDN(3,NFE)*T**(-DGDN(4,NFE))
|
|
DGE=DGEN(1,NFE)*T**DGEN(2,NFE)+DGEN(3,NFE)*T**(-DGEN(4,NFE))
|
|
XPQN=X*(X**2+X1**2)/(DGA-DGB*LOG(X1))+DGC*X**DGD*X1**DGE
|
|
DGA=DGAS(1,NFE)*T**DGAS(2,NFE)+DGAS(3,NFE)*T**(-DGAS(4,NFE))
|
|
DGB=DGBS(1,NFE)*T**DGBS(2,NFE)+DGBS(3,NFE)*T**(-DGBS(4,NFE))
|
|
DGC=DGCS(1,NFE)*T**DGCS(2,NFE)+DGCS(3,NFE)*T**(-DGCS(4,NFE))
|
|
DGD=DGDS(1,NFE)*T**DGDS(2,NFE)+DGDS(3,NFE)*T**(-DGDS(4,NFE))
|
|
DGE=DGES(1,NFE)*T**DGES(2,NFE)+DGES(3,NFE)*T**(-DGES(4,NFE))
|
|
DGF=9D0
|
|
IF(NF.EQ.4) DGF=10D0
|
|
IF(NF.EQ.5) DGF=55D0/6D0
|
|
XPQS=DGF*X*(X**2+X1**2)/(DGA-DGB*LOG(X1))+DGC*X**DGD*X1**DGE
|
|
IF(NF.LE.3) THEN
|
|
XPQU=(XPQS+9D0*XPQN)/6D0
|
|
XPQD=(XPQS-4.5D0*XPQN)/6D0
|
|
ELSEIF(NF.EQ.4) THEN
|
|
XPQU=(XPQS+6D0*XPQN)/8D0
|
|
XPQD=(XPQS-6D0*XPQN)/8D0
|
|
ELSE
|
|
XPQU=(XPQS+7.5D0*XPQN)/10D0
|
|
XPQD=(XPQS-5D0*XPQN)/10D0
|
|
ENDIF
|
|
|
|
C...Put into output arrays.
|
|
XPGA(0)=AEM*XPGL
|
|
XPGA(1)=AEM*XPQD
|
|
XPGA(2)=AEM*XPQU
|
|
XPGA(3)=AEM*XPQD
|
|
IF(NF.GE.4) XPGA(4)=AEM*XPQU
|
|
IF(NF.GE.5) XPGA(5)=AEM*XPQD
|
|
DO 110 KFL=1,6
|
|
XPGA(-KFL)=XPGA(KFL)
|
|
110 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGGAM
|
|
C...Constructs the F2 and parton distributions of the photon
|
|
C...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms.
|
|
C...For F2, c and b are included by the Bethe-Heitler formula;
|
|
C...in the 'MSbar' scheme additionally a Cgamma term is added.
|
|
C...Contains the SaS sets 1D, 1M, 2D and 2M.
|
|
C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand.
|
|
|
|
SUBROUTINE PYGGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
|
|
&XPDIR(-6:6)
|
|
COMMON/PYINT9/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6)
|
|
SAVE /PYINT8/,/PYINT9/
|
|
C...Local arrays.
|
|
DIMENSION XPDFGM(-6:6),XPGA(-6:6), VXPGA(-6:6)
|
|
C...Charm and bottom masses (low to compensate for J/psi etc.).
|
|
DATA PMC/1.3D0/, PMB/4.6D0/
|
|
C...alpha_em and alpha_em/(2*pi).
|
|
DATA AEM/0.007297D0/, AEM2PI/0.0011614D0/
|
|
C...Lambda value for 4 flavours.
|
|
DATA ALAM/0.20D0/
|
|
C...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum.
|
|
DATA FRACU/0.8D0/
|
|
C...VMD couplings f_V**2/(4*pi).
|
|
DATA FRHO/2.20D0/, FOMEGA/23.6D0/, FPHI/18.4D0/
|
|
C...Masses for rho (=omega) and phi.
|
|
DATA PMRHO/0.770D0/, PMPHI/1.020D0/
|
|
C...Number of points in integration for IP2=1.
|
|
DATA NSTEP/100/
|
|
|
|
C...Reset output.
|
|
F2GM=0D0
|
|
DO 100 KFL=-6,6
|
|
XPDFGM(KFL)=0D0
|
|
XPVMD(KFL)=0D0
|
|
XPANL(KFL)=0D0
|
|
XPANH(KFL)=0D0
|
|
XPBEH(KFL)=0D0
|
|
XPDIR(KFL)=0D0
|
|
VXPVMD(KFL)=0D0
|
|
VXPANL(KFL)=0D0
|
|
VXPANH(KFL)=0D0
|
|
VXPDGM(KFL)=0D0
|
|
100 CONTINUE
|
|
|
|
C...Set Q0 cut-off parameter as function of set used.
|
|
IF(ISET.LE.2) THEN
|
|
Q0=0.6D0
|
|
ELSE
|
|
Q0=2D0
|
|
ENDIF
|
|
Q02=Q0**2
|
|
|
|
C...Scale choice for off-shell photon; common factors.
|
|
Q2A=Q2
|
|
FACNOR=1D0
|
|
IF(IP2.EQ.1) THEN
|
|
P2MX=P2+Q02
|
|
Q2A=Q2+P2*Q02/MAX(Q02,Q2)
|
|
FACNOR=LOG(Q2/Q02)/NSTEP
|
|
ELSEIF(IP2.EQ.2) THEN
|
|
P2MX=MAX(P2,Q02)
|
|
ELSEIF(IP2.EQ.3) THEN
|
|
P2MX=P2+Q02
|
|
Q2A=Q2+P2*Q02/MAX(Q02,Q2)
|
|
ELSEIF(IP2.EQ.4) THEN
|
|
P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
|
|
& ((Q2+P2)*(Q02+P2)))
|
|
ELSEIF(IP2.EQ.5) THEN
|
|
P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
|
|
& ((Q2+P2)*(Q02+P2)))
|
|
P2MX=Q0*SQRT(P2MXA)
|
|
FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MX)
|
|
ELSEIF(IP2.EQ.6) THEN
|
|
P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
|
|
& ((Q2+P2)*(Q02+P2)))
|
|
P2MX=MAX(0D0,1D0-P2/Q2)*P2MX+MIN(1D0,P2/Q2)*MAX(P2,Q02)
|
|
ELSE
|
|
P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
|
|
& ((Q2+P2)*(Q02+P2)))
|
|
P2MX=Q0*SQRT(P2MXA)
|
|
P2MXB=P2MX
|
|
P2MX=MAX(0D0,1D0-P2/Q2)*P2MX+MIN(1D0,P2/Q2)*MAX(P2,Q02)
|
|
P2MXB=MAX(0D0,1D0-P2/Q2)*P2MXB+MIN(1D0,P2/Q2)*P2MXA
|
|
FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MXB)
|
|
ENDIF
|
|
|
|
C...Call VMD parametrization for d quark and use to give rho, omega,
|
|
C...phi. Note dipole dampening for off-shell photon.
|
|
CALL PYGVMD(ISET,1,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
|
|
XFVAL=VXPGA(1)
|
|
XPGA(1)=XPGA(2)
|
|
XPGA(-1)=XPGA(-2)
|
|
FACUD=AEM*(1D0/FRHO+1D0/FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2
|
|
FACS=AEM*(1D0/FPHI)*(PMPHI**2/(PMPHI**2+P2))**2
|
|
DO 110 KFL=-5,5
|
|
XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL)
|
|
110 CONTINUE
|
|
XPVMD(1)=XPVMD(1)+(1D0-FRACU)*FACUD*XFVAL
|
|
XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL
|
|
XPVMD(3)=XPVMD(3)+FACS*XFVAL
|
|
XPVMD(-1)=XPVMD(-1)+(1D0-FRACU)*FACUD*XFVAL
|
|
XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL
|
|
XPVMD(-3)=XPVMD(-3)+FACS*XFVAL
|
|
VXPVMD(1)=(1D0-FRACU)*FACUD*XFVAL
|
|
VXPVMD(2)=FRACU*FACUD*XFVAL
|
|
VXPVMD(3)=FACS*XFVAL
|
|
VXPVMD(-1)=(1D0-FRACU)*FACUD*XFVAL
|
|
VXPVMD(-2)=FRACU*FACUD*XFVAL
|
|
VXPVMD(-3)=FACS*XFVAL
|
|
|
|
IF(IP2.NE.1) THEN
|
|
C...Anomalous parametrizations for different strategies
|
|
C...for off-shell photons; except full integration.
|
|
|
|
C...Call anomalous parametrization for d + u + s.
|
|
CALL PYGANO(-3,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
|
|
DO 120 KFL=-5,5
|
|
XPANL(KFL)=FACNOR*XPGA(KFL)
|
|
VXPANL(KFL)=FACNOR*VXPGA(KFL)
|
|
120 CONTINUE
|
|
|
|
C...Call anomalous parametrization for c and b.
|
|
CALL PYGANO(4,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
|
|
DO 130 KFL=-5,5
|
|
XPANH(KFL)=FACNOR*XPGA(KFL)
|
|
VXPANH(KFL)=FACNOR*VXPGA(KFL)
|
|
130 CONTINUE
|
|
CALL PYGANO(5,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
|
|
DO 140 KFL=-5,5
|
|
XPANH(KFL)=XPANH(KFL)+FACNOR*XPGA(KFL)
|
|
VXPANH(KFL)=VXPANH(KFL)+FACNOR*VXPGA(KFL)
|
|
140 CONTINUE
|
|
|
|
ELSE
|
|
C...Special option: loop over flavours and integrate over k2.
|
|
DO 170 KF=1,5
|
|
DO 160 ISTEP=1,NSTEP
|
|
Q2STEP=Q02*(Q2/Q02)**((ISTEP-0.5D0)/NSTEP)
|
|
IF((KF.EQ.4.AND.Q2STEP.LT.PMC**2).OR.
|
|
& (KF.EQ.5.AND.Q2STEP.LT.PMB**2)) GOTO 160
|
|
CALL PYGVMD(0,KF,X,Q2,Q2STEP,ALAM,XPGA,VXPGA)
|
|
FACQ=AEM2PI*(Q2STEP/(Q2STEP+P2))**2*FACNOR
|
|
IF(MOD(KF,2).EQ.0) FACQ=FACQ*(8D0/9D0)
|
|
IF(MOD(KF,2).EQ.1) FACQ=FACQ*(2D0/9D0)
|
|
DO 150 KFL=-5,5
|
|
IF(KF.LE.3) XPANL(KFL)=XPANL(KFL)+FACQ*XPGA(KFL)
|
|
IF(KF.GE.4) XPANH(KFL)=XPANH(KFL)+FACQ*XPGA(KFL)
|
|
IF(KF.LE.3) VXPANL(KFL)=VXPANL(KFL)+FACQ*VXPGA(KFL)
|
|
IF(KF.GE.4) VXPANH(KFL)=VXPANH(KFL)+FACQ*VXPGA(KFL)
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
ENDIF
|
|
|
|
C...Call Bethe-Heitler term expression for charm and bottom.
|
|
CALL PYGBEH(4,X,Q2,P2,PMC**2,XPBH)
|
|
XPBEH(4)=XPBH
|
|
XPBEH(-4)=XPBH
|
|
CALL PYGBEH(5,X,Q2,P2,PMB**2,XPBH)
|
|
XPBEH(5)=XPBH
|
|
XPBEH(-5)=XPBH
|
|
|
|
C...For MSbar subtraction call C^gamma term expression for d, u, s.
|
|
IF(ISET.EQ.2.OR.ISET.EQ.4) THEN
|
|
CALL PYGDIR(X,Q2,P2,Q02,XPGA)
|
|
DO 180 KFL=-5,5
|
|
XPDIR(KFL)=XPGA(KFL)
|
|
180 CONTINUE
|
|
ENDIF
|
|
|
|
C...Store result in output array.
|
|
DO 190 KFL=-5,5
|
|
CHSQ=1D0/9D0
|
|
IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4D0/9D0
|
|
XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL)
|
|
IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2
|
|
XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL)
|
|
VXPDGM(KFL)=VXPVMD(KFL)+VXPANL(KFL)+VXPANH(KFL)
|
|
190 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGVMD
|
|
C...Evaluates the VMD parton distributions of a photon,
|
|
C...evolved homogeneously from an initial scale P2 to Q2.
|
|
C...Does not include dipole suppression factor.
|
|
C...ISET is parton distribution set, see above;
|
|
C...additionally ISET=0 is used for the evolution of an anomalous photon
|
|
C...which branched at a scale P2 and then evolved homogeneously to Q2.
|
|
C...ALAM is the 4-flavour Lambda, which is automatically converted
|
|
C...to 3- and 5-flavour equivalents as needed.
|
|
C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand.
|
|
|
|
SUBROUTINE PYGVMD(ISET,KF,X,Q2,P2,ALAM,XPGA,VXPGA)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Local arrays and data.
|
|
DIMENSION XPGA(-6:6), VXPGA(-6:6)
|
|
DATA PMC/1.3D0/, PMB/4.6D0/, AEM/0.007297D0/, AEM2PI/0.0011614D0/
|
|
|
|
C...Reset output.
|
|
DO 100 KFL=-6,6
|
|
XPGA(KFL)=0D0
|
|
VXPGA(KFL)=0D0
|
|
100 CONTINUE
|
|
KFA=IABS(KF)
|
|
|
|
C...Calculate Lambda; protect against unphysical Q2 and P2 input.
|
|
ALAM3=ALAM*(PMC/ALAM)**(2D0/27D0)
|
|
ALAM5=ALAM*(ALAM/PMB)**(2D0/23D0)
|
|
P2EFF=MAX(P2,1.2D0*ALAM3**2)
|
|
IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2)
|
|
IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2)
|
|
Q2EFF=MAX(Q2,P2EFF)
|
|
|
|
C...Find number of flavours at lower and upper scale.
|
|
NFP=4
|
|
IF(P2EFF.LT.PMC**2) NFP=3
|
|
IF(P2EFF.GT.PMB**2) NFP=5
|
|
NFQ=4
|
|
IF(Q2EFF.LT.PMC**2) NFQ=3
|
|
IF(Q2EFF.GT.PMB**2) NFQ=5
|
|
|
|
C...Find s as sum of 3-, 4- and 5-flavour parts.
|
|
S=0D0
|
|
IF(NFP.EQ.3) THEN
|
|
Q2DIV=PMC**2
|
|
IF(NFQ.EQ.3) Q2DIV=Q2EFF
|
|
S=S+(6D0/27D0)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2))
|
|
ENDIF
|
|
IF(NFP.LE.4.AND.NFQ.GE.4) THEN
|
|
P2DIV=P2EFF
|
|
IF(NFP.EQ.3) P2DIV=PMC**2
|
|
Q2DIV=Q2EFF
|
|
IF(NFQ.EQ.5) Q2DIV=PMB**2
|
|
S=S+(6D0/25D0)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2))
|
|
ENDIF
|
|
IF(NFQ.EQ.5) THEN
|
|
P2DIV=PMB**2
|
|
IF(NFP.EQ.5) P2DIV=P2EFF
|
|
S=S+(6D0/23D0)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2))
|
|
ENDIF
|
|
|
|
C...Calculate frequent combinations of x and s.
|
|
X1=1D0-X
|
|
XL=-LOG(X)
|
|
S2=S**2
|
|
S3=S**3
|
|
S4=S**4
|
|
|
|
C...Evaluate homogeneous anomalous parton distributions below or
|
|
C...above threshold.
|
|
IF(ISET.EQ.0) THEN
|
|
IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
|
|
& (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
|
|
XVAL = X * 1.5D0 * (X**2+X1**2)
|
|
XGLU = 0D0
|
|
XSEA = 0D0
|
|
ELSE
|
|
XVAL = (1.5D0/(1D0-0.197D0*S+4.33D0*S2)*X**2 +
|
|
& (1.5D0+2.10D0*S)/(1D0+3.29D0*S)*X1**2 +
|
|
& 5.23D0*S/(1D0+1.17D0*S+19.9D0*S3)*X*X1) *
|
|
& X**(1D0/(1D0+1.5D0*S)) * (1D0-X**2)**(2.667D0*S)
|
|
XGLU = 4D0*S/(1D0+4.76D0*S+15.2D0*S2+29.3D0*S4) *
|
|
& X**(-2.03D0*S/(1D0+2.44D0*S)) * (X1*XL)**(1.333D0*S) *
|
|
& ((4D0*X**2+7D0*X+4D0)*X1/3D0 - 2D0*X*(1D0+X)*XL)
|
|
XSEA = S2/(1D0+4.54D0*S+8.19D0*S2+8.05D0*S3) *
|
|
& X**(-1.54D0*S/(1D0+1.29D0*S)) * X1**(2.667D0*S) *
|
|
& ((8D0-73D0*X+62D0*X**2)*X1/9D0 + (3D0-8D0*X**2/3D0)*X*XL +
|
|
& (2D0*X-1D0)*X*XL**2)
|
|
ENDIF
|
|
|
|
C...Evaluate set 1D parton distributions below or above threshold.
|
|
ELSEIF(ISET.EQ.1) THEN
|
|
IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
|
|
& (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
|
|
XVAL = 1.294D0 * X**0.80D0 * X1**0.76D0
|
|
XGLU = 1.273D0 * X**0.40D0 * X1**1.76D0
|
|
XSEA = 0.100D0 * X1**3.76D0
|
|
ELSE
|
|
XVAL = 1.294D0/(1D0+0.252D0*S+3.079D0*S2) *
|
|
& X**(0.80D0-0.13D0*S) * X1**(0.76D0+0.667D0*S) * XL**(2D0*S)
|
|
XGLU = 7.90D0*S/(1D0+5.50D0*S) * EXP(-5.16D0*S) *
|
|
& X**(-1.90D0*S/(1D0+3.60D0*S)) * X1**1.30D0 *
|
|
& XL**(0.50D0+3D0*S) + 1.273D0 * EXP(-10D0*S) *
|
|
& X**0.40D0 * X1**(1.76D0+3D0*S)
|
|
XSEA = (0.1D0-0.397D0*S2+1.121D0*S3)/
|
|
& (1D0+5.61D0*S2+5.26D0*S3) * X**(-7.32D0*S2/(1D0+10.3D0*S2)) *
|
|
& X1**((3.76D0+15D0*S+12D0*S2)/(1D0+4D0*S))
|
|
XSEA0 = 0.100D0 * X1**3.76D0
|
|
ENDIF
|
|
|
|
C...Evaluate set 1M parton distributions below or above threshold.
|
|
ELSEIF(ISET.EQ.2) THEN
|
|
IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
|
|
& (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
|
|
XVAL = 0.8477D0 * X**0.51D0 * X1**1.37D0
|
|
XGLU = 3.42D0 * X**0.255D0 * X1**2.37D0
|
|
XSEA = 0D0
|
|
ELSE
|
|
XVAL = 0.8477D0/(1D0+1.37D0*S+2.18D0*S2+3.73D0*S3) *
|
|
& X**(0.51D0+0.21D0*S) * X1**1.37D0 * XL**(2.667D0*S)
|
|
XGLU = 24D0*S/(1D0+9.6D0*S+0.92D0*S2+14.34D0*S3) *
|
|
& EXP(-5.94D0*S) * X**((-0.013D0-1.80D0*S)/(1D0+3.14D0*S)) *
|
|
& X1**(2.37D0+0.4D0*S) * XL**(0.32D0+3.6D0*S) + 3.42D0 *
|
|
& EXP(-12D0*S) * X**0.255D0 * X1**(2.37D0+3D0*S)
|
|
XSEA = 0.842D0*S/(1D0+21.3D0*S-33.2D0*S2+229D0*S3) *
|
|
& X**((0.13D0-2.90D0*S)/(1D0+5.44D0*S)) * X1**(3.45D0+0.5D0*S) *
|
|
& XL**(2.8D0*S)
|
|
XSEA0 = 0D0
|
|
ENDIF
|
|
|
|
C...Evaluate set 2D parton distributions below or above threshold.
|
|
ELSEIF(ISET.EQ.3) THEN
|
|
IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
|
|
& (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
|
|
XVAL = X**0.46D0 * X1**0.64D0 + 0.76D0 * X
|
|
XGLU = 1.925D0 * X1**2
|
|
XSEA = 0.242D0 * X1**4
|
|
ELSE
|
|
XVAL = (1D0+0.186D0*S)/(1D0-0.209D0*S+1.495D0*S2) *
|
|
& X**(0.46D0+0.25D0*S) *
|
|
& X1**((0.64D0+0.14D0*S+5D0*S2)/(1D0+S)) * XL**(1.9D0*S) +
|
|
& (0.76D0+0.4D0*S) * X * X1**(2.667D0*S)
|
|
XGLU = (1.925D0+5.55D0*S+147D0*S2)/(1D0-3.59D0*S+3.32D0*S2) *
|
|
& EXP(-18.67D0*S) *
|
|
& X**((-5.81D0*S-5.34D0*S2)/(1D0+29D0*S-4.26D0*S2))
|
|
& * X1**((2D0-5.9D0*S)/(1D0+1.7D0*S)) *
|
|
& XL**(9.3D0*S/(1D0+1.7D0*S))
|
|
XSEA = (0.242D0-0.252D0*S+1.19D0*S2)/
|
|
& (1D0-0.607D0*S+21.95D0*S2) *
|
|
& X**(-12.1D0*S2/(1D0+2.62D0*S+16.7D0*S2)) * X1**4 * XL**S
|
|
XSEA0 = 0.242D0 * X1**4
|
|
ENDIF
|
|
|
|
C...Evaluate set 2M parton distributions below or above threshold.
|
|
ELSEIF(ISET.EQ.4) THEN
|
|
IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
|
|
& (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
|
|
XVAL = 1.168D0 * X**0.50D0 * X1**2.60D0 + 0.965D0 * X
|
|
XGLU = 1.808D0 * X1**2
|
|
XSEA = 0.209D0 * X1**4
|
|
ELSE
|
|
XVAL = (1.168D0+1.771D0*S+29.35D0*S2) * EXP(-5.776D0*S) *
|
|
& X**((0.5D0+0.208D0*S)/(1D0-0.794D0*S+1.516D0*S2)) *
|
|
& X1**((2.6D0+7.6D0*S)/(1D0+5D0*S)) *
|
|
& XL**(5.15D0*S/(1D0+2D0*S)) +
|
|
& (0.965D0+22.35D0*S)/(1D0+18.4D0*S) * X * X1**(2.667D0*S)
|
|
XGLU = (1.808D0+29.9D0*S)/(1D0+26.4D0*S) * EXP(-5.28D0*S) *
|
|
& X**((-5.35D0*S-10.11D0*S2)/(1D0+31.71D0*S)) *
|
|
& X1**((2D0-7.3D0*S+4D0*S2)/(1D0+2.5D0*S)) *
|
|
& XL**(10.9D0*S/(1D0+2.5D0*S))
|
|
XSEA = (0.209D0+0.644D0*S2)/(1D0+0.319D0*S+17.6D0*S2) *
|
|
& X**((-0.373D0*S-7.71D0*S2)/(1D0+0.815D0*S+11.0D0*S2)) *
|
|
& X1**(4D0+S) * XL**(0.45D0*S)
|
|
XSEA0 = 0.209D0 * X1**4
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Threshold factors for c and b sea.
|
|
SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2))
|
|
XCHM=0D0
|
|
IF(Q2.GT.PMC**2.AND.Q2.GT.1.001D0*P2EFF) THEN
|
|
SCH=MAX(0D0,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
|
|
IF(ISET.EQ.0) THEN
|
|
XCHM=XSEA*(1D0-(SCH/SLL)**2)
|
|
ELSE
|
|
XCHM=MAX(0D0,XSEA-XSEA0*X1**(2.667D0*S))*(1D0-SCH/SLL)
|
|
ENDIF
|
|
ENDIF
|
|
XBOT=0D0
|
|
IF(Q2.GT.PMB**2.AND.Q2.GT.1.001D0*P2EFF) THEN
|
|
SBT=MAX(0D0,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
|
|
IF(ISET.EQ.0) THEN
|
|
XBOT=XSEA*(1D0-(SBT/SLL)**2)
|
|
ELSE
|
|
XBOT=MAX(0D0,XSEA-XSEA0*X1**(2.667D0*S))*(1D0-SBT/SLL)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Fill parton distributions.
|
|
XPGA(0)=XGLU
|
|
XPGA(1)=XSEA
|
|
XPGA(2)=XSEA
|
|
XPGA(3)=XSEA
|
|
XPGA(4)=XCHM
|
|
XPGA(5)=XBOT
|
|
XPGA(KFA)=XPGA(KFA)+XVAL
|
|
DO 110 KFL=1,5
|
|
XPGA(-KFL)=XPGA(KFL)
|
|
110 CONTINUE
|
|
VXPGA(KFA)=XVAL
|
|
VXPGA(-KFA)=XVAL
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGANO
|
|
C...Evaluates the parton distributions of the anomalous photon,
|
|
C...inhomogeneously evolved from a scale P2 (where it vanishes) to Q2.
|
|
C...KF=0 gives the sum over (up to) 5 flavours,
|
|
C...KF<0 limits to flavours up to abs(KF),
|
|
C...KF>0 is for flavour KF only.
|
|
C...ALAM is the 4-flavour Lambda, which is automatically converted
|
|
C...to 3- and 5-flavour equivalents as needed.
|
|
C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand.
|
|
|
|
SUBROUTINE PYGANO(KF,X,Q2,P2,ALAM,XPGA,VXPGA)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Local arrays and data.
|
|
DIMENSION XPGA(-6:6), VXPGA(-6:6), ALAMSQ(3:5)
|
|
DATA PMC/1.3D0/, PMB/4.6D0/, AEM/0.007297D0/, AEM2PI/0.0011614D0/
|
|
|
|
C...Reset output.
|
|
DO 100 KFL=-6,6
|
|
XPGA(KFL)=0D0
|
|
VXPGA(KFL)=0D0
|
|
100 CONTINUE
|
|
IF(Q2.LE.P2) RETURN
|
|
KFA=IABS(KF)
|
|
|
|
C...Calculate Lambda; protect against unphysical Q2 and P2 input.
|
|
ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2D0/27D0))**2
|
|
ALAMSQ(4)=ALAM**2
|
|
ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2D0/23D0))**2
|
|
P2EFF=MAX(P2,1.2D0*ALAMSQ(3))
|
|
IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2)
|
|
IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2)
|
|
Q2EFF=MAX(Q2,P2EFF)
|
|
XL=-LOG(X)
|
|
|
|
C...Find number of flavours at lower and upper scale.
|
|
NFP=4
|
|
IF(P2EFF.LT.PMC**2) NFP=3
|
|
IF(P2EFF.GT.PMB**2) NFP=5
|
|
NFQ=4
|
|
IF(Q2EFF.LT.PMC**2) NFQ=3
|
|
IF(Q2EFF.GT.PMB**2) NFQ=5
|
|
|
|
C...Define range of flavour loop.
|
|
IF(KF.EQ.0) THEN
|
|
KFLMN=1
|
|
KFLMX=5
|
|
ELSEIF(KF.LT.0) THEN
|
|
KFLMN=1
|
|
KFLMX=KFA
|
|
ELSE
|
|
KFLMN=KFA
|
|
KFLMX=KFA
|
|
ENDIF
|
|
|
|
C...Loop over flavours the photon can branch into.
|
|
DO 110 KFL=KFLMN,KFLMX
|
|
|
|
C...Light flavours: calculate t range and (approximate) s range.
|
|
IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN
|
|
TDIFF=LOG(Q2EFF/P2EFF)
|
|
S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/
|
|
& LOG(P2EFF/ALAMSQ(NFQ)))
|
|
IF(NFQ.GT.NFP) THEN
|
|
Q2DIV=PMB**2
|
|
IF(NFQ.EQ.4) Q2DIV=PMC**2
|
|
SNFQ=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/
|
|
& LOG(P2EFF/ALAMSQ(NFQ)))
|
|
SNFP=(6D0/(33D0-2D0*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/
|
|
& LOG(P2EFF/ALAMSQ(NFQ-1)))
|
|
S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ)
|
|
ENDIF
|
|
IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN
|
|
Q2DIV=PMC**2
|
|
SNF4=(6D0/(33D0-2D0*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/
|
|
& LOG(P2EFF/ALAMSQ(4)))
|
|
SNF3=(6D0/(33D0-2D0*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/
|
|
& LOG(P2EFF/ALAMSQ(3)))
|
|
S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4)
|
|
ENDIF
|
|
|
|
C...u and s quark do not need a separate treatment when d has been done.
|
|
ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN
|
|
|
|
C...Charm: as above, but only include range above c threshold.
|
|
ELSEIF(KFL.EQ.4) THEN
|
|
IF(Q2.LE.PMC**2) GOTO 110
|
|
P2EFF=MAX(P2EFF,PMC**2)
|
|
Q2EFF=MAX(Q2EFF,P2EFF)
|
|
TDIFF=LOG(Q2EFF/P2EFF)
|
|
S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/
|
|
& LOG(P2EFF/ALAMSQ(NFQ)))
|
|
IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN
|
|
Q2DIV=PMB**2
|
|
SNFQ=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/
|
|
& LOG(P2EFF/ALAMSQ(NFQ)))
|
|
SNFP=(6D0/(33D0-2D0*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/
|
|
& LOG(P2EFF/ALAMSQ(NFQ-1)))
|
|
S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ)
|
|
ENDIF
|
|
|
|
C...Bottom: as above, but only include range above b threshold.
|
|
ELSEIF(KFL.EQ.5) THEN
|
|
IF(Q2.LE.PMB**2) GOTO 110
|
|
P2EFF=MAX(P2EFF,PMB**2)
|
|
Q2EFF=MAX(Q2,P2EFF)
|
|
TDIFF=LOG(Q2EFF/P2EFF)
|
|
S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/
|
|
& LOG(P2EFF/ALAMSQ(NFQ)))
|
|
ENDIF
|
|
|
|
C...Evaluate flavour-dependent prefactor (charge^2 etc.).
|
|
CHSQ=1D0/9D0
|
|
IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4D0/9D0
|
|
FAC=AEM2PI*2D0*CHSQ*TDIFF
|
|
|
|
C...Evaluate parton distributions (normalized to unit momentum sum).
|
|
IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN
|
|
XVAL= ((1.5D0+2.49D0*S+26.9D0*S**2)/(1D0+32.3D0*S**2)*X**2 +
|
|
& (1.5D0-0.49D0*S+7.83D0*S**2)/(1D0+7.68D0*S**2)*(1D0-X)**2 +
|
|
& 1.5D0*S/(1D0-3.2D0*S+7D0*S**2)*X*(1D0-X)) *
|
|
& X**(1D0/(1D0+0.58D0*S)) * (1D0-X**2)**(2.5D0*S/(1D0+10D0*S))
|
|
XGLU= 2D0*S/(1D0+4D0*S+7D0*S**2) *
|
|
& X**(-1.67D0*S/(1D0+2D0*S)) * (1D0-X**2)**(1.2D0*S) *
|
|
& ((4D0*X**2+7D0*X+4D0)*(1D0-X)/3D0 - 2D0*X*(1D0+X)*XL)
|
|
XSEA= 0.333D0*S**2/(1D0+4.90D0*S+4.69D0*S**2+21.4D0*S**3) *
|
|
& X**(-1.18D0*S/(1D0+1.22D0*S)) * (1D0-X)**(1.2D0*S) *
|
|
& ((8D0-73D0*X+62D0*X**2)*(1D0-X)/9D0 +
|
|
& (3D0-8D0*X**2/3D0)*X*XL + (2D0*X-1D0)*X*XL**2)
|
|
|
|
C...Threshold factors for c and b sea.
|
|
SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2))
|
|
XCHM=0D0
|
|
IF(Q2.GT.PMC**2.AND.Q2.GT.1.001D0*P2EFF) THEN
|
|
SCH=MAX(0D0,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
|
|
XCHM=XSEA*(1D0-(SCH/SLL)**3)
|
|
ENDIF
|
|
XBOT=0D0
|
|
IF(Q2.GT.PMB**2.AND.Q2.GT.1.001D0*P2EFF) THEN
|
|
SBT=MAX(0D0,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
|
|
XBOT=XSEA*(1D0-(SBT/SLL)**3)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Add contribution of each valence flavour.
|
|
XPGA(0)=XPGA(0)+FAC*XGLU
|
|
XPGA(1)=XPGA(1)+FAC*XSEA
|
|
XPGA(2)=XPGA(2)+FAC*XSEA
|
|
XPGA(3)=XPGA(3)+FAC*XSEA
|
|
XPGA(4)=XPGA(4)+FAC*XCHM
|
|
XPGA(5)=XPGA(5)+FAC*XBOT
|
|
XPGA(KFL)=XPGA(KFL)+FAC*XVAL
|
|
VXPGA(KFL)=VXPGA(KFL)+FAC*XVAL
|
|
110 CONTINUE
|
|
DO 120 KFL=1,5
|
|
XPGA(-KFL)=XPGA(KFL)
|
|
VXPGA(-KFL)=VXPGA(KFL)
|
|
120 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGBEH
|
|
C...Evaluates the Bethe-Heitler cross section for heavy flavour
|
|
C...production.
|
|
C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand.
|
|
|
|
SUBROUTINE PYGBEH(KF,X,Q2,P2,PM2,XPBH)
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local data.
|
|
DATA AEM2PI/0.0011614D0/
|
|
|
|
C...Reset output.
|
|
XPBH=0D0
|
|
SIGBH=0D0
|
|
|
|
C...Check kinematics limits.
|
|
IF(X.GE.Q2/(4D0*PM2+Q2+P2)) RETURN
|
|
W2=Q2*(1D0-X)/X-P2
|
|
BETA2=1D0-4D0*PM2/W2
|
|
IF(BETA2.LT.1D-10) RETURN
|
|
BETA=SQRT(BETA2)
|
|
RMQ=4D0*PM2/Q2
|
|
|
|
C...Simple case: P2 = 0.
|
|
IF(P2.LT.1D-4) THEN
|
|
IF(BETA.LT.0.99D0) THEN
|
|
XBL=LOG((1D0+BETA)/(1D0-BETA))
|
|
ELSE
|
|
XBL=LOG((1D0+BETA)**2*W2/(4D0*PM2))
|
|
ENDIF
|
|
SIGBH=BETA*(8D0*X*(1D0-X)-1D0-RMQ*X*(1D0-X))+
|
|
& XBL*(X**2+(1D0-X)**2+RMQ*X*(1D0-3D0*X)-0.5D0*RMQ**2*X**2)
|
|
|
|
C...Complicated case: P2 > 0, based on approximation of
|
|
C...C.T. Hill and G.G. Ross, Nucl. Phys. B148 (1979) 373
|
|
ELSE
|
|
RPQ=1D0-4D0*X**2*P2/Q2
|
|
IF(RPQ.GT.1D-10) THEN
|
|
RPBE=SQRT(RPQ*BETA2)
|
|
IF(RPBE.LT.0.99D0) THEN
|
|
XBL=LOG((1D0+RPBE)/(1D0-RPBE))
|
|
XBI=2D0*RPBE/(1D0-RPBE**2)
|
|
ELSE
|
|
RPBESN=4D0*PM2/W2+(4D0*X**2*P2/Q2)*BETA2
|
|
XBL=LOG((1D0+RPBE)**2/RPBESN)
|
|
XBI=2D0*RPBE/RPBESN
|
|
ENDIF
|
|
SIGBH=BETA*(6D0*X*(1D0-X)-1D0)+
|
|
& XBL*(X**2+(1D0-X)**2+RMQ*X*(1D0-3D0*X)-0.5D0*RMQ**2*X**2)+
|
|
& XBI*(2D0*X/Q2)*(PM2*X*(2D0-RMQ)-P2*X)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Multiply by charge-squared etc. to get parton distribution.
|
|
CHSQ=1D0/9D0
|
|
IF(IABS(KF).EQ.2.OR.IABS(KF).EQ.4) CHSQ=4D0/9D0
|
|
XPBH=3D0*CHSQ*AEM2PI*X*SIGBH
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGDIR
|
|
C...Evaluates the direct contribution, i.e. the C^gamma term,
|
|
C...as needed in MSbar parametrizations.
|
|
C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand.
|
|
|
|
SUBROUTINE PYGDIR(X,Q2,P2,Q02,XPGA)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Local array and data.
|
|
DIMENSION XPGA(-6:6)
|
|
DATA PMC/1.3D0/, PMB/4.6D0/, AEM2PI/0.0011614D0/
|
|
|
|
C...Reset output.
|
|
DO 100 KFL=-6,6
|
|
XPGA(KFL)=0D0
|
|
100 CONTINUE
|
|
|
|
C...Evaluate common x-dependent expression.
|
|
XTMP = (X**2+(1D0-X)**2) * (-LOG(X)) - 1D0
|
|
CGAM = 3D0*AEM2PI*X * (XTMP*(1D0+P2/(P2+Q02)) + 6D0*X*(1D0-X))
|
|
|
|
C...d, u, s part by simple charge factor.
|
|
XPGA(1)=(1D0/9D0)*CGAM
|
|
XPGA(2)=(4D0/9D0)*CGAM
|
|
XPGA(3)=(1D0/9D0)*CGAM
|
|
|
|
C...Also fill for antiquarks.
|
|
DO 110 KF=1,5
|
|
XPGA(-KF)=XPGA(KF)
|
|
110 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPDPI
|
|
C...Gives pi+ parton distribution according to two different
|
|
C...parametrizations.
|
|
|
|
SUBROUTINE PYPDPI(X,Q2,XPPI)
|
|
|
|
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...Local arrays.
|
|
DIMENSION XPPI(-6:6),COW(3,5,4,2),XQ(9),TS(6)
|
|
|
|
C...The following data lines are coefficients needed in the
|
|
C...Owens pion parton distribution parametrizations, see below.
|
|
C...Expansion coefficients for up and down valence quark distributions.
|
|
DATA ((COW(IP,IS,1,1),IS=1,5),IP=1,3)/
|
|
&4.0000D-01, 7.0000D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00,
|
|
&-6.2120D-02, 6.4780D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00,
|
|
&-7.1090D-03, 1.3350D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/
|
|
DATA ((COW(IP,IS,1,2),IS=1,5),IP=1,3)/
|
|
&4.0000D-01, 6.2800D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00,
|
|
&-5.9090D-02, 6.4360D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00,
|
|
&-6.5240D-03, 1.4510D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/
|
|
C...Expansion coefficients for gluon distribution.
|
|
DATA ((COW(IP,IS,2,1),IS=1,5),IP=1,3)/
|
|
&8.8800D-01, 0.0000D+00, 3.1100D+00, 6.0000D+00, 0.0000D+00,
|
|
&-1.8020D+00, -1.5760D+00, -1.3170D-01, 2.8010D+00, -1.7280D+01,
|
|
&1.8120D+00, 1.2000D+00, 5.0680D-01, -1.2160D+01, 2.0490D+01/
|
|
DATA ((COW(IP,IS,2,2),IS=1,5),IP=1,3)/
|
|
&7.9400D-01, 0.0000D+00, 2.8900D+00, 6.0000D+00, 0.0000D+00,
|
|
&-9.1440D-01, -1.2370D+00, 5.9660D-01, -3.6710D+00, -8.1910D+00,
|
|
&5.9660D-01, 6.5820D-01, -2.5500D-01, -2.3040D+00, 7.7580D+00/
|
|
C...Expansion coefficients for (up+down+strange) quark sea distribution.
|
|
DATA ((COW(IP,IS,3,1),IS=1,5),IP=1,3)/
|
|
&9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00,
|
|
&-2.4280D-01, -2.1200D-01, 8.6730D-01, 1.2660D+00, 2.3820D+00,
|
|
&1.3860D-01, 3.6710D-03, 4.7470D-02, -2.2150D+00, 3.4820D-01/
|
|
DATA ((COW(IP,IS,3,2),IS=1,5),IP=1,3)/
|
|
&9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00,
|
|
&-1.4170D-01, -1.6970D-01, -2.4740D+00, -2.5340D+00, 5.6210D-01,
|
|
&-1.7400D-01, -9.6230D-02, 1.5750D+00, 1.3780D+00, -2.7010D-01/
|
|
C...Expansion coefficients for charm quark sea distribution.
|
|
DATA ((COW(IP,IS,4,1),IS=1,5),IP=1,3)/
|
|
&0.0000D+00, -2.2120D-02, 2.8940D+00, 0.0000D+00, 0.0000D+00,
|
|
&7.9280D-02, -3.7850D-01, 9.4330D+00, 5.2480D+00, 8.3880D+00,
|
|
&-6.1340D-02, -1.0880D-01, -1.0852D+01, -7.1870D+00, -1.1610D+01/
|
|
DATA ((COW(IP,IS,4,2),IS=1,5),IP=1,3)/
|
|
&0.0000D+00, -8.8200D-02, 1.9240D+00, 0.0000D+00, 0.0000D+00,
|
|
&6.2290D-02, -2.8920D-01, 2.4240D-01, -4.4630D+00, -8.3670D-01,
|
|
&-4.0990D-02, -1.0820D-01, 2.0360D+00, 5.2090D+00, -4.8400D-02/
|
|
|
|
C...Euler's beta function, requires ordinary Gamma function
|
|
EULBET(X,Y)=PYGAMM(X)*PYGAMM(Y)/PYGAMM(X+Y)
|
|
|
|
C...Reset output array.
|
|
DO 100 KFL=-6,6
|
|
XPPI(KFL)=0D0
|
|
100 CONTINUE
|
|
|
|
IF(MSTP(53).LE.2) THEN
|
|
C...Pion parton distributions from Owens.
|
|
C...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2.
|
|
|
|
C...Determine set, Lambda and s expansion variable.
|
|
NSET=MSTP(53)
|
|
IF(NSET.EQ.1) ALAM=0.2D0
|
|
IF(NSET.EQ.2) ALAM=0.4D0
|
|
VINT(231)=4D0
|
|
IF(MSTP(57).LE.0) THEN
|
|
SD=0D0
|
|
ELSE
|
|
Q2IN=MIN(2D3,MAX(4D0,Q2))
|
|
SD=LOG(LOG(Q2IN/ALAM**2)/LOG(4D0/ALAM**2))
|
|
ENDIF
|
|
|
|
C...Calculate parton distributions.
|
|
DO 120 KFL=1,4
|
|
DO 110 IS=1,5
|
|
TS(IS)=COW(1,IS,KFL,NSET)+COW(2,IS,KFL,NSET)*SD+
|
|
& COW(3,IS,KFL,NSET)*SD**2
|
|
110 CONTINUE
|
|
IF(KFL.EQ.1) THEN
|
|
XQ(KFL)=X**TS(1)*(1D0-X)**TS(2)/EULBET(TS(1),TS(2)+1D0)
|
|
ELSE
|
|
XQ(KFL)=TS(1)*X**TS(2)*(1D0-X)**TS(3)*(1D0+TS(4)*X+
|
|
& TS(5)*X**2)
|
|
ENDIF
|
|
120 CONTINUE
|
|
|
|
C...Put into output array.
|
|
XPPI(0)=XQ(2)
|
|
XPPI(1)=XQ(3)/6D0
|
|
XPPI(2)=XQ(1)+XQ(3)/6D0
|
|
XPPI(3)=XQ(3)/6D0
|
|
XPPI(4)=XQ(4)
|
|
XPPI(-1)=XQ(1)+XQ(3)/6D0
|
|
XPPI(-2)=XQ(3)/6D0
|
|
XPPI(-3)=XQ(3)/6D0
|
|
XPPI(-4)=XQ(4)
|
|
|
|
C...Leading order pion parton distributions from Gluck, Reya and Vogt.
|
|
C...Allowed variable range: 0.25 GeV^2 < Q^2 < 10^8 GeV^2 and
|
|
C...10^-5 < x < 1.
|
|
ELSE
|
|
|
|
C...Determine s expansion variable and some x expressions.
|
|
VINT(231)=0.25D0
|
|
IF(MSTP(57).LE.0) THEN
|
|
SD=0D0
|
|
ELSE
|
|
Q2IN=MIN(1D8,MAX(0.25D0,Q2))
|
|
SD=LOG(LOG(Q2IN/0.232D0**2)/LOG(0.25D0/0.232D0**2))
|
|
ENDIF
|
|
SD2=SD**2
|
|
XL=-LOG(X)
|
|
XS=SQRT(X)
|
|
|
|
C...Evaluate valence, gluon and sea distributions.
|
|
XFVAL=(0.519D0+0.180D0*SD-0.011D0*SD2)*X**(0.499D0-0.027D0*SD)*
|
|
& (1D0+(0.381D0-0.419D0*SD)*XS)*(1D0-X)**(0.367D0+0.563D0*SD)
|
|
XFGLU=(X**(0.482D0+0.341D0*SQRT(SD))*((0.678D0+0.877D0*
|
|
& SD-0.175D0*SD2)+
|
|
& (0.338D0-1.597D0*SD)*XS+(-0.233D0*SD+0.406D0*SD2)*X)+
|
|
& SD**0.599D0*EXP(-(0.618D0+2.070D0*SD)+SQRT(3.676D0*SD**1.263D0*
|
|
& XL)))*
|
|
& (1D0-X)**(0.390D0+1.053D0*SD)
|
|
XFSEA=SD**0.55D0*(1D0-0.748D0*XS+(0.313D0+0.935D0*SD)*X)*(1D0-
|
|
& X)**3.359D0*
|
|
& EXP(-(4.433D0+1.301D0*SD)+SQRT((9.30D0-0.887D0*SD)*SD**0.56D0*
|
|
& XL))/
|
|
& XL**(2.538D0-0.763D0*SD)
|
|
IF(SD.LE.0.888D0) THEN
|
|
XFCHM=0D0
|
|
ELSE
|
|
XFCHM=(SD-0.888D0)**1.02D0*(1D0+1.008D0*X)*(1D0-X)**(1.208D0+
|
|
& 0.771D0*SD)*
|
|
& EXP(-(4.40D0+1.493D0*SD)+SQRT((2.032D0+1.901D0*SD)*SD**0.39D0*
|
|
& XL))
|
|
ENDIF
|
|
IF(SD.LE.1.351D0) THEN
|
|
XFBOT=0D0
|
|
ELSE
|
|
XFBOT=(SD-1.351D0)**1.03D0*(1D0-X)**(0.697D0+0.855D0*SD)*
|
|
& EXP(-(4.51D0+1.490D0*SD)+SQRT((3.056D0+1.694D0*SD)*SD**0.39D0*
|
|
& XL))
|
|
ENDIF
|
|
|
|
C...Put into output array.
|
|
XPPI(0)=XFGLU
|
|
XPPI(1)=XFSEA
|
|
XPPI(2)=XFSEA
|
|
XPPI(3)=XFSEA
|
|
XPPI(4)=XFCHM
|
|
XPPI(5)=XFBOT
|
|
DO 130 KFL=1,5
|
|
XPPI(-KFL)=XPPI(KFL)
|
|
130 CONTINUE
|
|
XPPI(2)=XPPI(2)+XFVAL
|
|
XPPI(-1)=XPPI(-1)+XFVAL
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPDPR
|
|
C...Gives proton parton distributions according to a few different
|
|
C...parametrizations.
|
|
|
|
SUBROUTINE PYPDPR(X,Q2,XPPR)
|
|
|
|
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/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYINT1/MINT(400),VINT(400)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/
|
|
C...Arrays and data.
|
|
DIMENSION XPPR(-6:6),Q2MIN(6)
|
|
DATA Q2MIN/ 2.56D0, 2.56D0, 2.56D0, 0.4D0, 0.4D0, 0.4D0/
|
|
|
|
C...Reset output array.
|
|
DO 100 KFL=-6,6
|
|
XPPR(KFL)=0D0
|
|
100 CONTINUE
|
|
|
|
C...Common preliminaries.
|
|
NSET=MAX(1,MIN(6,MSTP(51)))
|
|
VINT(231)=Q2MIN(NSET)
|
|
IF(MSTP(57).EQ.0) THEN
|
|
Q2L=Q2MIN(NSET)
|
|
ELSE
|
|
Q2L=MAX(Q2MIN(NSET),Q2)
|
|
ENDIF
|
|
|
|
IF(NSET.GE.1.AND.NSET.LE.3) THEN
|
|
C...Interface to the CTEQ 3 parton distributions.
|
|
QRT=SQRT(MAX(1D0,Q2L))
|
|
|
|
C...Loop over flavours.
|
|
DO 110 I=-6,6
|
|
IF(I.LE.0) THEN
|
|
XPPR(I)=PYCTEQ(NSET,I,X,QRT)
|
|
ELSEIF(I.LE.2) THEN
|
|
XPPR(I)=PYCTEQ(NSET,I,X,QRT)+XPPR(-I)
|
|
ELSE
|
|
XPPR(I)=XPPR(-I)
|
|
ENDIF
|
|
110 CONTINUE
|
|
|
|
ELSEIF(NSET.GE.4.AND.NSET.LE.6) THEN
|
|
C...Interface to the GRV 94 distributions.
|
|
IF(NSET.EQ.4) THEN
|
|
CALL PYGRVL (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL)
|
|
ELSEIF(NSET.EQ.5) THEN
|
|
CALL PYGRVM (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL)
|
|
ELSE
|
|
CALL PYGRVD (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL)
|
|
ENDIF
|
|
|
|
C...Put into output array.
|
|
XPPR(0)=GL
|
|
XPPR(-1)=0.5D0*(UDB+DEL)
|
|
XPPR(-2)=0.5D0*(UDB-DEL)
|
|
XPPR(-3)=SB
|
|
XPPR(-4)=CHM
|
|
XPPR(-5)=BOT
|
|
XPPR(1)=DV+XPPR(-1)
|
|
XPPR(2)=UV+XPPR(-2)
|
|
XPPR(3)=SB
|
|
XPPR(4)=CHM
|
|
XPPR(5)=BOT
|
|
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYCTEQ
|
|
C...Gives the CTEQ 3 parton distribution function sets in
|
|
C...parametrized form, of October 24, 1994.
|
|
C...Authors: H.L. Lai, J. Botts, J. Huston, J.G. Morfin, J.F. Owens,
|
|
C...J. Qiu, W.K. Tung and H. Weerts.
|
|
|
|
FUNCTION PYCTEQ (ISET, IPRT, X, Q)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
|
|
C...Data on Lambda values of fits, minimum Q and quark masses.
|
|
DIMENSION ALM(3), QMS(4:6)
|
|
DATA ALM / 0.177D0, 0.239D0, 0.247D0 /
|
|
DATA QMN / 1.60D0 /, (QMS(I), I=4,6) / 1.60D0, 5.00D0, 180.0D0 /
|
|
|
|
C....Check flavour thresholds. Set up QI for SB.
|
|
IP = IABS(IPRT)
|
|
IF(IP .GE. 4) THEN
|
|
IF(Q .LE. QMS(IP)) THEN
|
|
PYCTEQ = 0D0
|
|
RETURN
|
|
ENDIF
|
|
QI = QMS(IP)
|
|
ELSE
|
|
QI = QMN
|
|
ENDIF
|
|
|
|
C...Use "standard lambda" of parametrization program for expansion.
|
|
ALAM = ALM (ISET)
|
|
SBL = LOG(Q/ALAM) / LOG(QI/ALAM)
|
|
SB = LOG (SBL)
|
|
SB2 = SB*SB
|
|
SB3 = SB2*SB
|
|
|
|
C...Expansion for CTEQ3L.
|
|
IF(ISET .EQ. 1) THEN
|
|
IF(IPRT .EQ. 2) THEN
|
|
A0=Exp( 0.1907D+00+0.4205D-01*SB +0.2752D+00*SB2-
|
|
& 0.3171D+00*SB3)
|
|
A1= 0.4611D+00+0.2331D-01*SB -0.3403D-01*SB2+0.3174D-01*SB3
|
|
A2= 0.3504D+01+0.5739D+00*SB +0.2676D+00*SB2-0.1553D+00*SB3
|
|
A3= 0.7452D+01-0.6742D+01*SB +0.2849D+01*SB2-0.1964D+00*SB3
|
|
A4= 0.1116D+01-0.3435D+00*SB +0.2865D+00*SB2-0.1288D+00*SB3
|
|
A5= 0.6659D-01+0.2714D+00*SB -0.2688D+00*SB2+0.2763D+00*SB3
|
|
ELSEIF(IPRT .EQ. 1) THEN
|
|
A0=Exp( 0.1141D+00+0.4764D+00*SB -0.1745D+01*SB2+
|
|
& 0.7728D+00*SB3)
|
|
A1= 0.4275D+00-0.1290D+00*SB +0.3609D+00*SB2-0.1689D+00*SB3
|
|
A2= 0.3000D+01+0.2946D+01*SB -0.4117D+01*SB2+0.1989D+01*SB3
|
|
A3=-0.1302D+01+0.2322D+01*SB -0.4258D+01*SB2+0.2109D+01*SB3
|
|
A4= 0.2586D+01-0.1920D+00*SB -0.3754D+00*SB2+0.2731D+00*SB3
|
|
A5=-0.2251D+00-0.5374D+00*SB +0.2245D+01*SB2-0.1034D+01*SB3
|
|
ELSEIF(IPRT .EQ. 0) THEN
|
|
A0=Exp(-0.7631D+00-0.7241D+00*SB -0.1170D+01*SB2+
|
|
& 0.5343D+00*SB3)
|
|
A1=-0.3573D+00+0.3469D+00*SB -0.3396D+00*SB2+0.9188D-01*SB3
|
|
A2= 0.5604D+01+0.7458D+00*SB -0.5082D+00*SB2+0.1844D+00*SB3
|
|
A3= 0.1549D+02-0.1809D+02*SB +0.1162D+02*SB2-0.3483D+01*SB3
|
|
A4= 0.9881D+00+0.1364D+00*SB -0.4421D+00*SB2+0.2051D+00*SB3
|
|
A5=-0.9505D-01+0.3259D+01*SB -0.1547D+01*SB2+0.2918D+00*SB3
|
|
ELSEIF(IPRT .EQ. -1) THEN
|
|
A0=Exp(-0.2449D+01-0.3513D+01*SB +0.4529D+01*SB2-
|
|
& 0.2031D+01*SB3)
|
|
A1=-0.4050D+00+0.3411D+00*SB -0.3669D+00*SB2+0.1109D+00*SB3
|
|
A2= 0.7470D+01-0.2982D+01*SB +0.5503D+01*SB2-0.2419D+01*SB3
|
|
A3= 0.1503D+02+0.1638D+01*SB -0.8772D+01*SB2+0.3852D+01*SB3
|
|
A4= 0.1137D+01-0.1006D+01*SB +0.1485D+01*SB2-0.6389D+00*SB3
|
|
A5=-0.5299D+00+0.3160D+01*SB -0.3104D+01*SB2+0.1219D+01*SB3
|
|
ELSEIF(IPRT .EQ. -2) THEN
|
|
A0=Exp(-0.2740D+01-0.7987D-01*SB -0.9015D+00*SB2-
|
|
& 0.9872D-01*SB3)
|
|
A1=-0.3909D+00+0.1244D+00*SB -0.4487D-01*SB2+0.1277D-01*SB3
|
|
A2= 0.9163D+01+0.2823D+00*SB -0.7720D+00*SB2-0.9360D-02*SB3
|
|
A3= 0.1080D+02-0.3915D+01*SB -0.1153D+01*SB2+0.2649D+01*SB3
|
|
A4= 0.9894D+00-0.1647D+00*SB -0.9426D-02*SB2+0.2945D-02*SB3
|
|
A5=-0.3395D+00+0.6998D+00*SB +0.7000D+00*SB2-0.6730D-01*SB3
|
|
ELSEIF(IPRT .EQ. -3) THEN
|
|
A0=Exp(-0.3640D+01+0.1250D+01*SB -0.2914D+01*SB2+
|
|
& 0.8390D+00*SB3)
|
|
A1=-0.3595D+00-0.5259D-01*SB +0.3122D+00*SB2-0.1642D+00*SB3
|
|
A2= 0.7305D+01+0.9727D+00*SB -0.9788D+00*SB2-0.5193D-01*SB3
|
|
A3= 0.1198D+02-0.1799D+02*SB +0.2614D+02*SB2-0.1091D+02*SB3
|
|
A4= 0.9882D+00-0.6101D+00*SB +0.9737D+00*SB2-0.4935D+00*SB3
|
|
A5=-0.1186D+00-0.3231D+00*SB +0.3074D+01*SB2-0.1274D+01*SB3
|
|
ELSEIF(IPRT .EQ. -4) THEN
|
|
A0=SB** 0.1122D+01*Exp(-0.3718D+01-0.1335D+01*SB +
|
|
& 0.1651D-01*SB2)
|
|
A1=-0.4719D+00+0.7509D+00*SB -0.8420D+00*SB2+0.2901D+00*SB3
|
|
A2= 0.6194D+01-0.1641D+01*SB +0.4907D+01*SB2-0.2523D+01*SB3
|
|
A3= 0.4426D+01-0.4270D+01*SB +0.6581D+01*SB2-0.3474D+01*SB3
|
|
A4= 0.2683D+00+0.9876D+00*SB -0.7612D+00*SB2+0.1780D+00*SB3
|
|
A5=-0.4547D+00+0.4410D+01*SB -0.3712D+01*SB2+0.1245D+01*SB3
|
|
ELSEIF(IPRT .EQ. -5) THEN
|
|
A0=SB** 0.9838D+00*Exp(-0.2548D+01-0.7660D+01*SB +
|
|
& 0.3702D+01*SB2)
|
|
A1=-0.3122D+00-0.2120D+00*SB +0.5716D+00*SB2-0.3773D+00*SB3
|
|
A2= 0.6257D+01-0.8214D-01*SB -0.2537D+01*SB2+0.2981D+01*SB3
|
|
A3=-0.6723D+00+0.2131D+01*SB +0.9599D+01*SB2-0.7910D+01*SB3
|
|
A4= 0.9169D-01+0.4295D-01*SB -0.5017D+00*SB2+0.3811D+00*SB3
|
|
A5= 0.2402D+00+0.2656D+01*SB -0.1586D+01*SB2+0.2880D+00*SB3
|
|
ELSEIF(IPRT .EQ. -6) THEN
|
|
A0=SB** 0.1001D+01*Exp(-0.6934D+01+0.3050D+01*SB -
|
|
& 0.6943D+00*SB2)
|
|
A1=-0.1713D+00-0.5167D+00*SB +0.1241D+01*SB2-0.1703D+01*SB3
|
|
A2= 0.6169D+01+0.3023D+01*SB -0.1972D+02*SB2+0.1069D+02*SB3
|
|
A3= 0.4439D+01-0.1746D+02*SB +0.1225D+02*SB2+0.8350D+00*SB3
|
|
A4= 0.5458D+00-0.4586D+00*SB +0.9089D+00*SB2-0.4049D+00*SB3
|
|
A5= 0.3207D+01-0.3362D+01*SB +0.5877D+01*SB2-0.7659D+01*SB3
|
|
ENDIF
|
|
|
|
C...Expansion for CTEQ3M.
|
|
ELSEIF(ISET .EQ. 2) THEN
|
|
IF(IPRT .EQ. 2) THEN
|
|
A0=Exp( 0.2259D+00+0.1237D+00*SB +0.3035D+00*SB2-
|
|
& 0.2935D+00*SB3)
|
|
A1= 0.5085D+00+0.1651D-01*SB -0.3592D-01*SB2+0.2782D-01*SB3
|
|
A2= 0.3732D+01+0.4901D+00*SB +0.2218D+00*SB2-0.1116D+00*SB3
|
|
A3= 0.7011D+01-0.6620D+01*SB +0.2557D+01*SB2-0.1360D+00*SB3
|
|
A4= 0.8969D+00-0.2429D+00*SB +0.1811D+00*SB2-0.6888D-01*SB3
|
|
A5= 0.8636D-01+0.2558D+00*SB -0.3082D+00*SB2+0.2535D+00*SB3
|
|
ELSEIF(IPRT .EQ. 1) THEN
|
|
A0=Exp(-0.7266D+00-0.1584D+01*SB +0.1259D+01*SB2-
|
|
& 0.4305D-01*SB3)
|
|
A1= 0.5285D+00-0.3721D+00*SB +0.5150D+00*SB2-0.1697D+00*SB3
|
|
A2= 0.4075D+01+0.8282D+00*SB -0.4496D+00*SB2+0.2107D+00*SB3
|
|
A3= 0.3279D+01+0.5066D+01*SB -0.9134D+01*SB2+0.2897D+01*SB3
|
|
A4= 0.4399D+00-0.5888D+00*SB +0.4802D+00*SB2-0.1664D+00*SB3
|
|
A5= 0.3678D+00-0.8929D+00*SB +0.1592D+01*SB2-0.5713D+00*SB3
|
|
ELSEIF(IPRT .EQ. 0) THEN
|
|
A0=Exp(-0.2318D+00-0.9779D+00*SB -0.3783D+00*SB2+
|
|
& 0.1037D-01*SB3)
|
|
A1=-0.2916D+00+0.1754D+00*SB -0.1884D+00*SB2+0.6116D-01*SB3
|
|
A2= 0.5349D+01+0.7460D+00*SB +0.2319D+00*SB2-0.2622D+00*SB3
|
|
A3= 0.6920D+01-0.3454D+01*SB +0.2027D+01*SB2-0.7626D+00*SB3
|
|
A4= 0.1013D+01+0.1423D+00*SB -0.1798D+00*SB2+0.1872D-01*SB3
|
|
A5=-0.5465D-01+0.2303D+01*SB -0.9584D+00*SB2+0.3098D+00*SB3
|
|
ELSEIF(IPRT .EQ. -1) THEN
|
|
A0=Exp(-0.2328D+01-0.3061D+01*SB +0.3620D+01*SB2-
|
|
& 0.1602D+01*SB3)
|
|
A1=-0.3358D+00+0.3198D+00*SB -0.4210D+00*SB2+0.1571D+00*SB3
|
|
A2= 0.8478D+01-0.3112D+01*SB +0.5243D+01*SB2-0.2255D+01*SB3
|
|
A3= 0.1971D+02+0.3389D+00*SB -0.5268D+01*SB2+0.2099D+01*SB3
|
|
A4= 0.1128D+01-0.4701D+00*SB +0.7779D+00*SB2-0.3506D+00*SB3
|
|
A5=-0.4708D+00+0.3341D+01*SB -0.3375D+01*SB2+0.1353D+01*SB3
|
|
ELSEIF(IPRT .EQ. -2) THEN
|
|
A0=Exp(-0.2906D+01-0.1069D+00*SB -0.1055D+01*SB2+
|
|
& 0.2496D+00*SB3)
|
|
A1=-0.2875D+00+0.6571D-01*SB -0.1987D-01*SB2-0.1800D-02*SB3
|
|
A2= 0.9854D+01-0.2715D+00*SB -0.7407D+00*SB2+0.2888D+00*SB3
|
|
A3= 0.1583D+02-0.7687D+01*SB +0.3428D+01*SB2-0.3327D+00*SB3
|
|
A4= 0.9763D+00+0.7599D-01*SB -0.2128D+00*SB2+0.6852D-01*SB3
|
|
A5=-0.8444D-02+0.9434D+00*SB +0.4152D+00*SB2-0.1481D+00*SB3
|
|
ELSEIF(IPRT .EQ. -3) THEN
|
|
A0=Exp(-0.3780D+01+0.2499D+01*SB -0.4962D+01*SB2+
|
|
& 0.1936D+01*SB3)
|
|
A1=-0.2639D+00-0.1575D+00*SB +0.3584D+00*SB2-0.1646D+00*SB3
|
|
A2= 0.8082D+01+0.2794D+01*SB -0.5438D+01*SB2+0.2321D+01*SB3
|
|
A3= 0.1811D+02-0.2000D+02*SB +0.1951D+02*SB2-0.6904D+01*SB3
|
|
A4= 0.9822D+00+0.4972D+00*SB -0.8690D+00*SB2+0.3415D+00*SB3
|
|
A5= 0.1772D+00-0.6078D+00*SB +0.3341D+01*SB2-0.1473D+01*SB3
|
|
ELSEIF(IPRT .EQ. -4) THEN
|
|
A0=SB** 0.1122D+01*Exp(-0.4232D+01-0.1808D+01*SB +
|
|
& 0.5348D+00*SB2)
|
|
A1=-0.2824D+00+0.5846D+00*SB -0.7230D+00*SB2+0.2419D+00*SB3
|
|
A2= 0.5683D+01-0.2948D+01*SB +0.5916D+01*SB2-0.2560D+01*SB3
|
|
A3= 0.2051D+01+0.4795D+01*SB -0.4271D+01*SB2+0.4174D+00*SB3
|
|
A4= 0.1737D+00+0.1717D+01*SB -0.1978D+01*SB2+0.6643D+00*SB3
|
|
A5= 0.8689D+00+0.3500D+01*SB -0.3283D+01*SB2+0.1026D+01*SB3
|
|
ELSEIF(IPRT .EQ. -5) THEN
|
|
A0=SB** 0.9906D+00*Exp(-0.1496D+01-0.6576D+01*SB +
|
|
& 0.1569D+01*SB2)
|
|
A1=-0.2140D+00-0.6419D-01*SB -0.2741D-02*SB2+0.3185D-02*SB3
|
|
A2= 0.5781D+01+0.1049D+00*SB -0.3930D+00*SB2+0.5174D+00*SB3
|
|
A3=-0.9420D+00+0.5511D+00*SB +0.8817D+00*SB2+0.1903D+01*SB3
|
|
A4= 0.2418D-01+0.4232D-01*SB -0.1244D-01*SB2-0.2365D-01*SB3
|
|
A5= 0.7664D+00+0.1794D+01*SB -0.4917D+00*SB2-0.1284D+00*SB3
|
|
ELSEIF(IPRT .EQ. -6) THEN
|
|
A0=SB** 0.1000D+01*Exp(-0.8460D+01+0.1154D+01*SB +
|
|
& 0.8838D+01*SB2)
|
|
A1=-0.4316D-01-0.2976D+00*SB +0.3174D+00*SB2-0.1429D+01*SB3
|
|
A2= 0.4910D+01+0.2273D+01*SB +0.5631D+01*SB2-0.1994D+02*SB3
|
|
A3= 0.1190D+02-0.2000D+02*SB -0.2000D+02*SB2+0.1292D+02*SB3
|
|
A4= 0.5771D+00-0.2552D+00*SB +0.7510D+00*SB2+0.6923D+00*SB3
|
|
A5= 0.4402D+01-0.1627D+01*SB -0.2085D+01*SB2-0.6737D+01*SB3
|
|
ENDIF
|
|
|
|
C...Expansion for CTEQ3D.
|
|
ELSEIF(ISET .EQ. 3) THEN
|
|
IF(IPRT .EQ. 2) THEN
|
|
A0=Exp( 0.2148D+00+0.5814D-01*SB +0.2734D+00*SB2-
|
|
& 0.2902D+00*SB3)
|
|
A1= 0.4810D+00+0.1657D-01*SB -0.3800D-01*SB2+0.3125D-01*SB3
|
|
A2= 0.3509D+01+0.3923D+00*SB +0.4010D+00*SB2-0.1932D+00*SB3
|
|
A3= 0.7055D+01-0.6552D+01*SB +0.3466D+01*SB2-0.5657D+00*SB3
|
|
A4= 0.1061D+01-0.3453D+00*SB +0.4089D+00*SB2-0.1817D+00*SB3
|
|
A5= 0.8687D-01+0.2548D+00*SB -0.2967D+00*SB2+0.2647D+00*SB3
|
|
ELSEIF(IPRT .EQ. 1) THEN
|
|
A0=Exp( 0.3961D+00+0.4914D+00*SB -0.1728D+01*SB2+
|
|
& 0.7257D+00*SB3)
|
|
A1= 0.4162D+00-0.1419D+00*SB +0.3680D+00*SB2-0.1618D+00*SB3
|
|
A2= 0.3248D+01+0.3028D+01*SB -0.4307D+01*SB2+0.1920D+01*SB3
|
|
A3=-0.1100D+01+0.2184D+01*SB -0.3820D+01*SB2+0.1717D+01*SB3
|
|
A4= 0.2082D+01-0.2756D+00*SB +0.3043D+00*SB2-0.1260D+00*SB3
|
|
A5=-0.4822D+00-0.5706D+00*SB +0.2243D+01*SB2-0.9760D+00*SB3
|
|
ELSEIF(IPRT .EQ. 0) THEN
|
|
A0=Exp(-0.4665D+00-0.7554D+00*SB -0.3323D+00*SB2-
|
|
& 0.2734D-04*SB3)
|
|
A1=-0.3359D+00+0.2395D+00*SB -0.2377D+00*SB2+0.7059D-01*SB3
|
|
A2= 0.5451D+01+0.6086D+00*SB +0.8606D-01*SB2-0.1425D+00*SB3
|
|
A3= 0.1026D+02-0.9352D+01*SB +0.4879D+01*SB2-0.1150D+01*SB3
|
|
A4= 0.9935D+00-0.5017D-01*SB -0.1707D-01*SB2-0.1464D-02*SB3
|
|
A5=-0.4160D-01+0.2305D+01*SB -0.1063D+01*SB2+0.3211D+00*SB3
|
|
ELSEIF(IPRT .EQ. -1) THEN
|
|
A0=Exp(-0.2714D+01-0.2868D+01*SB +0.3700D+01*SB2-
|
|
& 0.1671D+01*SB3)
|
|
A1=-0.3893D+00+0.3341D+00*SB -0.3897D+00*SB2+0.1420D+00*SB3
|
|
A2= 0.8359D+01-0.3267D+01*SB +0.5327D+01*SB2-0.2245D+01*SB3
|
|
A3= 0.2359D+02-0.5669D+01*SB -0.4602D+01*SB2+0.3153D+01*SB3
|
|
A4= 0.1106D+01-0.4745D+00*SB +0.7739D+00*SB2-0.3417D+00*SB3
|
|
A5=-0.5557D+00+0.3433D+01*SB -0.3390D+01*SB2+0.1354D+01*SB3
|
|
ELSEIF(IPRT .EQ. -2) THEN
|
|
A0=Exp(-0.3323D+01+0.2296D+00*SB -0.1109D+01*SB2+
|
|
& 0.2223D+00*SB3)
|
|
A1=-0.3410D+00+0.8847D-01*SB -0.1111D-01*SB2-0.5927D-02*SB3
|
|
A2= 0.9753D+01-0.5182D+00*SB -0.4670D+00*SB2+0.1921D+00*SB3
|
|
A3= 0.1977D+02-0.1600D+02*SB +0.9481D+01*SB2-0.1864D+01*SB3
|
|
A4= 0.9818D+00+0.2839D-02*SB -0.1188D+00*SB2+0.3584D-01*SB3
|
|
A5=-0.7934D-01+0.1004D+01*SB +0.3704D+00*SB2-0.1220D+00*SB3
|
|
ELSEIF(IPRT .EQ. -3) THEN
|
|
A0=Exp(-0.3985D+01+0.2855D+01*SB -0.5208D+01*SB2+
|
|
& 0.1937D+01*SB3)
|
|
A1=-0.3337D+00-0.1150D+00*SB +0.3691D+00*SB2-0.1709D+00*SB3
|
|
A2= 0.7968D+01+0.3641D+01*SB -0.6599D+01*SB2+0.2642D+01*SB3
|
|
A3= 0.1873D+02-0.1999D+02*SB +0.1734D+02*SB2-0.5813D+01*SB3
|
|
A4= 0.9731D+00+0.5082D+00*SB -0.8780D+00*SB2+0.3231D+00*SB3
|
|
A5=-0.5542D-01-0.4189D+00*SB +0.3309D+01*SB2-0.1439D+01*SB3
|
|
ELSEIF(IPRT .EQ. -4) THEN
|
|
A0=SB** 0.1105D+01*Exp(-0.3952D+01-0.1901D+01*SB +
|
|
& 0.5137D+00*SB2)
|
|
A1=-0.3543D+00+0.6055D+00*SB -0.6941D+00*SB2+0.2278D+00*SB3
|
|
A2= 0.5955D+01-0.2629D+01*SB +0.5337D+01*SB2-0.2300D+01*SB3
|
|
A3= 0.1933D+01+0.4882D+01*SB -0.3810D+01*SB2+0.2290D+00*SB3
|
|
A4= 0.1806D+00+0.1655D+01*SB -0.1893D+01*SB2+0.6395D+00*SB3
|
|
A5= 0.4790D+00+0.3612D+01*SB -0.3152D+01*SB2+0.9684D+00*SB3
|
|
ELSEIF(IPRT .EQ. -5) THEN
|
|
A0=SB** 0.9818D+00*Exp(-0.1825D+01-0.7464D+01*SB +
|
|
& 0.2143D+01*SB2)
|
|
A1=-0.2604D+00-0.1400D+00*SB +0.1702D+00*SB2-0.8476D-01*SB3
|
|
A2= 0.6005D+01+0.6275D+00*SB -0.2535D+01*SB2+0.2219D+01*SB3
|
|
A3=-0.9067D+00+0.1149D+01*SB +0.1974D+01*SB2+0.4716D+01*SB3
|
|
A4= 0.3915D-01+0.5945D-01*SB -0.9844D-01*SB2+0.2783D-01*SB3
|
|
A5= 0.5500D+00+0.1994D+01*SB -0.6727D+00*SB2-0.1510D+00*SB3
|
|
ELSEIF(IPRT .EQ. -6) THEN
|
|
A0=SB** 0.1002D+01*Exp(-0.8553D+01+0.3793D+00*SB +
|
|
& 0.9998D+01*SB2)
|
|
A1=-0.5870D-01-0.2792D+00*SB +0.6526D+00*SB2-0.1984D+01*SB3
|
|
A2= 0.4716D+01+0.4473D+00*SB +0.1128D+02*SB2-0.1937D+02*SB3
|
|
A3= 0.1289D+02-0.1742D+02*SB -0.1983D+02*SB2-0.9274D+00*SB3
|
|
A4= 0.5647D+00-0.2732D+00*SB +0.1074D+01*SB2+0.5981D+00*SB3
|
|
A5= 0.4390D+01-0.1262D+01*SB -0.9026D+00*SB2-0.9394D+01*SB3
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Calculation of x * f(x, Q).
|
|
PYCTEQ = MAX(0D0, A0 *(X**A1) *((1D0-X)**A2) *(1D0+A3*(X**A4))
|
|
& *(LOG(1D0+1D0/X))**A5 )
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGRVL
|
|
C...Gives the GRV 94 L (leading order) parton distribution function set
|
|
C...in parametrized form.
|
|
C...Authors: M. Glueck, E. Reya and A. Vogt.
|
|
|
|
SUBROUTINE PYGRVL (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION (A - Z)
|
|
|
|
C...Common expressions.
|
|
MU2 = 0.23D0
|
|
LAM2 = 0.2322D0 * 0.2322D0
|
|
S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2))
|
|
DS = SQRT (S)
|
|
S2 = S * S
|
|
S3 = S2 * S
|
|
|
|
C...uv :
|
|
NU = 2.284D0 + 0.802D0 * S + 0.055D0 * S2
|
|
AKU = 0.590D0 - 0.024D0 * S
|
|
BKU = 0.131D0 + 0.063D0 * S
|
|
AU = -0.449D0 - 0.138D0 * S - 0.076D0 * S2
|
|
BU = 0.213D0 + 2.669D0 * S - 0.728D0 * S2
|
|
CU = 8.854D0 - 9.135D0 * S + 1.979D0 * S2
|
|
DU = 2.997D0 + 0.753D0 * S - 0.076D0 * S2
|
|
UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU)
|
|
|
|
C...dv :
|
|
ND = 0.371D0 + 0.083D0 * S + 0.039D0 * S2
|
|
AKD = 0.376D0
|
|
BKD = 0.486D0 + 0.062D0 * S
|
|
AD = -0.509D0 + 3.310D0 * S - 1.248D0 * S2
|
|
BD = 12.41D0 - 10.52D0 * S + 2.267D0 * S2
|
|
CD = 6.373D0 - 6.208D0 * S + 1.418D0 * S2
|
|
DD = 3.691D0 + 0.799D0 * S - 0.071D0 * S2
|
|
DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD)
|
|
|
|
C...del :
|
|
NE = 0.082D0 + 0.014D0 * S + 0.008D0 * S2
|
|
AKE = 0.409D0 - 0.005D0 * S
|
|
BKE = 0.799D0 + 0.071D0 * S
|
|
AE = -38.07D0 + 36.13D0 * S - 0.656D0 * S2
|
|
BE = 90.31D0 - 74.15D0 * S + 7.645D0 * S2
|
|
CE = 0.0D0
|
|
DE = 7.486D0 + 1.217D0 * S - 0.159D0 * S2
|
|
DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE)
|
|
|
|
C...udb :
|
|
ALX = 1.451D0
|
|
BEX = 0.271D0
|
|
AKX = 0.410D0 - 0.232D0 * S
|
|
BKX = 0.534D0 - 0.457D0 * S
|
|
AGX = 0.890D0 - 0.140D0 * S
|
|
BGX = -0.981D0
|
|
CX = 0.320D0 + 0.683D0 * S
|
|
DX = 4.752D0 + 1.164D0 * S + 0.286D0 * S2
|
|
EX = 4.119D0 + 1.713D0 * S
|
|
ESX = 0.682D0 + 2.978D0 * S
|
|
UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX,
|
|
& DX, EX, ESX)
|
|
|
|
C...sb :
|
|
STS = 0D0
|
|
ALS = 0.914D0
|
|
BES = 0.577D0
|
|
AKS = 1.798D0 - 0.596D0 * S
|
|
AS = -5.548D0 + 3.669D0 * DS - 0.616D0 * S
|
|
BS = 18.92D0 - 16.73D0 * DS + 5.168D0 * S
|
|
DST = 6.379D0 - 0.350D0 * S + 0.142D0 * S2
|
|
EST = 3.981D0 + 1.638D0 * S
|
|
ESS = 6.402D0
|
|
SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS)
|
|
|
|
C...cb :
|
|
STC = 0.888D0
|
|
ALC = 1.01D0
|
|
BEC = 0.37D0
|
|
AKC = 0D0
|
|
AC = 0D0
|
|
BC = 4.24D0 - 0.804D0 * S
|
|
DCT = 3.46D0 - 1.076D0 * S
|
|
ECT = 4.61D0 + 1.49D0 * S
|
|
ESC = 2.555D0 + 1.961D0 * S
|
|
CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC)
|
|
|
|
C...bb :
|
|
STB = 1.351D0
|
|
ALB = 1.00D0
|
|
BEB = 0.51D0
|
|
AKB = 0D0
|
|
AB = 0D0
|
|
BB = 1.848D0
|
|
DBT = 2.929D0 + 1.396D0 * S
|
|
EBT = 4.71D0 + 1.514D0 * S
|
|
ESB = 4.02D0 + 1.239D0 * S
|
|
BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB)
|
|
|
|
C...gl :
|
|
ALG = 0.524D0
|
|
BEG = 1.088D0
|
|
AKG = 1.742D0 - 0.930D0 * S
|
|
BKG = - 0.399D0 * S2
|
|
AG = 7.486D0 - 2.185D0 * S
|
|
BG = 16.69D0 - 22.74D0 * S + 5.779D0 * S2
|
|
CG = -25.59D0 + 29.71D0 * S - 7.296D0 * S2
|
|
DG = 2.792D0 + 2.215D0 * S + 0.422D0 * S2 - 0.104D0 * S3
|
|
EG = 0.807D0 + 2.005D0 * S
|
|
ESG = 3.841D0 + 0.316D0 * S
|
|
GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG,
|
|
& DG, EG, ESG)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGRVM
|
|
C...Gives the GRV 94 M (MSbar) parton distribution function set
|
|
C...in parametrized form.
|
|
C...Authors: M. Glueck, E. Reya and A. Vogt.
|
|
|
|
SUBROUTINE PYGRVM (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION (A - Z)
|
|
|
|
C...Common expressions.
|
|
MU2 = 0.34D0
|
|
LAM2 = 0.248D0 * 0.248D0
|
|
S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2))
|
|
DS = SQRT (S)
|
|
S2 = S * S
|
|
S3 = S2 * S
|
|
|
|
C...uv :
|
|
NU = 1.304D0 + 0.863D0 * S
|
|
AKU = 0.558D0 - 0.020D0 * S
|
|
BKU = 0.183D0 * S
|
|
AU = -0.113D0 + 0.283D0 * S - 0.321D0 * S2
|
|
BU = 6.843D0 - 5.089D0 * S + 2.647D0 * S2 - 0.527D0 * S3
|
|
CU = 7.771D0 - 10.09D0 * S + 2.630D0 * S2
|
|
DU = 3.315D0 + 1.145D0 * S - 0.583D0 * S2 + 0.154D0 * S3
|
|
UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU)
|
|
|
|
C...dv :
|
|
ND = 0.102D0 - 0.017D0 * S + 0.005D0 * S2
|
|
AKD = 0.270D0 - 0.019D0 * S
|
|
BKD = 0.260D0
|
|
AD = 2.393D0 + 6.228D0 * S - 0.881D0 * S2
|
|
BD = 46.06D0 + 4.673D0 * S - 14.98D0 * S2 + 1.331D0 * S3
|
|
CD = 17.83D0 - 53.47D0 * S + 21.24D0 * S2
|
|
DD = 4.081D0 + 0.976D0 * S - 0.485D0 * S2 + 0.152D0 * S3
|
|
DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD)
|
|
|
|
C...del :
|
|
NE = 0.070D0 + 0.042D0 * S - 0.011D0 * S2 + 0.004D0 * S3
|
|
AKE = 0.409D0 - 0.007D0 * S
|
|
BKE = 0.782D0 + 0.082D0 * S
|
|
AE = -29.65D0 + 26.49D0 * S + 5.429D0 * S2
|
|
BE = 90.20D0 - 74.97D0 * S + 4.526D0 * S2
|
|
CE = 0.0D0
|
|
DE = 8.122D0 + 2.120D0 * S - 1.088D0 * S2 + 0.231D0 * S3
|
|
DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE)
|
|
|
|
C...udb :
|
|
ALX = 0.877D0
|
|
BEX = 0.561D0
|
|
AKX = 0.275D0
|
|
BKX = 0.0D0
|
|
AGX = 0.997D0
|
|
BGX = 3.210D0 - 1.866D0 * S
|
|
CX = 7.300D0
|
|
DX = 9.010D0 + 0.896D0 * DS + 0.222D0 * S2
|
|
EX = 3.077D0 + 1.446D0 * S
|
|
ESX = 3.173D0 - 2.445D0 * DS + 2.207D0 * S
|
|
UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX,
|
|
& DX, EX, ESX)
|
|
|
|
C...sb :
|
|
STS = 0D0
|
|
ALS = 0.756D0
|
|
BES = 0.216D0
|
|
AKS = 1.690D0 + 0.650D0 * DS - 0.922D0 * S
|
|
AS = -4.329D0 + 1.131D0 * S
|
|
BS = 9.568D0 - 1.744D0 * S
|
|
DST = 9.377D0 + 1.088D0 * DS - 1.320D0 * S + 0.130D0 * S2
|
|
EST = 3.031D0 + 1.639D0 * S
|
|
ESS = 5.837D0 + 0.815D0 * S
|
|
SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS)
|
|
|
|
C...cb :
|
|
STC = 0.820D0
|
|
ALC = 0.98D0
|
|
BEC = 0D0
|
|
AKC = -0.625D0 - 0.523D0 * S
|
|
AC = 0D0
|
|
BC = 1.896D0 + 1.616D0 * S
|
|
DCT = 4.12D0 + 0.683D0 * S
|
|
ECT = 4.36D0 + 1.328D0 * S
|
|
ESC = 0.677D0 + 0.679D0 * S
|
|
CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC)
|
|
|
|
C...bb :
|
|
STB = 1.297D0
|
|
ALB = 0.99D0
|
|
BEB = 0D0
|
|
AKB = - 0.193D0 * S
|
|
AB = 0D0
|
|
BB = 0D0
|
|
DBT = 3.447D0 + 0.927D0 * S
|
|
EBT = 4.68D0 + 1.259D0 * S
|
|
ESB = 1.892D0 + 2.199D0 * S
|
|
BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB)
|
|
|
|
C...gl :
|
|
ALG = 1.014D0
|
|
BEG = 1.738D0
|
|
AKG = 1.724D0 + 0.157D0 * S
|
|
BKG = 0.800D0 + 1.016D0 * S
|
|
AG = 7.517D0 - 2.547D0 * S
|
|
BG = 34.09D0 - 52.21D0 * DS + 17.47D0 * S
|
|
CG = 4.039D0 + 1.491D0 * S
|
|
DG = 3.404D0 + 0.830D0 * S
|
|
EG = -1.112D0 + 3.438D0 * S - 0.302D0 * S2
|
|
ESG = 3.256D0 - 0.436D0 * S
|
|
GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, DG, EG, ESG)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGRVD
|
|
C...Gives the GRV 94 D (DIS) parton distribution function set
|
|
C...in parametrized form.
|
|
C...Authors: M. Glueck, E. Reya and A. Vogt.
|
|
|
|
SUBROUTINE PYGRVD (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION (A - Z)
|
|
|
|
C...Common expressions.
|
|
MU2 = 0.34D0
|
|
LAM2 = 0.248D0 * 0.248D0
|
|
S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2))
|
|
DS = SQRT (S)
|
|
S2 = S * S
|
|
S3 = S2 * S
|
|
|
|
C...uv :
|
|
NU = 2.484D0 + 0.116D0 * S + 0.093D0 * S2
|
|
AKU = 0.563D0 - 0.025D0 * S
|
|
BKU = 0.054D0 + 0.154D0 * S
|
|
AU = -0.326D0 - 0.058D0 * S - 0.135D0 * S2
|
|
BU = -3.322D0 + 8.259D0 * S - 3.119D0 * S2 + 0.291D0 * S3
|
|
CU = 11.52D0 - 12.99D0 * S + 3.161D0 * S2
|
|
DU = 2.808D0 + 1.400D0 * S - 0.557D0 * S2 + 0.119D0 * S3
|
|
UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU)
|
|
|
|
C...dv :
|
|
ND = 0.156D0 - 0.017D0 * S
|
|
AKD = 0.299D0 - 0.022D0 * S
|
|
BKD = 0.259D0 - 0.015D0 * S
|
|
AD = 3.445D0 + 1.278D0 * S + 0.326D0 * S2
|
|
BD = -6.934D0 + 37.45D0 * S - 18.95D0 * S2 + 1.463D0 * S3
|
|
CD = 55.45D0 - 69.92D0 * S + 20.78D0 * S2
|
|
DD = 3.577D0 + 1.441D0 * S - 0.683D0 * S2 + 0.179D0 * S3
|
|
DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD)
|
|
|
|
C...del :
|
|
NE = 0.099D0 + 0.019D0 * S + 0.002D0 * S2
|
|
AKE = 0.419D0 - 0.013D0 * S
|
|
BKE = 1.064D0 - 0.038D0 * S
|
|
AE = -44.00D0 + 98.70D0 * S - 14.79D0 * S2
|
|
BE = 28.59D0 - 40.94D0 * S - 13.66D0 * S2 + 2.523D0 * S3
|
|
CE = 84.57D0 - 108.8D0 * S + 31.52D0 * S2
|
|
DE = 7.469D0 + 2.480D0 * S - 0.866D0 * S2
|
|
DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE)
|
|
|
|
C...udb :
|
|
ALX = 1.215D0
|
|
BEX = 0.466D0
|
|
AKX = 0.326D0 + 0.150D0 * S
|
|
BKX = 0.956D0 + 0.405D0 * S
|
|
AGX = 0.272D0
|
|
BGX = 3.794D0 - 2.359D0 * DS
|
|
CX = 2.014D0
|
|
DX = 7.941D0 + 0.534D0 * DS - 0.940D0 * S + 0.410D0 * S2
|
|
EX = 3.049D0 + 1.597D0 * S
|
|
ESX = 4.396D0 - 4.594D0 * DS + 3.268D0 * S
|
|
UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX,
|
|
& DX, EX, ESX)
|
|
|
|
C...sb :
|
|
STS = 0D0
|
|
ALS = 0.175D0
|
|
BES = 0.344D0
|
|
AKS = 1.415D0 - 0.641D0 * DS
|
|
AS = 0.580D0 - 9.763D0 * DS + 6.795D0 * S - 0.558D0 * S2
|
|
BS = 5.617D0 + 5.709D0 * DS - 3.972D0 * S
|
|
DST = 13.78D0 - 9.581D0 * S + 5.370D0 * S2 - 0.996D0 * S3
|
|
EST = 4.546D0 + 0.372D0 * S2
|
|
ESS = 5.053D0 - 1.070D0 * S + 0.805D0 * S2
|
|
SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS)
|
|
|
|
C...cb :
|
|
STC = 0.820D0
|
|
ALC = 0.98D0
|
|
BEC = 0D0
|
|
AKC = -0.625D0 - 0.523D0 * S
|
|
AC = 0D0
|
|
BC = 1.896D0 + 1.616D0 * S
|
|
DCT = 4.12D0 + 0.683D0 * S
|
|
ECT = 4.36D0 + 1.328D0 * S
|
|
ESC = 0.677D0 + 0.679D0 * S
|
|
CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC)
|
|
|
|
C...bb :
|
|
STB = 1.297D0
|
|
ALB = 0.99D0
|
|
BEB = 0D0
|
|
AKB = - 0.193D0 * S
|
|
AB = 0D0
|
|
BB = 0D0
|
|
DBT = 3.447D0 + 0.927D0 * S
|
|
EBT = 4.68D0 + 1.259D0 * S
|
|
ESB = 1.892D0 + 2.199D0 * S
|
|
BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB)
|
|
|
|
C...gl :
|
|
ALG = 1.258D0
|
|
BEG = 1.846D0
|
|
AKG = 2.423D0
|
|
BKG = 2.427D0 + 1.311D0 * S - 0.153D0 * S2
|
|
AG = 25.09D0 - 7.935D0 * S
|
|
BG = -14.84D0 - 124.3D0 * DS + 72.18D0 * S
|
|
CG = 590.3D0 - 173.8D0 * S
|
|
DG = 5.196D0 + 1.857D0 * S
|
|
EG = -1.648D0 + 3.988D0 * S - 0.432D0 * S2
|
|
ESG = 3.232D0 - 0.542D0 * S
|
|
GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, DG, EG, ESG)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGRVV
|
|
C...Auxiliary for the GRV 94 parton distribution functions
|
|
C...for u and d valence and d-u sea.
|
|
C...Authors: M. Glueck, E. Reya and A. Vogt.
|
|
|
|
FUNCTION PYGRVV (X, N, AK, BK, A, B, C, D)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION (A - Z)
|
|
|
|
C...Evaluation.
|
|
DX = SQRT (X)
|
|
PYGRVV = N * X**AK * (1D0+ A*X**BK + X * (B + C*DX)) *
|
|
& (1D0- X)**D
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGRVW
|
|
C...Auxiliary for the GRV 94 parton distribution functions
|
|
C...for d+u sea and gluon.
|
|
C...Authors: M. Glueck, E. Reya and A. Vogt.
|
|
|
|
FUNCTION PYGRVW (X, S, AL, BE, AK, BK, A, B, C, D, E, ES)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION (A - Z)
|
|
|
|
C...Evaluation.
|
|
LX = LOG (1D0/X)
|
|
PYGRVW = (X**AK * (A + X * (B + X*C)) * LX**BK + S**AL
|
|
& * EXP (-E + SQRT (ES * S**BE * LX))) * (1D0- X)**D
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGRVS
|
|
C...Auxiliary for the GRV 94 parton distribution functions
|
|
C...for s, c and b sea.
|
|
C...Authors: M. Glueck, E. Reya and A. Vogt.
|
|
|
|
FUNCTION PYGRVS (X, S, STH, AL, BE, AK, AG, B, D, E, ES)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION (A - Z)
|
|
|
|
C...Evaluation.
|
|
IF(S.LE.STH) THEN
|
|
PYGRVS = 0D0
|
|
ELSE
|
|
DX = SQRT (X)
|
|
LX = LOG (1D0/X)
|
|
PYGRVS = (S - STH)**AL / LX**AK * (1D0+ AG*DX + B*X) *
|
|
& (1D0- X)**D * EXP (-E + SQRT (ES * S**BE * LX))
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYHFTH
|
|
C...Gives threshold attractive/repulsive factor for heavy flavour
|
|
C...production.
|
|
|
|
FUNCTION PYHFTH(SH,SQM,FRATT)
|
|
|
|
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...Value for alpha_strong.
|
|
IF(MSTP(35).LE.1) THEN
|
|
ALSSG=PARP(35)
|
|
ELSE
|
|
MST115=MSTU(115)
|
|
MSTU(115)=MSTP(36)
|
|
Q2BN=SQRT(MAX(1D0,SQM*((SQRT(SH)-2D0*SQRT(SQM))**2+
|
|
& PARP(36)**2)))
|
|
ALSSG=PYALPS(Q2BN)
|
|
MSTU(115)=MST115
|
|
ENDIF
|
|
|
|
C...Evaluate attractive and repulsive factors.
|
|
XATTR=4D0*PARU(1)*ALSSG/(3D0*SQRT(MAX(1D-20,1D0-4D0*SQM/SH)))
|
|
FATTR=XATTR/(1D0-EXP(-MIN(50D0,XATTR)))
|
|
XREPU=PARU(1)*ALSSG/(6D0*SQRT(MAX(1D-20,1D0-4D0*SQM/SH)))
|
|
FREPU=XREPU/(EXP(MIN(50D0,XREPU))-1D0)
|
|
PYHFTH=FRATT*FATTR+(1D0-FRATT)*FREPU
|
|
VINT(138)=PYHFTH
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYSPLI
|
|
C...Splits a hadron remnant into two (partons or hadron + parton)
|
|
C...in case it is more complicated than just a quark or a diquark.
|
|
|
|
SUBROUTINE PYSPLI(KF,KFLIN,KFLCH,KFLSP)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYINT1/MINT(400),VINT(400)
|
|
SAVE /PYPARS/,/PYINT1/
|
|
C...Local array.
|
|
DIMENSION KFL(3)
|
|
|
|
C...Preliminaries. Parton composition.
|
|
KFA=IABS(KF)
|
|
KFS=ISIGN(1,KF)
|
|
KFL(1)=MOD(KFA/1000,10)
|
|
KFL(2)=MOD(KFA/100,10)
|
|
KFL(3)=MOD(KFA/10,10)
|
|
IF(KFA.EQ.22.AND.MINT(109).EQ.2) THEN
|
|
KFL(2)=INT(1.5D0+PYR(0))
|
|
IF(MINT(105).EQ.333) KFL(2)=3
|
|
IF(MINT(105).EQ.443) KFL(2)=4
|
|
KFL(3)=KFL(2)
|
|
ELSEIF((KFA.EQ.111.OR.KFA.EQ.113).AND.PYR(0).GT.0.5D0) THEN
|
|
KFL(2)=2
|
|
KFL(3)=2
|
|
ELSEIF(KFA.EQ.223.AND.PYR(0).GT.0.5D0) THEN
|
|
KFL(2)=1
|
|
KFL(3)=1
|
|
ENDIF
|
|
IF(KFLIN.NE.21.AND.KFLIN.NE.22.AND.KFLIN.NE.23) THEN
|
|
KFLR=KFLIN*KFS
|
|
ELSE
|
|
KFLR=KFLIN
|
|
ENDIF
|
|
KFLCH=0
|
|
|
|
C...Subdivide lepton.
|
|
IF(KFA.GE.11.AND.KFA.LE.18) THEN
|
|
IF(KFLR.EQ.KFA) THEN
|
|
KFLSP=KFS*22
|
|
ELSEIF(KFLR.EQ.22) THEN
|
|
KFLSP=KFA
|
|
ELSEIF(KFLR.EQ.-24.AND.MOD(KFA,2).EQ.1) THEN
|
|
KFLSP=KFA+1
|
|
ELSEIF(KFLR.EQ.24.AND.MOD(KFA,2).EQ.0) THEN
|
|
KFLSP=KFA-1
|
|
ELSEIF(KFLR.EQ.21) THEN
|
|
KFLSP=KFA
|
|
KFLCH=KFS*21
|
|
ELSE
|
|
KFLSP=KFA
|
|
KFLCH=-KFLR
|
|
ENDIF
|
|
|
|
C...Subdivide photon.
|
|
ELSEIF(KFA.EQ.22.AND.MINT(109).NE.2) THEN
|
|
IF(KFLR.NE.21) THEN
|
|
KFLSP=-KFLR
|
|
ELSE
|
|
RAGR=0.75D0*PYR(0)
|
|
KFLSP=1
|
|
IF(RAGR.GT.0.125D0) KFLSP=2
|
|
IF(RAGR.GT.0.625D0) KFLSP=3
|
|
IF(PYR(0).GT.0.5D0) KFLSP=-KFLSP
|
|
KFLCH=-KFLSP
|
|
ENDIF
|
|
|
|
C...Subdivide Reggeon or Pomeron.
|
|
ELSEIF(KFA.EQ.28.OR.KFA.EQ.29) THEN
|
|
IF(KFLIN.EQ.21) THEN
|
|
KFLSP=KFS*21
|
|
ELSE
|
|
KFLSP=-KFLIN
|
|
ENDIF
|
|
|
|
C...Subdivide meson.
|
|
ELSEIF(KFL(1).EQ.0) THEN
|
|
KFL(2)=KFL(2)*(-1)**KFL(2)
|
|
KFL(3)=-KFL(3)*(-1)**IABS(KFL(2))
|
|
IF(KFLR.EQ.KFL(2)) THEN
|
|
KFLSP=KFL(3)
|
|
ELSEIF(KFLR.EQ.KFL(3)) THEN
|
|
KFLSP=KFL(2)
|
|
ELSEIF(KFLR.EQ.21.AND.PYR(0).GT.0.5D0) THEN
|
|
KFLSP=KFL(2)
|
|
KFLCH=KFL(3)
|
|
ELSEIF(KFLR.EQ.21) THEN
|
|
KFLSP=KFL(3)
|
|
KFLCH=KFL(2)
|
|
ELSEIF(KFLR*KFL(2).GT.0) THEN
|
|
CALL PYKFDI(-KFLR,KFL(2),KFDUMP,KFLCH)
|
|
KFLSP=KFL(3)
|
|
ELSE
|
|
CALL PYKFDI(-KFLR,KFL(3),KFDUMP,KFLCH)
|
|
KFLSP=KFL(2)
|
|
ENDIF
|
|
|
|
C...Subdivide baryon.
|
|
ELSE
|
|
NAGR=0
|
|
DO 100 J=1,3
|
|
IF(KFLR.EQ.KFL(J)) NAGR=NAGR+1
|
|
100 CONTINUE
|
|
IF(NAGR.GE.1) THEN
|
|
RAGR=0.00001D0+(NAGR-0.00002D0)*PYR(0)
|
|
IAGR=0
|
|
DO 110 J=1,3
|
|
IF(KFLR.EQ.KFL(J)) RAGR=RAGR-1D0
|
|
IF(IAGR.EQ.0.AND.RAGR.LE.0D0) IAGR=J
|
|
110 CONTINUE
|
|
ELSE
|
|
IAGR=1.00001D0+2.99998D0*PYR(0)
|
|
ENDIF
|
|
ID1=1
|
|
IF(IAGR.EQ.1) ID1=2
|
|
IF(IAGR.EQ.1.AND.KFL(3).GT.KFL(2)) ID1=3
|
|
ID2=6-IAGR-ID1
|
|
KSP=3
|
|
IF(MOD(KFA,10).EQ.2.AND.KFL(1).EQ.KFL(2)) THEN
|
|
IF(IAGR.NE.3.AND.PYR(0).GT.0.25D0) KSP=1
|
|
ELSEIF(MOD(KFA,10).EQ.2.AND.KFL(2).GE.KFL(3)) THEN
|
|
IF(IAGR.NE.1.AND.PYR(0).GT.0.25D0) KSP=1
|
|
ELSEIF(MOD(KFA,10).EQ.2) THEN
|
|
IF(IAGR.EQ.1) KSP=1
|
|
IF(IAGR.NE.1.AND.PYR(0).GT.0.75D0) KSP=1
|
|
ENDIF
|
|
KFLSP=1000*KFL(ID1)+100*KFL(ID2)+KSP
|
|
IF(KFLR.EQ.21) THEN
|
|
KFLCH=KFL(IAGR)
|
|
ELSEIF(NAGR.EQ.0.AND.KFLR.GT.0) THEN
|
|
CALL PYKFDI(-KFLR,KFL(IAGR),KFDUMP,KFLCH)
|
|
ELSEIF(NAGR.EQ.0) THEN
|
|
CALL PYKFDI(10000+KFLSP,-KFLR,KFDUMP,KFLCH)
|
|
KFLSP=KFL(IAGR)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Add on correct sign for result.
|
|
KFLCH=KFLCH*KFS
|
|
KFLSP=KFLSP*KFS
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGAMM
|
|
C...Gives ordinary Gamma function Gamma(x) for positive, real arguments;
|
|
C...see M. Abramowitz, I. A. Stegun: Handbook of Mathematical Functions
|
|
C...(Dover, 1965) 6.1.36.
|
|
|
|
FUNCTION PYGAMM(X)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Local array and data.
|
|
DIMENSION B(8)
|
|
DATA B/-0.577191652D0,0.988205891D0,-0.897056937D0,0.918206857D0,
|
|
&-0.756704078D0,0.482199394D0,-0.193527818D0,0.035868343D0/
|
|
|
|
NX=INT(X)
|
|
DX=X-NX
|
|
|
|
PYGAMM=1D0
|
|
DXP=1D0
|
|
DO 100 I=1,8
|
|
DXP=DXP*DX
|
|
PYGAMM=PYGAMM+B(I)*DXP
|
|
100 CONTINUE
|
|
IF(X.LT.1D0) THEN
|
|
PYGAMM=PYGAMM/X
|
|
ELSE
|
|
DO 110 IX=1,NX-1
|
|
PYGAMM=(X-IX)*PYGAMM
|
|
110 CONTINUE
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C***********************************************************************
|
|
|
|
C...PYWAUX
|
|
C...Calculates real and imaginary parts of the auxiliary functions W1
|
|
C...and W2; see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van
|
|
C...der Bij, Nucl. Phys. B297 (1988) 221.
|
|
|
|
SUBROUTINE PYWAUX(IAUX,EPS,WRE,WIM)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
|
|
ASINH(X)=LOG(X+SQRT(X**2+1D0))
|
|
ACOSH(X)=LOG(X+SQRT(X**2-1D0))
|
|
|
|
IF(EPS.LT.0D0) THEN
|
|
IF(IAUX.EQ.1) WRE=2D0*SQRT(1D0-EPS)*ASINH(SQRT(-1D0/EPS))
|
|
IF(IAUX.EQ.2) WRE=4D0*(ASINH(SQRT(-1D0/EPS)))**2
|
|
WIM=0D0
|
|
ELSEIF(EPS.LT.1D0) THEN
|
|
IF(IAUX.EQ.1) WRE=2D0*SQRT(1D0-EPS)*ACOSH(SQRT(1D0/EPS))
|
|
IF(IAUX.EQ.2) WRE=4D0*(ACOSH(SQRT(1D0/EPS)))**2-PARU(1)**2
|
|
IF(IAUX.EQ.1) WIM=-PARU(1)*SQRT(1D0-EPS)
|
|
IF(IAUX.EQ.2) WIM=-4D0*PARU(1)*ACOSH(SQRT(1D0/EPS))
|
|
ELSE
|
|
IF(IAUX.EQ.1) WRE=2D0*SQRT(EPS-1D0)*ASIN(SQRT(1D0/EPS))
|
|
IF(IAUX.EQ.2) WRE=-4D0*(ASIN(SQRT(1D0/EPS)))**2
|
|
WIM=0D0
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C***********************************************************************
|
|
|
|
C...PYI3AU
|
|
C...Calculates real and imaginary parts of the auxiliary function I3;
|
|
C...see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van der Bij,
|
|
C...Nucl. Phys. B297 (1988) 221.
|
|
|
|
SUBROUTINE PYI3AU(EPS,RAT,Y3RE,Y3IM)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
|
|
BE=0.5D0*(1D0+SQRT(1D0+RAT*EPS))
|
|
IF(EPS.LT.1D0) GA=0.5D0*(1D0+SQRT(1D0-EPS))
|
|
|
|
IF(EPS.LT.0D0) THEN
|
|
IF(ABS(EPS).LT.1.D-4.AND.ABS(RAT*EPS).LT.1.D-4) THEN
|
|
F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)-
|
|
& PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+
|
|
& PYSPEN(0.25D0*(RAT+1D0)*EPS/(1D0+0.25D0*RAT*EPS),0D0,1)-
|
|
& PYSPEN((RAT+1D0)/RAT,0D0,1)+0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2-
|
|
& LOG(0.25D0*RAT*EPS)**2)+LOG(1D0-0.25D0*EPS)*
|
|
& LOG((1D0+0.25D0*(RAT-1D0)*EPS)/(1D0+0.25D0*RAT*EPS))+
|
|
& LOG(-0.25D0*EPS)*LOG(0.25D0*RAT*EPS/(1D0+0.25D0*(RAT-1D0)*
|
|
& EPS))
|
|
ELSEIF(ABS(EPS).LT.1.D-4.AND.ABS(RAT*EPS).GE.1.D-4) THEN
|
|
F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)-
|
|
& PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+
|
|
& PYSPEN((BE-1D0+0.25D0*EPS)/BE,0D0,1)-
|
|
& PYSPEN((BE-1D0+0.25D0*EPS)/(BE-1D0),0D0,1)+
|
|
& 0.5D0*(LOG(BE)**2-LOG(BE-1D0)**2)+
|
|
& LOG(1D0-0.25D0*EPS)*LOG((BE-0.25D0*EPS)/BE)+
|
|
& LOG(-0.25D0*EPS)*LOG((BE-1D0)/(BE-0.25D0*EPS))
|
|
ELSEIF(ABS(EPS).GE.1.D-4.AND.ABS(RAT*EPS).LT.1.D-4) THEN
|
|
F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)-
|
|
& PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+
|
|
& PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(1D0+0.25D0*RAT*EPS),0D0,1)-
|
|
& PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(0.25D0*RAT*EPS),0D0,1)+
|
|
& 0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2-LOG(0.25D0*RAT*EPS)**2)+
|
|
& LOG(GA)*LOG((GA+0.25D0*RAT*EPS)/(1D0+0.25D0*RAT*EPS))+
|
|
& LOG(GA-1D0)*LOG(0.25D0*RAT*EPS/(GA+0.25D0*RAT*EPS))
|
|
ELSE
|
|
F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)-
|
|
& PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN((BE-GA)/BE,0D0,1)-
|
|
& PYSPEN((BE-GA)/(BE-1D0),0D0,1)+0.5D0*(LOG(BE)**2-
|
|
& LOG(BE-1D0)**2)+LOG(GA)*LOG((GA+BE-1D0)/BE)+
|
|
& LOG(GA-1D0)*LOG((BE-1D0)/(GA+BE-1D0))
|
|
ENDIF
|
|
F3IM=0D0
|
|
ELSEIF(EPS.LT.1D0) THEN
|
|
IF(ABS(EPS).LT.1.D-4.AND.ABS(RAT*EPS).LT.1.D-4) THEN
|
|
F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)-
|
|
& PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+
|
|
& PYSPEN((1D0-0.25D0*EPS)/(-0.25D0*(RAT+1D0)*EPS),0D0,1)-
|
|
& PYSPEN(1D0/(RAT+1D0),0D0,1)+LOG((1D0-0.25D0*EPS)/
|
|
& (0.25D0*EPS))*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/
|
|
& (0.25D0*(RAT+1D0)*EPS))
|
|
F3IM=-PARU(1)*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/
|
|
& (0.25D0*(RAT+1D0)*EPS))
|
|
ELSEIF(ABS(EPS).LT.1.D-4.AND.ABS(RAT*EPS).GE.1.D-4) THEN
|
|
F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)-
|
|
& PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+
|
|
& PYSPEN((1D0-0.25D0*EPS)/(1D0-0.25D0*EPS-BE),0D0,1)-
|
|
& PYSPEN(-0.25D0*EPS/(1D0-0.25D0*EPS-BE),0D0,1)+
|
|
& LOG((1D0-0.25D0*EPS)/(0.25D0*EPS))*
|
|
& LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS))
|
|
F3IM=-PARU(1)*LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS))
|
|
ELSEIF(ABS(EPS).GE.1.D-4.AND.ABS(RAT*EPS).LT.1.D-4) THEN
|
|
F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)-
|
|
& PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+
|
|
& PYSPEN(GA/(GA-1D0-0.25D0*RAT*EPS),0D0,1)-
|
|
& PYSPEN((GA-1D0)/(GA-1D0-0.25D0*RAT*EPS),0D0,1)+
|
|
& LOG(GA/(1D0-GA))*LOG((GA+0.25D0*RAT*EPS)/
|
|
& (1D0+0.25D0*RAT*EPS-GA))
|
|
F3IM=-PARU(1)*LOG((GA+0.25D0*RAT*EPS)/
|
|
& (1D0+0.25D0*RAT*EPS-GA))
|
|
ELSE
|
|
F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)-
|
|
& PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN(GA/(GA-BE),0D0,1)-
|
|
& PYSPEN((GA-1D0)/(GA-BE),0D0,1)+LOG(GA/(1D0-GA))*
|
|
& LOG((GA+BE-1D0)/(BE-GA))
|
|
F3IM=-PARU(1)*LOG((GA+BE-1D0)/(BE-GA))
|
|
ENDIF
|
|
ELSE
|
|
RSQ=EPS/(EPS-1D0+(2D0*BE-1D0)**2)
|
|
RCTHE=RSQ*(1D0-2D0*BE/EPS)
|
|
RSTHE=SQRT(MAX(0D0,RSQ-RCTHE**2))
|
|
RCPHI=RSQ*(1D0+2D0*(BE-1D0)/EPS)
|
|
RSPHI=SQRT(MAX(0D0,RSQ-RCPHI**2))
|
|
R=SQRT(RSQ)
|
|
THE=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCTHE/R)))
|
|
PHI=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCPHI/R)))
|
|
F3RE=PYSPEN(RCTHE,RSTHE,1)+PYSPEN(RCTHE,-RSTHE,1)-
|
|
& PYSPEN(RCPHI,RSPHI,1)-PYSPEN(RCPHI,-RSPHI,1)+
|
|
& (PHI-THE)*(PHI+THE-PARU(1))
|
|
F3IM=PYSPEN(RCTHE,RSTHE,2)+PYSPEN(RCTHE,-RSTHE,2)-
|
|
& PYSPEN(RCPHI,RSPHI,2)-PYSPEN(RCPHI,-RSPHI,2)
|
|
ENDIF
|
|
|
|
Y3RE=2D0/(2D0*BE-1D0)*F3RE
|
|
Y3IM=2D0/(2D0*BE-1D0)*F3IM
|
|
|
|
RETURN
|
|
END
|
|
|
|
C***********************************************************************
|
|
|
|
C...PYSPEN
|
|
C...Calculates real and imaginary part of Spence function; see
|
|
C...G. 't Hooft and M. Veltman, Nucl. Phys. B153 (1979) 365.
|
|
|
|
FUNCTION PYSPEN(XREIN,XIMIN,IREIM)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
C...Local array and data.
|
|
DIMENSION B(0:14)
|
|
DATA B/
|
|
&1.000000D+00, -5.000000D-01, 1.666667D-01,
|
|
&0.000000D+00, -3.333333D-02, 0.000000D+00,
|
|
&2.380952D-02, 0.000000D+00, -3.333333D-02,
|
|
&0.000000D+00, 7.575757D-02, 0.000000D+00,
|
|
&-2.531135D-01, 0.000000D+00, 1.166667D+00/
|
|
|
|
XRE=XREIN
|
|
XIM=XIMIN
|
|
IF(ABS(1D0-XRE).LT.1.D-6.AND.ABS(XIM).LT.1.D-6) THEN
|
|
IF(IREIM.EQ.1) PYSPEN=PARU(1)**2/6D0
|
|
IF(IREIM.EQ.2) PYSPEN=0D0
|
|
RETURN
|
|
ENDIF
|
|
|
|
XMOD=SQRT(XRE**2+XIM**2)
|
|
IF(XMOD.LT.1.D-6) THEN
|
|
IF(IREIM.EQ.1) PYSPEN=0D0
|
|
IF(IREIM.EQ.2) PYSPEN=0D0
|
|
RETURN
|
|
ENDIF
|
|
|
|
XARG=SIGN(ACOS(XRE/XMOD),XIM)
|
|
SP0RE=0D0
|
|
SP0IM=0D0
|
|
SGN=1D0
|
|
IF(XMOD.GT.1D0) THEN
|
|
ALGXRE=LOG(XMOD)
|
|
ALGXIM=XARG-SIGN(PARU(1),XARG)
|
|
SP0RE=-PARU(1)**2/6D0-(ALGXRE**2-ALGXIM**2)/2D0
|
|
SP0IM=-ALGXRE*ALGXIM
|
|
SGN=-1D0
|
|
XMOD=1D0/XMOD
|
|
XARG=-XARG
|
|
XRE=XMOD*COS(XARG)
|
|
XIM=XMOD*SIN(XARG)
|
|
ENDIF
|
|
IF(XRE.GT.0.5D0) THEN
|
|
ALGXRE=LOG(XMOD)
|
|
ALGXIM=XARG
|
|
XRE=1D0-XRE
|
|
XIM=-XIM
|
|
XMOD=SQRT(XRE**2+XIM**2)
|
|
XARG=SIGN(ACOS(XRE/XMOD),XIM)
|
|
ALGYRE=LOG(XMOD)
|
|
ALGYIM=XARG
|
|
SP0RE=SP0RE+SGN*(PARU(1)**2/6D0-(ALGXRE*ALGYRE-ALGXIM*ALGYIM))
|
|
SP0IM=SP0IM-SGN*(ALGXRE*ALGYIM+ALGXIM*ALGYRE)
|
|
SGN=-SGN
|
|
ENDIF
|
|
|
|
XRE=1D0-XRE
|
|
XIM=-XIM
|
|
XMOD=SQRT(XRE**2+XIM**2)
|
|
XARG=SIGN(ACOS(XRE/XMOD),XIM)
|
|
ZRE=-LOG(XMOD)
|
|
ZIM=-XARG
|
|
|
|
SPRE=0D0
|
|
SPIM=0D0
|
|
SAVERE=1D0
|
|
SAVEIM=0D0
|
|
DO 100 I=0,14
|
|
IF(MAX(ABS(SAVERE),ABS(SAVEIM)).LT.1D-30) GOTO 110
|
|
TERMRE=(SAVERE*ZRE-SAVEIM*ZIM)/DBLE(I+1)
|
|
TERMIM=(SAVERE*ZIM+SAVEIM*ZRE)/DBLE(I+1)
|
|
SAVERE=TERMRE
|
|
SAVEIM=TERMIM
|
|
SPRE=SPRE+B(I)*TERMRE
|
|
SPIM=SPIM+B(I)*TERMIM
|
|
100 CONTINUE
|
|
|
|
110 IF(IREIM.EQ.1) PYSPEN=SP0RE+SGN*SPRE
|
|
IF(IREIM.EQ.2) PYSPEN=SP0IM+SGN*SPIM
|
|
|
|
RETURN
|
|
END
|
|
|
|
C***********************************************************************
|
|
|
|
C...PYQQBH
|
|
C...Calculates the matrix element for the processes
|
|
C...g + g or q + qbar -> Q + Qbar + H (normally with Q = t).
|
|
C...REDUCE output and part of the rest courtesy Z. Kunszt, see
|
|
C...Z. Kunszt, Nucl. Phys. B247 (1984) 339.
|
|
|
|
SUBROUTINE PYQQBH(WTQQBH)
|
|
|
|
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/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/,/PYPARS/,/PYINT1/,/PYINT2/
|
|
C...Local arrays and function.
|
|
DIMENSION PP(15,4),CLR(8,8),FM(10,10),RM(8,8),DX(8)
|
|
DOT(I,J)=PP(I,4)*PP(J,4)-PP(I,1)*PP(J,1)-PP(I,2)*PP(J,2)-
|
|
&PP(I,3)*PP(J,3)
|
|
|
|
C...Mass parameters.
|
|
WTQQBH=0D0
|
|
ISUB=MINT(1)
|
|
SHPR=SQRT(VINT(26))*VINT(1)
|
|
PQ=PMAS(PYCOMP(KFPR(ISUB,2)),1)
|
|
PH=SQRT(VINT(21))*VINT(1)
|
|
SPQ=PQ**2
|
|
SPH=PH**2
|
|
|
|
C...Set up outgoing kinematics: 1=t, 2=tbar, 3=H.
|
|
DO 100 I=1,2
|
|
PT=SQRT(MAX(0D0,VINT(197+5*I)))
|
|
PP(I,1)=PT*COS(VINT(198+5*I))
|
|
PP(I,2)=PT*SIN(VINT(198+5*I))
|
|
100 CONTINUE
|
|
PP(3,1)=-PP(1,1)-PP(2,1)
|
|
PP(3,2)=-PP(1,2)-PP(2,2)
|
|
PMS1=SPQ+PP(1,1)**2+PP(1,2)**2
|
|
PMS2=SPQ+PP(2,1)**2+PP(2,2)**2
|
|
PMS3=SPH+PP(3,1)**2+PP(3,2)**2
|
|
PMT3=SQRT(PMS3)
|
|
PP(3,3)=PMT3*SINH(VINT(211))
|
|
PP(3,4)=PMT3*COSH(VINT(211))
|
|
PMS12=(SHPR-PP(3,4))**2-PP(3,3)**2
|
|
PP(1,3)=(-PP(3,3)*(PMS12+PMS1-PMS2)+
|
|
&VINT(213)*(SHPR-PP(3,4))*VINT(220))/(2D0*PMS12)
|
|
PP(2,3)=-PP(1,3)-PP(3,3)
|
|
PP(1,4)=SQRT(PMS1+PP(1,3)**2)
|
|
PP(2,4)=SQRT(PMS2+PP(2,3)**2)
|
|
|
|
C...Set up incoming kinematics and derived momentum combinations.
|
|
DO 110 I=4,5
|
|
PP(I,1)=0D0
|
|
PP(I,2)=0D0
|
|
PP(I,3)=-0.5D0*SHPR*(-1)**I
|
|
PP(I,4)=-0.5D0*SHPR
|
|
110 CONTINUE
|
|
DO 120 J=1,4
|
|
PP(6,J)=PP(1,J)+PP(2,J)
|
|
PP(7,J)=PP(1,J)+PP(3,J)
|
|
PP(8,J)=PP(1,J)+PP(4,J)
|
|
PP(9,J)=PP(1,J)+PP(5,J)
|
|
PP(10,J)=-PP(2,J)-PP(3,J)
|
|
PP(11,J)=-PP(2,J)-PP(4,J)
|
|
PP(12,J)=-PP(2,J)-PP(5,J)
|
|
PP(13,J)=-PP(4,J)-PP(5,J)
|
|
120 CONTINUE
|
|
|
|
C...Derived kinematics invariants.
|
|
X1=DOT(1,2)
|
|
X2=DOT(1,3)
|
|
X3=DOT(1,4)
|
|
X4=DOT(1,5)
|
|
X5=DOT(2,3)
|
|
X6=DOT(2,4)
|
|
X7=DOT(2,5)
|
|
X8=DOT(3,4)
|
|
X9=DOT(3,5)
|
|
X10=DOT(4,5)
|
|
|
|
C...Propagators.
|
|
SS1=DOT(7,7)-SPQ
|
|
SS2=DOT(8,8)-SPQ
|
|
SS3=DOT(9,9)-SPQ
|
|
SS4=DOT(10,10)-SPQ
|
|
SS5=DOT(11,11)-SPQ
|
|
SS6=DOT(12,12)-SPQ
|
|
SS7=DOT(13,13)
|
|
DX(1)=SS1*SS6
|
|
DX(2)=SS2*SS6
|
|
DX(3)=SS2*SS4
|
|
DX(4)=SS1*SS5
|
|
DX(5)=SS3*SS5
|
|
DX(6)=SS3*SS4
|
|
DX(7)=SS7*SS1
|
|
DX(8)=SS7*SS4
|
|
|
|
C...Define colour coefficients for g + g -> Q + Qbar + H.
|
|
IF(ISUB.EQ.121.OR.ISUB.EQ.181.OR.ISUB.EQ.186) THEN
|
|
DO 140 I=1,3
|
|
DO 130 J=1,3
|
|
CLR(I,J)=16D0/3D0
|
|
CLR(I+3,J+3)=16D0/3D0
|
|
CLR(I,J+3)=-2D0/3D0
|
|
CLR(I+3,J)=-2D0/3D0
|
|
130 CONTINUE
|
|
140 CONTINUE
|
|
DO 160 L=1,2
|
|
DO 150 I=1,3
|
|
CLR(I,6+L)=-6D0
|
|
CLR(I+3,6+L)=6D0
|
|
CLR(6+L,I)=-6D0
|
|
CLR(6+L,I+3)=6D0
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
DO 180 K1=1,2
|
|
DO 170 K2=1,2
|
|
CLR(6+K1,6+K2)=12D0
|
|
170 CONTINUE
|
|
180 CONTINUE
|
|
|
|
C...Evaluate matrix elements for g + g -> Q + Qbar + H.
|
|
FM(1,1)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+2*X2+X4+X9+2*
|
|
& X7+X5)+8*PQ**2*PH**2*(-X1-X4+2*X7)+16*PQ**2*(X2*X9+4*X2*
|
|
& X7+X2*X5-2*X4*X7-2*X9*X7)+8*PH**2*X4*X7-16*X2*X9*X7
|
|
FM(1,2)=16*PQ**6+8*PQ**4*(-2*X1+X2-2*X3-2*X4-4*X10+X9-X8+2
|
|
& *X7-4*X6+X5)+8*PQ**2*(-2*X1*X2-2*X2*X4-2*X2*X10+X2*X7-2*
|
|
& X2*X6-2*X3*X7+2*X4*X7+4*X10*X7-X9*X7-X8*X7)+16*X2*X7*(X4+
|
|
& X10)
|
|
FM(1,3)=16*PQ**6-4*PQ**4*PH**2+8*PQ**4*(-2*X1+2*X2-2*X3-4*
|
|
& X4-8*X10+X9+X8-2*X7-4*X6+2*X5)-(4*PQ**2*PH**2)*(X1+X4+X10
|
|
& +X6)+8*PQ**2*(-2*X1*X2-2*X1*X10+X1*X9+X1*X8-2*X1*X5+X2**2
|
|
& -4*X2*X4-5*X2*X10+X2*X8-X2*X7-3*X2*X6+X2*X5+X3*X9+2*X3*X7
|
|
& -X3*X5+X4*X8+2*X4*X6-3*X4*X5-5*X10*X5+X9*X8+X9*X6+X9*X5+
|
|
& X8*X7-4*X6*X5+X5**2)-(16*X2*X5)*(X1+X4+X10+X6)
|
|
FM(1,4)=16*PQ**6+4*PQ**4*PH**2+16*PQ**4*(-X1+X2-X3-X4+X10-
|
|
& X9-X8+2*X7+2*X6-X5)+4*PQ**2*PH**2*(X1+X3+X4+X10+2*X7+2*X6
|
|
& )+8*PQ**2*(4*X1*X10+4*X1*X7+4*X1*X6+2*X2*X10-X2*X9-X2*X8+
|
|
& 4*X2*X7+4*X2*X6-X2*X5+4*X10*X5+4*X7*X5+4*X6*X5)-(8*PH**2*
|
|
& X1)*(X10+X7+X6)+16*X2*X5*(X10+X7+X6)
|
|
FM(1,5)=8*PQ**4*(-2*X1-2*X4+X10-X9)+4*PQ**2*(4*X1**2-2*X1*
|
|
& X2+8*X1*X3+6*X1*X10-2*X1*X9+4*X1*X8+4*X1*X7+4*X1*X6+2*X1*
|
|
& X5+X2*X10+4*X3*X4-X3*X9+2*X3*X7+3*X4*X8-2*X4*X6+2*X4*X5-4
|
|
& *X10*X7+3*X10*X5-3*X9*X6+3*X8*X7-4*X7**2+4*X7*X5)+8*(X1**
|
|
& 2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9+X1*X3*X5-X1*X4*
|
|
& X8-X1*X4*X5+X1*X10*X9+X1*X9*X7+X1*X9*X6-X1*X8*X7-X2*X3*X7
|
|
& +X2*X4*X6-X2*X10*X7-X2*X7**2+X3*X7*X5-X4*X10*X5-X4*X7*X5-
|
|
& X4*X6*X5)
|
|
FM(1,6)=16*PQ**4*(-4*X1-X4+X9-X7)+4*PQ**2*PH**2*(-2*X1-X4-
|
|
& X7)+16*PQ**2*(-2*X1**2-3*X1*X2-2*X1*X4-3*X1*X9-2*X1*X7-3*
|
|
& X1*X5-2*X2*X4-2*X7*X5)-8*PH**2*X4*X7+8*(-X1*X2*X9-2*X1*X2
|
|
& *X5-X1*X9**2-X1*X9*X5+X2**2*X7-X2*X4*X5+X2*X9*X7-X2*X7*X5
|
|
& +X4*X9*X5+X4*X5**2)
|
|
FM(1,7)=8*PQ**4*(2*X3+X4+3*X10+X9+2*X8+3*X7+6*X6)+2*PQ**2*
|
|
& PH**2*(-2*X3-X4+3*X10+3*X7+6*X6)+4*PQ**2*(4*X1*X10+4*X1*
|
|
& X7+8*X1*X6+6*X2*X10+X2*X9+2*X2*X8+6*X2*X7+12*X2*X6-8*X3*
|
|
& X7+4*X4*X7+4*X4*X6+4*X10*X5+4*X9*X7+4*X9*X6-8*X8*X7+4*X7*
|
|
& X5+8*X6*X5)+4*PH**2*(-X1*X10-X1*X7-2*X1*X6+2*X3*X7-X4*X7-
|
|
& X4*X6)+8*X2*(X10*X5+X9*X7+X9*X6-2*X8*X7+X7*X5+2*X6*X5)
|
|
FM(1,8)=8*PQ**4*(2*X3+X4+3*X10+2*X9+X8+3*X7+6*X6)+2*PQ**2*
|
|
& PH**2*(-2*X3-X4+2*X10+X7+2*X6)+4*PQ**2*(4*X1*X10-2*X1*X9+
|
|
& 2*X1*X8+4*X1*X7+8*X1*X6+5*X2*X10+2*X2*X9+X2*X8+4*X2*X7+8*
|
|
& X2*X6-X3*X9-8*X3*X7+2*X3*X5+2*X4*X9-X4*X8+4*X4*X7+4*X4*X6
|
|
& +4*X4*X5+5*X10*X5+X9**2-X9*X8+2*X9*X7+5*X9*X6+X9*X5-7*X8*
|
|
& X7+2*X8*X5+2*X7*X5+10*X6*X5)+2*PH**2*(-X1*X10+X3*X7-2*X4*
|
|
& X7+X4*X6)+4*(-X1*X9**2+X1*X9*X8-2*X1*X9*X5-X1*X8*X5+2*X2*
|
|
& X10*X5+X2*X9*X7+X2*X9*X6-2*X2*X8*X7+3*X2*X6*X5+X3*X9*X5+
|
|
& X3*X5**2+X4*X9*X5-2*X4*X8*X5+2*X4*X5**2)
|
|
FM(2,2)=16*PQ**6+16*PQ**4*(-X1+X3-X4-X10+X7-X6)+16*PQ**2*(
|
|
& X3*X10+X3*X7+X3*X6+X4*X7+X10*X7)-16*X3*X10*X7
|
|
FM(2,3)=16*PQ**6+8*PQ**4*(-2*X1+X2+2*X3-4*X4-4*X10-X9+X8-2
|
|
& *X7-2*X6+X5)+8*PQ**2*(-2*X1*X5+4*X3*X10-X3*X9-X3*X8-2*X3*
|
|
& X7+2*X3*X6+X3*X5-2*X4*X5-2*X10*X5-2*X6*X5)+16*X3*X5*(X10+
|
|
& X6)
|
|
FM(2,4)=8*PQ**4*(-2*X1-2*X3+X10-X8)+4*PQ**2*(4*X1**2-2*X1*
|
|
& X2+8*X1*X4+6*X1*X10+4*X1*X9-2*X1*X8+4*X1*X7+4*X1*X6+2*X1*
|
|
& X5+X2*X10+4*X3*X4+3*X3*X9-2*X3*X7+2*X3*X5-X4*X8+2*X4*X6-4
|
|
& *X10*X6+3*X10*X5+3*X9*X6-3*X8*X7-4*X6**2+4*X6*X5)+8*(-X1
|
|
& **2*X9+X1**2*X8+X1*X2*X7-X1*X2*X6-X1*X3*X9-X1*X3*X5+X1*X4
|
|
& *X8+X1*X4*X5+X1*X10*X8-X1*X9*X6+X1*X8*X7+X1*X8*X6+X2*X3*
|
|
& X7-X2*X4*X6-X2*X10*X6-X2*X6**2-X3*X10*X5-X3*X7*X5-X3*X6*
|
|
& X5+X4*X6*X5)
|
|
FM(2,5)=16*PQ**4*X10+8*PQ**2*(2*X1**2+2*X1*X3+2*X1*X4+2*X1
|
|
& *X10+2*X1*X7+2*X1*X6+X3*X7+X4*X6)+8*(-2*X1**3-2*X1**2*X3-
|
|
& 2*X1**2*X4-2*X1**2*X10-2*X1**2*X7-2*X1**2*X6-2*X1*X3*X4-
|
|
& X1*X3*X10-2*X1*X3*X6-X1*X4*X10-2*X1*X4*X7-X1*X10**2-X1*
|
|
& X10*X7-X1*X10*X6-2*X1*X7*X6+X3**2*X7-X3*X4*X7-X3*X4*X6+X3
|
|
& *X10*X7+X3*X7**2-X3*X7*X6+X4**2*X6+X4*X10*X6-X4*X7*X6+X4*
|
|
& X6**2)
|
|
FM(2,6)=8*PQ**4*(-2*X1+X10-X9-2*X7)+4*PQ**2*(4*X1**2+2*X1*
|
|
& X2+4*X1*X3+4*X1*X4+6*X1*X10-2*X1*X9+4*X1*X8+8*X1*X6-2*X1*
|
|
& X5+4*X2*X4+3*X2*X10+2*X2*X7-3*X3*X9-2*X3*X7-4*X4**2-4*X4*
|
|
& X10+3*X4*X8+2*X4*X6+X10*X5-X9*X6+3*X8*X7+4*X7*X6)+8*(X1**
|
|
& 2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9+X1*X3*X5+X1*X4*
|
|
& X9-X1*X4*X8-X1*X4*X5+X1*X10*X9+X1*X9*X6-X1*X8*X7-X2*X3*X7
|
|
& -X2*X4*X7+X2*X4*X6-X2*X10*X7+X3*X7*X5-X4**2*X5-X4*X10*X5-
|
|
& X4*X6*X5)
|
|
FM(2,7)=8*PQ**4*(X3+2*X4+3*X10+X7+2*X6)+4*PQ**2*(-4*X1*X3-
|
|
& 2*X1*X4-2*X1*X10+X1*X9-X1*X8-4*X1*X7-2*X1*X6+X2*X3+2*X2*
|
|
& X4+3*X2*X10+X2*X7+2*X2*X6-6*X3*X4-6*X3*X10-2*X3*X9-2*X3*
|
|
& X7-4*X3*X6-X3*X5-6*X4**2-6*X4*X10-3*X4*X9-X4*X8-4*X4*X7-2
|
|
& *X4*X6-2*X4*X5-3*X10*X9-3*X10*X8-6*X10*X7-6*X10*X6+X10*X5
|
|
& +X9*X7-2*X8*X7-2*X8*X6-6*X7*X6+X7*X5-6*X6**2+2*X6*X5)+4*(
|
|
& -X1**2*X9+X1**2*X8-2*X1*X2*X10-3*X1*X2*X7-3*X1*X2*X6+X1*
|
|
& X3*X9-X1*X3*X5+X1*X4*X9+X1*X4*X8+X1*X4*X5+X1*X10*X9+X1*
|
|
& X10*X8-X1*X9*X6+X1*X8*X6+X2*X3*X7-3*X2*X4*X7-X2*X4*X6-3*
|
|
& X2*X10*X7-3*X2*X10*X6-3*X2*X7*X6-3*X2*X6**2-2*X3*X4*X5-X3
|
|
& *X10*X5-X3*X6*X5-X4**2*X5-X4*X10*X5+X4*X6*X5)
|
|
FM(2,8)=8*PQ**4*(X3+2*X4+3*X10+X7+2*X6)+4*PQ**2*(-4*X1*X3-
|
|
& 2*X1*X4-2*X1*X10-X1*X9+X1*X8-4*X1*X7-2*X1*X6+X2*X3+2*X2*
|
|
& X4+X2*X10-X2*X7-2*X2*X6-6*X3*X4-6*X3*X10-2*X3*X9+X3*X8-2*
|
|
& X3*X7-4*X3*X6+X3*X5-6*X4**2-6*X4*X10-2*X4*X9-4*X4*X7-2*X4
|
|
& *X6+2*X4*X5-3*X10*X9-3*X10*X8-6*X10*X7-6*X10*X6+3*X10*X5-
|
|
& X9*X6-2*X8*X7-3*X8*X6-6*X7*X6+X7*X5-6*X6**2+2*X6*X5)+4*(
|
|
& X1**2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6-3*X1*X3*X5+X1*X4*X9-
|
|
& X1*X4*X8-3*X1*X4*X5+X1*X10*X9+X1*X10*X8-2*X1*X10*X5+X1*X9
|
|
& *X6+X1*X8*X7+X1*X8*X6-X2*X4*X7+X2*X4*X6-X2*X10*X7-X2*X10*
|
|
& X6-2*X2*X7*X6-X2*X6**2-3*X3*X4*X5-3*X3*X10*X5+X3*X7*X5-3*
|
|
& X3*X6*X5-3*X4**2*X5-3*X4*X10*X5-X4*X6*X5)
|
|
FM(3,3)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+X2+2*X3+X8+X6
|
|
& +2*X5)+8*PQ**2*PH**2*(-X1+2*X3-X6)+16*PQ**2*(X2*X5-2*X3*
|
|
& X8-2*X3*X6+4*X3*X5+X8*X5)+8*PH**2*X3*X6-16*X3*X8*X5
|
|
FM(3,4)=16*PQ**4*(-4*X1-X3+X8-X6)+4*PQ**2*PH**2*(-2*X1-X3-
|
|
& X6)+16*PQ**2*(-2*X1**2-3*X1*X2-2*X1*X3-3*X1*X8-2*X1*X6-3*
|
|
& X1*X5-2*X2*X3-2*X6*X5)-8*PH**2*X3*X6+8*(-X1*X2*X8-2*X1*X2
|
|
& *X5-X1*X8**2-X1*X8*X5+X2**2*X6-X2*X3*X5+X2*X8*X6-X2*X6*X5
|
|
& +X3*X8*X5+X3*X5**2)
|
|
FM(3,5)=8*PQ**4*(-2*X1+X10-X8-2*X6)+4*PQ**2*(4*X1**2+2*X1*
|
|
& X2+4*X1*X3+4*X1*X4+6*X1*X10+4*X1*X9-2*X1*X8+8*X1*X7-2*X1*
|
|
& X5+4*X2*X3+3*X2*X10+2*X2*X6-4*X3**2-4*X3*X10+3*X3*X9+2*X3
|
|
& *X7-3*X4*X8-2*X4*X6+X10*X5+3*X9*X6-X8*X7+4*X7*X6)+8*(-X1
|
|
& **2*X9+X1**2*X8+X1*X2*X7-X1*X2*X6-X1*X3*X9+X1*X3*X8-X1*X3
|
|
& *X5+X1*X4*X8+X1*X4*X5+X1*X10*X8-X1*X9*X6+X1*X8*X7+X2*X3*
|
|
& X7-X2*X3*X6-X2*X4*X6-X2*X10*X6-X3**2*X5-X3*X10*X5-X3*X7*
|
|
& X5+X4*X6*X5)
|
|
FM(3,6)=16*PQ**6+4*PQ**4*PH**2+16*PQ**4*(-X1-X2+2*X3+2*X4+
|
|
& X10-X9-X8-X7-X6+X5)+4*PQ**2*PH**2*(X1+2*X3+2*X4+X10+X7+X6
|
|
& )+8*PQ**2*(4*X1*X3+4*X1*X4+4*X1*X10+4*X2*X3+4*X2*X4+4*X2*
|
|
& X10-X2*X5+4*X3*X5+4*X4*X5+2*X10*X5-X9*X5-X8*X5)-(8*PH**2*
|
|
& X1)*(X3+X4+X10)+16*X2*X5*(X3+X4+X10)
|
|
FM(3,7)=8*PQ**4*(3*X3+6*X4+3*X10+X9+2*X8+2*X7+X6)+2*PQ**2*
|
|
& PH**2*(X3+2*X4+2*X10-2*X7-X6)+4*PQ**2*(4*X1*X3+8*X1*X4+4*
|
|
& X1*X10+2*X1*X9-2*X1*X8+2*X2*X3+10*X2*X4+5*X2*X10+2*X2*X9+
|
|
& X2*X8+2*X2*X7+4*X2*X6-7*X3*X9+2*X3*X8-8*X3*X7+4*X3*X6+4*
|
|
& X3*X5+5*X4*X8+4*X4*X6+8*X4*X5+5*X10*X5-X9*X8-X9*X6+X9*X5+
|
|
& X8**2-X8*X7+2*X8*X6+2*X8*X5)+2*PH**2*(-X1*X10+X3*X7-2*X3*
|
|
& X6+X4*X6)+4*(-X1*X2*X9-2*X1*X2*X8+X1*X9*X8-X1*X8**2+X2**2
|
|
& *X7+2*X2**2*X6+3*X2*X4*X5+2*X2*X10*X5-2*X2*X9*X6+X2*X8*X7
|
|
& +X2*X8*X6-2*X3*X9*X5+X3*X8*X5+X4*X8*X5)
|
|
FM(3,8)=8*PQ**4*(3*X3+6*X4+3*X10+2*X9+X8+2*X7+X6)+2*PQ**2*
|
|
& PH**2*(3*X3+6*X4+3*X10-2*X7-X6)+4*PQ**2*(4*X1*X3+8*X1*X4+
|
|
& 4*X1*X10+4*X2*X3+8*X2*X4+4*X2*X10-8*X3*X9+4*X3*X8-8*X3*X7
|
|
& +4*X3*X6+6*X3*X5+4*X4*X8+4*X4*X6+12*X4*X5+6*X10*X5+2*X9*
|
|
& X5+X8*X5)+4*PH**2*(-X1*X3-2*X1*X4-X1*X10+2*X3*X7-X3*X6-X4
|
|
& *X6)+8*X5*(X2*X3+2*X2*X4+X2*X10-2*X3*X9+X3*X8+X4*X8)
|
|
FM(4,4)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+2*X2+X3+X8+2*
|
|
& X6+X5)+8*PQ**2*PH**2*(-X1-X3+2*X6)+16*PQ**2*(X2*X8+4*X2*
|
|
& X6+X2*X5-2*X3*X6-2*X8*X6)+8*PH**2*X3*X6-16*X2*X8*X6
|
|
FM(4,5)=16*PQ**6+8*PQ**4*(-2*X1+X2-2*X3-2*X4-4*X10-X9+X8-4
|
|
& *X7+2*X6+X5)+8*PQ**2*(-2*X1*X2-2*X2*X3-2*X2*X10-2*X2*X7+
|
|
& X2*X6+2*X3*X6-2*X4*X6+4*X10*X6-X9*X6-X8*X6)+16*X2*X6*(X3+
|
|
& X10)
|
|
FM(4,6)=16*PQ**6-4*PQ**4*PH**2+8*PQ**4*(-2*X1+2*X2-4*X3-2*
|
|
& X4-8*X10+X9+X8-4*X7-2*X6+2*X5)-(4*PQ**2*PH**2)*(X1+X3+X10
|
|
& +X7)+8*PQ**2*(-2*X1*X2-2*X1*X10+X1*X9+X1*X8-2*X1*X5+X2**2
|
|
& -4*X2*X3-5*X2*X10+X2*X9-3*X2*X7-X2*X6+X2*X5+X3*X9+2*X3*X7
|
|
& -3*X3*X5+X4*X8+2*X4*X6-X4*X5-5*X10*X5+X9*X8+X9*X6+X8*X7+
|
|
& X8*X5-4*X7*X5+X5**2)-(16*X2*X5)*(X1+X3+X10+X7)
|
|
FM(4,7)=8*PQ**4*(-X3-2*X4-3*X10-2*X9-X8-6*X7-3*X6)+2*PQ**2
|
|
& *PH**2*(X3+2*X4-3*X10-6*X7-3*X6)+4*PQ**2*(-4*X1*X10-8*X1*
|
|
& X7-4*X1*X6-6*X2*X10-2*X2*X9-X2*X8-12*X2*X7-6*X2*X6-4*X3*
|
|
& X7-4*X3*X6+8*X4*X6-4*X10*X5+8*X9*X6-4*X8*X7-4*X8*X6-8*X7*
|
|
& X5-4*X6*X5)+4*PH**2*(X1*X10+2*X1*X7+X1*X6+X3*X7+X3*X6-2*
|
|
& X4*X6)+8*X2*(-X10*X5+2*X9*X6-X8*X7-X8*X6-2*X7*X5-X6*X5)
|
|
FM(4,8)=8*PQ**4*(-X3-2*X4-3*X10-X9-2*X8-6*X7-3*X6)+2*PQ**2
|
|
& *PH**2*(X3+2*X4-2*X10-2*X7-X6)+4*PQ**2*(-4*X1*X10-2*X1*X9
|
|
& +2*X1*X8-8*X1*X7-4*X1*X6-5*X2*X10-X2*X9-2*X2*X8-8*X2*X7-4
|
|
& *X2*X6+X3*X9-2*X3*X8-4*X3*X7-4*X3*X6-4*X3*X5+X4*X8+8*X4*
|
|
& X6-2*X4*X5-5*X10*X5+X9*X8+7*X9*X6-2*X9*X5-X8**2-5*X8*X7-2
|
|
& *X8*X6-X8*X5-10*X7*X5-2*X6*X5)+2*PH**2*(X1*X10-X3*X7+2*X3
|
|
& *X6-X4*X6)+4*(-X1*X9*X8+X1*X9*X5+X1*X8**2+2*X1*X8*X5-2*X2
|
|
& *X10*X5+2*X2*X9*X6-X2*X8*X7-X2*X8*X6-3*X2*X7*X5+2*X3*X9*
|
|
& X5-X3*X8*X5-2*X3*X5**2-X4*X8*X5-X4*X5**2)
|
|
FM(5,5)=16*PQ**6+16*PQ**4*(-X1-X3+X4-X10-X7+X6)+16*PQ**2*(
|
|
& X3*X6+X4*X10+X4*X7+X4*X6+X10*X6)-16*X4*X10*X6
|
|
FM(5,6)=16*PQ**6+8*PQ**4*(-2*X1+X2-4*X3+2*X4-4*X10+X9-X8-2
|
|
& *X7-2*X6+X5)+8*PQ**2*(-2*X1*X5-2*X3*X5+4*X4*X10-X4*X9-X4*
|
|
& X8+2*X4*X7-2*X4*X6+X4*X5-2*X10*X5-2*X7*X5)+16*X4*X5*(X10+
|
|
& X7)
|
|
FM(5,7)=8*PQ**4*(-2*X3-X4-3*X10-2*X7-X6)+4*PQ**2*(2*X1*X3+
|
|
& 4*X1*X4+2*X1*X10+X1*X9-X1*X8+2*X1*X7+4*X1*X6-2*X2*X3-X2*
|
|
& X4-3*X2*X10-2*X2*X7-X2*X6+6*X3**2+6*X3*X4+6*X3*X10+X3*X9+
|
|
& 3*X3*X8+2*X3*X7+4*X3*X6+2*X3*X5+6*X4*X10+2*X4*X8+4*X4*X7+
|
|
& 2*X4*X6+X4*X5+3*X10*X9+3*X10*X8+6*X10*X7+6*X10*X6-X10*X5+
|
|
& 2*X9*X7+2*X9*X6-X8*X6+6*X7**2+6*X7*X6-2*X7*X5-X6*X5)+4*(-
|
|
& X1**2*X9+X1**2*X8+2*X1*X2*X10+3*X1*X2*X7+3*X1*X2*X6-X1*X3
|
|
& *X9-X1*X3*X8-X1*X3*X5-X1*X4*X8+X1*X4*X5-X1*X10*X9-X1*X10*
|
|
& X8-X1*X9*X7+X1*X8*X7+X2*X3*X7+3*X2*X3*X6-X2*X4*X6+3*X2*
|
|
& X10*X7+3*X2*X10*X6+3*X2*X7**2+3*X2*X7*X6+X3**2*X5+2*X3*X4
|
|
& *X5+X3*X10*X5-X3*X7*X5+X4*X10*X5+X4*X7*X5)
|
|
FM(5,8)=8*PQ**4*(-2*X3-X4-3*X10-2*X7-X6)+4*PQ**2*(2*X1*X3+
|
|
& 4*X1*X4+2*X1*X10-X1*X9+X1*X8+2*X1*X7+4*X1*X6-2*X2*X3-X2*
|
|
& X4-X2*X10+2*X2*X7+X2*X6+6*X3**2+6*X3*X4+6*X3*X10+2*X3*X8+
|
|
& 2*X3*X7+4*X3*X6-2*X3*X5+6*X4*X10-X4*X9+2*X4*X8+4*X4*X7+2*
|
|
& X4*X6-X4*X5+3*X10*X9+3*X10*X8+6*X10*X7+6*X10*X6-3*X10*X5+
|
|
& 3*X9*X7+2*X9*X6+X8*X7+6*X7**2+6*X7*X6-2*X7*X5-X6*X5)+4*(
|
|
& X1**2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9-X1*X3*X8+3*
|
|
& X1*X3*X5+3*X1*X4*X5-X1*X10*X9-X1*X10*X8+2*X1*X10*X5-X1*X9
|
|
& *X7-X1*X9*X6-X1*X8*X7-X2*X3*X7+X2*X3*X6+X2*X10*X7+X2*X10*
|
|
& X6+X2*X7**2+2*X2*X7*X6+3*X3**2*X5+3*X3*X4*X5+3*X3*X10*X5+
|
|
& X3*X7*X5+3*X4*X10*X5+3*X4*X7*X5-X4*X6*X5)
|
|
FM(6,6)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+X2+2*X4+X9+X7
|
|
& +2*X5)+8*PQ**2*PH**2*(-X1+2*X4-X7)+16*PQ**2*(X2*X5-2*X4*
|
|
& X9-2*X4*X7+4*X4*X5+X9*X5)+8*PH**2*X4*X7-16*X4*X9*X5
|
|
FM(6,7)=8*PQ**4*(-6*X3-3*X4-3*X10-2*X9-X8-X7-2*X6)+2*PQ**2
|
|
& *PH**2*(-2*X3-X4-2*X10+X7+2*X6)+4*PQ**2*(-8*X1*X3-4*X1*X4
|
|
& -4*X1*X10+2*X1*X9-2*X1*X8-10*X2*X3-2*X2*X4-5*X2*X10-X2*X9
|
|
& -2*X2*X8-4*X2*X7-2*X2*X6-5*X3*X9-4*X3*X7-8*X3*X5-2*X4*X9+
|
|
& 7*X4*X8-4*X4*X7+8*X4*X6-4*X4*X5-5*X10*X5-X9**2+X9*X8-2*X9
|
|
& *X7+X9*X6-2*X9*X5+X8*X7-X8*X5)+2*PH**2*(X1*X10-X3*X7+2*X4
|
|
& *X7-X4*X6)+4*(2*X1*X2*X9+X1*X2*X8+X1*X9**2-X1*X9*X8-2*X2
|
|
& **2*X7-X2**2*X6-3*X2*X3*X5-2*X2*X10*X5-X2*X9*X7-X2*X9*X6+
|
|
& 2*X2*X8*X7-X3*X9*X5-X4*X9*X5+2*X4*X8*X5)
|
|
FM(6,8)=8*PQ**4*(-6*X3-3*X4-3*X10-X9-2*X8-X7-2*X6)+2*PQ**2
|
|
& *PH**2*(-6*X3-3*X4-3*X10+X7+2*X6)+4*PQ**2*(-8*X1*X3-4*X1*
|
|
& X4-4*X1*X10-8*X2*X3-4*X2*X4-4*X2*X10-4*X3*X9-4*X3*X7-12*
|
|
& X3*X5-4*X4*X9+8*X4*X8-4*X4*X7+8*X4*X6-6*X4*X5-6*X10*X5-X9
|
|
& *X5-2*X8*X5)+4*PH**2*(2*X1*X3+X1*X4+X1*X10+X3*X7+X4*X7-2*
|
|
& X4*X6)+8*X5*(-2*X2*X3-X2*X4-X2*X10-X3*X9-X4*X9+2*X4*X8)
|
|
FM(7,7)=72*PQ**4*X10+18*PQ**2*PH**2*X10+8*PQ**2*(X1*X10+9*
|
|
& X2*X10+7*X3*X7+2*X3*X6+2*X4*X7+7*X4*X6+X10*X5+2*X9*X7+7*
|
|
& X9*X6+7*X8*X7+2*X8*X6)+2*PH**2*(-X1*X10-7*X3*X7-2*X3*X6-2
|
|
& *X4*X7-7*X4*X6)+4*X2*(X10*X5+2*X9*X7+7*X9*X6+7*X8*X7+2*X8
|
|
& *X6)
|
|
FM(7,8)=72*PQ**4*X10+2*PQ**2*PH**2*X10+4*PQ**2*(2*X1*X10+
|
|
& 10*X2*X10+7*X3*X9+2*X3*X8+14*X3*X7+4*X3*X6+2*X4*X9+7*X4*
|
|
& X8+4*X4*X7+14*X4*X6+10*X10*X5+X9**2+7*X9*X8+2*X9*X7+7*X9*
|
|
& X6+X8**2+7*X8*X7+2*X8*X6)+2*PH**2*(7*X1*X10-7*X3*X7-2*X3*
|
|
& X6-2*X4*X7-7*X4*X6)+2*(-2*X1*X9**2-14*X1*X9*X8-2*X1*X8**2
|
|
& +2*X2*X10*X5+2*X2*X9*X7+7*X2*X9*X6+7*X2*X8*X7+2*X2*X8*X6+
|
|
& 7*X3*X9*X5+2*X3*X8*X5+2*X4*X9*X5+7*X4*X8*X5)
|
|
FM(8,8)=72*PQ**4*X10+18*PQ**2*PH**2*X10+8*PQ**2*(X1*X10+X2
|
|
& *X10+7*X3*X9+2*X3*X8+7*X3*X7+2*X3*X6+2*X4*X9+7*X4*X8+2*X4
|
|
& *X7+7*X4*X6+9*X10*X5)+2*PH**2*(-X1*X10-7*X3*X7-2*X3*X6-2*
|
|
& X4*X7-7*X4*X6)+4*X5*(X2*X10+7*X3*X9+2*X3*X8+2*X4*X9+7*X4*
|
|
& X8)
|
|
FM(9,9)=-4*PQ**4*X10-PQ**2*PH**2*X10+4*PQ**2*(-X1*X10-X2*X10+
|
|
& X3*X7+X4*X6-X10*X5+X9*X6+X8*X7)+PH**2*(X1*X10-X3*X7-X4*X6
|
|
& )+2*X2*(-X10*X5+X9*X6+X8*X7)
|
|
FM(9,10)=-4*PQ**4*X10-PQ**2*PH**2*X10+2*PQ**2*(-2*X1*X10-2*X2*
|
|
& X10+2*X3*X9+2*X3*X7+2*X4*X6-2*X10*X5+X9*X8+2*X8*X7)+PH**2
|
|
& *(X1*X10-X3*X7-X4*X6)+2*(-X1*X9*X8-X2*X10*X5+X2*X8*X7+X3*
|
|
& X9*X5)
|
|
FMXX=-4*PQ**4*X10-PQ**2*PH**2*X10+2*PQ**2*(-2*X1*X10-2*X2*
|
|
& X10+2*X4*X8+2*X4*X6+2*X3*X7-2*X10*X5+X9*X8+2*X9*X6)+PH**2
|
|
& *(X1*X10-X3*X7-X4*X6)+2*(-X1*X9*X8-X2*X10*X5+X2*X9*X6+X4*
|
|
& X8*X5)
|
|
FM(9,10)=0.5D0*(FMXX+FM(9,10))
|
|
FM(10,10)=-4*PQ**4*X10-PQ**2*PH**2*X10+4*PQ**2*(-X1*X10-X2*X10+
|
|
& X3*X7+X4*X6-X10*X5+X9*X3+X8*X4)+PH**2*(X1*X10-X3*X7-X4*X6
|
|
& )+2*X5*(-X10*X2+X9*X3+X8*X4)
|
|
|
|
C...Repackage matrix elements.
|
|
DO 200 I=1,8
|
|
DO 190 J=1,8
|
|
RM(I,J)=FM(I,J)
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
RM(7,7)=FM(7,7)-2D0*FM(9,9)
|
|
RM(7,8)=FM(7,8)-2D0*FM(9,10)
|
|
RM(8,8)=FM(8,8)-2D0*FM(10,10)
|
|
|
|
C...Produce final result: matrix elements * colours * propagators.
|
|
DO 220 I=1,8
|
|
DO 210 J=I,8
|
|
FAC=8D0
|
|
IF(I.EQ.J)FAC=4D0
|
|
WTQQBH=WTQQBH+RM(I,J)*FAC*CLR(I,J)/(DX(I)*DX(J))
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
WTQQBH=-WTQQBH/256D0
|
|
|
|
ELSE
|
|
C...Evaluate matrix elements for q + qbar -> Q + Qbar + H.
|
|
A11=-8D0*PQ**4*X10-2D0*PQ**2*PH**2*X10-(8D0*PQ**2)*(X2*X10+X3
|
|
& *X7+X4*X6+X9*X6+X8*X7)+2D0*PH**2*(X3*X7+X4*X6)-(4D0*X2)*(X9
|
|
& *X6+X8*X7)
|
|
A12=-8D0*PQ**4*X10+4D0*PQ**2*(-X2*X10-X3*X9-2D0*X3*X7-X4*X8-
|
|
& 2D0*X4*X6-X10*X5-X9*X8-X9*X6-X8*X7)+2D0*PH**2*(-X1*X10+X3*X7
|
|
& +X4*X6)+2D0*(2D0*X1*X9*X8-X2*X9*X6-X2*X8*X7-X3*X9*X5-X4*X8*
|
|
& X5)
|
|
A22=-8D0*PQ**4*X10-2D0*PQ**2*PH**2*X10-(8D0*PQ**2)*(X3*X9+X3*
|
|
& X7+X4*X8+X4*X6+X10*X5)+2D0*PH**2*(X3*X7+X4*X6)-(4D0*X5)*(X3
|
|
& *X9+X4*X8)
|
|
|
|
C...Produce final result: matrix elements * propagators.
|
|
A11=A11/DX(7)**2
|
|
A12=A12/(DX(7)*DX(8))
|
|
A22=A22/DX(8)**2
|
|
WTQQBH=-(A11+A22+2D0*A12)/8D0
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYMSIN
|
|
C...Initializes supersymmetry: finds sparticle masses and
|
|
C...branching ratios and stores this information.
|
|
C...AUTHOR: STEPHEN MRENNA
|
|
|
|
SUBROUTINE PYMSIN
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYINT4/MWID(500),WIDS(500,5)
|
|
COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT4/,/PYMSSM/,
|
|
&/PYSSMT/
|
|
|
|
C...Local variables.
|
|
INTEGER NSTR
|
|
DOUBLE PRECISION ALFA,BETA
|
|
DOUBLE PRECISION TANB,AL,BE,COSA,COSB,SINA,SINB,XW,AEM,FACT
|
|
DOUBLE PRECISION PYALEM
|
|
INTEGER I,J,J1,J2,I1,I2,I3,IKNT,K1
|
|
INTEGER KC,LKNT,IDLAM(200,3),IDLAM0(100,3),LKNT0
|
|
DOUBLE PRECISION XLAM(0:200),XLAM0(0:200),XALL
|
|
DOUBLE PRECISION WDTP(0:200),WDTE(0:200,0:5)
|
|
DOUBLE PRECISION ATERM,TAN2T,THETA,DENOM
|
|
DOUBLE PRECISION XARG,COS2B,XMW2,XMZ2
|
|
DOUBLE PRECISION COSW,SINW,WDMIN,WDMAX
|
|
DOUBLE PRECISION DELM,XMDIF,BRLIM
|
|
DOUBLE PRECISION DX,DY,DS,DMU2,DMA2,DQ2,DU2,DD2,DL2,DE2,DHU2,DHD2
|
|
DOUBLE PRECISION ARG,SGNMU,R,GAM
|
|
INTEGER IS1,IS2,IS3,IS4,JS1,JS2,JS3,JS4,KS1,KS2,KS3,KS4
|
|
INTEGER IMSSM,KFHIGG
|
|
INTEGER IRPRTY
|
|
INTEGER KFSUSY(36)
|
|
DATA KFSUSY/
|
|
&1000001,2000001,1000002,2000002,1000003,2000003,
|
|
&1000004,2000004,1000005,2000005,1000006,2000006,
|
|
&1000011,2000011,1000012,2000012,1000013,2000013,
|
|
&1000014,2000014,1000015,2000015,1000016,2000016,
|
|
&1000021,1000022,1000023,1000025,1000035,1000024,
|
|
&1000037,1000039, 25, 35, 36, 37/
|
|
|
|
C...Do nothing if SUSY not requested.
|
|
IMSSM=IMSS(1)
|
|
IF(IMSSM.EQ.0) RETURN
|
|
|
|
C...First part of routine: set masses and couplings.
|
|
|
|
C...Reset mixing values in sfermion sector to pure left/right.
|
|
DO 100 I=1,16
|
|
SFMIX(I,1)=1D0
|
|
SFMIX(I,4)=1D0
|
|
SFMIX(I,2)=0D0
|
|
SFMIX(I,3)=0D0
|
|
100 CONTINUE
|
|
|
|
C...Common couplings.
|
|
TANB=RMSS(5)
|
|
BETA=ATAN(TANB)
|
|
COSB=COS(BETA)
|
|
SINB=TANB*COSB
|
|
COS2B=COS(2D0*BETA)
|
|
ALFA=RMSS(18)
|
|
XMW2=PMAS(24,1)**2
|
|
XMZ2=PMAS(23,1)**2
|
|
XW=PARU(102)
|
|
|
|
C...Define sparticle masses for a general MSSM simulation.
|
|
IF(IMSSM.EQ.1) THEN
|
|
IF(IMSS(9).EQ.0) RMSS(22)=RMSS(9)
|
|
DO 110 I=1,5,2
|
|
KC=PYCOMP(KSUSY1+I)
|
|
PMAS(KC,1)=SQRT(RMSS(8)**2-(2D0*XMW2+XMZ2)*COS2B/6D0)
|
|
KC=PYCOMP(KSUSY2+I)
|
|
PMAS(KC,1)=SQRT(RMSS(9)**2+(XMW2-XMZ2)*COS2B/3D0)
|
|
KC=PYCOMP(KSUSY1+I+1)
|
|
PMAS(KC,1)=SQRT(RMSS(8)**2+(4D0*XMW2-XMZ2)*COS2B/6D0)
|
|
KC=PYCOMP(KSUSY2+I+1)
|
|
PMAS(KC,1)=SQRT(RMSS(22)**2-(XMW2-XMZ2)*COS2B*2D0/3D0)
|
|
110 CONTINUE
|
|
XARG=RMSS(6)**2-PMAS(24,1)**2*ABS(COS(2D0*BETA))
|
|
IF(XARG.LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'//
|
|
& ' FROM THE SUM RULE. '
|
|
WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). '
|
|
RETURN
|
|
ELSE
|
|
XARG=SQRT(XARG)
|
|
ENDIF
|
|
DO 120 I=11,15,2
|
|
PMAS(PYCOMP(KSUSY1+I),1)=RMSS(6)
|
|
PMAS(PYCOMP(KSUSY2+I),1)=RMSS(7)
|
|
PMAS(PYCOMP(KSUSY1+I+1),1)=XARG
|
|
PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0
|
|
120 CONTINUE
|
|
IF(IMSS(8).EQ.1) THEN
|
|
RMSS(13)=RMSS(6)
|
|
RMSS(14)=RMSS(7)
|
|
ENDIF
|
|
|
|
C...Alternatively derive masses from SUGRA relations.
|
|
ELSEIF(IMSSM.EQ.2) THEN
|
|
CALL PYAPPS
|
|
ENDIF
|
|
|
|
C...Add in extra D-term contributions.
|
|
IF(IMSS(7).EQ.1) THEN
|
|
R=0.43D0
|
|
DX=RMSS(23)
|
|
DY=RMSS(24)
|
|
DS=RMSS(25)
|
|
WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC'
|
|
WRITE(MSTU(11),*) 'C NEW DTERMS ADDED TO SCALAR MASSES '
|
|
WRITE(MSTU(11),*) 'C IN A U(B-L) THEORY '
|
|
WRITE(MSTU(11),*) 'C DX = ',DX
|
|
WRITE(MSTU(11),*) 'C DY = ',DY
|
|
WRITE(MSTU(11),*) 'C DS = ',DS
|
|
WRITE(MSTU(11),*) 'C '
|
|
DY=R*DY-4D0/33D0*(1D0-R)*DX+(1D0-R)/33D0*DS
|
|
WRITE(MSTU(11),*) 'C DY AT THE WEAK SCALE = ',DY
|
|
WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC'
|
|
DQ2=DY/6D0-DX/3D0-DS/3D0
|
|
DU2=-2D0*DY/3D0-DX/3D0-DS/3D0
|
|
DD2=DY/3D0+DX-2D0*DS/3D0
|
|
DL2=-DY/2D0+DX-2D0*DS/3D0
|
|
DE2=DY-DX/3D0-DS/3D0
|
|
DHU2=DY/2D0+2D0*DX/3D0+2D0*DS/3D0
|
|
DHD2=-DY/2D0-2D0*DX/3D0+DS
|
|
DMU2=(-DY/2D0-2D0/3D0*DX+(COSB**2-2D0*SINB**2/3D0)*DS)
|
|
& /ABS(COS2B)
|
|
DMA2 = 2D0*DMU2+DHU2+DHD2
|
|
DO 130 I=1,5,2
|
|
KC=PYCOMP(KSUSY1+I)
|
|
PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DQ2)
|
|
KC=PYCOMP(KSUSY2+I)
|
|
PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DD2)
|
|
KC=PYCOMP(KSUSY1+I+1)
|
|
PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DQ2)
|
|
KC=PYCOMP(KSUSY2+I+1)
|
|
PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DU2)
|
|
130 CONTINUE
|
|
DO 140 I=11,15,2
|
|
KC=PYCOMP(KSUSY1+I)
|
|
PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DL2)
|
|
KC=PYCOMP(KSUSY2+I)
|
|
PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DE2)
|
|
KC=PYCOMP(KSUSY1+I+1)
|
|
PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DL2)
|
|
140 CONTINUE
|
|
IF(RMSS(4)**2+DMU2.LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' MU2 DRIVEN NEGATIVE '
|
|
STOP
|
|
ENDIF
|
|
SGNMU=SIGN(1D0,RMSS(4))
|
|
RMSS(4)=SGNMU*SQRT(RMSS(4)**2+DMU2)
|
|
ARG=RMSS(10)**2*SIGN(1D0,RMSS(10))+DQ2
|
|
RMSS(10)=SIGN(SQRT(ABS(ARG)),ARG)
|
|
ARG=RMSS(11)**2*SIGN(1D0,RMSS(11))+DD2
|
|
RMSS(11)=SIGN(SQRT(ABS(ARG)),ARG)
|
|
ARG=RMSS(12)**2*SIGN(1D0,RMSS(12))+DU2
|
|
RMSS(12)=SIGN(SQRT(ABS(ARG)),ARG)
|
|
ARG=RMSS(13)**2*SIGN(1D0,RMSS(13))+DL2
|
|
RMSS(13)=SIGN(SQRT(ABS(ARG)),ARG)
|
|
ARG=RMSS(14)**2*SIGN(1D0,RMSS(14))+DE2
|
|
RMSS(14)=SIGN(SQRT(ABS(ARG)),ARG)
|
|
IF( RMSS(19)**2 + DMA2 .LE. 50D0 ) THEN
|
|
WRITE(MSTU(11),*) ' MA DRIVEN TOO LOW '
|
|
STOP
|
|
ENDIF
|
|
RMSS(19)=SQRT(RMSS(19)**2+DMA2)
|
|
RMSS(6)=SQRT(RMSS(6)**2+DL2)
|
|
RMSS(7)=SQRT(RMSS(7)**2+DE2)
|
|
WRITE(MSTU(11),*) ' MTL = ',RMSS(10)
|
|
WRITE(MSTU(11),*) ' MBR = ',RMSS(11)
|
|
WRITE(MSTU(11),*) ' MTR = ',RMSS(12)
|
|
WRITE(MSTU(11),*) ' SEL = ',RMSS(6),RMSS(13)
|
|
WRITE(MSTU(11),*) ' SER = ',RMSS(7),RMSS(14)
|
|
ENDIF
|
|
|
|
C...Fix the third generation sfermions.
|
|
CALL PYTHRG
|
|
XARG=RMSS(13)**2-PMAS(24,1)**2*ABS(COS2B)
|
|
IF(XARG.LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' TAU SNEUTRINO MASS IS NEGATIVE FROM'//
|
|
& ' THE SUM RULE. '
|
|
WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). '
|
|
RETURN
|
|
ELSE
|
|
PMAS(PYCOMP(KSUSY1+16),1)=SQRT(XARG)
|
|
ENDIF
|
|
|
|
C...Fix the neutralino--chargino--gluino sector.
|
|
CALL PYINOM
|
|
|
|
C...Fix the Higgs sector.
|
|
CALL PYHGGM(ALFA)
|
|
|
|
C...Choose the Gunion-Haber convention.
|
|
ALFA=-ALFA
|
|
RMSS(18)=ALFA
|
|
|
|
C...Print information on mass parameters.
|
|
IF(IMSSM.EQ.2.AND.MSTP(122).GT.0) THEN
|
|
WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC'
|
|
WRITE(MSTU(11),*) ' USING APPROXIMATE SUGRA RELATIONS '
|
|
WRITE(MSTU(11),*) ' M0 = ',RMSS(8)
|
|
WRITE(MSTU(11),*) ' M1/2=',RMSS(1)
|
|
WRITE(MSTU(11),*) ' TANB=',RMSS(5)
|
|
WRITE(MSTU(11),*) ' MU = ',RMSS(4)
|
|
WRITE(MSTU(11),*) ' AT = ',RMSS(16)
|
|
WRITE(MSTU(11),*) ' MA = ',RMSS(19)
|
|
WRITE(MSTU(11),*) ' MTOP=',PMAS(6,1)
|
|
WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC'
|
|
ENDIF
|
|
IF(IMSS(20).EQ.1) THEN
|
|
WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC'
|
|
WRITE(MSTU(11),*) ' DEBUG MODE '
|
|
WRITE(MSTU(11),*) ' UMIX = ',UMIX(1,1),UMIX(1,2),
|
|
& UMIX(2,1),UMIX(2,2)
|
|
WRITE(MSTU(11),*) ' VMIX = ',VMIX(1,1),VMIX(1,2),
|
|
& VMIX(2,1),VMIX(2,2)
|
|
WRITE(MSTU(11),*) ' ZMIX = ',ZMIX
|
|
WRITE(MSTU(11),*) ' ALFA = ',ALFA
|
|
WRITE(MSTU(11),*) ' BETA = ',BETA
|
|
WRITE(MSTU(11),*) ' STOP = ',(SFMIX(6,I),I=1,4)
|
|
WRITE(MSTU(11),*) ' SBOT = ',(SFMIX(5,I),I=1,4)
|
|
WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC'
|
|
ENDIF
|
|
|
|
C...Set up the Higgs couplings - needed here since initialization
|
|
C...in PYINRE did not yet occur when PYWIDT is called below.
|
|
AL=ALFA
|
|
BE=BETA
|
|
SINA=SIN(AL)
|
|
COSA=COS(AL)
|
|
COSB=COS(BE)
|
|
SINB=TANB*COSB
|
|
C...tanb (used for H+)
|
|
PARU(141)=TANB
|
|
|
|
C...Firstly: h
|
|
C...Coupling to d-type quarks
|
|
PARU(161)=SINA/COSB
|
|
C...Coupling to u-type quarks
|
|
PARU(162)=-COSA/SINB
|
|
C...Coupling to leptons
|
|
PARU(163)=PARU(161)
|
|
C...Coupling to Z
|
|
PARU(164)=SIN(BE-AL)
|
|
C...Coupling to W
|
|
PARU(165)=PARU(164)
|
|
C...Coupling to H+
|
|
PARU(168)=-SIN(BE-AL)-COS(2D0*BE)*SIN(BE+AL)/2D0/(1D0-XW)
|
|
|
|
C...Secondly: H
|
|
C...Coupling to d-type quarks
|
|
PARU(171)=-COSA/COSB
|
|
C...Coupling to u-type quarks
|
|
PARU(172)=-SINA/SINB
|
|
C...Coupling to leptons
|
|
PARU(173)=PARU(171)
|
|
C...Coupling to Z
|
|
PARU(174)=COS(BE-AL)
|
|
C...Coupling to W
|
|
PARU(175)=PARU(174)
|
|
C...Coupling to h
|
|
PARU(176)=COS(2D0*AL)*COS(BE+AL)-2D0*SIN(2D0*AL)*SIN(BE+AL)
|
|
C...Coupling to A
|
|
PARU(177)=COS(2D0*BE)*COS(BE+AL)
|
|
C...Coupling to H+
|
|
PARU(178)=-COS(BE-AL)+COS(2D0*BE)*COS(BE+AL)/2D0/(1D0-XW)
|
|
|
|
C...Thirdly, A
|
|
C...Coupling to d-type quarks
|
|
PARU(181)=TANB
|
|
C...Coupling to u-type quarks
|
|
PARU(182)=1D0/PARU(181)
|
|
C...Coupling to leptons
|
|
PARU(183)=PARU(181)
|
|
PARU(184)=0D0
|
|
PARU(185)=0D0
|
|
C...Coupling to Z h
|
|
PARU(186)=COS(BE-AL)
|
|
C...Coupling to Z H
|
|
PARU(187)=SIN(BE-AL)
|
|
PARU(188)=0D0
|
|
PARU(189)=0D0
|
|
PARU(190)=0D0
|
|
|
|
C...Finally: H+
|
|
C...Coupling to W h
|
|
PARU(195)=COS(BE-AL)
|
|
|
|
C...Tell that all Higgs couplings have been set.
|
|
MSTP(4)=1
|
|
|
|
C...Second part of routine: set decay modes and branching ratios.
|
|
|
|
C...Allow chi10 -> gravitino + gamma or not.
|
|
KC=PYCOMP(KSUSY1+39)
|
|
IF( IMSS(11) .NE. 0 ) THEN
|
|
PMAS(KC,1)=RMSS(21)/1000000000D0
|
|
PMAS(KC,2)=0.0001D0
|
|
IRPRTY=0
|
|
WRITE(MSTU(11),*) ' ALLOWING DECAYS TO GRAVITINOS '
|
|
ELSE
|
|
PMAS(KC,1)=9999D0
|
|
IRPRTY=1
|
|
ENDIF
|
|
|
|
C...Loop over sparticle and Higgs species.
|
|
PMCHI1=PMAS(PYCOMP(KSUSY1+22),1)
|
|
DO 200 I=1,36
|
|
KF=KFSUSY(I)
|
|
KC=PYCOMP(KF)
|
|
LKNT=0
|
|
|
|
C...Sfermion decays.
|
|
IF(I.LE.24) THEN
|
|
C...First check to see if sneutrino is lighter than chi10.
|
|
IF((I.EQ.15.OR.I.EQ.19.OR.I.EQ.23).AND.
|
|
& PMAS(KC,1).LT.PMCHI1) THEN
|
|
ELSE
|
|
CALL PYSFDC(KF,XLAM,IDLAM,LKNT)
|
|
ENDIF
|
|
|
|
C...Gluino decays.
|
|
ELSEIF(I.EQ.25) THEN
|
|
CALL PYGLUI(KF,XLAM,IDLAM,LKNT)
|
|
|
|
C...Neutralino decays.
|
|
ELSEIF(I.GE.26.AND.I.LE.29) THEN
|
|
CALL PYNJDC(KF,XLAM,IDLAM,LKNT)
|
|
C...chi10 stable or chi10 -> gravitino + gamma.
|
|
IF(I.EQ.26.AND.IRPRTY.EQ.1) THEN
|
|
PMAS(KC,2)=1D-6
|
|
MDCY(KC,1)=0
|
|
MWID(KC)=0
|
|
ENDIF
|
|
|
|
C...Chargino decays.
|
|
ELSEIF(I.GE.30.AND.I.LE.31) THEN
|
|
CALL PYCJDC(KF,XLAM,IDLAM,LKNT)
|
|
|
|
C...Gravitino is stable.
|
|
ELSEIF(I.EQ.32) THEN
|
|
MDCY(KC,1)=0
|
|
MWID(KC)=0
|
|
|
|
C...Higgs decays.
|
|
ELSEIF(I.GE.33.AND.I.LE.36) THEN
|
|
C...Calculate decays to non-SUSY particles.
|
|
CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE)
|
|
LKNT=0
|
|
DO 150 I1=0,100
|
|
XLAM(I1)=0D0
|
|
150 CONTINUE
|
|
DO 170 I1=1,MDCY(KC,3)
|
|
K1=MDCY(KC,2)+I1-1
|
|
IF(IABS(KFDP(K1,1)).GT.KSUSY1.OR.
|
|
& IABS(KFDP(K1,2)).GT.KSUSY1) GOTO 170
|
|
XLAM(I1)=WDTP(I1)
|
|
XLAM(0)=XLAM(0)+XLAM(I1)
|
|
DO 160 J1=1,3
|
|
IDLAM(I1,J1)=KFDP(K1,J1)
|
|
160 CONTINUE
|
|
LKNT=LKNT+1
|
|
170 CONTINUE
|
|
C...Add the decays to SUSY particles.
|
|
CALL PYHEXT(KF,XLAM,IDLAM,LKNT)
|
|
ENDIF
|
|
|
|
C...Set stable particles.
|
|
IF(LKNT.EQ.0) THEN
|
|
MDCY(KC,1)=0
|
|
MWID(KC)=0
|
|
PMAS(KC,2)=1D-6
|
|
PMAS(KC,3)=1D-5
|
|
PMAS(KC,4)=0D0
|
|
|
|
C...Store branching ratios in the standard tables.
|
|
ELSE
|
|
IDC=MDCY(KC,2)+MDCY(KC,3)-1
|
|
DELM=1D6
|
|
DO 190 IL=1,LKNT
|
|
IDCSV=IDC
|
|
180 IDC=IDC+1
|
|
IF(IDC.EQ.MDCY(KC,2)+MDCY(KC,3)) IDC=MDCY(KC,2)
|
|
IF(IDLAM(IL,1).EQ.KFDP(IDC,1).AND.IDLAM(IL,2).EQ.
|
|
& KFDP(IDC,2).AND.IDLAM(IL,3).EQ.KFDP(IDC,3)) THEN
|
|
BRAT(IDC)=XLAM(IL)/XLAM(0)
|
|
XMDIF=PMAS(KC,1)
|
|
IF(MDME(IDC,1).GE.1) THEN
|
|
XMDIF=XMDIF-PMAS(PYCOMP(KFDP(IDC,1)),1)-
|
|
& PMAS(PYCOMP(KFDP(IDC,2)),1)
|
|
IF(KFDP(IDC,3).NE.0) XMDIF=XMDIF-
|
|
& PMAS(PYCOMP(KFDP(IDC,3)),1)
|
|
ENDIF
|
|
IF(I.LE.32) THEN
|
|
IF(XMDIF.GE.0D0) THEN
|
|
DELM=MIN(DELM,XMDIF)
|
|
ELSE
|
|
WRITE(MSTU(11),*) ' ERROR WITH DELM ',DELM,XMDIF
|
|
WRITE(MSTU(11),*) ' KF = ',KF
|
|
WRITE(MSTU(11),*) ' KF(decay) = ',(KFDP(IDC,J),J=1,3)
|
|
ENDIF
|
|
ENDIF
|
|
GOTO 190
|
|
ELSEIF(IDC.EQ.IDCSV) THEN
|
|
WRITE(MSTU(11),*) ' Error in PYMSIN: SUSY decay ',
|
|
& 'channel not recognized:'
|
|
WRITE(MSTU(11),*) KF,' -> ',(IDLAM(I,J),J=1,3)
|
|
GOTO 190
|
|
ELSE
|
|
GOTO 180
|
|
ENDIF
|
|
190 CONTINUE
|
|
|
|
C...Store width, cutoff and lifetime.
|
|
PMAS(KC,2)=XLAM(0)
|
|
IF(PMAS(KC,2).LT.0.1D0*DELM) THEN
|
|
PMAS(KC,3)=PMAS(KC,2)*10D0
|
|
ELSE
|
|
PMAS(KC,3)=0.95D0*DELM
|
|
ENDIF
|
|
IF(PMAS(KC,2).NE.0D0) THEN
|
|
PMAS(KC,4)=PARU(3)/PMAS(KC,2)*1D-12
|
|
ENDIF
|
|
ENDIF
|
|
200 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYAPPS
|
|
C...Uses approximate analytical formulae to determine the full set of
|
|
C...MSSM parameters from SUGRA input.
|
|
C...See M. Drees and S.P. Martin, hep-ph/9504124
|
|
|
|
SUBROUTINE PYAPPS
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/
|
|
|
|
XMT=PMAS(6,1)
|
|
XMZ2=PMAS(23,1)**2
|
|
XMW2=PMAS(24,1)**2
|
|
TANB=RMSS(5)
|
|
BETA=ATAN(TANB)
|
|
XW=PARU(102)
|
|
XMG=RMSS(1)
|
|
XMG2=XMG*XMG
|
|
XM0=RMSS(8)
|
|
XM02=XM0*XM0
|
|
AT=RMSS(16)
|
|
RMSS(15)=AT
|
|
RMSS(17)=AT
|
|
COSB=COS(BETA)
|
|
SINB=TANB*COSB
|
|
|
|
DTERM=XMZ2*COS(2D0*BETA)
|
|
XMER=SQRT(XM02+0.15D0*XMG2-XW*DTERM)
|
|
XMEL=SQRT(XM02+0.52D0*XMG2-(0.5D0-XW)*DTERM)
|
|
RMSS(6)=XMEL
|
|
RMSS(7)=XMER
|
|
XMUR=SQRT(PYRNMQ(2,2D0/3D0*XW*DTERM))
|
|
XMDR=SQRT(PYRNMQ(3,-1D0/3D0*XW*DTERM))
|
|
XMUL=SQRT(PYRNMQ(1,(0.5D0-2D0/3D0*XW)*DTERM))
|
|
XMDL=SQRT(PYRNMQ(1,-(0.5D0-1D0/3D0*XW)*DTERM))
|
|
DO 100 I=1,5,2
|
|
PMAS(PYCOMP(KSUSY1+I),1)=XMDL
|
|
PMAS(PYCOMP(KSUSY2+I),1)=XMDR
|
|
PMAS(PYCOMP(KSUSY1+I+1),1)=XMUL
|
|
PMAS(PYCOMP(KSUSY2+I+1),1)=XMUR
|
|
100 CONTINUE
|
|
XARG=XMEL**2-XMW2*ABS(COS(2D0*BETA))
|
|
IF(XARG.LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'//
|
|
& ' FROM THE SUM RULE. '
|
|
WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). '
|
|
RETURN
|
|
ELSE
|
|
XARG=SQRT(XARG)
|
|
ENDIF
|
|
DO 110 I=11,15,2
|
|
PMAS(PYCOMP(KSUSY1+I),1)=XMEL
|
|
PMAS(PYCOMP(KSUSY2+I),1)=XMER
|
|
PMAS(PYCOMP(KSUSY1+I+1),1)=XARG
|
|
PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0
|
|
110 CONTINUE
|
|
XMNU=XARG
|
|
|
|
RMT=PYRNMT(XMT)
|
|
XTOP=(RMT/150D0/SINB)**2*(.9D0*XM02+2.1D0*XMG2+
|
|
&(1D0-(RMT/190D0/SINB)**3)*(.24D0*AT**2+AT*XMG))
|
|
RMB=3D0
|
|
XBOT=(RMB/150D0/COSB)**2*(.9D0*XM02+2.1D0*XMG2+
|
|
&(1D0-(RMB/190D0/COSB)**3)*(.24D0*AT**2+AT*XMG))
|
|
XTAU=1D-4/COSB**2*(XM02+0.15D0*XMG2+AT**2/3D0)
|
|
ATP=AT*(1D0-(RMT/190D0/SINB)**2)+XMG*(3.47D0-1.9D0*(RMT/190D0/
|
|
&SINB)**2)
|
|
RMSS(16)=ATP
|
|
XMU2=-XM02-0.52D0*XMG2-0.5D0*XMZ2+XTOP/(1D0-1D0/TANB**2)
|
|
XMA2=(XMNU**2+XMU2-XBOT-XTAU/3D0)/SINB**2
|
|
XMU=SIGN(SQRT(XMU2),RMSS(4))
|
|
RMSS(4)=XMU
|
|
RMSS(19)=SQRT(XMA2)
|
|
ARG=XM02+0.15D0*XMG2-2D0*XTAU/3D0-XW*DTERM
|
|
IF(ARG.GT.0D0) THEN
|
|
RMSS(14)=SQRT(ARG)
|
|
ELSE
|
|
WRITE(MSTU(11),*) ' RIGHT STAU MASS < 0 '
|
|
STOP
|
|
ENDIF
|
|
ARG=XM02+0.52D0*XMG2-XTAU/3D0-(0.5D0-XW)*DTERM
|
|
IF(ARG.GT.0D0) THEN
|
|
RMSS(13)=SQRT(ARG)
|
|
ELSE
|
|
WRITE(MSTU(11),*) ' LEFT STAU MASS < 0 '
|
|
STOP
|
|
ENDIF
|
|
ARG=PYRNMQ(1,-(XBOT+XTOP)/3D0)
|
|
IF(ARG.GT.0D0) THEN
|
|
RMSS(10)=SQRT(ARG)
|
|
ELSE
|
|
RMSS(10)=-SQRT(-ARG)
|
|
ENDIF
|
|
ARG=PYRNMQ(2,-2D0*XTOP/3D0)
|
|
IF(ARG.GT.0D0) THEN
|
|
RMSS(12)=SQRT(ARG)
|
|
ELSE
|
|
RMSS(12)=-SQRT(-ARG)
|
|
ENDIF
|
|
ARG=PYRNMQ(3,-2D0*XBOT/3D0)
|
|
IF(ARG.GT.0D0) THEN
|
|
RMSS(11)=SQRT(ARG)
|
|
ELSE
|
|
RMSS(11)=-SQRT(-ARG)
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYRNMQ
|
|
C...Determines the running mass of quarks.
|
|
|
|
FUNCTION PYRNMQ(ID,DTERM)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblock.
|
|
COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
SAVE /PYMSSM/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PI,R
|
|
DOUBLE PRECISION TOL
|
|
DOUBLE PRECISION CI(3)
|
|
EXTERNAL PYALPS
|
|
DATA TOL/0.001D0/
|
|
DATA PI,R/3.141592654D0,.61803399D0/
|
|
DATA CI/0.47D0,0.07D0,0.02D0/
|
|
|
|
C=1D0-R
|
|
CA=CI(ID)
|
|
AG=(0.71D0)**2/4D0/PI
|
|
AG=RMSS(20)
|
|
XM0=RMSS(8)
|
|
XMG=RMSS(1)
|
|
XM02=XM0*XM0
|
|
XMG2=XMG*XMG
|
|
|
|
AS=PYALPS(XM02+6D0*XMG2)
|
|
CG=8D0/9D0*((AS/AG)**2-1D0)
|
|
BX=XM02+(CA+CG)*XMG2+DTERM
|
|
AX=MIN(50D0**2,0.5D0*BX)
|
|
CX=MAX(2000D0**2,2D0*BX)
|
|
|
|
X0=AX
|
|
X3=CX
|
|
IF(ABS(CX-BX).GT.ABS(BX-AX))THEN
|
|
X1=BX
|
|
X2=BX+C*(CX-BX)
|
|
ELSE
|
|
X2=BX
|
|
X1=BX-C*(BX-AX)
|
|
ENDIF
|
|
AS1=PYALPS(X1)
|
|
CG=8D0/9D0*((AS1/AG)**2-1D0)
|
|
F1=ABS(XM02+(CA+CG)*XMG2+DTERM-X1)
|
|
AS2=PYALPS(X2)
|
|
CG=8D0/9D0*((AS2/AG)**2-1D0)
|
|
F2=ABS(XM02+(CA+CG)*XMG2+DTERM-X2)
|
|
100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN
|
|
IF(F2.LT.F1) THEN
|
|
X0=X1
|
|
X1=X2
|
|
X2=R*X1+C*X3
|
|
F1=F2
|
|
AS2=PYALPS(X2)
|
|
CG=8D0/9D0*((AS2/AG)**2-1D0)
|
|
F2=ABS(XM02+(CA+CG)*XMG2+DTERM-X2)
|
|
ELSE
|
|
X3=X2
|
|
X2=X1
|
|
X1=R*X2+C*X0
|
|
F2=F1
|
|
AS1=PYALPS(X1)
|
|
CG=8D0/9D0*((AS1/AG)**2-1D0)
|
|
F1=ABS(XM02+(CA+CG)*XMG2+DTERM-X1)
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
IF(F1.LT.F2) THEN
|
|
PYRNMQ=X1
|
|
XMIN=X1
|
|
ELSE
|
|
PYRNMQ=X2
|
|
XMIN=X2
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYRNMT
|
|
C...Determines the running mass of the top quark.
|
|
|
|
FUNCTION PYRNMT(XMT)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblock.
|
|
COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
SAVE /PYMSSM/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION XMT
|
|
DOUBLE PRECISION PI,R
|
|
DOUBLE PRECISION TOL
|
|
EXTERNAL PYALPS
|
|
DATA TOL/0.001D0/
|
|
DATA PI,R/3.141592654D0,0.61803399D0/
|
|
|
|
C=1D0-R
|
|
|
|
BX=XMT
|
|
AX=MIN(50D0,BX*0.5D0)
|
|
CX=MAX(300D0,2D0*BX)
|
|
|
|
X0=AX
|
|
X3=CX
|
|
IF(ABS(CX-BX).GT.ABS(BX-AX))THEN
|
|
X1=BX
|
|
X2=BX+C*(CX-BX)
|
|
ELSE
|
|
X2=BX
|
|
X1=BX-C*(BX-AX)
|
|
ENDIF
|
|
AS1=PYALPS(X1**2)/PI
|
|
F1=ABS(XMT/(1D0+4D0/3D0*AS1+11D0*AS1**2)-X1)
|
|
AS2=PYALPS(X2**2)/PI
|
|
F2=ABS(XMT/(1D0+4D0/3D0*AS2+11D0*AS2**2)-X2)
|
|
100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN
|
|
IF(F2.LT.F1) THEN
|
|
X0=X1
|
|
X1=X2
|
|
X2=R*X1+C*X3
|
|
F1=F2
|
|
AS2=PYALPS(X2**2)/PI
|
|
F2=ABS(XMT/(1D0+4D0/3D0*AS2+11D0*AS2**2)-X2)
|
|
ELSE
|
|
X3=X2
|
|
X2=X1
|
|
X1=R*X2+C*X0
|
|
F2=F1
|
|
AS1=PYALPS(X1**2)/PI
|
|
F1=ABS(XMT/(1D0+4D0/3D0*AS1+11D0*AS1**2)-X1)
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
IF(F1.LT.F2) THEN
|
|
PYRNMT=X1
|
|
XMIN=X1
|
|
ELSE
|
|
PYRNMT=X2
|
|
XMIN=X2
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYTHRG
|
|
C...Calculates the mass eigenstates of the third generation sfermions.
|
|
C...Created: 5-31-96
|
|
|
|
SUBROUTINE PYTHRG
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION BETA
|
|
DOUBLE PRECISION PYRNMT
|
|
DOUBLE PRECISION AM2(2,2),RT(2,2),DI(2,2)
|
|
DOUBLE PRECISION XMZ2,XMW2,TANB,XMU,COS2B,XMQL2,XMQR2
|
|
DOUBLE PRECISION XMF,XMF2,DIFF,SAME,XMF12,XMF22,SMALL
|
|
DOUBLE PRECISION SIN2T,COS2T,TWOT,ATR,AMQR,XXX,YYY,AMQL
|
|
INTEGER ID1(3),ID2(3),ID3(3),ID4(3)
|
|
INTEGER IF,I,J,II,JJ,IT,L
|
|
LOGICAL DTERM
|
|
DATA SMALL/1D-3/
|
|
DATA ID1/10,10,13/
|
|
DATA ID2/5,6,15/
|
|
DATA ID3/15,16,17/
|
|
DATA ID4/11,12,14/
|
|
DATA DTERM/.TRUE./
|
|
|
|
XMZ2=PMAS(23,1)**2
|
|
XMW2=PMAS(24,1)**2
|
|
TANB=RMSS(5)
|
|
XMU=-RMSS(4)
|
|
BETA=ATAN(TANB)
|
|
COS2B=COS(2D0*BETA)
|
|
|
|
C...OPTION TO FIX T1, T2, B1 MASSES AND MIXINGS
|
|
|
|
IOPT=IMSS(5)
|
|
IF(IOPT.EQ.1) THEN
|
|
CTT=RMSS(27)
|
|
CTT2=CTT**2
|
|
STT2=1D0-CTT2
|
|
STT=SQRT(STT2)
|
|
XM12=RMSS(12)**2
|
|
XM22=RMSS(10)**2
|
|
XMQL2=CTT2*XM12+STT2*XM22
|
|
XMQR2=STT2*XM12+CTT2*XM22
|
|
XMFR=PMAS(6,1)
|
|
XMF2=PYRNMT(XMFR)**2
|
|
ATOP=-XMU/TANB+CTT*STT*(XM22-XM12)/SQRT(XMF2)
|
|
ATMT=SQRT(XMF2)*(ATOP+XMU/TANB)
|
|
XTEST=(XMQL2-XMQR2)*(CTT2-STT2)
|
|
IF(XTEST.GT.4D0*STT*CTT*ATMT) THEN
|
|
STT=-STT
|
|
ATOP=-XMU/TANB+CTT*STT*(XM22-XM12)/SQRT(XMF2)
|
|
ENDIF
|
|
RMSS(16)=ATOP
|
|
C......SUBTRACT OUT D-TERM AND FERMION MASS
|
|
XMQL2=XMQL2-XMF2-(4D0*XMW2-XMZ2)*COS2B/6D0
|
|
XMQR2=XMQR2-XMF2+(XMW2-XMZ2)*COS2B*2D0/3D0
|
|
IF(XMQL2.GE.0D0) THEN
|
|
RMSS(10)=SQRT(XMQL2)
|
|
ELSE
|
|
RMSS(10)=-SQRT(-XMQL2)
|
|
ENDIF
|
|
IF(XMQR2.GE.0D0) THEN
|
|
RMSS(12)=SQRT(XMQR2)
|
|
ELSE
|
|
RMSS(12)=-SQRT(-XMQR2)
|
|
ENDIF
|
|
C SAME FOR SBOTTOM SQUARK
|
|
CTT=RMSS(26)
|
|
CTT2=CTT**2
|
|
STT2=1D0-CTT2
|
|
STT=MAX(SQRT(STT2),1D-6)
|
|
XMF=3D00
|
|
XMF2=XMF**2
|
|
XM12=RMSS(11)**2
|
|
XMQL2=RMSS(10)**2-(2D0*XMW2+XMZ2)*COS2B/6D0+XMF2
|
|
IF(ABS(CTT).EQ.1D0) THEN
|
|
XM22=XM12
|
|
XM12=XMQL2
|
|
XMQR2=XM22
|
|
ELSEIF(CTT.EQ.0D0) THEN
|
|
XM22=XMQL2
|
|
XMQR2=XM12
|
|
ELSE
|
|
XM22=(XMQL2-CTT2*XM12)/STT2
|
|
XMQR2=STT2*XM12+CTT2*XM22
|
|
ENDIF
|
|
ABOT=-XMU*TANB+CTT*STT*(XM22-XM12)/SQRT(XMF2)
|
|
ATMT=SQRT(XMF2)*(ABOT+XMU*TANB)
|
|
XTEST=(XMQL2-XMQR2)*(CTT2-STT2)
|
|
IF(XTEST.GT.4D0*STT*CTT*ATMT) THEN
|
|
STT=-STT
|
|
ABOT=-XMU*TANB+CTT*STT*(XM22-XM12)/SQRT(XMF2)
|
|
ENDIF
|
|
RMSS(15)=ABOT
|
|
C......SUBTRACT OUT D-TERM AND FERMION MASS
|
|
XMQR2=XMQR2-(XMW2-XMZ2)*COS2B/3D0-XMF2
|
|
IF(XMQR2.GE.0D0) THEN
|
|
RMSS(11)=SQRT(XMQR2)
|
|
ELSE
|
|
RMSS(11)=-SQRT(-XMQR2)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
DO 170 L=1,3
|
|
AMQL=RMSS(ID1(L))
|
|
IF(AMQL.LT.0D0) THEN
|
|
XMQL2=-AMQL**2
|
|
ELSE
|
|
XMQL2=AMQL**2
|
|
ENDIF
|
|
IF=ID2(L)
|
|
XMF=PMAS(IF,1)
|
|
IF(L.EQ.1) XMF=3D0
|
|
IF(L.EQ.2) XMF=PYRNMT(XMF)
|
|
XMF2=XMF**2
|
|
ATR=RMSS(ID3(L))
|
|
AMQR=RMSS(ID4(L))
|
|
IF(AMQR.LT.0D0) THEN
|
|
XMQR2=-AMQR**2
|
|
ELSE
|
|
XMQR2=AMQR**2
|
|
ENDIF
|
|
AM2(1,1)=XMQL2+XMF2
|
|
AM2(2,2)=XMQR2+XMF2
|
|
IF(DTERM) THEN
|
|
IF(L.EQ.1) THEN
|
|
AM2(1,1)=AM2(1,1)-(2D0*XMW2+XMZ2)*COS2B/6D0
|
|
AM2(2,2)=AM2(2,2)+(XMW2-XMZ2)*COS2B/3D0
|
|
AM2(1,2)=XMF*(ATR+XMU*TANB)
|
|
ELSEIF(L.EQ.2) THEN
|
|
AM2(1,1)=AM2(1,1)+(4D0*XMW2-XMZ2)*COS2B/6D0
|
|
AM2(2,2)=AM2(2,2)-(XMW2-XMZ2)*COS2B*2D0/3D0
|
|
AM2(1,2)=XMF*(ATR+XMU/TANB)
|
|
ELSEIF(L.EQ.3) THEN
|
|
IF(IMSS(8).EQ.1) THEN
|
|
AM2(1,1)=RMSS(6)**2
|
|
AM2(2,2)=RMSS(7)**2
|
|
AM2(1,2)=0D0
|
|
RMSS(13)=RMSS(6)
|
|
RMSS(14)=RMSS(7)
|
|
ELSE
|
|
AM2(1,2)=XMF*(ATR+XMU*TANB)
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
AM2(2,1)=AM2(1,2)
|
|
SAME=0.5D0*(AM2(1,1)+AM2(2,2))
|
|
DIFF=0.5D0*SQRT((AM2(1,1)-AM2(2,2))**2+4D0*AM2(1,2)*AM2(2,1))
|
|
XMF12=SAME-DIFF
|
|
XMF22=SAME+DIFF
|
|
IF(XMF12.LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' NEGATIVE**2 MASS FOR SFERMION '
|
|
STOP
|
|
ENDIF
|
|
IT=0
|
|
IF(XMF22-XMF12.GT.0D0) THEN
|
|
RT(1,1) = SQRT((XMF22-AM2(1,1))/(XMF22-XMF12))
|
|
RT(2,2) = RT(1,1)
|
|
RT(1,2) = -SIGN(SQRT(1D0-RT(1,1)**2),AM2(1,2)/(XMF22-XMF12))
|
|
RT(2,1) = -RT(1,2)
|
|
ELSE
|
|
RT(1,1) = 1D0
|
|
RT(2,2) = RT(1,1)
|
|
RT(1,2) = 0D0
|
|
RT(2,1) = -RT(1,2)
|
|
ENDIF
|
|
100 CONTINUE
|
|
IT=IT+1
|
|
|
|
DO 140 I=1,2
|
|
DO 130 JJ=1,2
|
|
DI(I,JJ)=0D0
|
|
DO 120 II=1,2
|
|
DO 110 J=1,2
|
|
DI(I,JJ)=DI(I,JJ)+RT(I,J)*AM2(J,II)*RT(JJ,II)
|
|
110 CONTINUE
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
140 CONTINUE
|
|
|
|
IF(DI(1,1).GT.DI(2,2)) THEN
|
|
WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION '
|
|
WRITE(MSTU(11),*) L,SQRT(XMF12),SQRT(XMF22)
|
|
WRITE(MSTU(11),*) AM2
|
|
WRITE(MSTU(11),*) DI
|
|
WRITE(MSTU(11),*) RT
|
|
DI(1,1)=-RT(2,1)
|
|
DI(2,2)=RT(1,2)
|
|
DI(1,2)=-RT(2,2)
|
|
DI(2,1)=RT(1,1)
|
|
DO 160 I=1,2
|
|
DO 150 J=1,2
|
|
RT(I,J)=DI(I,J)
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
GOTO 100
|
|
ELSEIF(ABS(DI(1,2)*DI(2,1)/DI(1,1)/DI(2,2)).GT.SMALL) THEN
|
|
WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION,'//
|
|
& ' OFF DIAGONAL ELEMENTS '
|
|
WRITE(MSTU(11),*) 'MASSES = ',L,SQRT(XMF12),SQRT(XMF22)
|
|
WRITE(MSTU(11),*) DI
|
|
WRITE(MSTU(11),*) ' ROTATION = ',RT
|
|
C...STOP
|
|
ELSEIF(DI(1,1).LT.0D0.OR.DI(2,2).LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION,'//
|
|
& ' NEGATIVE MASSES '
|
|
STOP
|
|
ENDIF
|
|
PMAS(PYCOMP(KSUSY1+IF),1)=SQRT(XMF12)
|
|
PMAS(PYCOMP(KSUSY2+IF),1)=SQRT(XMF22)
|
|
SFMIX(IF,1)=RT(1,1)
|
|
SFMIX(IF,2)=RT(1,2)
|
|
SFMIX(IF,3)=RT(2,1)
|
|
SFMIX(IF,4)=RT(2,2)
|
|
170 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYINOM
|
|
C...Finds the mass eigenstates and mixing matrices for neutralinos
|
|
C...and charginos.
|
|
|
|
SUBROUTINE PYINOM
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION XMW,XMZ
|
|
DOUBLE PRECISION AR(4,4),WR(4),ZR(4,4)
|
|
DOUBLE PRECISION ZP(4,4)
|
|
DOUBLE PRECISION DETX,XI(2,2)
|
|
DOUBLE PRECISION XXX,YYY,XMH,XML
|
|
DOUBLE PRECISION COSW,SINW
|
|
DOUBLE PRECISION XMU
|
|
DOUBLE PRECISION TERMB,TERMC,DISCR,XMH2,XML2
|
|
DOUBLE PRECISION TANB,AL,BE,COSA,COSB,SINA,SINB,XW
|
|
DOUBLE PRECISION XM1,XM2,XM3,BETA
|
|
DOUBLE PRECISION Q2,AEM,A1,A2,A3,AQ,RM1,RM2
|
|
DOUBLE PRECISION ARG,X0,X1,AX0,AX1,AT,BT
|
|
DOUBLE PRECISION Y0,Y1,AMGX0,AM1X0,AMGX1,AM1X1
|
|
DOUBLE PRECISION ARGX0,AR1X0,ARGX1,AR1X1
|
|
DOUBLE PRECISION PYALPS,PYALEM
|
|
DOUBLE PRECISION PYRNM3
|
|
INTEGER IERR,INDEX(4),I,J,K,L,IOPT,ILR,KFNCHI(4)
|
|
DATA KFNCHI/1000022,1000023,1000025,1000035/
|
|
|
|
IOPT=IMSS(2)
|
|
IF(IMSS(1).EQ.2) THEN
|
|
IOPT=1
|
|
ENDIF
|
|
C...M1, M2, AND M3 ARE INDEPENDENT
|
|
IF(IOPT.EQ.0) THEN
|
|
XM1=RMSS(1)
|
|
XM2=RMSS(2)
|
|
XM3=RMSS(3)
|
|
ELSEIF(IOPT.GE.1) THEN
|
|
Q2=PMAS(23,1)**2
|
|
AEM=PYALEM(Q2)
|
|
A2=AEM/PARU(102)
|
|
A1=AEM/(1D0-PARU(102))
|
|
XM1=RMSS(1)
|
|
XM2=RMSS(2)
|
|
IF(IMSS(1).EQ.2) XM1=RMSS(1)/RMSS(20)*A1*5D0/3D0
|
|
IF(IOPT.EQ.1) THEN
|
|
XM2=XM1*A2/A1*3D0/5D0
|
|
ELSEIF(IOPT.EQ.3) THEN
|
|
XM1=XM2*5D0/3D0*A1/A2
|
|
ENDIF
|
|
XM3=PYRNM3(XM2/A2)
|
|
IF(XM3.LE.0D0) THEN
|
|
WRITE(MSTU(11),*) ' ERROR WITH M3 = ',XM3
|
|
STOP
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...GLUINO MASS
|
|
IF(IMSS(3).EQ.1) THEN
|
|
PMAS(PYCOMP(KSUSY1+21),1)=XM3
|
|
ELSE
|
|
AQ=0D0
|
|
DO 110 I=1,4
|
|
DO 100 ILR=1,2
|
|
RM1=PMAS(PYCOMP(ILR*KSUSY1+I),1)**2/XM3**2
|
|
AQ=AQ+0.5D0*((2D0-RM1)*(RM1*LOG(RM1)-1D0)
|
|
& +(1D0-RM1)**2*LOG(ABS(1D0-RM1)))
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
DO 130 I=5,6
|
|
DO 120 ILR=1,2
|
|
RM1=PMAS(PYCOMP(ILR*KSUSY1+I),1)**2/XM3**2
|
|
RM2=PMAS(I,1)**2/XM3**2
|
|
ARG=(RM1-RM2-1D0)**2-4D0*RM2**2
|
|
IF(ARG.GE.0D0) THEN
|
|
X0=0.5D0*(1D0+RM2-RM1-SQRT(ARG))
|
|
AX0=ABS(X0)
|
|
X1=0.5D0*(1D0+RM2-RM1+SQRT(ARG))
|
|
AX1=ABS(X1)
|
|
IF(X0.EQ.1D0) THEN
|
|
AT=-1D0
|
|
BT=0.25D0
|
|
ELSEIF(X0.EQ.0D0) THEN
|
|
AT=0D0
|
|
BT=-0.25D0
|
|
ELSE
|
|
AT=0.5D0*LOG(ABS(1D0-X0))*(1D0-X0**2)+
|
|
& 0.5D0*X0**2*LOG(AX0)
|
|
BT=(-1D0-2D0*X0)/4D0
|
|
ENDIF
|
|
IF(X1.EQ.1D0) THEN
|
|
AT=-1D0+AT
|
|
BT=0.25D0+BT
|
|
ELSEIF(X1.EQ.0D0) THEN
|
|
AT=0D0+AT
|
|
BT=-0.25D0+BT
|
|
ELSE
|
|
AT=0.5D0*LOG(ABS(1D0-X1))*(1D0-X1**2)+0.5D0*
|
|
& X1**2*LOG(AX1)+AT
|
|
BT=(-1D0-2D0*X1)/4D0+BT
|
|
ENDIF
|
|
AQ=AQ+AT+BT
|
|
ELSE
|
|
X0=0.5D0*(1D0+RM2-RM1)
|
|
Y0=-0.5D0*SQRT(-ARG)
|
|
AMGX0=SQRT(X0**2+Y0**2)
|
|
AM1X0=SQRT((1D0-X0)**2+Y0**2)
|
|
ARGX0=ATAN2(-X0,-Y0)
|
|
AR1X0=ATAN2(1D0-X0,Y0)
|
|
X1=X0
|
|
Y1=-Y0
|
|
AMGX1=AMGX0
|
|
AM1X1=AM1X0
|
|
ARGX1=ATAN2(-X1,-Y1)
|
|
AR1X1=ATAN2(1D0-X1,Y1)
|
|
AT=0.5D0*LOG(AM1X0)*(1D0-X0**2+3D0*Y0**2)
|
|
& +0.5D0*(X0**2-Y0**2)*LOG(AMGX0)
|
|
BT=(-1D0-2D0*X0)/4D0+X0*Y0*( AR1X0-ARGX0 )
|
|
AT=AT+0.5D0*LOG(AM1X1)*(1D0-X1**2+3D0*Y1**2)
|
|
& +0.5D0*(X1**2-Y1**2)*LOG(AMGX1)
|
|
BT=BT+(-1D0-2D0*X1)/4D0+X1*Y1*( AR1X1-ARGX1 )
|
|
AQ=AQ+AT+BT
|
|
ENDIF
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
PMAS(PYCOMP(KSUSY1+21),1)=XM3*(1D0+PYALPS(XM3**2)/(2D0*PARU(2))*
|
|
& (15D0+AQ))
|
|
ENDIF
|
|
|
|
C...NEUTRALINO MASSES
|
|
XMZ=PMAS(23,1)
|
|
XMW=PMAS(24,1)
|
|
XMU=RMSS(4)
|
|
SINW=SQRT(PARU(102))
|
|
COSW=SQRT(1D0-PARU(102))
|
|
TANB=RMSS(5)
|
|
BETA=ATAN(TANB)
|
|
COSB=COS(BETA)
|
|
SINB=TANB*COSB
|
|
AR(1,1) = XM1
|
|
AR(2,2) = XM2
|
|
AR(3,3) = 0D0
|
|
AR(4,4) = 0D0
|
|
AR(1,2) = 0D0
|
|
AR(2,1) = 0D0
|
|
AR(1,3) = -XMZ*SINW*COSB
|
|
AR(3,1) = AR(1,3)
|
|
AR(1,4) = XMZ*SINW*SINB
|
|
AR(4,1) = AR(1,4)
|
|
AR(2,3) = XMZ*COSW*COSB
|
|
AR(3,2) = AR(2,3)
|
|
AR(2,4) = -XMZ*COSW*SINB
|
|
AR(4,2) = AR(2,4)
|
|
AR(3,4) = -XMU
|
|
AR(4,3) = -XMU
|
|
CALL PYEIG4(AR,WR,ZR)
|
|
DO 150 I=1,4
|
|
SMZ(I)=WR(I)
|
|
PMAS(PYCOMP(KFNCHI(I)),1)=ABS(SMZ(I))
|
|
DO 140 J=1,4
|
|
ZMIX(I,J)=ZR(I,J)
|
|
IF(ABS(ZMIX(I,J)).LT.1D-6) ZMIX(I,J)=0D0
|
|
140 CONTINUE
|
|
150 CONTINUE
|
|
|
|
C...CHARGINO MASSES
|
|
AR(1,1) = XM2
|
|
AR(2,2) = XMU
|
|
AR(1,2) = SQRT(2D0)*XMW*SINB
|
|
AR(2,1) = SQRT(2D0)*XMW*COSB
|
|
TERMB=AR(1,1)**2+AR(2,2)**2+AR(1,2)**2+AR(2,1)**2
|
|
TERMC=(AR(1,1)**2-AR(2,2)**2)**2+(AR(1,2)**2-AR(2,1)**2)**2
|
|
TERMC=TERMC+2D0*(AR(1,1)**2+AR(2,2)**2)*
|
|
&(AR(1,2)**2+AR(2,1)**2)+
|
|
&8D0*AR(1,1)*AR(2,2)*AR(1,2)*AR(2,1)
|
|
DISCR=TERMC
|
|
IF(DISCR.LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' PROBLEM WITH DISCR '
|
|
ELSE
|
|
DISCR=SQRT(DISCR)
|
|
ENDIF
|
|
XML2=0.5D0*(TERMB-DISCR)
|
|
XMH2=0.5D0*(TERMB+DISCR)
|
|
XML=SQRT(XML2)
|
|
XMH=SQRT(XMH2)
|
|
PMAS(PYCOMP(KSUSY1+24),1)=XML
|
|
PMAS(PYCOMP(KSUSY1+37),1)=XMH
|
|
SMW(1)=XML
|
|
SMW(2)=XMH
|
|
XXX=AR(1,1)**2+AR(2,1)**2
|
|
YYY=AR(1,1)*AR(1,2)+AR(2,2)*AR(2,1)
|
|
VMIX(2,2) = YYY/SQRT(YYY**2+(XML2-XXX)**2)
|
|
VMIX(1,1) = SIGN(VMIX(2,2),AR(1,1)*AR(2,2)-0.5D0*AR(1,2)**2)
|
|
VMIX(2,1) = -(XML2-XXX)/SQRT(YYY**2+(XML2-XXX)**2)
|
|
VMIX(1,2) = -SIGN(VMIX(2,1),AR(1,1)*AR(2,2)-0.5D0*AR(1,2)**2)
|
|
ZR(1,1) = XML
|
|
ZR(1,2) = 0D0
|
|
ZR(2,1) = 0D0
|
|
ZR(2,2) = XMH
|
|
DETX = AR(1,1)*AR(2,2)-AR(1,2)*AR(2,1)
|
|
XI(1,1) = AR(2,2)/DETX
|
|
XI(2,2) = AR(1,1)/DETX
|
|
XI(1,2) = -AR(1,2)/DETX
|
|
XI(2,1) = -AR(2,1)/DETX
|
|
DO 190 I=1,2
|
|
DO 180 J=1,2
|
|
UMIX(I,J)=0D0
|
|
DO 170 K=1,2
|
|
DO 160 L=1,2
|
|
UMIX(I,J)=UMIX(I,J)+ZR(I,K)*VMIX(K,L)*XI(L,J)
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
180 CONTINUE
|
|
190 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYRNM3
|
|
C...Calculates the running of M3, the SU(3) gluino mass parameter.
|
|
|
|
FUNCTION PYRNM3(RGUT)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PI,R
|
|
DOUBLE PRECISION TOL
|
|
EXTERNAL PYALPS
|
|
DATA TOL/0.001D0/
|
|
DATA PI,R/3.141592654D0,0.61803399D0/
|
|
|
|
C=1D0-R
|
|
|
|
BX=RGUT*PYALPS(RGUT**2)
|
|
AX=MIN(50D0,BX*0.5D0)
|
|
CX=MAX(2000D0,2D0*BX)
|
|
|
|
X0=AX
|
|
X3=CX
|
|
IF(ABS(CX-BX).GT.ABS(BX-AX))THEN
|
|
X1=BX
|
|
X2=BX+C*(CX-BX)
|
|
ELSE
|
|
X2=BX
|
|
X1=BX-C*(BX-AX)
|
|
ENDIF
|
|
AS1=PYALPS(X1**2)
|
|
F1=ABS(X1-RGUT*AS1)
|
|
AS2=PYALPS(X2**2)
|
|
F2=ABS(X2-RGUT*AS2)
|
|
100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN
|
|
IF(F2.LT.F1) THEN
|
|
X0=X1
|
|
X1=X2
|
|
X2=R*X1+C*X3
|
|
F1=F2
|
|
AS2=PYALPS(X2**2)
|
|
F2=ABS(X2-RGUT*AS2)
|
|
ELSE
|
|
X3=X2
|
|
X2=X1
|
|
X1=R*X2+C*X0
|
|
F2=F1
|
|
AS1=PYALPS(X1**2)
|
|
F1=ABS(X1-RGUT*AS1)
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
IF(F1.LT.F2) THEN
|
|
PYRNM3=X1
|
|
XMIN=X1
|
|
ELSE
|
|
PYRNM3=X2
|
|
XMIN=X2
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYEIG4
|
|
C...Finds eigenvalues and eigenvectors to a 4 * 4 matrix.
|
|
C...Specific application: mixing in neutralino sector.
|
|
|
|
SUBROUTINE PYEIG4(A,W,Z)
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Arrays: in call and local.
|
|
DIMENSION A(4,4),W(4),Z(4,4),X(4),D(4,4),E(4)
|
|
|
|
C...Coefficients of fourth-degree equation from matrix.
|
|
C...x**4 + b3 * x**3 + b2 * x**2 + b1 * x + b0 = 0.
|
|
B3=-(A(1,1)+A(2,2)+A(3,3)+A(4,4))
|
|
B2=0D0
|
|
DO 110 I=1,3
|
|
DO 100 J=I+1,4
|
|
B2=B2+A(I,I)*A(J,J)-A(I,J)*A(J,I)
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
B1=0D0
|
|
B0=0D0
|
|
DO 120 I=1,4
|
|
I1=MOD(I,4)+1
|
|
I2=MOD(I+1,4)+1
|
|
I3=MOD(I+2,4)+1
|
|
B1=B1+A(I,I)*(-A(I1,I1)*A(I2,I2)+A(I1,I2)*A(I2,I1)+
|
|
& A(I1,I3)*A(I3,I1)+A(I2,I3)*A(I3,I2))-
|
|
& A(I,I1)*A(I1,I2)*A(I2,I)-A(I,I2)*A(I2,I1)*A(I1,I)
|
|
B0=B0+(-1D0)**(I+1)*A(1,I)*(
|
|
& A(2,I1)*(A(3,I2)*A(4,I3)-A(3,I3)*A(4,I2))+
|
|
& A(2,I2)*(A(3,I3)*A(4,I1)-A(3,I1)*A(4,I3))+
|
|
& A(2,I3)*(A(3,I1)*A(4,I2)-A(3,I2)*A(4,I1)))
|
|
120 CONTINUE
|
|
|
|
C...Coefficients of third-degree equation needed for
|
|
C...separation into two second-degree equations.
|
|
C...u**3 + c2 * u**2 + c1 * u + c0 = 0.
|
|
C2=-B2
|
|
C1=B1*B3-4D0*B0
|
|
C0=-B1**2-B0*B3**2+4D0*B0*B2
|
|
CQ=C1/3D0-C2**2/9D0
|
|
CR=C1*C2/6D0-C0/2D0-C2**3/27D0
|
|
CQR=CQ**3+CR**2
|
|
|
|
C...Cases with one or three real roots.
|
|
IF(CQR.GE.0D0) THEN
|
|
S1=(CR+SQRT(CQR))**(1D0/3D0)
|
|
S2=(CR-SQRT(CQR))**(1D0/3D0)
|
|
U=S1+S2-C2/3D0
|
|
ELSE
|
|
SABS=SQRT(-CQ)
|
|
C THE=ASIN(SQRT(CQR/CQ**3))/3D0
|
|
THE=ACOS(CR/SABS**3)/3D0
|
|
SRE=SABS*COS(THE)
|
|
U=2D0*SRE-C2/3D0
|
|
ENDIF
|
|
|
|
C...Find and solve two second-degree equations.
|
|
P1=B3/2D0-SQRT(B3**2/4D0+U-B2)
|
|
P2=B3/2D0+SQRT(B3**2/4D0+U-B2)
|
|
Q1=U/2D0+SQRT(U**2/4D0-B0)
|
|
Q2=U/2D0-SQRT(U**2/4D0-B0)
|
|
X(1)=-P1/2D0+SQRT(P1**2/4D0-Q1)
|
|
X(2)=-P1/2D0-SQRT(P1**2/4D0-Q1)
|
|
X(3)=-P2/2D0+SQRT(P2**2/4D0-Q2)
|
|
X(4)=-P2/2D0-SQRT(P2**2/4D0-Q2)
|
|
|
|
C...Order eigenvalues in asceding mass.
|
|
W(1)=X(1)
|
|
DO 150 I1=2,4
|
|
DO 130 I2=I1-1,1,-1
|
|
IF(ABS(X(I1)).GE.ABS(W(I2))) GOTO 140
|
|
W(I2+1)=W(I2)
|
|
130 CONTINUE
|
|
140 W(I2+1)=X(I1)
|
|
150 CONTINUE
|
|
|
|
C...Find equation system for eigenvectors.
|
|
DO 250 I=1,4
|
|
DO 170 J1=1,4
|
|
D(J1,J1)=A(J1,J1)-W(I)
|
|
DO 160 J2=J1+1,4
|
|
D(J1,J2)=A(J1,J2)
|
|
D(J2,J1)=A(J2,J1)
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
|
|
C...Find largest element in matrix.
|
|
DAMAX=0D0
|
|
DO 190 J1=1,4
|
|
DO 180 J2=1,4
|
|
IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 180
|
|
JA=J1
|
|
JB=J2
|
|
DAMAX=ABS(D(J1,J2))
|
|
180 CONTINUE
|
|
190 CONTINUE
|
|
|
|
C...Subtract others by multiple of row selected above.
|
|
DAMAX=0D0
|
|
DO 210 J3=JA+1,JA+3
|
|
J1=J3-4*((J3-1)/4)
|
|
RL=D(J1,JB)/D(JA,JB)
|
|
DO 200 J2=1,4
|
|
D(J1,J2)=D(J1,J2)-RL*D(JA,J2)
|
|
IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 200
|
|
JC=J1
|
|
JD=J2
|
|
DAMAX=ABS(D(J1,J2))
|
|
200 CONTINUE
|
|
210 CONTINUE
|
|
|
|
C...Do one more subtraction of a row.
|
|
DAMAX=0D0
|
|
DO 230 J3=JC+1,JC+3
|
|
J1=J3-4*((J3-1)/4)
|
|
IF(J1.EQ.JA) GOTO 230
|
|
RL=D(J1,JD)/D(JC,JD)
|
|
DO 220 J2=1,4
|
|
IF(J2.EQ.JB) GOTO 220
|
|
D(J1,J2)=D(J1,J2)-RL*D(JC,J2)
|
|
IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 220
|
|
JE=J1
|
|
DAMAX=ABS(D(J1,J2))
|
|
220 CONTINUE
|
|
230 CONTINUE
|
|
|
|
C...Construct unnormalized eigenvector.
|
|
JF1=JD+1-4*(JD/4)
|
|
JF2=JD+2-4*((JD+1)/4)
|
|
IF(JF1.EQ.JB) JF1=JD+3-4*((JD+2)/4)
|
|
IF(JF2.EQ.JB) JF2=JD+3-4*((JD+2)/4)
|
|
E(JF1)=-D(JE,JF2)
|
|
E(JF2)=D(JE,JF1)
|
|
E(JD)=-(D(JC,JF1)*E(JF1)+D(JC,JF2)*E(JF2))/D(JC,JD)
|
|
E(JB)=-(D(JA,JF1)*E(JF1)+D(JA,JF2)*E(JF2)+D(JA,JD)*E(JD))/
|
|
& D(JA,JB)
|
|
|
|
C...Normalize and fill in final array.
|
|
EA=SQRT(E(1)**2+E(2)**2+E(3)**2+E(4)**2)
|
|
SGN=(-1D0)**INT(PYR(0)+0.5D0)
|
|
DO 240 J=1,4
|
|
Z(I,J)=SGN*E(J)/EA
|
|
240 CONTINUE
|
|
250 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYHGGM
|
|
C...Determines the Higgs boson mass spectrum using several inputs.
|
|
|
|
SUBROUTINE PYHGGM(ALPHA)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
C...Commonblocks.
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
|
|
COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYMSSM/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION AT,AB,XMU,TANB,XM32,XMT2
|
|
DOUBLE PRECISION ALPHA
|
|
INTEGER I,J,IHOPT,II,JJ,IT
|
|
DOUBLE PRECISION DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD
|
|
DOUBLE PRECISION DMU,DMH,DHM,DMHCH,DSA,DCA,DTANBA
|
|
DOUBLE PRECISION DMC,DMDR,DMHP,DHMP,DAMP
|
|
DOUBLE PRECISION DSTOP1,DSTOP2,DSBOT1,DSBOT2
|
|
|
|
IHOPT=IMSS(4)
|
|
IF(IHOPT.EQ.2) THEN
|
|
ALPHA=RMSS(18)
|
|
RETURN
|
|
ENDIF
|
|
AT=RMSS(16)
|
|
AB=RMSS(15)
|
|
XMU=RMSS(4)
|
|
TANB=RMSS(5)
|
|
|
|
DMA=RMSS(19)
|
|
DTANB=TANB
|
|
DMQ=RMSS(10)
|
|
DMUR=RMSS(12)
|
|
DMDR=RMSS(11)
|
|
DMTOP=PMAS(6,1)
|
|
DMC=PMAS(PYCOMP(KSUSY1+37),1)
|
|
DAU=AT
|
|
DAD=AB
|
|
DMU=XMU
|
|
|
|
IF(IHOPT.EQ.0) THEN
|
|
CALL PYSUBH (DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD,DMU,DMH,DHM,
|
|
& DMHCH,DSA,DCA,DTANBA)
|
|
ELSEIF(IHOPT.EQ.1) THEN
|
|
CALL PYSUBH (DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD,DMU,DMH,DHM,
|
|
& DMHCH,DSA,DCA,DTANBA)
|
|
CALL PYPOLE(3,DMC,DMA,DTANB,DMQ,DMUR,DMDR,DMTOP,DAU,DAD,DMU,
|
|
& DMH,DMHP,DHM,DHMP,DAMP,DSA,DCA,
|
|
& DSTOP1,DSTOP2,DSBOT1,DSBOT2,DTANBA)
|
|
DMH=DMHP
|
|
DHM=DHMP
|
|
DMA=DAMP
|
|
ENDIF
|
|
|
|
ALPHA=ACOS(DCA)
|
|
|
|
PMAS(25,1)=DMH
|
|
PMAS(35,1)=DHM
|
|
PMAS(36,1)=DMA
|
|
PMAS(37,1)=DMHCH
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYSUBH
|
|
C...This routine computes the renormalization group improved
|
|
C...values of Higgs masses and couplings in the MSSM.
|
|
|
|
C...Program based on the work by M. Carena, J.R. Espinosa,
|
|
c...M. Quiros and C.E.M. Wagner, CERN-preprint CERN-TH/95-45
|
|
|
|
C...Input: MA,TANB = TAN(BETA),MQ,MUR,MTOP,AU,AD,MU
|
|
C...All masses in GeV units. MA is the CP-odd Higgs mass,
|
|
C...MTOP is the physical top mass, MQ and MUR are the soft
|
|
C...supersymmetry breaking mass parameters of left handed
|
|
C...and right handed stops respectively, AU and AD are the
|
|
C...stop and sbottom trilinear soft breaking terms,
|
|
C...respectively, and MU is the supersymmetric
|
|
C...Higgs mass parameter. We use the conventions from
|
|
C...the physics report of Haber and Kane: left right
|
|
C...stop mixing term proportional to (AU - MU/TANB)
|
|
C...We use as input TANB defined at the scale MTOP
|
|
|
|
C...Output: MH,HM,MHCH, SA = SIN(ALPHA), CA= COS(ALPHA), TANBA
|
|
C...where MH and HM are the lightest and heaviest CP-even
|
|
C...Higgs masses, MHCH is the charged Higgs mass and
|
|
C...ALPHA is the Higgs mixing angle
|
|
C...TANBA is the angle TANB at the CP-odd Higgs mass scale
|
|
|
|
C...Range of validity:
|
|
C...(STOP1**2 - STOP2**2)/(STOP2**2 + STOP1**2) < 0.5
|
|
C...(SBOT1**2 - SBOT2**2)/(SBOT2**2 + SBOT2**2) < 0.5
|
|
C...where STOP1, STOP2, SBOT1 and SBOT2 are the stop and
|
|
C...are the sbottom mass eigenvalues, respectively. This
|
|
C...range automatically excludes the existence of tachyons.
|
|
C...For the charged Higgs mass computation, the method is
|
|
C...valid if
|
|
C...2 * |MB * AD* TANB| < M_SUSY**2, 2 * |MTOP * AU| < M_SUSY**2
|
|
C...2 * |MB * MU * TANB| < M_SUSY**2, 2 * |MTOP * MU| < M_SUSY**2
|
|
C...where M_SUSY**2 is the average of the squared stop mass
|
|
C...eigenvalues, M_SUSY**2 = (STOP1**2 + STOP2**2)/2. The sbottom
|
|
C...masses have been assumed to be of order of the stop ones
|
|
C...M_SUSY**2 = (MQ**2 + MUR**2)*0.5 + MTOP**2
|
|
|
|
SUBROUTINE PYSUBH (XMA,TANB,XMQ,XMUR,XMTOP,AU,AD,XMU,XMH,XHM,
|
|
&XMHCH,SA,CA,TANBA)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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)
|
|
SAVE /PYDAT1/,/PYDAT2/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PYALEM,PYALPS
|
|
DOUBLE PRECISION TANB,XMQ,XMUR,XMTOP,AU,AD,XMU,XMH,XHM
|
|
DOUBLE PRECISION XMHCH,SA,CA
|
|
DOUBLE PRECISION XMA,AEM,ALP1,ALP2,ALPH3Z,V,PI
|
|
DOUBLE PRECISION Q02
|
|
DOUBLE PRECISION TANBA,TANBT,XMB,ALP3
|
|
DOUBLE PRECISION RMTOP,XMS,T,SINB,COSB
|
|
DOUBLE PRECISION XLAM1,XLAM2,XLAM3,XLAM4,XLAM5,XLAM6
|
|
DOUBLE PRECISION XLAM7,XAU,XAD,G1,G2,G3,HU,HD,HU2
|
|
DOUBLE PRECISION HD2,HU4,HD4,SINBT,COSBT
|
|
DOUBLE PRECISION TRM2,DETM2,XMH2,XHM2,XMHCH2
|
|
DOUBLE PRECISION SINALP,COSALP,AUD,PI2,XMS2,XMS4,AD2
|
|
DOUBLE PRECISION COS2BT,AU2,XMU2,XMZ,XMS3
|
|
|
|
XMZ = PMAS(23,1)
|
|
Q02=XMZ**2
|
|
AEM=PYALEM(Q02)
|
|
ALP1=AEM/(1D0-PARU(102))
|
|
ALP2=AEM/PARU(102)
|
|
ALPH3Z=PYALPS(Q02)
|
|
|
|
ALP1 = 0.0101D0
|
|
ALP2 = 0.0337D0
|
|
ALPH3Z = 0.12D0
|
|
|
|
V = 174.1D0
|
|
PI = PARU(1)
|
|
TANBA = TANB
|
|
TANBT = TANB
|
|
|
|
C...MBOTTOM(MTOP) = 3. GEV
|
|
XMB = 3D0
|
|
ALP3 = ALPH3Z/(1D0 +(11D0 - 10D0/3D0)/4D0/PI*ALPH3Z*
|
|
&LOG(XMTOP**2/XMZ**2))
|
|
|
|
C...RMTOP= RUNNING TOP QUARK MASS
|
|
RMTOP = XMTOP/(1D0+4D0*ALP3/3D0/PI)
|
|
XMS = ((XMQ**2 + XMUR**2)/2D0 + XMTOP**2)**0.5D0
|
|
T = LOG(XMS**2/XMTOP**2)
|
|
SINB = TANB/((1D0 + TANB**2)**0.5D0)
|
|
COSB = SINB/TANB
|
|
C...IF(MA.LE.XMTOP) TANBA = TANBT
|
|
IF(XMA.GT.XMTOP)
|
|
&TANBA = TANBT*(1D0-3D0/32D0/PI**2*
|
|
&(RMTOP**2/V**2/SINB**2-XMB**2/V**2/COSB**2)*
|
|
&LOG(XMA**2/XMTOP**2))
|
|
|
|
SINBT = TANBT/SQRT(1D0 + TANBT**2)
|
|
COSBT = 1D0/SQRT(1D0 + TANBT**2)
|
|
COS2BT = (TANBT**2 - 1D0)/(TANBT**2 + 1D0)
|
|
G1 = SQRT(ALP1*4D0*PI)
|
|
G2 = SQRT(ALP2*4D0*PI)
|
|
G3 = SQRT(ALP3*4D0*PI)
|
|
HU = RMTOP/V/SINBT
|
|
HD = XMB/V/COSBT
|
|
HU2=HU*HU
|
|
HD2=HD*HD
|
|
HU4=HU2*HU2
|
|
HD4=HD2*HD2
|
|
AU2=AU**2
|
|
AD2=AD**2
|
|
XMS2=XMS**2
|
|
XMS3=XMS**3
|
|
XMS4=XMS2*XMS2
|
|
XMU2=XMU*XMU
|
|
PI2=PI*PI
|
|
|
|
XAU = (2D0*AU2/XMS2)*(1D0 - AU2/12D0/XMS2)
|
|
XAD = (2D0*AD2/XMS2)*(1D0 - AD2/12D0/XMS2)
|
|
AUD = (-6D0*XMU2/XMS2 - ( XMU2- AD*AU)**2/XMS4
|
|
&+ 3D0*(AU + AD)**2/XMS2)/6D0
|
|
XLAM1 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HD2*T/8D0/PI2)
|
|
&+(3D0*HD4/8D0/PI2) * (T + XAD/2D0 + (3D0*HD2/2D0 + HU2/2D0
|
|
&- 8D0*G3**2) * (XAD*T + T**2)/16D0/PI2)
|
|
&-(3D0*HU4* XMU**4/96D0/PI2/XMS4) * (1+ (9D0*HU2 -5D0* HD2
|
|
&- 16D0*G3**2) *T/16D0/PI2)
|
|
XLAM2 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HU2*T/8D0/PI2)
|
|
&+(3D0*HU4/8D0/PI2) * (T + XAU/2D0 + (3D0*HU2/2D0 + HD2/2D0
|
|
&- 8D0*G3**2) * (XAU*T + T**2)/16D0/PI2)
|
|
&-(3D0*HD4* XMU**4/96D0/PI2/XMS4) * (1+ (9D0*HD2 -5D0* HU2
|
|
&- 16D0*G3**2) *T/16D0/PI2)
|
|
XLAM3 = ((G2**2 - G1**2)/4D0)*(1D0-3D0*
|
|
&(HU2 + HD2)*T/16D0/PI2)
|
|
&+(6D0*HU2*HD2/16D0/PI2) * (T + AUD/2D0 + (HU2 + HD2
|
|
&- 8D0*G3**2) * (AUD*T + T**2)/16D0/PI2)
|
|
&+(3D0*HU4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AU2/
|
|
&XMS4)* (1D0+ (6D0*HU2 -2D0* HD2/2D0
|
|
&- 16D0*G3**2) *T/16D0/PI2)
|
|
&+(3D0*HD4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AD2/
|
|
&XMS4)*(1D0+ (6D0*HD2 -2D0* HU2
|
|
&- 16D0*G3**2) *T/16D0/PI2)
|
|
XLAM4 = (- G2**2/2D0)*(1D0-3D0*(HU2 + HD2)*T/16D0/PI2)
|
|
&-(6D0*HU2*HD2/16D0/PI2) * (T + AUD/2D0 + (HU2 + HD2
|
|
&- 8D0*G3**2) * (AUD*T + T**2)/16D0/PI2)
|
|
&+(3D0*HU4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AU2/
|
|
&XMS4)*
|
|
&(1+ (6D0*HU2 -2D0* HD2
|
|
&- 16D0*G3**2) *T/16D0/PI2)
|
|
&+(3D0*HD4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AD2/
|
|
&XMS4)*
|
|
&(1+ (6D0*HD2 -2D0* HU2/2D0
|
|
&- 16D0*G3**2) *T/16D0/PI2)
|
|
XLAM5 = -(3D0*HU4* XMU2*AU2/96D0/PI2/XMS4) *
|
|
&(1- (2D0*HD2 -6D0* HU2 + 16D0*G3**2) *T/16D0/PI2)
|
|
&-(3D0*HD4* XMU2*AD2/96D0/PI2/XMS4) *
|
|
&(1- (2D0*HU2 -6D0* HD2 + 16D0*G3**2) *T/16D0/PI2)
|
|
XLAM6 = (3D0*HU4* XMU**3*AU/96D0/PI2/XMS4) *
|
|
&(1- (7D0*HD2/2D0 -15D0* HU2/2D0 + 16D0*G3**2) *T/16D0/PI2)
|
|
&+(3D0*HD4* XMU *(AD**3/XMS3 - 6D0*AD/XMS )/96D0/PI2/XMS) *
|
|
&(1- (HU2/2D0 -9D0* HD2/2D0 + 16D0*G3**2) *T/16D0/PI2)
|
|
XLAM7 = (3D0*HD4* XMU**3*AD/96D0/PI2/XMS4) *
|
|
&(1- (7D0*HU2/2D0 -15D0* HD2/2D0 + 16D0*G3**2) *T/16D0/PI2)
|
|
&+(3D0*HU4* XMU *(AU**3/XMS3 - 6D0*AU/XMS )/96D0/PI2/XMS) *
|
|
&(1- (HD2/2D0 -9D0* HU2/2D0 + 16D0*G3**2) *T/16D0/PI2)
|
|
TRM2 = XMA**2 + 2D0*V**2* (XLAM1* COSBT**2 +
|
|
&2D0* XLAM6*SINBT*COSBT
|
|
&+ XLAM5*SINBT**2 + XLAM2* SINBT**2 + 2D0* XLAM7*SINBT*COSBT
|
|
&+ XLAM5*COSBT**2)
|
|
DETM2 = 4D0*V**4*(-(SINBT*COSBT*(XLAM3 + XLAM4) +
|
|
&XLAM6*COSBT**2
|
|
&+ XLAM7* SINBT**2)**2 + (XLAM1* COSBT**2 +
|
|
&2D0* XLAM6* COSBT*SINBT
|
|
&+ XLAM5*SINBT**2)*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT
|
|
&+ XLAM5*COSBT**2)) + XMA**2*2D0*V**2 *
|
|
&((XLAM1* COSBT**2 +2D0*
|
|
&XLAM6* COSBT*SINBT + XLAM5*SINBT**2)*COSBT**2 +
|
|
&(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT + XLAM5*COSBT**2)
|
|
&*SINBT**2
|
|
&+2D0*SINBT*COSBT* (SINBT*COSBT*(XLAM3
|
|
&+ XLAM4) + XLAM6*COSBT**2
|
|
&+ XLAM7* SINBT**2))
|
|
|
|
XMH2 = (TRM2 - SQRT(TRM2**2 - 4D0* DETM2))/2D0
|
|
XHM2 = (TRM2 + SQRT(TRM2**2 - 4D0* DETM2))/2D0
|
|
XHM = SQRT(XHM2)
|
|
XMH = SQRT(XMH2)
|
|
XMHCH2 = XMA**2 + (XLAM5 - XLAM4)* V**2
|
|
XMHCH = SQRT(XMHCH2)
|
|
|
|
SINALP = SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0) -
|
|
&((2D0*V**2*(XLAM1* COSBT**2 + 2D0*
|
|
&XLAM6* COSBT*SINBT
|
|
&+ XLAM5*SINBT**2) + XMA**2*SINBT**2)
|
|
&- (2D0*V**2*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT
|
|
&+ XLAM5*COSBT**2) + XMA**2*COSBT**2)))/
|
|
&SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0))/2D0**0.5D0
|
|
|
|
COSALP = (2D0*(2D0*V**2*(SINBT*COSBT*(XLAM3 + XLAM4) +
|
|
&XLAM6*COSBT**2 + XLAM7* SINBT**2) -
|
|
&XMA**2*SINBT*COSBT))/2D0**0.5D0/
|
|
&SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0)*
|
|
&(((TRM2**2 - 4D0* DETM2)**0.5D0) -
|
|
&((2D0*V**2*(XLAM1* COSBT**2 + 2D0*
|
|
&XLAM6* COSBT*SINBT
|
|
&+ XLAM5*SINBT**2) + XMA**2*SINBT**2)
|
|
&- (2D0*V**2*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT
|
|
&+ XLAM5*COSBT**2) + XMA**2*COSBT**2))))
|
|
|
|
SA = -SINALP
|
|
CA = -COSALP
|
|
|
|
100 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPOLE
|
|
C...This subroutine computes the CP-even higgs and CP-odd pole
|
|
c...Higgs masses and mixing angles.
|
|
|
|
C...Program based on the work by M. Carena, M. Quiros
|
|
C...and C.E.M. Wagner, "Effective potential methods and
|
|
C...the Higgs mass spectrum in the MSSM", CERN-TH/95-157
|
|
|
|
C...Inputs: IHIGGS(explained below),MCHI,MA,TANB,MQ,MUR,MDR,MTOP,
|
|
C...AT,AB,MU
|
|
C...where MCHI is the largest chargino mass, MA is the running
|
|
C...CP-odd higgs mass, TANB is the value of the ratio of vacuum
|
|
C...expectaion values at the scale MTOP, MQ is the third generation
|
|
C...left handed squark mass parameter, MUR is the third generation
|
|
C...right handed stop mass parameter, MDR is the third generation
|
|
C...right handed sbottom mass parameter, MTOP is the pole top quark
|
|
C...mass; AT,AB are the soft supersymmetry breaking trilinear
|
|
C...couplings of the stop and sbottoms, respectively, and MU is the
|
|
C...supersymmetric mass parameter
|
|
|
|
C...The parameter IHIGGS=0,1,2,3 corresponds to the
|
|
c...number of Higgses whose pole mass is computed
|
|
c...by the subroutine PYVACU(...). If IHIGGS=0 only running
|
|
c...masses are given, what makes the running of the program
|
|
c...much faster and it is quite generally a good approximation
|
|
c...(for a theoretical discussion see ref. below).
|
|
c...If IHIGGS=1, only the pole
|
|
c...mass for H is computed. If IHIGGS=2, then h and H, and
|
|
c...if IHIGGS=3, then h,H,A polarizations are computed
|
|
|
|
C...Output: MH and MHP which are the lightest CP-even Higgs running
|
|
C...and pole masses, respectively; HM and HMP are the heaviest CP-even
|
|
C...Higgs running and pole masses, repectively; SA and CA are the
|
|
C...SIN(ALPHA) and COS(ALPHA) where ALPHA is the Higgs mixing angle
|
|
C...AMP is the CP-odd Higgs pole mass. STOP1,STOP2,SBOT1 and SBOT2
|
|
C...are the stop and sbottom mass eigenvalues. Finally, TANBA is
|
|
C...the value of TANB at the CP-odd Higgs mass scale
|
|
|
|
C...This subroutine makes use of CERN library subroutine
|
|
C...integration package, which makes the computation of the
|
|
C...pole Higgs masses somewhat faster. We thank P. Janot for this
|
|
C...improvement. Those who are not able to call the CERN
|
|
C...libraries, please use the subroutine SUBHPOLE2.F, which
|
|
C...although somewhat slower, gives identical results
|
|
|
|
SUBROUTINE PYPOLE(IHIGGS,XMC,XMA,TANB,XMQ,XMUR,XMDR,XMT,AT,AB,XMU,
|
|
&XMH,XMHP,HM,HMP,AMP,SA,CA,STOP1,STOP2,SBOT1,SBOT2,TANBA)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
CALL PYVACU(IHIGGS,XMC,XMA,TANB,XMQ,XMUR,XMDR,XMT,AT,AB,XMU,
|
|
&XMH,XMHP,HM,HMP,AMP,STOP1,STOP2,SBOT1,SBOT2,
|
|
&SA,CA,STOP1W,STOP2W,TANBA)
|
|
SINB = TANB/(TANB**2+1D0)**0.5D0
|
|
COSB = 1D0/(TANB**2+1D0)**0.5D0
|
|
SINBMA = SINB*CA - COSB*SA
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYVACU
|
|
C...Computes Higgs masses and mixing angles, see PYPOLE above.
|
|
|
|
SUBROUTINE PYVACU(IHIGGS,XMC,XMA,TANB,XMQ,XMUR,XMDR,
|
|
&XMT,AT,AB,XMU,XMH,XMHP,HM,HMP,AMP,STOP1,STOP2,
|
|
&SBOT1,SBOT2,SA,CA,STOP1W,STOP2W,TANBA)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local variables.
|
|
DIMENSION DELTA(2,2),COUPT(2,2),T(2,2),SSTOP2(2),
|
|
&SSBOT2(2),B(2,2),COUPB(2,2),
|
|
&HCOUPT(2,2),HCOUPB(2,2),
|
|
&ACOUPT(2,2),ACOUPB(2,2),PR(3), POLAR(3)
|
|
|
|
DELTA(1,1) = 1D0
|
|
DELTA(2,2) = 1D0
|
|
DELTA(1,2) = 0D0
|
|
DELTA(2,1) = 0D0
|
|
V = 174.1D0
|
|
XMZ=91.18D0
|
|
PI=3.14159D0
|
|
ALP3Z=0.12D0
|
|
ALP3=1D0/(1D0/ALP3Z+23D0/6D0/PI*LOG(XMT/XMZ))
|
|
|
|
RXMT = XMT/(1D0+4*ALP3/3D0/PI)
|
|
|
|
HT = RXMT /V
|
|
CALL PYRGHM(XMC,XMA,TANB,XMQ,XMUR,XMDR,XMT,AT,AB,
|
|
&XMU,XMH,HM,SA,CA,TANBA)
|
|
SINB = TANB/(TANB**2+1D0)**0.5D0
|
|
COSB = 1D0/(TANB**2+1D0)**0.5D0
|
|
COS2B = SINB**2 - COSB**2
|
|
SINBPA = SINB*CA + COSB*SA
|
|
COSBPA = COSB*CA - SINB*SA
|
|
RMBOT = 3D0
|
|
XMQ2 = XMQ**2
|
|
XMUR2 = XMUR**2
|
|
XMDR2 = XMDR**2
|
|
XMST11 = RXMT**2 + XMQ2 - 0.35D0*XMZ**2*COS2B
|
|
XMST22 = RXMT**2 + XMUR2 - 0.15D0*XMZ**2*COS2B
|
|
IF(XMST11.LT.0D0) GOTO 500
|
|
IF(XMST22.LT.0D0) GOTO 500
|
|
XMSB11 = RMBOT**2 + XMQ2 + 0.42D0*XMZ**2*COS2B
|
|
XMSB22 = RMBOT**2 + XMDR2 + 0.08D0*XMZ**2*COS2B
|
|
IF(XMSB11.LT.0D0) GOTO 500
|
|
IF(XMSB22.LT.0D0) GOTO 500
|
|
WMST11 = RXMT**2 + XMQ2
|
|
WMST22 = RXMT**2 + XMUR2
|
|
XMST12 = RXMT*(AT - XMU/TANB)
|
|
XMSB12 = RMBOT*(AB - XMU*TANB)
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C...STOP EIGENVALUES CALCULATION
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
|
|
STOP12 = 0.5D0*(XMST11+XMST22) +
|
|
&0.5D0*((XMST11+XMST22)**2 -
|
|
&4D0*(XMST11*XMST22 - XMST12**2))**0.5D0
|
|
STOP22 = 0.5D0*(XMST11+XMST22) -
|
|
&0.5D0*((XMST11+XMST22)**2 - 4D0*(XMST11*XMST22 -
|
|
&XMST12**2))**0.5D0
|
|
IF(STOP22.LT.0D0) GOTO 500
|
|
SSTOP2(1) = STOP12
|
|
SSTOP2(2) = STOP22
|
|
STOP1 = STOP12**0.5D0
|
|
STOP2 = STOP22**0.5D0
|
|
STOP1W = STOP1
|
|
STOP2W = STOP2
|
|
|
|
IF(XMST12.EQ.0D0) XST11 = 1D0
|
|
IF(XMST12.EQ.0D0) XST12 = 0D0
|
|
IF(XMST12.EQ.0D0) XST21 = 0D0
|
|
IF(XMST12.EQ.0D0) XST22 = 1D0
|
|
|
|
IF(XMST12.EQ.0D0) GOTO 110
|
|
|
|
100 XST11 = XMST12/(XMST12**2+(XMST11-STOP12)**2)**0.5D0
|
|
XST12 = - (XMST11-STOP12)/(XMST12**2+(XMST11-STOP12)**2)**0.5D0
|
|
XST21 = XMST12/(XMST12**2+(XMST11-STOP22)**2)**0.5D0
|
|
XST22 = - (XMST11-STOP22)/(XMST12**2+(XMST11-STOP22)**2)**0.5D0
|
|
|
|
110 T(1,1) = XST11
|
|
T(2,2) = XST22
|
|
T(1,2) = XST12
|
|
T(2,1) = XST21
|
|
|
|
SBOT12 = 0.5D0*(XMSB11+XMSB22) +
|
|
&0.5D0*((XMSB11+XMSB22)**2 -
|
|
&4D0*(XMSB11*XMSB22 - XMSB12**2))**0.5D0
|
|
SBOT22 = 0.5D0*(XMSB11+XMSB22) -
|
|
&0.5D0*((XMSB11+XMSB22)**2 - 4D0*(XMSB11*XMSB22 -
|
|
&XMSB12**2))**0.5D0
|
|
IF(SBOT22.LT.0D0) GOTO 500
|
|
SBOT1 = SBOT12**0.5D0
|
|
SBOT2 = SBOT22**0.5D0
|
|
SSBOT2(1) = SBOT12
|
|
SSBOT2(2) = SBOT22
|
|
|
|
IF(XMSB12.EQ.0D0) XSB11 = 1D0
|
|
IF(XMSB12.EQ.0D0) XSB12 = 0D0
|
|
IF(XMSB12.EQ.0D0) XSB21 = 0D0
|
|
IF(XMSB12.EQ.0D0) XSB22 = 1D0
|
|
|
|
IF(XMSB12.EQ.0D0) GOTO 130
|
|
|
|
120 XSB11 = XMSB12/(XMSB12**2+(XMSB11-SBOT12)**2)**0.5D0
|
|
XSB12 = - (XMSB11-SBOT12)/(XMSB12**2+(XMSB11-SBOT12)**2)**0.5D0
|
|
XSB21 = XMSB12/(XMSB12**2+(XMSB11-SBOT22)**2)**0.5D0
|
|
XSB22 = - (XMSB11-SBOT22)/(XMSB12**2+(XMSB11-SBOT22)**2)**0.5D0
|
|
|
|
130 B(1,1) = XSB11
|
|
B(2,2) = XSB22
|
|
B(1,2) = XSB12
|
|
B(2,1) = XSB21
|
|
|
|
|
|
SINT = 0.2320D0
|
|
SQR = 2D0**0.5D0
|
|
VP = 174.1D0*SQR
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C...STARTING OF LIGHT HIGGS
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
|
|
IF(IHIGGS.EQ.0) GOTO 490
|
|
|
|
DO 150 I = 1,2
|
|
DO 140 J = 1,2
|
|
COUPT(I,J) =
|
|
& SINT*XMZ**2*2D0*SQR/174.1D0/3D0*SINBPA*(DELTA(I,J) +
|
|
& (3D0 - 8D0*SINT)/4D0/SINT*T(1,I)*T(1,J))
|
|
& -RXMT**2/174.1D0**2*VP/SINB*CA*DELTA(I,J)
|
|
& -RXMT/VP/SINB*(AT*CA + XMU*SA)*(T(1,I)*T(2,J) +
|
|
& T(1,J)*T(2,I))
|
|
140 CONTINUE
|
|
150 CONTINUE
|
|
|
|
|
|
DO 170 I = 1,2
|
|
DO 160 J = 1,2
|
|
COUPB(I,J) =
|
|
& -SINT*XMZ**2*2D0*SQR/174.1D0/6D0*SINBPA*(DELTA(I,J) +
|
|
& (3D0 - 4D0*SINT)/2D0/SINT*B(1,I)*B(1,J))
|
|
& +RMBOT**2/174.1D0**2*VP/COSB*SA*DELTA(I,J)
|
|
& +RMBOT/VP/COSB*(AB*SA + XMU*CA)*(B(1,I)*B(2,J) +
|
|
& B(1,J)*B(2,I))
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
|
|
PRUN = XMH
|
|
EPS = 1D-4*PRUN
|
|
ITER = 0
|
|
180 ITER = ITER + 1
|
|
DO 230 I3 = 1,3
|
|
|
|
PR(I3)=PRUN+(I3-2)*EPS/2
|
|
P2=PR(I3)**2
|
|
POLT = 0D0
|
|
DO 200 I = 1,2
|
|
DO 190 J = 1,2
|
|
POLT = POLT + COUPT(I,J)**2*3D0*
|
|
& PYFINT(P2,SSTOP2(I),SSTOP2(J))/16D0/PI**2
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
POLB = 0D0
|
|
DO 220 I = 1,2
|
|
DO 210 J = 1,2
|
|
POLB = POLB + COUPB(I,J)**2*3D0*
|
|
& PYFINT(P2,SSBOT2(I),SSBOT2(J))/16D0/PI**2
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
RXMT2 = RXMT**2
|
|
XMT2=XMT**2
|
|
|
|
POLTT =
|
|
& 3D0*RXMT**2/8D0/PI**2/ V **2*
|
|
& CA**2/SINB**2 *
|
|
& (-2D0*XMT**2+0.5D0*P2)*
|
|
& PYFINT(P2,XMT2,XMT2)
|
|
|
|
POL = POLT + POLB + POLTT
|
|
POLAR(I3) = P2 - XMH**2 - POL
|
|
230 CONTINUE
|
|
DERIV = (POLAR(3)-POLAR(1))/EPS
|
|
DRUN = - POLAR(2)/DERIV
|
|
PRUN = PRUN + DRUN
|
|
P2 = PRUN**2
|
|
IF( ABS(DRUN) .LT. 1D-4 ) GOTO 240
|
|
GOTO 180
|
|
240 CONTINUE
|
|
|
|
XMHP = P2**0.5D0
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C...END OF LIGHT HIGGS
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
|
|
250 IF(IHIGGS.EQ.1) GOTO 490
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C... STARTING OF HEAVY HIGGS
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
|
|
DO 270 I = 1,2
|
|
DO 260 J = 1,2
|
|
HCOUPT(I,J) =
|
|
& -SINT*XMZ**2*2D0*SQR/174.1D0/3D0*COSBPA*(DELTA(I,J) +
|
|
& (3D0 - 8D0*SINT)/4D0/SINT*T(1,I)*T(1,J))
|
|
& -RXMT**2/174.1D0**2*VP/SINB*SA*DELTA(I,J)
|
|
& -RXMT/VP/SINB*(AT*SA - XMU*CA)*(T(1,I)*T(2,J) +
|
|
& T(1,J)*T(2,I))
|
|
260 CONTINUE
|
|
270 CONTINUE
|
|
|
|
DO 290 I = 1,2
|
|
DO 280 J = 1,2
|
|
HCOUPB(I,J) =
|
|
& SINT*XMZ**2*2D0*SQR/174.1D0/6D0*COSBPA*(DELTA(I,J) +
|
|
& (3D0 - 4D0*SINT)/2D0/SINT*B(1,I)*B(1,J))
|
|
& -RMBOT**2/174.1D0**2*VP/COSB*CA*DELTA(I,J)
|
|
& -RMBOT/VP/COSB*(AB*CA - XMU*SA)*(B(1,I)*B(2,J) +
|
|
& B(1,J)*B(2,I))
|
|
HCOUPB(I,J)=0D0
|
|
280 CONTINUE
|
|
290 CONTINUE
|
|
|
|
PRUN = HM
|
|
EPS = 1D-4*PRUN
|
|
ITER = 0
|
|
300 ITER = ITER + 1
|
|
DO 350 I3 = 1,3
|
|
PR(I3)=PRUN+(I3-2)*EPS/2
|
|
HP2=PR(I3)**2
|
|
|
|
HPOLT = 0D0
|
|
DO 320 I = 1,2
|
|
DO 310 J = 1,2
|
|
HPOLT = HPOLT + HCOUPT(I,J)**2*3D0*
|
|
& PYFINT(HP2,SSTOP2(I),SSTOP2(J))/16D0/PI**2
|
|
310 CONTINUE
|
|
320 CONTINUE
|
|
|
|
HPOLB = 0D0
|
|
DO 340 I = 1,2
|
|
DO 330 J = 1,2
|
|
HPOLB = HPOLB + HCOUPB(I,J)**2*3D0*
|
|
& PYFINT(HP2,SSBOT2(I),SSBOT2(J))/16D0/PI**2
|
|
330 CONTINUE
|
|
340 CONTINUE
|
|
|
|
RXMT2 = RXMT**2
|
|
XMT2 = XMT**2
|
|
|
|
HPOLTT =
|
|
& 3D0*RXMT**2/8D0/PI**2/ V **2*
|
|
& SA**2/SINB**2 *
|
|
& (-2D0*XMT**2+0.5D0*HP2)*
|
|
& PYFINT(HP2,XMT2,XMT2)
|
|
|
|
HPOL = HPOLT + HPOLB + HPOLTT
|
|
POLAR(I3) =HP2-HM**2-HPOL
|
|
350 CONTINUE
|
|
DERIV = (POLAR(3)-POLAR(1))/EPS
|
|
DRUN = - POLAR(2)/DERIV
|
|
PRUN = PRUN + DRUN
|
|
HP2 = PRUN**2
|
|
IF( ABS(DRUN) .LT. 1D-4 ) GOTO 360
|
|
GOTO 300
|
|
360 CONTINUE
|
|
|
|
|
|
370 CONTINUE
|
|
HMP = HP2**0.5D0
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C... END OF HEAVY HIGGS
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
|
|
IF(IHIGGS.EQ.2) GOTO 490
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C...BEGINNING OF PSEUDOSCALAR HIGGS
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
|
|
DO 390 I = 1,2
|
|
DO 380 J = 1,2
|
|
ACOUPT(I,J) =
|
|
& -RXMT/VP/SINB*(AT*COSB + XMU*SINB)*
|
|
& (T(1,I)*T(2,J) -T(1,J)*T(2,I))
|
|
380 CONTINUE
|
|
390 CONTINUE
|
|
DO 410 I = 1,2
|
|
DO 400 J = 1,2
|
|
ACOUPB(I,J) =
|
|
& RMBOT/VP/COSB*(AB*SINB + XMU*COSB)*
|
|
& (B(1,I)*B(2,J) -B(1,J)*B(2,I))
|
|
400 CONTINUE
|
|
410 CONTINUE
|
|
|
|
PRUN = XMA
|
|
EPS = 1D-4*PRUN
|
|
ITER = 0
|
|
420 ITER = ITER + 1
|
|
DO 470 I3 = 1,3
|
|
PR(I3)=PRUN+(I3-2)*EPS/2
|
|
AP2=PR(I3)**2
|
|
APOLT = 0D0
|
|
DO 440 I = 1,2
|
|
DO 430 J = 1,2
|
|
APOLT = APOLT + ACOUPT(I,J)**2*3D0*
|
|
& PYFINT(AP2,SSTOP2(I),SSTOP2(J))/16D0/PI**2
|
|
430 CONTINUE
|
|
440 CONTINUE
|
|
APOLB = 0D0
|
|
DO 460 I = 1,2
|
|
DO 450 J = 1,2
|
|
APOLB = APOLB + ACOUPB(I,J)**2*3D0*
|
|
& PYFINT(AP2,SSBOT2(I),SSBOT2(J))/16D0/PI**2
|
|
450 CONTINUE
|
|
460 CONTINUE
|
|
RXMT2 = RXMT**2
|
|
XMT2=XMT**2
|
|
APOLTT =
|
|
& 3D0*RXMT**2/8D0/PI**2/ V **2*
|
|
& COSB**2/SINB**2 *
|
|
& (-0.5D0*AP2)*
|
|
& PYFINT(AP2,XMT2,XMT2)
|
|
APOL = APOLT + APOLB + APOLTT
|
|
POLAR(I3) = AP2 - XMA**2 -APOL
|
|
470 CONTINUE
|
|
DERIV = (POLAR(3)-POLAR(1))/EPS
|
|
DRUN = - POLAR(2)/DERIV
|
|
PRUN = PRUN + DRUN
|
|
AP2 = PRUN**2
|
|
IF( ABS(DRUN) .LT. 1D-4 ) GOTO 480
|
|
GOTO 420
|
|
480 CONTINUE
|
|
|
|
AMP = AP2**0.5D0
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C...END OF PSEUDOSCALAR HIGGS
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
|
|
IF(IHIGGS.EQ.3) GOTO 490
|
|
|
|
490 CONTINUE
|
|
RETURN
|
|
500 CONTINUE
|
|
STOP
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYRGHM
|
|
C...Auxiliary routine to PYVACU for SUSY Higgs calculations.
|
|
|
|
SUBROUTINE PYRGHM(XMC,XMA,TANB,XMQ,XMUR,XMDL,XMT,AU,AD,XMU,
|
|
&XMHP,HMP,SA,CA,TANBA)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local variables.
|
|
DIMENSION VH(2,2),XM2(2,2),XM2P(2,2)
|
|
|
|
XMZ = 91.18D0
|
|
ALP1 = 0.0101D0
|
|
ALP2 = 0.0337D0
|
|
ALP3Z = 0.12D0
|
|
V = 174.1D0
|
|
PI = 3.14159D0
|
|
TANBA = TANB
|
|
TANBT = TANB
|
|
|
|
C...MBOTTOM(XMT) = 3. GEV
|
|
XMB = 3D0
|
|
ALP3 = ALP3Z/(1D0 +(11D0 - 10D0/3D0)/4D0/PI*ALP3Z*
|
|
&LOG(XMT**2/XMZ**2))
|
|
|
|
C...RXMT= RUNNING TOP QUARK MASS
|
|
RXMT = XMT/(1D0+4D0*ALP3/3D0/PI)
|
|
TQ = LOG((XMQ**2+XMT**2)/XMT**2)
|
|
TU = LOG((XMUR**2 + XMT**2)/XMT**2)
|
|
TD = LOG((XMDL**2 + XMT**2)/XMT**2)
|
|
SINB = TANB/((1D0 + TANB**2)**0.5D0)
|
|
COSB = SINB/TANB
|
|
IF(XMA.GT.XMT)
|
|
&TANBA = TANB*(1D0-3D0/32D0/PI**2*
|
|
&(RXMT**2/V**2/SINB**2-XMB**2/V**2/COSB**2)*
|
|
&LOG(XMA**2/XMT**2))
|
|
IF(XMA.LT.XMT.OR.XMA.EQ.XMT) TANBT = TANBA
|
|
SINB = TANBT/((1D0 + TANBT**2)**0.5D0)
|
|
COSB = 1D0/((1D0 + TANBT**2)**0.5D0)
|
|
COS2B = (TANBT**2 - 1D0)/(TANBT**2 + 1D0)
|
|
G1 = (ALP1*4D0*PI)**0.5D0
|
|
G2 = (ALP2*4D0*PI)**0.5D0
|
|
G3 = (ALP3*4D0*PI)**0.5D0
|
|
HU = RXMT/V/SINB
|
|
HD = XMB/V/COSB
|
|
|
|
CALL PYGFXX(XMA,TANBA,XMQ,XMUR,XMDL,XMT,AU,AD,
|
|
&XMU,VH,STOP1,STOP2)
|
|
|
|
IF(XMQ.GT.XMUR) TP = TQ - TU
|
|
IF(XMQ.LT.XMUR.OR.XMQ.EQ.XMUR) TP = TU - TQ
|
|
IF(XMQ.GT.XMUR) TDP = TU
|
|
IF(XMQ.LT.XMUR.OR.XMQ.EQ.XMUR) TDP = TQ
|
|
IF(XMQ.GT.XMDL) TPD = TQ - TD
|
|
IF(XMQ.LT.XMDL.OR.XMQ.EQ.XMDL) TPD = TD - TQ
|
|
IF(XMQ.GT.XMDL) TDPD = TD
|
|
IF(XMQ.LT.XMDL.OR.XMQ.EQ.XMDL) TDPD = TQ
|
|
|
|
IF(XMQ.GT.XMDL) DLAM1 = 6D0/96D0/PI**2*G1**2*HD**2*TPD
|
|
IF(XMQ.LT.XMDL.OR.XMQ.EQ.XMDL) DLAM1 = 3D0/32D0/PI**2*
|
|
&HD**2*(G1**2/3D0+G2**2)*TPD
|
|
|
|
IF(XMQ.GT.XMUR) DLAM2 =12D0/96D0/PI**2*G1**2*HU**2*TP
|
|
IF(XMQ.LT.XMUR.OR.XMQ.EQ.XMUR) DLAM2 = 3D0/32D0/PI**2*
|
|
&HU**2*(-G1**2/3D0+G2**2)*TP
|
|
|
|
DLAM3 = 0D0
|
|
DLAM4 = 0D0
|
|
|
|
IF(XMQ.GT.XMDL) DLAM3 = -1D0/32D0/PI**2*G1**2*HD**2*TPD
|
|
IF(XMQ.LT.XMDL.OR.XMQ.EQ.XMDL) DLAM3 = 3D0/64D0/PI**2*HD**2*
|
|
&(G2**2-G1**2/3D0)*TPD
|
|
|
|
IF(XMQ.GT.XMUR) DLAM3 = DLAM3 -
|
|
&1D0/16D0/PI**2*G1**2*HU**2*TP
|
|
IF(XMQ.LT.XMUR.OR.XMQ.EQ.XMUR) DLAM3 = DLAM3 +
|
|
&3D0/64D0/PI**2*HU**2*(G2**2+G1**2/3D0)*TP
|
|
|
|
IF(XMQ.LT.XMUR) DLAM4 = -3D0/32D0/PI**2*G2**2*HU**2*TP
|
|
IF(XMQ.LT.XMDL) DLAM4 = DLAM4 - 3D0/32D0/PI**2*G2**2*
|
|
&HD**2*TPD
|
|
|
|
XLAM1 = ((G1**2 + G2**2)/4D0)*
|
|
&(1D0-3D0*HD**2*(TPD + TDPD)/8D0/PI**2)
|
|
&+(3D0*HD**4/16D0/PI**2) *TPD*(1D0
|
|
&+ (3D0*HD**2/2D0 + HU**2/2D0
|
|
&- 8D0*G3**2) * (TPD + 2D0*TDPD)/16D0/PI**2)
|
|
&+(3D0*HD**4/8D0/PI**2) *TDPD*(1D0 + (3D0*HD**2/2D0 + HU**2/2D0
|
|
&- 8D0*G3**2) * TDPD/16D0/PI**2) + DLAM1
|
|
XLAM2 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HU**2*
|
|
&(TP + TDP)/8D0/PI**2)
|
|
&+(3D0*HU**4/16D0/PI**2) *TP*(1D0
|
|
&+ (3D0*HU**2/2D0 + HD**2/2D0
|
|
&- 8D0*G3**2) * (TP + 2D0*TDP)/16D0/PI**2)
|
|
&+(3D0*HU**4/8D0/PI**2) *TDP*(1D0 + (3D0*HU**2/2D0 + HD**2/2D0
|
|
&- 8D0*G3**2) * TDP/16D0/PI**2) + DLAM2
|
|
XLAM3 = ((G2**2 - G1**2)/4D0)*(1D0-3D0*
|
|
&(HU**2)*(TP + TDP)/16D0/PI**2 -3D0*
|
|
&(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAM3
|
|
XLAM4 = (- G2**2/2D0)*(1D0
|
|
&-3D0*(HU**2)*(TP + TDP)/16D0/PI**2
|
|
&-3D0*(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAM4
|
|
|
|
XLAM5 = 0D0
|
|
XLAM6 = 0D0
|
|
XLAM7 = 0D0
|
|
|
|
XM2(1,1) = 2D0*V**2*(XLAM1*COSB**2+2D0*XLAM6*
|
|
&COSB*SINB + XLAM5*SINB**2) + XMA**2*SINB**2
|
|
|
|
XM2(2,2) = 2D0*V**2*(XLAM5*COSB**2+2D0*XLAM7*
|
|
&COSB*SINB + XLAM2*SINB**2) + XMA**2*COSB**2
|
|
XM2(1,2) = 2D0*V**2*(XLAM6*COSB**2+(XLAM3+XLAM4)*
|
|
&COSB*SINB + XLAM7*SINB**2) - XMA**2*SINB*COSB
|
|
|
|
XM2(2,1) = XM2(1,2)
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C...THIS IS THE CONTRIBUTION FROM LIGHT CHARGINOS/NEUTRALINOS
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
|
|
XMSSU=(0.5D0*(XMQ**2+XMUR**2)+XMT**2)**0.5D0
|
|
|
|
IF(XMC.GT.XMSSU) GOTO 100
|
|
IF(XMC.LT.XMT) XMC=XMT
|
|
|
|
TCHAR=LOG(XMSSU**2/XMC**2)
|
|
|
|
DEL12=(9D0/64D0/PI**2*G2**4+5D0/192D0/PI**2*G1**4)*TCHAR
|
|
DEL3P4=(3D0/64D0/PI**2*G2**4+7D0/192D0/PI**2*G1**4
|
|
&+4D0/32/PI**2*G1**2*G2**2)*TCHAR
|
|
|
|
DEM112=2D0*DEL12*V**2*COSB**2
|
|
DEM222=2D0*DEL12*V**2*SINB**2
|
|
DEM122=2D0*DEL3P4*V**2*SINB*COSB
|
|
|
|
XM2(1,1)=XM2(1,1)+DEM112
|
|
XM2(2,2)=XM2(2,2)+DEM222
|
|
XM2(1,2)=XM2(1,2)+DEM122
|
|
XM2(2,1)=XM2(2,1)+DEM122
|
|
|
|
100 CONTINUE
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C...END OF CHARGINOS/NEUTRALINOS
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
|
|
DO 120 I = 1,2
|
|
DO 110 J = 1,2
|
|
XM2P(I,J) = XM2(I,J) + VH(I,J)
|
|
110 CONTINUE
|
|
120 CONTINUE
|
|
|
|
TRM2P = XM2P(1,1) + XM2P(2,2)
|
|
DETM2P = XM2P(1,1)*XM2P(2,2) - XM2P(1,2)*XM2P(2,1)
|
|
|
|
XMH2P = (TRM2P - (TRM2P**2 - 4D0* DETM2P)**0.5D0)/2D0
|
|
HM2P = (TRM2P + (TRM2P**2 - 4D0* DETM2P)**0.5D0)/2D0
|
|
HMP = HM2P**0.5D0
|
|
IF(XMH2P.LT.0D0) GOTO 130
|
|
XMHP = XMH2P**0.5D0
|
|
S2ALP = 2D0*XM2P(1,2)/(TRM2P**2-4D0*DETM2P)**0.5D0
|
|
C2ALP = (XM2P(1,1)-XM2P(2,2))/(TRM2P**2-4D0*DETM2P)**0.5D0
|
|
IF(C2ALP.GT.0D0) ALP = ASIN(S2ALP)/2D0
|
|
IF(C2ALP.LT.0D0) ALP = -PI/2D0-ASIN(S2ALP)/2D0
|
|
SA = SIN(ALP)
|
|
CA = COS(ALP)
|
|
SQBMA = (SINB*CA - COSB*SA)**2
|
|
130 XIN = 1D0
|
|
140 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGFXX
|
|
C...Auxiliary routine to PYRGHM for SUSY Higgs calculations.
|
|
|
|
SUBROUTINE PYGFXX(XMA,TANB,XMQ,XMUR,XMDL,XMT,AT,AB,XMU,VH,
|
|
&STOP1,STOP2)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local variables.
|
|
DIMENSION DIAH(2),VH(2,2),VH1(2,2),VH2(2,2),
|
|
&VH3T(2,2),VH3B(2,2),
|
|
&HMIX(2,2),AL(2,2),XM2(2,2)
|
|
|
|
C...Statement function.
|
|
G(X,Y) = 2D0 - (X+Y)/(X-Y)*LOG(X/Y)
|
|
|
|
IF(DABS(XMU).LT.0.000001D0) XMU = 0.000001D0
|
|
XMQ2 = XMQ**2
|
|
XMUR2 = XMUR**2
|
|
XMDL2 = XMDL**2
|
|
TANBA = TANB
|
|
SINBA = TANBA/(TANBA**2+1D0)**0.5D0
|
|
COSBA = SINBA/TANBA
|
|
|
|
SINB = TANB/(TANB**2+1D0)**0.5D0
|
|
COSB = SINB/TANB
|
|
PI = 3.14159D0
|
|
G2 = (0.0336D0*4D0*PI)**0.5D0
|
|
G12 = (0.0101D0*4D0*PI)
|
|
G1 = G12**0.5D0
|
|
XMZ = 91.18D0
|
|
V = 174.1D0
|
|
MW = (G2**2*V**2/2D0)**0.5D0
|
|
ALP3 = 0.12D0/(1D0+23/12D0/PI*0.12D0*LOG(XMT**2/XMZ**2))
|
|
|
|
XMB = 3D0
|
|
IF(XMQ.GT.XMUR) XMST = XMQ
|
|
IF(XMUR.GT.XMQ.OR.XMUR.EQ.XMQ) XMST = XMUR
|
|
|
|
XMSUT = (XMST**2 + XMT**2)**0.5D0
|
|
|
|
IF(XMQ.GT.XMDL) XMSB = XMQ
|
|
IF(XMDL.GT.XMQ.OR.XMDL.EQ.XMQ) XMSB = XMDL
|
|
|
|
XMSUB = (XMSB**2 + XMB**2)**0.5D0
|
|
|
|
TT = LOG(XMSUT**2/XMT**2)
|
|
TB = LOG(XMSUB**2/XMT**2)
|
|
|
|
RXMT = XMT/(1D0+4D0*ALP3/3D0/PI)
|
|
HT = RXMT/(174.1D0*SINB)
|
|
HTST = RXMT/174.1D0
|
|
HB = XMB/174.1D0/COSB
|
|
G32 = ALP3*4D0*PI
|
|
BT2 = -(8D0*G32 - 9D0*HT**2/2D0 - HB**2/2D0)/(4D0*PI)**2
|
|
BB2 = -(8D0*G32 - 9D0*HB**2/2D0 - HT**2/2D0)/(4D0*PI)**2
|
|
AL2 = 3D0/8D0/PI**2*HT**2
|
|
BT2ST = -(8D0*G32 - 9D0*HTST**2/2D0)/(4D0*PI)**2
|
|
ALST = 3D0/8D0/PI**2*HTST**2
|
|
AL1 = 3D0/8D0/PI**2*HB**2
|
|
|
|
AL(1,1) = AL1
|
|
AL(1,2) = (AL2+AL1)/2D0
|
|
AL(2,1) = (AL2+AL1)/2D0
|
|
AL(2,2) = AL2
|
|
|
|
XMT4 = RXMT**4*(1D0+2D0*BT2*TT- AL2*TT)
|
|
XMT2 = SQRT(XMT4)
|
|
XMBOT4 = XMB**4*(1D0+2D0*BB2*TB - AL1*TB)
|
|
XMBOT2 = SQRT(XMBOT4)
|
|
|
|
IF(XMA.GT.XMT) THEN
|
|
VI = 174.1D0*(1D0 + 3D0/32D0/PI**2*HTST**2*
|
|
& LOG(XMT**2/XMA**2))
|
|
H1I = VI* COSBA
|
|
H2I = VI*SINBA
|
|
H1T = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(XMA**2/XMSUT**2))**0.25D0
|
|
H2T = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(XMA**2/XMSUT**2))**0.25D0
|
|
H1B = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(XMA**2/XMSUB**2))**0.25D0
|
|
H2B = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(XMA**2/XMSUB**2))**0.25D0
|
|
ELSE
|
|
VI = 174.1D0
|
|
H1I = VI*COSB
|
|
H2I = VI*SINB
|
|
H1T = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(XMT**2/XMSUT**2))**0.25D0
|
|
H2T = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(XMT**2/XMSUT**2))**0.25D0
|
|
H1B = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(XMT**2/XMSUB**2))**0.25D0
|
|
H2B = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(XMT**2/XMSUB**2))**0.25D0
|
|
ENDIF
|
|
|
|
TANBST = H2T/H1T
|
|
SINBT = TANBST/(1D0+TANBST**2)**0.5D0
|
|
COSBT = SINBT/TANBST
|
|
|
|
TANBSB = H2B/H1B
|
|
SINBB = TANBSB/(1D0+TANBSB**2)**0.5D0
|
|
COSBB = SINBB/TANBSB
|
|
|
|
STOP12 = (XMQ2 + XMUR2)*0.5D0 + XMT2
|
|
&+1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2)
|
|
&+(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) +
|
|
&XMQ2 - XMUR2)**2*0.25D0 + XMT2*(AT-XMU/TANBST)**2)**0.5D0
|
|
STOP22 = (XMQ2 + XMUR2)*0.5D0 + XMT2
|
|
&+1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2)
|
|
&- (((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) +
|
|
&XMQ2 - XMUR2)**2*0.25D0
|
|
&+ XMT2*(AT-XMU/TANBST)**2)**0.5D0
|
|
IF(STOP22.LT.0D0) GOTO 120
|
|
SBOT12 = (XMQ2 + XMDL2)*0.5D0
|
|
&- 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2)
|
|
&+ (((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) +
|
|
&XMQ2 - XMDL2)**2*0.25D0 + XMBOT2*(AB-XMU*TANBSB)**2)**0.5D0
|
|
SBOT22 = (XMQ2 + XMDL2)*0.5D0
|
|
&- 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2)
|
|
&- (((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) +
|
|
&XMQ2 - XMDL2)**2*0.25D0 + XMBOT2*(AB-XMU*TANBSB)**2)**0.5D0
|
|
IF(SBOT22.LT.0D0) GOTO 120
|
|
|
|
STOP1 = STOP12**0.5D0
|
|
STOP2 = STOP22**0.5D0
|
|
SBOT1 = SBOT12**0.5D0
|
|
SBOT2 = SBOT22**0.5D0
|
|
|
|
VH1(1,1) = 1D0/TANBST
|
|
VH1(2,1) = -1D0
|
|
VH1(1,2) = -1D0
|
|
VH1(2,2) = TANBST
|
|
VH2(1,1) = TANBST
|
|
VH2(1,2) = -1D0
|
|
VH2(2,1) = -1D0
|
|
VH2(2,2) = 1D0/TANBST
|
|
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
C...D-TERMS
|
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
|
|
STW=0.2320D0
|
|
|
|
F1T=(XMQ2-XMUR2)/(STOP12-STOP22)*(0.5D0-4D0/3D0*STW)*
|
|
&LOG(STOP1/STOP2)
|
|
&+(0.5D0-2D0/3D0*STW)*LOG(STOP1*STOP2/(XMQ2+XMT2))
|
|
&+ 2D0/3D0*STW*LOG(STOP1*STOP2/(XMUR2+XMT2))
|
|
|
|
F1B=(XMQ2-XMDL2)/(SBOT12-SBOT22)*(-0.5D0+2D0/3D0*STW)*
|
|
&LOG(SBOT1/SBOT2)
|
|
&+(-0.5D0+1D0/3D0*STW)*LOG(SBOT1*SBOT2/(XMQ2+XMBOT2))
|
|
&- 1D0/3D0*STW*LOG(SBOT1*SBOT2/(XMDL2+XMBOT2))
|
|
|
|
F2T=XMT2**0.5D0*(AT-XMU/TANBST)/(STOP12-STOP22)*
|
|
&(-0.5D0*LOG(STOP12/STOP22)
|
|
&+(4D0/3D0*STW-0.5D0)*(XMQ2-XMUR2)/(STOP12-STOP22)*
|
|
&G(STOP12,STOP22))
|
|
|
|
F2B=XMBOT2**0.5D0*(AB-XMU*TANBSB)/(SBOT12-SBOT22)*
|
|
&(0.5D0*LOG(SBOT12/SBOT22)
|
|
&+(-2D0/3D0*STW+0.5D0)*(XMQ2-XMDL2)/(SBOT12-SBOT22)*
|
|
&G(SBOT12,SBOT22))
|
|
|
|
VH3B(1,1) = XMBOT4/(COSBB**2)*(LOG(SBOT1**2*SBOT2**2/
|
|
&(XMQ2+XMBOT2)/(XMDL2+XMBOT2))
|
|
&+ 2D0*(AB*(AB-XMU*TANBSB)/(SBOT1**2-SBOT2**2))*
|
|
&LOG(SBOT1**2/SBOT2**2)) +
|
|
&XMBOT4/(COSBB**2)*(AB*(AB-XMU*TANBSB)/
|
|
&(SBOT1**2-SBOT2**2))**2*G(SBOT12,SBOT22)
|
|
|
|
VH3T(1,1) =
|
|
&XMT4/(SINBT**2)*(XMU*(-AT+XMU/TANBST)/(STOP1**2
|
|
&-STOP2**2))**2*G(STOP12,STOP22)
|
|
|
|
VH3B(1,1)=VH3B(1,1)+
|
|
&XMZ**2*(2*XMBOT2*F1B-XMBOT2**0.5D0*AB*F2B)
|
|
|
|
VH3T(1,1) = VH3T(1,1) +
|
|
&XMZ**2*(XMT2**0.5D0*XMU/TANBST*F2T)
|
|
|
|
VH3T(2,2) = XMT4/(SINBT**2)*(LOG(STOP1**2*STOP2**2/
|
|
&(XMQ2+XMT2)/(XMUR2+XMT2))
|
|
&+ 2D0*(AT*(AT-XMU/TANBST)/(STOP1**2-STOP2**2))*
|
|
&LOG(STOP1**2/STOP2**2)) +
|
|
&XMT4/(SINBT**2)*(AT*(AT-XMU/TANBST)/
|
|
&(STOP1**2-STOP2**2))**2*G(STOP12,STOP22)
|
|
|
|
VH3B(2,2) =
|
|
&XMBOT4/(COSBB**2)*(XMU*(-AB+XMU*TANBSB)/(SBOT1**2
|
|
&-SBOT2**2))**2*G(SBOT12,SBOT22)
|
|
|
|
VH3T(2,2)=VH3T(2,2)+
|
|
&XMZ**2*(-2*XMT2*F1T+XMT2**0.5D0*AT*F2T)
|
|
|
|
VH3B(2,2) = VH3B(2,2) -XMZ**2*XMBOT2**0.5D0*XMU*TANBSB*F2B
|
|
|
|
VH3T(1,2) = -
|
|
&XMT4/(SINBT**2)*XMU*(AT-XMU/TANBST)/
|
|
&(STOP1**2-STOP2**2)*(LOG(STOP1**2/STOP2**2) + AT*
|
|
&(AT - XMU/TANBST)/(STOP1**2-STOP2**2)*G(STOP12,STOP22))
|
|
|
|
VH3B(1,2) =
|
|
&- XMBOT4/(COSBB**2)*XMU*(AT-XMU*TANBSB)/
|
|
&(SBOT1**2-SBOT2**2)*(LOG(SBOT1**2/SBOT2**2) + AB*
|
|
&(AB - XMU*TANBSB)/(SBOT1**2-SBOT2**2)*G(SBOT12,SBOT22))
|
|
|
|
VH3T(1,2)=VH3T(1,2) +
|
|
&XMZ**2*(XMT2/TANBST*F1T-XMT2**0.5D0*(AT/TANBST+XMU)/2D0*F2T)
|
|
|
|
VH3B(1,2)=VH3B(1,2)
|
|
&+XMZ**2*(-XMBOT2*TANBSB*F1B+XMBOT2**0.5D0*(AB*TANBSB+XMU)/2D0*F2B)
|
|
|
|
VH3T(2,1) = VH3T(1,2)
|
|
VH3B(2,1) = VH3B(1,2)
|
|
|
|
TQ = LOG((XMQ2 + XMT2)/XMT2)
|
|
TU = LOG((XMUR2+XMT2)/XMT2)
|
|
TQD = LOG((XMQ2 + XMB**2)/XMB**2)
|
|
TD = LOG((XMDL2+XMB**2)/XMB**2)
|
|
|
|
DO 110 I = 1,2
|
|
DO 100 J = 1,2
|
|
|
|
VH(I,J) =
|
|
& 6D0/(8D0*PI**2*(H1T**2+H2T**2))
|
|
& *VH3T(I,J)*0.5D0*(1D0-AL(I,J)*TT/2D0) +
|
|
& 6D0/(8D0*PI**2*(H1B**2+H2B**2))
|
|
& *VH3B(I,J)*0.5D0*(1D0-AL(I,J)*TB/2D0)
|
|
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
GOTO 150
|
|
120 DO 140 I =1,2
|
|
DO 130 J = 1,2
|
|
VH(I,J) = -1D+15
|
|
130 CONTINUE
|
|
140 CONTINUE
|
|
|
|
150 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYFINT
|
|
C...Auxiliary routine to PYVACU for SUSY Higgs calculations.
|
|
|
|
FUNCTION PYFINT(A,B,C)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblock.
|
|
COMMON/PYINTS/XXM(20)
|
|
SAVE/PYINTS/
|
|
|
|
C...Local variables.
|
|
EXTERNAL PYFISB
|
|
|
|
XXM(1)=A
|
|
XXM(2)=B
|
|
XXM(3)=C
|
|
PYFINT = PYGAUS(PYFISB,XLO,XHI,1D-3)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYFISB
|
|
C...Auxiliary routine to PYFINT for SUSY Higgs calculations.
|
|
|
|
FUNCTION PYFISB(X)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblock.
|
|
COMMON/PYINTS/XXM(20)
|
|
SAVE/PYINTS/
|
|
|
|
PYFISB = LOG(ABS(X*XXM(2)+(1-X)*XXM(3)-X*(1-X)*XXM(1))/
|
|
&(X*(XXM(2)-XXM(3))+XXM(3)))
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYSFDC
|
|
C...Calculates decays of sfermions.
|
|
|
|
SUBROUTINE PYSFDC(KFIN,XLAM,IDLAM,IKNT)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/
|
|
|
|
C...Local variables.
|
|
INTEGER KFIN,KCIN
|
|
DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2,XMZ,
|
|
&XMZ2,AXMJ,AXMI
|
|
DOUBLE PRECISION XMI2,XMI3,XMJ2,XMA2,XMB2,XMFP
|
|
DOUBLE PRECISION PYLAMF,XL
|
|
DOUBLE PRECISION TANW,XW,AEM,C1,AS
|
|
DOUBLE PRECISION CA,CB,AL,AR,BL,BR,ALP,ARP,BLP,BRP
|
|
DOUBLE PRECISION CH1,CH2,CH3,CH4
|
|
DOUBLE PRECISION XMBOT,XMTOP
|
|
DOUBLE PRECISION XLAM(0:200)
|
|
INTEGER IDLAM(200,3)
|
|
INTEGER LKNT,IX,IC,ILR,IDU,J,IJ,I,IKNT,IFL,IFP,II
|
|
DOUBLE PRECISION SR2
|
|
DOUBLE PRECISION CBETA,SBETA,GR,GL,F12K,F21K
|
|
DOUBLE PRECISION CW
|
|
DOUBLE PRECISION BETA,ALFA,XMU,AT,AB,ATRIT,ATRIB,ATRIL
|
|
DOUBLE PRECISION COSA,SINA,TANB
|
|
DOUBLE PRECISION PYALEM,PI,PYALPS,EI,PYRNMT
|
|
DOUBLE PRECISION GHRR,GHLL,GHLR,CF,XMB,BLR
|
|
INTEGER IG,KF1,KF2,ILR2,IDP
|
|
INTEGER IGG(4),KFNCHI(4),KFCCHI(2)
|
|
DATA IGG/23,25,35,36/
|
|
DATA PI/3.141592654D0/
|
|
DATA SR2/1.4142136D0/
|
|
DATA KFNCHI/1000022,1000023,1000025,1000035/
|
|
DATA KFCCHI/1000024,1000037/
|
|
|
|
C...COUNT THE NUMBER OF DECAY MODES
|
|
LKNT=0
|
|
|
|
C...NO NU_R DECAYS
|
|
IF(KFIN.EQ.KSUSY2+12.OR.KFIN.EQ.KSUSY2+14.OR.
|
|
&KFIN.EQ.KSUSY2+16) RETURN
|
|
|
|
XMW=PMAS(24,1)
|
|
XMW2=XMW**2
|
|
XMZ=PMAS(23,1)
|
|
XMZ2=XMZ**2
|
|
XW=PARU(102)
|
|
TANW = SQRT(XW/(1D0-XW))
|
|
CW=SQRT(1D0-XW)
|
|
|
|
C...KCIN
|
|
KCIN=PYCOMP(KFIN)
|
|
C...ILR is 1 for left and 2 for right.
|
|
ILR=KFIN/KSUSY1
|
|
C...IFL is matching non-SUSY flavour.
|
|
IFL=MOD(KFIN,KSUSY1)
|
|
C...IDU is weak isospin, 1 for down and 2 for up.
|
|
IDU=2-MOD(IFL,2)
|
|
|
|
XMI=PMAS(KCIN,1)
|
|
XMI2=XMI**2
|
|
AEM=PYALEM(XMI2)
|
|
AS =PYALPS(XMI2)
|
|
C1=AEM/XW
|
|
XMI3=XMI**3
|
|
EI=KCHG(IFL,1)/3D0
|
|
|
|
XMBOT=3D0
|
|
XMTOP=PYRNMT(PMAS(6,1))
|
|
XMBOT=0D0
|
|
|
|
TANB=RMSS(5)
|
|
BETA=ATAN(TANB)
|
|
ALFA=RMSS(18)
|
|
CBETA=COS(BETA)
|
|
SBETA=TANB*CBETA
|
|
SINA=SIN(ALFA)
|
|
COSA=COS(ALFA)
|
|
XMU=-RMSS(4)
|
|
ATRIT=RMSS(16)
|
|
ATRIB=RMSS(15)
|
|
ATRIL=RMSS(17)
|
|
|
|
C...2-BODY DECAYS OF SFERMION -> GRAVITINO + FERMION
|
|
|
|
IF(IMSS(11).EQ.1) THEN
|
|
XMP=RMSS(28)
|
|
IDG=39+KSUSY1
|
|
XMGR=PMAS(PYCOMP(IDG),1)
|
|
XFAC=(XMI2/(XMP*XMGR))**2*XMI/48D0/PI
|
|
IF(IFL.EQ.5) THEN
|
|
XMF=XMBOT
|
|
ELSEIF(IFL.EQ.6) THEN
|
|
XMF=XMTOP
|
|
ELSE
|
|
XMF=PMAS(IFL,1)
|
|
ENDIF
|
|
IF(XMI.GT.XMGR+XMF) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=IDG
|
|
IDLAM(LKNT,2)=IFL
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XFAC*(1D0-XMF**2/XMI2)**4
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...2-BODY DECAYS OF SFERMION -> FERMION + GAUGE/GAUGINO
|
|
|
|
C...CHARGED DECAYS:
|
|
DO 100 IX=1,2
|
|
C...DI -> U CHI1-,CHI2-
|
|
IF(IDU.EQ.1) THEN
|
|
XMFP=PMAS(IFL+1,1)
|
|
XMF =PMAS(IFL,1)
|
|
C...UI -> D CHI1+,CHI2+
|
|
ELSE
|
|
XMFP=PMAS(IFL-1,1)
|
|
XMF =PMAS(IFL,1)
|
|
ENDIF
|
|
XMJ=SMW(IX)
|
|
AXMJ=ABS(XMJ)
|
|
IF(XMI.GE.AXMJ+XMFP) THEN
|
|
XMA2=XMJ**2
|
|
XMB2=XMFP**2
|
|
IF(IDU.EQ.2) THEN
|
|
IF(IFL.EQ.6) THEN
|
|
XMFP=XMBOT
|
|
XMF =XMTOP
|
|
ELSEIF(IFL.LT.6) THEN
|
|
XMF=0D0
|
|
XMFP=0D0
|
|
ENDIF
|
|
BL=VMIX(IX,1)
|
|
AL=-XMFP*UMIX(IX,2)/SR2/XMW/CBETA
|
|
BR=-XMF*VMIX(IX,2)/SR2/XMW/SBETA
|
|
AR=0D0
|
|
ELSE
|
|
IF(IFL.EQ.5) THEN
|
|
XMF =XMBOT
|
|
XMFP=XMTOP
|
|
ELSEIF(IFL.LT.5) THEN
|
|
XMF=0D0
|
|
XMFP=0D0
|
|
ENDIF
|
|
BL=UMIX(IX,1)
|
|
AL=-XMFP*VMIX(IX,2)/SR2/XMW/SBETA
|
|
BR=-XMF*UMIX(IX,2)/SR2/XMW/CBETA
|
|
AR=0D0
|
|
ENDIF
|
|
|
|
ALP=SFMIX(IFL,1)*AL + SFMIX(IFL,2)*AR
|
|
BLP=SFMIX(IFL,1)*BL + SFMIX(IFL,2)*BR
|
|
ARP=SFMIX(IFL,4)*AR + SFMIX(IFL,3)*AL
|
|
BRP=SFMIX(IFL,4)*BR + SFMIX(IFL,3)*BL
|
|
AL=ALP
|
|
BL=BLP
|
|
AR=ARP
|
|
BR=BRP
|
|
|
|
C...F1 -> F` CHI
|
|
IF(ILR.EQ.1) THEN
|
|
CA=AL
|
|
CB=BL
|
|
C...F2 -> F` CHI
|
|
ELSE
|
|
CA=AR
|
|
CB=BR
|
|
ENDIF
|
|
LKNT=LKNT+1
|
|
XL=PYLAMF(XMI2,XMA2,XMB2)
|
|
C...SPIN AVERAGE = 1/1 NOT 1/2....NO COLOR ENHANCEMENT
|
|
XLAM(LKNT)=2D0*C1/8D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)*
|
|
& (CA**2+CB**2)-4D0*CA*CB*XMJ*XMFP)
|
|
IDLAM(LKNT,3)=0
|
|
IF(IDU.EQ.1) THEN
|
|
IDLAM(LKNT,1)=-KFCCHI(IX)
|
|
IDLAM(LKNT,2)=IFL+1
|
|
ELSE
|
|
IDLAM(LKNT,1)=KFCCHI(IX)
|
|
IDLAM(LKNT,2)=IFL-1
|
|
ENDIF
|
|
ENDIF
|
|
100 CONTINUE
|
|
|
|
C...NEUTRAL DECAYS
|
|
DO 110 IX=1,4
|
|
C...DI -> D CHI10
|
|
XMF=PMAS(IFL,1)
|
|
XMJ=SMZ(IX)
|
|
AXMJ=ABS(XMJ)
|
|
IF(XMI.GE.AXMJ+XMF) THEN
|
|
XMA2=XMJ**2
|
|
XMB2=XMF**2
|
|
IF(IDU.EQ.1) THEN
|
|
IF(IFL.EQ.5) THEN
|
|
XMF=XMBOT
|
|
ELSEIF(IFL.LT.5) THEN
|
|
XMF=0D0
|
|
ENDIF
|
|
BL=-ZMIX(IX,2)+TANW*ZMIX(IX,1)*(2D0*EI+1)
|
|
AL=XMF*ZMIX(IX,3)/XMW/CBETA
|
|
AR=-2D0*EI*TANW*ZMIX(IX,1)
|
|
BR=AL
|
|
ELSE
|
|
IF(IFL.EQ.6) THEN
|
|
XMF=XMTOP
|
|
ELSEIF(IFL.LT.5) THEN
|
|
XMF=0D0
|
|
ENDIF
|
|
BL=ZMIX(IX,2)+TANW*ZMIX(IX,1)*(2D0*EI-1)
|
|
AL=XMF*ZMIX(IX,4)/XMW/SBETA
|
|
AR=-2D0*EI*TANW*ZMIX(IX,1)
|
|
BR=AL
|
|
ENDIF
|
|
|
|
ALP=SFMIX(IFL,1)*AL + SFMIX(IFL,2)*AR
|
|
BLP=SFMIX(IFL,1)*BL + SFMIX(IFL,2)*BR
|
|
ARP=SFMIX(IFL,4)*AR + SFMIX(IFL,3)*AL
|
|
BRP=SFMIX(IFL,4)*BR + SFMIX(IFL,3)*BL
|
|
AL=ALP
|
|
BL=BLP
|
|
AR=ARP
|
|
BR=BRP
|
|
|
|
C...F1 -> F CHI
|
|
IF(ILR.EQ.1) THEN
|
|
CA=AL
|
|
CB=BL
|
|
C...F2 -> F CHI
|
|
ELSE
|
|
CA=AR
|
|
CB=BR
|
|
ENDIF
|
|
LKNT=LKNT+1
|
|
XL=PYLAMF(XMI2,XMA2,XMB2)
|
|
C...SPIN AVERAGE = 1/1 NOT 1/2....NO COLOR ENHANCEMENT
|
|
XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)*
|
|
& (CA**2+CB**2)-4D0*CA*CB*XMJ*XMF)
|
|
IDLAM(LKNT,1)=KFNCHI(IX)
|
|
IDLAM(LKNT,2)=IFL
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
110 CONTINUE
|
|
|
|
C...2-BODY DECAYS TO SM GAUGE AND HIGGS BOSONS
|
|
C...IG=23,25,35,36
|
|
DO 120 II=1,4
|
|
IG=IGG(II)
|
|
IF(ILR.EQ.1) GOTO 120
|
|
XMB=PMAS(IG,1)
|
|
XMSF1=PMAS(PYCOMP(KFIN-KSUSY1),1)
|
|
IF(XMI.LT.XMSF1+XMB) GOTO 120
|
|
IF(IG.EQ.23) THEN
|
|
BL=-SIGN(.5D0,EI)/CW+EI*XW/CW
|
|
BR=EI*XW/CW
|
|
BLR=0D0
|
|
ELSEIF(IG.EQ.25) THEN
|
|
IF(IFL.EQ.5) THEN
|
|
XMF=XMBOT
|
|
ELSEIF(IFL.EQ.6) THEN
|
|
XMF=XMTOP
|
|
ELSEIF(IFL.LT.5) THEN
|
|
XMF=0D0
|
|
ELSE
|
|
XMF=PMAS(IFL,1)
|
|
ENDIF
|
|
IF(IDU.EQ.2) THEN
|
|
GHLL=XMZ/CW*(0.5D0-EI*XW)*(-SIN(ALFA+BETA))+
|
|
& XMF**2/XMW*COSA/SBETA
|
|
GHRR=XMZ/CW*(EI*XW)*(-SIN(ALFA+BETA))+
|
|
& XMF**2/XMW*COSA/SBETA
|
|
ELSE
|
|
GHLL=XMZ/CW*(0.5D0-EI*XW)*(-SIN(ALFA+BETA))+
|
|
& XMF**2/XMW*(-SINA)/CBETA
|
|
GHRR=XMZ/CW*(EI*XW)*(-SIN(ALFA+BETA))+
|
|
& XMF**2/XMW*(-SINA)/CBETA
|
|
ENDIF
|
|
IF(IFL.EQ.5) THEN
|
|
AT=ATRIB
|
|
ELSEIF(IFL.EQ.6) THEN
|
|
AT=ATRIT
|
|
ELSEIF(IFL.EQ.15) THEN
|
|
AT=ATRIL
|
|
ELSE
|
|
AT=0D0
|
|
ENDIF
|
|
IF(IDU.EQ.2) THEN
|
|
GHLR=XMF/2D0/XMW/SBETA*(-XMU*SINA+
|
|
& AT*COSA)
|
|
ELSE
|
|
GHLR=XMF/2D0/XMW/CBETA*(XMU*COSA-
|
|
& AT*SINA)
|
|
ENDIF
|
|
BL=GHLL
|
|
BR=GHRR
|
|
BLR=-GHLR
|
|
ELSEIF(IG.EQ.35) THEN
|
|
IF(IFL.EQ.5) THEN
|
|
XMF=XMBOT
|
|
ELSEIF(IFL.EQ.6) THEN
|
|
XMF=XMTOP
|
|
ELSEIF(IFL.LT.5) THEN
|
|
XMF=0D0
|
|
ELSE
|
|
XMF=PMAS(IFL,1)
|
|
ENDIF
|
|
IF(IDU.EQ.2) THEN
|
|
GHLL=XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)+
|
|
& XMF**2/XMW*SINA/SBETA
|
|
GHRR=XMZ/CW*(EI*XW)*COS(ALFA+BETA)+
|
|
& XMF**2/XMW*SINA/SBETA
|
|
ELSE
|
|
GHLL=XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)+
|
|
& XMF**2/XMW*COSA/CBETA
|
|
GHRR=XMZ/CW*(EI*XW)*COS(ALFA+BETA)+
|
|
& XMF**2/XMW*COSA/CBETA
|
|
ENDIF
|
|
IF(IFL.EQ.5) THEN
|
|
AT=ATRIB
|
|
ELSEIF(IFL.EQ.6) THEN
|
|
AT=ATRIT
|
|
ELSEIF(IFL.EQ.15) THEN
|
|
AT=ATRIL
|
|
ELSE
|
|
AT=0D0
|
|
ENDIF
|
|
IF(IDU.EQ.2) THEN
|
|
GHLR=XMF/2D0/XMW/SBETA*(XMU*COSA+
|
|
& AT*SINA)
|
|
ELSE
|
|
GHLR=XMF/2D0/XMW/CBETA*(XMU*SINA+
|
|
& AT*COSA)
|
|
ENDIF
|
|
BL=GHLL
|
|
BR=GHRR
|
|
BLR=GHLR
|
|
ELSEIF(IG.EQ.36) THEN
|
|
GHLL=0D0
|
|
GHRR=0D0
|
|
IF(IFL.EQ.5) THEN
|
|
XMF=XMBOT
|
|
ELSEIF(IFL.EQ.6) THEN
|
|
XMF=XMTOP
|
|
ELSEIF(IFL.LT.5) THEN
|
|
XMF=0D0
|
|
ELSE
|
|
XMF=PMAS(IFL,1)
|
|
ENDIF
|
|
IF(IFL.EQ.5) THEN
|
|
AT=ATRIB
|
|
ELSEIF(IFL.EQ.6) THEN
|
|
AT=ATRIT
|
|
ELSEIF(IFL.EQ.15) THEN
|
|
AT=ATRIL
|
|
ELSE
|
|
AT=0D0
|
|
ENDIF
|
|
IF(IDU.EQ.2) THEN
|
|
GHLR=XMF/2D0/XMW*(-XMU+AT/TANB)
|
|
ELSE
|
|
GHLR=XMF/2D0/XMW/(-XMU+AT*TANB)
|
|
ENDIF
|
|
BL=GHLL
|
|
BR=GHRR
|
|
BLR=GHLR
|
|
ENDIF
|
|
AL=SFMIX(IFL,1)*SFMIX(IFL,3)*BL+
|
|
& SFMIX(IFL,2)*SFMIX(IFL,4)*BR+
|
|
& (SFMIX(IFL,1)*SFMIX(IFL,4)+SFMIX(IFL,3)*SFMIX(IFL,2))*BLR
|
|
XL=PYLAMF(XMI2,XMSF1**2,XMB**2)
|
|
LKNT=LKNT+1
|
|
IF(IG.EQ.23) THEN
|
|
XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2
|
|
ELSE
|
|
XLAM(LKNT)=C1/4D0/XMI3*SQRT(XL)*AL**2
|
|
ENDIF
|
|
IDLAM(LKNT,3)=0
|
|
IDLAM(LKNT,1)=KFIN-KSUSY1
|
|
IDLAM(LKNT,2)=IG
|
|
120 CONTINUE
|
|
|
|
C...SF -> SF' + W
|
|
XMB=PMAS(24,1)
|
|
IF(MOD(IFL,2).EQ.0) THEN
|
|
KF1=KSUSY1+IFL-1
|
|
ELSE
|
|
KF1=KSUSY1+IFL+1
|
|
ENDIF
|
|
KF2=KF1+KSUSY1
|
|
XMSF1=PMAS(PYCOMP(KF1),1)
|
|
XMSF2=PMAS(PYCOMP(KF2),1)
|
|
IF(XMI.GT.XMB+XMSF1) THEN
|
|
IF(MOD(IFL,2).EQ.0) THEN
|
|
IF(ILR.EQ.1) THEN
|
|
AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL-1,1)
|
|
ELSE
|
|
AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL-1,1)
|
|
ENDIF
|
|
ELSE
|
|
IF(ILR.EQ.1) THEN
|
|
AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL+1,1)
|
|
ELSE
|
|
AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL+1,1)
|
|
ENDIF
|
|
ENDIF
|
|
XL=PYLAMF(XMI2,XMSF1**2,XMB**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2
|
|
IDLAM(LKNT,3)=0
|
|
IDLAM(LKNT,1)=KF1
|
|
IDLAM(LKNT,2)=SIGN(24,KCHG(IFL,1))
|
|
ENDIF
|
|
IF(XMI.GT.XMB+XMSF2) THEN
|
|
IF(MOD(IFL,2).EQ.0) THEN
|
|
IF(ILR.EQ.1) THEN
|
|
AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL-1,3)
|
|
ELSE
|
|
AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL-1,3)
|
|
ENDIF
|
|
ELSE
|
|
IF(ILR.EQ.1) THEN
|
|
AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL+1,3)
|
|
ELSE
|
|
AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL+1,3)
|
|
ENDIF
|
|
ENDIF
|
|
XL=PYLAMF(XMI2,XMSF2**2,XMB**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2
|
|
IDLAM(LKNT,3)=0
|
|
IDLAM(LKNT,1)=KF2
|
|
IDLAM(LKNT,2)=SIGN(24,KCHG(IFL,1))
|
|
ENDIF
|
|
|
|
C...SF -> SF' + HC
|
|
XMB=PMAS(37,1)
|
|
IF(MOD(IFL,2).EQ.0) THEN
|
|
KF1=KSUSY1+IFL-1
|
|
ELSE
|
|
KF1=KSUSY1+IFL+1
|
|
ENDIF
|
|
KF2=KF1+KSUSY1
|
|
XMSF1=PMAS(PYCOMP(KF1),1)
|
|
XMSF2=PMAS(PYCOMP(KF2),1)
|
|
IF(XMI.GT.XMB+XMSF1) THEN
|
|
XMF=0D0
|
|
XMFP=0D0
|
|
AT=0D0
|
|
AB=0D0
|
|
IF(MOD(IFL,2).EQ.0) THEN
|
|
C...T1-> B1 HC
|
|
IF(ILR.EQ.1) THEN
|
|
CH1=-SFMIX(IFL,1)*SFMIX(IFL-1,1)
|
|
CH2= SFMIX(IFL,2)*SFMIX(IFL-1,2)
|
|
CH3=-SFMIX(IFL,1)*SFMIX(IFL-1,2)
|
|
CH4=-SFMIX(IFL,2)*SFMIX(IFL-1,1)
|
|
C...T2-> B1 HC
|
|
ELSE
|
|
CH1= SFMIX(IFL,3)*SFMIX(IFL-1,1)
|
|
CH2=-SFMIX(IFL,4)*SFMIX(IFL-1,2)
|
|
CH3= SFMIX(IFL,3)*SFMIX(IFL-1,2)
|
|
CH4= SFMIX(IFL,4)*SFMIX(IFL-1,1)
|
|
ENDIF
|
|
IF(IFL.EQ.6) THEN
|
|
XMF=XMTOP
|
|
XMFP=XMBOT
|
|
AT=ATRIT
|
|
AB=ATRIB
|
|
ENDIF
|
|
ELSE
|
|
C...B1 -> T1 HC
|
|
IF(ILR.EQ.1) THEN
|
|
CH1=-SFMIX(IFL+1,1)*SFMIX(IFL,1)
|
|
CH2= SFMIX(IFL+1,2)*SFMIX(IFL,2)
|
|
CH3=-SFMIX(IFL+1,1)*SFMIX(IFL,2)
|
|
CH4=-SFMIX(IFL+1,2)*SFMIX(IFL,1)
|
|
C...B2-> T1 HC
|
|
ELSE
|
|
CH1= SFMIX(IFL,3)*SFMIX(IFL+1,1)
|
|
CH2=-SFMIX(IFL,4)*SFMIX(IFL+1,2)
|
|
CH3= SFMIX(IFL,4)*SFMIX(IFL+1,1)
|
|
CH4= SFMIX(IFL,3)*SFMIX(IFL+1,2)
|
|
ENDIF
|
|
IF(IFL.EQ.5) THEN
|
|
XMF=XMTOP
|
|
XMFP=XMBOT
|
|
AT=ATRIT
|
|
AB=ATRIB
|
|
ENDIF
|
|
ENDIF
|
|
XL=PYLAMF(XMI2,XMSF1**2,XMB**2)
|
|
LKNT=LKNT+1
|
|
AL=CH1*(XMW2*2D0*CBETA*SBETA-XMFP**2*TANB-XMF**2/TANB)+
|
|
& CH2*2D0*XMF*XMFP/(2D0*CBETA*SBETA)+
|
|
& CH3*XMFP*(-XMU+AB*TANB)+CH4*XMF*(-XMU+AT/TANB)
|
|
XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)/XMW2*AL**2
|
|
IDLAM(LKNT,3)=0
|
|
IDLAM(LKNT,1)=KF1
|
|
IDLAM(LKNT,2)=SIGN(37,KCHG(IFL,1))
|
|
ENDIF
|
|
IF(XMI.GT.XMB+XMSF2) THEN
|
|
XMF=0D0
|
|
XMFP=0D0
|
|
AT=0D0
|
|
AB=0D0
|
|
IF(MOD(IFL,2).EQ.0) THEN
|
|
C...T1-> B2 HC
|
|
IF(ILR.EQ.1) THEN
|
|
CH1= SFMIX(IFL-1,3)*SFMIX(IFL,1)
|
|
CH2=-SFMIX(IFL-1,4)*SFMIX(IFL,2)
|
|
CH3= SFMIX(IFL-1,4)*SFMIX(IFL,1)
|
|
CH4= SFMIX(IFL-1,3)*SFMIX(IFL,2)
|
|
C...T2-> B2 HC
|
|
ELSE
|
|
CH1= -SFMIX(IFL,3)*SFMIX(IFL-1,3)
|
|
CH2= SFMIX(IFL,4)*SFMIX(IFL-1,4)
|
|
CH3= -SFMIX(IFL,3)*SFMIX(IFL-1,4)
|
|
CH4= -SFMIX(IFL,4)*SFMIX(IFL-1,3)
|
|
ENDIF
|
|
IF(IFL.EQ.6) THEN
|
|
XMF=XMTOP
|
|
XMFP=XMBOT
|
|
AT=ATRIT
|
|
AB=ATRIB
|
|
ENDIF
|
|
ELSE
|
|
C...B1 -> T2 HC
|
|
IF(ILR.EQ.1) THEN
|
|
CH1= SFMIX(IFL+1,3)*SFMIX(IFL,1)
|
|
CH2=-SFMIX(IFL+1,4)*SFMIX(IFL,2)
|
|
CH3= SFMIX(IFL+1,3)*SFMIX(IFL,2)
|
|
CH4= SFMIX(IFL+1,4)*SFMIX(IFL,1)
|
|
C...B2-> T2 HC
|
|
ELSE
|
|
CH1= -SFMIX(IFL+1,3)*SFMIX(IFL,3)
|
|
CH2= SFMIX(IFL+1,4)*SFMIX(IFL,4)
|
|
CH3= -SFMIX(IFL+1,3)*SFMIX(IFL,4)
|
|
CH4= -SFMIX(IFL+1,4)*SFMIX(IFL,3)
|
|
ENDIF
|
|
IF(IFL.EQ.5) THEN
|
|
XMF=XMTOP
|
|
XMFP=XMBOT
|
|
AT=ATRIT
|
|
AB=ATRIB
|
|
ENDIF
|
|
ENDIF
|
|
XL=PYLAMF(XMI2,XMSF1**2,XMB**2)
|
|
LKNT=LKNT+1
|
|
AL=CH1*(XMW2*2D0*CBETA*SBETA-XMFP**2*TANB-XMF**2/TANB)+
|
|
& CH2*2D0*XMF*XMFP/(2D0*CBETA*SBETA)+
|
|
& CH3*XMFP*(-XMU+AB*TANB)+CH4*XMF*(-XMU+AT/TANB)
|
|
XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)/XMW2*AL**2
|
|
IDLAM(LKNT,3)=0
|
|
IDLAM(LKNT,1)=KF2
|
|
IDLAM(LKNT,2)=SIGN(37,KCHG(IFL,1))
|
|
ENDIF
|
|
|
|
C...2-BODY DECAYS OF SQUARK -> QUARK GLUINO
|
|
|
|
IF(IFL.LE.6) THEN
|
|
XMFP=0D0
|
|
XMF=0D0
|
|
IF(IFL.EQ.6) XMF=PMAS(6,1)
|
|
IF(IFL.EQ.5) XMF=PMAS(5,1)
|
|
XMJ=PMAS(PYCOMP(KSUSY1+21),1)
|
|
AXMJ=ABS(XMJ)
|
|
IF(XMI.GE.AXMJ+XMF) THEN
|
|
AL=-SFMIX(IFL,2)
|
|
BL=SFMIX(IFL,1)
|
|
AR=-SFMIX(IFL,4)
|
|
BR=SFMIX(IFL,3)
|
|
C...F1 -> F CHI
|
|
IF(ILR.EQ.1) THEN
|
|
CA=AL
|
|
CB=BL
|
|
C...F2 -> F CHI
|
|
ELSE
|
|
CA=AR
|
|
CB=BR
|
|
ENDIF
|
|
LKNT=LKNT+1
|
|
XMA2=XMJ**2
|
|
XMB2=XMF**2
|
|
XL=PYLAMF(XMI2,XMA2,XMB2)
|
|
XLAM(LKNT)=4D0/3D0*AS/2D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)*
|
|
& (CA**2+CB**2)-4D0*CA*CB*XMJ*XMF)
|
|
IDLAM(LKNT,1)=KSUSY1+21
|
|
IDLAM(LKNT,2)=IFL
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...IF NOTHING ELSE FOR T1, THEN T1* -> C+CHI0
|
|
IF(KFIN.EQ.KSUSY1+6.AND.PMAS(KCIN,1).GT.
|
|
&PMAS(PYCOMP(KSUSY1+22),1)+PMAS(4,1)) THEN
|
|
C...THIS IS A BACK-OF-THE-ENVELOPE ESTIMATE
|
|
C...M = 1/(16PI**2)G**3 = G*2/(4PI) G/(4PI) = C1 * G/(4PI)
|
|
C...M*M = C1**2 * G**2/(16PI**2)
|
|
C...G = 1/(8PI)P/MI**2 * M*M = C1**3/(32PI**2)*LAM/(2*MI**3)
|
|
LKNT=LKNT+1
|
|
XL=PYLAMF(XMI2,0D0,PMAS(PYCOMP(KSUSY1+22),1)**2)
|
|
XLAM(LKNT)=C1**3/64D0/PI**2/XMI3*SQRT(XL)
|
|
IF(XLAM(LKNT).EQ.0) XLAM(LKNT)=1D-3
|
|
IDLAM(LKNT,1)=KSUSY1+22
|
|
IDLAM(LKNT,2)=4
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
|
|
IKNT=LKNT
|
|
XLAM(0)=0D0
|
|
DO 130 I=1,IKNT
|
|
IF(XLAM(I).LT.0D0) XLAM(I)=0D0
|
|
XLAM(0)=XLAM(0)+XLAM(I)
|
|
130 CONTINUE
|
|
IF(XLAM(0).EQ.0D0) XLAM(0)=1D-3
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGLUI
|
|
C...Calculates gluino decay modes.
|
|
|
|
SUBROUTINE PYGLUI(KFIN,XLAM,IDLAM,IKNT)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
COMMON/PYINTS/XXM(20)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTS/
|
|
|
|
C...Local variables.
|
|
INTEGER KFIN,KCIN,KF
|
|
DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2,
|
|
&XMZ,XMZ2,AXMJ,AXMI
|
|
DOUBLE PRECISION XMI2,XMI3,XMJ2,XMA2,XMB2,XMFP
|
|
DOUBLE PRECISION C1L,C1R,D1L,D1R
|
|
DOUBLE PRECISION C2L,C2R,D2L,D2R
|
|
DOUBLE PRECISION PYLAMF,XL
|
|
DOUBLE PRECISION TANW,XW,AEM,C1,AS,S12MAX,S12MIN
|
|
DOUBLE PRECISION CA,CB,AL,AR,BL,BR
|
|
DOUBLE PRECISION ALFA,BETA
|
|
DOUBLE PRECISION SW,CW,SINB,COSB,QT,T3
|
|
DOUBLE PRECISION XLAM(0:200)
|
|
INTEGER IDLAM(200,3)
|
|
INTEGER LKNT,IX,IC,ILR,IDU,J,IJ,I,IKNT,IFL
|
|
DOUBLE PRECISION SR2
|
|
DOUBLE PRECISION GAM
|
|
DOUBLE PRECISION PYALEM,PI,PYALPS,EI
|
|
DOUBLE PRECISION PYGAUS
|
|
EXTERNAL PYGAUS,PYXXZ5,PYXXW5,PYXXZ2
|
|
DOUBLE PRECISION PREC
|
|
INTEGER KFNCHI(4),KFCCHI(2)
|
|
DATA PI/3.141592654D0/
|
|
DATA SR2/1.4142136D0/
|
|
DATA PREC/1D-2/
|
|
DATA KFNCHI/1000022,1000023,1000025,1000035/
|
|
DATA KFCCHI/1000024,1000037/
|
|
|
|
C...COUNT THE NUMBER OF DECAY MODES
|
|
LKNT=0
|
|
IF(KFIN.NE.KSUSY1+21) RETURN
|
|
KCIN=PYCOMP(KFIN)
|
|
|
|
XMW=PMAS(24,1)
|
|
XMW2=XMW**2
|
|
XMZ=PMAS(23,1)
|
|
XMZ2=XMZ**2
|
|
XW=PARU(102)
|
|
TANW = SQRT(XW/(1D0-XW))
|
|
|
|
XMI=PMAS(KCIN,1)
|
|
AXMI=ABS(XMI)
|
|
XMI2=XMI**2
|
|
AEM=PYALEM(XMI2)
|
|
AS =PYALPS(XMI2)
|
|
C1=AEM/XW
|
|
XMI3=XMI**3
|
|
BETA=ATAN(RMSS(5))
|
|
|
|
C...2-BODY DECAYS OF GLUINO -> GRAVITINO GLUON
|
|
|
|
IF(IMSS(11).EQ.1) THEN
|
|
XMP=RMSS(28)
|
|
IDG=39+KSUSY1
|
|
XMGR=PMAS(PYCOMP(IDG),1)
|
|
XFAC=(XMI2/(XMP*XMGR))**2*XMI/48D0/PI
|
|
IF(AXMI.GT.XMGR) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=IDG
|
|
IDLAM(LKNT,2)=21
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XFAC
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...2-BODY DECAYS OF GLUINO -> QUARK SQUARK
|
|
|
|
DO 110 IFL=1,6
|
|
DO 100 ILR=1,2
|
|
XMJ=PMAS(PYCOMP(ILR*KSUSY1+IFL),1)
|
|
AXMJ=ABS(XMJ)
|
|
XMF=PMAS(IFL,1)
|
|
IDU=3-(1+MOD(IFL,2))
|
|
IF(XMI.GE.AXMJ+XMF) THEN
|
|
AL=SFMIX(IFL,1)
|
|
BL=SFMIX(IFL,2)
|
|
AR=SFMIX(IFL,3)
|
|
BR=SFMIX(IFL,4)
|
|
C...F1 -> F CHI
|
|
IF(ILR.EQ.1) THEN
|
|
CA=AL
|
|
CB=BL
|
|
C...F2 -> F CHI
|
|
ELSE
|
|
CA=AR
|
|
CB=BR
|
|
ENDIF
|
|
LKNT=LKNT+1
|
|
XMA2=XMJ**2
|
|
XMB2=XMF**2
|
|
XL=PYLAMF(XMI2,XMA2,XMB2)
|
|
XLAM(LKNT)=4D0/8D0*AS/4D0/XMI3*SQRT(XL)*((XMI2+XMB2-XMA2)*
|
|
& (CA**2+CB**2)+4D0*CA*CB*XMI*XMF)
|
|
IDLAM(LKNT,1)=ILR*KSUSY1+IFL
|
|
IDLAM(LKNT,2)=-IFL
|
|
IDLAM(LKNT,3)=0
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
C...3-BODY DECAYS TO GAUGINO FERMION-FERMION
|
|
C...GLUINO -> NI Q QBAR
|
|
DO 160 IX=1,4
|
|
XMJ=SMZ(IX)
|
|
AXMJ=ABS(XMJ)
|
|
IF(XMI.GE.AXMJ) THEN
|
|
XXM(1)=0D0
|
|
XXM(2)=XMJ
|
|
XXM(3)=0D0
|
|
XXM(4)=XMI
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+1),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+1),1)
|
|
XXM(7)=1D6
|
|
XXM(8)=0D0
|
|
XXM(9)=0D0
|
|
XXM(10)=0D0
|
|
S12MIN=0D0
|
|
S12MAX=(XMI-AXMJ)**2
|
|
C...D-TYPE QUARKS
|
|
XXM(11)=0D0
|
|
XXM(12)=0D0
|
|
XXM(13)=1D0
|
|
XXM(14)=-SR2*(-0.5D0*ZMIX(IX,2)+TANW*ZMIX(IX,1)/6D0)
|
|
XXM(15)=1D0
|
|
XXM(16)=SR2*(-TANW*ZMIX(IX,1)/3D0)
|
|
IF( XXM(5).LT.AXMI .OR. XXM(6).LT.AXMI ) GOTO 120
|
|
IF(XMI.GE.AXMJ+2D0*PMAS(1,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1*AS/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-2)
|
|
IDLAM(LKNT,1)=KFNCHI(IX)
|
|
IDLAM(LKNT,2)=1
|
|
IDLAM(LKNT,3)=-1
|
|
ENDIF
|
|
IF(XMI.GE.AXMJ+2D0*PMAS(3,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFNCHI(IX)
|
|
IDLAM(LKNT,2)=3
|
|
IDLAM(LKNT,3)=-3
|
|
ENDIF
|
|
120 CONTINUE
|
|
IF( XXM(5).LT.AXMI .OR. XXM(6).LT.AXMI ) GOTO 130
|
|
IF(XMI.GE.AXMJ+2D0*PMAS(5,1)) THEN
|
|
CALL PYTBBN(IX,80,-1D0/3D0,AXMI,GAM)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=GAM
|
|
IDLAM(LKNT,1)=KFNCHI(IX)
|
|
IDLAM(LKNT,2)=5
|
|
IDLAM(LKNT,3)=-5
|
|
ENDIF
|
|
C...U-TYPE QUARKS
|
|
130 CONTINUE
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+2),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+2),1)
|
|
XXM(13)=1D0
|
|
XXM(14)=-SR2*(0.5D0*ZMIX(IX,2)+TANW*ZMIX(IX,1)/6D0)
|
|
XXM(15)=1D0
|
|
XXM(16)=SR2*(2D0*TANW*ZMIX(IX,1)/3D0)
|
|
IF( XXM(5).LT.AXMI .OR. XXM(6).LT.AXMI ) GOTO 140
|
|
IF(XMI.GE.AXMJ+2D0*PMAS(2,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1*AS/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-2)
|
|
IDLAM(LKNT,1)=KFNCHI(IX)
|
|
IDLAM(LKNT,2)=2
|
|
IDLAM(LKNT,3)=-2
|
|
ENDIF
|
|
IF(XMI.GE.AXMJ+2D0*PMAS(4,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFNCHI(IX)
|
|
IDLAM(LKNT,2)=4
|
|
IDLAM(LKNT,3)=-4
|
|
ENDIF
|
|
140 CONTINUE
|
|
C...INCLUDE THE DECAY GLUINO -> NJ + T + T~
|
|
C...IF THE DECAY GLUINO -> ST + T CANNOT OCCUR
|
|
IF(XMI.GE.PMAS(PYCOMP(KSUSY1+6),1)+PMAS(6,1)) GOTO 150
|
|
XMF=PMAS(6,1)
|
|
IF(XMI.GE.AXMJ+2D0*XMF) THEN
|
|
CALL PYTBBN(IX,80,2D0/3D0,AXMI,GAM)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=GAM
|
|
IDLAM(LKNT,1)=KFNCHI(IX)
|
|
IDLAM(LKNT,2)=6
|
|
IDLAM(LKNT,3)=-6
|
|
ENDIF
|
|
150 CONTINUE
|
|
ENDIF
|
|
160 CONTINUE
|
|
|
|
C...GLUINO -> CI Q QBAR'
|
|
DO 190 IX=1,2
|
|
XMJ=SMW(IX)
|
|
AXMJ=ABS(XMJ)
|
|
IF(XMI.GE.AXMJ) THEN
|
|
S12MIN=0D0
|
|
S12MAX=(AXMI-AXMJ)**2
|
|
XXM(1)=0D0
|
|
XXM(2)=XMJ
|
|
XXM(3)=0D0
|
|
XXM(4)=XMI
|
|
XXM(5)=0D0
|
|
XXM(6)=0D0
|
|
XXM(9)=1D6
|
|
XXM(10)=0D0
|
|
XXM(7)=UMIX(IX,1)*SR2
|
|
XXM(8)=VMIX(IX,1)*SR2
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+1),1)
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+2),1)
|
|
IF( XXM(11).LT.AXMI .OR. XXM(12).LT.AXMI ) GOTO 170
|
|
IF(XMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXW5,S12MIN,S12MAX,PREC)
|
|
IDLAM(LKNT,1)=KFCCHI(IX)
|
|
IDLAM(LKNT,2)=1
|
|
IDLAM(LKNT,3)=-2
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
|
|
ENDIF
|
|
IF(XMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(IX)
|
|
IDLAM(LKNT,2)=3
|
|
IDLAM(LKNT,3)=-4
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
|
|
ENDIF
|
|
170 CONTINUE
|
|
|
|
IF(XMI.GE.PMAS(PYCOMP(KSUSY1+5),1)+PMAS(5,1)) GOTO 180
|
|
IF(XMI.GE.PMAS(PYCOMP(KSUSY1+6),1)+PMAS(6,1)) GOTO 180
|
|
XMF=PMAS(6,1)
|
|
XMFP=PMAS(5,1)
|
|
IF(XMI.GE.AXMJ+XMF+XMFP) THEN
|
|
CALL PYTBBC(IX,80,AXMI,GAM)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=GAM
|
|
IDLAM(LKNT,1)=KFCCHI(IX)
|
|
IDLAM(LKNT,2)=5
|
|
IDLAM(LKNT,3)=-6
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
|
|
ENDIF
|
|
180 CONTINUE
|
|
ENDIF
|
|
190 CONTINUE
|
|
|
|
IKNT=LKNT
|
|
XLAM(0)=0D0
|
|
DO 200 I=1,IKNT
|
|
IF(XLAM(I).LT.0D0) XLAM(I)=0D0
|
|
XLAM(0)=XLAM(0)+XLAM(I)
|
|
200 CONTINUE
|
|
IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYTBBN
|
|
C...Calculates the three-body decay of gluinos into
|
|
C...neutralinos and third generation fermions.
|
|
|
|
SUBROUTINE PYTBBN(I,NN,E,XMGLU,GAM)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/
|
|
|
|
C...Local variables.
|
|
EXTERNAL PYSIMP,PYLAMF
|
|
INTEGER LIN,NN
|
|
DOUBLE PRECISION COSD,SIND,COSD2,SIND2,COS2D,SIN2D
|
|
DOUBLE PRECISION HL,HR,FL,FR,HL2,HR2,FL2,FR2
|
|
DOUBLE PRECISION XMS2(2),XM,XM2,XMG,XMG2,XMR,XMR2
|
|
DOUBLE PRECISION SBAR,SMIN,SMAX,XMQA,W,GRS,G(0:6),SUMME(0:100)
|
|
DOUBLE PRECISION FF,HH,HFL,HFR,HRFL,HLFR,XMQ4,XM24
|
|
DOUBLE PRECISION XLN1,XLN2,B1,B2
|
|
DOUBLE PRECISION E,XMGLU,GAM
|
|
DOUBLE PRECISION PYSIMP,PYLAMF
|
|
DOUBLE PRECISION HRB(4),HLB(4),FLB(4),FRB(4)
|
|
SAVE HRB,HLB,FLB,FRB
|
|
DOUBLE PRECISION ALPHAW,ALPHAS,GSU2
|
|
DOUBLE PRECISION HLT(4),HRT(4),FLT(4),FRT(4)
|
|
SAVE HLT,HRT,FLT,FRT
|
|
DOUBLE PRECISION AMC(2),AMN(4),AN(4,4),ZN(3),FLU(4),FRU(4),
|
|
&FLD(4),FRD(4)
|
|
SAVE AMC,AMN,AN,ZN,FLU,FRU,FLD,FRD
|
|
DOUBLE PRECISION AMBOT,AMSB(2),SINC,COSC
|
|
DOUBLE PRECISION AMTOP,AMST(2),SINA,COSA
|
|
SAVE AMSB,AMST
|
|
DOUBLE PRECISION SINW,COSW,TANW,COSW2,SINW2
|
|
DOUBLE PRECISION ROT1(4,4)
|
|
LOGICAL IFIRST
|
|
SAVE IFIRST
|
|
DATA IFIRST/.TRUE./
|
|
|
|
TANB=RMSS(5)
|
|
SINB=TANB/SQRT(1D0+TANB**2)
|
|
COSB=SINB/TANB
|
|
XW=PARU(102)
|
|
SINW=SQRT(XW)
|
|
COSW=SQRT(1D0-XW)
|
|
TANW=SINW/COSW
|
|
AMW=PMAS(24,1)
|
|
COSC=SFMIX(5,1)
|
|
SINC=SFMIX(5,3)
|
|
COSA=SFMIX(6,1)
|
|
SINA=SFMIX(6,3)
|
|
AMBOT=0D0
|
|
AMTOP=PYRNMT(PMAS(6,1))
|
|
W2=SQRT(2D0)
|
|
FAKT1=AMBOT/W2/AMW/COSB
|
|
FAKT2=AMTOP/W2/AMW/SINB
|
|
IF(IFIRST) THEN
|
|
DO 110 II=1,4
|
|
AMN(II)=SMZ(II)
|
|
DO 100 J=1,4
|
|
ROT1(II,J)=0D0
|
|
AN(II,J)=0D0
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
ROT1(1,1)=COSW
|
|
ROT1(1,2)=-SINW
|
|
ROT1(2,1)=-ROT1(1,2)
|
|
ROT1(2,2)=ROT1(1,1)
|
|
ROT1(3,3)=COSB
|
|
ROT1(3,4)=SINB
|
|
ROT1(4,3)=-ROT1(3,4)
|
|
ROT1(4,4)=ROT1(3,3)
|
|
DO 140 II=1,4
|
|
DO 130 J=1,4
|
|
DO 120 JJ=1,4
|
|
AN(II,J)=AN(II,J)+ZMIX(II,JJ)*ROT1(JJ,J)
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
140 CONTINUE
|
|
DO 150 J=1,4
|
|
ZN(1)=-FAKT2*(-SINB*AN(J,3)+COSB*AN(J,4))
|
|
ZN(2)=-2D0*W2/3D0*SINW*(TANW*AN(J,2)-AN(J,1))
|
|
ZN(3)=-2*W2/3D0*SINW*AN(J,1)-W2*(0.5D0-2D0/3D0*
|
|
& XW)*AN(J,2)/COSW
|
|
HRT(J)=ZN(1)*COSA-ZN(3)*SINA
|
|
HLT(J)=ZN(1)*COSA+ZN(2)*SINA
|
|
FLT(J)=ZN(3)*COSA+ZN(1)*SINA
|
|
FRT(J)=ZN(2)*COSA-ZN(1)*SINA
|
|
FLU(J)=ZN(3)
|
|
FRU(J)=ZN(2)
|
|
ZN(1)=-FAKT1*(COSB*AN(J,3)+SINB*AN(J,4))
|
|
ZN(2)=W2/3D0*SINW*(TANW*AN(J,2)-AN(J,1))
|
|
ZN(3)=W2/3D0*SINW*AN(J,1)+W2*(0.5D0-XW/3D0)*AN(J,2)/COSW
|
|
HRB(J)=ZN(1)*COSC-ZN(3)*SINC
|
|
HLB(J)=ZN(1)*COSC+ZN(2)*SINC
|
|
FLB(J)=ZN(3)*COSC+ZN(1)*SINC
|
|
FRB(J)=ZN(2)*COSC-ZN(1)*SINC
|
|
FLD(J)=ZN(3)
|
|
FRD(J)=ZN(2)
|
|
150 CONTINUE
|
|
AMST(1)=PMAS(PYCOMP(KSUSY1+6),1)
|
|
AMST(2)=PMAS(PYCOMP(KSUSY2+6),1)
|
|
AMSB(1)=PMAS(PYCOMP(KSUSY1+5),1)
|
|
AMSB(2)=PMAS(PYCOMP(KSUSY2+5),1)
|
|
IFIRST=.FALSE.
|
|
ENDIF
|
|
|
|
IF(NINT(3D0*E).EQ.2) THEN
|
|
HL=HLT(I)
|
|
HR=HRT(I)
|
|
FL=FLT(I)
|
|
FR=FRT(I)
|
|
COSD=SFMIX(6,1)
|
|
SIND=SFMIX(6,3)
|
|
XMS2(1)=PMAS(PYCOMP(KSUSY1+6),1)**2
|
|
XMS2(2)=PMAS(PYCOMP(KSUSY2+6),1)**2
|
|
XM=PMAS(6,1)
|
|
ELSE
|
|
HL=HLB(I)
|
|
HR=HRB(I)
|
|
FL=FLB(I)
|
|
FR=FRB(I)
|
|
COSD=SFMIX(5,1)
|
|
SIND=SFMIX(5,3)
|
|
XMS2(1)=PMAS(PYCOMP(KSUSY1+5),1)**2
|
|
XMS2(2)=PMAS(PYCOMP(KSUSY2+5),1)**2
|
|
XM=PMAS(5,1)
|
|
ENDIF
|
|
COSD2=COSD*COSD
|
|
SIND2=SIND*SIND
|
|
COS2D=COSD2-SIND2
|
|
SIN2D=SIND*COSD*2D0
|
|
HL2=HL*HL
|
|
HR2=HR*HR
|
|
FL2=FL*FL
|
|
FR2=FR*FR
|
|
FF=FL*FR
|
|
HH=HL*HR
|
|
HFL=HL*FL
|
|
HFR=HR*FR
|
|
HRFL=HR*FL
|
|
HLFR=HL*FR
|
|
XM2=XM*XM
|
|
XMG=XMGLU
|
|
XMG2=XMG*XMG
|
|
ALPHAW=PYALEM(XMG2)
|
|
ALPHAS=PYALPS(XMG2)
|
|
XMR=AMN(I)
|
|
XMR2=XMR*XMR
|
|
XMQ4=XMG*XM2*XMR
|
|
XM24=(XMG2+XM2)*(XM2+XMR2)
|
|
SMIN=4D0*XM2
|
|
SMAX=(XMG-ABS(XMR))**2
|
|
XMQA=XMG2+2D0*XM2+XMR2
|
|
DO 170 LIN=1,NN-1
|
|
SBAR=SMIN+DBLE(LIN)*(SMAX-SMIN)/DBLE(NN)
|
|
GRS=SBAR-XMQA
|
|
W=PYLAMF(XMG2,XMR2,SBAR)*(0.25D0-XM2/SBAR)
|
|
W=DSQRT(W)
|
|
XLN1=LOG(ABS((GRS/2D0+XMS2(1)-W)/(GRS/2D0+XMS2(1)+W)))
|
|
XLN2=LOG(ABS((GRS/2D0+XMS2(2)-W)/(GRS/2D0+XMS2(2)+W)))
|
|
B1=1D0/(GRS/2D0+XMS2(1)-W)-1D0/(GRS/2D0+XMS2(1)+W)
|
|
B2=1D0/(GRS/2D0+XMS2(2)-W)-1D0/(GRS/2D0+XMS2(2)+W)
|
|
G(0)=-2D0*(HL2+FL2+HR2+FR2+(HFR-HFL)*SIN2D
|
|
& +2D0*(FF*SIND2-HH*COSD2))*W
|
|
G(1)=((HL2+FL2)*(XMQA-2D0*XMS2(1)-2D0*XM*XMG*SIN2D)
|
|
& +4D0*HFL*XM*XMR)*XLN1
|
|
& +((HL2+FL2)*((XMQA-XMS2(1))*XMS2(1)-XM24
|
|
& +2D0*XM*XMG*(XM2+XMR2-XMS2(1))*SIN2D)
|
|
& -4D0*HFL*XMR*XM*(XMG2+XM2-XMS2(1))
|
|
& +8D0*HFL*XMQ4*SIN2D)*B1
|
|
G(2)=((HR2+FR2)*(XMQA-2D0*XMS2(2)+2D0*XM*XMG*SIN2D)
|
|
& +4D0*HFR*XMR*XM)*XLN2
|
|
& +((HR2+FR2)*((XMQA-XMS2(2))*XMS2(2)-XM24
|
|
& +2D0*XMG*XM*SIN2D*(XMS2(2)-XM2-XMR2))
|
|
& +4D0*HFR*XM*XMR*(XMS2(2)-XMG2-XM2)
|
|
& -8D0*HFR*XMQ4*SIN2D)*B2
|
|
G(3)=(2D0*HFL*SIN2D*(XMS2(1)*(GRS+XMS2(1))+XM2*(SBAR-XMG2-XMR2)
|
|
& +XMG2*XMR2+XM2*XM2)-2D0*XMR*XMG*(HL2*SIND2+FL2*COSD2)*SBAR
|
|
& -2D0*XMG*XM*HFL*(SBAR+XMR2-XMG2)
|
|
& +XMR*XM*(HL2+FL2)*SIN2D*(SBAR+XMG2-XMR2)
|
|
& -4D0*XMQ4*(HL2-FL2)*COS2D)/(GRS+2D0*XMS2(1))*XLN1
|
|
G(4)=4D0*COS2D*XM*XMG/(XMS2(1)-XMS2(2))*
|
|
& (((HLFR+HRFL)*(XM2+XMR2)+2D0*XM*XMR*(HH+FF))*(XLN1-XLN2)
|
|
& +(HLFR+HRFL)*(XMS2(2)*XLN2-XMS2(1)*XLN1))
|
|
G(5)=(2D0*(HH*COSD2-FF*SIND2)
|
|
& *((XMS2(2)*(XMS2(2)+GRS)+XM2*XM2+XMG2*XMR2)*XLN2
|
|
& +(XMS2(1)*(XMS2(1)+GRS)+XM2*XM2+XMG2*XMR2)*XLN1)
|
|
& +XM*((HH-FF)*SIN2D*XMG-(HRFL-HLFR)*XMR)
|
|
& *((GRS+XMS2(1)*2D0)*XLN1-(GRS+XMS2(2)*2D0)*XLN2)
|
|
& +((HRFL-HLFR)*XMR*(SIN2D*XMG*(SBAR-4D0*XM2)
|
|
& +COS2D*XM*(SBAR+XMG2-XMR2))
|
|
& +2D0*(FF*COSD2-HH*SIND2)*XM2*(SBAR-XMG2-XMR2))
|
|
& *(XLN1+XLN2))/(GRS+XMS2(1)+XMS2(2))
|
|
G(6)=(-2D0*HFR*SIN2D*(XMS2(2)*(GRS+XMS2(2))+XM2*(SBAR-XMG2-XMR2)
|
|
& +XMG2*XMR2+XM2*XM2)-2D0*XMR*XMG*(HR2*SIND2+FR2*COSD2)*SBAR
|
|
& -2D0*XMG*XM*HFR*(SBAR+XMR2-XMG2)
|
|
& -XMR*XM*(HR2+FR2)*SIN2D*(SBAR+XMG2-XMR2)
|
|
& -4D0*XMQ4*(HR2-FR2)*COS2D)/(GRS+2D0*XMS2(2))*XLN2
|
|
SUMME(LIN)=0D0
|
|
DO 160 J=0,6
|
|
SUMME(LIN)=SUMME(LIN)+G(J)
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
SUMME(0)=0D0
|
|
SUMME(NN)=0D0
|
|
GAM = ALPHAW * ALPHAS * PYSIMP(SUMME,SMIN,SMAX,NN)
|
|
&/ (16D0 * PARU(1) * PARU(102) * XMGLU**3)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYTBBC
|
|
C...Calculates the three-body decay of gluinos into
|
|
C...charginos and third generation fermions.
|
|
|
|
SUBROUTINE PYTBBC(I,NN,XMGLU,GAM)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/
|
|
|
|
C...Local variables.
|
|
EXTERNAL PYSIMP,PYLAMF
|
|
INTEGER I,NN,LIN
|
|
DOUBLE PRECISION XMG,XMG2,XMB,XMB2,XMR,XMR2
|
|
DOUBLE PRECISION XMT,XMT2,XMST(4),XMSB(4)
|
|
DOUBLE PRECISION ULR(2),VLR(2),XMQ2,XMQ4,AM,W,SBAR,SMIN,SMAX
|
|
DOUBLE PRECISION SUMME(0:100),A(4,8)
|
|
DOUBLE PRECISION COS2A,SIN2A,COS2C,SIN2C
|
|
DOUBLE PRECISION GRS,XMQ3,XMGBTR,XMGTBR,ANT1,ANT2,ANB1,ANB2
|
|
DOUBLE PRECISION XMGLU,GAM
|
|
DOUBLE PRECISION PYSIMP,PYLAMF
|
|
DOUBLE PRECISION XX1(2),XX2(2),AAA(2),BBB(2),CCC(2),
|
|
&DDD(2),EEE(2),FFF(2)
|
|
SAVE XX1,XX2,AAA,BBB,CCC,DDD,EEE,FFF
|
|
DOUBLE PRECISION ALPHAW,ALPHAS,GSU2
|
|
DOUBLE PRECISION AMC(2),AMN(4)
|
|
SAVE AMC,AMN
|
|
DOUBLE PRECISION AMBOT,AMSB(2),SINC,COSC
|
|
DOUBLE PRECISION AMTOP,AMST(2),SINA,COSA
|
|
SAVE AMSB,AMST
|
|
DOUBLE PRECISION SINW,COSW,TANW,COSW2,SINW2
|
|
LOGICAL IFIRST
|
|
SAVE IFIRST
|
|
DATA IFIRST/.TRUE./
|
|
|
|
TANB=RMSS(5)
|
|
SINB=TANB/SQRT(1D0+TANB**2)
|
|
COSB=SINB/TANB
|
|
XW=PARU(102)
|
|
SINW=SQRT(XW)
|
|
COSW=SQRT(1D0-XW)
|
|
AMW=PMAS(24,1)
|
|
COSC=SFMIX(5,1)
|
|
SINC=SFMIX(5,3)
|
|
COSA=SFMIX(6,1)
|
|
SINA=SFMIX(6,3)
|
|
AMBOT=0D0
|
|
AMTOP=PYRNMT(PMAS(6,1))
|
|
W2=SQRT(2D0)
|
|
AMW=PMAS(24,1)
|
|
FAKT1=AMBOT/W2/AMW/COSB
|
|
FAKT2=AMTOP/W2/AMW/SINB
|
|
IF(IFIRST) THEN
|
|
AMC(1)=SMW(1)
|
|
AMC(2)=SMW(2)
|
|
DO 100 JJ=1,2
|
|
CCC(JJ)=FAKT1*UMIX(JJ,2)*SINC-UMIX(JJ,1)*COSC
|
|
EEE(JJ)=FAKT2*VMIX(JJ,2)*COSC
|
|
DDD(JJ)=FAKT1*UMIX(JJ,2)*COSC+UMIX(JJ,1)*SINC
|
|
FFF(JJ)=FAKT2*VMIX(JJ,2)*SINC
|
|
XX1(JJ)=FAKT2*VMIX(JJ,2)*SINA-VMIX(JJ,1)*COSA
|
|
AAA(JJ)=FAKT1*UMIX(JJ,2)*COSA
|
|
XX2(JJ)=FAKT2*VMIX(JJ,2)*COSA+VMIX(JJ,1)*SINA
|
|
BBB(JJ)=FAKT1*UMIX(JJ,2)*SINA
|
|
100 CONTINUE
|
|
AMST(1)=PMAS(PYCOMP(KSUSY1+6),1)
|
|
AMST(2)=PMAS(PYCOMP(KSUSY2+6),1)
|
|
AMSB(1)=PMAS(PYCOMP(KSUSY1+5),1)
|
|
AMSB(2)=PMAS(PYCOMP(KSUSY2+5),1)
|
|
IFIRST=.FALSE.
|
|
ENDIF
|
|
AMTOP=PMAS(6,1)
|
|
|
|
ULR(1)=XX1(I)*XX1(I)+AAA(I)*AAA(I)
|
|
ULR(2)=XX2(I)*XX2(I)+BBB(I)*BBB(I)
|
|
VLR(1)=CCC(I)*CCC(I)+EEE(I)*EEE(I)
|
|
VLR(2)=DDD(I)*DDD(I)+FFF(I)*FFF(I)
|
|
|
|
COS2A=COSA**2-SINA**2
|
|
SIN2A=SINA*COSA*2D0
|
|
COS2C=COSC**2-SINC**2
|
|
SIN2C=SINC*COSC*2D0
|
|
|
|
XMG=XMGLU
|
|
XMT=AMTOP
|
|
XMB=0D0
|
|
XMR=AMC(I)
|
|
XMG2=XMG*XMG
|
|
ALPHAW=PYALEM(XMG2)
|
|
ALPHAS=PYALPS(XMG2)
|
|
XMT2=XMT*XMT
|
|
XMB2=XMB*XMB
|
|
XMR2=XMR*XMR
|
|
XMQ2=XMG2+XMT2+XMB2+XMR2
|
|
XMQ4=XMG*XMT*XMB*XMR
|
|
XMQ3=XMG2*XMR2+XMT2*XMB2
|
|
XMGBTR=(XMG2+XMB2)*(XMT2+XMR2)
|
|
XMGTBR=(XMG2+XMT2)*(XMB2+XMR2)
|
|
|
|
XMST(1)=AMST(1)*AMST(1)
|
|
XMST(2)=AMST(1)*AMST(1)
|
|
XMST(3)=AMST(2)*AMST(2)
|
|
XMST(4)=AMST(2)*AMST(2)
|
|
XMSB(1)=AMSB(1)*AMSB(1)
|
|
XMSB(2)=AMSB(2)*AMSB(2)
|
|
XMSB(3)=AMSB(1)*AMSB(1)
|
|
XMSB(4)=AMSB(2)*AMSB(2)
|
|
|
|
A(1,1)=-COSA*SINC*CCC(I)*AAA(I)-SINA*COSC*EEE(I)*XX1(I)
|
|
A(1,2)=XMG*XMB*(COSA*COSC*CCC(I)*AAA(I)+SINA*SINC*EEE(I)*XX1(I))
|
|
A(1,3)=-XMG*XMR*(COSA*COSC*CCC(I)*XX1(I)+SINA*SINC*EEE(I)*AAA(I))
|
|
A(1,4)=XMB*XMR*(COSA*SINC*CCC(I)*XX1(I)+SINA*COSC*EEE(I)*AAA(I))
|
|
A(1,5)=XMG*XMT*(COSA*COSC*EEE(I)*XX1(I)+SINA*SINC*CCC(I)*AAA(I))
|
|
A(1,6)=-XMT*XMB*(COSA*SINC*EEE(I)*XX1(I)+SINA*COSC*CCC(I)*AAA(I))
|
|
A(1,7)=XMT*XMR*(COSA*SINC*EEE(I)*AAA(I)+SINA*COSC*CCC(I)*XX1(I))
|
|
A(1,8)=-XMQ4*(COSA*COSC*EEE(I)*AAA(I)+SINA*SINC*CCC(I)*XX1(I))
|
|
|
|
A(2,1)=-COSA*COSC*DDD(I)*AAA(I)-SINA*SINC*FFF(I)*XX1(I)
|
|
A(2,2)=-XMG*XMB*(COSA*SINC*DDD(I)*AAA(I)+SINA*COSC*FFF(I)*XX1(I))
|
|
A(2,3)=XMG*XMR*(COSA*SINC*DDD(I)*XX1(I)+SINA*COSC*FFF(I)*AAA(I))
|
|
A(2,4)=XMB*XMR*(COSA*COSC*DDD(I)*XX1(I)+SINA*SINC*FFF(I)*AAA(I))
|
|
A(2,5)=XMG*XMT*(COSA*SINC*FFF(I)*XX1(I)+SINA*COSC*DDD(I)*AAA(I))
|
|
A(2,6)=XMT*XMB*(COSA*COSC*FFF(I)*XX1(I)+SINA*SINC*DDD(I)*AAA(I))
|
|
A(2,7)=-XMT*XMR*(COSA*COSC*FFF(I)*AAA(I)+SINA*SINC*DDD(I)*XX1(I))
|
|
A(2,8)=-XMQ4*(COSA*SINC*FFF(I)*AAA(I)+SINA*COSC*DDD(I)*XX1(I))
|
|
|
|
A(3,1)=-COSA*COSC*EEE(I)*XX2(I)-SINA*SINC*CCC(I)*BBB(I)
|
|
A(3,2)=XMG*XMB*(COSA*SINC*EEE(I)*XX2(I)+SINA*COSC*CCC(I)*BBB(I))
|
|
A(3,3)=XMG*XMR*(COSA*SINC*EEE(I)*BBB(I)+SINA*COSC*CCC(I)*XX2(I))
|
|
A(3,4)=-XMB*XMR*(COSA*COSC*EEE(I)*BBB(I)+SINA*SINC*CCC(I)*XX2(I))
|
|
A(3,5)=-XMG*XMT*(COSA*SINC*CCC(I)*BBB(I)+SINA*COSC*EEE(I)*XX2(I))
|
|
A(3,6)=XMT*XMB*(COSA*COSC*CCC(I)*BBB(I)+SINA*SINC*EEE(I)*XX2(I))
|
|
A(3,7)=XMT*XMR*(COSA*COSC*CCC(I)*XX2(I)+SINA*SINC*EEE(I)*BBB(I))
|
|
A(3,8)=-XMQ4*(COSA*SINC*CCC(I)*XX2(I)+SINA*COSC*EEE(I)*BBB(I))
|
|
|
|
A(4,1)=-COSA*SINC*FFF(I)*XX2(I)-SINA*COSC*DDD(I)*BBB(I)
|
|
A(4,2)=-XMG*XMB*(COSA*COSC*FFF(I)*XX2(I)+SINA*SINC*DDD(I)*BBB(I))
|
|
A(4,3)=-XMG*XMR*(COSA*COSC*FFF(I)*BBB(I)+SINA*SINC*DDD(I)*XX2(I))
|
|
A(4,4)=-XMB*XMR*(COSA*SINC*FFF(I)*BBB(I)+SINA*COSC*DDD(I)*XX2(I))
|
|
A(4,5)=-XMG*XMT*(COSA*COSC*DDD(I)*BBB(I)+SINA*SINC*FFF(I)*XX2(I))
|
|
A(4,6)=-XMT*XMB*(COSA*SINC*DDD(I)*BBB(I)+SINA*COSC*FFF(I)*XX2(I))
|
|
A(4,7)=-XMT*XMR*(COSA*SINC*DDD(I)*XX2(I)+SINA*COSC*FFF(I)*BBB(I))
|
|
A(4,8)=-XMQ4*(COSA*COSC*DDD(I)*XX2(I)+SINA*SINC*FFF(I)*BBB(I))
|
|
|
|
SMAX=(XMG-ABS(XMR))**2
|
|
SMIN=(XMB+XMT)**2+0.1D0
|
|
|
|
DO 120 LIN=0,NN-1
|
|
SBAR=SMIN+DBLE(LIN)*(SMAX-SMIN)/DBLE(NN)
|
|
AM=(XMG2-XMR2)*(XMT2-XMB2)/2D0/SBAR
|
|
GRS=SBAR-XMQ2
|
|
W=PYLAMF(SBAR,XMB2,XMT2)*PYLAMF(SBAR,XMG2,XMR2)
|
|
W=DSQRT(W)/2D0/SBAR
|
|
ANT1=LOG(ABS((GRS/2D0+AM+XMST(1)-W)/(GRS/2D0+AM+XMST(1)+W)))
|
|
ANT2=LOG(ABS((GRS/2D0+AM+XMST(3)-W)/(GRS/2D0+AM+XMST(3)+W)))
|
|
ANB1=LOG(ABS((GRS/2D0-AM+XMSB(1)-W)/(GRS/2D0-AM+XMSB(1)+W)))
|
|
ANB2=LOG(ABS((GRS/2D0-AM+XMSB(2)-W)/(GRS/2D0-AM+XMSB(2)+W)))
|
|
SUMME(LIN)=-ULR(1)*W+(ULR(1)*(XMQ2/2D0-XMST(1)-XMG*XMT*SIN2A)
|
|
& +2D0*XX1(I)*AAA(I)*XMR*XMB)*ANT1
|
|
& +(ULR(1)/2D0*(XMST(1)*(XMQ2-XMST(1))-XMGTBR
|
|
& -2D0*XMG*XMT*SIN2A*(XMST(1)-XMB2-XMR2))
|
|
& +2D0*XX1(I)*AAA(I)*XMR*XMB*(XMST(1)-XMG2-XMT2)
|
|
& +4D0*SIN2A*XX1(I)*AAA(I)*XMQ4)
|
|
& *(1D0/(GRS/2D0+AM+XMST(1)-W)-1D0/(GRS/2D0+AM+XMST(1)+W))
|
|
SUMME(LIN)=SUMME(LIN)-ULR(2)*W
|
|
& +(ULR(2)*(XMQ2/2D0-XMST(3)+XMG*XMT*SIN2A)
|
|
& -2D0*XX2(I)*BBB(I)*XMR*XMB)*ANT2
|
|
& +(ULR(2)/2D0*(XMST(3)*(XMQ2-XMST(3))-XMGTBR
|
|
& +2D0*XMG*XMT*SIN2A*(XMST(3)-XMB2-XMR2))
|
|
& -2D0*XX2(I)*BBB(I)*XMR*XMB*(XMST(3)-XMG2-XMT2)
|
|
& +4D0*SIN2A*XX2(I)*BBB(I)*XMQ4)
|
|
& *(1D0/(GRS/2D0+AM+XMST(3)-W)-1D0/(GRS/2D0+AM+XMST(3)+W))
|
|
SUMME(LIN)=SUMME(LIN)-VLR(1)*W
|
|
& +(VLR(1)*(XMQ2/2D0-XMSB(1)-XMG*XMB*SIN2C)
|
|
& +2D0*CCC(I)*EEE(I)*XMR*XMT)*ANB1
|
|
& +(VLR(1)/2D0*(XMSB(1)*(XMQ2-XMSB(1))-XMGBTR
|
|
& -2D0*XMG*XMB*SIN2C*(XMSB(1)-XMT2-XMR2))
|
|
& +2D0*CCC(I)*EEE(I)*XMR*XMT*(XMSB(1)-XMG2-XMB2)
|
|
& +4D0*SIN2C*CCC(I)*EEE(I)*XMQ4)
|
|
& *(1D0/(GRS/2D0-AM+XMSB(1)-W)-1D0/(GRS/2D0-AM+XMSB(1)+W))
|
|
SUMME(LIN)=SUMME(LIN)-VLR(2)*W
|
|
& +(VLR(2)*(XMQ2/2D0-XMSB(2)+XMG*XMB*SIN2C)
|
|
& -2D0*DDD(I)*FFF(I)*XMR*XMT)*ANB2
|
|
& +(VLR(2)/2D0*(XMSB(2)*(XMQ2-XMSB(2))-XMGBTR
|
|
& +2D0*XMG*XMB*SIN2C*(XMSB(2)-XMT2-XMR2))
|
|
& -2D0*DDD(I)*FFF(I)*XMR*XMT*(XMSB(2)-XMG2-XMB2)
|
|
& +4D0*SIN2C*DDD(I)*FFF(I)*XMQ4)
|
|
& *(1D0/(GRS/2D0-AM+XMSB(2)-W)-1D0/(GRS/2D0-AM+XMSB(2)+W))
|
|
SUMME(LIN)=SUMME(LIN)+2D0*XMG*XMT*COS2A/(XMST(3)-XMST(1))
|
|
& *((AAA(I)*BBB(I)-XX1(I)*XX2(I))
|
|
& *((XMST(3)-XMB2-XMR2)*ANT2-(XMST(1)-XMB2-XMR2)*ANT1)
|
|
& +2D0*(AAA(I)*XX2(I)-XX1(I)*BBB(I))*XMB*XMR*(ANT2-ANT1))
|
|
SUMME(LIN)=SUMME(LIN)+2D0*XMG*XMB*COS2C/(XMSB(2)-XMSB(1))
|
|
& *((EEE(I)*FFF(I)-CCC(I)*DDD(I))
|
|
& *((XMSB(2)-XMT2-XMR2)*ANB2-(XMSB(1)-XMT2-XMR2)*ANB1)
|
|
& +2D0*(EEE(I)*DDD(I)-CCC(I)*FFF(I))*XMT*XMR*(ANB2-ANB1))
|
|
DO 110 J=1,4
|
|
SUMME(LIN)=SUMME(LIN)-2D0*A(J,1)*W
|
|
& +((-A(J,1)*(XMSB(J)*(GRS+XMSB(J))+XMQ3)
|
|
& +A(J,2)*(XMSB(J)-XMT2-XMR2)+A(J,3)*(SBAR-XMB2-XMT2)
|
|
& +A(J,4)*(XMSB(J)+SBAR-XMB2-XMR2)
|
|
& -A(J,5)*(XMSB(J)+SBAR-XMG2-XMT2)+A(J,6)*(XMG2+XMR2-SBAR)
|
|
& -A(J,7)*(XMSB(J)-XMG2-XMB2)+2D0*A(J,8))
|
|
& *LOG(ABS((GRS/2D0+XMSB(J)-AM-W)/(GRS/2D0+XMSB(J)-AM+W)))
|
|
& -(A(J,1)*(XMST(J)*(GRS+XMST(J))+XMQ3)
|
|
& +A(J,2)*(XMST(J)+SBAR-XMG2-XMB2)-A(J,3)*(SBAR-XMB2-XMT2)
|
|
& +A(J,4)*(XMST(J)-XMG2-XMT2)-A(J,5)*(XMST(J)-XMR2-XMB2)
|
|
& -A(J,6)*(XMG2+XMR2-SBAR)
|
|
& -A(J,7)*(XMST(J)+SBAR-XMT2-XMR2)-2D0*A(J,8))
|
|
& *LOG(ABS((GRS/2D0+XMST(J)+AM-W)/(GRS/2D0+XMST(J)+AM+W))))
|
|
& /(GRS+XMSB(J)+XMST(J))
|
|
110 CONTINUE
|
|
120 CONTINUE
|
|
SUMME(NN)=0D0
|
|
GAM= ALPHAW * ALPHAS * PYSIMP(SUMME,SMIN,SMAX,NN)
|
|
&/ (16D0 * PARU(1) * PARU(102) * XMGLU**3)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYNJDC
|
|
C...Calculates decay widths for the neutralinos (admixtures of
|
|
C...Bino, W3-ino, Higgs1-ino, Higgs2-ino)
|
|
|
|
C...Input: KCIN = KF code for particle
|
|
C...Output: XLAM = widths
|
|
C... IDLAM = KF codes for decay particles
|
|
C... IKNT = number of decay channels defined
|
|
C...AUTHOR: STEPHEN MRENNA
|
|
C...Last change:
|
|
C...10-15-95: force decay chi^0_2 -> chi^0_1 + gamma
|
|
C...when CHIGAMMA .NE. 0
|
|
C...10 FEB 96: Calculate this decay for small tan(beta)
|
|
|
|
SUBROUTINE PYNJDC(KFIN,XLAM,IDLAM,IKNT)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
COMMON/PYINTS/XXM(20)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTS/
|
|
|
|
C...Local variables.
|
|
INTEGER KFIN,KCIN
|
|
DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2,
|
|
&XMZ,XMZ2,AXMJ,AXMI
|
|
DOUBLE PRECISION XMFP,XMF1,XMF2,XMSL,XMG,XMK
|
|
DOUBLE PRECISION S12MIN,S12MAX
|
|
DOUBLE PRECISION XMI2,XMI3,XMJ2,XMH,XMH2,XMHP,XMHP2,XMA2,XMB2
|
|
DOUBLE PRECISION PYLAMF,XL,QIJ,RIJ
|
|
DOUBLE PRECISION TANW,XW,AEM,C1,AS,EI,T3
|
|
DOUBLE PRECISION PYX2XH,PYX2XG
|
|
DOUBLE PRECISION XLAM(0:200)
|
|
INTEGER IDLAM(200,3)
|
|
INTEGER LKNT,IX,IH,J,IJ,I,IKNT,FID
|
|
INTEGER ITH(3),KF1,KF2
|
|
INTEGER ITHC
|
|
DOUBLE PRECISION ETAH(3),CH(3),DH(3),EH(3)
|
|
DOUBLE PRECISION SR2
|
|
DOUBLE PRECISION CBETA,SBETA,GR,GL,F12K,F21K
|
|
DOUBLE PRECISION GAMCON,XMT1,XMT2
|
|
DOUBLE PRECISION PYALEM,PI,PYALPS
|
|
DOUBLE PRECISION AL,BL,AR,BR,ALP,ARP,BLP,BRP
|
|
DOUBLE PRECISION RAT1,RAT2
|
|
DOUBLE PRECISION T3T,CA,CB,FCOL
|
|
DOUBLE PRECISION ALFA,BETA,TANB
|
|
DOUBLE PRECISION PYGAUS,PYXXGA
|
|
EXTERNAL PYXXW5,PYGAUS,PYXXZ5
|
|
DOUBLE PRECISION PREC
|
|
INTEGER KFNCHI(4),KFCCHI(2)
|
|
DATA ETAH/1D0,1D0,-1D0/
|
|
DATA ITH/25,35,36/
|
|
DATA ITHC/37/
|
|
DATA PREC/1D-2/
|
|
DATA PI/3.141592654D0/
|
|
DATA SR2/1.4142136D0/
|
|
DATA KFNCHI/1000022,1000023,1000025,1000035/
|
|
DATA KFCCHI/1000024,1000037/
|
|
|
|
C...COUNT THE NUMBER OF DECAY MODES
|
|
LKNT=0
|
|
|
|
XMW=PMAS(24,1)
|
|
XMW2=XMW**2
|
|
XMZ=PMAS(23,1)
|
|
XMZ2=XMZ**2
|
|
XW=1D0-XMW2/XMZ2
|
|
TANW = SQRT(XW/(1D0-XW))
|
|
|
|
C...IX IS 1 - 4 DEPENDING ON SEQUENCE NUMBER
|
|
KCIN=PYCOMP(KFIN)
|
|
IX=1
|
|
IF(KFIN.EQ.KFNCHI(2)) IX=2
|
|
IF(KFIN.EQ.KFNCHI(3)) IX=3
|
|
IF(KFIN.EQ.KFNCHI(4)) IX=4
|
|
|
|
XMI=SMZ(IX)
|
|
XMI2=XMI**2
|
|
AXMI=ABS(XMI)
|
|
AEM=PYALEM(XMI2)
|
|
AS =PYALPS(XMI2)
|
|
C1=AEM/XW
|
|
XMI3=ABS(XMI**3)
|
|
|
|
TANB=RMSS(5)
|
|
BETA=ATAN(TANB)
|
|
ALFA=RMSS(18)
|
|
CBETA=COS(BETA)
|
|
SBETA=TANB*CBETA
|
|
CALFA=COS(ALFA)
|
|
SALFA=SIN(ALFA)
|
|
|
|
C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS
|
|
IF(IX.EQ.1.AND.IMSS(11).EQ.0) THEN
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...FORCE CHI0_2 -> CHI0_1 + GAMMA
|
|
IF(IX.EQ.2 .AND. IMSS(10).NE.0 ) THEN
|
|
XMJ=SMZ(1)
|
|
AXMJ=ABS(XMJ)
|
|
LKNT=LKNT+1
|
|
GAMCON=AEM**3/8D0/PI/XMW2/XW
|
|
XMT1=(PMAS(PYCOMP(KSUSY1+6),1)/PMAS(6,1))**2
|
|
XMT2=(PMAS(PYCOMP(KSUSY2+6),1)/PMAS(6,1))**2
|
|
XLAM(LKNT)=PYXXGA(GAMCON,AXMI,AXMJ,XMT1,XMT2)
|
|
IDLAM(LKNT,1)=KSUSY1+22
|
|
IDLAM(LKNT,2)=22
|
|
IDLAM(LKNT,3)=0
|
|
WRITE(MSTU(11),*) 'FORCED N2 -> N1 + GAMMA ',XLAM(LKNT)
|
|
GOTO 290
|
|
ENDIF
|
|
|
|
C...GRAVITINO DECAY MODES
|
|
|
|
IF(IMSS(11).EQ.1) THEN
|
|
XMP=RMSS(28)
|
|
IDG=39+KSUSY1
|
|
XMGR=PMAS(PYCOMP(IDG),1)
|
|
SINW=SQRT(XW)
|
|
COSW=SQRT(1D0-XW)
|
|
XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI
|
|
IF(AXMI.GT.XMGR+PMAS(22,1)) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=IDG
|
|
IDLAM(LKNT,2)=22
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XFAC*(ZMIX(IX,1)*COSW+ZMIX(IX,2)*SINW)**2
|
|
ENDIF
|
|
IF(AXMI.GT.XMGR+XMZ) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=IDG
|
|
IDLAM(LKNT,2)=23
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XFAC*((ZMIX(IX,1)*SINW-ZMIX(IX,2)*COSW)**2 +
|
|
$ .5D0*(ZMIX(IX,3)*CBETA-ZMIX(IX,4)*SBETA)**2)*(1D0-XMZ2/XMI2)**4
|
|
ENDIF
|
|
IF(AXMI.GT.XMGR+PMAS(25,1)) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=IDG
|
|
IDLAM(LKNT,2)=25
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XFAC*((ZMIX(IX,3)*SALFA-ZMIX(IX,4)*CALFA)**2)*
|
|
$ .5D0*(1D0-PMAS(25,1)**2/XMI2)**4
|
|
ENDIF
|
|
IF(AXMI.GT.XMGR+PMAS(35,1)) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=IDG
|
|
IDLAM(LKNT,2)=35
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XFAC*((ZMIX(IX,3)*CALFA+ZMIX(IX,4)*SALFA)**2)*
|
|
$ .5D0*(1D0-PMAS(35,1)**2/XMI2)**4
|
|
ENDIF
|
|
IF(AXMI.GT.XMGR+PMAS(36,1)) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=IDG
|
|
IDLAM(LKNT,2)=36
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XFAC*((ZMIX(IX,3)*SBETA+ZMIX(IX,4)*CBETA)**2)*
|
|
$ .5D0*(1D0-PMAS(36,1)**2/XMI2)**4
|
|
ENDIF
|
|
ENDIF
|
|
|
|
DO 180 IJ=1,IX-1
|
|
XMJ=SMZ(IJ)
|
|
AXMJ=ABS(XMJ)
|
|
XMJ2=XMJ**2
|
|
|
|
C...CHI0_I -> CHI0_J + GAMMA
|
|
IF(AXMI.GE.AXMJ.AND.SBETA/CBETA.LE.2D0) THEN
|
|
RAT1=ZMIX(IJ,1)**2+ZMIX(IJ,2)**2
|
|
RAT1=RAT1/( 1D-6+ZMIX(IX,3)**2+ZMIX(IX,4)**2 )
|
|
RAT2=ZMIX(IX,1)**2+ZMIX(IX,2)**2
|
|
RAT2=RAT2/( 1D-6+ZMIX(IJ,3)**2+ZMIX(IJ,4)**2 )
|
|
IF((RAT1.GT. 0.90D0 .AND. RAT1.LT. 1.10D0) .OR.
|
|
& (RAT2.GT. 0.90D0 .AND. RAT2.LT. 1.10D0)) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=22
|
|
IDLAM(LKNT,3)=0
|
|
GAMCON=AEM**3/8D0/PI/XMW2/XW
|
|
XMT1=(PMAS(PYCOMP(KSUSY1+6),1)/PMAS(6,1))**2
|
|
XMT2=(PMAS(PYCOMP(KSUSY2+6),1)/PMAS(6,1))**2
|
|
XLAM(LKNT)=PYXXGA(GAMCON,AXMI,AXMJ,XMT1,XMT2)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...CHI0_I -> CHI0_J + Z0
|
|
IF(AXMI.GE.AXMJ+XMZ) THEN
|
|
LKNT=LKNT+1
|
|
GL=-0.5D0*(ZMIX(IX,3)*ZMIX(IJ,3)-ZMIX(IX,4)*ZMIX(IJ,4))
|
|
GR=-GL
|
|
XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMZ,GL,GR)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=23
|
|
IDLAM(LKNT,3)=0
|
|
ELSEIF(AXMI.GE.AXMJ) THEN
|
|
FID=11
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=-0.5D0
|
|
XXM(1)=0D0
|
|
XXM(2)=XMJ
|
|
XXM(3)=0D0
|
|
XXM(4)=XMI
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+11),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+11),1)
|
|
XXM(7)=XMZ
|
|
XXM(8)=PMAS(23,2)
|
|
XXM(9)=-0.5D0*(ZMIX(IX,3)*ZMIX(IJ,3)-ZMIX(IX,4)*ZMIX(IJ,4))
|
|
XXM(10)=-XXM(9)
|
|
XXM(11)=(T3-EI*XW)/(1D0-XW)
|
|
XXM(12)=-EI*XW/(1D0-XW)
|
|
XXM(13)=-SR2*(T3*ZMIX(IX,2)-TANW*(T3-EI)*ZMIX(IX,1))
|
|
XXM(14)=-SR2*(T3*ZMIX(IJ,2)-TANW*(T3-EI)*ZMIX(IJ,1))
|
|
XXM(15)=SR2*TANW*(EI*ZMIX(IX,1))
|
|
XXM(16)=SR2*TANW*(EI*ZMIX(IJ,1))
|
|
S12MIN=0D0
|
|
S12MAX=(AXMI-AXMJ)**2
|
|
|
|
C...CHARGED LEPTONS
|
|
IF( XXM(5).LT.AXMI ) THEN
|
|
XXM(5)=1D6
|
|
ENDIF
|
|
IF(XXM(6).LT.AXMI ) THEN
|
|
XXM(6)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(11,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=11
|
|
IDLAM(LKNT,3)=-11
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(13,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=13
|
|
IDLAM(LKNT,3)=-13
|
|
ENDIF
|
|
ENDIF
|
|
100 CONTINUE
|
|
IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+15),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+15),1)
|
|
ELSE
|
|
XXM(6)=PMAS(PYCOMP(KSUSY1+15),1)
|
|
XXM(5)=PMAS(PYCOMP(KSUSY2+15),1)
|
|
ENDIF
|
|
IF( XXM(5).LT.AXMI ) THEN
|
|
XXM(5)=1D6
|
|
ENDIF
|
|
IF(XXM(6).LT.AXMI ) THEN
|
|
XXM(6)=1D6
|
|
ENDIF
|
|
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(15,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=15
|
|
IDLAM(LKNT,3)=-15
|
|
ENDIF
|
|
|
|
C...NEUTRINOS
|
|
110 CONTINUE
|
|
FID=12
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=0.5D0
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+12),1)
|
|
XXM(6)=1D6
|
|
XXM(11)=(T3-EI*XW)/(1D0-XW)
|
|
XXM(12)=-EI*XW/(1D0-XW)
|
|
XXM(13)=-SR2*(T3*ZMIX(IX,2)-TANW*(T3-EI)*ZMIX(IX,1))
|
|
XXM(14)=-SR2*(T3*ZMIX(IJ,2)-TANW*(T3-EI)*ZMIX(IJ,1))
|
|
XXM(15)=SR2*TANW*(EI*ZMIX(IX,1))
|
|
XXM(16)=SR2*TANW*(EI*ZMIX(IJ,1))
|
|
|
|
IF( XXM(5).LT.AXMI ) THEN
|
|
XXM(5)=1D6
|
|
ENDIF
|
|
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=12
|
|
IDLAM(LKNT,3)=-12
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=14
|
|
IDLAM(LKNT,3)=-14
|
|
120 CONTINUE
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+16),1)
|
|
IF( XXM(5).LT.AXMI ) THEN
|
|
XXM(5)=1D6
|
|
ENDIF
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=16
|
|
IDLAM(LKNT,3)=-16
|
|
|
|
C...D-TYPE QUARKS
|
|
130 CONTINUE
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+1),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+1),1)
|
|
FID=1
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=-0.5D0
|
|
|
|
XXM(11)=(T3-EI*XW)/(1D0-XW)
|
|
XXM(12)=-EI*XW/(1D0-XW)
|
|
XXM(13)=-SR2*(T3*ZMIX(IX,2)-TANW*(T3-EI)*ZMIX(IX,1))
|
|
XXM(14)=-SR2*(T3*ZMIX(IJ,2)-TANW*(T3-EI)*ZMIX(IJ,1))
|
|
XXM(15)=SR2*TANW*(EI*ZMIX(IX,1))
|
|
XXM(16)=SR2*TANW*(EI*ZMIX(IJ,1))
|
|
|
|
IF( XXM(5).LT.AXMI .AND. XXM(6).LT.AXMI ) GOTO 140
|
|
IF( XXM(5).LT.AXMI ) THEN
|
|
XXM(5)=1D6
|
|
ELSEIF( XXM(6).LT.AXMI ) THEN
|
|
XXM(6)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)*3D0
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=1
|
|
IDLAM(LKNT,3)=-1
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=3
|
|
IDLAM(LKNT,3)=-3
|
|
ENDIF
|
|
ENDIF
|
|
140 CONTINUE
|
|
IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+5),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+5),1)
|
|
ELSE
|
|
XXM(6)=PMAS(PYCOMP(KSUSY1+5),1)
|
|
XXM(5)=PMAS(PYCOMP(KSUSY2+5),1)
|
|
ENDIF
|
|
IF( XXM(5).LT.AXMI .AND. XXM(6).LT.AXMI ) GOTO 150
|
|
IF(XXM(5).LT.AXMI) THEN
|
|
XXM(5)=1D6
|
|
ELSEIF(XXM(6).LT.AXMI) THEN
|
|
XXM(6)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)*3D0
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=5
|
|
IDLAM(LKNT,3)=-5
|
|
ENDIF
|
|
|
|
C...U-TYPE QUARKS
|
|
150 CONTINUE
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+2),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+2),1)
|
|
FID=2
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=0.5D0
|
|
|
|
XXM(11)=(T3-EI*XW)/(1D0-XW)
|
|
XXM(12)=-EI*XW/(1D0-XW)
|
|
XXM(13)=-SR2*(T3*ZMIX(IX,2)-TANW*(T3-EI)*ZMIX(IX,1))
|
|
XXM(14)=-SR2*(T3*ZMIX(IJ,2)-TANW*(T3-EI)*ZMIX(IJ,1))
|
|
XXM(15)=SR2*TANW*(EI*ZMIX(IX,1))
|
|
XXM(16)=SR2*TANW*(EI*ZMIX(IJ,1))
|
|
|
|
IF( XXM(5).LT.AXMI .AND. XXM(6).LT.AXMI ) GOTO 160
|
|
IF(XXM(5).LT.AXMI) THEN
|
|
XXM(5)=1D6
|
|
ELSEIF(XXM(6).LT.AXMI) THEN
|
|
XXM(6)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)*3D0
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=2
|
|
IDLAM(LKNT,3)=-2
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=4
|
|
IDLAM(LKNT,3)=-4
|
|
ENDIF
|
|
ENDIF
|
|
160 CONTINUE
|
|
ENDIF
|
|
|
|
C...CHI0_I -> CHI0_J + H0_K
|
|
EH(1)=SIN(ALFA)
|
|
EH(2)=COS(ALFA)
|
|
EH(3)=-SIN(BETA)
|
|
DH(1)=COS(ALFA)
|
|
DH(2)=-SIN(ALFA)
|
|
DH(3)=COS(BETA)
|
|
|
|
QIJ=ZMIX(IX,3)*ZMIX(IJ,2)+ZMIX(IJ,3)*ZMIX(IX,2)-
|
|
& TANW*(ZMIX(IX,3)*ZMIX(IJ,1)+ZMIX(IJ,3)*ZMIX(IX,1))
|
|
RIJ=ZMIX(IX,4)*ZMIX(IJ,2)+ZMIX(IJ,4)*ZMIX(IX,2)-
|
|
& TANW*(ZMIX(IX,4)*ZMIX(IJ,1)+ZMIX(IJ,4)*ZMIX(IX,1))
|
|
|
|
DO 170 IH=1,3
|
|
XMH=PMAS(ITH(IH),1)
|
|
XMH2=XMH**2
|
|
IF(AXMI.GE.AXMJ+XMH) THEN
|
|
LKNT=LKNT+1
|
|
XL=PYLAMF(XMI2,XMJ2,XMH2)
|
|
F21K=0.5D0*(QIJ*EH(IH)+RIJ*DH(IH))
|
|
F12K=F21K
|
|
C...SIGN OF MASSES I,J
|
|
XMK=XMJ
|
|
IF(IH.EQ.3) XMK=-XMK
|
|
XLAM(LKNT)=PYX2XH(C1,XMI,XMK,XMH,F12K,F21K)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=ITH(IH)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
170 CONTINUE
|
|
180 CONTINUE
|
|
|
|
C...CHI0_I -> CHI+_J + W-
|
|
DO 220 IJ=1,2
|
|
XMJ=SMW(IJ)
|
|
AXMJ=ABS(XMJ)
|
|
XMJ2=XMJ**2
|
|
IF(AXMI.GE.AXMJ+XMW) THEN
|
|
LKNT=LKNT+1
|
|
GL=ZMIX(IX,2)*VMIX(IJ,1)-ZMIX(IX,4)*VMIX(IJ,2)/SR2
|
|
GR=ZMIX(IX,2)*UMIX(IJ,1)+ZMIX(IX,3)*UMIX(IJ,2)/SR2
|
|
XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMW,GL,GR)
|
|
IDLAM(LKNT,1)=KFCCHI(IJ)
|
|
IDLAM(LKNT,2)=-24
|
|
IDLAM(LKNT,3)=0
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-KFCCHI(IJ)
|
|
IDLAM(LKNT,2)=24
|
|
IDLAM(LKNT,3)=0
|
|
ELSEIF(AXMI.GE.AXMJ) THEN
|
|
S12MIN=0D0
|
|
S12MAX=(AXMI-AXMJ)**2
|
|
XXM(5)=ZMIX(IX,2)*VMIX(IJ,1)-ZMIX(IX,4)*VMIX(IJ,2)/SR2
|
|
XXM(6)=ZMIX(IX,2)*UMIX(IJ,1)+ZMIX(IX,3)*UMIX(IJ,2)/SR2
|
|
|
|
C...LEPTONS
|
|
FID=11
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=-0.5D0
|
|
XXM(7)=-SR2*(T3*ZMIX(IX,2)-TANW*(T3-EI)*ZMIX(IX,1))*UMIX(IJ,1)
|
|
FID=12
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=0.5D0
|
|
XXM(8)=-SR2*(T3*ZMIX(IX,2)-TANW*(T3-EI)*ZMIX(IX,1))*VMIX(IJ,1)
|
|
|
|
XXM(1)=0D0
|
|
XXM(2)=XMJ
|
|
XXM(3)=0D0
|
|
XXM(4)=XMI
|
|
XXM(9)=PMAS(24,1)
|
|
XXM(10)=PMAS(24,2)
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+11),1)
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+12),1)
|
|
IF( XXM(11).LT.AXMI .AND. XXM(12).LT.AXMI ) GOTO 190
|
|
IF(XXM(11).LT.AXMI) THEN
|
|
XXM(11)=1D6
|
|
ELSEIF(XXM(12).LT.AXMI) THEN
|
|
XXM(12)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+PMAS(11,1)+PMAS(12,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXW5,S12MIN,S12MAX,PREC)
|
|
IDLAM(LKNT,1)=KFCCHI(IJ)
|
|
IDLAM(LKNT,2)=11
|
|
IDLAM(LKNT,3)=-12
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
|
|
IF(AXMI.GE.AXMJ+PMAS(13,1)+PMAS(14,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(IJ)
|
|
IDLAM(LKNT,2)=13
|
|
IDLAM(LKNT,3)=-14
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
|
|
ENDIF
|
|
ENDIF
|
|
190 CONTINUE
|
|
IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+15),1)
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+16),1)
|
|
ELSE
|
|
XXM(11)=PMAS(PYCOMP(KSUSY2+15),1)
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+16),1)
|
|
ENDIF
|
|
|
|
IF(XXM(11).LT.AXMI) THEN
|
|
XXM(11)=1D6
|
|
ENDIF
|
|
IF(XXM(12).LT.AXMI) THEN
|
|
XXM(12)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+PMAS(15,1)+PMAS(16,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXW5,S12MIN,S12MAX,PREC)
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(IJ)
|
|
IDLAM(LKNT,2)=15
|
|
IDLAM(LKNT,3)=-16
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
|
|
ENDIF
|
|
|
|
C...NOW, DO THE QUARKS
|
|
200 CONTINUE
|
|
FID=1
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=-0.5D0
|
|
XXM(7)=-SR2*(T3*ZMIX(IX,2)-TANW*(T3-EI)*ZMIX(IX,1))*UMIX(IJ,1)
|
|
FID=2
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=0.5D0
|
|
XXM(8)=-SR2*(T3*ZMIX(IX,2)-TANW*(T3-EI)*ZMIX(IX,1))*VMIX(IJ,1)
|
|
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+1),1)
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+2),1)
|
|
IF( XXM(11).LT.AXMI .AND. XXM(12).LT.AXMI ) GOTO 210
|
|
IF(XXM(11).LT.AXMI) THEN
|
|
XXM(11)=1D6
|
|
ELSEIF(XXM(12).LT.AXMI) THEN
|
|
XXM(12)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+PMAS(2,1)+PMAS(1,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXW5,S12MIN,S12MAX,PREC)
|
|
IDLAM(LKNT,1)=KFCCHI(IJ)
|
|
IDLAM(LKNT,2)=1
|
|
IDLAM(LKNT,3)=-2
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
|
|
IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(IJ)
|
|
IDLAM(LKNT,2)=3
|
|
IDLAM(LKNT,3)=-4
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
|
|
ENDIF
|
|
ENDIF
|
|
210 CONTINUE
|
|
ENDIF
|
|
220 CONTINUE
|
|
230 CONTINUE
|
|
|
|
C...CHI0_I -> CHI+_I + H-
|
|
DO 240 IJ=1,2
|
|
XMJ=SMW(IJ)
|
|
AXMJ=ABS(XMJ)
|
|
XMJ2=XMJ**2
|
|
XMHP=PMAS(ITHC,1)
|
|
XMHP2=XMHP**2
|
|
IF(AXMI.GE.AXMJ+XMHP) THEN
|
|
LKNT=LKNT+1
|
|
GL=CBETA*(ZMIX(IX,4)*VMIX(IJ,1)+(ZMIX(IX,2)+
|
|
& ZMIX(IX,1)*TANW)*VMIX(IJ,2)/SR2)
|
|
GR=SBETA*(ZMIX(IX,3)*UMIX(IJ,1)-(ZMIX(IX,2)+
|
|
& ZMIX(IX,1)*TANW)*UMIX(IJ,2)/SR2)
|
|
XLAM(LKNT)=PYX2XH(C1,XMI,XMJ,XMHP,GL,GR)
|
|
IDLAM(LKNT,1)=KFCCHI(IJ)
|
|
IDLAM(LKNT,2)=-ITHC
|
|
IDLAM(LKNT,3)=0
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
|
|
ELSE
|
|
|
|
ENDIF
|
|
240 CONTINUE
|
|
|
|
C...2-BODY DECAYS TO FERMION SFERMION
|
|
DO 250 J=1,16
|
|
IF(J.GE.7.AND.J.LE.10) GOTO 250
|
|
KF1=KSUSY1+J
|
|
KF2=KSUSY2+J
|
|
XMSF1=PMAS(PYCOMP(KF1),1)
|
|
XMSF2=PMAS(PYCOMP(KF2),1)
|
|
XMF=PMAS(J,1)
|
|
IF(J.LE.6) THEN
|
|
FCOL=3D0
|
|
ELSE
|
|
FCOL=1D0
|
|
ENDIF
|
|
|
|
EI=KCHG(J,1)/3D0
|
|
T3T=SIGN(1D0,EI)
|
|
IF(J.EQ.12.OR.J.EQ.14.OR.J.EQ.16) T3T=1D0
|
|
IF(MOD(J,2).EQ.0) THEN
|
|
BL=T3T*ZMIX(IX,2)+TANW*ZMIX(IX,1)*(2D0*EI-T3T)
|
|
AL=XMF*ZMIX(IX,4)/XMW/SBETA
|
|
AR=-2D0*EI*TANW*ZMIX(IX,1)
|
|
BR=AL
|
|
ELSE
|
|
BL=T3T*ZMIX(IX,2)+TANW*ZMIX(IX,1)*(2D0*EI-T3T)
|
|
AL=XMF*ZMIX(IX,3)/XMW/CBETA
|
|
AR=-2D0*EI*TANW*ZMIX(IX,1)
|
|
BR=AL
|
|
ENDIF
|
|
|
|
C...D~ D_L
|
|
IF(AXMI.GE.XMF+XMSF1) THEN
|
|
LKNT=LKNT+1
|
|
XMA2=XMSF1**2
|
|
XMB2=XMF**2
|
|
XL=PYLAMF(XMI2,XMA2,XMB2)
|
|
CA=AL*SFMIX(J,1)+AR*SFMIX(J,2)
|
|
CB=BL*SFMIX(J,1)+BR*SFMIX(J,2)
|
|
XLAM(LKNT)=0.5D0*FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)*
|
|
& (CA**2+CB**2)+4D0*CA*CB*XMF*XMI)
|
|
IDLAM(LKNT,1)=KF1
|
|
IDLAM(LKNT,2)=-J
|
|
IDLAM(LKNT,3)=0
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
|
|
C...D~ D_R
|
|
IF(AXMI.GE.XMF+XMSF2) THEN
|
|
LKNT=LKNT+1
|
|
XMA2=XMSF2**2
|
|
XMB2=XMF**2
|
|
CA=AL*SFMIX(J,3)+AR*SFMIX(J,4)
|
|
CB=BL*SFMIX(J,3)+BR*SFMIX(J,4)
|
|
XL=PYLAMF(XMI2,XMA2,XMB2)
|
|
XLAM(LKNT)=0.5D0*FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)*
|
|
& (CA**2+CB**2)+4D0*CA*CB*XMF*XMI)
|
|
IDLAM(LKNT,1)=KF2
|
|
IDLAM(LKNT,2)=-J
|
|
IDLAM(LKNT,3)=0
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
|
|
IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
250 CONTINUE
|
|
|
|
C...3-BODY DECAY TO Q Q~ GLUINO
|
|
XMJ=PMAS(PYCOMP(KSUSY1+21),1)
|
|
IF(AXMI.GE.XMJ) THEN
|
|
AXMJ=ABS(XMJ)
|
|
XXM(1)=0D0
|
|
XXM(2)=XMJ
|
|
XXM(3)=0D0
|
|
XXM(4)=XMI
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+1),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+1),1)
|
|
XXM(7)=1D6
|
|
XXM(8)=0D0
|
|
XXM(9)=0D0
|
|
XXM(10)=0D0
|
|
S12MIN=0D0
|
|
S12MAX=(AXMI-AXMJ)**2
|
|
C...ALL QUARKS BUT T
|
|
XXM(11)=0D0
|
|
XXM(12)=0D0
|
|
XXM(13)=1D0
|
|
XXM(14)=-SR2*(-0.5D0*ZMIX(IX,2)+TANW*ZMIX(IX,1)/6D0)
|
|
XXM(15)=1D0
|
|
XXM(16)=SR2*(-TANW*ZMIX(IX,1)/3D0)
|
|
IF( XXM(5).LT.AXMI .OR. XXM(6).LT.AXMI ) GOTO 260
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=4D0*C1*AS/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)
|
|
IDLAM(LKNT,1)=KSUSY1+21
|
|
IDLAM(LKNT,2)=1
|
|
IDLAM(LKNT,3)=-1
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KSUSY1+21
|
|
IDLAM(LKNT,2)=3
|
|
IDLAM(LKNT,3)=-3
|
|
ENDIF
|
|
ENDIF
|
|
260 CONTINUE
|
|
IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+5),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+5),1)
|
|
ELSE
|
|
XXM(6)=PMAS(PYCOMP(KSUSY1+5),1)
|
|
XXM(5)=PMAS(PYCOMP(KSUSY2+5),1)
|
|
ENDIF
|
|
IF( XXM(5).LT.AXMI .OR. XXM(6).LT.AXMI ) GOTO 270
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)
|
|
IDLAM(LKNT,1)=KSUSY1+21
|
|
IDLAM(LKNT,2)=5
|
|
IDLAM(LKNT,3)=-5
|
|
ENDIF
|
|
C...U-TYPE QUARKS
|
|
270 CONTINUE
|
|
XXM(5)=PMAS(PYCOMP(KSUSY1+2),1)
|
|
XXM(6)=PMAS(PYCOMP(KSUSY2+2),1)
|
|
XXM(13)=1D0
|
|
XXM(14)=-SR2*(0.5D0*ZMIX(IX,2)+TANW*ZMIX(IX,1)/6D0)
|
|
XXM(15)=1D0
|
|
XXM(16)=SR2*(2D0*TANW*ZMIX(IX,1)/3D0)
|
|
IF( XXM(5).LT.AXMI .OR. XXM(6).LT.AXMI ) GOTO 280
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ5,S12MIN,S12MAX,1D-3)
|
|
IDLAM(LKNT,1)=KSUSY1+21
|
|
IDLAM(LKNT,2)=2
|
|
IDLAM(LKNT,3)=-2
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KSUSY1+21
|
|
IDLAM(LKNT,2)=4
|
|
IDLAM(LKNT,3)=-4
|
|
ENDIF
|
|
ENDIF
|
|
280 CONTINUE
|
|
ENDIF
|
|
|
|
290 IKNT=LKNT
|
|
XLAM(0)=0D0
|
|
DO 300 I=1,IKNT
|
|
IF(XLAM(I).LT.0D0) XLAM(I)=0D0
|
|
XLAM(0)=XLAM(0)+XLAM(I)
|
|
300 CONTINUE
|
|
IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYCJDC
|
|
C...Calculate decay widths for the charginos (admixtures of
|
|
C...charged Wino and charged Higgsino.
|
|
|
|
C...Input: KCIN = KF code for particle
|
|
C...Output: XLAM = widths
|
|
C... IDLAM = KF codes for decay particles
|
|
C... IKNT = number of decay channels defined
|
|
C...AUTHOR: STEPHEN MRENNA
|
|
C...Last change:
|
|
C...10-16-95: force decay chi^+_1 -> chi^0_1 e+ nu_e
|
|
C...when CHIENU .NE. 0
|
|
|
|
SUBROUTINE PYCJDC(KFIN,XLAM,IDLAM,IKNT)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
COMMON/PYINTS/XXM(20)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTS/
|
|
|
|
C...Local variables.
|
|
INTEGER KFIN,KCIN
|
|
DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2,
|
|
&XMZ,XMZ2,AXMJ,AXMI
|
|
DOUBLE PRECISION XMFP,XMF1,XMF2,XMSL,XMG
|
|
DOUBLE PRECISION S12MIN,S12MAX
|
|
DOUBLE PRECISION XMI2,XMI3,XMJ2,XMH,XMH2,XMHP,XMHP2,XMA2,XMB2,XMK
|
|
DOUBLE PRECISION PYLAMF,XL
|
|
DOUBLE PRECISION TANW,XW,AEM,C1,AS,EI,T3,BETA,ALFA
|
|
DOUBLE PRECISION PYX2XH,PYX2XG
|
|
DOUBLE PRECISION XLAM(0:200)
|
|
INTEGER IDLAM(200,3)
|
|
INTEGER LKNT,IX,IH,J,IJ,I,IKNT,FID
|
|
INTEGER ITH(3)
|
|
INTEGER ITHC
|
|
DOUBLE PRECISION ETAH(3),CH(3),DH(3),EH(3)
|
|
DOUBLE PRECISION SR2
|
|
DOUBLE PRECISION CBETA,SBETA,GR,GL,F12K,F21K,TANB
|
|
|
|
DOUBLE PRECISION PYALEM,PI,PYALPS
|
|
DOUBLE PRECISION AL,BL,AR,BR,ALP,BLP,ARP,BRP
|
|
DOUBLE PRECISION CA,CB,FCOL
|
|
INTEGER KF1,KF2,ISF
|
|
INTEGER KFNCHI(4),KFCCHI(2)
|
|
|
|
DOUBLE PRECISION TEMP
|
|
DOUBLE PRECISION PYGAUS
|
|
EXTERNAL PYGAUS,PYXXZ5,PYXXW5,PYXXZ2
|
|
DOUBLE PRECISION PREC
|
|
DATA ITH/25,35,36/
|
|
DATA ITHC/37/
|
|
DATA ETAH/1D0,1D0,-1D0/
|
|
DATA SR2/1.4142136D0/
|
|
DATA PI/3.141592654D0/
|
|
DATA PREC/1D-2/
|
|
DATA KFNCHI/1000022,1000023,1000025,1000035/
|
|
DATA KFCCHI/1000024,1000037/
|
|
|
|
C...COUNT THE NUMBER OF DECAY MODES
|
|
LKNT=0
|
|
XMW=PMAS(24,1)
|
|
XMW2=XMW**2
|
|
XMZ=PMAS(23,1)
|
|
XMZ2=XMZ**2
|
|
XW=1D0-XMW2/XMZ2
|
|
TANW = SQRT(XW/(1D0-XW))
|
|
|
|
C...1 OR 2 DEPENDING ON CHARGINO TYPE
|
|
IX=1
|
|
IF(KFIN.EQ.KFCCHI(2)) IX=2
|
|
KCIN=PYCOMP(KFIN)
|
|
|
|
XMI=SMW(IX)
|
|
XMI2=XMI**2
|
|
AXMI=ABS(XMI)
|
|
AEM=PYALEM(XMI2)
|
|
AS =PYALPS(XMI2)
|
|
C1=AEM/XW
|
|
XMI3=ABS(XMI**3)
|
|
TANB=RMSS(5)
|
|
BETA=ATAN(TANB)
|
|
CBETA=COS(BETA)
|
|
SBETA=TANB*CBETA
|
|
ALFA=RMSS(18)
|
|
|
|
C...GRAVITINO DECAY MODES
|
|
|
|
IF(IMSS(11).EQ.1) THEN
|
|
XMP=RMSS(28)
|
|
IDG=39+KSUSY1
|
|
XMGR=PMAS(PYCOMP(IDG),1)
|
|
SINW=SQRT(XW)
|
|
COSW=SQRT(1D0-XW)
|
|
XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI
|
|
IF(AXMI.GT.XMGR+XMW) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=IDG
|
|
IDLAM(LKNT,2)=24
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XFAC*(.5D0*(VMIX(IX,1)**2+UMIX(IX,1)**2)+
|
|
& .5D0*((VMIX(IX,2)*SBETA)**2+(UMIX(IX,2)*CBETA)**2))*
|
|
& (1D0-XMW2/XMI2)**4
|
|
ENDIF
|
|
IF(AXMI.GT.XMGR+PMAS(37,1)) THEN
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=IDG
|
|
IDLAM(LKNT,2)=37
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XFAC*(.5D0*((VMIX(IX,2)*CBETA)**2+
|
|
& (UMIX(IX,2)*SBETA)**2))
|
|
& *(1D0-PMAS(37,1)**2/XMI2)**4
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS
|
|
IF(IX.EQ.1) GOTO 150
|
|
XMJ=SMW(1)
|
|
AXMJ=ABS(XMJ)
|
|
XMJ2=XMJ**2
|
|
|
|
C...CHI_2+ -> CHI_1+ + Z0
|
|
IF(AXMI.GE.AXMJ+XMZ) THEN
|
|
LKNT=LKNT+1
|
|
GL=VMIX(2,1)*VMIX(1,1)+0.5D0*VMIX(2,2)*VMIX(1,2)
|
|
GR=UMIX(2,1)*UMIX(1,1)+0.5D0*UMIX(2,2)*UMIX(1,2)
|
|
XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMZ,GL,GR)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=23
|
|
IDLAM(LKNT,3)=0
|
|
|
|
C...CHARGED LEPTONS
|
|
ELSEIF(AXMI.GE.AXMJ) THEN
|
|
XXM(5)=-(VMIX(2,1)*VMIX(1,1)+0.5D0*VMIX(2,2)*VMIX(1,2))
|
|
XXM(6)=-(UMIX(2,1)*UMIX(1,1)+0.5D0*UMIX(2,2)*UMIX(1,2))
|
|
XXM(9)=XMZ
|
|
XXM(10)=PMAS(23,2)
|
|
XXM(1)=0D0
|
|
XXM(2)=XMJ
|
|
XXM(3)=0D0
|
|
XXM(4)=XMI
|
|
S12MIN=0D0
|
|
S12MAX=(AXMJ-AXMI)**2
|
|
XXM(7)= (-0.5D0+XW)/(1D0-XW)
|
|
XXM(8)= XW/(1D0-XW)
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+12),1)
|
|
XXM(12)=VMIX(2,1)*VMIX(1,1)
|
|
IF( XXM(11).LT.AXMI ) THEN
|
|
XXM(11)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(11,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ2,S12MIN,S12MAX,PREC)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=11
|
|
IDLAM(LKNT,3)=-11
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(13,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=13
|
|
IDLAM(LKNT,3)=-13
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(15,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=15
|
|
IDLAM(LKNT,3)=-15
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...NEUTRINOS
|
|
100 CONTINUE
|
|
XXM(7)= (0.5D0)/(1D0-XW)
|
|
XXM(8)= 0D0
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+11),1)
|
|
XXM(12)=UMIX(2,1)*UMIX(1,1)
|
|
IF( XXM(11).LT.AXMI ) THEN
|
|
XXM(11)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(12,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ2,S12MIN,S12MAX,PREC)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=12
|
|
IDLAM(LKNT,3)=-12
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=14
|
|
IDLAM(LKNT,3)=-14
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=16
|
|
IDLAM(LKNT,3)=-16
|
|
ENDIF
|
|
|
|
C...D-TYPE QUARKS
|
|
110 CONTINUE
|
|
XXM(7)= (-0.5D0+XW/3D0)/(1D0-XW)
|
|
XXM(8)= XW/3D0/(1D0-XW)
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+2),1)
|
|
XXM(12)=VMIX(2,1)*VMIX(1,1)
|
|
IF( XXM(11).LT.AXMI ) GOTO 120
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ2,S12MIN,S12MAX,PREC)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=1
|
|
IDLAM(LKNT,3)=-1
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=3
|
|
IDLAM(LKNT,3)=-3
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=5
|
|
IDLAM(LKNT,3)=-5
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...U-TYPE QUARKS
|
|
120 CONTINUE
|
|
XXM(7)= (0.5D0-2D0*XW/3D0)/(1D0-XW)
|
|
XXM(8)= -2D0*XW/3D0/(1D0-XW)
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+1),1)
|
|
XXM(12)=UMIX(2,1)*UMIX(1,1)
|
|
IF( XXM(11).LT.AXMI ) GOTO 130
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXZ2,S12MIN,S12MAX,PREC)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=2
|
|
IDLAM(LKNT,3)=-2
|
|
IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=4
|
|
IDLAM(LKNT,3)=-4
|
|
ENDIF
|
|
ENDIF
|
|
130 CONTINUE
|
|
ENDIF
|
|
|
|
C...CHI_2+ -> CHI_1+ + H0_K
|
|
EH(2)=COS(ALFA)
|
|
EH(1)=SIN(ALFA)
|
|
EH(3)=-SBETA
|
|
DH(2)=-SIN(ALFA)
|
|
DH(1)=COS(ALFA)
|
|
DH(3)=COS(BETA)
|
|
DO 140 IH=1,3
|
|
XMH=PMAS(ITH(IH),1)
|
|
XMH2=XMH**2
|
|
C...NO 3-BODY OPTION
|
|
IF(AXMI.GE.AXMJ+XMH) THEN
|
|
LKNT=LKNT+1
|
|
XL=PYLAMF(XMI2,XMJ2,XMH2)
|
|
F21K=(VMIX(2,1)*UMIX(1,2)*EH(IH) -
|
|
& VMIX(2,2)*UMIX(1,1)*DH(IH))/SR2
|
|
F12K=(VMIX(1,1)*UMIX(2,2)*EH(IH) -
|
|
& VMIX(1,2)*UMIX(2,1)*DH(IH))/SR2
|
|
XMK=XMJ*ETAH(IH)
|
|
XLAM(LKNT)=PYX2XH(C1,XMI,XMK,XMH,F12K,F21K)
|
|
IDLAM(LKNT,1)=KFCCHI(1)
|
|
IDLAM(LKNT,2)=ITH(IH)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
140 CONTINUE
|
|
|
|
C...CHI1 JUMPS TO HERE
|
|
150 CONTINUE
|
|
|
|
C...CHI+_I -> CHI0_J + W+
|
|
DO 180 IJ=1,4
|
|
XMJ=SMZ(IJ)
|
|
AXMJ=ABS(XMJ)
|
|
XMJ2=XMJ**2
|
|
IF(AXMI.GE.AXMJ+XMW) THEN
|
|
LKNT=LKNT+1
|
|
GL=ZMIX(IJ,2)*VMIX(IX,1)-ZMIX(IJ,4)*VMIX(IX,2)/SR2
|
|
GR=ZMIX(IJ,2)*UMIX(IX,1)+ZMIX(IJ,3)*UMIX(IX,2)/SR2
|
|
XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMW,GL,GR)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=24
|
|
IDLAM(LKNT,3)=0
|
|
|
|
C...LEPTONS
|
|
ELSEIF(AXMI.GE.AXMJ) THEN
|
|
XMF1=0D0
|
|
XMF2=0D0
|
|
S12MIN=(XMF1+XMF2)**2
|
|
S12MAX=(AXMJ-AXMI)**2
|
|
XXM(5)=-1D0/SR2*ZMIX(IJ,4)*VMIX(IX,2)+ZMIX(IJ,2)*VMIX(IX,1)
|
|
XXM(6)= 1D0/SR2*ZMIX(IJ,3)*UMIX(IX,2)+ZMIX(IJ,2)*UMIX(IX,1)
|
|
FID=11
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=-0.5D0
|
|
XXM(7)=-SR2*(T3*ZMIX(IJ,2)-TANW*(T3-EI)*ZMIX(IJ,1))*UMIX(IX,1)
|
|
FID=12
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=0.5D0
|
|
XXM(8)=-SR2*(T3*ZMIX(IJ,2)-TANW*(T3-EI)*ZMIX(IJ,1))*VMIX(IX,1)
|
|
|
|
XXM(4)=XMI
|
|
XXM(1)=XMF1
|
|
XXM(2)=XMJ
|
|
XXM(3)=XMF2
|
|
XXM(9)=PMAS(24,1)
|
|
XXM(10)=PMAS(24,2)
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+11),1)
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+12),1)
|
|
|
|
C...1/(2PI)**3*/(32*M**3)*G^4, G^2/(4*PI)= AEM/XW,
|
|
C...--> 1/(16PI)/M**3*(AEM/XW)**2
|
|
|
|
IF(XXM(11).LT.AXMI) THEN
|
|
XXM(11)=1D6
|
|
ENDIF
|
|
IF(XXM(12).LT.AXMI) THEN
|
|
XXM(12)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+PMAS(11,1)+PMAS(12,1)) THEN
|
|
LKNT=LKNT+1
|
|
TEMP=PYGAUS(PYXXW5,S12MIN,S12MAX,PREC)
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*TEMP
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=-11
|
|
IDLAM(LKNT,3)=12
|
|
|
|
C...ONLY DECAY CHI+1 -> E+ NU_E
|
|
IF( IMSS(12).NE. 0 ) GOTO 220
|
|
IF(AXMI.GE.AXMJ+PMAS(13,1)+PMAS(14,1)) THEN
|
|
LKNT=LKNT+1
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+13),1)
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+14),1)
|
|
IF(XXM(11).LT.AXMI) THEN
|
|
XXM(11)=1D6
|
|
ELSEIF(XXM(12).LT.AXMI) THEN
|
|
XXM(12)=1D6
|
|
ENDIF
|
|
TEMP=PYGAUS(PYXXW5,S12MIN,S12MAX,PREC)
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*TEMP
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=-13
|
|
IDLAM(LKNT,3)=14
|
|
IF(AXMI.GE.AXMJ+PMAS(15,1)+PMAS(16,1)) THEN
|
|
LKNT=LKNT+1
|
|
IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+15),1)
|
|
ELSE
|
|
XXM(11)=PMAS(PYCOMP(KSUSY2+15),1)
|
|
ENDIF
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+16),1)
|
|
IF(XXM(11).LT.AXMI) THEN
|
|
XXM(11)=1D6
|
|
ENDIF
|
|
IF(XXM(12).LT.AXMI) THEN
|
|
XXM(12)=1D6
|
|
ENDIF
|
|
TEMP=PYGAUS(PYXXW5,S12MIN,S12MAX,PREC)
|
|
XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*TEMP
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=-15
|
|
IDLAM(LKNT,3)=16
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...NOW, DO THE QUARKS
|
|
160 CONTINUE
|
|
FID=1
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=-0.5D0
|
|
XXM(7)=-SR2*(T3*ZMIX(IJ,2)-TANW*(T3-EI)*ZMIX(IJ,1))*UMIX(IX,1)
|
|
FID=1
|
|
EI=KCHG(FID,1)/3D0
|
|
T3=0.5D0
|
|
XXM(8)=-SR2*(T3*ZMIX(IJ,2)-TANW*(T3-EI)*ZMIX(IJ,1))*VMIX(IX,1)
|
|
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+1),1)
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+2),1)
|
|
IF( XXM(11).LT.AXMI .AND. XXM(12).LT.AXMI ) GOTO 170
|
|
IF(XXM(11).LT.AXMI) THEN
|
|
XXM(11)=1D6
|
|
ELSEIF(XXM(12).LT.AXMI) THEN
|
|
XXM(12)=1D6
|
|
ENDIF
|
|
IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXW5,S12MIN,S12MAX,PREC)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=-1
|
|
IDLAM(LKNT,3)=2
|
|
IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=-3
|
|
IDLAM(LKNT,3)=4
|
|
ENDIF
|
|
ENDIF
|
|
170 CONTINUE
|
|
ENDIF
|
|
180 CONTINUE
|
|
|
|
C...CHI+_I -> CHI0_J + H+
|
|
DO 190 IJ=1,4
|
|
XMJ=SMZ(IJ)
|
|
AXMJ=ABS(XMJ)
|
|
XMJ2=XMJ**2
|
|
XMHP=PMAS(ITHC,1)
|
|
XMHP2=XMHP**2
|
|
IF(AXMI.GE.AXMJ+XMHP) THEN
|
|
LKNT=LKNT+1
|
|
GL=CBETA*(ZMIX(IJ,4)*VMIX(IX,1)+(ZMIX(IJ,2)+
|
|
& ZMIX(IJ,1)*TANW)*VMIX(IX,2)/SR2)
|
|
GR=SBETA*(ZMIX(IJ,3)*UMIX(IX,1)-(ZMIX(IJ,2)+
|
|
& ZMIX(IJ,1)*TANW)*UMIX(IX,2)/SR2)
|
|
XLAM(LKNT)=PYX2XH(C1,XMI,XMJ,XMHP,GL,GR)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=ITHC
|
|
IDLAM(LKNT,3)=0
|
|
ELSE
|
|
|
|
ENDIF
|
|
190 CONTINUE
|
|
|
|
C...2-BODY DECAYS TO FERMION SFERMION
|
|
DO 200 J=1,16
|
|
IF(J.GE.7.AND.J.LE.10) GOTO 200
|
|
IF(MOD(J,2).EQ.0) THEN
|
|
KF1=KSUSY1+J-1
|
|
ELSE
|
|
KF1=KSUSY1+J+1
|
|
ENDIF
|
|
KF2=KF1+KSUSY1
|
|
XMSF1=PMAS(PYCOMP(KF1),1)
|
|
XMSF2=PMAS(PYCOMP(KF2),1)
|
|
XMF=PMAS(J,1)
|
|
IF(J.LE.6) THEN
|
|
FCOL=3D0
|
|
ELSE
|
|
FCOL=1D0
|
|
ENDIF
|
|
|
|
C...U~ D_L
|
|
IF(MOD(J,2).EQ.0) THEN
|
|
XMFP=PMAS(J-1,1)
|
|
AL=UMIX(IX,1)
|
|
BL=-XMF*VMIX(IX,2)/XMW/SBETA/SR2
|
|
AR=-XMFP*UMIX(IX,2)/XMW/CBETA/SR2
|
|
BR=0D0
|
|
ISF=J-1
|
|
ELSE
|
|
XMFP=PMAS(J+1,1)
|
|
AL=VMIX(IX,1)
|
|
BL=-XMF*UMIX(IX,2)/XMW/CBETA/SR2
|
|
BR=0D0
|
|
AR=-XMFP*VMIX(IX,2)/XMW/SBETA/SR2
|
|
ISF=J+1
|
|
ENDIF
|
|
|
|
C...~U_L D
|
|
IF(AXMI.GE.XMF+XMSF1) THEN
|
|
LKNT=LKNT+1
|
|
XMA2=XMSF1**2
|
|
XMB2=XMF**2
|
|
XL=PYLAMF(XMI2,XMA2,XMB2)
|
|
CA=AL*SFMIX(ISF,1)+AR*SFMIX(ISF,2)
|
|
CB=BL*SFMIX(ISF,1)+BR*SFMIX(ISF,2)
|
|
XLAM(LKNT)=FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)*
|
|
& (CA**2+CB**2)+4D0*CA*CB*XMF*XMI)
|
|
IDLAM(LKNT,3)=0
|
|
IF(MOD(J,2).EQ.0) THEN
|
|
IDLAM(LKNT,1)=-KF1
|
|
IDLAM(LKNT,2)=J
|
|
ELSE
|
|
IDLAM(LKNT,1)=KF1
|
|
IDLAM(LKNT,2)=-J
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...U~ D_R
|
|
IF(AXMI.GE.XMF+XMSF2) THEN
|
|
LKNT=LKNT+1
|
|
XMA2=XMSF2**2
|
|
XMB2=XMF**2
|
|
CA=AL*SFMIX(ISF,3)+AR*SFMIX(ISF,4)
|
|
CB=BL*SFMIX(ISF,3)+BR*SFMIX(ISF,4)
|
|
XL=PYLAMF(XMI2,XMA2,XMB2)
|
|
XLAM(LKNT)=FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)*
|
|
& (CA**2+CB**2)+4D0*CA*CB*XMF*XMI)
|
|
IDLAM(LKNT,3)=0
|
|
IF(MOD(J,2).EQ.0) THEN
|
|
IDLAM(LKNT,1)=-KF2
|
|
IDLAM(LKNT,2)=J
|
|
ELSE
|
|
IDLAM(LKNT,1)=KF2
|
|
IDLAM(LKNT,2)=-J
|
|
ENDIF
|
|
ENDIF
|
|
200 CONTINUE
|
|
|
|
C...3-BODY DECAY TO Q Q~' GLUINO, ONLY IF IT CANNOT PROCEED THROUGH
|
|
C...A 2-BODY -- 2-BODY CHAIN
|
|
XMJ=PMAS(PYCOMP(KSUSY1+21),1)
|
|
IF(AXMI.GE.XMJ) THEN
|
|
AXMJ=ABS(XMJ)
|
|
S12MIN=0D0
|
|
S12MAX=(AXMI-AXMJ)**2
|
|
XXM(1)=0D0
|
|
XXM(2)=XMJ
|
|
XXM(3)=0D0
|
|
XXM(4)=XMI
|
|
XXM(5)=0D0
|
|
XXM(6)=0D0
|
|
XXM(9)=1D6
|
|
XXM(10)=0D0
|
|
XXM(7)=UMIX(IX,1)*SR2
|
|
XXM(8)=VMIX(IX,1)*SR2
|
|
XXM(11)=PMAS(PYCOMP(KSUSY1+1),1)
|
|
XXM(12)=PMAS(PYCOMP(KSUSY1+2),1)
|
|
IF( XXM(11).LT.AXMI .OR. XXM(12).LT.AXMI ) GOTO 210
|
|
IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=4D0*C1*AS/XMI3/(16D0*PI)*
|
|
& PYGAUS(PYXXW5,S12MIN,S12MAX,PREC)
|
|
IDLAM(LKNT,1)=KSUSY1+21
|
|
IDLAM(LKNT,2)=-1
|
|
IDLAM(LKNT,3)=2
|
|
IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
IDLAM(LKNT,1)=KSUSY1+21
|
|
IDLAM(LKNT,2)=-3
|
|
IDLAM(LKNT,3)=4
|
|
ENDIF
|
|
ENDIF
|
|
210 CONTINUE
|
|
ENDIF
|
|
|
|
220 IKNT=LKNT
|
|
XLAM(0)=0D0
|
|
DO 230 I=1,IKNT
|
|
XLAM(0)=XLAM(0)+XLAM(I)
|
|
IF(XLAM(I).LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' XLAM(I) = ',XLAM(I),KCIN,
|
|
& (IDLAM(I,J),J=1,3)
|
|
XLAM(I)=0D0
|
|
ENDIF
|
|
230 CONTINUE
|
|
IF(XLAM(0).EQ.0D0) THEN
|
|
XLAM(0)=1D-6
|
|
WRITE(MSTU(11),*) ' XLAM(0) = ',XLAM(0)
|
|
WRITE(MSTU(11),*) LKNT
|
|
WRITE(MSTU(11),*) (XLAM(J),J=1,LKNT)
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYXXZ5
|
|
C...Calculates chi0 -> chi0 + f + ~f.
|
|
|
|
FUNCTION PYXXZ5(X)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
C...Commonblocks.
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/PYINTS/XXM(20)
|
|
SAVE /PYDAT1/,/PYINTS/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PYXXZ5,X
|
|
DOUBLE PRECISION XM12,XM22,XM32,S,S23,S13,WPROP2
|
|
DOUBLE PRECISION WW,WF1,WF2,WFL1,WFL2
|
|
DOUBLE PRECISION SIJ
|
|
DOUBLE PRECISION SR2,OL,OR,FLD,FLU,XMV,XMG,XMSU,XMSD
|
|
DOUBLE PRECISION LE,RE,LE2,RE2,OL2,OR2,FLI,FLJ,FRI,FRJ
|
|
DOUBLE PRECISION S23MIN,S23MAX,S23AVE,S23DEL
|
|
INTEGER I
|
|
DATA SR2/1.4142136D0/
|
|
|
|
C...Statement functions.
|
|
C...Integral from x to y of (t-a)(b-t) dt.
|
|
TINT(X,Y,A,B)=(X-Y)*(-(X**2+X*Y+Y**2)/3D0+(B+A)*(X+Y)/2D0-A*B)
|
|
C...Integral from x to y of (t-a)(b-t)/(t-c) dt.
|
|
TINT2(X,Y,A,B,C)=(X-Y)*(-0.5D0*(X+Y)+(B+A-C))-
|
|
&LOG(ABS((X-C)/(Y-C)))*(C-B)*(C-A)
|
|
C...Integral from x to y of (t-a)(b-t)/(t-c)**2 dt.
|
|
TINT3(X,Y,A,B,C)=-(X-Y)+(C-A)*(C-B)*(Y-X)/(X-C)/(Y-C)+
|
|
&(B+A-2D0*C)*LOG(ABS((X-C)/(Y-C)))
|
|
C...Integral from x to y of (t-a)/(b-t) dt.
|
|
UTINT(X,Y,A,B)=LOG(ABS((X-A)/(B-X)*(B-Y)/(Y-A)))/(B-A)
|
|
C...Integral from x to y of 1/(t-a) dt.
|
|
TPROP(X,Y,A)=LOG(ABS((X-A)/(Y-A)))
|
|
|
|
XM12=XXM(1)**2
|
|
XM22=XXM(2)**2
|
|
XM32=XXM(3)**2
|
|
S=XXM(4)**2
|
|
S13=X
|
|
|
|
S23AVE=XM22+XM32-0.5D0/X*(X+XM32-XM12)*(X+XM22-S)
|
|
S23DEL=0.5D0/X*SQRT( ( (X-XM12-XM32)**2-4D0*XM12*XM32)*
|
|
&( (X-XM22-S)**2 -4D0*XM22*S ) )
|
|
|
|
S23MIN=(S23AVE-S23DEL)
|
|
S23MAX=(S23AVE+S23DEL)
|
|
|
|
XMV=XXM(7)
|
|
XMG=XXM(8)
|
|
XMSD=XXM(5)**2
|
|
XMSU=XXM(6)**2
|
|
OL=XXM(9)
|
|
OR=XXM(10)
|
|
OL2=OL**2
|
|
OR2=OR**2
|
|
LE=XXM(11)
|
|
RE=XXM(12)
|
|
LE2=LE**2
|
|
RE2=RE**2
|
|
FLI=XXM(13)
|
|
FLJ=XXM(14)
|
|
FRI=XXM(15)
|
|
FRJ=XXM(16)
|
|
|
|
WPROP2=(S13-XMV**2)**2+(XMV*XMG)**2
|
|
SIJ=2D0*XXM(2)*XXM(4)*S13
|
|
|
|
IF(XMV.LE.1000D0) THEN
|
|
WW=2D0*(LE2+RE2)*(OL2)*( 2D0*TINT(S23MAX,S23MIN,XM22,S)
|
|
& +SIJ*(S23MAX-S23MIN) )/WPROP2
|
|
IF(XXM(5).LE.10000D0) THEN
|
|
WFL1=2D0*FLI*FLJ*OL*LE*( 2D0*TINT2(S23MAX,S23MIN,XM22,S,XMSD)
|
|
& + SIJ*TPROP(S23MAX,S23MIN,XMSD) )
|
|
WFL1=WFL1*(S13-XMV**2)/WPROP2
|
|
ELSE
|
|
WFL1=0D0
|
|
ENDIF
|
|
IF(XXM(6).LE.10000D0) THEN
|
|
WFL2=2D0*FRI*FRJ*OR*RE*( 2D0*TINT2(S23MAX,S23MIN,XM22,S,XMSU)
|
|
& + SIJ*TPROP(S23MAX,S23MIN,XMSU) )
|
|
WFL2=WFL2*(S13-XMV**2)/WPROP2
|
|
ELSE
|
|
WFL2=0D0
|
|
ENDIF
|
|
ELSE
|
|
WW=0D0
|
|
WFL1=0D0
|
|
WFL2=0D0
|
|
ENDIF
|
|
IF(XXM(5).LE.10000D0) THEN
|
|
WF1=0.5D0*(FLI*FLJ)**2*( 2D0*TINT3(S23MAX,S23MIN,XM22,S,XMSD)
|
|
& + SIJ*UTINT(S23MAX,S23MIN,XMSD,XM22+S-S13-XMSD) )
|
|
ELSE
|
|
WF1=0D0
|
|
ENDIF
|
|
IF(XXM(6).LE.10000D0) THEN
|
|
WF2=0.5D0*(FRI*FRJ)**2*( 2D0*TINT3(S23MAX,S23MIN,XM22,S,XMSU)
|
|
& + SIJ*UTINT(S23MAX,S23MIN,XMSU,XM22+S-S13-XMSU) )
|
|
ELSE
|
|
WF2=0D0
|
|
ENDIF
|
|
|
|
C...WFL1=0.0
|
|
C...WFL2=0.0
|
|
PYXXZ5=(WW+WF1+WF2+WFL1+WFL2)
|
|
IF(PYXXZ5.LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' NEGATIVE WT IN PYXXZ5 '
|
|
WRITE(MSTU(11),*) XXM(1),XXM(2),XXM(3),XXM(4)
|
|
WRITE(MSTU(11),*) (XXM(I),I=5,8)
|
|
WRITE(MSTU(11),*) (XXM(I),I=9,12)
|
|
WRITE(MSTU(11),*) (XXM(I),I=13,16)
|
|
WRITE(MSTU(11),*) WW,WF1,WF2,WFL1,WFL2
|
|
WRITE(MSTU(11),*) S23MIN,S23MAX
|
|
PYXXZ5=0D0
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYXXW5
|
|
C...Calculates chi0(+) -> chi+(0) + f + ~f'.
|
|
|
|
FUNCTION PYXXW5(X)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
C...Commonblocks.
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/PYINTS/XXM(20)
|
|
SAVE /PYDAT1/,/PYINTS/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PYXXW5,X
|
|
DOUBLE PRECISION XM12,XM22,XM32,S,S23,S13,S12,WPROP2
|
|
DOUBLE PRECISION WW,WU,WD,WWU,WWD,WUD
|
|
DOUBLE PRECISION SR2,OL,OR,FLD,FLU,XMV,XMG,XMSD,XMSU
|
|
DOUBLE PRECISION SIJ
|
|
DOUBLE PRECISION S23MIN,S23MAX,S23AVE,S23DEL
|
|
INTEGER IK
|
|
SAVE IK
|
|
DATA IK/0/
|
|
DATA SR2/1.4142136D0/
|
|
|
|
C...Statement functions.
|
|
C...Integral from x to y of (t-a)(b-t) dt.
|
|
TINT(X,Y,A,B)=(X-Y)*(-(X**2+X*Y+Y**2)/3D0+(B+A)*(X+Y)/2D0-A*B)
|
|
C...Integral from x to y of (t-a)(b-t)/(t-c) dt.
|
|
TINT2(X,Y,A,B,C)=(X-Y)*(-0.5D0*(X+Y)+(B+A-C))-
|
|
&LOG(ABS((X-C)/(Y-C)))*(C-B)*(C-A)
|
|
C...Integral from x to y of (t-a)(b-t)/(t-c)**2 dt.
|
|
TINT3(X,Y,A,B,C)=-(X-Y)+(C-A)*(C-B)*(Y-X)/(X-C)/(Y-C)+
|
|
&(B+A-2D0*C)*LOG(ABS((X-C)/(Y-C)))
|
|
C...Integral from x to y of (t-a)/(b-t) dt.
|
|
UTINT(X,Y,A,B)=LOG(ABS((X-A)/(B-X)*(B-Y)/(Y-A)))/(B-A)
|
|
C...Integral from x to y of 1/(t-a) dt.
|
|
TPROP(X,Y,A)=LOG(ABS((X-A)/(Y-A)))
|
|
|
|
XM12=XXM(1)**2
|
|
XM22=XXM(2)**2
|
|
XM32=XXM(3)**2
|
|
S=XXM(4)**2
|
|
S13=X
|
|
IF(XXM(1).EQ.0.AND.XXM(3).EQ.0D0) THEN
|
|
S23AVE=0.5D0*(XM22+S-S13)
|
|
S23DEL=0.5D0*SQRT( (X-XM22-S)**2-4D0*XM22*S )
|
|
ELSE
|
|
S23AVE=XM22+XM32-0.5D0/X*(X+XM32-XM12)*(X+XM22-S)
|
|
S23DEL=0.5D0/X*SQRT( ( (X-XM12-XM32)**2-4D0*XM12*XM32)*
|
|
& ( (X-XM22-S)**2 -4D0*XM22*S ) )
|
|
ENDIF
|
|
S23MIN=(S23AVE-S23DEL)
|
|
S23MAX=(S23AVE+S23DEL)
|
|
IF(S23DEL.LT.1D-3) THEN
|
|
PYXXW5=0D0
|
|
RETURN
|
|
ENDIF
|
|
XMV=XXM(9)
|
|
XMG=XXM(10)
|
|
XMSD=XXM(11)**2
|
|
XMSU=XXM(12)**2
|
|
OL=XXM(5)
|
|
OR=XXM(6)
|
|
FLD=XXM(7)
|
|
FLU=XXM(8)
|
|
|
|
WPROP2=((S13-XMV**2)**2+(XMV*XMG)**2)
|
|
SIJ=S13*XXM(2)*XXM(4)
|
|
IF(XMV.LE.1000D0) THEN
|
|
WW=(OR**2+OL**2)*TINT(S23MAX,S23MIN,XM22,S)
|
|
& -2D0*OL*OR*SIJ*(S23MAX-S23MIN)
|
|
WW=WW/WPROP2
|
|
IF(XXM(11).LE.10000D0) THEN
|
|
WWD=OL*SIJ*TPROP(S23MAX,S23MIN,XMSD)
|
|
& -OR*TINT2(S23MAX,S23MIN,XM22,S,XMSD)
|
|
WWD=-WWD*SR2*FLD
|
|
WWD=WWD*(S13-XMV**2)/WPROP2
|
|
ELSE
|
|
WWD=0D0
|
|
ENDIF
|
|
IF(XXM(12).LE.10000D0) THEN
|
|
WWU=OR*SIJ*TPROP(S23MAX,S23MIN,XMSU)
|
|
& -OL*TINT2(S23MAX,S23MIN,XM22,S,XMSU)
|
|
WWU=WWU*SR2*FLU
|
|
WWU=WWU*(S13-XMV**2)/WPROP2
|
|
ELSE
|
|
WWU=0D0
|
|
ENDIF
|
|
ELSE
|
|
WW=0D0
|
|
WWD=0D0
|
|
WWU=0D0
|
|
ENDIF
|
|
IF(XXM(12).LE.10000D0) THEN
|
|
WU=0.5D0*FLU**2*TINT3(S23MAX,S23MIN,XM22,S,XMSU)
|
|
ELSE
|
|
WU=0D0
|
|
ENDIF
|
|
IF(XXM(11).LE.10000D0) THEN
|
|
WD=0.5D0*FLD**2*TINT3(S23MAX,S23MIN,XM22,S,XMSD)
|
|
ELSE
|
|
WD=0D0
|
|
ENDIF
|
|
IF(XXM(11).LE.10000D0.AND.XXM(12).LE.10000D0) THEN
|
|
WUD=FLU*FLD*SIJ*UTINT(S23MAX,S23MIN,XMSD,XM22+S-S13-XMSU)
|
|
ELSE
|
|
WUD=0D0
|
|
ENDIF
|
|
|
|
PYXXW5=WW+WU+WD+WWU+WWD+WUD
|
|
|
|
IF(PYXXW5.LT.0D0) THEN
|
|
IF(IK.EQ.0) THEN
|
|
WRITE(MSTU(11),*) ' NEGATIVE WT IN PYXXW5 '
|
|
WRITE(MSTU(11),*) WW,WU,WD
|
|
WRITE(MSTU(11),*) WWD,WWU,WUD
|
|
WRITE(MSTU(11),*) SQRT(S13)
|
|
WRITE(MSTU(11),*) TINT(S23MAX,S23MIN,XM22,S)
|
|
IK=1
|
|
ENDIF
|
|
PYXXW5=0D0
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYXXGA
|
|
C...Calculates chi0_i -> chi0_j + gamma.
|
|
|
|
FUNCTION PYXXGA(C0,XM1,XM2,XMTR,XMTL)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PYXXGA,C0,XM1,XM2,XMTR,XMTL
|
|
DOUBLE PRECISION F1,F2
|
|
|
|
F1=(1D0+XMTR/(1D0-XMTR)*LOG(XMTR))/(1D0-XMTR)
|
|
F2=(1D0+XMTL/(1D0-XMTL)*LOG(XMTL))/(1D0-XMTL)
|
|
PYXXGA=C0*((XM1**2-XM2**2)/XM1)**3
|
|
PYXXGA=PYXXGA*(2D0/3D0*(F1+F2)-13D0/12D0)**2
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYX2XG
|
|
C...Calculates the decay rate for ino -> ino + gauge boson.
|
|
|
|
FUNCTION PYX2XG(C1,XM1,XM2,XM3,GL,GR)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PYX2XG,XM1,XM2,XM3,GL,GR
|
|
DOUBLE PRECISION XL,PYLAMF,C1
|
|
DOUBLE PRECISION XMI2,XMJ2,XMV2,XMI3
|
|
|
|
XMI2=XM1**2
|
|
XMI3=ABS(XM1**3)
|
|
XMJ2=XM2**2
|
|
XMV2=XM3**2
|
|
XL=PYLAMF(XMI2,XMJ2,XMV2)
|
|
PYX2XG=C1/8D0/XMI3*SQRT(XL)
|
|
&*((GL**2+GR**2)*(XL+3D0*XMV2*(XMI2+XMJ2-XMV2))-
|
|
&12D0*GL*GR*XM1*XM2*XMV2)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYX2XH
|
|
C...Calculates the decay rate for ino -> ino + H.
|
|
|
|
FUNCTION PYX2XH(C1,XM1,XM2,XM3,GL,GR)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PYX2XH,XM1,XM2,XM3,GL,GR
|
|
DOUBLE PRECISION XL,PYLAMF,C1
|
|
DOUBLE PRECISION XMI2,XMJ2,XMV2,XMI3
|
|
|
|
XMI2=XM1**2
|
|
XMI3=ABS(XM1**3)
|
|
XMJ2=XM2**2
|
|
XMV2=XM3**2
|
|
XL=PYLAMF(XMI2,XMJ2,XMV2)
|
|
PYX2XH=C1/8D0/XMI3*SQRT(XL)
|
|
&*((GL**2+GR**2)*(XMI2+XMJ2-XMV2)+
|
|
&4D0*GL*GR*XM1*XM2)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYXXZ2
|
|
C...Calculates chi+ -> chi+ + f + ~f.
|
|
|
|
FUNCTION PYXXZ2(X)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
C...Commonblocks.
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/PYINTS/XXM(20)
|
|
SAVE /PYDAT1/,/PYINTS/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PYXXZ2,X
|
|
DOUBLE PRECISION XM12,XM22,XM32,S,S23,S13,S12,WPROP2
|
|
DOUBLE PRECISION WW,WU,WD,WWU,WWD,WUD
|
|
DOUBLE PRECISION SR2,OL,OR,FLD,FLU,XMV,XMG,XMSL
|
|
DOUBLE PRECISION SIJ
|
|
DOUBLE PRECISION LE,RE,LE2,RE2,OL2,OR2,CT
|
|
DOUBLE PRECISION S23MIN,S23MAX,S23AVE,S23DEL
|
|
INTEGER I
|
|
DATA SR2/1.4142136D0/
|
|
|
|
C...Statement functions.
|
|
C...Integral from x to y of (t-a)(b-t) dt.
|
|
TINT(X,Y,A,B)=(X-Y)*(-(X**2+X*Y+Y**2)/3D0+(B+A)*(X+Y)/2D0-A*B)
|
|
C...Integral from x to y of (t-a)(b-t)/(t-c) dt.
|
|
TINT2(X,Y,A,B,C)=(X-Y)*(-0.5D0*(X+Y)+(B+A-C))-
|
|
&LOG(ABS((X-C)/(Y-C)))*(C-B)*(C-A)
|
|
C...Integral from x to y of (t-a)(b-t)/(t-c)**2 dt.
|
|
TINT3(X,Y,A,B,C)=-(X-Y)+(C-A)*(C-B)*(Y-X)/(X-C)/(Y-C)+
|
|
&(B+A-2D0*C)*LOG(ABS((X-C)/(Y-C)))
|
|
C...Integral from x to y of 1/(t-a) dt.
|
|
TPROP(X,Y,A)=LOG(ABS((X-A)/(Y-A)))
|
|
|
|
XM12=XXM(1)**2
|
|
XM22=XXM(2)**2
|
|
XM32=XXM(3)**2
|
|
S=XXM(4)**2
|
|
S13=X
|
|
IF(XXM(1).EQ.0.AND.XXM(3).EQ.0D0) THEN
|
|
S23AVE=0.5D0*(XM22+S-S13)
|
|
S23DEL=0.5D0*SQRT( (X-XM22-S)**2-4D0*XM22*S )
|
|
ELSE
|
|
S23AVE=XM22+XM32-0.5D0/X*(X+XM32-XM12)*(X+XM22-S)
|
|
S23DEL=0.5D0/X*SQRT( ( (X-XM12-XM32)**2-4D0*XM12*XM32)*
|
|
& ( (X-XM22-S)**2 -4D0*XM22*S ) )
|
|
ENDIF
|
|
S23MIN=(S23AVE-S23DEL)
|
|
S23MAX=(S23AVE+S23DEL)
|
|
IF(S23DEL.LT.1D-3) THEN
|
|
PYXXZ2=0D0
|
|
RETURN
|
|
ENDIF
|
|
|
|
XMV=XXM(9)
|
|
XMG=XXM(10)
|
|
XMSL=XXM(11)**2
|
|
OL=XXM(5)
|
|
OR=XXM(6)
|
|
OL2=OL**2
|
|
OR2=OR**2
|
|
LE=XXM(7)
|
|
RE=XXM(8)
|
|
LE2=LE**2
|
|
RE2=RE**2
|
|
CT=XXM(12)
|
|
|
|
WPROP2=(S13-XMV**2)**2+(XMV*XMG)**2
|
|
SIJ=XXM(2)*XXM(4)*S13
|
|
WW=(LE2+RE2)*(OR2+OL2)*2D0*TINT(S23MAX,S23MIN,XM22,S)
|
|
&- 4D0*(LE2+RE2)*OL*OR*SIJ*(S23MAX-S23MIN)
|
|
WW=WW/WPROP2
|
|
IF(XMSL.GT.1D4*S) THEN
|
|
WD=0D0
|
|
WWD=0D0
|
|
ELSE
|
|
WD=0.5D0*CT**2*TINT3(S23MAX,S23MIN,XM22,S,XMSL)
|
|
WWD=OL*TINT2(S23MAX,S23MIN,XM22,S,XMSL)-
|
|
& OR*SIJ*TPROP(S23MAX,S23MIN,XMSL)
|
|
WWD=2D0*WWD*LE*CT*(S13-XMV**2)/WPROP2
|
|
ENDIF
|
|
|
|
PYXXZ2=(WW+WD+WWD)
|
|
IF(PYXXZ2.LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' NEGATIVE WT IN PYXXZ2 '
|
|
WRITE(MSTU(11),*) WW,WD,WWD
|
|
WRITE(MSTU(11),*) S23MIN,S23MAX
|
|
WRITE(MSTU(11),*) (XXM(I),I=1,4)
|
|
WRITE(MSTU(11),*) (XXM(I),I=5,8)
|
|
WRITE(MSTU(11),*) (XXM(I),I=9,12)
|
|
PYXXZ2=0D0
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYHEXT
|
|
C...Calculates the non-standard decay modes of the Higgs boson.
|
|
|
|
SUBROUTINE PYHEXT(KFIN,XLAM,IDLAM,IKNT)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
C...Commonblocks.
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
|
|
COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
|
|
&SFMIX(16,4)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYMSSM/,/PYSSMT/
|
|
|
|
C...Local variables.
|
|
INTEGER KFIN
|
|
DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2,
|
|
&XMZ,XMZ2,AXMJ,AXMI
|
|
DOUBLE PRECISION XMFP,XMF1,XMF2,XMSL,XMG
|
|
DOUBLE PRECISION S12MIN,S12MAX
|
|
DOUBLE PRECISION XMI2,XMI3,XMJ2,XMH,XMH2,XMHP,XMHP2,XMA2,XMB2
|
|
DOUBLE PRECISION PYLAMF,XL,CF,EI
|
|
INTEGER IDU,IC,ILR,IFL
|
|
DOUBLE PRECISION TANW,XW,AEM,C1,AS
|
|
DOUBLE PRECISION PYH2XX,GHLL,GHRR,GHLR
|
|
DOUBLE PRECISION XLAM(0:200)
|
|
INTEGER IDLAM(200,3)
|
|
INTEGER LKNT,IX,IH,J,IJ,I,IKNT,IK
|
|
INTEGER ITH(4)
|
|
INTEGER KFNCHI(4),KFCCHI(2)
|
|
DOUBLE PRECISION ETAH(3),CH(3),DH(3),EH(3)
|
|
DOUBLE PRECISION SR2
|
|
DOUBLE PRECISION BETA,ALFA
|
|
DOUBLE PRECISION CBETA,SBETA,GR,GL,F12K,F21K,TANB
|
|
DOUBLE PRECISION PYALEM,PI,PYALPS
|
|
DOUBLE PRECISION AL,BL,AR,BR,ALP,ARP,BLP,BRP,ALR
|
|
DOUBLE PRECISION XMK,AXMK,XMK2,COSA,SINA,CW,XML
|
|
DOUBLE PRECISION XMUZ,ATRIT,ATRIB,ATRIL
|
|
DOUBLE PRECISION XMJL,XMJR,XM1,XM2
|
|
DATA ITH/25,35,36,37/
|
|
DATA ETAH/1D0,1D0,-1D0/
|
|
DATA SR2/1.4142136D0/
|
|
DATA PI/3.141592654D0/
|
|
DATA KFNCHI/1000022,1000023,1000025,1000035/
|
|
DATA KFCCHI/1000024,1000037/
|
|
|
|
C...COUNT THE NUMBER OF DECAY MODES
|
|
LKNT=IKNT
|
|
|
|
XMW=PMAS(24,1)
|
|
XMW2=XMW**2
|
|
XMZ=PMAS(23,1)
|
|
XMZ2=XMZ**2
|
|
XW=PARU(102)
|
|
TANW = SQRT(XW/(1D0-XW))
|
|
CW=SQRT(1D0-XW)
|
|
|
|
C...1 - 4 DEPENDING ON Higgs species.
|
|
IH=1
|
|
IF(KFIN.EQ.ITH(2)) IH=2
|
|
IF(KFIN.EQ.ITH(3)) IH=3
|
|
IF(KFIN.EQ.ITH(4)) IH=4
|
|
|
|
XMI=PMAS(KFIN,1)
|
|
XMI2=XMI**2
|
|
AXMI=ABS(XMI)
|
|
AEM=PYALEM(XMI2)
|
|
AS =PYALPS(XMI2)
|
|
C1=AEM/XW
|
|
XMI3=ABS(XMI**3)
|
|
|
|
TANB=RMSS(5)
|
|
BETA=ATAN(TANB)
|
|
CBETA=COS(BETA)
|
|
SBETA=TANB*CBETA
|
|
ALFA=RMSS(18)
|
|
COSA=COS(ALFA)
|
|
SINA=SIN(ALFA)
|
|
ATRIT=RMSS(16)
|
|
ATRIB=RMSS(15)
|
|
ATRIL=RMSS(17)
|
|
XMUZ=-RMSS(4)
|
|
|
|
IF(IH.EQ.4) GOTO 180
|
|
|
|
C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS
|
|
C...H0_K -> CHI0_I + CHI0_J
|
|
EH(1)=SINA
|
|
EH(2)=COSA
|
|
EH(3)=-SBETA
|
|
DH(1)=COSA
|
|
DH(2)=-SINA
|
|
DH(3)=CBETA
|
|
DO 110 IJ=1,4
|
|
XMJ=SMZ(IJ)
|
|
AXMJ=ABS(XMJ)
|
|
DO 100 IK=1,IJ
|
|
XMK=SMZ(IK)
|
|
AXMK=ABS(XMK)
|
|
IF(AXMI.GE.AXMJ+AXMK) THEN
|
|
LKNT=LKNT+1
|
|
F21K=0.5D0*
|
|
& EH(IH)*( ZMIX(IK,3)*ZMIX(IJ,2)+ZMIX(IJ,3)*ZMIX(IK,2)
|
|
& -TANW*(ZMIX(IK,3)*ZMIX(IJ,1)+ZMIX(IJ,3)*ZMIX(IK,1)) )+
|
|
& 0.5D0*DH(IH)*( ZMIX(IK,4)*ZMIX(IJ,2)+ZMIX(IJ,4)*ZMIX(IK,2)
|
|
& -TANW*(ZMIX(IK,4)*ZMIX(IJ,1)+ZMIX(IJ,4)*ZMIX(IK,1)) )
|
|
F12K=0.5D0*
|
|
& EH(IH)*(ZMIX(IJ,3)*ZMIX(IK,2)+ZMIX(IK,3)*ZMIX(IJ,2)
|
|
& -TANW*(ZMIX(IJ,3)*ZMIX(IK,1)+ZMIX(IK,3)*ZMIX(IJ,1)))+
|
|
& 0.5D0*DH(IH)*( ZMIX(IJ,4)*ZMIX(IK,2)+ZMIX(IK,4)*ZMIX(IJ,2)
|
|
& -TANW*(ZMIX(IJ,4)*ZMIX(IK,1)+ZMIX(IK,4)*ZMIX(IJ,1)) )
|
|
C...SIGN OF MASSES I,J
|
|
XML=XMK*ETAH(IH)
|
|
XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,XML,F12K,F21K)
|
|
IF(IJ.EQ.IK) XLAM(LKNT)=XLAM(LKNT)*0.5D0
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=KFNCHI(IK)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
C...H0_K -> CHI+_I CHI-_J
|
|
DO 130 IJ=1,2
|
|
XMJ=SMW(IJ)
|
|
AXMJ=ABS(XMJ)
|
|
DO 120 IK=1,2
|
|
XMK=SMW(IK)
|
|
AXMK=ABS(XMK)
|
|
IF(AXMI.GE.AXMJ+AXMK) THEN
|
|
LKNT=LKNT+1
|
|
F21K=(VMIX(IJ,1)*UMIX(IK,2)*EH(IH) -
|
|
& VMIX(IJ,2)*UMIX(IK,1)*DH(IH))/SR2
|
|
F12K=(VMIX(IK,1)*UMIX(IJ,2)*EH(IH) -
|
|
& VMIX(IK,2)*UMIX(IJ,1)*DH(IH))/SR2
|
|
XML=-XMK*ETAH(IH)
|
|
XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,XML,F12K,F21K)
|
|
IDLAM(LKNT,1)=KFCCHI(IJ)
|
|
IDLAM(LKNT,2)=-KFCCHI(IK)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
|
|
C...HIGGS TO SFERMION SFERMION
|
|
DO 160 IFL=1,16
|
|
IF(IFL.GE.7.AND.IFL.LE.10) GOTO 160
|
|
IJ=KSUSY1+IFL
|
|
XMJL=PMAS(PYCOMP(IJ),1)
|
|
XMJR=PMAS(PYCOMP(IJ+KSUSY1),1)
|
|
IF(AXMI.GE.2D0*MIN(XMJL,XMJR)) THEN
|
|
XMJ=XMJL
|
|
XMJ2=XMJ**2
|
|
XL=PYLAMF(XMI2,XMJ2,XMJ2)
|
|
XMF=PMAS(IFL,1)
|
|
EI=KCHG(IFL,1)/3D0
|
|
IDU=2-MOD(IFL,2)
|
|
|
|
IF(IH.EQ.1) THEN
|
|
IF(IDU.EQ.1) THEN
|
|
GHLL=-XMZ/CW*(0.5D0+EI*XW)*SIN(ALFA+BETA)+
|
|
& XMF**2/XMW*SINA/CBETA
|
|
GHRR=XMZ/CW*(EI*XW)*SIN(ALFA+BETA)+
|
|
& XMF**2/XMW*SINA/CBETA
|
|
IF(IFL.EQ.5) THEN
|
|
GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*COSA-
|
|
& ATRIB*SINA)
|
|
ELSEIF(IFL.EQ.15) THEN
|
|
GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*COSA-
|
|
& ATRIL*SINA)
|
|
ELSE
|
|
GHLR=0D0
|
|
ENDIF
|
|
ELSE
|
|
GHLL=XMZ/CW*(0.5D0-EI*XW)*SIN(ALFA+BETA)-
|
|
& XMF**2/XMW*COSA/SBETA
|
|
GHRR=XMZ/CW*(EI*XW)*SIN(ALFA+BETA)-
|
|
& XMF**2/XMW*COSA/SBETA
|
|
IF(IFL.EQ.6) THEN
|
|
GHLR=XMF/2D0/XMW/SBETA*(XMUZ*SINA-
|
|
& ATRIT*COSA)
|
|
ELSE
|
|
GHLR=0D0
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ELSEIF(IH.EQ.2) THEN
|
|
IF(IDU.EQ.1) THEN
|
|
GHLL=XMZ/CW*(0.5D0+EI*XW)*COS(ALFA+BETA)-
|
|
& XMF**2/XMW*COSA/CBETA
|
|
GHRR=-XMZ/CW*(EI*XW)*COS(ALFA+BETA)-
|
|
& XMF**2/XMW*COSA/CBETA
|
|
IF(IFL.EQ.5) THEN
|
|
GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*SINA+
|
|
& ATRIB*COSA)
|
|
ELSEIF(IFL.EQ.15) THEN
|
|
GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*SINA+
|
|
& ATRIL*COSA)
|
|
ELSE
|
|
GHLR=0D0
|
|
ENDIF
|
|
ELSE
|
|
GHLL=-XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)-
|
|
& XMF**2/XMW*SINA/SBETA
|
|
GHRR=-XMZ/CW*(EI*XW)*COS(ALFA+BETA)-
|
|
& XMF**2/XMW*SINA/SBETA
|
|
IF(IFL.EQ.6) THEN
|
|
GHLR=-XMF/2D0/XMW/SBETA*(XMUZ*COSA+
|
|
& ATRIT*SINA)
|
|
ELSE
|
|
GHLR=0D0
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ELSEIF(IH.EQ.3) THEN
|
|
GHLL=0D0
|
|
GHRR=0D0
|
|
GHLR=0D0
|
|
IF(IDU.EQ.1) THEN
|
|
IF(IFL.EQ.5) THEN
|
|
GHLR=XMF/2D0/XMW*(ATRIB*TANB-XMUZ)
|
|
ELSEIF(IFL.EQ.15) THEN
|
|
GHLR=XMF/2D0/XMW*(ATRIL*TANB-XMUZ)
|
|
ENDIF
|
|
ELSE
|
|
IF(IFL.EQ.6) THEN
|
|
GHLR=XMF/2D0/XMW*(ATRIT/TANB-XMUZ)
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
IF(IH.EQ.3) GOTO 140
|
|
|
|
AL=SFMIX(IFL,1)**2
|
|
AR=SFMIX(IFL,2)**2
|
|
ALR=SFMIX(IFL,1)*SFMIX(IFL,2)
|
|
IF(IFL.LE.6) THEN
|
|
CF=3D0
|
|
ELSE
|
|
CF=1D0
|
|
ENDIF
|
|
|
|
IF(AXMI.GE.2D0*XMJ) THEN
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*
|
|
& (GHLL*AL+GHRR*AR
|
|
& +2D0*GHLR*ALR)**2
|
|
IDLAM(LKNT,1)=IJ
|
|
IDLAM(LKNT,2)=-IJ
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
|
|
IF(AXMI.GE.2D0*XMJR) THEN
|
|
LKNT=LKNT+1
|
|
AL=SFMIX(IFL,3)**2
|
|
AR=SFMIX(IFL,4)**2
|
|
ALR=SFMIX(IFL,3)*SFMIX(IFL,4)
|
|
XMJ=XMJR
|
|
XMJ2=XMJ**2
|
|
XL=PYLAMF(XMI2,XMJ2,XMJ2)
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*
|
|
& (GHLL*AL+GHRR*AR
|
|
& +2D0*GHLR*ALR)**2
|
|
IDLAM(LKNT,1)=IJ+KSUSY1
|
|
IDLAM(LKNT,2)=-(IJ+KSUSY1)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
140 CONTINUE
|
|
|
|
IF(AXMI.GE.XMJL+XMJR) THEN
|
|
LKNT=LKNT+1
|
|
AL=SFMIX(IFL,1)*SFMIX(IFL,3)
|
|
AR=SFMIX(IFL,2)*SFMIX(IFL,4)
|
|
ALR=SFMIX(IFL,1)*SFMIX(IFL,4)+SFMIX(IFL,2)*SFMIX(IFL,3)
|
|
XMJ=XMJR
|
|
XMJ2=XMJ**2
|
|
XL=PYLAMF(XMI2,XMJ2,XMJL**2)
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*
|
|
& (GHLL*AL+GHRR*AR)**2
|
|
IDLAM(LKNT,1)=IJ
|
|
IDLAM(LKNT,2)=-(IJ+KSUSY1)
|
|
IDLAM(LKNT,3)=0
|
|
LKNT=LKNT+1
|
|
IDLAM(LKNT,1)=-IJ
|
|
IDLAM(LKNT,2)=IJ+KSUSY1
|
|
IDLAM(LKNT,3)=0
|
|
XLAM(LKNT)=XLAM(LKNT-1)
|
|
ENDIF
|
|
ENDIF
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
|
|
GOTO 230
|
|
180 CONTINUE
|
|
|
|
C...H+ -> CHI+_I + CHI0_J
|
|
DO 200 IJ=1,4
|
|
XMJ=SMZ(IJ)
|
|
AXMJ=ABS(XMJ)
|
|
XMJ2=XMJ**2
|
|
DO 190 IK=1,2
|
|
XMK=SMW(IK)
|
|
AXMK=ABS(XMK)
|
|
XMK2=XMK**2
|
|
IF(AXMI.GE.AXMJ+AXMK) THEN
|
|
LKNT=LKNT+1
|
|
GL=CBETA*(ZMIX(IJ,4)*VMIX(IK,1)+(ZMIX(IJ,2)+ZMIX(IJ,1)*
|
|
& TANW)*VMIX(IK,2)/SR2)
|
|
GR=SBETA*(ZMIX(IJ,3)*UMIX(IK,1)-(ZMIX(IJ,2)+ZMIX(IJ,1)*
|
|
& TANW)*UMIX(IK,2)/SR2)
|
|
XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,-XMK,GL,GR)
|
|
IDLAM(LKNT,1)=KFNCHI(IJ)
|
|
IDLAM(LKNT,2)=KFCCHI(IK)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
|
|
GL=-XMW/SR2*(SIN(2D0*BETA)-PMAS(6,1)**2/TANB/XMW2)
|
|
GR=-PMAS(6,1)/SR2/XMW*(XMUZ-ATRIT/TANB)
|
|
AL=0D0
|
|
AR=0D0
|
|
CF=3D0
|
|
|
|
C...H+ -> T_1 B_1~
|
|
XM1=PMAS(PYCOMP(KSUSY1+6),1)
|
|
XM2=PMAS(PYCOMP(KSUSY1+5),1)
|
|
IF(XMI.GE.XM1+XM2) THEN
|
|
XL=PYLAMF(XMI2,XM1**2,XM2**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*
|
|
& (GL*SFMIX(6,1)*SFMIX(5,1)+GR*SFMIX(6,2)*SFMIX(5,1))**2
|
|
IDLAM(LKNT,1)=KSUSY1+6
|
|
IDLAM(LKNT,2)=-(KSUSY1+5)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
|
|
C...H+ -> T_2 B_1~
|
|
XM1=PMAS(PYCOMP(KSUSY2+6),1)
|
|
XM2=PMAS(PYCOMP(KSUSY1+5),1)
|
|
IF(XMI.GE.XM1+XM2) THEN
|
|
XL=PYLAMF(XMI2,XM1**2,XM2**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*
|
|
& (GL*SFMIX(6,3)*SFMIX(5,1)+GR*SFMIX(6,4)*SFMIX(5,1))**2
|
|
IDLAM(LKNT,1)=KSUSY2+6
|
|
IDLAM(LKNT,2)=-(KSUSY1+5)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
|
|
C...H+ -> T_1 B_2~
|
|
XM1=PMAS(PYCOMP(KSUSY1+6),1)
|
|
XM2=PMAS(PYCOMP(KSUSY2+5),1)
|
|
IF(XMI.GE.XM1+XM2) THEN
|
|
XL=PYLAMF(XMI2,XM1**2,XM2**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*
|
|
& (GL*SFMIX(6,1)*SFMIX(5,3)+GR*SFMIX(6,2)*SFMIX(5,3))**2
|
|
IDLAM(LKNT,1)=KSUSY1+6
|
|
IDLAM(LKNT,2)=-(KSUSY2+5)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
|
|
C...H+ -> T_2 B_2~
|
|
XM1=PMAS(PYCOMP(KSUSY2+6),1)
|
|
XM2=PMAS(PYCOMP(KSUSY2+5),1)
|
|
IF(XMI.GE.XM1+XM2) THEN
|
|
XL=PYLAMF(XMI2,XM1**2,XM2**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*
|
|
& (GL*SFMIX(6,3)*SFMIX(5,3)+GR*SFMIX(6,4)*SFMIX(5,3))**2
|
|
IDLAM(LKNT,1)=KSUSY2+6
|
|
IDLAM(LKNT,2)=-(KSUSY2+5)
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
|
|
C...H+ -> UL DL~
|
|
GL=-XMW/SR2*SIN(2D0*BETA)
|
|
DO 210 IJ=1,3,2
|
|
XM1=PMAS(PYCOMP(KSUSY1+IJ),1)
|
|
XM2=PMAS(PYCOMP(KSUSY1+IJ+1),1)
|
|
IF(XMI.GE.XM1+XM2) THEN
|
|
XL=PYLAMF(XMI2,XM1**2,XM2**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*(GL)**2
|
|
IDLAM(LKNT,1)=-(KSUSY1+IJ)
|
|
IDLAM(LKNT,2)=KSUSY1+IJ+1
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
210 CONTINUE
|
|
|
|
C...H+ -> EL~ NUL
|
|
CF=1D0
|
|
DO 220 IJ=11,13,2
|
|
XM1=PMAS(PYCOMP(KSUSY1+IJ),1)
|
|
XM2=PMAS(PYCOMP(KSUSY1+IJ+1),1)
|
|
IF(XMI.GE.XM1+XM2) THEN
|
|
XL=PYLAMF(XMI2,XM1**2,XM2**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*(GL)**2
|
|
IDLAM(LKNT,1)=-(KSUSY1+IJ)
|
|
IDLAM(LKNT,2)=KSUSY1+IJ+1
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
220 CONTINUE
|
|
|
|
C...H+ -> TAU1 NUTAUL
|
|
XM1=PMAS(PYCOMP(KSUSY1+15),1)
|
|
XM2=PMAS(PYCOMP(KSUSY1+16),1)
|
|
IF(XMI.GE.XM1+XM2) THEN
|
|
XL=PYLAMF(XMI2,XM1**2,XM2**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*(GL)**2*SFMIX(15,1)**2
|
|
IDLAM(LKNT,1)=-(KSUSY1+15)
|
|
IDLAM(LKNT,2)= KSUSY1+16
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
|
|
C...H+ -> TAU2 NUTAUL
|
|
XM1=PMAS(PYCOMP(KSUSY2+15),1)
|
|
XM2=PMAS(PYCOMP(KSUSY1+16),1)
|
|
IF(XMI.GE.XM1+XM2) THEN
|
|
XL=PYLAMF(XMI2,XM1**2,XM2**2)
|
|
LKNT=LKNT+1
|
|
XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*(GL)**2*SFMIX(15,3)**2
|
|
IDLAM(LKNT,1)=-(KSUSY2+15)
|
|
IDLAM(LKNT,2)= KSUSY1+16
|
|
IDLAM(LKNT,3)=0
|
|
ENDIF
|
|
|
|
230 CONTINUE
|
|
IKNT=LKNT
|
|
XLAM(0)=0D0
|
|
DO 240 I=1,IKNT
|
|
IF(XLAM(I).LE.0D0) XLAM(I)=0D0
|
|
XLAM(0)=XLAM(0)+XLAM(I)
|
|
240 CONTINUE
|
|
IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYH2XX
|
|
C...Calculates the decay rate for a Higgs to an ino pair.
|
|
|
|
FUNCTION PYH2XX(C1,XM1,XM2,XM3,GL,GR)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PYH2XX,XM1,XM2,XM3,GL,GR
|
|
DOUBLE PRECISION XL,PYLAMF,C1
|
|
DOUBLE PRECISION XMI2,XMJ2,XMK2,XMI3
|
|
|
|
XMI2=XM1**2
|
|
XMI3=ABS(XM1**3)
|
|
XMJ2=XM2**2
|
|
XMK2=XM3**2
|
|
XL=PYLAMF(XMI2,XMJ2,XMK2)
|
|
PYH2XX=C1/4D0/XMI3*SQRT(XL)
|
|
&*((GL**2+GR**2)*(XMI2-XMJ2-XMK2)-
|
|
&4D0*GL*GR*XM3*XM2)
|
|
IF(PYH2XX.LT.0D0) THEN
|
|
WRITE(MSTU(11),*) ' NEGATIVE WIDTH IN PYH2XX '
|
|
WRITE(MSTU(11),*) XMI2,XMJ2,XMK2,GL,GR,XM1,XM2,XM3
|
|
STOP
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGAUS
|
|
C...Integration by adaptive Gaussian quadrature.
|
|
C...Adapted from the CERNLIB DGAUSS routine by K.S. Kolbig.
|
|
|
|
FUNCTION PYGAUS(F, A, B, EPS)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local declarations.
|
|
EXTERNAL F
|
|
DOUBLE PRECISION W(12), X(12)
|
|
DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/
|
|
DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/
|
|
DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/
|
|
DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/
|
|
DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/
|
|
DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/
|
|
DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/
|
|
DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/
|
|
DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/
|
|
DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/
|
|
DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/
|
|
DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/
|
|
|
|
C...The Gaussian quadrature algorithm.
|
|
H = 0D0
|
|
IF(B .EQ. A) GO TO 140
|
|
CONST = 5D-3 / ABS(B-A)
|
|
BB = A
|
|
100 CONTINUE
|
|
AA = BB
|
|
BB = B
|
|
110 CONTINUE
|
|
C1 = 0.5D0*(BB+AA)
|
|
C2 = 0.5D0*(BB-AA)
|
|
S8 = 0D0
|
|
DO 120 I = 1, 4
|
|
U = C2*X(I)
|
|
S8 = S8 + W(I) * (F(C1+U) + F(C1-U))
|
|
120 CONTINUE
|
|
S16 = 0D0
|
|
DO 130 I = 5, 12
|
|
U = C2*X(I)
|
|
S16 = S16 + W(I) * (F(C1+U) + F(C1-U))
|
|
130 CONTINUE
|
|
S16 = C2*S16
|
|
IF(DABS(S16-C2*S8) .LE. EPS*(1D0+DABS(S16))) THEN
|
|
H = H + S16
|
|
IF(BB .NE. B) GO TO 100
|
|
ELSE
|
|
BB = C1
|
|
IF(1D0 + CONST*ABS(C2) .NE. 1D0) GO TO 110
|
|
H = 0D0
|
|
CALL PYERRM(18,'(PYGAUS:) too high accuracy required')
|
|
GO TO 140
|
|
ENDIF
|
|
140 CONTINUE
|
|
PYGAUS = H
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYSIMP
|
|
C...Simpson formula for an integral.
|
|
|
|
FUNCTION PYSIMP(Y,X0,X1,N)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION Y,X0,X1,H,S
|
|
DIMENSION Y(0:N)
|
|
|
|
S=0D0
|
|
H=(X1-X0)/N
|
|
DO 100 I=0,N-2,2
|
|
S=S+Y(I)+4D0*Y(I+1)+Y(I+2)
|
|
100 CONTINUE
|
|
PYSIMP=S*H/3D0
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYLAMF
|
|
C...The standard lambda function.
|
|
|
|
FUNCTION PYLAMF(X,Y,Z)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION PYLAMF,X,Y,Z
|
|
|
|
PYLAMF=(X-(Y+Z))**2-4D0*Y*Z
|
|
IF(PYLAMF.LT.0D0) PYLAMF=0D0
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYTBDY
|
|
C...Generates 3-body decays of gauginos.
|
|
|
|
SUBROUTINE PYTBDY(XM)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/
|
|
|
|
C...Local variables.
|
|
DOUBLE PRECISION XM(5)
|
|
DOUBLE PRECISION S12MIN,S12MAX,YJACO1,S23AVE,S23DF1,S23DF2
|
|
DOUBLE PRECISION D1,D2,D3,P1,P2,P3,CTHE1,STHE1,CTHE3,STHE3
|
|
DOUBLE PRECISION CPHI1,SPHI1
|
|
DOUBLE PRECISION S23DEL,EPS
|
|
DOUBLE PRECISION GOLDEN,AX,BX,CX,TOL,XMIN,R,C
|
|
PARAMETER (R=0.61803399D0,C=1D0-R,TOL=1D-3)
|
|
DOUBLE PRECISION F1,F2,X0,X1,X2,X3
|
|
DATA EPS/1D-6/
|
|
|
|
C...GENERATE S12
|
|
S12MIN=(XM(1)+XM(2))**2
|
|
S12MAX=(XM(5)-XM(3))**2
|
|
YJACO1=S12MAX-S12MIN
|
|
|
|
C...FIND S12*
|
|
AX=S12MIN
|
|
CX=S12MAX
|
|
BX=S12MIN+0.5D0*YJACO1
|
|
X0=AX
|
|
X3=CX
|
|
IF(ABS(CX-BX).GT.ABS(BX-AX))THEN
|
|
X1=BX
|
|
X2=BX+C*(CX-BX)
|
|
ELSE
|
|
X2=BX
|
|
X1=BX-C*(BX-AX)
|
|
ENDIF
|
|
|
|
C...SOLVE FOR F1 AND F2
|
|
S23DF1=(X1-XM(2)**2-XM(1)**2)**2
|
|
&-(2D0*XM(1)*XM(2))**2
|
|
S23DF2=(X1-XM(3)**2-XM(5)**2)**2
|
|
&-(2D0*XM(3)*XM(5))**2
|
|
S23DF1=S23DF1*EPS
|
|
S23DF2=S23DF2*EPS
|
|
S23DEL=SQRT(S23DF1*S23DF2)/(2D0*X1)
|
|
F1=-2D0*S23DEL/EPS
|
|
S23DF1=(X2-XM(2)**2-XM(1)**2)**2
|
|
&-(2D0*XM(1)*XM(2))**2
|
|
S23DF2=(X2-XM(3)**2-XM(5)**2)**2
|
|
&-(2D0*XM(3)*XM(5))**2
|
|
S23DF1=S23DF1*EPS
|
|
S23DF2=S23DF2*EPS
|
|
S23DEL=SQRT(S23DF1*S23DF2)/(2D0*X2)
|
|
F2=-2D0*S23DEL/EPS
|
|
|
|
100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2)))THEN
|
|
IF(F2.LT.F1)THEN
|
|
X0=X1
|
|
X1=X2
|
|
X2=R*X1+C*X3
|
|
F1=F2
|
|
S23DF1=(X2-XM(2)**2-XM(1)**2)**2
|
|
& -(2D0*XM(1)*XM(2))**2
|
|
S23DF2=(X2-XM(3)**2-XM(5)**2)**2
|
|
& -(2D0*XM(3)*XM(5))**2
|
|
S23DF1=S23DF1*EPS
|
|
S23DF2=S23DF2*EPS
|
|
S23DEL=SQRT(S23DF1*S23DF2)/(2D0*X2)
|
|
F2=-2D0*S23DEL/EPS
|
|
ELSE
|
|
X3=X2
|
|
X2=X1
|
|
X1=R*X2+C*X0
|
|
F2=F1
|
|
S23DF1=(X1-XM(2)**2-XM(1)**2)**2
|
|
& -(2D0*XM(1)*XM(2))**2
|
|
S23DF2=(X1-XM(3)**2-XM(5)**2)**2
|
|
& -(2D0*XM(3)*XM(5))**2
|
|
S23DF1=S23DF1*EPS
|
|
S23DF2=S23DF2*EPS
|
|
S23DEL=SQRT(S23DF1*S23DF2)/(2D0*X1)
|
|
F1=-2D0*S23DEL/EPS
|
|
ENDIF
|
|
GOTO 100
|
|
ENDIF
|
|
C...WE WANT THE MAXIMUM, NOT THE MINIMUM
|
|
IF(F1.LT.F2)THEN
|
|
GOLDEN=-F1
|
|
XMIN=X1
|
|
ELSE
|
|
GOLDEN=-F2
|
|
XMIN=X2
|
|
ENDIF
|
|
|
|
IKNT=0
|
|
110 S12=S12MIN+PYR(0)*YJACO1
|
|
IKNT=IKNT+1
|
|
C...GENERATE S23
|
|
S23AVE=XM(2)**2+XM(3)**2-(S12+XM(2)**2-XM(1)**2)
|
|
&*(S12+XM(3)**2-XM(5)**2)/(2D0*S12)
|
|
S23DF1=(S12-XM(2)**2-XM(1)**2)**2
|
|
&-(2D0*XM(1)*XM(2))**2
|
|
S23DF2=(S12-XM(3)**2-XM(5)**2)**2
|
|
&-(2D0*XM(3)*XM(5))**2
|
|
S23DF1=S23DF1*EPS
|
|
S23DF2=S23DF2*EPS
|
|
S23DEL=SQRT(S23DF1*S23DF2)/(2D0*S12)
|
|
S23DEL=S23DEL/EPS
|
|
S23MIN=S23AVE-S23DEL
|
|
S23MAX=S23AVE+S23DEL
|
|
YJACO2=S23MAX-S23MIN
|
|
S23=S23MIN+PYR(0)*YJACO2
|
|
|
|
C...CHECK THE SAMPLING
|
|
IF(IKNT.GT.100) THEN
|
|
WRITE(MSTU(11),*) ' IKNT > 100 IN PYTBDY '
|
|
GOTO 120
|
|
ENDIF
|
|
IF(YJACO2.LT.PYR(0)*GOLDEN) GOTO 110
|
|
120 D3=(XM(5)**2+XM(3)**2-S12)/(2D0*XM(5))
|
|
D1=(XM(5)**2+XM(1)**2-S23)/(2D0*XM(5))
|
|
D2=XM(5)-D1-D3
|
|
P1=SQRT(D1*D1-XM(1)**2)
|
|
P2=SQRT(D2*D2-XM(2)**2)
|
|
P3=SQRT(D3*D3-XM(3)**2)
|
|
CTHE1=2D0*PYR(0)-1D0
|
|
ANG1=2D0*PYR(0)*PARU(1)
|
|
CPHI1=COS(ANG1)
|
|
SPHI1=SIN(ANG1)
|
|
ARG=1D0-CTHE1**2
|
|
IF(ARG.LT.0D0.AND.ARG.GT.-1D-3) ARG=0D0
|
|
STHE1=SQRT(ARG)
|
|
P(N+1,1)=P1*STHE1*CPHI1
|
|
P(N+1,2)=P1*STHE1*SPHI1
|
|
P(N+1,3)=P1*CTHE1
|
|
P(N+1,4)=D1
|
|
|
|
C...GET CPHI3
|
|
ANG3=2D0*PYR(0)*PARU(1)
|
|
CPHI3=COS(ANG3)
|
|
SPHI3=SIN(ANG3)
|
|
CTHE3=(P2**2-P1**2-P3**2)/2D0/P1/P3
|
|
ARG=1D0-CTHE3**2
|
|
IF(ARG.LT.0D0.AND.ARG.GT.-1D-3) ARG=0D0
|
|
STHE3=SQRT(ARG)
|
|
P(N+3,1)=-P3*STHE3*CPHI3*CTHE1*CPHI1
|
|
&+P3*STHE3*SPHI3*SPHI1
|
|
&+P3*CTHE3*STHE1*CPHI1
|
|
P(N+3,2)=-P3*STHE3*CPHI3*CTHE1*SPHI1
|
|
&-P3*STHE3*SPHI3*CPHI1
|
|
&+P3*CTHE3*STHE1*SPHI1
|
|
P(N+3,3)=P3*STHE3*CPHI3*STHE1
|
|
&+P3*CTHE3*CTHE1
|
|
P(N+3,4)=D3
|
|
|
|
DO 130 I=1,3
|
|
P(N+2,I)=-P(N+1,I)-P(N+3,I)
|
|
130 CONTINUE
|
|
P(N+2,4)=D2
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PY1ENT
|
|
C...Stores one parton/particle in commonblock PYJETS.
|
|
|
|
SUBROUTINE PY1ENT(IP,KF,PE,THE,PHI)
|
|
|
|
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...Standard checks.
|
|
MSTU(28)=0
|
|
IF(MSTU(12).GE.1) CALL PYLIST(0)
|
|
IPA=MAX(1,IABS(IP))
|
|
IF(IPA.GT.MSTU(4)) CALL PYERRM(21,
|
|
&'(PY1ENT:) writing outside PYJETS memory')
|
|
KC=PYCOMP(KF)
|
|
IF(KC.EQ.0) CALL PYERRM(12,'(PY1ENT:) unknown flavour code')
|
|
|
|
C...Find mass. Reset K, P and V vectors.
|
|
PM=0D0
|
|
IF(MSTU(10).EQ.1) PM=P(IPA,5)
|
|
IF(MSTU(10).GE.2) PM=PYMASS(KF)
|
|
DO 100 J=1,5
|
|
K(IPA,J)=0
|
|
P(IPA,J)=0D0
|
|
V(IPA,J)=0D0
|
|
100 CONTINUE
|
|
|
|
C...Store parton/particle in K and P vectors.
|
|
K(IPA,1)=1
|
|
IF(IP.LT.0) K(IPA,1)=2
|
|
K(IPA,2)=KF
|
|
P(IPA,5)=PM
|
|
P(IPA,4)=MAX(PE,PM)
|
|
PA=SQRT(P(IPA,4)**2-P(IPA,5)**2)
|
|
P(IPA,1)=PA*SIN(THE)*COS(PHI)
|
|
P(IPA,2)=PA*SIN(THE)*SIN(PHI)
|
|
P(IPA,3)=PA*COS(THE)
|
|
|
|
C...Set N. Optionally fragment/decay.
|
|
N=IPA
|
|
IF(IP.EQ.0) CALL PYEXEC
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PY2ENT
|
|
C...Stores two partons/particles in their CM frame,
|
|
C...with the first along the +z axis.
|
|
|
|
SUBROUTINE PY2ENT(IP,KF1,KF2,PECM)
|
|
|
|
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...Standard checks.
|
|
MSTU(28)=0
|
|
IF(MSTU(12).GE.1) CALL PYLIST(0)
|
|
IPA=MAX(1,IABS(IP))
|
|
IF(IPA.GT.MSTU(4)-1) CALL PYERRM(21,
|
|
&'(PY2ENT:) writing outside PYJETS memory')
|
|
KC1=PYCOMP(KF1)
|
|
KC2=PYCOMP(KF2)
|
|
IF(KC1.EQ.0.OR.KC2.EQ.0) CALL PYERRM(12,
|
|
&'(PY2ENT:) unknown flavour code')
|
|
|
|
C...Find masses. Reset K, P and V vectors.
|
|
PM1=0D0
|
|
IF(MSTU(10).EQ.1) PM1=P(IPA,5)
|
|
IF(MSTU(10).GE.2) PM1=PYMASS(KF1)
|
|
PM2=0D0
|
|
IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
|
|
IF(MSTU(10).GE.2) PM2=PYMASS(KF2)
|
|
DO 110 I=IPA,IPA+1
|
|
DO 100 J=1,5
|
|
K(I,J)=0
|
|
P(I,J)=0D0
|
|
V(I,J)=0D0
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
C...Check flavours.
|
|
KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
|
|
KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
|
|
IF(MSTU(19).EQ.1) THEN
|
|
MSTU(19)=0
|
|
ELSE
|
|
IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL PYERRM(2,
|
|
& '(PY2ENT:) unphysical flavour combination')
|
|
ENDIF
|
|
K(IPA,2)=KF1
|
|
K(IPA+1,2)=KF2
|
|
|
|
C...Store partons/particles in K vectors for normal case.
|
|
IF(IP.GE.0) THEN
|
|
K(IPA,1)=1
|
|
IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2
|
|
K(IPA+1,1)=1
|
|
|
|
C...Store partons in K vectors for parton shower evolution.
|
|
ELSE
|
|
K(IPA,1)=3
|
|
K(IPA+1,1)=3
|
|
K(IPA,4)=MSTU(5)*(IPA+1)
|
|
K(IPA,5)=K(IPA,4)
|
|
K(IPA+1,4)=MSTU(5)*IPA
|
|
K(IPA+1,5)=K(IPA+1,4)
|
|
ENDIF
|
|
|
|
C...Check kinematics and store partons/particles in P vectors.
|
|
IF(PECM.LE.PM1+PM2) CALL PYERRM(13,
|
|
&'(PY2ENT:) energy smaller than sum of masses')
|
|
PA=SQRT(MAX(0D0,(PECM**2-PM1**2-PM2**2)**2-(2D0*PM1*PM2)**2))/
|
|
&(2D0*PECM)
|
|
P(IPA,3)=PA
|
|
P(IPA,4)=SQRT(PM1**2+PA**2)
|
|
P(IPA,5)=PM1
|
|
P(IPA+1,3)=-PA
|
|
P(IPA+1,4)=SQRT(PM2**2+PA**2)
|
|
P(IPA+1,5)=PM2
|
|
|
|
C...Set N. Optionally fragment/decay.
|
|
N=IPA+1
|
|
IF(IP.EQ.0) CALL PYEXEC
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PY3ENT
|
|
C...Stores three partons or particles in their CM frame,
|
|
C...with the first along the +z axis and the third in the (x,z)
|
|
C...plane with x > 0.
|
|
|
|
SUBROUTINE PY3ENT(IP,KF1,KF2,KF3,PECM,X1,X3)
|
|
|
|
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...Standard checks.
|
|
MSTU(28)=0
|
|
IF(MSTU(12).GE.1) CALL PYLIST(0)
|
|
IPA=MAX(1,IABS(IP))
|
|
IF(IPA.GT.MSTU(4)-2) CALL PYERRM(21,
|
|
&'(PY3ENT:) writing outside PYJETS memory')
|
|
KC1=PYCOMP(KF1)
|
|
KC2=PYCOMP(KF2)
|
|
KC3=PYCOMP(KF3)
|
|
IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL PYERRM(12,
|
|
&'(PY3ENT:) unknown flavour code')
|
|
|
|
C...Find masses. Reset K, P and V vectors.
|
|
PM1=0D0
|
|
IF(MSTU(10).EQ.1) PM1=P(IPA,5)
|
|
IF(MSTU(10).GE.2) PM1=PYMASS(KF1)
|
|
PM2=0D0
|
|
IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
|
|
IF(MSTU(10).GE.2) PM2=PYMASS(KF2)
|
|
PM3=0D0
|
|
IF(MSTU(10).EQ.1) PM3=P(IPA+2,5)
|
|
IF(MSTU(10).GE.2) PM3=PYMASS(KF3)
|
|
DO 110 I=IPA,IPA+2
|
|
DO 100 J=1,5
|
|
K(I,J)=0
|
|
P(I,J)=0D0
|
|
V(I,J)=0D0
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
C...Check flavours.
|
|
KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
|
|
KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
|
|
KQ3=KCHG(KC3,2)*ISIGN(1,KF3)
|
|
IF(MSTU(19).EQ.1) THEN
|
|
MSTU(19)=0
|
|
ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0) THEN
|
|
ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.(KQ1+KQ3.EQ.0.OR.
|
|
& KQ1+KQ3.EQ.4)) THEN
|
|
ELSE
|
|
CALL PYERRM(2,'(PY3ENT:) unphysical flavour combination')
|
|
ENDIF
|
|
K(IPA,2)=KF1
|
|
K(IPA+1,2)=KF2
|
|
K(IPA+2,2)=KF3
|
|
|
|
C...Store partons/particles in K vectors for normal case.
|
|
IF(IP.GE.0) THEN
|
|
K(IPA,1)=1
|
|
IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0)) K(IPA,1)=2
|
|
K(IPA+1,1)=1
|
|
IF(KQ2.NE.0.AND.KQ3.NE.0) K(IPA+1,1)=2
|
|
K(IPA+2,1)=1
|
|
|
|
C...Store partons in K vectors for parton shower evolution.
|
|
ELSE
|
|
K(IPA,1)=3
|
|
K(IPA+1,1)=3
|
|
K(IPA+2,1)=3
|
|
KCS=4
|
|
IF(KQ1.EQ.-1) KCS=5
|
|
K(IPA,KCS)=MSTU(5)*(IPA+1)
|
|
K(IPA,9-KCS)=MSTU(5)*(IPA+2)
|
|
K(IPA+1,KCS)=MSTU(5)*(IPA+2)
|
|
K(IPA+1,9-KCS)=MSTU(5)*IPA
|
|
K(IPA+2,KCS)=MSTU(5)*IPA
|
|
K(IPA+2,9-KCS)=MSTU(5)*(IPA+1)
|
|
ENDIF
|
|
|
|
C...Check kinematics.
|
|
MKERR=0
|
|
IF(0.5D0*X1*PECM.LE.PM1.OR.0.5D0*(2D0-X1-X3)*PECM.LE.PM2.OR.
|
|
&0.5D0*X3*PECM.LE.PM3) MKERR=1
|
|
PA1=SQRT(MAX(1D-10,(0.5D0*X1*PECM)**2-PM1**2))
|
|
PA2=SQRT(MAX(1D-10,(0.5D0*(2D0-X1-X3)*PECM)**2-PM2**2))
|
|
PA3=SQRT(MAX(1D-10,(0.5D0*X3*PECM)**2-PM3**2))
|
|
CTHE2=(PA3**2-PA1**2-PA2**2)/(2D0*PA1*PA2)
|
|
CTHE3=(PA2**2-PA1**2-PA3**2)/(2D0*PA1*PA3)
|
|
IF(ABS(CTHE2).GE.1.001D0.OR.ABS(CTHE3).GE.1.001D0) MKERR=1
|
|
CTHE3=MAX(-1D0,MIN(1D0,CTHE3))
|
|
IF(MKERR.NE.0) CALL PYERRM(13,
|
|
&'(PY3ENT:) unphysical kinematical variable setup')
|
|
|
|
C...Store partons/particles in P vectors.
|
|
P(IPA,3)=PA1
|
|
P(IPA,4)=SQRT(PA1**2+PM1**2)
|
|
P(IPA,5)=PM1
|
|
P(IPA+2,1)=PA3*SQRT(1D0-CTHE3**2)
|
|
P(IPA+2,3)=PA3*CTHE3
|
|
P(IPA+2,4)=SQRT(PA3**2+PM3**2)
|
|
P(IPA+2,5)=PM3
|
|
P(IPA+1,1)=-P(IPA+2,1)
|
|
P(IPA+1,3)=-P(IPA,3)-P(IPA+2,3)
|
|
P(IPA+1,4)=SQRT(P(IPA+1,1)**2+P(IPA+1,3)**2+PM2**2)
|
|
P(IPA+1,5)=PM2
|
|
|
|
C...Set N. Optionally fragment/decay.
|
|
N=IPA+2
|
|
IF(IP.EQ.0) CALL PYEXEC
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PY4ENT
|
|
C...Stores four partons or particles in their CM frame, with
|
|
C...the first along the +z axis, the last in the xz plane with x > 0
|
|
C...and the second having y < 0 and y > 0 with equal probability.
|
|
|
|
SUBROUTINE PY4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14)
|
|
|
|
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...Standard checks.
|
|
MSTU(28)=0
|
|
IF(MSTU(12).GE.1) CALL PYLIST(0)
|
|
IPA=MAX(1,IABS(IP))
|
|
IF(IPA.GT.MSTU(4)-3) CALL PYERRM(21,
|
|
&'(PY4ENT:) writing outside PYJETS momory')
|
|
KC1=PYCOMP(KF1)
|
|
KC2=PYCOMP(KF2)
|
|
KC3=PYCOMP(KF3)
|
|
KC4=PYCOMP(KF4)
|
|
IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL PYERRM(12,
|
|
&'(PY4ENT:) unknown flavour code')
|
|
|
|
C...Find masses. Reset K, P and V vectors.
|
|
PM1=0D0
|
|
IF(MSTU(10).EQ.1) PM1=P(IPA,5)
|
|
IF(MSTU(10).GE.2) PM1=PYMASS(KF1)
|
|
PM2=0D0
|
|
IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
|
|
IF(MSTU(10).GE.2) PM2=PYMASS(KF2)
|
|
PM3=0D0
|
|
IF(MSTU(10).EQ.1) PM3=P(IPA+2,5)
|
|
IF(MSTU(10).GE.2) PM3=PYMASS(KF3)
|
|
PM4=0D0
|
|
IF(MSTU(10).EQ.1) PM4=P(IPA+3,5)
|
|
IF(MSTU(10).GE.2) PM4=PYMASS(KF4)
|
|
DO 110 I=IPA,IPA+3
|
|
DO 100 J=1,5
|
|
K(I,J)=0
|
|
P(I,J)=0D0
|
|
V(I,J)=0D0
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
C...Check flavours.
|
|
KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
|
|
KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
|
|
KQ3=KCHG(KC3,2)*ISIGN(1,KF3)
|
|
KQ4=KCHG(KC4,2)*ISIGN(1,KF4)
|
|
IF(MSTU(19).EQ.1) THEN
|
|
MSTU(19)=0
|
|
ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0.AND.KQ4.EQ.0) THEN
|
|
ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.KQ3.EQ.2.AND.(KQ1+KQ4.EQ.0.OR.
|
|
& KQ1+KQ4.EQ.4)) THEN
|
|
ELSEIF(KQ1.NE.0.AND.KQ1+KQ2.EQ.0.AND.KQ3.NE.0.AND.KQ3+KQ4.EQ.0D0)
|
|
& THEN
|
|
ELSE
|
|
CALL PYERRM(2,'(PY4ENT:) unphysical flavour combination')
|
|
ENDIF
|
|
K(IPA,2)=KF1
|
|
K(IPA+1,2)=KF2
|
|
K(IPA+2,2)=KF3
|
|
K(IPA+3,2)=KF4
|
|
|
|
C...Store partons/particles in K vectors for normal case.
|
|
IF(IP.GE.0) THEN
|
|
K(IPA,1)=1
|
|
IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0.OR.KQ4.NE.0)) K(IPA,1)=2
|
|
K(IPA+1,1)=1
|
|
IF(KQ2.NE.0.AND.KQ1+KQ2.NE.0.AND.(KQ3.NE.0.OR.KQ4.NE.0))
|
|
& K(IPA+1,1)=2
|
|
K(IPA+2,1)=1
|
|
IF(KQ3.NE.0.AND.KQ4.NE.0) K(IPA+2,1)=2
|
|
K(IPA+3,1)=1
|
|
|
|
C...Store partons for parton shower evolution from q-g-g-qbar or
|
|
C...g-g-g-g event.
|
|
ELSEIF(KQ1+KQ2.NE.0) THEN
|
|
K(IPA,1)=3
|
|
K(IPA+1,1)=3
|
|
K(IPA+2,1)=3
|
|
K(IPA+3,1)=3
|
|
KCS=4
|
|
IF(KQ1.EQ.-1) KCS=5
|
|
K(IPA,KCS)=MSTU(5)*(IPA+1)
|
|
K(IPA,9-KCS)=MSTU(5)*(IPA+3)
|
|
K(IPA+1,KCS)=MSTU(5)*(IPA+2)
|
|
K(IPA+1,9-KCS)=MSTU(5)*IPA
|
|
K(IPA+2,KCS)=MSTU(5)*(IPA+3)
|
|
K(IPA+2,9-KCS)=MSTU(5)*(IPA+1)
|
|
K(IPA+3,KCS)=MSTU(5)*IPA
|
|
K(IPA+3,9-KCS)=MSTU(5)*(IPA+2)
|
|
|
|
C...Store partons for parton shower evolution from q-qbar-q-qbar event.
|
|
ELSE
|
|
K(IPA,1)=3
|
|
K(IPA+1,1)=3
|
|
K(IPA+2,1)=3
|
|
K(IPA+3,1)=3
|
|
K(IPA,4)=MSTU(5)*(IPA+1)
|
|
K(IPA,5)=K(IPA,4)
|
|
K(IPA+1,4)=MSTU(5)*IPA
|
|
K(IPA+1,5)=K(IPA+1,4)
|
|
K(IPA+2,4)=MSTU(5)*(IPA+3)
|
|
K(IPA+2,5)=K(IPA+2,4)
|
|
K(IPA+3,4)=MSTU(5)*(IPA+2)
|
|
K(IPA+3,5)=K(IPA+3,4)
|
|
ENDIF
|
|
|
|
C...Check kinematics.
|
|
MKERR=0
|
|
IF(0.5D0*X1*PECM.LE.PM1.OR.0.5D0*X2*PECM.LE.PM2.OR.
|
|
&0.5D0*(2D0-X1-X2-X4)*PECM.LE.PM3.OR.0.5D0*X4*PECM.LE.PM4)
|
|
&MKERR=1
|
|
PA1=SQRT(MAX(1D-10,(0.5D0*X1*PECM)**2-PM1**2))
|
|
PA2=SQRT(MAX(1D-10,(0.5D0*X2*PECM)**2-PM2**2))
|
|
PA4=SQRT(MAX(1D-10,(0.5D0*X4*PECM)**2-PM4**2))
|
|
X24=X1+X2+X4-1D0-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2
|
|
CTHE4=(X1*X4-2D0*X14)*PECM**2/(4D0*PA1*PA4)
|
|
IF(ABS(CTHE4).GE.1.002D0) MKERR=1
|
|
CTHE4=MAX(-1D0,MIN(1D0,CTHE4))
|
|
STHE4=SQRT(1D0-CTHE4**2)
|
|
CTHE2=(X1*X2-2D0*X12)*PECM**2/(4D0*PA1*PA2)
|
|
IF(ABS(CTHE2).GE.1.002D0) MKERR=1
|
|
CTHE2=MAX(-1D0,MIN(1D0,CTHE2))
|
|
STHE2=SQRT(1D0-CTHE2**2)
|
|
CPHI2=((X2*X4-2D0*X24)*PECM**2-4D0*PA2*CTHE2*PA4*CTHE4)/
|
|
&MAX(1D-8*PECM**2,4D0*PA2*STHE2*PA4*STHE4)
|
|
IF(ABS(CPHI2).GE.1.05D0) MKERR=1
|
|
CPHI2=MAX(-1D0,MIN(1D0,CPHI2))
|
|
IF(MKERR.EQ.1) CALL PYERRM(13,
|
|
&'(PY4ENT:) unphysical kinematical variable setup')
|
|
|
|
C...Store partons/particles in P vectors.
|
|
P(IPA,3)=PA1
|
|
P(IPA,4)=SQRT(PA1**2+PM1**2)
|
|
P(IPA,5)=PM1
|
|
P(IPA+3,1)=PA4*STHE4
|
|
P(IPA+3,3)=PA4*CTHE4
|
|
P(IPA+3,4)=SQRT(PA4**2+PM4**2)
|
|
P(IPA+3,5)=PM4
|
|
P(IPA+1,1)=PA2*STHE2*CPHI2
|
|
P(IPA+1,2)=PA2*STHE2*SQRT(1D0-CPHI2**2)*(-1D0)**INT(PYR(0)+0.5D0)
|
|
P(IPA+1,3)=PA2*CTHE2
|
|
P(IPA+1,4)=SQRT(PA2**2+PM2**2)
|
|
P(IPA+1,5)=PM2
|
|
P(IPA+2,1)=-P(IPA+1,1)-P(IPA+3,1)
|
|
P(IPA+2,2)=-P(IPA+1,2)
|
|
P(IPA+2,3)=-P(IPA,3)-P(IPA+1,3)-P(IPA+3,3)
|
|
P(IPA+2,4)=SQRT(P(IPA+2,1)**2+P(IPA+2,2)**2+P(IPA+2,3)**2+PM3**2)
|
|
P(IPA+2,5)=PM3
|
|
|
|
C...Set N. Optionally fragment/decay.
|
|
N=IPA+3
|
|
IF(IP.EQ.0) CALL PYEXEC
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYJOIN
|
|
C...Connects a sequence of partons with colour flow indices,
|
|
C...as required for subsequent shower evolution (or other operations).
|
|
|
|
SUBROUTINE PYJOIN(NJOIN,IJOIN)
|
|
|
|
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...Local array.
|
|
DIMENSION IJOIN(*)
|
|
|
|
C...Check that partons are of right types to be connected.
|
|
IF(NJOIN.LT.2) GOTO 120
|
|
KQSUM=0
|
|
DO 100 IJN=1,NJOIN
|
|
I=IJOIN(IJN)
|
|
IF(I.LE.0.OR.I.GT.N) GOTO 120
|
|
IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0) GOTO 120
|
|
KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
|
|
IF(KQ.EQ.0) GOTO 120
|
|
IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120
|
|
IF(KQ.NE.2) KQSUM=KQSUM+KQ
|
|
IF(IJN.EQ.1) KQS=KQ
|
|
100 CONTINUE
|
|
IF(KQSUM.NE.0) GOTO 120
|
|
|
|
C...Connect the partons sequentially (closing for gluon loop).
|
|
KCS=(9-KQS)/2
|
|
IF(KQS.EQ.2) KCS=INT(4.5D0+PYR(0))
|
|
DO 110 IJN=1,NJOIN
|
|
I=IJOIN(IJN)
|
|
K(I,1)=3
|
|
IF(IJN.NE.1) IP=IJOIN(IJN-1)
|
|
IF(IJN.EQ.1) IP=IJOIN(NJOIN)
|
|
IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1)
|
|
IF(IJN.EQ.NJOIN) IN=IJOIN(1)
|
|
K(I,KCS)=MSTU(5)*IN
|
|
K(I,9-KCS)=MSTU(5)*IP
|
|
IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0
|
|
IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0
|
|
110 CONTINUE
|
|
|
|
C...Error exit: no action taken.
|
|
RETURN
|
|
120 CALL PYERRM(12,
|
|
&'(PYJOIN:) given entries can not be joined by one string')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYGIVE
|
|
C...Sets values of commonblock variables.
|
|
|
|
SUBROUTINE PYGIVE(CHIN)
|
|
|
|
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/PYDAT4/CHAF(500,2)
|
|
CHARACTER CHAF*16
|
|
COMMON/PYDATR/MRPY(6),RRPY(100)
|
|
COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
|
|
COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
COMMON/PYINT1/MINT(400),VINT(400)
|
|
COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
|
|
COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
|
|
COMMON/PYINT4/MWID(500),WIDS(500,5)
|
|
COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
|
|
COMMON/PYINT6/PROC(0:500)
|
|
CHARACTER PROC*28
|
|
COMMON/PYINT7/SIGT(0:6,0:6,0:5)
|
|
COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
|
|
&XPDIR(-6:6)
|
|
COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/,
|
|
&/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,
|
|
&/PYINT5/,/PYINT6/,/PYINT7/,/PYINT8/,/PYMSSM/
|
|
C...Local arrays and character variables.
|
|
CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28,
|
|
&CHNEW2*28,CHNAM*6,CHVAR(49)*6,CHALP(2)*26,CHIND*8,CHINI*10,
|
|
&CHINR*16
|
|
DIMENSION MSVAR(49,8)
|
|
|
|
C...For each variable to be translated give: name,
|
|
C...integer/real/character, no. of indices, lower&upper index bounds.
|
|
DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
|
|
&'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRPY',
|
|
&'RRPY','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI',
|
|
&'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH',
|
|
&'MWID','WIDS','NGEN','XSEC','PROC','SIGT','XPVMD','XPANL',
|
|
&'XPANH','XPBEH','XPDIR','IMSS','RMSS'/
|
|
DATA ((MSVAR(I,J),J=1,8),I=1,49)/ 1,7*0, 1,2,1,4000,1,5,2*0,
|
|
&2,2,1,4000,1,5,2*0, 2,2,1,4000,1,5,2*0, 1,1,1,200,4*0,
|
|
&2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
|
|
&1,2,1,500,1,4,2*0, 2,2,1,500,1,4,2*0, 2,1,1,2000,4*0,
|
|
&2,2,1,4,1,4,2*0, 1,2,1,500,1,3,2*0, 1,2,1,4000,1,2,2*0,
|
|
&2,1,1,4000,4*0, 1,2,1,4000,1,5,2*0, 3,2,1,500,1,2,2*0,
|
|
&1,1,1,6,4*0, 2,1,1,100,4*0,
|
|
&1,7*0, 1,1,1,500,4*0, 1,2,1,2,-40,40,2*0, 2,1,1,200,4*0,
|
|
&1,1,1,200,4*0, 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
|
|
&1,1,1,400,4*0, 2,1,1,400,4*0, 1,1,1,500,4*0,
|
|
&1,2,1,500,1,2,2*0, 2,2,1,500,1,20,2*0, 1,3,1,40,1,4,1,2,
|
|
&2,2,1,2,-40,40,2*0, 1,2,1,1000,1,3,2*0, 2,1,1,1000,4*0,
|
|
&1,1,1,500,4*0, 2,2,1,500,1,5,2*0, 1,2,0,500,1,3,2*0,
|
|
&2,2,0,500,1,3,2*0, 4,1,0,500,4*0, 2,3,0,6,0,6,0,5,
|
|
&2,1,-6,6,4*0, 2,1,-6,6,4*0, 2,1,-6,6,4*0,
|
|
&2,1,-6,6,4*0, 2,1,-6,6,4*0, 1,1,0,99,4*0, 2,1,0,99,4*0/
|
|
DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
|
|
&'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
|
|
|
|
C...Length of character variable. Subdivide it into instructions.
|
|
IF(MSTU(12).GE.1) CALL PYLIST(0)
|
|
CHBIT=CHIN//' '
|
|
LBIT=101
|
|
100 LBIT=LBIT-1
|
|
IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100
|
|
LTOT=0
|
|
DO 110 LCOM=1,LBIT
|
|
IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110
|
|
LTOT=LTOT+1
|
|
CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM)
|
|
110 CONTINUE
|
|
LLOW=0
|
|
120 LHIG=LLOW+1
|
|
130 LHIG=LHIG+1
|
|
IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130
|
|
LBIT=LHIG-LLOW-1
|
|
CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1)
|
|
|
|
C...Identify commonblock variable.
|
|
LNAM=1
|
|
140 LNAM=LNAM+1
|
|
IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND.
|
|
&LNAM.LE.6) GOTO 140
|
|
CHNAM=CHBIT(1:LNAM-1)//' '
|
|
DO 160 LCOM=1,LNAM-1
|
|
DO 150 LALP=1,26
|
|
IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)=
|
|
& CHALP(2)(LALP:LALP)
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
IVAR=0
|
|
DO 170 IV=1,49
|
|
IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV
|
|
170 CONTINUE
|
|
IF(IVAR.EQ.0) THEN
|
|
CALL PYERRM(18,'(PYGIVE:) do not recognize variable '//CHNAM)
|
|
LLOW=LHIG
|
|
IF(LLOW.LT.LTOT) GOTO 120
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Identify any indices.
|
|
I1=0
|
|
I2=0
|
|
I3=0
|
|
NINDX=0
|
|
IF(CHBIT(LNAM:LNAM).EQ.'(') THEN
|
|
LIND=LNAM
|
|
180 LIND=LIND+1
|
|
IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180
|
|
CHIND=' '
|
|
IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c')
|
|
& .AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17))
|
|
& THEN
|
|
CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1)
|
|
READ(CHIND,'(I8)') KF
|
|
I1=PYCOMP(KF)
|
|
ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.
|
|
& 'c') THEN
|
|
CALL PYERRM(18,'(PYGIVE:) not allowed to use C index for '//
|
|
& CHNAM)
|
|
LLOW=LHIG
|
|
IF(LLOW.LT.LTOT) GOTO 120
|
|
RETURN
|
|
ELSE
|
|
CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
|
|
READ(CHIND,'(I8)') I1
|
|
ENDIF
|
|
LNAM=LIND
|
|
IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
|
|
NINDX=1
|
|
ENDIF
|
|
IF(CHBIT(LNAM:LNAM).EQ.',') THEN
|
|
LIND=LNAM
|
|
190 LIND=LIND+1
|
|
IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190
|
|
CHIND=' '
|
|
CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
|
|
READ(CHIND,'(I8)') I2
|
|
LNAM=LIND
|
|
IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
|
|
NINDX=2
|
|
ENDIF
|
|
IF(CHBIT(LNAM:LNAM).EQ.',') THEN
|
|
LIND=LNAM
|
|
200 LIND=LIND+1
|
|
IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 200
|
|
CHIND=' '
|
|
CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
|
|
READ(CHIND,'(I8)') I3
|
|
LNAM=LIND+1
|
|
NINDX=3
|
|
ENDIF
|
|
|
|
C...Check that indices allowed.
|
|
IERR=0
|
|
IF(NINDX.NE.MSVAR(IVAR,2)) IERR=1
|
|
IF(NINDX.GE.1.AND.(I1.LT.MSVAR(IVAR,3).OR.I1.GT.MSVAR(IVAR,4)))
|
|
&IERR=2
|
|
IF(NINDX.GE.2.AND.(I2.LT.MSVAR(IVAR,5).OR.I2.GT.MSVAR(IVAR,6)))
|
|
&IERR=3
|
|
IF(NINDX.EQ.3.AND.(I3.LT.MSVAR(IVAR,7).OR.I3.GT.MSVAR(IVAR,8)))
|
|
&IERR=4
|
|
IF(CHBIT(LNAM:LNAM).NE.'=') IERR=5
|
|
IF(IERR.GE.1) THEN
|
|
CALL PYERRM(18,'(PYGIVE:) unallowed indices for '//
|
|
& CHBIT(1:LNAM-1))
|
|
LLOW=LHIG
|
|
IF(LLOW.LT.LTOT) GOTO 120
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Save old value of variable.
|
|
IF(IVAR.EQ.1) THEN
|
|
IOLD=N
|
|
ELSEIF(IVAR.EQ.2) THEN
|
|
IOLD=K(I1,I2)
|
|
ELSEIF(IVAR.EQ.3) THEN
|
|
ROLD=P(I1,I2)
|
|
ELSEIF(IVAR.EQ.4) THEN
|
|
ROLD=V(I1,I2)
|
|
ELSEIF(IVAR.EQ.5) THEN
|
|
IOLD=MSTU(I1)
|
|
ELSEIF(IVAR.EQ.6) THEN
|
|
ROLD=PARU(I1)
|
|
ELSEIF(IVAR.EQ.7) THEN
|
|
IOLD=MSTJ(I1)
|
|
ELSEIF(IVAR.EQ.8) THEN
|
|
ROLD=PARJ(I1)
|
|
ELSEIF(IVAR.EQ.9) THEN
|
|
IOLD=KCHG(I1,I2)
|
|
ELSEIF(IVAR.EQ.10) THEN
|
|
ROLD=PMAS(I1,I2)
|
|
ELSEIF(IVAR.EQ.11) THEN
|
|
ROLD=PARF(I1)
|
|
ELSEIF(IVAR.EQ.12) THEN
|
|
ROLD=VCKM(I1,I2)
|
|
ELSEIF(IVAR.EQ.13) THEN
|
|
IOLD=MDCY(I1,I2)
|
|
ELSEIF(IVAR.EQ.14) THEN
|
|
IOLD=MDME(I1,I2)
|
|
ELSEIF(IVAR.EQ.15) THEN
|
|
ROLD=BRAT(I1)
|
|
ELSEIF(IVAR.EQ.16) THEN
|
|
IOLD=KFDP(I1,I2)
|
|
ELSEIF(IVAR.EQ.17) THEN
|
|
CHOLD=CHAF(I1,I2)
|
|
ELSEIF(IVAR.EQ.18) THEN
|
|
IOLD=MRPY(I1)
|
|
ELSEIF(IVAR.EQ.19) THEN
|
|
ROLD=RRPY(I1)
|
|
ELSEIF(IVAR.EQ.20) THEN
|
|
IOLD=MSEL
|
|
ELSEIF(IVAR.EQ.21) THEN
|
|
IOLD=MSUB(I1)
|
|
ELSEIF(IVAR.EQ.22) THEN
|
|
IOLD=KFIN(I1,I2)
|
|
ELSEIF(IVAR.EQ.23) THEN
|
|
ROLD=CKIN(I1)
|
|
ELSEIF(IVAR.EQ.24) THEN
|
|
IOLD=MSTP(I1)
|
|
ELSEIF(IVAR.EQ.25) THEN
|
|
ROLD=PARP(I1)
|
|
ELSEIF(IVAR.EQ.26) THEN
|
|
IOLD=MSTI(I1)
|
|
ELSEIF(IVAR.EQ.27) THEN
|
|
ROLD=PARI(I1)
|
|
ELSEIF(IVAR.EQ.28) THEN
|
|
IOLD=MINT(I1)
|
|
ELSEIF(IVAR.EQ.29) THEN
|
|
ROLD=VINT(I1)
|
|
ELSEIF(IVAR.EQ.30) THEN
|
|
IOLD=ISET(I1)
|
|
ELSEIF(IVAR.EQ.31) THEN
|
|
IOLD=KFPR(I1,I2)
|
|
ELSEIF(IVAR.EQ.32) THEN
|
|
ROLD=COEF(I1,I2)
|
|
ELSEIF(IVAR.EQ.33) THEN
|
|
IOLD=ICOL(I1,I2,I3)
|
|
ELSEIF(IVAR.EQ.34) THEN
|
|
ROLD=XSFX(I1,I2)
|
|
ELSEIF(IVAR.EQ.35) THEN
|
|
IOLD=ISIG(I1,I2)
|
|
ELSEIF(IVAR.EQ.36) THEN
|
|
ROLD=SIGH(I1)
|
|
ELSEIF(IVAR.EQ.37) THEN
|
|
IOLD=MWID(I1)
|
|
ELSEIF(IVAR.EQ.38) THEN
|
|
ROLD=WIDS(I1,I2)
|
|
ELSEIF(IVAR.EQ.39) THEN
|
|
IOLD=NGEN(I1,I2)
|
|
ELSEIF(IVAR.EQ.40) THEN
|
|
ROLD=XSEC(I1,I2)
|
|
ELSEIF(IVAR.EQ.41) THEN
|
|
CHOLD2=PROC(I1)
|
|
ELSEIF(IVAR.EQ.42) THEN
|
|
ROLD=SIGT(I1,I2,I3)
|
|
ELSEIF(IVAR.EQ.43) THEN
|
|
ROLD=XPVMD(I1)
|
|
ELSEIF(IVAR.EQ.44) THEN
|
|
ROLD=XPANL(I1)
|
|
ELSEIF(IVAR.EQ.45) THEN
|
|
ROLD=XPANH(I1)
|
|
ELSEIF(IVAR.EQ.46) THEN
|
|
ROLD=XPBEH(I1)
|
|
ELSEIF(IVAR.EQ.47) THEN
|
|
ROLD=XPDIR(I1)
|
|
ELSEIF(IVAR.EQ.48) THEN
|
|
IOLD=IMSS(I1)
|
|
ELSEIF(IVAR.EQ.49) THEN
|
|
ROLD=RMSS(I1)
|
|
ENDIF
|
|
|
|
C...Print current value of variable. Loop back.
|
|
IF(LNAM.GE.LBIT) THEN
|
|
CHBIT(LNAM:14)=' '
|
|
CHBIT(15:60)=' has the value '
|
|
IF(MSVAR(IVAR,1).EQ.1) THEN
|
|
WRITE(CHBIT(51:60),'(I10)') IOLD
|
|
ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
|
|
WRITE(CHBIT(47:60),'(F14.5)') ROLD
|
|
ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
|
|
CHBIT(53:60)=CHOLD
|
|
ELSE
|
|
CHBIT(33:60)=CHOLD
|
|
ENDIF
|
|
IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
|
|
LLOW=LHIG
|
|
IF(LLOW.LT.LTOT) GOTO 120
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Read in new variable value.
|
|
IF(MSVAR(IVAR,1).EQ.1) THEN
|
|
CHINI=' '
|
|
CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT)
|
|
READ(CHINI,'(I10)') INEW
|
|
ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
|
|
CHINR=' '
|
|
CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT)
|
|
READ(CHINR,*) RNEW
|
|
ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
|
|
CHNEW=CHBIT(LNAM+1:LBIT)//' '
|
|
ELSE
|
|
CHNEW2=CHBIT(LNAM+1:LBIT)//' '
|
|
ENDIF
|
|
|
|
C...Store new variable value.
|
|
IF(IVAR.EQ.1) THEN
|
|
N=INEW
|
|
ELSEIF(IVAR.EQ.2) THEN
|
|
K(I1,I2)=INEW
|
|
ELSEIF(IVAR.EQ.3) THEN
|
|
P(I1,I2)=RNEW
|
|
ELSEIF(IVAR.EQ.4) THEN
|
|
V(I1,I2)=RNEW
|
|
ELSEIF(IVAR.EQ.5) THEN
|
|
MSTU(I1)=INEW
|
|
ELSEIF(IVAR.EQ.6) THEN
|
|
PARU(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.7) THEN
|
|
MSTJ(I1)=INEW
|
|
ELSEIF(IVAR.EQ.8) THEN
|
|
PARJ(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.9) THEN
|
|
KCHG(I1,I2)=INEW
|
|
ELSEIF(IVAR.EQ.10) THEN
|
|
PMAS(I1,I2)=RNEW
|
|
ELSEIF(IVAR.EQ.11) THEN
|
|
PARF(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.12) THEN
|
|
VCKM(I1,I2)=RNEW
|
|
ELSEIF(IVAR.EQ.13) THEN
|
|
MDCY(I1,I2)=INEW
|
|
ELSEIF(IVAR.EQ.14) THEN
|
|
MDME(I1,I2)=INEW
|
|
ELSEIF(IVAR.EQ.15) THEN
|
|
BRAT(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.16) THEN
|
|
KFDP(I1,I2)=INEW
|
|
ELSEIF(IVAR.EQ.17) THEN
|
|
CHAF(I1,I2)=CHNEW
|
|
ELSEIF(IVAR.EQ.18) THEN
|
|
MRPY(I1)=INEW
|
|
ELSEIF(IVAR.EQ.19) THEN
|
|
RRPY(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.20) THEN
|
|
MSEL=INEW
|
|
ELSEIF(IVAR.EQ.21) THEN
|
|
MSUB(I1)=INEW
|
|
ELSEIF(IVAR.EQ.22) THEN
|
|
KFIN(I1,I2)=INEW
|
|
ELSEIF(IVAR.EQ.23) THEN
|
|
CKIN(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.24) THEN
|
|
MSTP(I1)=INEW
|
|
ELSEIF(IVAR.EQ.25) THEN
|
|
PARP(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.26) THEN
|
|
MSTI(I1)=INEW
|
|
ELSEIF(IVAR.EQ.27) THEN
|
|
PARI(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.28) THEN
|
|
MINT(I1)=INEW
|
|
ELSEIF(IVAR.EQ.29) THEN
|
|
VINT(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.30) THEN
|
|
ISET(I1)=INEW
|
|
ELSEIF(IVAR.EQ.31) THEN
|
|
KFPR(I1,I2)=INEW
|
|
ELSEIF(IVAR.EQ.32) THEN
|
|
COEF(I1,I2)=RNEW
|
|
ELSEIF(IVAR.EQ.33) THEN
|
|
ICOL(I1,I2,I3)=INEW
|
|
ELSEIF(IVAR.EQ.34) THEN
|
|
XSFX(I1,I2)=RNEW
|
|
ELSEIF(IVAR.EQ.35) THEN
|
|
ISIG(I1,I2)=INEW
|
|
ELSEIF(IVAR.EQ.36) THEN
|
|
SIGH(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.37) THEN
|
|
MWID(I1)=INEW
|
|
ELSEIF(IVAR.EQ.38) THEN
|
|
WIDS(I1,I2)=RNEW
|
|
ELSEIF(IVAR.EQ.39) THEN
|
|
NGEN(I1,I2)=INEW
|
|
ELSEIF(IVAR.EQ.40) THEN
|
|
XSEC(I1,I2)=RNEW
|
|
ELSEIF(IVAR.EQ.41) THEN
|
|
PROC(I1)=CHNEW2
|
|
ELSEIF(IVAR.EQ.42) THEN
|
|
SIGT(I1,I2,I3)=RNEW
|
|
ELSEIF(IVAR.EQ.43) THEN
|
|
XPVMD(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.44) THEN
|
|
XPANL(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.45) THEN
|
|
XPANH(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.46) THEN
|
|
XPBEH(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.47) THEN
|
|
XPDIR(I1)=RNEW
|
|
ELSEIF(IVAR.EQ.48) THEN
|
|
IMSS(I1)=INEW
|
|
ELSEIF(IVAR.EQ.49) THEN
|
|
RMSS(I1)=RNEW
|
|
ENDIF
|
|
|
|
C...Write old and new value. Loop back.
|
|
CHBIT(LNAM:14)=' '
|
|
CHBIT(15:60)=' changed from to '
|
|
IF(MSVAR(IVAR,1).EQ.1) THEN
|
|
WRITE(CHBIT(33:42),'(I10)') IOLD
|
|
WRITE(CHBIT(51:60),'(I10)') INEW
|
|
IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
|
|
ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
|
|
WRITE(CHBIT(29:42),'(F14.5)') ROLD
|
|
WRITE(CHBIT(47:60),'(F14.5)') RNEW
|
|
IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
|
|
ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
|
|
CHBIT(35:42)=CHOLD
|
|
CHBIT(53:60)=CHNEW
|
|
IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
|
|
ELSE
|
|
CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2
|
|
IF(MSTU(13).GE.1) WRITE(MSTU(11),5100) CHBIT(1:88)
|
|
ENDIF
|
|
LLOW=LHIG
|
|
IF(LLOW.LT.LTOT) GOTO 120
|
|
|
|
C...Format statement for output on unit MSTU(11) (by default 6).
|
|
5000 FORMAT(5X,A60)
|
|
5100 FORMAT(5X,A88)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYEXEC
|
|
C...Administrates the fragmentation and decay chain.
|
|
|
|
SUBROUTINE PYEXEC
|
|
|
|
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/PYINT4/MWID(500),WIDS(500,5)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYINT4/
|
|
C...Local array.
|
|
DIMENSION PS(2,6),IJOIN(100)
|
|
|
|
C...Initialize and reset.
|
|
MSTU(24)=0
|
|
IF(MSTU(12).GE.1) CALL PYLIST(0)
|
|
MSTU(31)=MSTU(31)+1
|
|
MSTU(1)=0
|
|
MSTU(2)=0
|
|
MSTU(3)=0
|
|
IF(MSTU(17).LE.0) MSTU(90)=0
|
|
MCONS=1
|
|
|
|
C...Sum up momentum, energy and charge for starting entries.
|
|
NSAV=N
|
|
DO 110 I=1,2
|
|
DO 100 J=1,6
|
|
PS(I,J)=0D0
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
DO 130 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 130
|
|
DO 120 J=1,4
|
|
PS(1,J)=PS(1,J)+P(I,J)
|
|
120 CONTINUE
|
|
PS(1,6)=PS(1,6)+PYCHGE(K(I,2))
|
|
130 CONTINUE
|
|
PARU(21)=PS(1,4)
|
|
|
|
C...Prepare system for subsequent fragmentation/decay.
|
|
CALL PYPREP(0)
|
|
|
|
C...Loop through jet fragmentation and particle decays.
|
|
MBE=0
|
|
140 MBE=MBE+1
|
|
IP=0
|
|
150 IP=IP+1
|
|
KC=0
|
|
IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=PYCOMP(K(IP,2))
|
|
IF(KC.EQ.0) THEN
|
|
|
|
C...Deal with any remaining undecayed resonance
|
|
C...(normally the task of PYEVNT, so seldom used).
|
|
ELSEIF(MWID(KC).NE.0) THEN
|
|
IBEG=IP
|
|
IF(KCHG(KC,2).NE.0.AND.K(I,1).NE.3) THEN
|
|
IBEG=IP+1
|
|
160 IBEG=IBEG-1
|
|
IF(IBEG.GE.2.AND.K(IBEG,1).EQ.2) GOTO 160
|
|
IF(K(IBEG,1).NE.2) IBEG=IBEG+1
|
|
IEND=IP-1
|
|
170 IEND=IEND+1
|
|
IF(IEND.LT.N.AND.K(IEND,1).EQ.2) GOTO 170
|
|
IF(IEND.LT.N.AND.KCHG(PYCOMP(K(IEND,2)),2).EQ.0) GOTO 170
|
|
NJOIN=0
|
|
DO 180 I=IBEG,IEND
|
|
IF(KCHG(PYCOMP(K(IEND,2)),2).NE.0) THEN
|
|
NJOIN=NJOIN+1
|
|
IJOIN(NJOIN)=I
|
|
ENDIF
|
|
180 CONTINUE
|
|
ENDIF
|
|
CALL PYRESD(IP)
|
|
CALL PYPREP(IBEG)
|
|
|
|
C...Particle decay if unstable and allowed. Save long-lived particle
|
|
C...decays until second pass after Bose-Einstein effects.
|
|
ELSEIF(KCHG(KC,2).EQ.0) THEN
|
|
IF(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1.AND.(MSTJ(51).LE.0.OR.MBE
|
|
& .EQ.2.OR.PMAS(KC,2).GE.PARJ(91).OR.IABS(K(IP,2)).EQ.311))
|
|
& CALL PYDECY(IP)
|
|
|
|
C...Decay products may develop a shower.
|
|
IF(MSTJ(92).GT.0) THEN
|
|
IP1=MSTJ(92)
|
|
QMAX=SQRT(MAX(0D0,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1,
|
|
& 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2))
|
|
CALL PYSHOW(IP1,IP1+1,QMAX)
|
|
CALL PYPREP(IP1)
|
|
MSTJ(92)=0
|
|
ELSEIF(MSTJ(92).LT.0) THEN
|
|
IP1=-MSTJ(92)
|
|
CALL PYSHOW(IP1,-3,P(IP,5))
|
|
CALL PYPREP(IP1)
|
|
MSTJ(92)=0
|
|
ENDIF
|
|
|
|
C...Jet fragmentation: string or independent fragmentation.
|
|
ELSEIF(K(IP,1).EQ.1.OR.K(IP,1).EQ.2) THEN
|
|
MFRAG=MSTJ(1)
|
|
IF(MFRAG.GE.1.AND.K(IP,1).EQ.1) MFRAG=2
|
|
IF(MSTJ(21).GE.2.AND.K(IP,1).EQ.2.AND.N.GT.IP) THEN
|
|
IF(K(IP+1,1).EQ.1.AND.K(IP+1,3).EQ.K(IP,3).AND.
|
|
& K(IP,3).GT.0.AND.K(IP,3).LT.IP) THEN
|
|
IF(KCHG(PYCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG)
|
|
ENDIF
|
|
ENDIF
|
|
IF(MFRAG.EQ.1) CALL PYSTRF(IP)
|
|
IF(MFRAG.EQ.2) CALL PYINDF(IP)
|
|
IF(MFRAG.EQ.2.AND.K(IP,1).EQ.1) MCONS=0
|
|
IF(MFRAG.EQ.2.AND.(MSTJ(3).LE.0.OR.MOD(MSTJ(3),5).EQ.0)) MCONS=0
|
|
ENDIF
|
|
|
|
C...Loop back if enough space left in PYJETS and no error abort.
|
|
IF(MSTU(24).NE.0.AND.MSTU(21).GE.2) THEN
|
|
ELSEIF(IP.LT.N.AND.N.LT.MSTU(4)-20-MSTU(32)) THEN
|
|
GOTO 150
|
|
ELSEIF(IP.LT.N) THEN
|
|
CALL PYERRM(11,'(PYEXEC:) no more memory left in PYJETS')
|
|
ENDIF
|
|
|
|
C...Include simple Bose-Einstein effect parametrization if desired.
|
|
IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN
|
|
CALL PYBOEI(NSAV)
|
|
GOTO 140
|
|
ENDIF
|
|
|
|
C...Check that momentum, energy and charge were conserved.
|
|
DO 200 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 200
|
|
DO 190 J=1,4
|
|
PS(2,J)=PS(2,J)+P(I,J)
|
|
190 CONTINUE
|
|
PS(2,6)=PS(2,6)+PYCHGE(K(I,2))
|
|
200 CONTINUE
|
|
PDEV=(ABS(PS(2,1)-PS(1,1))+ABS(PS(2,2)-PS(1,2))+ABS(PS(2,3)-
|
|
&PS(1,3))+ABS(PS(2,4)-PS(1,4)))/(1D0+ABS(PS(2,4))+ABS(PS(1,4)))
|
|
IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL PYERRM(15,
|
|
&'(PYEXEC:) four-momentum was not conserved')
|
|
IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1D0) CALL PYERRM(15,
|
|
&'(PYEXEC:) charge was not conserved')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPREP
|
|
C...Rearranges partons along strings. Allows small systems
|
|
C...to collapse into one or two particles and checks flavours.
|
|
|
|
SUBROUTINE PYPREP(IP)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/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)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/
|
|
C...Local arrays.
|
|
DIMENSION DPS(5),DPC(5),UE(3)
|
|
|
|
C...Rearrange parton shower product listing along strings: begin loop.
|
|
I1=N
|
|
DO 130 MQGST=1,2
|
|
DO 120 I=MAX(1,IP),N
|
|
IF(K(I,1).NE.3) GOTO 120
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0) GOTO 120
|
|
KQ=KCHG(KC,2)
|
|
IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 120
|
|
|
|
C...Pick up loose string end.
|
|
KCS=4
|
|
IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5
|
|
IA=I
|
|
NSTP=0
|
|
100 NSTP=NSTP+1
|
|
IF(NSTP.GT.4*N) THEN
|
|
CALL PYERRM(14,'(PYPREP:) caught in infinite loop')
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Copy undecayed parton.
|
|
IF(K(IA,1).EQ.3) THEN
|
|
IF(I1.GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYPREP:) no more memory left in PYJETS')
|
|
RETURN
|
|
ENDIF
|
|
I1=I1+1
|
|
K(I1,1)=2
|
|
IF(NSTP.GE.2.AND.KCHG(PYCOMP(K(IA,2)),2).NE.2) K(I1,1)=1
|
|
K(I1,2)=K(IA,2)
|
|
K(I1,3)=IA
|
|
K(I1,4)=0
|
|
K(I1,5)=0
|
|
DO 110 J=1,5
|
|
P(I1,J)=P(IA,J)
|
|
V(I1,J)=V(IA,J)
|
|
110 CONTINUE
|
|
K(IA,1)=K(IA,1)+10
|
|
IF(K(I1,1).EQ.1) GOTO 120
|
|
ENDIF
|
|
|
|
C...Go to next parton in colour space.
|
|
IB=IA
|
|
IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5))
|
|
& .NE.0) THEN
|
|
IA=MOD(K(IB,KCS),MSTU(5))
|
|
K(IB,KCS)=K(IB,KCS)+MSTU(5)**2
|
|
MREV=0
|
|
ELSE
|
|
IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5),
|
|
& MSTU(5)).EQ.0) KCS=9-KCS
|
|
IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5))
|
|
K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2
|
|
MREV=1
|
|
ENDIF
|
|
IF(IA.LE.0.OR.IA.GT.N) THEN
|
|
CALL PYERRM(12,'(PYPREP:) colour rearrangement failed')
|
|
RETURN
|
|
ENDIF
|
|
IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5),
|
|
& MSTU(5)).EQ.IB) THEN
|
|
IF(MREV.EQ.1) KCS=9-KCS
|
|
IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS
|
|
K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2
|
|
ELSE
|
|
IF(MREV.EQ.0) KCS=9-KCS
|
|
IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS
|
|
K(IA,KCS)=K(IA,KCS)+MSTU(5)**2
|
|
ENDIF
|
|
IF(IA.NE.I) GOTO 100
|
|
K(I1,1)=1
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
N=I1
|
|
IF(MSTJ(14).LT.0) RETURN
|
|
|
|
C...Find lowest-mass colour singlet jet system, OK if above threshold.
|
|
IF(MSTJ(14).EQ.0) GOTO 320
|
|
NS=N
|
|
140 NSIN=N-NS
|
|
PDM=1D0+PARJ(32)
|
|
IC=0
|
|
DO 190 I=MAX(1,IP),NS
|
|
IF(K(I,1).NE.1.AND.K(I,1).NE.2) THEN
|
|
ELSEIF(K(I,1).EQ.2.AND.IC.EQ.0) THEN
|
|
NSIN=NSIN+1
|
|
IC=I
|
|
DO 150 J=1,4
|
|
DPS(J)=P(I,J)
|
|
150 CONTINUE
|
|
MSTJ(93)=1
|
|
DPS(5)=PYMASS(K(I,2))
|
|
ELSEIF(K(I,1).EQ.2) THEN
|
|
DO 160 J=1,4
|
|
DPS(J)=DPS(J)+P(I,J)
|
|
160 CONTINUE
|
|
ELSEIF(IC.NE.0.AND.KCHG(PYCOMP(K(I,2)),2).NE.0) THEN
|
|
DO 170 J=1,4
|
|
DPS(J)=DPS(J)+P(I,J)
|
|
170 CONTINUE
|
|
MSTJ(93)=1
|
|
DPS(5)=DPS(5)+PYMASS(K(I,2))
|
|
PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))-
|
|
& DPS(5)
|
|
IF(PD.LT.PDM) THEN
|
|
PDM=PD
|
|
DO 180 J=1,5
|
|
DPC(J)=DPS(J)
|
|
180 CONTINUE
|
|
IC1=IC
|
|
IC2=I
|
|
ENDIF
|
|
IC=0
|
|
ELSE
|
|
NSIN=NSIN+1
|
|
ENDIF
|
|
190 CONTINUE
|
|
IF(PDM.GE.PARJ(32)) GOTO 320
|
|
|
|
C...Fill small-mass system as cluster.
|
|
NSAV=N
|
|
PECM=SQRT(MAX(0D0,DPC(4)**2-DPC(1)**2-DPC(2)**2-DPC(3)**2))
|
|
K(N+1,1)=11
|
|
K(N+1,2)=91
|
|
K(N+1,3)=IC1
|
|
K(N+1,4)=N+2
|
|
K(N+1,5)=N+3
|
|
P(N+1,1)=DPC(1)
|
|
P(N+1,2)=DPC(2)
|
|
P(N+1,3)=DPC(3)
|
|
P(N+1,4)=DPC(4)
|
|
P(N+1,5)=PECM
|
|
|
|
C...Form two particles from flavours of lowest-mass system, if feasible.
|
|
K(N+2,1)=1
|
|
K(N+3,1)=1
|
|
IF(MSTU(16).NE.2) THEN
|
|
K(N+2,3)=N+1
|
|
K(N+3,3)=N+1
|
|
ELSE
|
|
K(N+2,3)=IC1
|
|
K(N+3,3)=IC2
|
|
ENDIF
|
|
K(N+2,4)=0
|
|
K(N+3,4)=0
|
|
K(N+2,5)=0
|
|
K(N+3,5)=0
|
|
IF(IABS(K(IC1,2)).NE.21) THEN
|
|
KC1=PYCOMP(K(IC1,2))
|
|
KC2=PYCOMP(K(IC2,2))
|
|
IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 320
|
|
KQ1=KCHG(KC1,2)*ISIGN(1,K(IC1,2))
|
|
KQ2=KCHG(KC2,2)*ISIGN(1,K(IC2,2))
|
|
IF(KQ1+KQ2.NE.0) GOTO 320
|
|
200 CALL PYKFDI(K(IC1,2),0,KFLN,K(N+2,2))
|
|
CALL PYKFDI(K(IC2,2),-KFLN,KFLDMP,K(N+3,2))
|
|
IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 200
|
|
ELSE
|
|
IF(IABS(K(IC2,2)).NE.21) GOTO 320
|
|
210 CALL PYKFDI(1+INT((2D0+PARJ(2))*PYR(0)),0,KFLN,KFDMP)
|
|
CALL PYKFDI(KFLN,0,KFLM,K(N+2,2))
|
|
CALL PYKFDI(-KFLN,-KFLM,KFLDMP,K(N+3,2))
|
|
IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 210
|
|
ENDIF
|
|
P(N+2,5)=PYMASS(K(N+2,2))
|
|
P(N+3,5)=PYMASS(K(N+3,2))
|
|
IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM.AND.NSIN.EQ.1) GOTO 320
|
|
IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) GOTO 260
|
|
|
|
C...Perform two-particle decay of jet system, if possible.
|
|
IF(PECM.GE.0.02D0*DPC(4)) THEN
|
|
PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2-
|
|
& (P(N+2,5)-P(N+3,5))**2))/(2D0*PECM)
|
|
UE(3)=2D0*PYR(0)-1D0
|
|
PHI=PARU(2)*PYR(0)
|
|
UE(1)=SQRT(1D0-UE(3)**2)*COS(PHI)
|
|
UE(2)=SQRT(1D0-UE(3)**2)*SIN(PHI)
|
|
DO 220 J=1,3
|
|
P(N+2,J)=PA*UE(J)
|
|
P(N+3,J)=-PA*UE(J)
|
|
220 CONTINUE
|
|
P(N+2,4)=SQRT(PA**2+P(N+2,5)**2)
|
|
P(N+3,4)=SQRT(PA**2+P(N+3,5)**2)
|
|
MSTU(33)=1
|
|
CALL PYROBO(N+2,N+3,0D0,0D0,DPC(1)/DPC(4),DPC(2)/DPC(4),
|
|
& DPC(3)/DPC(4))
|
|
ELSE
|
|
NP=0
|
|
DO 230 I=IC1,IC2
|
|
IF(K(I,1).EQ.1.OR.K(I,1).EQ.2) NP=NP+1
|
|
230 CONTINUE
|
|
HA=P(IC1,4)*P(IC2,4)-P(IC1,1)*P(IC2,1)-P(IC1,2)*P(IC2,2)-
|
|
& P(IC1,3)*P(IC2,3)
|
|
IF(NP.GE.3.OR.HA.LE.1.25D0*P(IC1,5)*P(IC2,5)) GOTO 260
|
|
HD1=0.5D0*(P(N+2,5)**2-P(IC1,5)**2)
|
|
HD2=0.5D0*(P(N+3,5)**2-P(IC2,5)**2)
|
|
HR=SQRT(MAX(0D0,((HA-HD1-HD2)**2-(P(N+2,5)*P(N+3,5))**2)/
|
|
& (HA**2-(P(IC1,5)*P(IC2,5))**2)))-1D0
|
|
HC=P(IC1,5)**2+2D0*HA+P(IC2,5)**2
|
|
HK1=((P(IC2,5)**2+HA)*HR+HD1-HD2)/HC
|
|
HK2=((P(IC1,5)**2+HA)*HR+HD2-HD1)/HC
|
|
DO 240 J=1,4
|
|
P(N+2,J)=(1D0+HK1)*P(IC1,J)-HK2*P(IC2,J)
|
|
P(N+3,J)=(1D0+HK2)*P(IC2,J)-HK1*P(IC1,J)
|
|
240 CONTINUE
|
|
ENDIF
|
|
DO 250 J=1,4
|
|
V(N+1,J)=V(IC1,J)
|
|
V(N+2,J)=V(IC1,J)
|
|
V(N+3,J)=V(IC2,J)
|
|
250 CONTINUE
|
|
V(N+1,5)=0D0
|
|
V(N+2,5)=0D0
|
|
V(N+3,5)=0D0
|
|
N=N+3
|
|
GOTO 300
|
|
|
|
C...Else form one particle from the flavours available, if possible.
|
|
260 K(N+1,5)=N+2
|
|
IF(IABS(K(IC1,2)).GT.100.AND.IABS(K(IC2,2)).GT.100) THEN
|
|
GOTO 320
|
|
ELSEIF(IABS(K(IC1,2)).NE.21) THEN
|
|
CALL PYKFDI(K(IC1,2),K(IC2,2),KFLDMP,K(N+2,2))
|
|
ELSE
|
|
KFLN=1+INT((2D0+PARJ(2))*PYR(0))
|
|
CALL PYKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2))
|
|
ENDIF
|
|
IF(K(N+2,2).EQ.0) GOTO 260
|
|
P(N+2,5)=PYMASS(K(N+2,2))
|
|
|
|
C...Find parton/particle which combines to largest extra mass.
|
|
IR=0
|
|
HA=0D0
|
|
HSM=0D0
|
|
DO 280 MCOMB=1,3
|
|
IF(IR.NE.0) GOTO 280
|
|
DO 270 I=MAX(1,IP),N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10.OR.(I.GE.IC1.AND.I.LE.IC2
|
|
& .AND.K(I,1).GE.1.AND.K(I,1).LE.2)) GOTO 270
|
|
IF(MCOMB.EQ.1) KCI=PYCOMP(K(I,2))
|
|
IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 270
|
|
IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 270
|
|
IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100)
|
|
& GOTO 270
|
|
HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3)
|
|
HSR=2D0*HCR+PECM**2-P(N+2,5)**2-2D0*P(N+2,5)*P(I,5)
|
|
IF(HSR.GT.HSM) THEN
|
|
IR=I
|
|
HA=HCR
|
|
HSM=HSR
|
|
ENDIF
|
|
270 CONTINUE
|
|
280 CONTINUE
|
|
|
|
C...Shuffle energy and momentum to put new particle on mass shell.
|
|
IF(IR.NE.0) THEN
|
|
HB=PECM**2+HA
|
|
HC=P(N+2,5)**2+HA
|
|
HD=P(IR,5)**2+HA
|
|
HK2=0.5D0*(HB*SQRT(MAX(0D0,((HB+HC)**2-4D0*(HB+HD)*P(N+2,5)**2)/
|
|
& (HA**2-(PECM*P(IR,5))**2)))-(HB+HC))/(HB+HD)
|
|
HK1=(0.5D0*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB
|
|
DO 290 J=1,4
|
|
P(N+2,J)=(1D0+HK1)*DPC(J)-HK2*P(IR,J)
|
|
P(IR,J)=(1D0+HK2)*P(IR,J)-HK1*DPC(J)
|
|
V(N+1,J)=V(IC1,J)
|
|
V(N+2,J)=V(IC1,J)
|
|
290 CONTINUE
|
|
V(N+1,5)=0D0
|
|
V(N+2,5)=0D0
|
|
N=N+2
|
|
ELSE
|
|
CALL PYERRM(3,'(PYPREP:) no match for collapsing cluster')
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Mark collapsed system and store daughter pointers. Iterate.
|
|
300 DO 310 I=IC1,IC2
|
|
IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.KCHG(PYCOMP(K(I,2)),2).NE.0)
|
|
& THEN
|
|
K(I,1)=K(I,1)+10
|
|
IF(MSTU(16).NE.2) THEN
|
|
K(I,4)=NSAV+1
|
|
K(I,5)=NSAV+1
|
|
ELSE
|
|
K(I,4)=NSAV+2
|
|
K(I,5)=N
|
|
ENDIF
|
|
ENDIF
|
|
310 CONTINUE
|
|
IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 140
|
|
|
|
C...Check flavours and invariant masses in parton systems.
|
|
320 NP=0
|
|
KFN=0
|
|
KQS=0
|
|
DO 330 J=1,5
|
|
DPS(J)=0D0
|
|
330 CONTINUE
|
|
DO 360 I=MAX(1,IP),N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0) GOTO 360
|
|
KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
|
|
IF(KQ.EQ.0) GOTO 360
|
|
NP=NP+1
|
|
IF(KQ.NE.2) THEN
|
|
KFN=KFN+1
|
|
KQS=KQS+KQ
|
|
MSTJ(93)=1
|
|
DPS(5)=DPS(5)+PYMASS(K(I,2))
|
|
ENDIF
|
|
DO 340 J=1,4
|
|
DPS(J)=DPS(J)+P(I,J)
|
|
340 CONTINUE
|
|
IF(K(I,1).EQ.1) THEN
|
|
IF(NP.NE.1.AND.(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0)) CALL
|
|
& PYERRM(2,'(PYPREP:) unphysical flavour combination')
|
|
IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT.
|
|
& (0.9D0*PARJ(32)+DPS(5))**2) CALL PYERRM(3,
|
|
& '(PYPREP:) too small mass in jet system')
|
|
NP=0
|
|
KFN=0
|
|
KQS=0
|
|
DO 350 J=1,5
|
|
DPS(J)=0D0
|
|
350 CONTINUE
|
|
ENDIF
|
|
360 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYSTRF
|
|
C...Handles the fragmentation of an arbitrary colour singlet
|
|
C...jet system according to the Lund string fragmentation model.
|
|
|
|
SUBROUTINE PYSTRF(IP)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/
|
|
C...Local arrays.
|
|
DIMENSION DPS(5),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2),
|
|
&IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(3),PJU(5,5),
|
|
&TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8)
|
|
|
|
C...Function: four-product of two vectors.
|
|
FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3)
|
|
DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)-
|
|
&DP(I,3)*DP(J,3)
|
|
|
|
C...Reset counters. Identify parton system.
|
|
MSTJ(91)=0
|
|
NSAV=N
|
|
MSTU90=MSTU(90)
|
|
NP=0
|
|
KQSUM=0
|
|
DO 100 J=1,5
|
|
DPS(J)=0D0
|
|
100 CONTINUE
|
|
MJU(1)=0
|
|
MJU(2)=0
|
|
I=IP-1
|
|
110 I=I+1
|
|
IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN
|
|
CALL PYERRM(12,'(PYSTRF:) failed to reconstruct jet system')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0) GOTO 110
|
|
KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
|
|
IF(KQ.EQ.0) GOTO 110
|
|
IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
|
|
C...Take copy of partons to be considered. Check flavour sum.
|
|
NP=NP+1
|
|
DO 120 J=1,5
|
|
K(N+NP,J)=K(I,J)
|
|
P(N+NP,J)=P(I,J)
|
|
IF(J.NE.4) DPS(J)=DPS(J)+P(I,J)
|
|
120 CONTINUE
|
|
DPS(4)=DPS(4)+SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
|
|
K(N+NP,3)=I
|
|
IF(KQ.NE.2) KQSUM=KQSUM+KQ
|
|
IF(K(I,1).EQ.41) THEN
|
|
KQSUM=KQSUM+2*KQ
|
|
IF(KQSUM.EQ.KQ) MJU(1)=N+NP
|
|
IF(KQSUM.NE.KQ) MJU(2)=N+NP
|
|
ENDIF
|
|
IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110
|
|
IF(KQSUM.NE.0) THEN
|
|
CALL PYERRM(12,'(PYSTRF:) unphysical flavour combination')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
|
|
C...Boost copied system to CM frame (for better numerical precision).
|
|
IF(ABS(DPS(3)).LT.0.99D0*DPS(4)) THEN
|
|
MBST=0
|
|
MSTU(33)=1
|
|
CALL PYROBO(N+1,N+NP,0D0,0D0,-DPS(1)/DPS(4),-DPS(2)/DPS(4),
|
|
& -DPS(3)/DPS(4))
|
|
ELSE
|
|
MBST=1
|
|
HHBZ=SQRT(MAX(1D-6,DPS(4)+DPS(3))/MAX(1D-6,DPS(4)-DPS(3)))
|
|
DO 130 I=N+1,N+NP
|
|
HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2
|
|
IF(P(I,3).GT.0D0) THEN
|
|
HHPEZ=(P(I,4)+P(I,3))/HHBZ
|
|
P(I,3)=0.5D0*(HHPEZ-HHPMT/HHPEZ)
|
|
P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ)
|
|
ELSE
|
|
HHPEZ=(P(I,4)-P(I,3))*HHBZ
|
|
P(I,3)=-0.5D0*(HHPEZ-HHPMT/HHPEZ)
|
|
P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ)
|
|
ENDIF
|
|
130 CONTINUE
|
|
ENDIF
|
|
|
|
C...Search for very nearby partons that may be recombined.
|
|
NTRYR=0
|
|
PARU12=PARU(12)
|
|
PARU13=PARU(13)
|
|
MJU(3)=MJU(1)
|
|
MJU(4)=MJU(2)
|
|
NR=NP
|
|
140 IF(NR.GE.3) THEN
|
|
PDRMIN=2D0*PARU12
|
|
DO 150 I=N+1,N+NR
|
|
IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 150
|
|
I1=I+1
|
|
IF(I.EQ.N+NR) I1=N+1
|
|
IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 150
|
|
IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21)
|
|
& GOTO 150
|
|
IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21)
|
|
& GOTO 150
|
|
PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+
|
|
& P(I1,2)**2+P(I1,3)**2))
|
|
PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3)
|
|
PDR=4D0*(PAP-PVP)**2/MAX(1D-6,PARU13**2*PAP+2D0*(PAP-PVP))
|
|
IF(PDR.LT.PDRMIN) THEN
|
|
IR=I
|
|
PDRMIN=PDR
|
|
ENDIF
|
|
150 CONTINUE
|
|
|
|
C...Recombine very nearby partons to avoid machine precision problems.
|
|
IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN
|
|
DO 160 J=1,4
|
|
P(N+1,J)=P(N+1,J)+P(N+NR,J)
|
|
160 CONTINUE
|
|
P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2-
|
|
& P(N+1,3)**2))
|
|
NR=NR-1
|
|
GOTO 140
|
|
ELSEIF(PDRMIN.LT.PARU12) THEN
|
|
DO 170 J=1,4
|
|
P(IR,J)=P(IR,J)+P(IR+1,J)
|
|
170 CONTINUE
|
|
P(IR,5)=SQRT(MAX(0D0,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2-
|
|
& P(IR,3)**2))
|
|
DO 190 I=IR+1,N+NR-1
|
|
K(I,2)=K(I+1,2)
|
|
DO 180 J=1,5
|
|
P(I,J)=P(I+1,J)
|
|
180 CONTINUE
|
|
190 CONTINUE
|
|
IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2)
|
|
NR=NR-1
|
|
IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1
|
|
IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1
|
|
GOTO 140
|
|
ENDIF
|
|
ENDIF
|
|
NTRYR=NTRYR+1
|
|
|
|
C...Reset particle counter. Skip ahead if no junctions are present;
|
|
C...this is usually the case!
|
|
NRS=MAX(5*NR+11,NP)
|
|
NTRY=0
|
|
200 NTRY=NTRY+1
|
|
IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
|
|
PARU12=4D0*PARU12
|
|
PARU13=2D0*PARU13
|
|
GOTO 140
|
|
ELSEIF(NTRY.GT.100) THEN
|
|
CALL PYERRM(14,'(PYSTRF:) caught in infinite loop')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
I=N+NRS
|
|
MSTU(90)=MSTU90
|
|
IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 580
|
|
DO 570 JT=1,2
|
|
NJS(JT)=0
|
|
IF(MJU(JT).EQ.0) GOTO 570
|
|
JS=3-2*JT
|
|
|
|
C...Find and sum up momentum on three sides of junction. Check flavours.
|
|
DO 220 IU=1,3
|
|
IJU(IU)=0
|
|
DO 210 J=1,5
|
|
PJU(IU,J)=0D0
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
IU=0
|
|
DO 240 I1=N+1+(JT-1)*(NR-1),N+NR+(JT-1)*(1-NR),JS
|
|
IF(K(I1,2).NE.21.AND.IU.LE.2) THEN
|
|
IU=IU+1
|
|
IJU(IU)=I1
|
|
ENDIF
|
|
DO 230 J=1,4
|
|
PJU(IU,J)=PJU(IU,J)+P(I1,J)
|
|
230 CONTINUE
|
|
240 CONTINUE
|
|
DO 250 IU=1,3
|
|
PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)
|
|
250 CONTINUE
|
|
IF(K(IJU(3),2)/100.NE.10*K(IJU(1),2)+K(IJU(2),2).AND.
|
|
& K(IJU(3),2)/100.NE.10*K(IJU(2),2)+K(IJU(1),2)) THEN
|
|
CALL PYERRM(12,'(PYSTRF:) unphysical flavour combination')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
|
|
C...Calculate (approximate) boost to rest frame of junction.
|
|
T12=(PJU(1,1)*PJU(2,1)+PJU(1,2)*PJU(2,2)+PJU(1,3)*PJU(2,3))/
|
|
& (PJU(1,5)*PJU(2,5))
|
|
T13=(PJU(1,1)*PJU(3,1)+PJU(1,2)*PJU(3,2)+PJU(1,3)*PJU(3,3))/
|
|
& (PJU(1,5)*PJU(3,5))
|
|
T23=(PJU(2,1)*PJU(3,1)+PJU(2,2)*PJU(3,2)+PJU(2,3)*PJU(3,3))/
|
|
& (PJU(2,5)*PJU(3,5))
|
|
T11=SQRT((2D0/3D0)*(1D0-T12)*(1D0-T13)/(1D0-T23))
|
|
T22=SQRT((2D0/3D0)*(1D0-T12)*(1D0-T23)/(1D0-T13))
|
|
TSQ=SQRT((2D0*T11*T22+T12-1D0)*(1D0+T12))
|
|
T1F=(TSQ-T22*(1D0+T12))/(1D0-T12**2)
|
|
T2F=(TSQ-T11*(1D0+T12))/(1D0-T12**2)
|
|
DO 260 J=1,3
|
|
TJU(J)=-(T1F*PJU(1,J)/PJU(1,5)+T2F*PJU(2,J)/PJU(2,5))
|
|
260 CONTINUE
|
|
TJU(4)=SQRT(1D0+TJU(1)**2+TJU(2)**2+TJU(3)**2)
|
|
DO 270 IU=1,3
|
|
PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)-
|
|
& TJU(3)*PJU(IU,3)
|
|
270 CONTINUE
|
|
|
|
C...Put junction at rest if motion could give inconsistencies.
|
|
IF(PJU(1,5)+PJU(2,5).GT.PJU(1,4)+PJU(2,4)) THEN
|
|
DO 280 J=1,3
|
|
TJU(J)=0D0
|
|
280 CONTINUE
|
|
TJU(4)=1D0
|
|
PJU(1,5)=PJU(1,4)
|
|
PJU(2,5)=PJU(2,4)
|
|
PJU(3,5)=PJU(3,4)
|
|
ENDIF
|
|
|
|
C...Start preparing for fragmentation of two strings from junction.
|
|
ISTA=I
|
|
DO 550 IU=1,2
|
|
NS=IJU(IU+1)-IJU(IU)
|
|
|
|
C...Junction strings: find longitudinal string directions.
|
|
DO 310 IS=1,NS
|
|
IS1=IJU(IU)+IS-1
|
|
IS2=IJU(IU)+IS
|
|
DO 290 J=1,5
|
|
DP(1,J)=0.5D0*P(IS1,J)
|
|
IF(IS.EQ.1) DP(1,J)=P(IS1,J)
|
|
DP(2,J)=0.5D0*P(IS2,J)
|
|
IF(IS.EQ.NS) DP(2,J)=-PJU(IU,J)
|
|
290 CONTINUE
|
|
IF(IS.EQ.NS) DP(2,4)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+
|
|
& PJU(IU,3)**2)
|
|
IF(IS.EQ.NS) DP(2,5)=0D0
|
|
DP(3,5)=DFOUR(1,1)
|
|
DP(4,5)=DFOUR(2,2)
|
|
DHKC=DFOUR(1,2)
|
|
IF(DP(3,5)+2D0*DHKC+DP(4,5).LE.0D0) THEN
|
|
DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
|
|
DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
|
|
DP(3,5)=0D0
|
|
DP(4,5)=0D0
|
|
DHKC=DFOUR(1,2)
|
|
ENDIF
|
|
DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5))
|
|
DHK1=0.5D0*((DP(4,5)+DHKC)/DHKS-1D0)
|
|
DHK2=0.5D0*((DP(3,5)+DHKC)/DHKS-1D0)
|
|
IN1=N+NR+4*IS-3
|
|
P(IN1,5)=SQRT(DP(3,5)+2D0*DHKC+DP(4,5))
|
|
DO 300 J=1,4
|
|
P(IN1,J)=(1D0+DHK1)*DP(1,J)-DHK2*DP(2,J)
|
|
P(IN1+1,J)=(1D0+DHK2)*DP(2,J)-DHK1*DP(1,J)
|
|
300 CONTINUE
|
|
310 CONTINUE
|
|
|
|
C...Junction strings: initialize flavour, momentum and starting pos.
|
|
ISAV=I
|
|
MSTU91=MSTU(90)
|
|
320 NTRY=NTRY+1
|
|
IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
|
|
PARU12=4D0*PARU12
|
|
PARU13=2D0*PARU13
|
|
GOTO 140
|
|
ELSEIF(NTRY.GT.100) THEN
|
|
CALL PYERRM(14,'(PYSTRF:) caught in infinite loop')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
I=ISAV
|
|
MSTU(90)=MSTU91
|
|
IRANKJ=0
|
|
IE(1)=K(N+1+(JT/2)*(NP-1),3)
|
|
IN(4)=N+NR+1
|
|
IN(5)=IN(4)+1
|
|
IN(6)=N+NR+4*NS+1
|
|
DO 340 JQ=1,2
|
|
DO 330 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4
|
|
P(IN1,1)=2-JQ
|
|
P(IN1,2)=JQ-1
|
|
P(IN1,3)=1D0
|
|
330 CONTINUE
|
|
340 CONTINUE
|
|
KFL(1)=K(IJU(IU),2)
|
|
PX(1)=0D0
|
|
PY(1)=0D0
|
|
GAM(1)=0D0
|
|
DO 350 J=1,5
|
|
PJU(IU+3,J)=0D0
|
|
350 CONTINUE
|
|
|
|
C...Junction strings: find initial transverse directions.
|
|
DO 360 J=1,4
|
|
DP(1,J)=P(IN(4),J)
|
|
DP(2,J)=P(IN(4)+1,J)
|
|
DP(3,J)=0D0
|
|
DP(4,J)=0D0
|
|
360 CONTINUE
|
|
DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
|
|
DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
|
|
DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
|
|
DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
|
|
DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
|
|
IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1D0
|
|
IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0
|
|
IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0
|
|
IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0
|
|
DHC12=DFOUR(1,2)
|
|
DHCX1=DFOUR(3,1)/DHC12
|
|
DHCX2=DFOUR(3,2)/DHC12
|
|
DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
|
|
DHCY1=DFOUR(4,1)/DHC12
|
|
DHCY2=DFOUR(4,2)/DHC12
|
|
DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
|
|
DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
|
|
DO 370 J=1,4
|
|
DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
|
|
P(IN(6),J)=DP(3,J)
|
|
P(IN(6)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
|
|
& DHCYX*DP(3,J))
|
|
370 CONTINUE
|
|
|
|
C...Junction strings: produce new particle, origin.
|
|
380 I=I+1
|
|
IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
IRANKJ=IRANKJ+1
|
|
K(I,1)=1
|
|
K(I,3)=IE(1)
|
|
K(I,4)=0
|
|
K(I,5)=0
|
|
|
|
C...Junction strings: generate flavour, hadron, pT, z and Gamma.
|
|
390 CALL PYKFDI(KFL(1),0,KFL(3),K(I,2))
|
|
IF(K(I,2).EQ.0) GOTO 320
|
|
IF(MSTJ(12).GE.3.AND.IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND.
|
|
& IABS(KFL(3)).GT.10) THEN
|
|
IF(PYR(0).GT.PARJ(19)) GOTO 390
|
|
ENDIF
|
|
P(I,5)=PYMASS(K(I,2))
|
|
CALL PYPTDI(KFL(1),PX(3),PY(3))
|
|
PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2
|
|
CALL PYZDIS(KFL(1),KFL(3),PR(1),Z)
|
|
IF(IABS(KFL(1)).GE.4.AND.IABS(KFL(1)).LE.8.AND.
|
|
& MSTU(90).LT.8) THEN
|
|
MSTU(90)=MSTU(90)+1
|
|
MSTU(90+MSTU(90))=I
|
|
PARU(90+MSTU(90))=Z
|
|
ENDIF
|
|
GAM(3)=(1D0-Z)*(GAM(1)+PR(1)/Z)
|
|
DO 400 J=1,3
|
|
IN(J)=IN(3+J)
|
|
400 CONTINUE
|
|
|
|
C...Junction strings: stepping within or from 'low' string region easy.
|
|
IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)*
|
|
& P(IN(1),5)**2.GE.PR(1)) THEN
|
|
P(IN(1)+2,4)=Z*P(IN(1)+2,3)
|
|
P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2)
|
|
DO 410 J=1,4
|
|
P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J)
|
|
410 CONTINUE
|
|
GOTO 500
|
|
ELSEIF(IN(1)+1.EQ.IN(2)) THEN
|
|
P(IN(2)+2,4)=P(IN(2)+2,3)
|
|
P(IN(2)+2,1)=1D0
|
|
IN(2)=IN(2)+4
|
|
IF(IN(2).GT.N+NR+4*NS) GOTO 320
|
|
IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN
|
|
P(IN(1)+2,4)=P(IN(1)+2,3)
|
|
P(IN(1)+2,1)=0D0
|
|
IN(1)=IN(1)+4
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Junction strings: find new transverse directions.
|
|
420 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR.
|
|
& IN(1).GT.IN(2)) GOTO 320
|
|
IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN
|
|
DO 430 J=1,4
|
|
DP(1,J)=P(IN(1),J)
|
|
DP(2,J)=P(IN(2),J)
|
|
DP(3,J)=0D0
|
|
DP(4,J)=0D0
|
|
430 CONTINUE
|
|
DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
|
|
DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
|
|
DHC12=DFOUR(1,2)
|
|
IF(DHC12.LE.1D-2) THEN
|
|
P(IN(1)+2,4)=P(IN(1)+2,3)
|
|
P(IN(1)+2,1)=0D0
|
|
IN(1)=IN(1)+4
|
|
GOTO 420
|
|
ENDIF
|
|
IN(3)=N+NR+4*NS+5
|
|
DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
|
|
DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
|
|
DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
|
|
IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1D0
|
|
IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0
|
|
IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0
|
|
IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0
|
|
DHCX1=DFOUR(3,1)/DHC12
|
|
DHCX2=DFOUR(3,2)/DHC12
|
|
DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
|
|
DHCY1=DFOUR(4,1)/DHC12
|
|
DHCY2=DFOUR(4,2)/DHC12
|
|
DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
|
|
DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
|
|
DO 440 J=1,4
|
|
DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
|
|
P(IN(3),J)=DP(3,J)
|
|
P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
|
|
& DHCYX*DP(3,J))
|
|
440 CONTINUE
|
|
C...Express pT with respect to new axes, if sensible.
|
|
PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3)))
|
|
PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1))
|
|
IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01D0) THEN
|
|
PX(3)=PXP
|
|
PY(3)=PYP
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Junction strings: sum up known four-momentum, coefficients for m2.
|
|
DO 470 J=1,4
|
|
DHG(J)=0D0
|
|
P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+
|
|
& PY(3)*P(IN(3)+1,J)
|
|
DO 450 IN1=IN(4),IN(1)-4,4
|
|
P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)
|
|
450 CONTINUE
|
|
DO 460 IN2=IN(5),IN(2)-4,4
|
|
P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)
|
|
460 CONTINUE
|
|
470 CONTINUE
|
|
DHM(1)=FOUR(I,I)
|
|
DHM(2)=2D0*FOUR(I,IN(1))
|
|
DHM(3)=2D0*FOUR(I,IN(2))
|
|
DHM(4)=2D0*FOUR(IN(1),IN(2))
|
|
|
|
C...Junction strings: find coefficients for Gamma expression.
|
|
DO 490 IN2=IN(1)+1,IN(2),4
|
|
DO 480 IN1=IN(1),IN2-1,4
|
|
DHC=2D0*FOUR(IN1,IN2)
|
|
DHG(1)=DHG(1)+P(IN1+2,1)*P(IN2+2,1)*DHC
|
|
IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-P(IN2+2,1)*DHC
|
|
IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+P(IN1+2,1)*DHC
|
|
IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC
|
|
480 CONTINUE
|
|
490 CONTINUE
|
|
|
|
C...Junction strings: solve (m2, Gamma) equation system for energies.
|
|
DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3)
|
|
IF(ABS(DHS1).LT.1D-4) GOTO 320
|
|
DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(2)*DHG(3)-DHG(4)*
|
|
& (P(I,5)**2-DHM(1))+DHG(2)*DHM(3)
|
|
DHS3=DHM(2)*(GAM(3)-DHG(1))-DHG(2)*(P(I,5)**2-DHM(1))
|
|
P(IN(2)+2,4)=0.5D0*(SQRT(MAX(0D0,DHS2**2-4D0*DHS1*DHS3))/
|
|
& ABS(DHS1)-DHS2/DHS1)
|
|
IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0D0) GOTO 320
|
|
P(IN(1)+2,4)=(P(I,5)**2-DHM(1)-DHM(3)*P(IN(2)+2,4))/
|
|
& (DHM(2)+DHM(4)*P(IN(2)+2,4))
|
|
|
|
C...Junction strings: step to new region if necessary.
|
|
IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN
|
|
P(IN(2)+2,4)=P(IN(2)+2,3)
|
|
P(IN(2)+2,1)=1D0
|
|
IN(2)=IN(2)+4
|
|
IF(IN(2).GT.N+NR+4*NS) GOTO 320
|
|
IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN
|
|
P(IN(1)+2,4)=P(IN(1)+2,3)
|
|
P(IN(1)+2,1)=0D0
|
|
IN(1)=IN(1)+4
|
|
ENDIF
|
|
GOTO 420
|
|
ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN
|
|
P(IN(1)+2,4)=P(IN(1)+2,3)
|
|
P(IN(1)+2,1)=0D0
|
|
IN(1)=IN(1)+JS
|
|
GOTO 820
|
|
ENDIF
|
|
|
|
C...Junction strings: particle four-momentum, remainder, loop back.
|
|
500 DO 510 J=1,4
|
|
P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+
|
|
& P(IN(2)+2,4)*P(IN(2),J)
|
|
PJU(IU+3,J)=PJU(IU+3,J)+P(I,J)
|
|
510 CONTINUE
|
|
IF(P(I,4).LT.P(I,5)) GOTO 320
|
|
PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)-
|
|
& TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3)
|
|
IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN
|
|
KFL(1)=-KFL(3)
|
|
PX(1)=-PX(3)
|
|
PY(1)=-PY(3)
|
|
GAM(1)=GAM(3)
|
|
IF(IN(3).NE.IN(6)) THEN
|
|
DO 520 J=1,4
|
|
P(IN(6),J)=P(IN(3),J)
|
|
P(IN(6)+1,J)=P(IN(3)+1,J)
|
|
520 CONTINUE
|
|
ENDIF
|
|
DO 530 JQ=1,2
|
|
IN(3+JQ)=IN(JQ)
|
|
P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4)
|
|
P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4)
|
|
530 CONTINUE
|
|
GOTO 380
|
|
ENDIF
|
|
|
|
C...Junction strings: save quantities left after each string.
|
|
IF(IABS(KFL(1)).GT.10) GOTO 320
|
|
I=I-1
|
|
KFJH(IU)=KFL(1)
|
|
DO 540 J=1,4
|
|
PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J)
|
|
540 CONTINUE
|
|
550 CONTINUE
|
|
|
|
C...Junction strings: put together to new effective string endpoint.
|
|
NJS(JT)=I-ISTA
|
|
KFJS(JT)=K(K(MJU(JT+2),3),2)
|
|
KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1
|
|
IF(KFJH(1).EQ.KFJH(2)) KFLS=3
|
|
IF(ISTA.NE.I) KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)),
|
|
& IABS(KFJH(2)))+100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+
|
|
& KFLS,KFJH(1))
|
|
DO 560 J=1,4
|
|
PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J)
|
|
PJS(JT+2,J)=PJU(4,J)+PJU(5,J)
|
|
560 CONTINUE
|
|
PJS(JT,5)=SQRT(MAX(0D0,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2-
|
|
& PJS(JT,3)**2))
|
|
570 CONTINUE
|
|
|
|
C...Open versus closed strings. Choose breakup region for latter.
|
|
580 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN
|
|
NS=MJU(2)-MJU(1)
|
|
NB=MJU(1)-N
|
|
ELSEIF(MJU(1).NE.0) THEN
|
|
NS=N+NR-MJU(1)
|
|
NB=MJU(1)-N
|
|
ELSEIF(MJU(2).NE.0) THEN
|
|
NS=MJU(2)-N
|
|
NB=1
|
|
ELSEIF(IABS(K(N+1,2)).NE.21) THEN
|
|
NS=NR-1
|
|
NB=1
|
|
ELSE
|
|
NS=NR+1
|
|
W2SUM=0D0
|
|
DO 590 IS=1,NR
|
|
P(N+NR+IS,1)=0.5D0*FOUR(N+IS,N+IS+1-NR*(IS/NR))
|
|
W2SUM=W2SUM+P(N+NR+IS,1)
|
|
590 CONTINUE
|
|
W2RAN=PYR(0)*W2SUM
|
|
NB=0
|
|
600 NB=NB+1
|
|
W2SUM=W2SUM-P(N+NR+NB,1)
|
|
IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 600
|
|
ENDIF
|
|
|
|
C...Find longitudinal string directions (i.e. lightlike four-vectors).
|
|
DO 630 IS=1,NS
|
|
IS1=N+IS+NB-1-NR*((IS+NB-2)/NR)
|
|
IS2=N+IS+NB-NR*((IS+NB-1)/NR)
|
|
DO 610 J=1,5
|
|
DP(1,J)=P(IS1,J)
|
|
IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5D0*DP(1,J)
|
|
IF(IS1.EQ.MJU(1)) DP(1,J)=PJS(1,J)-PJS(3,J)
|
|
DP(2,J)=P(IS2,J)
|
|
IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5D0*DP(2,J)
|
|
IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J)
|
|
610 CONTINUE
|
|
DP(3,5)=DFOUR(1,1)
|
|
DP(4,5)=DFOUR(2,2)
|
|
DHKC=DFOUR(1,2)
|
|
IF(DP(3,5)+2D0*DHKC+DP(4,5).LE.0D0) THEN
|
|
DP(3,5)=DP(1,5)**2
|
|
DP(4,5)=DP(2,5)**2
|
|
DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2+DP(1,5)**2)
|
|
DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2+DP(2,5)**2)
|
|
DHKC=DFOUR(1,2)
|
|
ENDIF
|
|
DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5))
|
|
DHK1=0.5D0*((DP(4,5)+DHKC)/DHKS-1D0)
|
|
DHK2=0.5D0*((DP(3,5)+DHKC)/DHKS-1D0)
|
|
IN1=N+NR+4*IS-3
|
|
P(IN1,5)=SQRT(DP(3,5)+2D0*DHKC+DP(4,5))
|
|
DO 620 J=1,4
|
|
P(IN1,J)=(1D0+DHK1)*DP(1,J)-DHK2*DP(2,J)
|
|
P(IN1+1,J)=(1D0+DHK2)*DP(2,J)-DHK1*DP(1,J)
|
|
620 CONTINUE
|
|
630 CONTINUE
|
|
|
|
C...Begin initialization: sum up energy, set starting position.
|
|
ISAV=I
|
|
MSTU91=MSTU(90)
|
|
640 NTRY=NTRY+1
|
|
IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
|
|
PARU12=4D0*PARU12
|
|
PARU13=2D0*PARU13
|
|
GOTO 140
|
|
ELSEIF(NTRY.GT.100) THEN
|
|
CALL PYERRM(14,'(PYSTRF:) caught in infinite loop')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
I=ISAV
|
|
MSTU(90)=MSTU91
|
|
DO 660 J=1,4
|
|
P(N+NRS,J)=0D0
|
|
DO 650 IS=1,NR
|
|
P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J)
|
|
650 CONTINUE
|
|
660 CONTINUE
|
|
DO 680 JT=1,2
|
|
IRANK(JT)=0
|
|
IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT)
|
|
IF(NS.GT.NR) IRANK(JT)=1
|
|
IE(JT)=K(N+1+(JT/2)*(NP-1),3)
|
|
IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1)
|
|
IN(3*JT+2)=IN(3*JT+1)+1
|
|
IN(3*JT+3)=N+NR+4*NS+2*JT-1
|
|
DO 670 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4
|
|
P(IN1,1)=2-JT
|
|
P(IN1,2)=JT-1
|
|
P(IN1,3)=1D0
|
|
670 CONTINUE
|
|
680 CONTINUE
|
|
|
|
C...Initialize flavour and pT variables for open string.
|
|
IF(NS.LT.NR) THEN
|
|
PX(1)=0D0
|
|
PY(1)=0D0
|
|
IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL PYPTDI(0,PX(1),PY(1))
|
|
PX(2)=-PX(1)
|
|
PY(2)=-PY(1)
|
|
DO 690 JT=1,2
|
|
KFL(JT)=K(IE(JT),2)
|
|
IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT)
|
|
MSTJ(93)=1
|
|
PMQ(JT)=PYMASS(KFL(JT))
|
|
GAM(JT)=0D0
|
|
690 CONTINUE
|
|
|
|
C...Closed string: random initial breakup flavour, pT and vertex.
|
|
ELSE
|
|
KFL(3)=INT(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0)
|
|
CALL PYKFDI(KFL(3),0,KFL(1),KDUMP)
|
|
KFL(2)=-KFL(1)
|
|
IF(IABS(KFL(1)).GT.10.AND.PYR(0).GT.0.5D0) THEN
|
|
KFL(2)=-(KFL(1)+ISIGN(10000,KFL(1)))
|
|
ELSEIF(IABS(KFL(1)).GT.10) THEN
|
|
KFL(1)=-(KFL(2)+ISIGN(10000,KFL(2)))
|
|
ENDIF
|
|
CALL PYPTDI(KFL(1),PX(1),PY(1))
|
|
PX(2)=-PX(1)
|
|
PY(2)=-PY(1)
|
|
PR3=MIN(25D0,0.1D0*P(N+NR+1,5)**2)
|
|
700 CALL PYZDIS(KFL(1),KFL(2),PR3,Z)
|
|
ZR=PR3/(Z*P(N+NR+1,5)**2)
|
|
IF(ZR.GE.1D0) GOTO 700
|
|
DO 710 JT=1,2
|
|
MSTJ(93)=1
|
|
PMQ(JT)=PYMASS(KFL(JT))
|
|
GAM(JT)=PR3*(1D0-Z)/Z
|
|
IN1=N+NR+3+4*(JT/2)*(NS-1)
|
|
P(IN1,JT)=1D0-Z
|
|
P(IN1,3-JT)=JT-1
|
|
P(IN1,3)=(2-JT)*(1D0-Z)+(JT-1)*Z
|
|
P(IN1+1,JT)=ZR
|
|
P(IN1+1,3-JT)=2-JT
|
|
P(IN1+1,3)=(2-JT)*(1D0-ZR)+(JT-1)*ZR
|
|
710 CONTINUE
|
|
ENDIF
|
|
|
|
C...Find initial transverse directions (i.e. spacelike four-vectors).
|
|
DO 750 JT=1,2
|
|
IF(JT.EQ.1.OR.NS.EQ.NR-1) THEN
|
|
IN1=IN(3*JT+1)
|
|
IN3=IN(3*JT+3)
|
|
DO 720 J=1,4
|
|
DP(1,J)=P(IN1,J)
|
|
DP(2,J)=P(IN1+1,J)
|
|
DP(3,J)=0D0
|
|
DP(4,J)=0D0
|
|
720 CONTINUE
|
|
DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
|
|
DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
|
|
DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
|
|
DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
|
|
DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
|
|
IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1D0
|
|
IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0
|
|
IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0
|
|
IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0
|
|
DHC12=DFOUR(1,2)
|
|
DHCX1=DFOUR(3,1)/DHC12
|
|
DHCX2=DFOUR(3,2)/DHC12
|
|
DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
|
|
DHCY1=DFOUR(4,1)/DHC12
|
|
DHCY2=DFOUR(4,2)/DHC12
|
|
DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
|
|
DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
|
|
DO 730 J=1,4
|
|
DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
|
|
P(IN3,J)=DP(3,J)
|
|
P(IN3+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
|
|
& DHCYX*DP(3,J))
|
|
730 CONTINUE
|
|
ELSE
|
|
DO 740 J=1,4
|
|
P(IN3+2,J)=P(IN3,J)
|
|
P(IN3+3,J)=P(IN3+1,J)
|
|
740 CONTINUE
|
|
ENDIF
|
|
750 CONTINUE
|
|
|
|
C...Remove energy used up in junction string fragmentation.
|
|
IF(MJU(1)+MJU(2).GT.0) THEN
|
|
DO 770 JT=1,2
|
|
IF(NJS(JT).EQ.0) GOTO 770
|
|
DO 760 J=1,4
|
|
P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J)
|
|
760 CONTINUE
|
|
770 CONTINUE
|
|
ENDIF
|
|
|
|
C...Produce new particle: side, origin.
|
|
780 I=I+1
|
|
IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
JT=1.5D0+PYR(0)
|
|
IF(IABS(KFL(3-JT)).GT.10) JT=3-JT
|
|
IF(IABS(KFL(3-JT)).GE.4.AND.IABS(KFL(3-JT)).LE.8) JT=3-JT
|
|
JR=3-JT
|
|
JS=3-2*JT
|
|
IRANK(JT)=IRANK(JT)+1
|
|
K(I,1)=1
|
|
K(I,3)=IE(JT)
|
|
K(I,4)=0
|
|
K(I,5)=0
|
|
|
|
C...Generate flavour, hadron and pT.
|
|
790 CALL PYKFDI(KFL(JT),0,KFL(3),K(I,2))
|
|
IF(K(I,2).EQ.0) GOTO 640
|
|
IF(MSTJ(12).GE.3.AND.IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND.
|
|
&IABS(KFL(3)).GT.10) THEN
|
|
IF(PYR(0).GT.PARJ(19)) GOTO 790
|
|
ENDIF
|
|
P(I,5)=PYMASS(K(I,2))
|
|
CALL PYPTDI(KFL(JT),PX(3),PY(3))
|
|
PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2
|
|
|
|
C...Final hadrons for small invariant mass.
|
|
MSTJ(93)=1
|
|
PMQ(3)=PYMASS(KFL(3))
|
|
PARJST=PARJ(33)
|
|
IF(MSTJ(11).EQ.2) PARJST=PARJ(34)
|
|
WMIN=PARJST+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3)
|
|
IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN=
|
|
&WMIN-0.5D0*PARJ(36)*PMQ(3)
|
|
WREM2=FOUR(N+NRS,N+NRS)
|
|
IF(WREM2.LT.0.10D0) GOTO 640
|
|
IF(WREM2.LT.MAX(WMIN*(1D0+(2D0*PYR(0)-1D0)*PARJ(37)),
|
|
&PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 940
|
|
|
|
C...Choose z, which gives Gamma. Shift z for heavy flavours.
|
|
CALL PYZDIS(KFL(JT),KFL(3),PR(JT),Z)
|
|
IF(IABS(KFL(JT)).GE.4.AND.IABS(KFL(JT)).LE.8.AND.
|
|
&MSTU(90).LT.8) THEN
|
|
MSTU(90)=MSTU(90)+1
|
|
MSTU(90+MSTU(90))=I
|
|
PARU(90+MSTU(90))=Z
|
|
ENDIF
|
|
KFL1A=IABS(KFL(1))
|
|
KFL2A=IABS(KFL(2))
|
|
IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10),
|
|
&MOD(KFL2A/1000,10)).GE.4) THEN
|
|
PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
|
|
PW12=SQRT(MAX(0D0,(WREM2-PR(1)-PR(2))**2-4D0*PR(1)*PR(2)))
|
|
Z=(WREM2+PR(JT)-PR(JR)+PW12*(2D0*Z-1D0))/(2D0*WREM2)
|
|
PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
|
|
IF((1D0-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 940
|
|
ENDIF
|
|
GAM(3)=(1D0-Z)*(GAM(JT)+PR(JT)/Z)
|
|
DO 800 J=1,3
|
|
IN(J)=IN(3*JT+J)
|
|
800 CONTINUE
|
|
|
|
C...Stepping within or from 'low' string region easy.
|
|
IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)*
|
|
&P(IN(1),5)**2.GE.PR(JT)) THEN
|
|
P(IN(JT)+2,4)=Z*P(IN(JT)+2,3)
|
|
P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2)
|
|
DO 810 J=1,4
|
|
P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J)
|
|
810 CONTINUE
|
|
GOTO 900
|
|
ELSEIF(IN(1)+1.EQ.IN(2)) THEN
|
|
P(IN(JR)+2,4)=P(IN(JR)+2,3)
|
|
P(IN(JR)+2,JT)=1D0
|
|
IN(JR)=IN(JR)+4*JS
|
|
IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640
|
|
IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN
|
|
P(IN(JT)+2,4)=P(IN(JT)+2,3)
|
|
P(IN(JT)+2,JT)=0D0
|
|
IN(JT)=IN(JT)+4*JS
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Find new transverse directions (i.e. spacelike string vectors).
|
|
820 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR.
|
|
&IN(1).GT.IN(2)) GOTO 640
|
|
IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN
|
|
DO 830 J=1,4
|
|
DP(1,J)=P(IN(1),J)
|
|
DP(2,J)=P(IN(2),J)
|
|
DP(3,J)=0D0
|
|
DP(4,J)=0D0
|
|
830 CONTINUE
|
|
DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
|
|
DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
|
|
DHC12=DFOUR(1,2)
|
|
IF(DHC12.LE.1D-2) THEN
|
|
P(IN(JT)+2,4)=P(IN(JT)+2,3)
|
|
P(IN(JT)+2,JT)=0D0
|
|
IN(JT)=IN(JT)+4*JS
|
|
GOTO 820
|
|
ENDIF
|
|
IN(3)=N+NR+4*NS+5
|
|
DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
|
|
DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
|
|
DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
|
|
IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1D0
|
|
IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0
|
|
IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0
|
|
IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0
|
|
DHCX1=DFOUR(3,1)/DHC12
|
|
DHCX2=DFOUR(3,2)/DHC12
|
|
DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
|
|
DHCY1=DFOUR(4,1)/DHC12
|
|
DHCY2=DFOUR(4,2)/DHC12
|
|
DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
|
|
DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
|
|
DO 840 J=1,4
|
|
DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
|
|
P(IN(3),J)=DP(3,J)
|
|
P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
|
|
& DHCYX*DP(3,J))
|
|
840 CONTINUE
|
|
C...Express pT with respect to new axes, if sensible.
|
|
PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)*
|
|
& FOUR(IN(3*JT+3)+1,IN(3)))
|
|
PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)*
|
|
& FOUR(IN(3*JT+3)+1,IN(3)+1))
|
|
IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01D0) THEN
|
|
PX(3)=PXP
|
|
PY(3)=PYP
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Sum up known four-momentum. Gives coefficients for m2 expression.
|
|
DO 870 J=1,4
|
|
DHG(J)=0D0
|
|
P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+
|
|
& PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J)
|
|
DO 850 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS
|
|
P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)
|
|
850 CONTINUE
|
|
DO 860 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS
|
|
P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)
|
|
860 CONTINUE
|
|
870 CONTINUE
|
|
DHM(1)=FOUR(I,I)
|
|
DHM(2)=2D0*FOUR(I,IN(1))
|
|
DHM(3)=2D0*FOUR(I,IN(2))
|
|
DHM(4)=2D0*FOUR(IN(1),IN(2))
|
|
|
|
C...Find coefficients for Gamma expression.
|
|
DO 890 IN2=IN(1)+1,IN(2),4
|
|
DO 880 IN1=IN(1),IN2-1,4
|
|
DHC=2D0*FOUR(IN1,IN2)
|
|
DHG(1)=DHG(1)+P(IN1+2,JT)*P(IN2+2,JT)*DHC
|
|
IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-JS*P(IN2+2,JT)*DHC
|
|
IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+JS*P(IN1+2,JT)*DHC
|
|
IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC
|
|
880 CONTINUE
|
|
890 CONTINUE
|
|
|
|
C...Solve (m2, Gamma) equation system for energies taken.
|
|
DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1)
|
|
IF(ABS(DHS1).LT.1D-4) GOTO 640
|
|
DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)*
|
|
&(P(I,5)**2-DHM(1))+DHG(JT+1)*DHM(JR+1)
|
|
DHS3=DHM(JT+1)*(GAM(3)-DHG(1))-DHG(JT+1)*(P(I,5)**2-DHM(1))
|
|
P(IN(JR)+2,4)=0.5D0*(SQRT(MAX(0D0,DHS2**2-4D0*DHS1*DHS3))/
|
|
&ABS(DHS1)-DHS2/DHS1)
|
|
IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0D0) GOTO 640
|
|
P(IN(JT)+2,4)=(P(I,5)**2-DHM(1)-DHM(JR+1)*P(IN(JR)+2,4))/
|
|
&(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4))
|
|
|
|
C...Step to new region if necessary.
|
|
IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN
|
|
P(IN(JR)+2,4)=P(IN(JR)+2,3)
|
|
P(IN(JR)+2,JT)=1D0
|
|
IN(JR)=IN(JR)+4*JS
|
|
IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640
|
|
IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN
|
|
P(IN(JT)+2,4)=P(IN(JT)+2,3)
|
|
P(IN(JT)+2,JT)=0D0
|
|
IN(JT)=IN(JT)+4*JS
|
|
ENDIF
|
|
GOTO 820
|
|
ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN
|
|
P(IN(JT)+2,4)=P(IN(JT)+2,3)
|
|
P(IN(JT)+2,JT)=0D0
|
|
IN(JT)=IN(JT)+4*JS
|
|
GOTO 820
|
|
ENDIF
|
|
|
|
C...Four-momentum of particle. Remaining quantities. Loop back.
|
|
900 DO 910 J=1,4
|
|
P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J)
|
|
P(N+NRS,J)=P(N+NRS,J)-P(I,J)
|
|
910 CONTINUE
|
|
IF(P(I,4).LT.P(I,5)) GOTO 640
|
|
KFL(JT)=-KFL(3)
|
|
PMQ(JT)=PMQ(3)
|
|
PX(JT)=-PX(3)
|
|
PY(JT)=-PY(3)
|
|
GAM(JT)=GAM(3)
|
|
IF(IN(3).NE.IN(3*JT+3)) THEN
|
|
DO 920 J=1,4
|
|
P(IN(3*JT+3),J)=P(IN(3),J)
|
|
P(IN(3*JT+3)+1,J)=P(IN(3)+1,J)
|
|
920 CONTINUE
|
|
ENDIF
|
|
DO 930 JQ=1,2
|
|
IN(3*JT+JQ)=IN(JQ)
|
|
P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4)
|
|
P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4)
|
|
930 CONTINUE
|
|
GOTO 780
|
|
|
|
C...Final hadron: side, flavour, hadron, mass.
|
|
940 I=I+1
|
|
K(I,1)=1
|
|
K(I,3)=IE(JR)
|
|
K(I,4)=0
|
|
K(I,5)=0
|
|
CALL PYKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2))
|
|
IF(K(I,2).EQ.0) GOTO 640
|
|
P(I,5)=PYMASS(K(I,2))
|
|
PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
|
|
|
|
C...Final two hadrons: find common setup of four-vectors.
|
|
JQ=1
|
|
IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT.P(IN(7),3)*
|
|
&P(IN(8),3)*FOUR(IN(7),IN(8))) JQ=2
|
|
DHC12=FOUR(IN(3*JQ+1),IN(3*JQ+2))
|
|
DHR1=FOUR(N+NRS,IN(3*JQ+2))/DHC12
|
|
DHR2=FOUR(N+NRS,IN(3*JQ+1))/DHC12
|
|
IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN
|
|
PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ)
|
|
PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ)
|
|
PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS*
|
|
& PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2
|
|
ENDIF
|
|
|
|
C...Solve kinematics for final two hadrons, if possible.
|
|
WREM2=WREM2+(PX(1)+PX(2))**2+(PY(1)+PY(2))**2
|
|
FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2)
|
|
IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1D0) GOTO 200
|
|
IF(FD.GE.1D0) GOTO 640
|
|
FA=WREM2+PR(JT)-PR(JR)
|
|
IF(MSTJ(11).NE.2) PREV=0.5D0*EXP(MAX(-50D0,LOG(FD)*PARJ(38)*
|
|
&(PR(1)+PR(2))**2))
|
|
IF(MSTJ(11).EQ.2) PREV=0.5D0*FD**PARJ(39)
|
|
FB=SIGN(SQRT(MAX(0D0,FA**2-4D0*WREM2*PR(JT))),JS*(PYR(0)-PREV))
|
|
KFL1A=IABS(KFL(1))
|
|
KFL2A=IABS(KFL(2))
|
|
IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10),
|
|
&MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0D0,FA**2-
|
|
&4D0*WREM2*PR(JT))),DBLE(JS))
|
|
DO 950 J=1,4
|
|
P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))*
|
|
& P(IN(3*JQ+3)+1,J)+0.5D0*(DHR1*(FA+FB)*P(IN(3*JQ+1),J)+
|
|
& DHR2*(FA-FB)*P(IN(3*JQ+2),J))/WREM2
|
|
P(I,J)=P(N+NRS,J)-P(I-1,J)
|
|
950 CONTINUE
|
|
IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 640
|
|
|
|
C...Mark jets as fragmented and give daughter pointers.
|
|
N=I-NRS+1
|
|
DO 960 I=NSAV+1,NSAV+NP
|
|
IM=K(I,3)
|
|
K(IM,1)=K(IM,1)+10
|
|
IF(MSTU(16).NE.2) THEN
|
|
K(IM,4)=NSAV+1
|
|
K(IM,5)=NSAV+1
|
|
ELSE
|
|
K(IM,4)=NSAV+2
|
|
K(IM,5)=N
|
|
ENDIF
|
|
960 CONTINUE
|
|
|
|
C...Document string system. Move up particles.
|
|
NSAV=NSAV+1
|
|
K(NSAV,1)=11
|
|
K(NSAV,2)=92
|
|
K(NSAV,3)=IP
|
|
K(NSAV,4)=NSAV+1
|
|
K(NSAV,5)=N
|
|
DO 970 J=1,4
|
|
P(NSAV,J)=DPS(J)
|
|
V(NSAV,J)=V(IP,J)
|
|
970 CONTINUE
|
|
P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))
|
|
V(NSAV,5)=0D0
|
|
DO 990 I=NSAV+1,N
|
|
DO 980 J=1,5
|
|
K(I,J)=K(I+NRS-1,J)
|
|
P(I,J)=P(I+NRS-1,J)
|
|
V(I,J)=0D0
|
|
980 CONTINUE
|
|
990 CONTINUE
|
|
MSTU91=MSTU(90)
|
|
DO 1000 IZ=MSTU90+1,MSTU91
|
|
MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N
|
|
PARU9T(IZ)=PARU(90+IZ)
|
|
1000 CONTINUE
|
|
MSTU(90)=MSTU90
|
|
|
|
C...Order particles in rank along the chain. Update mother pointer.
|
|
DO 1020 I=NSAV+1,N
|
|
DO 1010 J=1,5
|
|
K(I-NSAV+N,J)=K(I,J)
|
|
P(I-NSAV+N,J)=P(I,J)
|
|
1010 CONTINUE
|
|
1020 CONTINUE
|
|
I1=NSAV
|
|
DO 1050 I=N+1,2*N-NSAV
|
|
IF(K(I,3).NE.IE(1)) GOTO 1050
|
|
I1=I1+1
|
|
DO 1030 J=1,5
|
|
K(I1,J)=K(I,J)
|
|
P(I1,J)=P(I,J)
|
|
1030 CONTINUE
|
|
IF(MSTU(16).NE.2) K(I1,3)=NSAV
|
|
DO 1040 IZ=MSTU90+1,MSTU91
|
|
IF(MSTU9T(IZ).EQ.I) THEN
|
|
MSTU(90)=MSTU(90)+1
|
|
MSTU(90+MSTU(90))=I1
|
|
PARU(90+MSTU(90))=PARU9T(IZ)
|
|
ENDIF
|
|
1040 CONTINUE
|
|
1050 CONTINUE
|
|
DO 1080 I=2*N-NSAV,N+1,-1
|
|
IF(K(I,3).EQ.IE(1)) GOTO 1080
|
|
I1=I1+1
|
|
DO 1060 J=1,5
|
|
K(I1,J)=K(I,J)
|
|
P(I1,J)=P(I,J)
|
|
1060 CONTINUE
|
|
IF(MSTU(16).NE.2) K(I1,3)=NSAV
|
|
DO 1070 IZ=MSTU90+1,MSTU91
|
|
IF(MSTU9T(IZ).EQ.I) THEN
|
|
MSTU(90)=MSTU(90)+1
|
|
MSTU(90+MSTU(90))=I1
|
|
PARU(90+MSTU(90))=PARU9T(IZ)
|
|
ENDIF
|
|
1070 CONTINUE
|
|
1080 CONTINUE
|
|
|
|
C...Boost back particle system. Set production vertices.
|
|
IF(MBST.EQ.0) THEN
|
|
MSTU(33)=1
|
|
CALL PYROBO(NSAV+1,N,0D0,0D0,DPS(1)/DPS(4),DPS(2)/DPS(4),
|
|
& DPS(3)/DPS(4))
|
|
ELSE
|
|
DO 1090 I=NSAV+1,N
|
|
HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2
|
|
IF(P(I,3).GT.0D0) THEN
|
|
HHPEZ=(P(I,4)+P(I,3))*HHBZ
|
|
P(I,3)=0.5D0*(HHPEZ-HHPMT/HHPEZ)
|
|
P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ)
|
|
ELSE
|
|
HHPEZ=(P(I,4)-P(I,3))/HHBZ
|
|
P(I,3)=-0.5D0*(HHPEZ-HHPMT/HHPEZ)
|
|
P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ)
|
|
ENDIF
|
|
1090 CONTINUE
|
|
ENDIF
|
|
DO 1110 I=NSAV+1,N
|
|
DO 1100 J=1,4
|
|
V(I,J)=V(IP,J)
|
|
1100 CONTINUE
|
|
1110 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYINDF
|
|
C...Handles the fragmentation of a jet system (or a single
|
|
C...jet) according to independent fragmentation models.
|
|
|
|
SUBROUTINE PYINDF(IP)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/
|
|
C...Local arrays.
|
|
DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3),
|
|
&KFLO(2),PXO(2),PYO(2),WO(2)
|
|
|
|
C...Reset counters. Identify parton system and take copy. Check flavour.
|
|
NSAV=N
|
|
MSTU90=MSTU(90)
|
|
NJET=0
|
|
KQSUM=0
|
|
DO 100 J=1,5
|
|
DPS(J)=0D0
|
|
100 CONTINUE
|
|
I=IP-1
|
|
110 I=I+1
|
|
IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN
|
|
CALL PYERRM(12,'(PYINDF:) failed to reconstruct jet system')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0) GOTO 110
|
|
KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
|
|
IF(KQ.EQ.0) GOTO 110
|
|
NJET=NJET+1
|
|
IF(KQ.NE.2) KQSUM=KQSUM+KQ
|
|
DO 120 J=1,5
|
|
K(NSAV+NJET,J)=K(I,J)
|
|
P(NSAV+NJET,J)=P(I,J)
|
|
DPS(J)=DPS(J)+P(I,J)
|
|
120 CONTINUE
|
|
K(NSAV+NJET,3)=I
|
|
IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND.
|
|
&K(I+1,1).EQ.2)) GOTO 110
|
|
IF(NJET.NE.1.AND.KQSUM.NE.0) THEN
|
|
CALL PYERRM(12,'(PYINDF:) unphysical flavour combination')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
|
|
C...Boost copied system to CM frame. Find CM energy and sum flavours.
|
|
IF(NJET.NE.1) THEN
|
|
MSTU(33)=1
|
|
CALL PYROBO(NSAV+1,NSAV+NJET,0D0,0D0,-DPS(1)/DPS(4),
|
|
& -DPS(2)/DPS(4),-DPS(3)/DPS(4))
|
|
ENDIF
|
|
PECM=0D0
|
|
DO 130 J=1,3
|
|
NFI(J)=0
|
|
130 CONTINUE
|
|
DO 140 I=NSAV+1,NSAV+NJET
|
|
PECM=PECM+P(I,4)
|
|
KFA=IABS(K(I,2))
|
|
IF(KFA.LE.3) THEN
|
|
NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2))
|
|
ELSEIF(KFA.GT.1000) THEN
|
|
KFLA=MOD(KFA/1000,10)
|
|
KFLB=MOD(KFA/100,10)
|
|
IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2))
|
|
IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2))
|
|
ENDIF
|
|
140 CONTINUE
|
|
|
|
C...Loop over attempts made. Reset counters.
|
|
NTRY=0
|
|
150 NTRY=NTRY+1
|
|
IF(NTRY.GT.200) THEN
|
|
CALL PYERRM(14,'(PYINDF:) caught in infinite loop')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
N=NSAV+NJET
|
|
MSTU(90)=MSTU90
|
|
DO 160 J=1,3
|
|
NFL(J)=NFI(J)
|
|
IFET(J)=0
|
|
KFLF(J)=0
|
|
160 CONTINUE
|
|
|
|
C...Loop over jets to be fragmented.
|
|
DO 230 IP1=NSAV+1,NSAV+NJET
|
|
MSTJ(91)=0
|
|
NSAV1=N
|
|
MSTU91=MSTU(90)
|
|
|
|
C...Initial flavour and momentum values. Jet along +z axis.
|
|
KFLH=IABS(K(IP1,2))
|
|
IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10)
|
|
KFLO(2)=0
|
|
WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2)
|
|
|
|
C...Initial values for quark or diquark jet.
|
|
170 IF(IABS(K(IP1,2)).NE.21) THEN
|
|
NSTR=1
|
|
KFLO(1)=K(IP1,2)
|
|
CALL PYPTDI(0,PXO(1),PYO(1))
|
|
WO(1)=WF
|
|
|
|
C...Initial values for gluon treated like random quark jet.
|
|
ELSEIF(MSTJ(2).LE.2) THEN
|
|
NSTR=1
|
|
IF(MSTJ(2).EQ.2) MSTJ(91)=1
|
|
KFLO(1)=INT(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0)
|
|
CALL PYPTDI(0,PXO(1),PYO(1))
|
|
WO(1)=WF
|
|
|
|
C...Initial values for gluon treated like quark-antiquark jet pair,
|
|
C...sharing energy according to Altarelli-Parisi splitting function.
|
|
ELSE
|
|
NSTR=2
|
|
IF(MSTJ(2).EQ.4) MSTJ(91)=1
|
|
KFLO(1)=INT(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0)
|
|
KFLO(2)=-KFLO(1)
|
|
CALL PYPTDI(0,PXO(1),PYO(1))
|
|
PXO(2)=-PXO(1)
|
|
PYO(2)=-PYO(1)
|
|
WO(1)=WF*PYR(0)**(1D0/3D0)
|
|
WO(2)=WF-WO(1)
|
|
ENDIF
|
|
|
|
C...Initial values for rank, flavour, pT and W+.
|
|
DO 220 ISTR=1,NSTR
|
|
180 I=N
|
|
MSTU(90)=MSTU91
|
|
IRANK=0
|
|
KFL1=KFLO(ISTR)
|
|
PX1=PXO(ISTR)
|
|
PY1=PYO(ISTR)
|
|
W=WO(ISTR)
|
|
|
|
C...New hadron. Generate flavour and hadron species.
|
|
190 I=I+1
|
|
IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN
|
|
CALL PYERRM(11,'(PYINDF:) no more memory left in PYJETS')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
IRANK=IRANK+1
|
|
K(I,1)=1
|
|
K(I,3)=IP1
|
|
K(I,4)=0
|
|
K(I,5)=0
|
|
200 CALL PYKFDI(KFL1,0,KFL2,K(I,2))
|
|
IF(K(I,2).EQ.0) GOTO 180
|
|
IF(MSTJ(12).GE.3.AND.IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND.
|
|
& IABS(KFL2).GT.10) THEN
|
|
IF(PYR(0).GT.PARJ(19)) GOTO 200
|
|
ENDIF
|
|
|
|
C...Find hadron mass. Generate four-momentum.
|
|
P(I,5)=PYMASS(K(I,2))
|
|
CALL PYPTDI(KFL1,PX2,PY2)
|
|
P(I,1)=PX1+PX2
|
|
P(I,2)=PY1+PY2
|
|
PR=P(I,5)**2+P(I,1)**2+P(I,2)**2
|
|
CALL PYZDIS(KFL1,KFL2,PR,Z)
|
|
MZSAV=0
|
|
IF(IABS(KFL1).GE.4.AND.IABS(KFL1).LE.8.AND.MSTU(90).LT.8) THEN
|
|
MZSAV=1
|
|
MSTU(90)=MSTU(90)+1
|
|
MSTU(90+MSTU(90))=I
|
|
PARU(90+MSTU(90))=Z
|
|
ENDIF
|
|
P(I,3)=0.5D0*(Z*W-PR/MAX(1D-4,Z*W))
|
|
P(I,4)=0.5D0*(Z*W+PR/MAX(1D-4,Z*W))
|
|
IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND.
|
|
& P(I,3).LE.0.001D0) THEN
|
|
IF(W.GE.P(I,5)+0.5D0*PARJ(32)) GOTO 180
|
|
P(I,3)=0.0001D0
|
|
P(I,4)=SQRT(PR)
|
|
Z=P(I,4)/W
|
|
ENDIF
|
|
|
|
C...Remaining flavour and momentum.
|
|
KFL1=-KFL2
|
|
PX1=-PX2
|
|
PY1=-PY2
|
|
W=(1D0-Z)*W
|
|
DO 210 J=1,5
|
|
V(I,J)=0D0
|
|
210 CONTINUE
|
|
|
|
C...Check if pL acceptable. Go back for new hadron if enough energy.
|
|
IF(MSTJ(3).GE.0.AND.P(I,3).LT.0D0) THEN
|
|
I=I-1
|
|
IF(MZSAV.EQ.1) MSTU(90)=MSTU(90)-1
|
|
ENDIF
|
|
IF(W.GT.PARJ(31)) GOTO 190
|
|
N=I
|
|
220 CONTINUE
|
|
IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1D0*PARJ(32)
|
|
IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170
|
|
|
|
C...Rotate jet to new direction.
|
|
THE=PYANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2))
|
|
PHI=PYANGL(P(IP1,1),P(IP1,2))
|
|
MSTU(33)=1
|
|
CALL PYROBO(NSAV1+1,N,THE,PHI,0D0,0D0,0D0)
|
|
K(K(IP1,3),4)=NSAV1+1
|
|
K(K(IP1,3),5)=N
|
|
|
|
C...End of jet generation loop. Skip conservation in some cases.
|
|
230 CONTINUE
|
|
IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 490
|
|
IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150
|
|
|
|
C...Subtract off produced hadron flavours, finished if zero.
|
|
DO 240 I=NSAV+NJET+1,N
|
|
KFA=IABS(K(I,2))
|
|
KFLA=MOD(KFA/1000,10)
|
|
KFLB=MOD(KFA/100,10)
|
|
KFLC=MOD(KFA/10,10)
|
|
IF(KFLA.EQ.0) THEN
|
|
IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB
|
|
IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB
|
|
ELSE
|
|
IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2))
|
|
IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))
|
|
IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2))
|
|
ENDIF
|
|
240 CONTINUE
|
|
NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
|
|
&NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
|
|
IF(NREQ.EQ.0) GOTO 320
|
|
|
|
C...Take away flavour of low-momentum particles until enough freedom.
|
|
NREM=0
|
|
250 IREM=0
|
|
P2MIN=PECM**2
|
|
DO 260 I=NSAV+NJET+1,N
|
|
P2=P(I,1)**2+P(I,2)**2+P(I,3)**2
|
|
IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I
|
|
IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2
|
|
260 CONTINUE
|
|
IF(IREM.EQ.0) GOTO 150
|
|
K(IREM,1)=7
|
|
KFA=IABS(K(IREM,2))
|
|
KFLA=MOD(KFA/1000,10)
|
|
KFLB=MOD(KFA/100,10)
|
|
KFLC=MOD(KFA/10,10)
|
|
IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8
|
|
IF(K(IREM,1).EQ.8) GOTO 250
|
|
IF(KFLA.EQ.0) THEN
|
|
ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB
|
|
IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN
|
|
IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN
|
|
ELSE
|
|
IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2))
|
|
IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2))
|
|
IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2))
|
|
ENDIF
|
|
NREM=NREM+1
|
|
NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
|
|
&NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
|
|
IF(NREQ.GT.NREM) GOTO 250
|
|
DO 270 I=NSAV+NJET+1,N
|
|
IF(K(I,1).EQ.8) K(I,1)=1
|
|
270 CONTINUE
|
|
|
|
C...Find combination of existing and new flavours for hadron.
|
|
280 NFET=2
|
|
IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3
|
|
IF(NREQ.LT.NREM) NFET=1
|
|
IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0
|
|
DO 290 J=1,NFET
|
|
IFET(J)=1+(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*PYR(0)
|
|
KFLF(J)=ISIGN(1,NFL(1))
|
|
IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2))
|
|
IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3))
|
|
290 CONTINUE
|
|
IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0))
|
|
&GOTO 280
|
|
IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR.
|
|
&IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3)
|
|
&.LT.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280
|
|
IF(NFET.EQ.0) KFLF(1)=1+INT((2D0+PARJ(2))*PYR(0))
|
|
IF(NFET.EQ.0) KFLF(2)=-KFLF(1)
|
|
IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2D0+PARJ(2))*PYR(0)),-KFLF(1))
|
|
IF(NFET.LE.2) KFLF(3)=0
|
|
IF(KFLF(3).NE.0) THEN
|
|
KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+
|
|
& 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1))
|
|
IF(KFLF(1).EQ.KFLF(3).OR.(1D0+3D0*PARJ(4))*PYR(0).GT.1D0)
|
|
& KFLFC=KFLFC+ISIGN(2,KFLFC)
|
|
ELSE
|
|
KFLFC=KFLF(1)
|
|
ENDIF
|
|
CALL PYKFDI(KFLFC,KFLF(2),KFLDMP,KF)
|
|
IF(KF.EQ.0) GOTO 280
|
|
DO 300 J=1,MAX(2,NFET)
|
|
NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J))
|
|
300 CONTINUE
|
|
|
|
C...Store hadron at random among free positions.
|
|
NPOS=MIN(1+INT(PYR(0)*NREM),NREM)
|
|
DO 310 I=NSAV+NJET+1,N
|
|
IF(K(I,1).EQ.7) NPOS=NPOS-1
|
|
IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310
|
|
K(I,1)=1
|
|
K(I,2)=KF
|
|
P(I,5)=PYMASS(K(I,2))
|
|
P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
|
|
310 CONTINUE
|
|
NREM=NREM-1
|
|
NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
|
|
&NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
|
|
IF(NREM.GT.0) GOTO 280
|
|
|
|
C...Compensate for missing momentum in global scheme (3 options).
|
|
320 IF(MOD(MSTJ(3),5).NE.0.AND.MOD(MSTJ(3),5).NE.4) THEN
|
|
DO 340 J=1,3
|
|
PSI(J)=0D0
|
|
DO 330 I=NSAV+NJET+1,N
|
|
PSI(J)=PSI(J)+P(I,J)
|
|
330 CONTINUE
|
|
340 CONTINUE
|
|
PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2
|
|
PWS=0D0
|
|
DO 350 I=NSAV+NJET+1,N
|
|
IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4)
|
|
IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+
|
|
& PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4))
|
|
IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1D0
|
|
350 CONTINUE
|
|
DO 370 I=NSAV+NJET+1,N
|
|
IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4)
|
|
IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+
|
|
& PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4))
|
|
IF(MOD(MSTJ(3),5).EQ.3) PW=1D0
|
|
DO 360 J=1,3
|
|
P(I,J)=P(I,J)-PSI(J)*PW/PWS
|
|
360 CONTINUE
|
|
P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
|
|
370 CONTINUE
|
|
|
|
C...Compensate for missing momentum withing each jet separately.
|
|
ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN
|
|
DO 390 I=N+1,N+NJET
|
|
K(I,1)=0
|
|
DO 380 J=1,5
|
|
P(I,J)=0D0
|
|
380 CONTINUE
|
|
390 CONTINUE
|
|
DO 410 I=NSAV+NJET+1,N
|
|
IR1=K(I,3)
|
|
IR2=N+IR1-NSAV
|
|
K(IR2,1)=K(IR2,1)+1
|
|
PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/
|
|
& (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)
|
|
DO 400 J=1,3
|
|
P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J)
|
|
400 CONTINUE
|
|
P(IR2,4)=P(IR2,4)+P(I,4)
|
|
P(IR2,5)=P(IR2,5)+PLS
|
|
410 CONTINUE
|
|
PSS=0D0
|
|
DO 420 I=N+1,N+NJET
|
|
IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8D0*P(I,5)+0.2D0))
|
|
420 CONTINUE
|
|
DO 440 I=NSAV+NJET+1,N
|
|
IR1=K(I,3)
|
|
IR2=N+IR1-NSAV
|
|
PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/
|
|
& (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)
|
|
DO 430 J=1,3
|
|
P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1D0/(P(IR2,5)*PSS)-1D0)*
|
|
& PLS*P(IR1,J)
|
|
430 CONTINUE
|
|
P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
|
|
440 CONTINUE
|
|
ENDIF
|
|
|
|
C...Scale momenta for energy conservation.
|
|
IF(MOD(MSTJ(3),5).NE.0) THEN
|
|
PMS=0D0
|
|
PES=0D0
|
|
PQS=0D0
|
|
DO 450 I=NSAV+NJET+1,N
|
|
PMS=PMS+P(I,5)
|
|
PES=PES+P(I,4)
|
|
PQS=PQS+P(I,5)**2/P(I,4)
|
|
450 CONTINUE
|
|
IF(PMS.GE.PECM) GOTO 150
|
|
NECO=0
|
|
460 NECO=NECO+1
|
|
PFAC=(PECM-PQS)/(PES-PQS)
|
|
PES=0D0
|
|
PQS=0D0
|
|
DO 480 I=NSAV+NJET+1,N
|
|
DO 470 J=1,3
|
|
P(I,J)=PFAC*P(I,J)
|
|
470 CONTINUE
|
|
P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
|
|
PES=PES+P(I,4)
|
|
PQS=PQS+P(I,5)**2/P(I,4)
|
|
480 CONTINUE
|
|
IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2D-6*PECM) GOTO 460
|
|
ENDIF
|
|
|
|
C...Origin of produced particles and parton daughter pointers.
|
|
490 DO 500 I=NSAV+NJET+1,N
|
|
IF(MSTU(16).NE.2) K(I,3)=NSAV+1
|
|
IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3)
|
|
500 CONTINUE
|
|
DO 510 I=NSAV+1,NSAV+NJET
|
|
I1=K(I,3)
|
|
K(I1,1)=K(I1,1)+10
|
|
IF(MSTU(16).NE.2) THEN
|
|
K(I1,4)=NSAV+1
|
|
K(I1,5)=NSAV+1
|
|
ELSE
|
|
K(I1,4)=K(I1,4)-NJET+1
|
|
K(I1,5)=K(I1,5)-NJET+1
|
|
IF(K(I1,5).LT.K(I1,4)) THEN
|
|
K(I1,4)=0
|
|
K(I1,5)=0
|
|
ENDIF
|
|
ENDIF
|
|
510 CONTINUE
|
|
|
|
C...Document independent fragmentation system. Remove copy of jets.
|
|
NSAV=NSAV+1
|
|
K(NSAV,1)=11
|
|
K(NSAV,2)=93
|
|
K(NSAV,3)=IP
|
|
K(NSAV,4)=NSAV+1
|
|
K(NSAV,5)=N-NJET+1
|
|
DO 520 J=1,4
|
|
P(NSAV,J)=DPS(J)
|
|
V(NSAV,J)=V(IP,J)
|
|
520 CONTINUE
|
|
P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))
|
|
V(NSAV,5)=0D0
|
|
DO 540 I=NSAV+NJET,N
|
|
DO 530 J=1,5
|
|
K(I-NJET+1,J)=K(I,J)
|
|
P(I-NJET+1,J)=P(I,J)
|
|
V(I-NJET+1,J)=V(I,J)
|
|
530 CONTINUE
|
|
540 CONTINUE
|
|
N=N-NJET+1
|
|
DO 550 IZ=MSTU90+1,MSTU(90)
|
|
MSTU(90+IZ)=MSTU(90+IZ)-NJET+1
|
|
550 CONTINUE
|
|
|
|
C...Boost back particle system. Set production vertices.
|
|
IF(NJET.NE.1) CALL PYROBO(NSAV+1,N,0D0,0D0,DPS(1)/DPS(4),
|
|
&DPS(2)/DPS(4),DPS(3)/DPS(4))
|
|
DO 570 I=NSAV+1,N
|
|
DO 560 J=1,4
|
|
V(I,J)=V(IP,J)
|
|
560 CONTINUE
|
|
570 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYDECY
|
|
C...Handles the decay of unstable particles.
|
|
|
|
SUBROUTINE PYDECY(IP)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/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)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/
|
|
C...Local arrays.
|
|
DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3),
|
|
&WTCOR(10),PTAU(4),PCMTAU(4),DBETAU(3)
|
|
CHARACTER CIDC*4
|
|
DATA WTCOR/2D0,5D0,15D0,60D0,250D0,1500D0,1.2D4,1.2D5,150D0,16D0/
|
|
|
|
C...Functions: momentum in two-particle decays and four-product.
|
|
PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2D0*A)
|
|
FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3)
|
|
|
|
C...Initial values.
|
|
NTRY=0
|
|
NSAV=N
|
|
KFA=IABS(K(IP,2))
|
|
KFS=ISIGN(1,K(IP,2))
|
|
KC=PYCOMP(KFA)
|
|
MSTJ(92)=0
|
|
|
|
C...Choose lifetime and determine decay vertex.
|
|
IF(K(IP,1).EQ.5) THEN
|
|
V(IP,5)=0D0
|
|
ELSEIF(K(IP,1).NE.4) THEN
|
|
V(IP,5)=-PMAS(KC,4)*LOG(PYR(0))
|
|
ENDIF
|
|
DO 100 J=1,4
|
|
VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5)
|
|
100 CONTINUE
|
|
|
|
C...Determine whether decay allowed or not.
|
|
MOUT=0
|
|
IF(MSTJ(22).EQ.2) THEN
|
|
IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1
|
|
ELSEIF(MSTJ(22).EQ.3) THEN
|
|
IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1
|
|
ELSEIF(MSTJ(22).EQ.4) THEN
|
|
IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1
|
|
IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1
|
|
ENDIF
|
|
IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN
|
|
K(IP,1)=4
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Interface to external tau decay library (for tau polarization).
|
|
IF(KFA.EQ.15.AND.MSTJ(28).GE.1) THEN
|
|
|
|
C...Starting values for pointers and momenta.
|
|
ITAU=IP
|
|
DO 110 J=1,4
|
|
PTAU(J)=P(ITAU,J)
|
|
PCMTAU(J)=P(ITAU,J)
|
|
110 CONTINUE
|
|
|
|
C...Iterate to find position and code of mother of tau.
|
|
IMTAU=ITAU
|
|
120 IMTAU=K(IMTAU,3)
|
|
|
|
IF(IMTAU.EQ.0) THEN
|
|
C...If no known origin then impossible to do anything further.
|
|
KFORIG=0
|
|
IORIG=0
|
|
|
|
ELSEIF(K(IMTAU,2).EQ.K(ITAU,2)) THEN
|
|
C...If tau -> tau + gamma then add gamma energy and loop.
|
|
IF(K(K(IMTAU,4),2).EQ.22) THEN
|
|
DO 130 J=1,4
|
|
PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,4),J)
|
|
130 CONTINUE
|
|
ELSEIF(K(K(IMTAU,5),2).EQ.22) THEN
|
|
DO 140 J=1,4
|
|
PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,5),J)
|
|
140 CONTINUE
|
|
ENDIF
|
|
GOTO 120
|
|
|
|
ELSEIF(IABS(K(IMTAU,2)).GT.100) THEN
|
|
C...If coming from weak decay of hadron then W is not stored in record,
|
|
C...but can be reconstructed by adding neutrino momentum.
|
|
KFORIG=-ISIGN(24,K(ITAU,2))
|
|
IORIG=0
|
|
DO 160 II=K(IMTAU,4),K(IMTAU,5)
|
|
IF(K(II,2)*ISIGN(1,K(ITAU,2)).EQ.-16) THEN
|
|
DO 150 J=1,4
|
|
PCMTAU(J)=PCMTAU(J)+P(II,J)
|
|
150 CONTINUE
|
|
ENDIF
|
|
160 CONTINUE
|
|
|
|
ELSE
|
|
C...If coming from resonance decay then find latest copy of this
|
|
C...resonance (may not completely agree).
|
|
KFORIG=K(IMTAU,2)
|
|
IORIG=IMTAU
|
|
DO 170 II=IMTAU+1,IP-1
|
|
IF(K(II,2).EQ.KFORIG.AND.K(II,3).EQ.IORIG.AND.
|
|
& ABS(P(II,5)-P(IORIG,5)).LT.1D-5*P(IORIG,5)) IORIG=II
|
|
170 CONTINUE
|
|
DO 180 J=1,4
|
|
PCMTAU(J)=P(IORIG,J)
|
|
180 CONTINUE
|
|
ENDIF
|
|
|
|
C...Boost tau to rest frame of production process (where known)
|
|
C...and rotate it to sit along +z axis.
|
|
DO 190 J=1,3
|
|
DBETAU(J)=PCMTAU(J)/PCMTAU(4)
|
|
190 CONTINUE
|
|
IF(KFORIG.NE.0) CALL PYROBO(ITAU,ITAU,0D0,0D0,-DBETAU(1),
|
|
& -DBETAU(2),-DBETAU(3))
|
|
PHITAU=PYANGL(P(ITAU,1),P(ITAU,2))
|
|
CALL PYROBO(ITAU,ITAU,0D0,-PHITAU,0D0,0D0,0D0)
|
|
THETAU=PYANGL(P(ITAU,3),P(ITAU,1))
|
|
CALL PYROBO(ITAU,ITAU,-THETAU,0D0,0D0,0D0,0D0)
|
|
|
|
C...Call tau decay routine (if meaningful) and fill extra info.
|
|
IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN
|
|
CALL PYTAUD(ITAU,IORIG,KFORIG,NDECAY)
|
|
DO 200 II=NSAV+1,NSAV+NDECAY
|
|
K(II,1)=1
|
|
K(II,3)=IP
|
|
K(II,4)=0
|
|
K(II,5)=0
|
|
200 CONTINUE
|
|
N=NSAV+NDECAY
|
|
ENDIF
|
|
|
|
C...Boost back decay tau and decay products.
|
|
DO 210 J=1,4
|
|
P(ITAU,J)=PTAU(J)
|
|
210 CONTINUE
|
|
IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN
|
|
CALL PYROBO(NSAV+1,N,THETAU,PHITAU,0D0,0D0,0D0)
|
|
IF(KFORIG.NE.0) CALL PYROBO(NSAV+1,N,0D0,0D0,DBETAU(1),
|
|
& DBETAU(2),DBETAU(3))
|
|
|
|
C...Skip past ordinary tau decay treatment.
|
|
MMAT=0
|
|
MBST=0
|
|
ND=0
|
|
GOTO 630
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...B-Bbar mixing: flip sign of meson appropriately.
|
|
MMIX=0
|
|
IF((KFA.EQ.511.OR.KFA.EQ.531).AND.MSTJ(26).GE.1) THEN
|
|
XBBMIX=PARJ(76)
|
|
IF(KFA.EQ.531) XBBMIX=PARJ(77)
|
|
IF(SIN(0.5D0*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.PYR(0)) MMIX=1
|
|
IF(MMIX.EQ.1) KFS=-KFS
|
|
ENDIF
|
|
|
|
C...Check existence of decay channels. Particle/antiparticle rules.
|
|
KCA=KC
|
|
IF(MDCY(KC,2).GT.0) THEN
|
|
MDMDCY=MDME(MDCY(KC,2),2)
|
|
IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY
|
|
ENDIF
|
|
IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN
|
|
CALL PYERRM(9,'(PYDECY:) no decay channel defined')
|
|
RETURN
|
|
ENDIF
|
|
IF(MOD(KFA/1000,10).EQ.0.AND.KCA.EQ.85) KFS=-KFS
|
|
IF(KCHG(KC,3).EQ.0) THEN
|
|
KFSP=1
|
|
KFSN=0
|
|
IF(PYR(0).GT.0.5D0) KFS=-KFS
|
|
ELSEIF(KFS.GT.0) THEN
|
|
KFSP=1
|
|
KFSN=0
|
|
ELSE
|
|
KFSP=0
|
|
KFSN=1
|
|
ENDIF
|
|
|
|
C...Sum branching ratios of allowed decay channels.
|
|
220 NOPE=0
|
|
BRSU=0D0
|
|
DO 230 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1
|
|
IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND.
|
|
& KFSN*MDME(IDL,1).NE.3) GOTO 230
|
|
IF(MDME(IDL,2).GT.100) GOTO 230
|
|
NOPE=NOPE+1
|
|
BRSU=BRSU+BRAT(IDL)
|
|
230 CONTINUE
|
|
IF(NOPE.EQ.0) THEN
|
|
CALL PYERRM(2,'(PYDECY:) all decay channels closed by user')
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Select decay channel among allowed ones.
|
|
240 RBR=BRSU*PYR(0)
|
|
IDL=MDCY(KCA,2)-1
|
|
250 IDL=IDL+1
|
|
IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND.
|
|
&KFSN*MDME(IDL,1).NE.3) THEN
|
|
IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250
|
|
ELSEIF(MDME(IDL,2).GT.100) THEN
|
|
IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250
|
|
ELSE
|
|
IDC=IDL
|
|
RBR=RBR-BRAT(IDL)
|
|
IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0D0) GOTO 250
|
|
ENDIF
|
|
|
|
C...Start readout of decay channel: matrix element, reset counters.
|
|
MMAT=MDME(IDC,2)
|
|
260 NTRY=NTRY+1
|
|
IF(MOD(NTRY,200).EQ.0) THEN
|
|
WRITE(CIDC,'(I4)') IDC
|
|
CALL PYERRM(4,'(PYDECY:) caught in loop for decay channel'//
|
|
& CIDC)
|
|
GOTO 240
|
|
ENDIF
|
|
IF(NTRY.GT.1000) THEN
|
|
CALL PYERRM(14,'(PYDECY:) caught in infinite loop')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
I=N
|
|
NP=0
|
|
NQ=0
|
|
MBST=0
|
|
IF(MMAT.GE.11.AND.P(IP,4).GT.20D0*P(IP,5)) MBST=1
|
|
DO 270 J=1,4
|
|
PV(1,J)=0D0
|
|
IF(MBST.EQ.0) PV(1,J)=P(IP,J)
|
|
270 CONTINUE
|
|
IF(MBST.EQ.1) PV(1,4)=P(IP,5)
|
|
PV(1,5)=P(IP,5)
|
|
PS=0D0
|
|
PSQ=0D0
|
|
MREM=0
|
|
MHADDY=0
|
|
IF(KFA.GT.80) MHADDY=1
|
|
|
|
C...Read out decay products. Convert to standard flavour code.
|
|
JTMAX=5
|
|
IF(MDME(IDC+1,2).EQ.101) JTMAX=10
|
|
DO 280 JT=1,JTMAX
|
|
IF(JT.LE.5) KP=KFDP(IDC,JT)
|
|
IF(JT.GE.6) KP=KFDP(IDC+1,JT-5)
|
|
IF(KP.EQ.0) GOTO 280
|
|
KPA=IABS(KP)
|
|
KCP=PYCOMP(KPA)
|
|
IF(KPA.GT.80) MHADDY=1
|
|
IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN
|
|
KFP=KP
|
|
ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN
|
|
KFP=KFS*KP
|
|
ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN
|
|
KFP=-KFS*MOD(KFA/10,10)
|
|
ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN
|
|
KFP=KFS*(100*MOD(KFA/10,100)+3)
|
|
ELSEIF(KPA.EQ.81) THEN
|
|
KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1)
|
|
ELSEIF(KP.EQ.82) THEN
|
|
CALL PYKFDI(-KFS*INT(1D0+(2D0+PARJ(2))*PYR(0)),0,KFP,KDUMP)
|
|
IF(KFP.EQ.0) GOTO 260
|
|
MSTJ(93)=1
|
|
IF(PV(1,5).LT.PARJ(32)+2D0*PYMASS(KFP)) GOTO 260
|
|
ELSEIF(KP.EQ.-82) THEN
|
|
KFP=-KFP
|
|
IF(IABS(KFP).GT.10) KFP=KFP+ISIGN(10000,KFP)
|
|
ENDIF
|
|
IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=PYCOMP(MOD(KFP,10000))
|
|
|
|
C...Add decay product to event record or to quark flavour list.
|
|
KFPA=IABS(KFP)
|
|
KQP=KCHG(KCP,2)
|
|
IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN
|
|
NQ=NQ+1
|
|
KFLO(NQ)=KFP
|
|
MSTJ(93)=2
|
|
PSQ=PSQ+PYMASS(KFLO(NQ))
|
|
ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.48).AND.NP.EQ.3.AND.
|
|
& MOD(NQ,2).EQ.1) THEN
|
|
NQ=NQ-1
|
|
PS=PS-P(I,5)
|
|
K(I,1)=1
|
|
KFI=K(I,2)
|
|
CALL PYKFDI(KFP,KFI,KFLDMP,K(I,2))
|
|
IF(K(I,2).EQ.0) GOTO 260
|
|
MSTJ(93)=1
|
|
P(I,5)=PYMASS(K(I,2))
|
|
PS=PS+P(I,5)
|
|
ELSE
|
|
I=I+1
|
|
NP=NP+1
|
|
IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1
|
|
IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1
|
|
K(I,1)=1+MOD(NQ,2)
|
|
IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2
|
|
IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1
|
|
K(I,2)=KFP
|
|
K(I,3)=IP
|
|
K(I,4)=0
|
|
K(I,5)=0
|
|
P(I,5)=PYMASS(KFP)
|
|
PS=PS+P(I,5)
|
|
ENDIF
|
|
280 CONTINUE
|
|
|
|
C...Check masses for resonance decays.
|
|
IF(MHADDY.EQ.0) THEN
|
|
IF(PS+PARJ(64).GT.PV(1,5)) GOTO 240
|
|
ENDIF
|
|
|
|
C...Choose decay multiplicity in phase space model.
|
|
290 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN
|
|
PSP=PS
|
|
CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1D0))
|
|
IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63)
|
|
300 NTRY=NTRY+1
|
|
IF(NTRY.GT.1000) THEN
|
|
CALL PYERRM(14,'(PYDECY:) caught in infinite loop')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
IF(MMAT.LE.20) THEN
|
|
GAUSS=SQRT(-2D0*CNDE*LOG(MAX(1D-10,PYR(0))))*
|
|
& SIN(PARU(2)*PYR(0))
|
|
ND=0.5D0+0.5D0*NP+0.25D0*NQ+CNDE+GAUSS
|
|
IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 300
|
|
IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 300
|
|
IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 300
|
|
IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 300
|
|
ELSE
|
|
ND=MMAT-20
|
|
ENDIF
|
|
|
|
C...Form hadrons from flavour content.
|
|
DO 310 JT=1,4
|
|
KFL1(JT)=KFLO(JT)
|
|
310 CONTINUE
|
|
IF(ND.EQ.NP+NQ/2) GOTO 330
|
|
DO 320 I=N+NP+1,N+ND-NQ/2
|
|
JT=1+INT((NQ-1)*PYR(0))
|
|
CALL PYKFDI(KFL1(JT),0,KFL2,K(I,2))
|
|
IF(K(I,2).EQ.0) GOTO 300
|
|
KFL1(JT)=-KFL2
|
|
320 CONTINUE
|
|
330 JT=2
|
|
JT2=3
|
|
JT3=4
|
|
IF(NQ.EQ.4.AND.PYR(0).LT.PARJ(66)) JT=4
|
|
IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))*
|
|
& ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3
|
|
IF(JT.EQ.3) JT2=2
|
|
IF(JT.EQ.4) JT3=2
|
|
CALL PYKFDI(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2))
|
|
IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 300
|
|
IF(NQ.EQ.4) CALL PYKFDI(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2))
|
|
IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 300
|
|
|
|
C...Check that sum of decay product masses not too large.
|
|
PS=PSP
|
|
DO 340 I=N+NP+1,N+ND
|
|
K(I,1)=1
|
|
K(I,3)=IP
|
|
K(I,4)=0
|
|
K(I,5)=0
|
|
P(I,5)=PYMASS(K(I,2))
|
|
PS=PS+P(I,5)
|
|
340 CONTINUE
|
|
IF(PS+PARJ(64).GT.PV(1,5)) GOTO 300
|
|
|
|
C...Rescale energy to subtract off spectator quark mass.
|
|
ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44)
|
|
& .AND.NP.GE.3) THEN
|
|
PS=PS-P(N+NP,5)
|
|
PQT=(P(N+NP,5)+PARJ(65))/PV(1,5)
|
|
DO 350 J=1,5
|
|
P(N+NP,J)=PQT*PV(1,J)
|
|
PV(1,J)=(1D0-PQT)*PV(1,J)
|
|
350 CONTINUE
|
|
IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260
|
|
ND=NP-1
|
|
MREM=1
|
|
|
|
C...Fully specified final state: check mass broadening effects.
|
|
ELSE
|
|
IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 260
|
|
ND=NP
|
|
ENDIF
|
|
|
|
C...Determine position of grandmother, number of sisters.
|
|
NM=0
|
|
KFAS=0
|
|
MSGN=0
|
|
IF(MMAT.EQ.3) THEN
|
|
IM=K(IP,3)
|
|
IF(IM.LT.0.OR.IM.GE.IP) IM=0
|
|
IF(IM.NE.0) KFAM=IABS(K(IM,2))
|
|
IF(IM.NE.0) THEN
|
|
DO 360 IL=MAX(IP-2,IM+1),MIN(IP+2,N)
|
|
IF(K(IL,3).EQ.IM) NM=NM+1
|
|
IF(K(IL,3).EQ.IM.AND.IL.NE.IP) ISIS=IL
|
|
360 CONTINUE
|
|
IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR.
|
|
& MOD(KFAM/1000,10).NE.0) NM=0
|
|
IF(NM.EQ.2) THEN
|
|
KFAS=IABS(K(ISIS,2))
|
|
IF((KFAS.LE.100.OR.MOD(KFAS,10).NE.1.OR.
|
|
& MOD(KFAS/1000,10).NE.0).AND.KFAS.NE.22) NM=0
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Kinematics of one-particle decays.
|
|
IF(ND.EQ.1) THEN
|
|
DO 370 J=1,4
|
|
P(N+1,J)=P(IP,J)
|
|
370 CONTINUE
|
|
GOTO 630
|
|
ENDIF
|
|
|
|
C...Calculate maximum weight ND-particle decay.
|
|
PV(ND,5)=P(N+ND,5)
|
|
IF(ND.GE.3) THEN
|
|
WTMAX=1D0/WTCOR(ND-2)
|
|
PMAX=PV(1,5)-PS+P(N+ND,5)
|
|
PMIN=0D0
|
|
DO 380 IL=ND-1,1,-1
|
|
PMAX=PMAX+P(N+IL,5)
|
|
PMIN=PMIN+P(N+IL+1,5)
|
|
WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5))
|
|
380 CONTINUE
|
|
ENDIF
|
|
|
|
C...Find virtual gamma mass in Dalitz decay.
|
|
390 IF(ND.EQ.2) THEN
|
|
ELSEIF(MMAT.EQ.2) THEN
|
|
PMES=4D0*PMAS(11,1)**2
|
|
PMRHO2=PMAS(131,1)**2
|
|
PGRHO2=PMAS(131,2)**2
|
|
400 PMST=PMES*(P(IP,5)**2/PMES)**PYR(0)
|
|
WT=(1+0.5D0*PMES/PMST)*SQRT(MAX(0D0,1D0-PMES/PMST))*
|
|
& (1D0-PMST/P(IP,5)**2)**3*(1D0+PGRHO2/PMRHO2)/
|
|
& ((1D0-PMST/PMRHO2)**2+PGRHO2/PMRHO2)
|
|
IF(WT.LT.PYR(0)) GOTO 400
|
|
PV(2,5)=MAX(2.00001D0*PMAS(11,1),SQRT(PMST))
|
|
|
|
C...M-generator gives weight. If rejected, try again.
|
|
ELSE
|
|
410 RORD(1)=1D0
|
|
DO 440 IL1=2,ND-1
|
|
RSAV=PYR(0)
|
|
DO 420 IL2=IL1-1,1,-1
|
|
IF(RSAV.LE.RORD(IL2)) GOTO 430
|
|
RORD(IL2+1)=RORD(IL2)
|
|
420 CONTINUE
|
|
430 RORD(IL2+1)=RSAV
|
|
440 CONTINUE
|
|
RORD(ND)=0D0
|
|
WT=1D0
|
|
DO 450 IL=ND-1,1,-1
|
|
PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))*
|
|
& (PV(1,5)-PS)
|
|
WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))
|
|
450 CONTINUE
|
|
IF(WT.LT.PYR(0)*WTMAX) GOTO 410
|
|
ENDIF
|
|
|
|
C...Perform two-particle decays in respective CM frame.
|
|
460 DO 480 IL=1,ND-1
|
|
PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))
|
|
UE(3)=2D0*PYR(0)-1D0
|
|
PHI=PARU(2)*PYR(0)
|
|
UE(1)=SQRT(1D0-UE(3)**2)*COS(PHI)
|
|
UE(2)=SQRT(1D0-UE(3)**2)*SIN(PHI)
|
|
DO 470 J=1,3
|
|
P(N+IL,J)=PA*UE(J)
|
|
PV(IL+1,J)=-PA*UE(J)
|
|
470 CONTINUE
|
|
P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2)
|
|
PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2)
|
|
480 CONTINUE
|
|
|
|
C...Lorentz transform decay products to lab frame.
|
|
DO 490 J=1,4
|
|
P(N+ND,J)=PV(ND,J)
|
|
490 CONTINUE
|
|
DO 530 IL=ND-1,1,-1
|
|
DO 500 J=1,3
|
|
BE(J)=PV(IL,J)/PV(IL,4)
|
|
500 CONTINUE
|
|
GA=PV(IL,4)/PV(IL,5)
|
|
DO 520 I=N+IL,N+ND
|
|
BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
|
|
DO 510 J=1,3
|
|
P(I,J)=P(I,J)+GA*(GA*BEP/(1D0+GA)+P(I,4))*BE(J)
|
|
510 CONTINUE
|
|
P(I,4)=GA*(P(I,4)+BEP)
|
|
520 CONTINUE
|
|
530 CONTINUE
|
|
|
|
C...Check that no infinite loop in matrix element weight.
|
|
NTRY=NTRY+1
|
|
IF(NTRY.GT.800) GOTO 560
|
|
|
|
C...Matrix elements for omega and phi decays.
|
|
IF(MMAT.EQ.1) THEN
|
|
WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2
|
|
& -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2
|
|
& +2D0*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3)
|
|
IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001D0).LT.PYR(0)) GOTO 390
|
|
|
|
C...Matrix elements for pi0 or eta Dalitz decay to gamma e+ e-.
|
|
ELSEIF(MMAT.EQ.2) THEN
|
|
FOUR12=FOUR(N+1,N+2)
|
|
FOUR13=FOUR(N+1,N+3)
|
|
WT=(PMST-0.5D0*PMES)*(FOUR12**2+FOUR13**2)+
|
|
& PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2)
|
|
IF(WT.LT.PYR(0)*0.25D0*PMST*(P(IP,5)**2-PMST)**2) GOTO 460
|
|
|
|
C...Matrix element for S0 -> S1 + V1 -> S1 + S2 + S3 (S scalar,
|
|
C...V vector), of form cos**2(theta02) in V1 rest frame, and for
|
|
C...S0 -> gamma + V1 -> gamma + S2 + S3, of form sin**2(theta02).
|
|
ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN
|
|
FOUR10=FOUR(IP,IM)
|
|
FOUR12=FOUR(IP,N+1)
|
|
FOUR02=FOUR(IM,N+1)
|
|
PMS1=P(IP,5)**2
|
|
PMS0=P(IM,5)**2
|
|
PMS2=P(N+1,5)**2
|
|
IF(KFAS.NE.22) HNUM=(FOUR10*FOUR12-PMS1*FOUR02)**2
|
|
IF(KFAS.EQ.22) HNUM=PMS1*(2D0*FOUR10*FOUR12*FOUR02-
|
|
& PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2)
|
|
HNUM=MAX(1D-6*PMS1**2*PMS0*PMS2,HNUM)
|
|
HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2)
|
|
IF(HNUM.LT.PYR(0)*HDEN) GOTO 460
|
|
|
|
C...Matrix element for "onium" -> g + g + g or gamma + g + g.
|
|
ELSEIF(MMAT.EQ.4) THEN
|
|
HX1=2D0*FOUR(IP,N+1)/P(IP,5)**2
|
|
HX2=2D0*FOUR(IP,N+2)/P(IP,5)**2
|
|
HX3=2D0*FOUR(IP,N+3)/P(IP,5)**2
|
|
WT=((1D0-HX1)/(HX2*HX3))**2+((1D0-HX2)/(HX1*HX3))**2+
|
|
& ((1D0-HX3)/(HX1*HX2))**2
|
|
IF(WT.LT.2D0*PYR(0)) GOTO 390
|
|
IF(K(IP+1,2).EQ.22.AND.(1D0-HX1)*P(IP,5)**2.LT.4D0*PARJ(32)**2)
|
|
& GOTO 390
|
|
|
|
C...Effective matrix element for nu spectrum in tau -> nu + hadrons.
|
|
ELSEIF(MMAT.EQ.41) THEN
|
|
HX1=2D0*FOUR(IP,N+1)/P(IP,5)**2
|
|
HXM=MIN(0.75D0,2D0*(1D0-PS/P(IP,5)))
|
|
IF(HX1*(3D0-2D0*HX1).LT.PYR(0)*HXM*(3D0-2D0*HXM)) GOTO 390
|
|
|
|
C...Matrix elements for weak decays (only semileptonic for c and b)
|
|
ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48)
|
|
& .AND.ND.EQ.3) THEN
|
|
IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3)
|
|
IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3)
|
|
IF(WT.LT.PYR(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 390
|
|
ELSEIF(MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) THEN
|
|
DO 550 J=1,4
|
|
P(N+NP+1,J)=0D0
|
|
DO 540 IS=N+3,N+NP
|
|
P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J)
|
|
540 CONTINUE
|
|
550 CONTINUE
|
|
IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1)
|
|
IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1)
|
|
IF(WT.LT.PYR(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 390
|
|
ENDIF
|
|
|
|
C...Scale back energy and reattach spectator.
|
|
560 IF(MREM.EQ.1) THEN
|
|
DO 570 J=1,5
|
|
PV(1,J)=PV(1,J)/(1D0-PQT)
|
|
570 CONTINUE
|
|
ND=ND+1
|
|
MREM=0
|
|
ENDIF
|
|
|
|
C...Low invariant mass for system with spectator quark gives particle,
|
|
C...not two jets. Readjust momenta accordingly.
|
|
IF(MMAT.EQ.31.AND.ND.EQ.3) THEN
|
|
MSTJ(93)=1
|
|
PM2=PYMASS(K(N+2,2))
|
|
MSTJ(93)=1
|
|
PM3=PYMASS(K(N+3,2))
|
|
IF(P(N+2,5)**2+P(N+3,5)**2+2D0*FOUR(N+2,N+3).GE.
|
|
& (PARJ(32)+PM2+PM3)**2) GOTO 630
|
|
K(N+2,1)=1
|
|
KFTEMP=K(N+2,2)
|
|
CALL PYKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2))
|
|
IF(K(N+2,2).EQ.0) GOTO 260
|
|
P(N+2,5)=PYMASS(K(N+2,2))
|
|
PS=P(N+1,5)+P(N+2,5)
|
|
PV(2,5)=P(N+2,5)
|
|
MMAT=0
|
|
ND=2
|
|
GOTO 460
|
|
ELSEIF(MMAT.EQ.44) THEN
|
|
MSTJ(93)=1
|
|
PM3=PYMASS(K(N+3,2))
|
|
MSTJ(93)=1
|
|
PM4=PYMASS(K(N+4,2))
|
|
IF(P(N+3,5)**2+P(N+4,5)**2+2D0*FOUR(N+3,N+4).GE.
|
|
& (PARJ(32)+PM3+PM4)**2) GOTO 600
|
|
K(N+3,1)=1
|
|
KFTEMP=K(N+3,2)
|
|
CALL PYKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2))
|
|
IF(K(N+3,2).EQ.0) GOTO 260
|
|
P(N+3,5)=PYMASS(K(N+3,2))
|
|
DO 580 J=1,3
|
|
P(N+3,J)=P(N+3,J)+P(N+4,J)
|
|
580 CONTINUE
|
|
P(N+3,4)=SQRT(P(N+3,1)**2+P(N+3,2)**2+P(N+3,3)**2+P(N+3,5)**2)
|
|
HA=P(N+1,4)**2-P(N+2,4)**2
|
|
HB=HA-(P(N+1,5)**2-P(N+2,5)**2)
|
|
HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+
|
|
& (P(N+1,3)-P(N+2,3))**2
|
|
HD=(PV(1,4)-P(N+3,4))**2
|
|
HE=HA**2-2D0*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2
|
|
HF=HD*HC-HB**2
|
|
HG=HD*HC-HA*HB
|
|
HH=(SQRT(HG**2+HE*HF)-HG)/(2D0*HF)
|
|
DO 590 J=1,3
|
|
PCOR=HH*(P(N+1,J)-P(N+2,J))
|
|
P(N+1,J)=P(N+1,J)+PCOR
|
|
P(N+2,J)=P(N+2,J)-PCOR
|
|
590 CONTINUE
|
|
P(N+1,4)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2+P(N+1,5)**2)
|
|
P(N+2,4)=SQRT(P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2+P(N+2,5)**2)
|
|
ND=ND-1
|
|
ENDIF
|
|
|
|
C...Check invariant mass of W jets. May give one particle or start over.
|
|
600 IF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48)
|
|
&.AND.IABS(K(N+1,2)).LT.10) THEN
|
|
PMR=SQRT(MAX(0D0,P(N+1,5)**2+P(N+2,5)**2+2D0*FOUR(N+1,N+2)))
|
|
MSTJ(93)=1
|
|
PM1=PYMASS(K(N+1,2))
|
|
MSTJ(93)=1
|
|
PM2=PYMASS(K(N+2,2))
|
|
IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 610
|
|
KFLDUM=INT(1.5D0+PYR(0))
|
|
CALL PYKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1)
|
|
CALL PYKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2)
|
|
IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 260
|
|
PSM=PYMASS(KF1)+PYMASS(KF2)
|
|
IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.PMR.GT.PARJ(64)+PSM) GOTO 610
|
|
IF(MMAT.GE.43.AND.PMR.GT.0.2D0*PARJ(32)+PSM) GOTO 610
|
|
IF(MMAT.EQ.48) GOTO 390
|
|
IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 260
|
|
K(N+1,1)=1
|
|
KFTEMP=K(N+1,2)
|
|
CALL PYKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2))
|
|
IF(K(N+1,2).EQ.0) GOTO 260
|
|
P(N+1,5)=PYMASS(K(N+1,2))
|
|
K(N+2,2)=K(N+3,2)
|
|
P(N+2,5)=P(N+3,5)
|
|
PS=P(N+1,5)+P(N+2,5)
|
|
IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260
|
|
PV(2,5)=P(N+3,5)
|
|
MMAT=0
|
|
ND=2
|
|
GOTO 460
|
|
ENDIF
|
|
|
|
C...Phase space decay of partons from W decay.
|
|
610 IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.IABS(K(N+1,2)).LT.10) THEN
|
|
KFLO(1)=K(N+1,2)
|
|
KFLO(2)=K(N+2,2)
|
|
K(N+1,1)=K(N+3,1)
|
|
K(N+1,2)=K(N+3,2)
|
|
DO 620 J=1,5
|
|
PV(1,J)=P(N+1,J)+P(N+2,J)
|
|
P(N+1,J)=P(N+3,J)
|
|
620 CONTINUE
|
|
PV(1,5)=PMR
|
|
N=N+1
|
|
NP=0
|
|
NQ=2
|
|
PS=0D0
|
|
MSTJ(93)=2
|
|
PSQ=PYMASS(KFLO(1))
|
|
MSTJ(93)=2
|
|
PSQ=PSQ+PYMASS(KFLO(2))
|
|
MMAT=11
|
|
GOTO 290
|
|
ENDIF
|
|
|
|
C...Boost back for rapidly moving particle.
|
|
630 N=N+ND
|
|
IF(MBST.EQ.1) THEN
|
|
DO 640 J=1,3
|
|
BE(J)=P(IP,J)/P(IP,4)
|
|
640 CONTINUE
|
|
GA=P(IP,4)/P(IP,5)
|
|
DO 660 I=NSAV+1,N
|
|
BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
|
|
DO 650 J=1,3
|
|
P(I,J)=P(I,J)+GA*(GA*BEP/(1D0+GA)+P(I,4))*BE(J)
|
|
650 CONTINUE
|
|
P(I,4)=GA*(P(I,4)+BEP)
|
|
660 CONTINUE
|
|
ENDIF
|
|
|
|
C...Fill in position of decay vertex.
|
|
DO 680 I=NSAV+1,N
|
|
DO 670 J=1,4
|
|
V(I,J)=VDCY(J)
|
|
670 CONTINUE
|
|
V(I,5)=0D0
|
|
680 CONTINUE
|
|
|
|
C...Set up for parton shower evolution from jets.
|
|
IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN
|
|
K(NSAV+1,1)=3
|
|
K(NSAV+2,1)=3
|
|
K(NSAV+3,1)=3
|
|
K(NSAV+1,4)=MSTU(5)*(NSAV+2)
|
|
K(NSAV+1,5)=MSTU(5)*(NSAV+3)
|
|
K(NSAV+2,4)=MSTU(5)*(NSAV+3)
|
|
K(NSAV+2,5)=MSTU(5)*(NSAV+1)
|
|
K(NSAV+3,4)=MSTU(5)*(NSAV+1)
|
|
K(NSAV+3,5)=MSTU(5)*(NSAV+2)
|
|
MSTJ(92)=-(NSAV+1)
|
|
ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN
|
|
K(NSAV+2,1)=3
|
|
K(NSAV+3,1)=3
|
|
K(NSAV+2,4)=MSTU(5)*(NSAV+3)
|
|
K(NSAV+2,5)=MSTU(5)*(NSAV+3)
|
|
K(NSAV+3,4)=MSTU(5)*(NSAV+2)
|
|
K(NSAV+3,5)=MSTU(5)*(NSAV+2)
|
|
MSTJ(92)=NSAV+2
|
|
ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44).AND.
|
|
& IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN
|
|
K(NSAV+1,1)=3
|
|
K(NSAV+2,1)=3
|
|
K(NSAV+1,4)=MSTU(5)*(NSAV+2)
|
|
K(NSAV+1,5)=MSTU(5)*(NSAV+2)
|
|
K(NSAV+2,4)=MSTU(5)*(NSAV+1)
|
|
K(NSAV+2,5)=MSTU(5)*(NSAV+1)
|
|
MSTJ(92)=NSAV+1
|
|
ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44).AND.
|
|
& IABS(K(NSAV+1,2)).LE.20.AND.IABS(K(NSAV+2,2)).LE.20) THEN
|
|
MSTJ(92)=NSAV+1
|
|
ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21)
|
|
& THEN
|
|
K(NSAV+1,1)=3
|
|
K(NSAV+2,1)=3
|
|
K(NSAV+3,1)=3
|
|
KCP=PYCOMP(K(NSAV+1,2))
|
|
KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2))
|
|
JCON=4
|
|
IF(KQP.LT.0) JCON=5
|
|
K(NSAV+1,JCON)=MSTU(5)*(NSAV+2)
|
|
K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1)
|
|
K(NSAV+2,JCON)=MSTU(5)*(NSAV+3)
|
|
K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2)
|
|
MSTJ(92)=NSAV+1
|
|
ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN
|
|
K(NSAV+1,1)=3
|
|
K(NSAV+3,1)=3
|
|
K(NSAV+1,4)=MSTU(5)*(NSAV+3)
|
|
K(NSAV+1,5)=MSTU(5)*(NSAV+3)
|
|
K(NSAV+3,4)=MSTU(5)*(NSAV+1)
|
|
K(NSAV+3,5)=MSTU(5)*(NSAV+1)
|
|
MSTJ(92)=NSAV+1
|
|
ENDIF
|
|
|
|
C...Mark decayed particle; special option for B-Bbar mixing.
|
|
IF(K(IP,1).EQ.5) K(IP,1)=15
|
|
IF(K(IP,1).LE.10) K(IP,1)=11
|
|
IF(MMIX.EQ.1.AND.MSTJ(26).EQ.2.AND.K(IP,1).EQ.11) K(IP,1)=12
|
|
K(IP,4)=NSAV+1
|
|
K(IP,5)=N
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYKFDI
|
|
C...Generates a new flavour pair and combines off a hadron.
|
|
|
|
SUBROUTINE PYKFDI(KFL1,KFL2,KFL3,KF)
|
|
|
|
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)
|
|
SAVE /PYDAT1/,/PYDAT2/
|
|
|
|
C...Default flavour values. Input consistency checks.
|
|
KF1A=IABS(KFL1)
|
|
KF2A=IABS(KFL2)
|
|
KFL3=0
|
|
KF=0
|
|
IF(KF1A.EQ.0) RETURN
|
|
IF(KF2A.NE.0) THEN
|
|
IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN
|
|
IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN
|
|
IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN
|
|
ENDIF
|
|
|
|
C...Check if tabulated flavour probabilities are to be used.
|
|
IF(MSTJ(15).EQ.1) THEN
|
|
KTAB1=-1
|
|
IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A
|
|
KFL1A=MOD(KF1A/1000,10)
|
|
KFL1B=MOD(KF1A/100,10)
|
|
KFL1S=MOD(KF1A,10)
|
|
IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4)
|
|
& KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2
|
|
IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1
|
|
IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A
|
|
KTAB2=0
|
|
IF(KF2A.NE.0) THEN
|
|
KTAB2=-1
|
|
IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A
|
|
KFL2A=MOD(KF2A/1000,10)
|
|
KFL2B=MOD(KF2A/100,10)
|
|
KFL2S=MOD(KF2A,10)
|
|
IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4)
|
|
& KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2
|
|
IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1
|
|
ENDIF
|
|
IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 150
|
|
ENDIF
|
|
|
|
C...Parameters and breaking diquark parameter combinations.
|
|
100 PAR2=PARJ(2)
|
|
PAR3=PARJ(3)
|
|
PAR4=3D0*PARJ(4)
|
|
IF(MSTJ(12).GE.2) THEN
|
|
PAR3M=SQRT(PARJ(3))
|
|
PAR4M=1D0/(3D0*SQRT(PARJ(4)))
|
|
PARDM=PARJ(7)/(PARJ(7)+PAR3M*PARJ(6))
|
|
PARS0=PARJ(5)*(2D0+(1D0+PAR2*PAR3M*PARJ(7))*(1D0+PAR4M))
|
|
PARS1=PARJ(7)*PARS0/(2D0*PAR3M)+PARJ(5)*(PARJ(6)*(1D0+PAR4M)+
|
|
& PAR2*PAR3M*PARJ(6)*PARJ(7))
|
|
PARS2=PARJ(5)*2D0*PARJ(6)*PARJ(7)*(PAR2*PARJ(7)+
|
|
& (1D0+PAR4M)/PAR3M)
|
|
PARSM=MAX(PARS0,PARS1,PARS2)
|
|
PAR4=PAR4*(1D0+PARSM)/(1D0+PARSM/(3D0*PAR4M))
|
|
ENDIF
|
|
|
|
C...Choice of whether to generate meson or baryon.
|
|
110 MBARY=0
|
|
KFDA=0
|
|
IF(KF1A.LE.10) THEN
|
|
IF(KF2A.EQ.0.AND.MSTJ(12).GE.1.AND.(1D0+PARJ(1))*PYR(0).GT.1D0)
|
|
& MBARY=1
|
|
IF(KF2A.GT.10) MBARY=2
|
|
IF(KF2A.GT.10.AND.KF2A.LE.10000) KFDA=KF2A
|
|
ELSE
|
|
MBARY=2
|
|
IF(KF1A.LE.10000) KFDA=KF1A
|
|
ENDIF
|
|
|
|
C...Possibility of process diquark -> meson + new diquark.
|
|
IF(KFDA.NE.0.AND.MSTJ(12).GE.2) THEN
|
|
KFLDA=MOD(KFDA/1000,10)
|
|
KFLDB=MOD(KFDA/100,10)
|
|
KFLDS=MOD(KFDA,10)
|
|
WTDQ=PARS0
|
|
IF(MAX(KFLDA,KFLDB).EQ.3) WTDQ=PARS1
|
|
IF(MIN(KFLDA,KFLDB).EQ.3) WTDQ=PARS2
|
|
IF(KFLDS.EQ.1) WTDQ=WTDQ/(3D0*PAR4M)
|
|
IF((1D0+WTDQ)*PYR(0).GT.1D0) MBARY=-1
|
|
IF(MBARY.EQ.-1.AND.KF2A.NE.0) RETURN
|
|
ENDIF
|
|
|
|
C...Flavour for meson, possibly with new flavour.
|
|
IF(MBARY.LE.0) THEN
|
|
KFS=ISIGN(1,KFL1)
|
|
IF(MBARY.EQ.0) THEN
|
|
IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2D0+PAR2)*PYR(0)),-KFL1)
|
|
KFLA=MAX(KF1A,KF2A+IABS(KFL3))
|
|
KFLB=MIN(KF1A,KF2A+IABS(KFL3))
|
|
IF(KFLA.NE.KF1A) KFS=-KFS
|
|
|
|
C...Splitting of diquark into meson plus new diquark.
|
|
ELSE
|
|
KFL1A=MOD(KF1A/1000,10)
|
|
KFL1B=MOD(KF1A/100,10)
|
|
120 KFL1D=KFL1A+INT(PYR(0)+0.5D0)*(KFL1B-KFL1A)
|
|
KFL1E=KFL1A+KFL1B-KFL1D
|
|
IF((KFL1D.EQ.3.AND.PYR(0).GT.PARDM).OR.(KFL1E.EQ.3.AND.
|
|
& PYR(0).LT.PARDM)) THEN
|
|
KFL1D=KFL1A+KFL1B-KFL1D
|
|
KFL1E=KFL1A+KFL1B-KFL1E
|
|
ENDIF
|
|
KFL3A=1+INT((2D0+PAR2*PAR3M*PARJ(7))*PYR(0))
|
|
IF((KFL1E.NE.KFL3A.AND.PYR(0).GT.(1D0+PAR4M)/
|
|
& MAX(2D0,1D0+PAR4M)).OR.(KFL1E.EQ.KFL3A.AND.PYR(0).GT.
|
|
& 2D0/MAX(2D0,1D0+PAR4M))) GOTO 120
|
|
KFLDS=3
|
|
IF(KFL1E.NE.KFL3A) KFLDS=2*INT(PYR(0)+1D0/(1D0+PAR4M))+1
|
|
KFL3=ISIGN(10000+1000*MAX(KFL1E,KFL3A)+100*MIN(KFL1E,KFL3A)+
|
|
& KFLDS,-KFL1)
|
|
KFLA=MAX(KFL1D,KFL3A)
|
|
KFLB=MIN(KFL1D,KFL3A)
|
|
IF(KFLA.NE.KFL1D) KFS=-KFS
|
|
ENDIF
|
|
|
|
C...Form meson, with spin and flavour mixing for diagonal states.
|
|
IF(KFLA.LE.2) KMUL=INT(PARJ(11)+PYR(0))
|
|
IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+PYR(0))
|
|
IF(KFLA.GE.4) KMUL=INT(PARJ(13)+PYR(0))
|
|
IF(KMUL.EQ.0.AND.PARJ(14).GT.0D0) THEN
|
|
IF(PYR(0).LT.PARJ(14)) KMUL=2
|
|
ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0D0) THEN
|
|
RMUL=PYR(0)
|
|
IF(RMUL.LT.PARJ(15)) KMUL=3
|
|
IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4
|
|
IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5
|
|
ENDIF
|
|
KFLS=3
|
|
IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
|
|
IF(KMUL.EQ.5) KFLS=5
|
|
IF(KFLA.NE.KFLB) THEN
|
|
KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA
|
|
ELSE
|
|
RMIX=PYR(0)
|
|
IMIX=2*KFLA+10*KMUL
|
|
IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+
|
|
& INT(RMIX+PARF(IMIX)))+KFLS
|
|
IF(KFLA.GE.4) KF=110*KFLA+KFLS
|
|
ENDIF
|
|
IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF)
|
|
IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF)
|
|
|
|
C...Optional extra suppression of eta and eta'.
|
|
IF(KF.EQ.221) THEN
|
|
IF(PYR(0).GT.PARJ(25)) GOTO 110
|
|
ELSEIF(KF.EQ.331) THEN
|
|
IF(PYR(0).GT.PARJ(26)) GOTO 110
|
|
ENDIF
|
|
|
|
C...Generate diquark flavour.
|
|
ELSE
|
|
130 IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN
|
|
KFLA=KF1A
|
|
140 KFLB=1+INT((2D0+PAR2*PAR3)*PYR(0))
|
|
KFLC=1+INT((2D0+PAR2*PAR3)*PYR(0))
|
|
KFLDS=1
|
|
IF(KFLB.GE.KFLC) KFLDS=3
|
|
IF(KFLDS.EQ.1.AND.PAR4*PYR(0).GT.1D0) GOTO 140
|
|
IF(KFLDS.EQ.3.AND.PAR4.LT.PYR(0)) GOTO 140
|
|
KFL3=ISIGN(1000*MAX(KFLB,KFLC)+100*MIN(KFLB,KFLC)+KFLDS,KFL1)
|
|
|
|
C...Take diquark flavour from input.
|
|
ELSEIF(KF1A.LE.10) THEN
|
|
KFLA=KF1A
|
|
KFLB=MOD(KF2A/1000,10)
|
|
KFLC=MOD(KF2A/100,10)
|
|
KFLDS=MOD(KF2A,10)
|
|
|
|
C...Generate (or take from input) quark to go with diquark.
|
|
ELSE
|
|
IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2D0+PAR2)*PYR(0)),KFL1)
|
|
KFLA=KF2A+IABS(KFL3)
|
|
KFLB=MOD(KF1A/1000,10)
|
|
KFLC=MOD(KF1A/100,10)
|
|
KFLDS=MOD(KF1A,10)
|
|
ENDIF
|
|
|
|
C...SU(6) factors for formation of baryon. Try again if fails.
|
|
KBARY=KFLDS
|
|
IF(KFLDS.EQ.3.AND.KFLB.NE.KFLC) KBARY=5
|
|
IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC) KBARY=KBARY+1
|
|
WT=PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY)
|
|
IF(MBARY.EQ.1.AND.MSTJ(12).GE.2) THEN
|
|
WTDQ=PARS0
|
|
IF(MAX(KFLB,KFLC).EQ.3) WTDQ=PARS1
|
|
IF(MIN(KFLB,KFLC).EQ.3) WTDQ=PARS2
|
|
IF(KFLDS.EQ.1) WTDQ=WTDQ/(3D0*PAR4M)
|
|
IF(KFLDS.EQ.1) WT=WT*(1D0+WTDQ)/(1D0+PARSM/(3D0*PAR4M))
|
|
IF(KFLDS.EQ.3) WT=WT*(1D0+WTDQ)/(1D0+PARSM)
|
|
ENDIF
|
|
IF(KF2A.EQ.0.AND.WT.LT.PYR(0)) GOTO 130
|
|
|
|
C...Form baryon. Distinguish Lambda- and Sigmalike baryons.
|
|
KFLD=MAX(KFLA,KFLB,KFLC)
|
|
KFLF=MIN(KFLA,KFLB,KFLC)
|
|
KFLE=KFLA+KFLB+KFLC-KFLD-KFLF
|
|
KFLS=2
|
|
IF((PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY))*PYR(0).GT.
|
|
& PARF(60+KBARY)) KFLS=4
|
|
KFLL=0
|
|
IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF) THEN
|
|
IF(KFLDS.EQ.1.AND.KFLA.EQ.KFLD) KFLL=1
|
|
IF(KFLDS.EQ.1.AND.KFLA.NE.KFLD) KFLL=INT(0.25D0+PYR(0))
|
|
IF(KFLDS.EQ.3.AND.KFLA.NE.KFLD) KFLL=INT(0.75D0+PYR(0))
|
|
ENDIF
|
|
IF(KFLL.EQ.0) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1)
|
|
IF(KFLL.EQ.1) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1)
|
|
ENDIF
|
|
RETURN
|
|
|
|
C...Use tabulated probabilities to select new flavour and hadron.
|
|
150 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN
|
|
KT3L=1
|
|
KT3U=6
|
|
ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN
|
|
KT3L=1
|
|
KT3U=6
|
|
ELSEIF(KTAB2.EQ.0) THEN
|
|
KT3L=1
|
|
KT3U=22
|
|
ELSE
|
|
KT3L=KTAB2
|
|
KT3U=KTAB2
|
|
ENDIF
|
|
RFL=0D0
|
|
DO 170 KTS=0,2
|
|
DO 160 KT3=KT3L,KT3U
|
|
RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3)
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
RFL=PYR(0)*RFL
|
|
DO 190 KTS=0,2
|
|
KTABS=KTS
|
|
DO 180 KT3=KT3L,KT3U
|
|
KTAB3=KT3
|
|
RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3)
|
|
IF(RFL.LE.0D0) GOTO 200
|
|
180 CONTINUE
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
|
|
C...Reconstruct flavour of produced quark/diquark.
|
|
IF(KTAB3.LE.6) THEN
|
|
KFL3A=KTAB3
|
|
KFL3B=0
|
|
KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13))
|
|
ELSE
|
|
KFL3A=1
|
|
IF(KTAB3.GE.8) KFL3A=2
|
|
IF(KTAB3.GE.11) KFL3A=3
|
|
IF(KTAB3.GE.16) KFL3A=4
|
|
KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2
|
|
KFL3=1000*KFL3A+100*KFL3B+1
|
|
IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3=
|
|
& KFL3+2
|
|
KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1))
|
|
ENDIF
|
|
|
|
C...Reconstruct meson code.
|
|
IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR.
|
|
&KFL3B.NE.0)) THEN
|
|
RFL=PYR(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+
|
|
& 25*KTABS)+PARF(145+80*KTAB1+25*KTABS))
|
|
KF=110+2*KTABS+1
|
|
IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1
|
|
IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+
|
|
& 25*KTABS)) KF=330+2*KTABS+1
|
|
ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN
|
|
KFLA=MAX(KTAB1,KTAB3)
|
|
KFLB=MIN(KTAB1,KTAB3)
|
|
KFS=ISIGN(1,KFL1)
|
|
IF(KFLA.NE.KF1A) KFS=-KFS
|
|
KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA
|
|
ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN
|
|
KFS=ISIGN(1,KFL1)
|
|
IF(KFL1A.EQ.KFL3A) THEN
|
|
KFLA=MAX(KFL1B,KFL3B)
|
|
KFLB=MIN(KFL1B,KFL3B)
|
|
IF(KFLA.NE.KFL1B) KFS=-KFS
|
|
ELSEIF(KFL1A.EQ.KFL3B) THEN
|
|
KFLA=KFL3A
|
|
KFLB=KFL1B
|
|
KFS=-KFS
|
|
ELSEIF(KFL1B.EQ.KFL3A) THEN
|
|
KFLA=KFL1A
|
|
KFLB=KFL3B
|
|
ELSEIF(KFL1B.EQ.KFL3B) THEN
|
|
KFLA=MAX(KFL1A,KFL3A)
|
|
KFLB=MIN(KFL1A,KFL3A)
|
|
IF(KFLA.NE.KFL1A) KFS=-KFS
|
|
ELSE
|
|
CALL PYERRM(2,'(PYKFDI:) no matching flavours for qq -> qq')
|
|
GOTO 100
|
|
ENDIF
|
|
KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA
|
|
|
|
C...Reconstruct baryon code.
|
|
ELSE
|
|
IF(KTAB1.GE.7) THEN
|
|
KFLA=KFL3A
|
|
KFLB=KFL1A
|
|
KFLC=KFL1B
|
|
ELSE
|
|
KFLA=KFL1A
|
|
KFLB=KFL3A
|
|
KFLC=KFL3B
|
|
ENDIF
|
|
KFLD=MAX(KFLA,KFLB,KFLC)
|
|
KFLF=MIN(KFLA,KFLB,KFLC)
|
|
KFLE=KFLA+KFLB+KFLC-KFLD-KFLF
|
|
IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1)
|
|
IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1)
|
|
ENDIF
|
|
|
|
C...Check that constructed flavour code is an allowed one.
|
|
IF(KFL2.NE.0) KFL3=0
|
|
KC=PYCOMP(KF)
|
|
IF(KC.EQ.0) THEN
|
|
CALL PYERRM(2,'(PYKFDI:) user-defined flavour probabilities '//
|
|
& 'failed')
|
|
GOTO 100
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPTDI
|
|
C...Generates transverse momentum according to a Gaussian.
|
|
|
|
SUBROUTINE PYPTDI(KFL,PX,PY)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
|
|
C...Generate p_T and azimuthal angle, gives p_x and p_y.
|
|
KFLA=IABS(KFL)
|
|
PT=PARJ(21)*SQRT(-LOG(MAX(1D-10,PYR(0))))
|
|
IF(PARJ(23).GT.PYR(0)) PT=PARJ(24)*PT
|
|
IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT
|
|
IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0D0
|
|
PHI=PARU(2)*PYR(0)
|
|
PX=PT*COS(PHI)
|
|
PY=PT*SIN(PHI)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYZDIS
|
|
C...Generates the longitudinal splitting variable z.
|
|
|
|
SUBROUTINE PYZDIS(KFL1,KFL2,PR,Z)
|
|
|
|
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)
|
|
SAVE /PYDAT1/,/PYDAT2/
|
|
|
|
C...Check if heavy flavour fragmentation.
|
|
KFLA=IABS(KFL1)
|
|
KFLB=IABS(KFL2)
|
|
KFLH=KFLA
|
|
IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10)
|
|
|
|
C...Lund symmetric scaling function: determine parameters of shape.
|
|
IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3).OR.
|
|
&MSTJ(11).GE.4) THEN
|
|
FA=PARJ(41)
|
|
IF(MSTJ(91).EQ.1) FA=PARJ(43)
|
|
IF(KFLB.GE.10) FA=FA+PARJ(45)
|
|
FBB=PARJ(42)
|
|
IF(MSTJ(91).EQ.1) FBB=PARJ(44)
|
|
FB=FBB*PR
|
|
FC=1D0
|
|
IF(KFLA.GE.10) FC=FC-PARJ(45)
|
|
IF(KFLB.GE.10) FC=FC+PARJ(45)
|
|
IF(MSTJ(11).GE.4.AND.KFLH.GE.4.AND.KFLH.LE.5) THEN
|
|
FRED=PARJ(46)
|
|
IF(MSTJ(11).EQ.5.AND.KFLH.EQ.5) FRED=PARJ(47)
|
|
FC=FC+FRED*FBB*PARF(100+KFLH)**2
|
|
ELSEIF(MSTJ(11).GE.4.AND.KFLH.GE.6.AND.KFLH.LE.8) THEN
|
|
FRED=PARJ(46)
|
|
IF(MSTJ(11).EQ.5) FRED=PARJ(48)
|
|
FC=FC+FRED*FBB*PMAS(KFLH,1)**2
|
|
ENDIF
|
|
MC=1
|
|
IF(ABS(FC-1D0).GT.0.01D0) MC=2
|
|
|
|
C...Determine position of maximum. Special cases for a = 0 or a = c.
|
|
IF(FA.LT.0.02D0) THEN
|
|
MA=1
|
|
ZMAX=1D0
|
|
IF(FC.GT.FB) ZMAX=FB/FC
|
|
ELSEIF(ABS(FC-FA).LT.0.01D0) THEN
|
|
MA=2
|
|
ZMAX=FB/(FB+FC)
|
|
ELSE
|
|
MA=3
|
|
ZMAX=0.5D0*(FB+FC-SQRT((FB-FC)**2+4D0*FA*FB))/(FC-FA)
|
|
IF(ZMAX.GT.0.9999D0.AND.FB.GT.100D0) ZMAX=MIN(ZMAX,1D0-FA/FB)
|
|
ENDIF
|
|
|
|
C...Subdivide z range if distribution very peaked near endpoint.
|
|
MMAX=2
|
|
IF(ZMAX.LT.0.1D0) THEN
|
|
MMAX=1
|
|
ZDIV=2.75D0*ZMAX
|
|
IF(MC.EQ.1) THEN
|
|
FINT=1D0-LOG(ZDIV)
|
|
ELSE
|
|
ZDIVC=ZDIV**(1D0-FC)
|
|
FINT=1D0+(1D0-1D0/ZDIVC)/(FC-1D0)
|
|
ENDIF
|
|
ELSEIF(ZMAX.GT.0.85D0.AND.FB.GT.1D0) THEN
|
|
MMAX=3
|
|
FSCB=SQRT(4D0+(FC/FB)**2)
|
|
ZDIV=FSCB-1D0/ZMAX-(FC/FB)*LOG(ZMAX*0.5D0*(FSCB+FC/FB))
|
|
IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1D0-ZMAX)
|
|
ZDIV=MIN(ZMAX,MAX(0D0,ZDIV))
|
|
FINT=1D0+FB*(1D0-ZDIV)
|
|
ENDIF
|
|
|
|
C...Choice of z, preweighted for peaks at low or high z.
|
|
100 Z=PYR(0)
|
|
FPRE=1D0
|
|
IF(MMAX.EQ.1) THEN
|
|
IF(FINT*PYR(0).LE.1D0) THEN
|
|
Z=ZDIV*Z
|
|
ELSEIF(MC.EQ.1) THEN
|
|
Z=ZDIV**Z
|
|
FPRE=ZDIV/Z
|
|
ELSE
|
|
Z=(ZDIVC+Z*(1D0-ZDIVC))**(1D0/(1D0-FC))
|
|
FPRE=(ZDIV/Z)**FC
|
|
ENDIF
|
|
ELSEIF(MMAX.EQ.3) THEN
|
|
IF(FINT*PYR(0).LE.1D0) THEN
|
|
Z=ZDIV+LOG(Z)/FB
|
|
FPRE=EXP(FB*(Z-ZDIV))
|
|
ELSE
|
|
Z=ZDIV+Z*(1D0-ZDIV)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Weighting according to correct formula.
|
|
IF(Z.LE.0D0.OR.Z.GE.1D0) GOTO 100
|
|
FEXP=FC*LOG(ZMAX/Z)+FB*(1D0/ZMAX-1D0/Z)
|
|
IF(MA.GE.2) FEXP=FEXP+FA*LOG((1D0-Z)/(1D0-ZMAX))
|
|
FVAL=EXP(MAX(-50D0,MIN(50D0,FEXP)))
|
|
IF(FVAL.LT.PYR(0)*FPRE) GOTO 100
|
|
|
|
C...Generate z according to Field-Feynman, SLAC, (1-z)**c OR z**c.
|
|
ELSE
|
|
FC=PARJ(50+MAX(1,KFLH))
|
|
IF(MSTJ(91).EQ.1) FC=PARJ(59)
|
|
110 Z=PYR(0)
|
|
IF(FC.GE.0D0.AND.FC.LE.1D0) THEN
|
|
IF(FC.GT.PYR(0)) Z=1D0-Z**(1D0/3D0)
|
|
ELSEIF(FC.GT.-1.AND.FC.LT.0D0) THEN
|
|
IF(-4D0*FC*Z*(1D0-Z)**2.LT.PYR(0)*((1D0-Z)**2-FC*Z)**2)
|
|
& GOTO 110
|
|
ELSE
|
|
IF(FC.GT.0D0) Z=1D0-Z**(1D0/FC)
|
|
IF(FC.LT.0D0) Z=Z**(-1D0/FC)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYSHOW
|
|
C...Generates timelike parton showers from given partons.
|
|
|
|
SUBROUTINE PYSHOW(IP1,IP2,QMAX)
|
|
|
|
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...Local arrays.
|
|
DIMENSION PMTH(5,50),PS(5),PMA(4),PMSD(4),IEP(4),IPA(4),
|
|
&KFLA(4),KFLD(4),KFL(4),ITRY(4),ISI(4),ISL(4),DP(4),DPT(5,4),
|
|
&KSH(0:40),KCII(2),NIIS(2),IIIS(2,2),THEIIS(2,2),PHIIIS(2,2),
|
|
&ISII(2)
|
|
|
|
C...Initialization of cutoff masses etc.
|
|
IF(MSTJ(41).LE.0.OR.(MSTJ(41).EQ.1.AND.QMAX.LE.PARJ(82)).OR.
|
|
&QMAX.LE.MIN(PARJ(82),PARJ(83))) RETURN
|
|
DO 100 IFL=0,40
|
|
KSH(IFL)=0
|
|
100 CONTINUE
|
|
KSH(21)=1
|
|
PMTH(1,21)=PYMASS(21)
|
|
PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25D0*PARJ(82)**2)
|
|
PMTH(3,21)=2D0*PMTH(2,21)
|
|
PMTH(4,21)=PMTH(3,21)
|
|
PMTH(5,21)=PMTH(3,21)
|
|
PMTH(1,22)=PYMASS(22)
|
|
PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25D0*PARJ(83)**2)
|
|
PMTH(3,22)=2D0*PMTH(2,22)
|
|
PMTH(4,22)=PMTH(3,22)
|
|
PMTH(5,22)=PMTH(3,22)
|
|
PMQTH1=PARJ(82)
|
|
IF(MSTJ(41).GE.2) PMQTH1=MIN(PARJ(82),PARJ(83))
|
|
PMQTH2=PMTH(2,21)
|
|
IF(MSTJ(41).GE.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22))
|
|
DO 110 IFL=1,8
|
|
KSH(IFL)=1
|
|
PMTH(1,IFL)=PYMASS(IFL)
|
|
PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PMQTH1**2)
|
|
PMTH(3,IFL)=PMTH(2,IFL)+PMQTH2
|
|
PMTH(4,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(82)**2)+PMTH(2,21)
|
|
PMTH(5,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(83)**2)+PMTH(2,22)
|
|
110 CONTINUE
|
|
DO 120 IFL=11,17,2
|
|
IF(MSTJ(41).GE.2) KSH(IFL)=1
|
|
PMTH(1,IFL)=PYMASS(IFL)
|
|
PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(83)**2)
|
|
PMTH(3,IFL)=PMTH(2,IFL)+PMTH(2,22)
|
|
PMTH(4,IFL)=PMTH(3,IFL)
|
|
PMTH(5,IFL)=PMTH(3,IFL)
|
|
120 CONTINUE
|
|
PT2MIN=MAX(0.5D0*PARJ(82),1.1D0*PARJ(81))**2
|
|
ALAMS=PARJ(81)**2
|
|
ALFM=LOG(PT2MIN/ALAMS)
|
|
|
|
C...Store positions of shower initiating partons.
|
|
IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN
|
|
NPA=1
|
|
IPA(1)=IP1
|
|
ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)-
|
|
& MSTU(32))) THEN
|
|
NPA=2
|
|
IPA(1)=IP1
|
|
IPA(2)=IP2
|
|
ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0
|
|
& .AND.IP2.GE.-3) THEN
|
|
NPA=IABS(IP2)
|
|
DO 130 I=1,NPA
|
|
IPA(I)=IP1+I-1
|
|
130 CONTINUE
|
|
ELSE
|
|
CALL PYERRM(12,
|
|
& '(PYSHOW:) failed to reconstruct showering system')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
|
|
C...Check on phase space available for emission.
|
|
IREJ=0
|
|
DO 140 J=1,5
|
|
PS(J)=0D0
|
|
140 CONTINUE
|
|
PM=0D0
|
|
DO 160 I=1,NPA
|
|
KFLA(I)=IABS(K(IPA(I),2))
|
|
PMA(I)=P(IPA(I),5)
|
|
C...Special cutoff masses for t, l, h with variable masses.
|
|
IFLA=KFLA(I)
|
|
IF(KFLA(I).GE.6.AND.KFLA(I).LE.8) THEN
|
|
IFLA=37+KFLA(I)+ISIGN(2,K(IPA(I),2))
|
|
PMTH(1,IFLA)=PMA(I)
|
|
PMTH(2,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25D0*PMQTH1**2)
|
|
PMTH(3,IFLA)=PMTH(2,IFLA)+PMQTH2
|
|
PMTH(4,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25D0*PARJ(82)**2)+
|
|
& PMTH(2,21)
|
|
PMTH(5,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25D0*PARJ(83)**2)+
|
|
& PMTH(2,22)
|
|
ENDIF
|
|
IF(KFLA(I).LE.40) THEN
|
|
IF(KSH(KFLA(I)).EQ.1) PMA(I)=PMTH(3,IFLA)
|
|
ENDIF
|
|
PM=PM+PMA(I)
|
|
IF(KFLA(I).GT.40) THEN
|
|
IREJ=IREJ+1
|
|
ELSE
|
|
IF(KSH(KFLA(I)).EQ.0.OR.PMA(I).GT.QMAX) IREJ=IREJ+1
|
|
ENDIF
|
|
DO 150 J=1,4
|
|
PS(J)=PS(J)+P(IPA(I),J)
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
IF(IREJ.EQ.NPA) RETURN
|
|
PS(5)=SQRT(MAX(0D0,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))
|
|
IF(NPA.EQ.1) PS(5)=PS(4)
|
|
IF(PS(5).LE.PM+PMQTH1) RETURN
|
|
|
|
C...Check if 3-jet matrix elements to be used.
|
|
M3JC=0
|
|
IF(NPA.EQ.2.AND.MSTJ(47).GE.1) THEN
|
|
IF(KFLA(1).GE.1.AND.KFLA(1).LE.8.AND.KFLA(2).GE.1.AND.
|
|
& KFLA(2).LE.8) M3JC=1
|
|
IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR.
|
|
& KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)) M3JC=1
|
|
IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR.
|
|
& KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)+1) M3JC=1
|
|
IF((KFLA(1).EQ.12.OR.KFLA(1).EQ.14.OR.KFLA(1).EQ.16.OR.
|
|
& KFLA(1).EQ.18).AND.KFLA(2).EQ.KFLA(1)-1) M3JC=1
|
|
IF(MSTJ(47).EQ.2.OR.MSTJ(47).EQ.4) M3JC=1
|
|
M3JCM=0
|
|
IF(M3JC.EQ.1.AND.MSTJ(47).GE.3.AND.KFLA(1).EQ.KFLA(2)) THEN
|
|
M3JCM=1
|
|
QME=(2D0*PMTH(1,KFLA(1))/PS(5))**2
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Find if interference with initial state partons.
|
|
MIIS=0
|
|
IF(MSTJ(50).GE.1.AND.MSTJ(50).LE.3.AND.NPA.EQ.2) MIIS=MSTJ(50)
|
|
IF(MIIS.NE.0) THEN
|
|
DO 180 I=1,2
|
|
KCII(I)=0
|
|
KCA=PYCOMP(KFLA(I))
|
|
IF(KCA.NE.0) KCII(I)=KCHG(KCA,2)*ISIGN(1,K(IPA(I),2))
|
|
NIIS(I)=0
|
|
IF(KCII(I).NE.0) THEN
|
|
DO 170 J=1,2
|
|
ICSI=MOD(K(IPA(I),3+J)/MSTU(5),MSTU(5))
|
|
IF(ICSI.GT.0.AND.ICSI.NE.IPA(1).AND.ICSI.NE.IPA(2).AND.
|
|
& (KCII(I).EQ.(-1)**(J+1).OR.KCII(I).EQ.2)) THEN
|
|
NIIS(I)=NIIS(I)+1
|
|
IIIS(I,NIIS(I))=ICSI
|
|
ENDIF
|
|
170 CONTINUE
|
|
ENDIF
|
|
180 CONTINUE
|
|
IF(NIIS(1)+NIIS(2).EQ.0) MIIS=0
|
|
ENDIF
|
|
|
|
C...Boost interfering initial partons to rest frame
|
|
C...and reconstruct their polar and azimuthal angles.
|
|
IF(MIIS.NE.0) THEN
|
|
DO 200 I=1,2
|
|
DO 190 J=1,5
|
|
K(N+I,J)=K(IPA(I),J)
|
|
P(N+I,J)=P(IPA(I),J)
|
|
V(N+I,J)=0D0
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
DO 220 I=3,2+NIIS(1)
|
|
DO 210 J=1,5
|
|
K(N+I,J)=K(IIIS(1,I-2),J)
|
|
P(N+I,J)=P(IIIS(1,I-2),J)
|
|
V(N+I,J)=0D0
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
DO 240 I=3+NIIS(1),2+NIIS(1)+NIIS(2)
|
|
DO 230 J=1,5
|
|
K(N+I,J)=K(IIIS(2,I-2-NIIS(1)),J)
|
|
P(N+I,J)=P(IIIS(2,I-2-NIIS(1)),J)
|
|
V(N+I,J)=0D0
|
|
230 CONTINUE
|
|
240 CONTINUE
|
|
CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),0D0,0D0,-PS(1)/PS(4),
|
|
& -PS(2)/PS(4),-PS(3)/PS(4))
|
|
PHI=PYANGL(P(N+1,1),P(N+1,2))
|
|
CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),0D0,-PHI,0D0,0D0,0D0)
|
|
THE=PYANGL(P(N+1,3),P(N+1,1))
|
|
CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),-THE,0D0,0D0,0D0,0D0)
|
|
DO 250 I=3,2+NIIS(1)
|
|
THEIIS(1,I-2)=PYANGL(P(N+I,3),SQRT(P(N+I,1)**2+P(N+I,2)**2))
|
|
PHIIIS(1,I-2)=PYANGL(P(N+I,1),P(N+I,2))
|
|
250 CONTINUE
|
|
DO 260 I=3+NIIS(1),2+NIIS(1)+NIIS(2)
|
|
THEIIS(2,I-2-NIIS(1))=PARU(1)-PYANGL(P(N+I,3),
|
|
& SQRT(P(N+I,1)**2+P(N+I,2)**2))
|
|
PHIIIS(2,I-2-NIIS(1))=PYANGL(P(N+I,1),P(N+I,2))
|
|
260 CONTINUE
|
|
ENDIF
|
|
|
|
C...Define imagined single initiator of shower for parton system.
|
|
NS=N
|
|
IF(N.GT.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
IF(NPA.GE.2) THEN
|
|
K(N+1,1)=11
|
|
K(N+1,2)=21
|
|
K(N+1,3)=0
|
|
K(N+1,4)=0
|
|
K(N+1,5)=0
|
|
P(N+1,1)=0D0
|
|
P(N+1,2)=0D0
|
|
P(N+1,3)=0D0
|
|
P(N+1,4)=PS(5)
|
|
P(N+1,5)=PS(5)
|
|
V(N+1,5)=PS(5)**2
|
|
N=N+1
|
|
ENDIF
|
|
|
|
C...Loop over partons that may branch.
|
|
NEP=NPA
|
|
IM=NS
|
|
IF(NPA.EQ.1) IM=NS-1
|
|
270 IM=IM+1
|
|
IF(N.GT.NS) THEN
|
|
IF(IM.GT.N) GOTO 510
|
|
KFLM=IABS(K(IM,2))
|
|
IF(KFLM.GT.40) GOTO 270
|
|
IF(KSH(KFLM).EQ.0) GOTO 270
|
|
IFLM=KFLM
|
|
IF(KFLM.GE.6.AND.KFLM.LE.8) IFLM=37+KFLM+ISIGN(2,K(IM,2))
|
|
IF(P(IM,5).LT.PMTH(2,IFLM)) GOTO 270
|
|
IGM=K(IM,3)
|
|
ELSE
|
|
IGM=-1
|
|
ENDIF
|
|
IF(N+NEP.GT.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
|
|
C...Position of aunt (sister to branching parton).
|
|
C...Origin and flavour of daughters.
|
|
IAU=0
|
|
IF(IGM.GT.0) THEN
|
|
IF(K(IM-1,3).EQ.IGM) IAU=IM-1
|
|
IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1
|
|
ENDIF
|
|
IF(IGM.GE.0) THEN
|
|
K(IM,4)=N+1
|
|
DO 280 I=1,NEP
|
|
K(N+I,3)=IM
|
|
280 CONTINUE
|
|
ELSE
|
|
K(N+1,3)=IPA(1)
|
|
ENDIF
|
|
IF(IGM.LE.0) THEN
|
|
DO 290 I=1,NEP
|
|
K(N+I,2)=K(IPA(I),2)
|
|
290 CONTINUE
|
|
ELSEIF(KFLM.NE.21) THEN
|
|
K(N+1,2)=K(IM,2)
|
|
K(N+2,2)=K(IM,5)
|
|
ELSEIF(K(IM,5).EQ.21) THEN
|
|
K(N+1,2)=21
|
|
K(N+2,2)=21
|
|
ELSE
|
|
K(N+1,2)=K(IM,5)
|
|
K(N+2,2)=-K(IM,5)
|
|
ENDIF
|
|
|
|
C...Reset flags on daughers and tries made.
|
|
DO 300 IP=1,NEP
|
|
K(N+IP,1)=3
|
|
K(N+IP,4)=0
|
|
K(N+IP,5)=0
|
|
KFLD(IP)=IABS(K(N+IP,2))
|
|
IF(KCHG(PYCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1
|
|
ITRY(IP)=0
|
|
ISL(IP)=0
|
|
ISI(IP)=0
|
|
IF(KFLD(IP).LE.40) THEN
|
|
IF(KSH(KFLD(IP)).EQ.1) ISI(IP)=1
|
|
ENDIF
|
|
300 CONTINUE
|
|
ISLM=0
|
|
|
|
C...Maximum virtuality of daughters.
|
|
IF(IGM.LE.0) THEN
|
|
DO 310 I=1,NPA
|
|
IF(NPA.GE.3) P(N+I,4)=(PS(4)*P(IPA(I),4)-PS(1)*P(IPA(I),1)-
|
|
& PS(2)*P(IPA(I),2)-PS(3)*P(IPA(I),3))/PS(5)
|
|
P(N+I,5)=MIN(QMAX,PS(5))
|
|
IF(NPA.GE.3) P(N+I,5)=MIN(P(N+I,5),P(N+I,4))
|
|
IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5)
|
|
310 CONTINUE
|
|
ELSE
|
|
IF(MSTJ(43).LE.2) PEM=V(IM,2)
|
|
IF(MSTJ(43).GE.3) PEM=P(IM,4)
|
|
P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM)
|
|
P(N+2,5)=MIN(P(IM,5),(1D0-V(IM,1))*PEM)
|
|
IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22)
|
|
ENDIF
|
|
DO 320 I=1,NEP
|
|
PMSD(I)=P(N+I,5)
|
|
IF(ISI(I).EQ.1) THEN
|
|
IFLD=KFLD(I)
|
|
IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+
|
|
& ISIGN(2,K(N+I,2))
|
|
IF(P(N+I,5).LE.PMTH(3,IFLD)) P(N+I,5)=PMTH(1,IFLD)
|
|
ENDIF
|
|
V(N+I,5)=P(N+I,5)**2
|
|
320 CONTINUE
|
|
|
|
C...Choose one of the daughters for evolution.
|
|
330 INUM=0
|
|
IF(NEP.EQ.1) INUM=1
|
|
DO 340 I=1,NEP
|
|
IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I
|
|
340 CONTINUE
|
|
DO 350 I=1,NEP
|
|
IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN
|
|
IFLD=KFLD(I)
|
|
IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+
|
|
& ISIGN(2,K(N+I,2))
|
|
IF(P(N+I,5).GE.PMTH(2,IFLD)) INUM=I
|
|
ENDIF
|
|
350 CONTINUE
|
|
IF(INUM.EQ.0) THEN
|
|
RMAX=0D0
|
|
DO 360 I=1,NEP
|
|
IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN
|
|
RPM=P(N+I,5)/PMSD(I)
|
|
IFLD=KFLD(I)
|
|
IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+
|
|
& ISIGN(2,K(N+I,2))
|
|
IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,IFLD)) THEN
|
|
RMAX=RPM
|
|
INUM=I
|
|
ENDIF
|
|
ENDIF
|
|
360 CONTINUE
|
|
ENDIF
|
|
|
|
C...Store information on choice of evolving daughter.
|
|
INUM=MAX(1,INUM)
|
|
IEP(1)=N+INUM
|
|
DO 370 I=2,NEP
|
|
IEP(I)=IEP(I-1)+1
|
|
IF(IEP(I).GT.N+NEP) IEP(I)=N+1
|
|
370 CONTINUE
|
|
DO 380 I=1,NEP
|
|
KFL(I)=IABS(K(IEP(I),2))
|
|
380 CONTINUE
|
|
ITRY(INUM)=ITRY(INUM)+1
|
|
IF(ITRY(INUM).GT.200) THEN
|
|
CALL PYERRM(14,'(PYSHOW:) caught in infinite loop')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
Z=0.5D0
|
|
IF(KFL(1).GT.40) GOTO 430
|
|
IF(KSH(KFL(1)).EQ.0) GOTO 430
|
|
IFL=KFL(1)
|
|
IF(KFL(1).GE.6.AND.KFL(1).LE.8) IFL=37+KFL(1)+
|
|
&ISIGN(2,K(IEP(1),2))
|
|
IF(P(IEP(1),5).LT.PMTH(2,IFL)) GOTO 430
|
|
|
|
C...Select side for interference with initial state partons.
|
|
IF(MIIS.GE.1.AND.IEP(1).LE.NS+3) THEN
|
|
III=IEP(1)-NS-1
|
|
ISII(III)=0
|
|
IF(IABS(KCII(III)).EQ.1.AND.NIIS(III).EQ.1) THEN
|
|
ISII(III)=1
|
|
ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.1) THEN
|
|
IF(PYR(0).GT.0.5D0) ISII(III)=1
|
|
ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.2) THEN
|
|
ISII(III)=1
|
|
IF(PYR(0).GT.0.5D0) ISII(III)=2
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Calculate allowed z range.
|
|
IF(NEP.EQ.1) THEN
|
|
PMED=PS(4)
|
|
ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
|
|
PMED=P(IM,5)
|
|
ELSE
|
|
IF(INUM.EQ.1) PMED=V(IM,1)*PEM
|
|
IF(INUM.EQ.2) PMED=(1D0-V(IM,1))*PEM
|
|
ENDIF
|
|
IF(MOD(MSTJ(43),2).EQ.1) THEN
|
|
ZC=PMTH(2,21)/PMED
|
|
ZCE=PMTH(2,22)/PMED
|
|
ELSE
|
|
ZC=0.5D0*(1D0-SQRT(MAX(0D0,1D0-(2D0*PMTH(2,21)/PMED)**2)))
|
|
IF(ZC.LT.1D-4) ZC=(PMTH(2,21)/PMED)**2
|
|
ZCE=0.5D0*(1D0-SQRT(MAX(0D0,1D0-(2D0*PMTH(2,22)/PMED)**2)))
|
|
IF(ZCE.LT.1D-4) ZCE=(PMTH(2,22)/PMED)**2
|
|
ENDIF
|
|
ZC=MIN(ZC,0.491D0)
|
|
ZCE=MIN(ZCE,0.491D0)
|
|
IF((MSTJ(41).EQ.1.AND.ZC.GT.0.49D0).OR.(MSTJ(41).GE.2.AND.
|
|
&MIN(ZC,ZCE).GT.0.49D0)) THEN
|
|
P(IEP(1),5)=PMTH(1,IFL)
|
|
V(IEP(1),5)=P(IEP(1),5)**2
|
|
GOTO 430
|
|
ENDIF
|
|
|
|
C...Integral of Altarelli-Parisi z kernel for QCD.
|
|
IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN
|
|
FBR=6D0*LOG((1D0-ZC)/ZC)+MSTJ(45)*(0.5D0-ZC)
|
|
ELSEIF(MSTJ(49).EQ.0) THEN
|
|
FBR=(8D0/3D0)*LOG((1D0-ZC)/ZC)
|
|
|
|
C...Integral of Altarelli-Parisi z kernel for scalar gluon.
|
|
ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN
|
|
FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1D0-2D0*ZC)
|
|
ELSEIF(MSTJ(49).EQ.1) THEN
|
|
FBR=(1D0-2D0*ZC)/3D0
|
|
IF(IGM.EQ.0.AND.M3JC.EQ.1) FBR=4D0*FBR
|
|
|
|
C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon.
|
|
ELSEIF(KFL(1).EQ.21) THEN
|
|
FBR=6D0*MSTJ(45)*(0.5D0-ZC)
|
|
ELSE
|
|
FBR=2D0*LOG((1D0-ZC)/ZC)
|
|
ENDIF
|
|
|
|
C...Reset QCD probability for lepton.
|
|
IF(KFL(1).GE.11.AND.KFL(1).LE.18) FBR=0D0
|
|
|
|
C...Integral of Altarelli-Parisi kernel for photon emission.
|
|
IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN
|
|
FBRE=(KCHG(KFL(1),1)/3D0)**2*2D0*LOG((1D0-ZCE)/ZCE)
|
|
IF(MSTJ(41).EQ.10) FBRE=PARJ(84)*FBRE
|
|
ENDIF
|
|
|
|
C...Inner veto algorithm starts. Find maximum mass for evolution.
|
|
390 PMS=V(IEP(1),5)
|
|
IF(IGM.GE.0) THEN
|
|
PM2=0D0
|
|
DO 400 I=2,NEP
|
|
PM=P(IEP(I),5)
|
|
IF(KFL(I).LE.40) THEN
|
|
IFLI=KFL(I)
|
|
IF(KFL(I).GE.6.AND.KFL(I).LE.8) IFLI=37+KFL(I)+
|
|
& ISIGN(2,K(IEP(I),2))
|
|
IF(KSH(KFL(I)).EQ.1) PM=PMTH(2,IFLI)
|
|
ENDIF
|
|
PM2=PM2+PM
|
|
400 CONTINUE
|
|
PMS=MIN(PMS,(P(IM,5)-PM2)**2)
|
|
ENDIF
|
|
|
|
C...Select mass for daughter in QCD evolution.
|
|
B0=27D0/6D0
|
|
DO 410 IFF=4,MSTJ(45)
|
|
IF(PMS.GT.4D0*PMTH(2,IFF)**2) B0=(33D0-2D0*IFF)/6D0
|
|
410 CONTINUE
|
|
IF(FBR.LT.1D-3) THEN
|
|
PMSQCD=0D0
|
|
ELSEIF(MSTJ(44).LE.0) THEN
|
|
PMSQCD=PMS*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/(PARU(111)*FBR)))
|
|
ELSEIF(MSTJ(44).EQ.1) THEN
|
|
PMSQCD=4D0*ALAMS*(0.25D0*PMS/ALAMS)**(PYR(0)**(B0/FBR))
|
|
ELSE
|
|
PMSQCD=PMS*EXP(MAX(-50D0,ALFM*B0*LOG(PYR(0))/FBR))
|
|
ENDIF
|
|
IF(ZC.GT.0.49D0.OR.PMSQCD.LE.PMTH(4,IFL)**2) PMSQCD=PMTH(2,IFL)**2
|
|
V(IEP(1),5)=PMSQCD
|
|
MCE=1
|
|
|
|
C...Select mass for daughter in QED evolution.
|
|
IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN
|
|
PMSQED=PMS*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/(PARU(101)*FBRE)))
|
|
IF(ZCE.GT.0.49D0.OR.PMSQED.LE.PMTH(5,IFL)**2) PMSQED=
|
|
& PMTH(2,IFL)**2
|
|
IF(PMSQED.GT.PMSQCD) THEN
|
|
V(IEP(1),5)=PMSQED
|
|
MCE=2
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Check whether daughter mass below cutoff.
|
|
P(IEP(1),5)=SQRT(V(IEP(1),5))
|
|
IF(P(IEP(1),5).LE.PMTH(3,IFL)) THEN
|
|
P(IEP(1),5)=PMTH(1,IFL)
|
|
V(IEP(1),5)=P(IEP(1),5)**2
|
|
GOTO 430
|
|
ENDIF
|
|
|
|
C...Select z value of branching: q -> qgamma.
|
|
IF(MCE.EQ.2) THEN
|
|
Z=1D0-(1D0-ZCE)*(ZCE/(1D0-ZCE))**PYR(0)
|
|
IF(1D0+Z**2.LT.2D0*PYR(0)) GOTO 390
|
|
K(IEP(1),5)=22
|
|
|
|
C...Select z value of branching: q -> qg, g -> gg, g -> qqbar.
|
|
ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN
|
|
Z=1D0-(1D0-ZC)*(ZC/(1D0-ZC))**PYR(0)
|
|
IF(1D0+Z**2.LT.2D0*PYR(0)) GOTO 390
|
|
K(IEP(1),5)=21
|
|
ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*(0.5D0-ZC).LT.PYR(0)*FBR) THEN
|
|
Z=(1D0-ZC)*(ZC/(1D0-ZC))**PYR(0)
|
|
IF(PYR(0).GT.0.5D0) Z=1D0-Z
|
|
IF((1D0-Z*(1D0-Z))**2.LT.PYR(0)) GOTO 390
|
|
K(IEP(1),5)=21
|
|
ELSEIF(MSTJ(49).NE.1) THEN
|
|
Z=ZC+(1D0-2D0*ZC)*PYR(0)
|
|
IF(Z**2+(1D0-Z)**2.LT.PYR(0)) GOTO 390
|
|
KFLB=1+INT(MSTJ(45)*PYR(0))
|
|
PMQ=4D0*PMTH(2,KFLB)**2/V(IEP(1),5)
|
|
IF(PMQ.GE.1D0) GOTO 390
|
|
PMQ0=4D0*PMTH(2,21)**2/V(IEP(1),5)
|
|
IF(MOD(MSTJ(43),2).EQ.0.AND.(1D0+0.5D0*PMQ)*SQRT(1D0-PMQ).LT.
|
|
& PYR(0)*(1D0+0.5D0*PMQ0)*SQRT(1D0-PMQ0)) GOTO 390
|
|
K(IEP(1),5)=KFLB
|
|
|
|
C...Ditto for scalar gluon model.
|
|
ELSEIF(KFL(1).NE.21) THEN
|
|
Z=1D0-SQRT(ZC**2+PYR(0)*(1D0-2D0*ZC))
|
|
K(IEP(1),5)=21
|
|
ELSEIF(PYR(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN
|
|
Z=ZC+(1D0-2D0*ZC)*PYR(0)
|
|
K(IEP(1),5)=21
|
|
ELSE
|
|
Z=ZC+(1D0-2D0*ZC)*PYR(0)
|
|
KFLB=1+INT(MSTJ(45)*PYR(0))
|
|
PMQ=4D0*PMTH(2,KFLB)**2/V(IEP(1),5)
|
|
IF(PMQ.GE.1D0) GOTO 390
|
|
K(IEP(1),5)=KFLB
|
|
ENDIF
|
|
IF(MCE.EQ.1.AND.MSTJ(44).GE.2) THEN
|
|
IF(Z*(1D0-Z)*V(IEP(1),5).LT.PT2MIN) GOTO 390
|
|
IF(ALFM/LOG(V(IEP(1),5)*Z*(1D0-Z)/ALAMS).LT.PYR(0)) GOTO 390
|
|
ENDIF
|
|
|
|
C...Check if z consistent with chosen m.
|
|
IF(KFL(1).EQ.21) THEN
|
|
KFLGD1=IABS(K(IEP(1),5))
|
|
KFLGD2=KFLGD1
|
|
ELSE
|
|
KFLGD1=KFL(1)
|
|
KFLGD2=IABS(K(IEP(1),5))
|
|
ENDIF
|
|
IF(NEP.EQ.1) THEN
|
|
PED=PS(4)
|
|
ELSEIF(NEP.GE.3) THEN
|
|
PED=P(IEP(1),4)
|
|
ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
|
|
PED=0.5D0*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5)
|
|
ELSE
|
|
IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM
|
|
IF(IEP(1).EQ.N+2) PED=(1D0-V(IM,1))*PEM
|
|
ENDIF
|
|
IF(MOD(MSTJ(43),2).EQ.1) THEN
|
|
IFLGD1=KFLGD1
|
|
IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFL
|
|
PMQTH3=0.5D0*PARJ(82)
|
|
IF(KFLGD2.EQ.22) PMQTH3=0.5D0*PARJ(83)
|
|
PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(IEP(1),5)
|
|
PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(IEP(1),5)
|
|
ZD=SQRT(MAX(0D0,(1D0-V(IEP(1),5)/PED**2)*((1D0-PMQ1-PMQ2)**2-
|
|
& 4D0*PMQ1*PMQ2)))
|
|
ZH=1D0+PMQ1-PMQ2
|
|
ELSE
|
|
ZD=SQRT(MAX(0D0,1D0-V(IEP(1),5)/PED**2))
|
|
ZH=1D0
|
|
ENDIF
|
|
ZL=0.5D0*(ZH-ZD)
|
|
ZU=0.5D0*(ZH+ZD)
|
|
IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 390
|
|
IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1D0-ZL)/MAX(1D-20,ZL*
|
|
&(1D0-ZU)))
|
|
IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1D0-ZL)/MAX(1D-10,1D0-ZU))
|
|
|
|
C...Width suppression for q -> q + g.
|
|
IF(MSTJ(40).NE.0.AND.KFL(1).NE.21) THEN
|
|
IF(IGM.EQ.0) THEN
|
|
EGLU=0.5D0*PS(5)*(1D0-Z)*(1D0+V(IEP(1),5)/V(NS+1,5))
|
|
ELSE
|
|
EGLU=PMED*(1D0-Z)
|
|
ENDIF
|
|
CHI=PARJ(89)**2/(PARJ(89)**2+EGLU**2)
|
|
IF(MSTJ(40).EQ.1) THEN
|
|
IF(CHI.LT.PYR(0)) GOTO 390
|
|
ELSEIF(MSTJ(40).EQ.2) THEN
|
|
IF(1D0-CHI.LT.PYR(0)) GOTO 390
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Three-jet matrix element correction.
|
|
IF(IGM.EQ.0.AND.M3JC.EQ.1) THEN
|
|
X1=Z*(1D0+V(IEP(1),5)/V(NS+1,5))
|
|
X2=1D0-V(IEP(1),5)/V(NS+1,5)
|
|
X3=(1D0-X1)+(1D0-X2)
|
|
IF(MCE.EQ.2) THEN
|
|
KI1=K(IPA(INUM),2)
|
|
KI2=K(IPA(3-INUM),2)
|
|
QF1=KCHG(IABS(KI1),1)*ISIGN(1,KI1)/3D0
|
|
QF2=KCHG(IABS(KI2),1)*ISIGN(1,KI2)/3D0
|
|
WSHOW=QF1**2*(1D0-X1)/X3*(1D0+(X1/(2D0-X2))**2)+
|
|
& QF2**2*(1D0-X2)/X3*(1D0+(X2/(2D0-X1))**2)
|
|
WME=(QF1*(1D0-X1)/X3-QF2*(1D0-X2)/X3)**2*(X1**2+X2**2)
|
|
ELSEIF(MSTJ(49).NE.1) THEN
|
|
WSHOW=1D0+(1D0-X1)/X3*(X1/(2D0-X2))**2+
|
|
& (1D0-X2)/X3*(X2/(2D0-X1))**2
|
|
WME=X1**2+X2**2
|
|
IF(M3JCM.EQ.1) WME=WME-QME*X3-0.5D0*QME**2-
|
|
& (0.5D0*QME+0.25D0*QME**2)*((1D0-X2)/MAX(1D-7,1D0-X1)+
|
|
& (1D0-X1)/MAX(1D-7,1D0-X2))
|
|
ELSE
|
|
WSHOW=4D0*X3*((1D0-X1)/(2D0-X2)**2+(1D0-X2)/(2D0-X1)**2)
|
|
WME=X3**2
|
|
IF(MSTJ(102).GE.2) WME=X3**2-2D0*(1D0+X3)*(1D0-X1)*(1D0-X2)*
|
|
& PARJ(171)
|
|
ENDIF
|
|
IF(WME.LT.PYR(0)*WSHOW) GOTO 390
|
|
|
|
C...Impose angular ordering by rejection of nonordered emission.
|
|
ELSEIF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2) THEN
|
|
MAOM=1
|
|
ZM=V(IM,1)
|
|
IF(IEP(1).EQ.N+2) ZM=1D0-V(IM,1)
|
|
THE2ID=Z*(1D0-Z)*(ZM*P(IM,4))**2/V(IEP(1),5)
|
|
IAOM=IM
|
|
420 IF(K(IAOM,5).EQ.22) THEN
|
|
IAOM=K(IAOM,3)
|
|
IF(K(IAOM,3).LE.NS) MAOM=0
|
|
IF(MAOM.EQ.1) GOTO 420
|
|
ENDIF
|
|
IF(MAOM.EQ.1) THEN
|
|
THE2IM=V(IAOM,1)*(1D0-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5)
|
|
IF(THE2ID.LT.THE2IM) GOTO 390
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Impose user-defined maximum angle at first branching.
|
|
IF(MSTJ(48).EQ.1) THEN
|
|
IF(NEP.EQ.1.AND.IM.EQ.NS) THEN
|
|
THE2ID=Z*(1D0-Z)*PS(4)**2/V(IEP(1),5)
|
|
IF(THE2ID.LT.1D0/PARJ(85)**2) GOTO 390
|
|
ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN
|
|
THE2ID=Z*(1D0-Z)*(0.5D0*P(IM,4))**2/V(IEP(1),5)
|
|
IF(THE2ID.LT.1D0/PARJ(85)**2) GOTO 390
|
|
ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN
|
|
THE2ID=Z*(1D0-Z)*(0.5D0*P(IM,4))**2/V(IEP(1),5)
|
|
IF(THE2ID.LT.1D0/PARJ(86)**2) GOTO 390
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Impose angular constraint in first branching from interference
|
|
C...with initial state partons.
|
|
IF(MIIS.GE.2.AND.IEP(1).LE.NS+3) THEN
|
|
THE2D=MAX((1D0-Z)/Z,Z/(1D0-Z))*V(IEP(1),5)/(0.5D0*P(IM,4))**2
|
|
IF(IEP(1).EQ.NS+2.AND.ISII(1).GE.1) THEN
|
|
IF(THE2D.GT.THEIIS(1,ISII(1))**2) GOTO 390
|
|
ELSEIF(IEP(1).EQ.NS+3.AND.ISII(2).GE.1) THEN
|
|
IF(THE2D.GT.THEIIS(2,ISII(2))**2) GOTO 390
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...End of inner veto algorithm. Check if only one leg evolved so far.
|
|
430 V(IEP(1),1)=Z
|
|
ISL(1)=0
|
|
ISL(2)=0
|
|
IF(NEP.EQ.1) GOTO 460
|
|
IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 330
|
|
DO 440 I=1,NEP
|
|
IF(ITRY(I).EQ.0.AND.KFLD(I).LE.40) THEN
|
|
IF(KSH(KFLD(I)).EQ.1) THEN
|
|
IFLD=KFLD(I)
|
|
IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+
|
|
& ISIGN(2,K(N+I,2))
|
|
IF(P(N+I,5).GE.PMTH(2,IFLD)) GOTO 330
|
|
ENDIF
|
|
ENDIF
|
|
440 CONTINUE
|
|
|
|
C...Check if chosen multiplet m1,m2,z1,z2 is physical.
|
|
IF(NEP.EQ.3) THEN
|
|
PA1S=(P(N+1,4)+P(N+1,5))*(P(N+1,4)-P(N+1,5))
|
|
PA2S=(P(N+2,4)+P(N+2,5))*(P(N+2,4)-P(N+2,5))
|
|
PA3S=(P(N+3,4)+P(N+3,5))*(P(N+3,4)-P(N+3,5))
|
|
PTS=0.25D0*(2D0*PA1S*PA2S+2D0*PA1S*PA3S+2D0*PA2S*PA3S-
|
|
& PA1S**2-PA2S**2-PA3S**2)/PA1S
|
|
IF(PTS.LE.0D0) GOTO 330
|
|
ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN
|
|
DO 450 I1=N+1,N+2
|
|
KFLDA=IABS(K(I1,2))
|
|
IF(KFLDA.GT.40) GOTO 450
|
|
IF(KSH(KFLDA).EQ.0) GOTO 450
|
|
IFLDA=KFLDA
|
|
IF(KFLDA.GE.6.AND.KFLDA.LE.8) IFLDA=37+KFLDA+
|
|
& ISIGN(2,K(I1,2))
|
|
IF(P(I1,5).LT.PMTH(2,IFLDA)) GOTO 450
|
|
IF(KFLDA.EQ.21) THEN
|
|
KFLGD1=IABS(K(I1,5))
|
|
KFLGD2=KFLGD1
|
|
ELSE
|
|
KFLGD1=KFLDA
|
|
KFLGD2=IABS(K(I1,5))
|
|
ENDIF
|
|
I2=2*N+3-I1
|
|
IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
|
|
PED=0.5D0*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5)
|
|
ELSE
|
|
IF(I1.EQ.N+1) ZM=V(IM,1)
|
|
IF(I1.EQ.N+2) ZM=1D0-V(IM,1)
|
|
PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2-
|
|
& 4D0*V(N+1,5)*V(N+2,5))
|
|
PED=PEM*(0.5D0*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/V(IM,5)
|
|
ENDIF
|
|
IF(MOD(MSTJ(43),2).EQ.1) THEN
|
|
PMQTH3=0.5D0*PARJ(82)
|
|
IF(KFLGD2.EQ.22) PMQTH3=0.5D0*PARJ(83)
|
|
IFLGD1=KFLGD1
|
|
IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFLDA
|
|
PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(I1,5)
|
|
PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(I1,5)
|
|
ZD=SQRT(MAX(0D0,(1D0-V(I1,5)/PED**2)*((1D0-PMQ1-PMQ2)**2-
|
|
& 4D0*PMQ1*PMQ2)))
|
|
ZH=1D0+PMQ1-PMQ2
|
|
ELSE
|
|
ZD=SQRT(MAX(0D0,1D0-V(I1,5)/PED**2))
|
|
ZH=1D0
|
|
ENDIF
|
|
ZL=0.5D0*(ZH-ZD)
|
|
ZU=0.5D0*(ZH+ZD)
|
|
IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(1)=1
|
|
IF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(2)=1
|
|
IF(KFLDA.EQ.21) V(I1,4)=LOG(ZU*(1D0-ZL)/MAX(1D-20,
|
|
& ZL*(1D0-ZU)))
|
|
IF(KFLDA.NE.21) V(I1,4)=LOG((1D0-ZL)/MAX(1D-10,1D0-ZU))
|
|
450 CONTINUE
|
|
IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN
|
|
ISL(3-ISLM)=0
|
|
ISLM=3-ISLM
|
|
ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN
|
|
ZDR1=MAX(0D0,V(N+1,3)/MAX(1D-6,V(N+1,4))-1D0)
|
|
ZDR2=MAX(0D0,V(N+2,3)/MAX(1D-6,V(N+2,4))-1D0)
|
|
IF(ZDR2.GT.PYR(0)*(ZDR1+ZDR2)) ISL(1)=0
|
|
IF(ISL(1).EQ.1) ISL(2)=0
|
|
IF(ISL(1).EQ.0) ISLM=1
|
|
IF(ISL(2).EQ.0) ISLM=2
|
|
ENDIF
|
|
IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 330
|
|
ENDIF
|
|
IFLD1=KFLD(1)
|
|
IF(KFLD(1).GE.6.AND.KFLD(1).LE.8) IFLD1=37+KFLD(1)+
|
|
&ISIGN(2,K(N+1,2))
|
|
IFLD2=KFLD(2)
|
|
IF(KFLD(2).GE.6.AND.KFLD(2).LE.8) IFLD2=37+KFLD(2)+
|
|
&ISIGN(2,K(N+2,2))
|
|
IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE.
|
|
&PMTH(2,IFLD1).OR.P(N+2,5).GE.PMTH(2,IFLD2))) THEN
|
|
PMQ1=V(N+1,5)/V(IM,5)
|
|
PMQ2=V(N+2,5)/V(IM,5)
|
|
ZD=SQRT(MAX(0D0,(1D0-V(IM,5)/PEM**2)*((1D0-PMQ1-PMQ2)**2-
|
|
& 4D0*PMQ1*PMQ2)))
|
|
ZH=1D0+PMQ1-PMQ2
|
|
ZL=0.5D0*(ZH-ZD)
|
|
ZU=0.5D0*(ZH+ZD)
|
|
IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 330
|
|
ENDIF
|
|
|
|
C...Accepted branch. Construct four-momentum for initial partons.
|
|
460 MAZIP=0
|
|
MAZIC=0
|
|
IF(NEP.EQ.1) THEN
|
|
P(N+1,1)=0D0
|
|
P(N+1,2)=0D0
|
|
P(N+1,3)=SQRT(MAX(0D0,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)-
|
|
& P(N+1,5))))
|
|
P(N+1,4)=P(IPA(1),4)
|
|
V(N+1,2)=P(N+1,4)
|
|
ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN
|
|
PED1=0.5D0*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5)
|
|
P(N+1,1)=0D0
|
|
P(N+1,2)=0D0
|
|
P(N+1,3)=SQRT(MAX(0D0,(PED1+P(N+1,5))*(PED1-P(N+1,5))))
|
|
P(N+1,4)=PED1
|
|
P(N+2,1)=0D0
|
|
P(N+2,2)=0D0
|
|
P(N+2,3)=-P(N+1,3)
|
|
P(N+2,4)=P(IM,5)-PED1
|
|
V(N+1,2)=P(N+1,4)
|
|
V(N+2,2)=P(N+2,4)
|
|
ELSEIF(NEP.EQ.3) THEN
|
|
P(N+1,1)=0D0
|
|
P(N+1,2)=0D0
|
|
P(N+1,3)=SQRT(MAX(0D0,PA1S))
|
|
P(N+2,1)=SQRT(PTS)
|
|
P(N+2,2)=0D0
|
|
P(N+2,3)=0.5D0*(PA3S-PA2S-PA1S)/P(N+1,3)
|
|
P(N+3,1)=-P(N+2,1)
|
|
P(N+3,2)=0D0
|
|
P(N+3,3)=-(P(N+1,3)+P(N+2,3))
|
|
V(N+1,2)=P(N+1,4)
|
|
V(N+2,2)=P(N+2,4)
|
|
V(N+3,2)=P(N+3,4)
|
|
|
|
C...Construct transverse momentum for ordinary branching in shower.
|
|
ELSE
|
|
ZM=V(IM,1)
|
|
PZM=SQRT(MAX(0D0,(PEM+P(IM,5))*(PEM-P(IM,5))))
|
|
PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4D0*V(N+1,5)*V(N+2,5)
|
|
IF(PZM.LE.0D0) THEN
|
|
PTS=0D0
|
|
ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN
|
|
PTS=(PEM**2*(ZM*(1D0-ZM)*V(IM,5)-(1D0-ZM)*V(N+1,5)-
|
|
& ZM*V(N+2,5))-0.25D0*PMLS)/PZM**2
|
|
ELSE
|
|
PTS=PMLS*(ZM*(1D0-ZM)*PEM**2/V(IM,5)-0.25D0)/PZM**2
|
|
ENDIF
|
|
PT=SQRT(MAX(0D0,PTS))
|
|
|
|
C...Find coefficient of azimuthal asymmetry due to gluon polarization.
|
|
HAZIP=0D0
|
|
IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21
|
|
& .AND.IAU.NE.0) THEN
|
|
IF(K(IGM,3).NE.0) MAZIP=1
|
|
ZAU=V(IGM,1)
|
|
IF(IAU.EQ.IM+1) ZAU=1D0-V(IGM,1)
|
|
IF(MAZIP.EQ.0) ZAU=0D0
|
|
IF(K(IGM,2).NE.21) THEN
|
|
HAZIP=2D0*ZAU/(1D0+ZAU**2)
|
|
ELSE
|
|
HAZIP=(ZAU/(1D0-ZAU*(1D0-ZAU)))**2
|
|
ENDIF
|
|
IF(K(N+1,2).NE.21) THEN
|
|
HAZIP=HAZIP*(-2D0*ZM*(1D0-ZM))/(1D0-2D0*ZM*(1D0-ZM))
|
|
ELSE
|
|
HAZIP=HAZIP*(ZM*(1D0-ZM)/(1D0-ZM*(1D0-ZM)))**2
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Find coefficient of azimuthal asymmetry due to soft gluon
|
|
C...interference.
|
|
HAZIC=0D0
|
|
IF(MSTJ(49).NE.2.AND.MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR.
|
|
& K(N+2,2).EQ.21).AND.IAU.NE.0) THEN
|
|
IF(K(IGM,3).NE.0) MAZIC=N+1
|
|
IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2
|
|
IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND.
|
|
& ZM.GT.0.5D0) MAZIC=N+2
|
|
IF(K(IAU,2).EQ.22) MAZIC=0
|
|
ZS=ZM
|
|
IF(MAZIC.EQ.N+2) ZS=1D0-ZM
|
|
ZGM=V(IGM,1)
|
|
IF(IAU.EQ.IM-1) ZGM=1D0-V(IGM,1)
|
|
IF(MAZIC.EQ.0) ZGM=1D0
|
|
IF(MAZIC.NE.0) HAZIC=(P(IM,5)/P(IGM,5))*
|
|
& SQRT((1D0-ZS)*(1D0-ZGM)/(ZS*ZGM))
|
|
HAZIC=MIN(0.95D0,HAZIC)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Construct kinematics for ordinary branching in shower.
|
|
470 IF(NEP.EQ.2.AND.IGM.GT.0) THEN
|
|
IF(MOD(MSTJ(43),2).EQ.1) THEN
|
|
P(N+1,4)=PEM*V(IM,1)
|
|
ELSE
|
|
P(N+1,4)=PEM*(0.5D0*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+
|
|
& SQRT(PMLS)*ZM)/V(IM,5)
|
|
ENDIF
|
|
PHI=PARU(2)*PYR(0)
|
|
P(N+1,1)=PT*COS(PHI)
|
|
P(N+1,2)=PT*SIN(PHI)
|
|
IF(PZM.GT.0D0) THEN
|
|
P(N+1,3)=0.5D0*(V(N+2,5)-V(N+1,5)-V(IM,5)+
|
|
& 2D0*PEM*P(N+1,4))/PZM
|
|
ELSE
|
|
P(N+1,3)=0D0
|
|
ENDIF
|
|
P(N+2,1)=-P(N+1,1)
|
|
P(N+2,2)=-P(N+1,2)
|
|
P(N+2,3)=PZM-P(N+1,3)
|
|
P(N+2,4)=PEM-P(N+1,4)
|
|
IF(MSTJ(43).LE.2) THEN
|
|
V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5)
|
|
V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Rotate and boost daughters.
|
|
IF(IGM.GT.0) THEN
|
|
IF(MSTJ(43).LE.2) THEN
|
|
BEX=P(IGM,1)/P(IGM,4)
|
|
BEY=P(IGM,2)/P(IGM,4)
|
|
BEZ=P(IGM,3)/P(IGM,4)
|
|
GA=P(IGM,4)/P(IGM,5)
|
|
GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1D0+GA)-
|
|
& P(IM,4))
|
|
ELSE
|
|
BEX=0D0
|
|
BEY=0D0
|
|
BEZ=0D0
|
|
GA=1D0
|
|
GABEP=0D0
|
|
ENDIF
|
|
THE=PYANGL(P(IM,3)+GABEP*BEZ,SQRT((P(IM,1)+GABEP*BEX)**2+
|
|
& (P(IM,2)+GABEP*BEY)**2))
|
|
PHI=PYANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY)
|
|
DO 480 I=N+1,N+2
|
|
DP(1)=COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+
|
|
& SIN(THE)*COS(PHI)*P(I,3)
|
|
DP(2)=COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+
|
|
& SIN(THE)*SIN(PHI)*P(I,3)
|
|
DP(3)=-SIN(THE)*P(I,1)+COS(THE)*P(I,3)
|
|
DP(4)=P(I,4)
|
|
DBP=BEX*DP(1)+BEY*DP(2)+BEZ*DP(3)
|
|
DGABP=GA*(GA*DBP/(1D0+GA)+DP(4))
|
|
P(I,1)=DP(1)+DGABP*BEX
|
|
P(I,2)=DP(2)+DGABP*BEY
|
|
P(I,3)=DP(3)+DGABP*BEZ
|
|
P(I,4)=GA*(DP(4)+DBP)
|
|
480 CONTINUE
|
|
ENDIF
|
|
|
|
C...Weight with azimuthal distribution, if required.
|
|
IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN
|
|
DO 490 J=1,3
|
|
DPT(1,J)=P(IM,J)
|
|
DPT(2,J)=P(IAU,J)
|
|
DPT(3,J)=P(N+1,J)
|
|
490 CONTINUE
|
|
DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3)
|
|
DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3)
|
|
DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2
|
|
DO 500 J=1,3
|
|
DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/DPMM
|
|
DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/DPMM
|
|
500 CONTINUE
|
|
DPT(4,4)=SQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2)
|
|
DPT(5,4)=SQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2)
|
|
IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1D0*PARJ(82)) THEN
|
|
CAD=(DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+
|
|
& DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4))
|
|
IF(MAZIP.NE.0) THEN
|
|
IF(1D0+HAZIP*(2D0*CAD**2-1D0).LT.PYR(0)*(1D0+ABS(HAZIP)))
|
|
& GOTO 470
|
|
ENDIF
|
|
IF(MAZIC.NE.0) THEN
|
|
IF(MAZIC.EQ.N+2) CAD=-CAD
|
|
IF((1D0-HAZIC)*(1D0-HAZIC*CAD)/(1D0+HAZIC**2-2D0*HAZIC*CAD)
|
|
& .LT.PYR(0)) GOTO 470
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Azimuthal anisotropy due to interference with initial state partons.
|
|
IF(MOD(MIIS,2).EQ.1.AND.IGM.EQ.NS+1.AND.(K(N+1,2).EQ.21.OR.
|
|
&K(N+2,2).EQ.21)) THEN
|
|
III=IM-NS-1
|
|
IF(ISII(III).GE.1) THEN
|
|
IAZIID=N+1
|
|
IF(K(N+1,2).NE.21) IAZIID=N+2
|
|
IF(K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND.
|
|
& P(N+1,4).GT.P(N+2,4)) IAZIID=N+2
|
|
THEIID=PYANGL(P(IAZIID,3),SQRT(P(IAZIID,1)**2+P(IAZIID,2)**2))
|
|
IF(III.EQ.2) THEIID=PARU(1)-THEIID
|
|
PHIIID=PYANGL(P(IAZIID,1),P(IAZIID,2))
|
|
HAZII=MIN(0.95D0,THEIID/THEIIS(III,ISII(III)))
|
|
CAD=COS(PHIIID-PHIIIS(III,ISII(III)))
|
|
PHIREL=ABS(PHIIID-PHIIIS(III,ISII(III)))
|
|
IF(PHIREL.GT.PARU(1)) PHIREL=PARU(2)-PHIREL
|
|
IF((1D0-HAZII)*(1D0-HAZII*CAD)/(1D0+HAZII**2-2D0*HAZII*CAD)
|
|
& .LT.PYR(0)) GOTO 470
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Continue loop over partons that may branch, until none left.
|
|
IF(IGM.GE.0) K(IM,1)=14
|
|
N=N+NEP
|
|
NEP=2
|
|
IF(N.GT.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS')
|
|
IF(MSTU(21).GE.1) N=NS
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
GOTO 270
|
|
|
|
C...Set information on imagined shower initiator.
|
|
510 IF(NPA.GE.2) THEN
|
|
K(NS+1,1)=11
|
|
K(NS+1,2)=94
|
|
K(NS+1,3)=IP1
|
|
IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2
|
|
K(NS+1,4)=NS+2
|
|
K(NS+1,5)=NS+1+NPA
|
|
IIM=1
|
|
ELSE
|
|
IIM=0
|
|
ENDIF
|
|
|
|
C...Reconstruct string drawing information.
|
|
DO 520 I=NS+1+IIM,N
|
|
IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN
|
|
K(I,1)=1
|
|
ELSEIF(K(I,1).LE.10.AND.IABS(K(I,2)).GE.11.AND.
|
|
& IABS(K(I,2)).LE.18) THEN
|
|
K(I,1)=1
|
|
ELSEIF(K(I,1).LE.10) THEN
|
|
K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))
|
|
K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))
|
|
ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN
|
|
ID1=MOD(K(I,4),MSTU(5))
|
|
IF(K(I,2).GE.1.AND.K(I,2).LE.8) ID1=MOD(K(I,4),MSTU(5))+1
|
|
ID2=2*MOD(K(I,4),MSTU(5))+1-ID1
|
|
K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1
|
|
K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2
|
|
K(ID1,4)=K(ID1,4)+MSTU(5)*I
|
|
K(ID1,5)=K(ID1,5)+MSTU(5)*ID2
|
|
K(ID2,4)=K(ID2,4)+MSTU(5)*ID1
|
|
K(ID2,5)=K(ID2,5)+MSTU(5)*I
|
|
ELSE
|
|
ID1=MOD(K(I,4),MSTU(5))
|
|
ID2=ID1+1
|
|
K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1
|
|
K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1
|
|
IF(IABS(K(I,2)).LE.10.OR.K(ID1,1).GE.11) THEN
|
|
K(ID1,4)=K(ID1,4)+MSTU(5)*I
|
|
K(ID1,5)=K(ID1,5)+MSTU(5)*I
|
|
ELSE
|
|
K(ID1,4)=0
|
|
K(ID1,5)=0
|
|
ENDIF
|
|
K(ID2,4)=0
|
|
K(ID2,5)=0
|
|
ENDIF
|
|
520 CONTINUE
|
|
|
|
C...Transformation from CM frame.
|
|
IF(NPA.GE.2) THEN
|
|
BEX=PS(1)/PS(4)
|
|
BEY=PS(2)/PS(4)
|
|
BEZ=PS(3)/PS(4)
|
|
GA=PS(4)/PS(5)
|
|
GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3))
|
|
& /(1D0+GA)-P(IPA(1),4))
|
|
ELSE
|
|
BEX=0D0
|
|
BEY=0D0
|
|
BEZ=0D0
|
|
GABEP=0D0
|
|
ENDIF
|
|
THE=PYANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1)
|
|
&+GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2))
|
|
PHI=PYANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY)
|
|
IF(NPA.EQ.3) THEN
|
|
CHI=PYANGL(COS(THE)*COS(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(THE)*
|
|
& SIN(PHI)*(P(IPA(2),2)+GABEP*BEY)-SIN(THE)*(P(IPA(2),3)+GABEP*
|
|
& BEZ),-SIN(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(PHI)*(P(IPA(2),2)+
|
|
& GABEP*BEY))
|
|
MSTU(33)=1
|
|
CALL PYROBO(NS+1,N,0D0,CHI,0D0,0D0,0D0)
|
|
ENDIF
|
|
MSTU(33)=1
|
|
CALL PYROBO(NS+1,N,THE,PHI,BEX,BEY,BEZ)
|
|
|
|
C...Decay vertex of shower.
|
|
DO 540 I=NS+1,N
|
|
DO 530 J=1,5
|
|
V(I,J)=V(IP1,J)
|
|
530 CONTINUE
|
|
540 CONTINUE
|
|
|
|
C...Delete trivial shower, else connect initiators.
|
|
IF(N.EQ.NS+NPA+IIM) THEN
|
|
N=NS
|
|
ELSE
|
|
DO 550 IP=1,NPA
|
|
K(IPA(IP),1)=14
|
|
K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP
|
|
K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP
|
|
K(NS+IIM+IP,3)=IPA(IP)
|
|
IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1
|
|
IF(K(NS+IIM+IP,1).NE.1) THEN
|
|
K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4)
|
|
K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5)
|
|
ENDIF
|
|
550 CONTINUE
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYBOEI
|
|
C...Modifies an event so as to approximately take into account
|
|
C...Bose-Einstein effects according to a simple phenomenological
|
|
C...parametrization.
|
|
|
|
SUBROUTINE PYBOEI(NSAV)
|
|
|
|
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)
|
|
SAVE /PYJETS/,/PYDAT1/
|
|
C...Local arrays and data.
|
|
DIMENSION DPS(4),KFBE(9),NBE(0:9),BEI(100)
|
|
DATA KFBE/211,-211,111,321,-321,130,310,221,331/
|
|
|
|
C...Boost event to overall CM frame. Calculate CM energy.
|
|
IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN
|
|
DO 100 J=1,4
|
|
DPS(J)=0D0
|
|
100 CONTINUE
|
|
DO 120 I=1,N
|
|
KFA=IABS(K(I,2))
|
|
IF(K(I,1).LE.10.AND.((KFA.GT.10.AND.KFA.LE.20).OR.KFA.EQ.22)
|
|
& .AND.K(I,3).GT.0) THEN
|
|
KFMA=IABS(K(K(I,3),2))
|
|
IF(KFMA.GT.10.AND.KFMA.LE.80) K(I,1)=-K(I,1)
|
|
ENDIF
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120
|
|
DO 110 J=1,4
|
|
DPS(J)=DPS(J)+P(I,J)
|
|
110 CONTINUE
|
|
120 CONTINUE
|
|
CALL PYROBO(0,0,0D0,0D0,-DPS(1)/DPS(4),-DPS(2)/DPS(4),
|
|
&-DPS(3)/DPS(4))
|
|
PECM=0D0
|
|
DO 130 I=1,N
|
|
IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4)
|
|
130 CONTINUE
|
|
|
|
C...Reserve copy of particles by species at end of record.
|
|
NBE(0)=N+MSTU(3)
|
|
DO 160 IBE=1,MIN(9,MSTJ(52))
|
|
NBE(IBE)=NBE(IBE-1)
|
|
DO 150 I=NSAV+1,N
|
|
IF(K(I,2).NE.KFBE(IBE)) GOTO 150
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150
|
|
IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYBOEI:) no more memory left in PYJETS')
|
|
RETURN
|
|
ENDIF
|
|
NBE(IBE)=NBE(IBE)+1
|
|
K(NBE(IBE),1)=I
|
|
DO 140 J=1,3
|
|
P(NBE(IBE),J)=0D0
|
|
140 CONTINUE
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
IF(NBE(MIN(9,MSTJ(52)))-NBE(0).LE.1) GOTO 280
|
|
|
|
C...Tabulate integral for subsequent momentum shift.
|
|
DO 220 IBE=1,MIN(9,MSTJ(52))
|
|
IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 180
|
|
IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2))
|
|
& .LE.1) GOTO 180
|
|
IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5),
|
|
& NBE(7)-NBE(6)).LE.1) GOTO 180
|
|
IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 180
|
|
IF(IBE.EQ.1) PMHQ=2D0*PYMASS(211)
|
|
IF(IBE.EQ.4) PMHQ=2D0*PYMASS(321)
|
|
IF(IBE.EQ.8) PMHQ=2D0*PYMASS(221)
|
|
IF(IBE.EQ.9) PMHQ=2D0*PYMASS(331)
|
|
QDEL=0.1D0*MIN(PMHQ,PARJ(93))
|
|
IF(MSTJ(51).EQ.1) THEN
|
|
NBIN=MIN(100,NINT(9D0*PARJ(93)/QDEL))
|
|
BEEX=EXP(0.5D0*QDEL/PARJ(93))
|
|
BERT=EXP(-QDEL/PARJ(93))
|
|
ELSE
|
|
NBIN=MIN(100,NINT(3D0*PARJ(93)/QDEL))
|
|
ENDIF
|
|
DO 170 IBIN=1,NBIN
|
|
QBIN=QDEL*(IBIN-0.5D0)
|
|
BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12D0)/SQRT(QBIN**2+PMHQ**2)
|
|
IF(MSTJ(51).EQ.1) THEN
|
|
BEEX=BEEX*BERT
|
|
BEI(IBIN)=BEI(IBIN)*BEEX
|
|
ELSE
|
|
BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2)
|
|
ENDIF
|
|
IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1)
|
|
170 CONTINUE
|
|
|
|
C...Loop through particle pairs and find old relative momentum.
|
|
180 DO 210 I1M=NBE(IBE-1)+1,NBE(IBE)-1
|
|
I1=K(I1M,1)
|
|
DO 200 I2M=I1M+1,NBE(IBE)
|
|
I2=K(I2M,1)
|
|
Q2OLD=MAX(0D0,(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-
|
|
& (P(I1,2)+ P(I2,2))**2-(P(I1,3)+P(I2,3))**2-
|
|
& (P(I1,5)+P(I2,5))**2)
|
|
QOLD=SQRT(Q2OLD)
|
|
|
|
C...Calculate new relative momentum.
|
|
IF(QOLD.LT.1D-3*QDEL) THEN
|
|
GOTO 200
|
|
ELSEIF(QOLD.LE.QDEL) THEN
|
|
QMOV=QOLD/3D0
|
|
ELSEIF(QOLD.LT.(NBIN-0.1D0)*QDEL) THEN
|
|
RBIN=QOLD/QDEL
|
|
IBIN=RBIN
|
|
RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1)
|
|
QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))*
|
|
& SQRT(Q2OLD+PMHQ**2)/Q2OLD
|
|
ELSE
|
|
QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD
|
|
ENDIF
|
|
Q2NEW=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV))**(2D0/3D0)
|
|
|
|
C...Calculate and save shift to be performed on three-momenta.
|
|
HC1=(P(I1,4)+P(I2,4))**2-(Q2OLD-Q2NEW)
|
|
HC2=(Q2OLD-Q2NEW)*(P(I1,4)-P(I2,4))**2
|
|
HA=0.5D0*(1D0-SQRT(HC1*Q2NEW/(HC1*Q2OLD-HC2)))
|
|
DO 190 J=1,3
|
|
PD=HA*(P(I2,J)-P(I1,J))
|
|
P(I1M,J)=P(I1M,J)+PD
|
|
P(I2M,J)=P(I2M,J)-PD
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
|
|
C...Shift momenta and recalculate energies.
|
|
DO 240 IM=NBE(0)+1,NBE(MIN(9,MSTJ(52)))
|
|
I=K(IM,1)
|
|
DO 230 J=1,3
|
|
P(I,J)=P(I,J)+P(IM,J)
|
|
230 CONTINUE
|
|
P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
240 CONTINUE
|
|
|
|
C...Rescale all momenta for energy conservation.
|
|
PES=0D0
|
|
PQS=0D0
|
|
DO 250 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 250
|
|
PES=PES+P(I,4)
|
|
PQS=PQS+P(I,5)**2/P(I,4)
|
|
250 CONTINUE
|
|
FAC=(PECM-PQS)/(PES-PQS)
|
|
DO 270 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270
|
|
DO 260 J=1,3
|
|
P(I,J)=FAC*P(I,J)
|
|
260 CONTINUE
|
|
P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
270 CONTINUE
|
|
|
|
C...Boost back to correct reference frame.
|
|
280 CALL PYROBO(0,0,0D0,0D0,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4))
|
|
DO 290 I=1,N
|
|
IF(K(I,1).LT.0) K(I,1)=-K(I,1)
|
|
290 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYMASS
|
|
C...Gives the mass of a particle/parton.
|
|
|
|
FUNCTION PYMASS(KF)
|
|
|
|
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)
|
|
SAVE /PYDAT1/,/PYDAT2/
|
|
|
|
C...Reset variables. Compressed code. Special case for popcorn diquarks.
|
|
PYMASS=0D0
|
|
KFA=IABS(KF)
|
|
IF(KFA/10000.EQ.1.AND.MOD(KFA/10,10).EQ.0) KFA=KFA-10000
|
|
KC=PYCOMP(ISIGN(KFA,KF))
|
|
IF(KC.EQ.0) THEN
|
|
MSTJ(93)=0
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Guarantee use of constituent masses for internal checks.
|
|
IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND.
|
|
&(KFA.LE.10.OR.MOD(KFA/10,10).EQ.0)) THEN
|
|
PARF(106)=PMAS(6,1)
|
|
PARF(107)=PMAS(7,1)
|
|
PARF(108)=PMAS(8,1)
|
|
IF(KFA.LE.10) THEN
|
|
PYMASS=PARF(100+KFA)
|
|
IF(MSTJ(93).EQ.2) PYMASS=MAX(0D0,PYMASS-PARF(121))
|
|
ELSEIF(MSTJ(93).EQ.1) THEN
|
|
PYMASS=PARF(100+MOD(KFA/1000,10))+PARF(100+MOD(KFA/100,10))
|
|
ELSE
|
|
PYMASS=MAX(0D0,PMAS(KC,1)-PARF(122)-2D0*PARF(112)/3D0)
|
|
ENDIF
|
|
|
|
C...Other masses can be read directly off table.
|
|
ELSE
|
|
PYMASS=PMAS(KC,1)
|
|
ENDIF
|
|
|
|
C...Optional mass broadening according to truncated Breit-Wigner
|
|
C...(either in m or in m^2).
|
|
IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1D-4) THEN
|
|
IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN
|
|
PYMASS=PYMASS+0.5D0*PMAS(KC,2)*TAN((2D0*PYR(0)-1D0)*
|
|
& ATAN(2D0*PMAS(KC,3)/PMAS(KC,2)))
|
|
ELSE
|
|
PM0=PYMASS
|
|
PMLOW=ATAN((MAX(0D0,PM0-PMAS(KC,3))**2-PM0**2)/
|
|
& (PM0*PMAS(KC,2)))
|
|
PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2)))
|
|
PYMASS=SQRT(MAX(0D0,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+
|
|
& (PMUPP-PMLOW)*PYR(0))))
|
|
ENDIF
|
|
ENDIF
|
|
MSTJ(93)=0
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYNAME
|
|
C...Gives the particle/parton name as a character string.
|
|
|
|
SUBROUTINE PYNAME(KF,CHAU)
|
|
|
|
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/PYDAT4/CHAF(500,2)
|
|
CHARACTER CHAF*16
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYDAT4/
|
|
C...Local character variable.
|
|
CHARACTER CHAU*16
|
|
|
|
C...Read out code with distinction particle/antiparticle.
|
|
CHAU=' '
|
|
KC=PYCOMP(KF)
|
|
IF(KC.NE.0) CHAU=CHAF(KC,(3-ISIGN(1,KF))/2)
|
|
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYCHGE
|
|
C...Gives three times the charge for a particle/parton.
|
|
|
|
FUNCTION PYCHGE(KF)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
|
|
SAVE /PYDAT2/
|
|
|
|
C...Read out charge and change sign for antiparticle.
|
|
PYCHGE=0
|
|
KC=PYCOMP(KF)
|
|
IF(KC.NE.0) PYCHGE=KCHG(KC,1)*ISIGN(1,KF)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYCOMP
|
|
C...Compress the standard KF codes for use in mass and decay arrays;
|
|
C...also checks whether a given code actually is defined.
|
|
|
|
FUNCTION PYCOMP(KF)
|
|
|
|
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)
|
|
SAVE /PYDAT1/,/PYDAT2/
|
|
C...Local arrays and saved data.
|
|
DIMENSION KFORD(100:500),KCORD(101:500)
|
|
SAVE KFORD,KCORD,NFORD,KFLAST,KCLAST
|
|
|
|
C...Whenever necessary reorder codes for faster search.
|
|
IF(MSTU(20).EQ.0) THEN
|
|
NFORD=100
|
|
KFORD(100)=0
|
|
DO 120 I=101,500
|
|
KFA=KCHG(I,4)
|
|
IF(KFA.LE.100) GOTO 120
|
|
NFORD=NFORD+1
|
|
DO 100 I1=NFORD-1,0,-1
|
|
IF(KFA.GE.KFORD(I1)) GOTO 110
|
|
KFORD(I1+1)=KFORD(I1)
|
|
KCORD(I1+1)=KCORD(I1)
|
|
100 CONTINUE
|
|
110 KFORD(I1+1)=KFA
|
|
KCORD(I1+1)=I
|
|
120 CONTINUE
|
|
MSTU(20)=1
|
|
KFLAST=0
|
|
KCLAST=0
|
|
ENDIF
|
|
|
|
C...Fast action if same code as in latest call.
|
|
IF(KF.EQ.KFLAST) THEN
|
|
PYCOMP=KCLAST
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Starting values.
|
|
PYCOMP=0
|
|
KFA=IABS(KF)
|
|
|
|
C...Simple cases: direct translation.
|
|
IF(KFA.GT.KFORD(NFORD)) THEN
|
|
ELSEIF(KFA.LE.100) THEN
|
|
PYCOMP=KFA
|
|
|
|
C...Else binary search.
|
|
ELSE
|
|
IMIN=100
|
|
IMAX=NFORD+1
|
|
130 IAVG=(IMIN+IMAX)/2
|
|
IF(KFORD(IAVG).GT.KFA) THEN
|
|
IMAX=IAVG
|
|
IF(IMAX.GT.IMIN+1) GOTO 130
|
|
ELSEIF(KFORD(IAVG).LT.KFA) THEN
|
|
IMIN=IAVG
|
|
IF(IMAX.GT.IMIN+1) GOTO 130
|
|
ELSE
|
|
PYCOMP=KCORD(IAVG)
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Check if antiparticle allowed.
|
|
IF(PYCOMP.NE.0.AND.KF.LT.0) THEN
|
|
IF(KCHG(PYCOMP,3).EQ.0) PYCOMP=0
|
|
ENDIF
|
|
|
|
C...Save codes for possible future fast action.
|
|
KFLAST=KF
|
|
KCLAST=PYCOMP
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYERRM
|
|
C...Informs user of errors in program execution.
|
|
|
|
SUBROUTINE PYERRM(MERR,CHMESS)
|
|
|
|
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)
|
|
SAVE /PYJETS/,/PYDAT1/
|
|
C...Local character variable.
|
|
CHARACTER CHMESS*(*)
|
|
|
|
C...Write first few warnings, then be silent.
|
|
IF(MERR.LE.10) THEN
|
|
MSTU(27)=MSTU(27)+1
|
|
MSTU(28)=MERR
|
|
IF(MSTU(25).EQ.1.AND.MSTU(27).LE.MSTU(26)) WRITE(MSTU(11),5000)
|
|
& MERR,MSTU(31),CHMESS
|
|
|
|
C...Write first few errors, then be silent or stop program.
|
|
ELSEIF(MERR.LE.20) THEN
|
|
MSTU(23)=MSTU(23)+1
|
|
MSTU(24)=MERR-10
|
|
IF(MSTU(21).GE.1.AND.MSTU(23).LE.MSTU(22)) WRITE(MSTU(11),5100)
|
|
& MERR-10,MSTU(31),CHMESS
|
|
IF(MSTU(21).GE.2.AND.MSTU(23).GT.MSTU(22)) THEN
|
|
WRITE(MSTU(11),5100) MERR-10,MSTU(31),CHMESS
|
|
WRITE(MSTU(11),5100) MERR-10,MSTU(31),CHMESS
|
|
WRITE(MSTU(11),5100) MERR-10,MSTU(31),CHMESS
|
|
WRITE(MSTU(11),5200)
|
|
IF(MERR.NE.17) CALL PYLIST(2)
|
|
IF(MERR.NE.17) CALL PYLIST(2)
|
|
IF(MERR.NE.17) CALL PYLIST(2)
|
|
WRITE(6,*)' J.R. programme continuing without stop'
|
|
C STOP
|
|
ENDIF
|
|
|
|
C...Stop program in case of irreparable error.
|
|
ELSE
|
|
WRITE(MSTU(11),5300) MERR-20,MSTU(31),CHMESS
|
|
STOP
|
|
ENDIF
|
|
|
|
C...Formats for output.
|
|
5000 FORMAT(/5X,'Advisory warning type',I2,' given after',I9,
|
|
&' PYEXEC calls:'/5X,A)
|
|
5100 FORMAT(/5X,'Error type',I2,' has occured after',I9,
|
|
&' PYEXEC calls:'/5X,A)
|
|
5200 FORMAT(5X,'Execution will be stopped after listing of last ',
|
|
&'event!')
|
|
5300 FORMAT(/5X,'Fatal error type',I2,' has occured after',I9,
|
|
&' PYEXEC calls:'/5X,A/5X,'Execution will now be stopped!')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYALEM
|
|
C...Calculates the running alpha_electromagnetic.
|
|
|
|
FUNCTION PYALEM(Q2)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
|
|
C...Calculate real part of photon vacuum polarization.
|
|
C...For leptons simplify by using asymptotic (Q^2 >> m^2) expressions.
|
|
C...For hadrons use parametrization of H. Burkhardt et al.
|
|
C...See R. Kleiss et al, CERN 89-08, vol. 3, pp. 129-131.
|
|
AEMPI=PARU(101)/(3D0*PARU(1))
|
|
IF(MSTU(101).LE.0.OR.Q2.LT.2D-6) THEN
|
|
RPIGG=0D0
|
|
ELSEIF(MSTU(101).EQ.2.AND.Q2.LT.PARU(104)) THEN
|
|
RPIGG=0D0
|
|
ELSEIF(MSTU(101).EQ.2) THEN
|
|
RPIGG=1D0-PARU(101)/PARU(103)
|
|
ELSEIF(Q2.LT.0.09D0) THEN
|
|
RPIGG=AEMPI*(13.4916D0+LOG(Q2))+0.00835D0*LOG(1D0+Q2)
|
|
ELSEIF(Q2.LT.9D0) THEN
|
|
RPIGG=AEMPI*(16.3200D0+2D0*LOG(Q2))+
|
|
& 0.00238D0*LOG(1D0+3.927D0*Q2)
|
|
ELSEIF(Q2.LT.1D4) THEN
|
|
RPIGG=AEMPI*(13.4955D0+3D0*LOG(Q2))+0.00165D0+
|
|
& 0.00299D0*LOG(1D0+Q2)
|
|
ELSE
|
|
RPIGG=AEMPI*(13.4955D0+3D0*LOG(Q2))+0.00221D0+
|
|
& 0.00293D0*LOG(1D0+Q2)
|
|
ENDIF
|
|
|
|
C...Calculate running alpha_em.
|
|
PYALEM=PARU(101)/(1D0-RPIGG)
|
|
PARU(108)=PYALEM
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYALPS
|
|
C...Gives the value of alpha_strong.
|
|
|
|
FUNCTION PYALPS(Q2)
|
|
|
|
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)
|
|
SAVE /PYDAT1/,/PYDAT2/
|
|
|
|
C...Constant alpha_strong trivial.
|
|
IF(MSTU(111).LE.0) THEN
|
|
PYALPS=PARU(111)
|
|
MSTU(118)=MSTU(112)
|
|
PARU(117)=0D0
|
|
PARU(118)=PARU(111)
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Find effective Q2, number of flavours and Lambda.
|
|
Q2EFF=Q2
|
|
IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114))
|
|
NF=MSTU(112)
|
|
ALAM2=PARU(112)**2
|
|
100 IF(NF.GT.MAX(2,MSTU(113))) THEN
|
|
Q2THR=PARU(113)*PMAS(NF,1)**2
|
|
IF(Q2EFF.LT.Q2THR) THEN
|
|
NF=NF-1
|
|
ALAM2=ALAM2*(Q2THR/ALAM2)**(2D0/(33D0-2D0*NF))
|
|
GOTO 100
|
|
ENDIF
|
|
ENDIF
|
|
110 IF(NF.LT.MIN(8,MSTU(114))) THEN
|
|
Q2THR=PARU(113)*PMAS(NF+1,1)**2
|
|
IF(Q2EFF.GT.Q2THR) THEN
|
|
NF=NF+1
|
|
ALAM2=ALAM2*(ALAM2/Q2THR)**(2D0/(33D0-2D0*NF))
|
|
GOTO 110
|
|
ENDIF
|
|
ENDIF
|
|
IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2
|
|
PARU(117)=SQRT(ALAM2)
|
|
|
|
C...Evaluate first or second order alpha_strong.
|
|
B0=(33D0-2D0*NF)/6D0
|
|
ALGQ=LOG(MAX(1.0001D0,Q2EFF/ALAM2))
|
|
IF(MSTU(111).EQ.1) THEN
|
|
PYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ))
|
|
ELSE
|
|
B1=(153D0-19D0*NF)/6D0
|
|
PYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1D0-B1*LOG(ALGQ)/
|
|
& (B0**2*ALGQ)))
|
|
ENDIF
|
|
MSTU(118)=NF
|
|
PARU(118)=PYALPS
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYANGL
|
|
C...Reconstructs an angle from given x and y coordinates.
|
|
|
|
FUNCTION PYANGL(X,Y)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
|
|
PYANGL=0D0
|
|
R=SQRT(X**2+Y**2)
|
|
IF(R.LT.1D-20) RETURN
|
|
IF(ABS(X)/R.LT.0.8D0) THEN
|
|
PYANGL=SIGN(ACOS(X/R),Y)
|
|
ELSE
|
|
PYANGL=ASIN(Y/R)
|
|
IF(X.LT.0D0.AND.PYANGL.GE.0D0) THEN
|
|
PYANGL=PARU(1)-PYANGL
|
|
ELSEIF(X.LT.0D0) THEN
|
|
PYANGL=-PARU(1)-PYANGL
|
|
ENDIF
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYR
|
|
C...Generates random numbers uniformly distributed between
|
|
C...0 and 1, excluding the endpoints.
|
|
|
|
FUNCTION PYR(IDUMMY)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYDATR/MRPY(6),RRPY(100)
|
|
SAVE /PYDATR/
|
|
C...Equivalence between commonblock and local variables.
|
|
EQUIVALENCE (MRPY1,MRPY(1)),(MRPY2,MRPY(2)),(MRPY3,MRPY(3)),
|
|
&(MRPY4,MRPY(4)),(MRPY5,MRPY(5)),(MRPY6,MRPY(6)),
|
|
&(RRPY98,RRPY(98)),(RRPY99,RRPY(99)),(RRPY00,RRPY(100))
|
|
|
|
C...Initialize generation from given seed.
|
|
IF(MRPY2.EQ.0) THEN
|
|
IJ=MOD(MRPY1/30082,31329)
|
|
KL=MOD(MRPY1,30082)
|
|
I=MOD(IJ/177,177)+2
|
|
J=MOD(IJ,177)+2
|
|
K=MOD(KL/169,178)+1
|
|
L=MOD(KL,169)
|
|
DO 110 II=1,97
|
|
S=0D0
|
|
T=0.5D0
|
|
DO 100 JJ=1,48
|
|
M=MOD(MOD(I*J,179)*K,179)
|
|
I=J
|
|
J=K
|
|
K=M
|
|
L=MOD(53*L+1,169)
|
|
IF(MOD(L*M,64).GE.32) S=S+T
|
|
T=0.5D0*T
|
|
100 CONTINUE
|
|
RRPY(II)=S
|
|
110 CONTINUE
|
|
TWOM24=1D0
|
|
DO 120 I24=1,24
|
|
TWOM24=0.5D0*TWOM24
|
|
120 CONTINUE
|
|
RRPY98=362436D0*TWOM24
|
|
RRPY99=7654321D0*TWOM24
|
|
RRPY00=16777213D0*TWOM24
|
|
MRPY2=1
|
|
MRPY3=0
|
|
MRPY4=97
|
|
MRPY5=33
|
|
ENDIF
|
|
|
|
C...Generate next random number.
|
|
130 RUNI=RRPY(MRPY4)-RRPY(MRPY5)
|
|
IF(RUNI.LT.0D0) RUNI=RUNI+1D0
|
|
RRPY(MRPY4)=RUNI
|
|
MRPY4=MRPY4-1
|
|
IF(MRPY4.EQ.0) MRPY4=97
|
|
MRPY5=MRPY5-1
|
|
IF(MRPY5.EQ.0) MRPY5=97
|
|
RRPY98=RRPY98-RRPY99
|
|
IF(RRPY98.LT.0D0) RRPY98=RRPY98+RRPY00
|
|
RUNI=RUNI-RRPY98
|
|
IF(RUNI.LT.0D0) RUNI=RUNI+1D0
|
|
IF(RUNI.LE.0D0.OR.RUNI.GE.1D0) GOTO 130
|
|
|
|
C...Update counters. Random number to output.
|
|
MRPY3=MRPY3+1
|
|
IF(MRPY3.EQ.1000000000) THEN
|
|
MRPY2=MRPY2+1
|
|
MRPY3=0
|
|
ENDIF
|
|
PYR=RUNI
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYRGET
|
|
C...Dumps the state of the random number generator on a file
|
|
C...for subsequent startup from this state onwards.
|
|
|
|
SUBROUTINE PYRGET(LFN,MOVE)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYDATR/MRPY(6),RRPY(100)
|
|
SAVE /PYDATR/
|
|
C...Local character variable.
|
|
CHARACTER CHERR*8
|
|
|
|
C...Backspace required number of records (or as many as there are).
|
|
IF(MOVE.LT.0) THEN
|
|
NBCK=MIN(MRPY(6),-MOVE)
|
|
DO 100 IBCK=1,NBCK
|
|
BACKSPACE(LFN,ERR=110,IOSTAT=IERR)
|
|
100 CONTINUE
|
|
MRPY(6)=MRPY(6)-NBCK
|
|
ENDIF
|
|
|
|
C...Unformatted write on unit LFN.
|
|
WRITE(LFN,ERR=110,IOSTAT=IERR) (MRPY(I1),I1=1,5),
|
|
&(RRPY(I2),I2=1,100)
|
|
MRPY(6)=MRPY(6)+1
|
|
RETURN
|
|
|
|
C...Write error.
|
|
110 WRITE(CHERR,'(I8)') IERR
|
|
CALL PYERRM(18,'(PYRGET:) error when accessing file, IOSTAT ='//
|
|
&CHERR)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYRSET
|
|
C...Reads a state of the random number generator from a file
|
|
C...for subsequent generation from this state onwards.
|
|
|
|
SUBROUTINE PYRSET(LFN,MOVE)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Commonblocks.
|
|
COMMON/PYDATR/MRPY(6),RRPY(100)
|
|
SAVE /PYDATR/
|
|
C...Local character variable.
|
|
CHARACTER CHERR*8
|
|
|
|
C...Backspace required number of records (or as many as there are).
|
|
IF(MOVE.LT.0) THEN
|
|
NBCK=MIN(MRPY(6),-MOVE)
|
|
DO 100 IBCK=1,NBCK
|
|
BACKSPACE(LFN,ERR=120,IOSTAT=IERR)
|
|
100 CONTINUE
|
|
MRPY(6)=MRPY(6)-NBCK
|
|
ENDIF
|
|
|
|
C...Unformatted read from unit LFN.
|
|
NFOR=1+MAX(0,MOVE)
|
|
DO 110 IFOR=1,NFOR
|
|
READ(LFN,ERR=120,IOSTAT=IERR) (MRPY(I1),I1=1,5),
|
|
& (RRPY(I2),I2=1,100)
|
|
110 CONTINUE
|
|
MRPY(6)=MRPY(6)+NFOR
|
|
RETURN
|
|
|
|
C...Write error.
|
|
120 WRITE(CHERR,'(I8)') IERR
|
|
CALL PYERRM(18,'(PYRSET:) error when accessing file, IOSTAT ='//
|
|
&CHERR)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYROBO
|
|
C...Performs rotations and boosts.
|
|
|
|
SUBROUTINE PYROBO(IMI,IMA,THE,PHI,BEX,BEY,BEZ)
|
|
|
|
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)
|
|
SAVE /PYJETS/,/PYDAT1/
|
|
C...Local arrays.
|
|
DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4)
|
|
|
|
C...Find and check range of rotation/boost.
|
|
IMIN=IMI
|
|
IF(IMIN.LE.0) IMIN=1
|
|
IF(MSTU(1).GT.0) IMIN=MSTU(1)
|
|
IMAX=IMA
|
|
IF(IMAX.LE.0) IMAX=N
|
|
IF(MSTU(2).GT.0) IMAX=MSTU(2)
|
|
IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN
|
|
CALL PYERRM(11,'(PYROBO:) range outside PYJETS memory')
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Optional resetting of V (when not set before.)
|
|
IF(MSTU(33).NE.0) THEN
|
|
DO 110 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4))
|
|
DO 100 J=1,5
|
|
V(I,J)=0D0
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
MSTU(33)=0
|
|
ENDIF
|
|
|
|
C...Rotate, typically from z axis to direction (theta,phi).
|
|
IF(THE**2+PHI**2.GT.1D-20) THEN
|
|
ROT(1,1)=COS(THE)*COS(PHI)
|
|
ROT(1,2)=-SIN(PHI)
|
|
ROT(1,3)=SIN(THE)*COS(PHI)
|
|
ROT(2,1)=COS(THE)*SIN(PHI)
|
|
ROT(2,2)=COS(PHI)
|
|
ROT(2,3)=SIN(THE)*SIN(PHI)
|
|
ROT(3,1)=-SIN(THE)
|
|
ROT(3,2)=0D0
|
|
ROT(3,3)=COS(THE)
|
|
DO 140 I=IMIN,IMAX
|
|
IF(K(I,1).LE.0) GOTO 140
|
|
DO 120 J=1,3
|
|
PR(J)=P(I,J)
|
|
VR(J)=V(I,J)
|
|
120 CONTINUE
|
|
DO 130 J=1,3
|
|
P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3)
|
|
V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3)
|
|
130 CONTINUE
|
|
140 CONTINUE
|
|
ENDIF
|
|
|
|
C...Boost, typically from rest to momentum/energy=beta.
|
|
IF(BEX**2+BEY**2+BEZ**2.GT.1D-20) THEN
|
|
DBX=BEX
|
|
DBY=BEY
|
|
DBZ=BEZ
|
|
DB=SQRT(DBX**2+DBY**2+DBZ**2)
|
|
EPS1=1D0-1D-12
|
|
IF(DB.GT.EPS1) THEN
|
|
C...Rescale boost vector if too close to unity.
|
|
CALL PYERRM(3,'(PYROBO:) boost vector too large')
|
|
DBX=DBX*(EPS1/DB)
|
|
DBY=DBY*(EPS1/DB)
|
|
DBZ=DBZ*(EPS1/DB)
|
|
DB=EPS1
|
|
ENDIF
|
|
DGA=1D0/SQRT(1D0-DB**2)
|
|
DO 160 I=IMIN,IMAX
|
|
IF(K(I,1).LE.0) GOTO 160
|
|
DO 150 J=1,4
|
|
DP(J)=P(I,J)
|
|
DV(J)=V(I,J)
|
|
150 CONTINUE
|
|
DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3)
|
|
DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4))
|
|
P(I,1)=DP(1)+DGABP*DBX
|
|
P(I,2)=DP(2)+DGABP*DBY
|
|
P(I,3)=DP(3)+DGABP*DBZ
|
|
P(I,4)=DGA*(DP(4)+DBP)
|
|
DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3)
|
|
DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4))
|
|
V(I,1)=DV(1)+DGABV*DBX
|
|
V(I,2)=DV(2)+DGABV*DBY
|
|
V(I,3)=DV(3)+DGABV*DBZ
|
|
V(I,4)=DGA*(DV(4)+DBV)
|
|
160 CONTINUE
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYEDIT
|
|
C...Performs global manipulations on the event record, in particular
|
|
C...to exclude unstable or undetectable partons/particles.
|
|
|
|
SUBROUTINE PYEDIT(MEDIT)
|
|
|
|
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...Local arrays.
|
|
DIMENSION NS(2),PTS(2),PLS(2)
|
|
|
|
C...Remove unwanted partons/particles.
|
|
IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN
|
|
IMAX=N
|
|
IF(MSTU(2).GT.0) IMAX=MSTU(2)
|
|
I1=MAX(1,MSTU(1))-1
|
|
DO 110 I=MAX(1,MSTU(1)),IMAX
|
|
IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110
|
|
IF(MEDIT.EQ.1) THEN
|
|
IF(K(I,1).GT.10) GOTO 110
|
|
ELSEIF(MEDIT.EQ.2) THEN
|
|
IF(K(I,1).GT.10) GOTO 110
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18)
|
|
& GOTO 110
|
|
ELSEIF(MEDIT.EQ.3) THEN
|
|
IF(K(I,1).GT.10) GOTO 110
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0) GOTO 110
|
|
IF(KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) GOTO 110
|
|
ELSEIF(MEDIT.EQ.5) THEN
|
|
IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0) GOTO 110
|
|
IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110
|
|
ENDIF
|
|
|
|
C...Pack remaining partons/particles. Origin no longer known.
|
|
I1=I1+1
|
|
DO 100 J=1,5
|
|
K(I1,J)=K(I,J)
|
|
P(I1,J)=P(I,J)
|
|
V(I1,J)=V(I,J)
|
|
100 CONTINUE
|
|
K(I1,3)=0
|
|
110 CONTINUE
|
|
IF(I1.LT.N) MSTU(3)=0
|
|
IF(I1.LT.N) MSTU(70)=0
|
|
N=I1
|
|
|
|
C...Selective removal of class of entries. New position of retained.
|
|
ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN
|
|
I1=0
|
|
DO 120 I=1,N
|
|
K(I,3)=MOD(K(I,3),MSTU(5))
|
|
IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120
|
|
IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120
|
|
IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR.
|
|
& K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120
|
|
IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.
|
|
& K(I,2).EQ.94)) GOTO 120
|
|
IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120
|
|
I1=I1+1
|
|
K(I,3)=K(I,3)+MSTU(5)*I1
|
|
120 CONTINUE
|
|
|
|
C...Find new event history information and replace old.
|
|
DO 140 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0)
|
|
& GOTO 140
|
|
ID=I
|
|
130 IM=MOD(K(ID,3),MSTU(5))
|
|
IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN
|
|
IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND.
|
|
& K(IM,2).NE.94) THEN
|
|
ID=IM
|
|
GOTO 130
|
|
ENDIF
|
|
ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN
|
|
IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN
|
|
ID=IM
|
|
GOTO 130
|
|
ENDIF
|
|
ENDIF
|
|
K(I,3)=MSTU(5)*(K(I,3)/MSTU(5))
|
|
IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5)
|
|
IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
|
|
IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)=
|
|
& K(K(I,4),3)/MSTU(5)
|
|
IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)=
|
|
& K(K(I,5),3)/MSTU(5)
|
|
ELSE
|
|
KCM=MOD(K(I,4)/MSTU(5),MSTU(5))
|
|
IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
|
|
KCD=MOD(K(I,4),MSTU(5))
|
|
IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
|
|
K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD
|
|
KCM=MOD(K(I,5)/MSTU(5),MSTU(5))
|
|
IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
|
|
KCD=MOD(K(I,5),MSTU(5))
|
|
IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
|
|
K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD
|
|
ENDIF
|
|
140 CONTINUE
|
|
|
|
C...Pack remaining entries.
|
|
I1=0
|
|
MSTU90=MSTU(90)
|
|
MSTU(90)=0
|
|
DO 170 I=1,N
|
|
IF(K(I,3)/MSTU(5).EQ.0) GOTO 170
|
|
I1=I1+1
|
|
DO 150 J=1,5
|
|
K(I1,J)=K(I,J)
|
|
P(I1,J)=P(I,J)
|
|
V(I1,J)=V(I,J)
|
|
150 CONTINUE
|
|
K(I1,3)=MOD(K(I1,3),MSTU(5))
|
|
DO 160 IZ=1,MSTU90
|
|
IF(I.EQ.MSTU(90+IZ)) THEN
|
|
MSTU(90)=MSTU(90)+1
|
|
MSTU(90+MSTU(90))=I1
|
|
PARU(90+MSTU(90))=PARU(90+IZ)
|
|
ENDIF
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
IF(I1.LT.N) MSTU(3)=0
|
|
IF(I1.LT.N) MSTU(70)=0
|
|
N=I1
|
|
|
|
C...Fill in some missing daughter pointers (lost in colour flow).
|
|
ELSEIF(MEDIT.EQ.16) THEN
|
|
DO 220 I=1,N
|
|
IF(K(I,1).LE.10.OR.K(I,1).GT.20) GOTO 220
|
|
IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 220
|
|
C...Find daughters who point to mother.
|
|
DO 180 I1=I+1,N
|
|
IF(K(I1,3).NE.I) THEN
|
|
ELSEIF(K(I,4).EQ.0) THEN
|
|
K(I,4)=I1
|
|
ELSE
|
|
K(I,5)=I1
|
|
ENDIF
|
|
180 CONTINUE
|
|
IF(K(I,5).EQ.0) K(I,5)=K(I,4)
|
|
IF(K(I,4).NE.0) GOTO 220
|
|
C...Find daughters who point to documentation version of mother.
|
|
IM=K(I,3)
|
|
IF(IM.LE.0.OR.IM.GE.I) GOTO 220
|
|
IF(K(IM,1).LE.20.OR.K(IM,1).GT.30) GOTO 220
|
|
IF(K(IM,2).NE.K(I,2).OR.ABS(P(IM,5)-P(I,5)).GT.1D-2) GOTO 220
|
|
DO 190 I1=I+1,N
|
|
IF(K(I1,3).NE.IM) THEN
|
|
ELSEIF(K(I,4).EQ.0) THEN
|
|
K(I,4)=I1
|
|
ELSE
|
|
K(I,5)=I1
|
|
ENDIF
|
|
190 CONTINUE
|
|
IF(K(I,5).EQ.0) K(I,5)=K(I,4)
|
|
IF(K(I,4).NE.0) GOTO 220
|
|
C...Find daughters who point to documentation daughters who,
|
|
C...in their turn, point to documentation mother.
|
|
ID1=IM
|
|
ID2=IM
|
|
DO 200 I1=IM+1,I-1
|
|
IF(K(I1,3).EQ.IM.AND.K(I1,1).GT.20.AND.K(I1,1).LE.30) THEN
|
|
ID2=I1
|
|
IF(ID1.EQ.IM) ID1=I1
|
|
ENDIF
|
|
200 CONTINUE
|
|
DO 210 I1=I+1,N
|
|
IF(K(I1,3).NE.ID1.AND.K(I1,3).NE.ID2) THEN
|
|
ELSEIF(K(I,4).EQ.0) THEN
|
|
K(I,4)=I1
|
|
ELSE
|
|
K(I,5)=I1
|
|
ENDIF
|
|
210 CONTINUE
|
|
IF(K(I,5).EQ.0) K(I,5)=K(I,4)
|
|
220 CONTINUE
|
|
|
|
C...Save top entries at bottom of PYJETS commonblock.
|
|
ELSEIF(MEDIT.EQ.21) THEN
|
|
IF(2*N.GE.MSTU(4)) THEN
|
|
CALL PYERRM(11,'(PYEDIT:) no more memory left in PYJETS')
|
|
RETURN
|
|
ENDIF
|
|
DO 240 I=1,N
|
|
DO 230 J=1,5
|
|
K(MSTU(4)-I,J)=K(I,J)
|
|
P(MSTU(4)-I,J)=P(I,J)
|
|
V(MSTU(4)-I,J)=V(I,J)
|
|
230 CONTINUE
|
|
240 CONTINUE
|
|
MSTU(32)=N
|
|
|
|
C...Restore bottom entries of commonblock PYJETS to top.
|
|
ELSEIF(MEDIT.EQ.22) THEN
|
|
DO 260 I=1,MSTU(32)
|
|
DO 250 J=1,5
|
|
K(I,J)=K(MSTU(4)-I,J)
|
|
P(I,J)=P(MSTU(4)-I,J)
|
|
V(I,J)=V(MSTU(4)-I,J)
|
|
250 CONTINUE
|
|
260 CONTINUE
|
|
N=MSTU(32)
|
|
|
|
C...Mark primary entries at top of commonblock PYJETS as untreated.
|
|
ELSEIF(MEDIT.EQ.23) THEN
|
|
I1=0
|
|
DO 270 I=1,N
|
|
KH=K(I,3)
|
|
IF(KH.GE.1) THEN
|
|
IF(K(KH,1).GT.20) KH=0
|
|
ENDIF
|
|
IF(KH.NE.0) GOTO 280
|
|
I1=I1+1
|
|
IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10
|
|
270 CONTINUE
|
|
280 N=I1
|
|
|
|
C...Place largest axis along z axis and second largest in xy plane.
|
|
ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN
|
|
CALL PYROBO(1,N+MSTU(3),0D0,-PYANGL(P(MSTU(61),1),
|
|
& P(MSTU(61),2)),0D0,0D0,0D0)
|
|
CALL PYROBO(1,N+MSTU(3),-PYANGL(P(MSTU(61),3),
|
|
& P(MSTU(61),1)),0D0,0D0,0D0,0D0)
|
|
CALL PYROBO(1,N+MSTU(3),0D0,-PYANGL(P(MSTU(61)+1,1),
|
|
& P(MSTU(61)+1,2)),0D0,0D0,0D0)
|
|
IF(MEDIT.EQ.31) RETURN
|
|
|
|
C...Rotate to put slim jet along +z axis.
|
|
DO 290 IS=1,2
|
|
NS(IS)=0
|
|
PTS(IS)=0D0
|
|
PLS(IS)=0D0
|
|
290 CONTINUE
|
|
DO 300 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 300
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 300
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2))
|
|
& .EQ.0) GOTO 300
|
|
ENDIF
|
|
IS=2D0-SIGN(0.5D0,P(I,3))
|
|
NS(IS)=NS(IS)+1
|
|
PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2)
|
|
300 CONTINUE
|
|
IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2)
|
|
& CALL PYROBO(1,N+MSTU(3),PARU(1),0D0,0D0,0D0,0D0)
|
|
|
|
C...Rotate to put second largest jet into -z,+x quadrant.
|
|
DO 310 I=1,N
|
|
IF(P(I,3).GE.0D0) GOTO 310
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 310
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 310
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2))
|
|
& .EQ.0) GOTO 310
|
|
ENDIF
|
|
IS=2D0-SIGN(0.5D0,P(I,1))
|
|
PLS(IS)=PLS(IS)-P(I,3)
|
|
310 CONTINUE
|
|
IF(PLS(2).GT.PLS(1)) CALL PYROBO(1,N+MSTU(3),0D0,PARU(1),
|
|
& 0D0,0D0,0D0)
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYLIST
|
|
C...Gives program heading, or lists an event, or particle
|
|
C...data, or current parameter values.
|
|
|
|
SUBROUTINE PYLIST(MLIST)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter statement to help give large particle numbers.
|
|
PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KEXCIT=4000000)
|
|
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)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/
|
|
C...Local arrays, character variables and data.
|
|
CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHDL(7)*4
|
|
DIMENSION PS(6)
|
|
DATA CHDL/'(())',' ','()','!!','<>','==','(==)'/
|
|
|
|
C...Initialization printout: version number and date of last change.
|
|
IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN
|
|
CALL PYLOGO
|
|
MSTU(12)=0
|
|
IF(MLIST.EQ.0) RETURN
|
|
ENDIF
|
|
|
|
C...List event data, including additional lines after N.
|
|
IF(MLIST.GE.1.AND.MLIST.LE.3) THEN
|
|
IF(MLIST.EQ.1) WRITE(MSTU(11),5100)
|
|
IF(MLIST.EQ.2) WRITE(MSTU(11),5200)
|
|
IF(MLIST.EQ.3) WRITE(MSTU(11),5300)
|
|
LMX=12
|
|
IF(MLIST.GE.2) LMX=16
|
|
ISTR=0
|
|
IMAX=N
|
|
IF(MSTU(2).GT.0) IMAX=MSTU(2)
|
|
DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3)))
|
|
IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120
|
|
|
|
C...Get particle name, pad it and check it is not too long.
|
|
CALL PYNAME(K(I,2),CHAP)
|
|
LEN=0
|
|
DO 100 LEM=1,16
|
|
IF(CHAP(LEM:LEM).NE.' ') LEN=LEM
|
|
100 CONTINUE
|
|
MDL=(K(I,1)+19)/10
|
|
LDL=0
|
|
IF(MDL.EQ.2.OR.MDL.GE.8) THEN
|
|
CHAC=CHAP
|
|
IF(LEN.GT.LMX) CHAC(LMX:LMX)='?'
|
|
ELSE
|
|
LDL=1
|
|
IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2
|
|
IF(LEN.EQ.0) THEN
|
|
CHAC=CHDL(MDL)(1:2*LDL)//' '
|
|
ELSE
|
|
CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))//
|
|
& CHDL(MDL)(LDL+1:2*LDL)//' '
|
|
IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?'
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Add information on string connection.
|
|
IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12)
|
|
& THEN
|
|
KC=PYCOMP(K(I,2))
|
|
KCC=0
|
|
IF(KC.NE.0) KCC=KCHG(KC,2)
|
|
IF(IABS(K(I,2)).EQ.39) THEN
|
|
IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X'
|
|
ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN
|
|
ISTR=1
|
|
IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A'
|
|
ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN
|
|
IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I'
|
|
ELSEIF(KCC.NE.0) THEN
|
|
ISTR=0
|
|
IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V'
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Write data for particle/jet.
|
|
IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999D0) THEN
|
|
WRITE(MSTU(11),5400) I,CHAC(1:12),(K(I,J1),J1=1,3),
|
|
& (P(I,J2),J2=1,5)
|
|
ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999D0) THEN
|
|
WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3),
|
|
& (P(I,J2),J2=1,5)
|
|
ELSEIF(MLIST.EQ.1) THEN
|
|
WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3),
|
|
& (P(I,J2),J2=1,5)
|
|
ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.
|
|
& K(I,1).EQ.14)) THEN
|
|
WRITE(MSTU(11),5700) I,CHAC,(K(I,J1),J1=1,3),
|
|
& K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000),
|
|
& K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000),
|
|
& (P(I,J2),J2=1,5)
|
|
ELSE
|
|
WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,5),
|
|
& (P(I,J2),J2=1,5)
|
|
ENDIF
|
|
IF(MLIST.EQ.3) WRITE(MSTU(11),5900) (V(I,J),J=1,5)
|
|
|
|
C...Insert extra separator lines specified by user.
|
|
IF(MSTU(70).GE.1) THEN
|
|
ISEP=0
|
|
DO 110 J=1,MIN(10,MSTU(70))
|
|
IF(I.EQ.MSTU(70+J)) ISEP=1
|
|
110 CONTINUE
|
|
IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),6000)
|
|
IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),6100)
|
|
ENDIF
|
|
120 CONTINUE
|
|
|
|
C...Sum of charges and momenta.
|
|
DO 130 J=1,6
|
|
PS(J)=PYP(0,J)
|
|
130 CONTINUE
|
|
IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999D0) THEN
|
|
WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5)
|
|
ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999D0) THEN
|
|
WRITE(MSTU(11),6300) PS(6),(PS(J),J=1,5)
|
|
ELSEIF(MLIST.EQ.1) THEN
|
|
WRITE(MSTU(11),6400) PS(6),(PS(J),J=1,5)
|
|
ELSE
|
|
WRITE(MSTU(11),6500) PS(6),(PS(J),J=1,5)
|
|
ENDIF
|
|
|
|
C...Give simple list of KF codes defined in program.
|
|
ELSEIF(MLIST.EQ.11) THEN
|
|
WRITE(MSTU(11),6600)
|
|
DO 140 KF=1,80
|
|
CALL PYNAME(KF,CHAP)
|
|
CALL PYNAME(-KF,CHAN)
|
|
IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP
|
|
IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
|
|
140 CONTINUE
|
|
DO 170 KFLS=1,3,2
|
|
DO 160 KFLA=1,5
|
|
DO 150 KFLB=1,KFLA-(3-KFLS)/2
|
|
KF=1000*KFLA+100*KFLB+KFLS
|
|
CALL PYNAME(KF,CHAP)
|
|
CALL PYNAME(-KF,CHAN)
|
|
WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
KF=130
|
|
CALL PYNAME(KF,CHAP)
|
|
WRITE(MSTU(11),6700) KF,CHAP
|
|
KF=310
|
|
CALL PYNAME(KF,CHAP)
|
|
WRITE(MSTU(11),6700) KF,CHAP
|
|
DO 200 KMUL=0,5
|
|
KFLS=3
|
|
IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
|
|
IF(KMUL.EQ.5) KFLS=5
|
|
KFLR=0
|
|
IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1
|
|
IF(KMUL.EQ.4) KFLR=2
|
|
DO 190 KFLB=1,5
|
|
DO 180 KFLC=1,KFLB-1
|
|
KF=10000*KFLR+100*KFLB+10*KFLC+KFLS
|
|
CALL PYNAME(KF,CHAP)
|
|
CALL PYNAME(-KF,CHAN)
|
|
WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
|
|
180 CONTINUE
|
|
KF=10000*KFLR+110*KFLB+KFLS
|
|
CALL PYNAME(KF,CHAP)
|
|
WRITE(MSTU(11),6700) KF,CHAP
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
KF=100443
|
|
CALL PYNAME(KF,CHAP)
|
|
WRITE(MSTU(11),6700) KF,CHAP
|
|
KF=100553
|
|
CALL PYNAME(KF,CHAP)
|
|
WRITE(MSTU(11),6700) KF,CHAP
|
|
DO 240 KFLSP=1,3
|
|
KFLS=2+2*(KFLSP/3)
|
|
DO 230 KFLA=1,5
|
|
DO 220 KFLB=1,KFLA
|
|
DO 210 KFLC=1,KFLB
|
|
IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC))
|
|
& GOTO 210
|
|
IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 210
|
|
IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS
|
|
IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS
|
|
CALL PYNAME(KF,CHAP)
|
|
CALL PYNAME(-KF,CHAN)
|
|
WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
230 CONTINUE
|
|
240 CONTINUE
|
|
DO 250 KF=KSUSY1+1,KSUSY1+40
|
|
CALL PYNAME(KF,CHAP)
|
|
CALL PYNAME(-KF,CHAN)
|
|
IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP
|
|
IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
|
|
250 CONTINUE
|
|
DO 260 KF=KSUSY2+1,KSUSY2+40
|
|
CALL PYNAME(KF,CHAP)
|
|
CALL PYNAME(-KF,CHAN)
|
|
IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP
|
|
IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
|
|
260 CONTINUE
|
|
DO 270 KF=KEXCIT+1,KEXCIT+40
|
|
CALL PYNAME(KF,CHAP)
|
|
CALL PYNAME(-KF,CHAN)
|
|
IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP
|
|
IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
|
|
270 CONTINUE
|
|
|
|
C...List parton/particle data table. Check whether to be listed.
|
|
ELSEIF(MLIST.EQ.12) THEN
|
|
WRITE(MSTU(11),6800)
|
|
DO 300 KC=1,MSTU(6)
|
|
KF=KCHG(KC,4)
|
|
IF(KF.EQ.0) GOTO 300
|
|
IF(KF.LT.MSTU(1).OR.(MSTU(2).GT.0.AND.KF.GT.MSTU(2)))
|
|
& GOTO 300
|
|
|
|
C...Find particle name and mass. Print information.
|
|
CALL PYNAME(KF,CHAP)
|
|
IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 300
|
|
CALL PYNAME(-KF,CHAN)
|
|
WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,(KCHG(KC,J1),J1=1,3),
|
|
& (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
|
|
|
|
C...Particle decay: channel number, branching ratios, matrix element,
|
|
C...decay products.
|
|
DO 290 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
|
|
DO 280 J=1,5
|
|
CALL PYNAME(KFDP(IDC,J),CHAD(J))
|
|
280 CONTINUE
|
|
WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
|
|
& (CHAD(J),J=1,5)
|
|
290 CONTINUE
|
|
300 CONTINUE
|
|
|
|
C...List parameter value table.
|
|
ELSEIF(MLIST.EQ.13) THEN
|
|
WRITE(MSTU(11),7100)
|
|
DO 310 I=1,200
|
|
WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I)
|
|
310 CONTINUE
|
|
ENDIF
|
|
|
|
C...Format statements for output on unit MSTU(11) (by default 6).
|
|
5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS',
|
|
&5X,'KF orig p_x p_y p_z E m'/)
|
|
5200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet',
|
|
&' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
|
|
&' P(I,2) P(I,3) P(I,4) P(I,5)'/)
|
|
5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j',
|
|
&'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
|
|
&' P(I,2) P(I,3) P(I,4) P(I,5)'/73X,
|
|
&'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/)
|
|
5400 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.3)
|
|
5500 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.2)
|
|
5600 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.1)
|
|
5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I1,2I4),5F13.5)
|
|
5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I9),5F13.5)
|
|
5900 FORMAT(66X,5(1X,F12.3))
|
|
6000 FORMAT(1X,78('='))
|
|
6100 FORMAT(1X,130('='))
|
|
6200 FORMAT(19X,'sum:',F6.2,5X,5F9.3)
|
|
6300 FORMAT(19X,'sum:',F6.2,5X,5F9.2)
|
|
6400 FORMAT(19X,'sum:',F6.2,5X,5F9.1)
|
|
6500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:',
|
|
&5F13.5)
|
|
6600 FORMAT(///20X,'List of KF codes in program'/)
|
|
6700 FORMAT(4X,I9,4X,A16,6X,I9,4X,A16)
|
|
6800 FORMAT(///30X,'Particle/parton data table'//8X,'KF',5X,'KC',4X,
|
|
&'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X,
|
|
&'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off',
|
|
&1X,'ME',3X,'Br.rat.',4X,'decay products')
|
|
6900 FORMAT(/1X,I9,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5),
|
|
&1X,1P,E13.5,3X,I2)
|
|
7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F10.6,4X,5A16)
|
|
7100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)',
|
|
&8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)')
|
|
7200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYLOGO
|
|
C...Writes a logo for the program.
|
|
|
|
SUBROUTINE PYLOGO
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
C...Parameter for length of information block.
|
|
PARAMETER (IREFER=17)
|
|
C...Commonblocks.
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
|
|
SAVE /PYDAT1/,/PYPARS/
|
|
C...Local arrays and character variables.
|
|
INTEGER IDATI(6)
|
|
CHARACTER MONTH(12)*3, LOGO(48)*32, REFER(2*IREFER)*36, LINE*79,
|
|
&VERS*1, SUBV*3, DATE*2, YEAR*4, HOUR*2, MINU*2, SECO*2
|
|
|
|
C...Data on months, logo, titles, and references.
|
|
DATA MONTH/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',
|
|
&'Oct','Nov','Dec'/
|
|
DATA (LOGO(J),J=1,19)/
|
|
&' *......* ',
|
|
&' *:::!!:::::::::::* ',
|
|
&' *::::::!!::::::::::::::* ',
|
|
&' *::::::::!!::::::::::::::::* ',
|
|
&' *:::::::::!!:::::::::::::::::* ',
|
|
&' *:::::::::!!:::::::::::::::::* ',
|
|
&' *::::::::!!::::::::::::::::*! ',
|
|
&' *::::::!!::::::::::::::* !! ',
|
|
&' !! *:::!!:::::::::::* !! ',
|
|
&' !! !* -><- * !! ',
|
|
&' !! !! !! ',
|
|
&' !! !! !! ',
|
|
&' !! !! ',
|
|
&' !! ep !! ',
|
|
&' !! !! ',
|
|
&' !! pp !! ',
|
|
&' !! e+e- !! ',
|
|
&' !! !! ',
|
|
&' !! '/
|
|
DATA (LOGO(J),J=20,38)/
|
|
&'Welcome to the Lund Monte Carlo!',
|
|
&' ',
|
|
&'PPP Y Y TTTTT H H III A ',
|
|
&'P P Y Y T H H I A A ',
|
|
&'PPP Y T HHHHH I AAAAA',
|
|
&'P Y T H H I A A',
|
|
&'P Y T H H III A A',
|
|
&' ',
|
|
&'This is PYTHIA version x.xxx ',
|
|
&'Last date of change: xx xxx 199x',
|
|
&' ',
|
|
&'Now is xx xxx 199x at xx:xx:xx ',
|
|
&' ',
|
|
&'Disclaimer: this program comes ',
|
|
&'without any guarantees. Beware ',
|
|
&'of errors and use common sense ',
|
|
&'when interpreting results. ',
|
|
&' ',
|
|
&'Copyright T. Sjostrand (1997) '/
|
|
DATA (REFER(J),J=1,18)/
|
|
&'An archive of program versions and d',
|
|
&'ocumentation is found on the web: ',
|
|
&'http://thep.lu.se/tf2/staff/torbjorn',
|
|
&'/Pythia.html ',
|
|
&' ',
|
|
&' ',
|
|
&'When you cite this program, currentl',
|
|
&'y the official reference is ',
|
|
&'T. Sjostrand, Computer Physics Commu',
|
|
&'n. 82 (1994) 74. ',
|
|
&'The supersymmetry extensions are des',
|
|
&'cribed in ',
|
|
&'S. Mrenna, ANL-HEP-PR-96-63. ',
|
|
&' ',
|
|
&'Also remember that the program, to a',
|
|
&' large extent, represents original ',
|
|
&'physics research. Other publications',
|
|
&' of special relevance to your '/
|
|
DATA (REFER(J),J=19,2*IREFER)/
|
|
&'studies may therefore deserve separa',
|
|
&'te mention. ',
|
|
&' ',
|
|
&' ',
|
|
&'Main author: Torbjorn Sjostrand; Dep',
|
|
&'artment of Theoretical Physics 2, ',
|
|
&' Lund University, Solvegatan 14A, S',
|
|
&'-223 62 Lund, Sweden; ',
|
|
&' phone: + 46 - 46 - 222 48 16; e-ma',
|
|
&'il: torbjorn@thep.lu.se ',
|
|
&'SUSY author: Stephen Mrenna, Argonne',
|
|
&' National Laboratory, ',
|
|
&' 9700 South Cass Avenue, Argonne, I',
|
|
&'L 60439, USA; ',
|
|
&' phone: + 1 - 630 - 252 - 7615; e-m',
|
|
&'ail: mrenna@hep.anl.gov '/
|
|
|
|
C...Check that PYDATA linked.
|
|
IF(MSTP(183)/10.NE.199) THEN
|
|
WRITE(MSTU(11),'(1X,A)')
|
|
& 'Error: PYDATA has not been linked.'
|
|
WRITE(MSTU(11),'(1X,A)') 'Execution stopped!'
|
|
STOP
|
|
|
|
C...Write current version number and current date+time.
|
|
ELSE
|
|
WRITE(VERS,'(I1)') MSTP(181)
|
|
LOGO(28)(24:24)=VERS
|
|
WRITE(SUBV,'(I3)') MSTP(182)
|
|
LOGO(28)(26:28)=SUBV
|
|
IF(MSTP(182).LT.100) LOGO(28)(26:26)='0'
|
|
WRITE(DATE,'(I2)') MSTP(185)
|
|
LOGO(29)(22:23)=DATE
|
|
LOGO(29)(25:27)=MONTH(MSTP(184))
|
|
WRITE(YEAR,'(I4)') MSTP(183)
|
|
LOGO(29)(29:32)=YEAR
|
|
CALL PYTIME(IDATI)
|
|
IF(IDATI(1).LE.0) THEN
|
|
LOGO(31)=' '
|
|
ELSE
|
|
WRITE(DATE,'(I2)') IDATI(3)
|
|
LOGO(31)(8:9)=DATE
|
|
LOGO(31)(11:13)=MONTH(MAX(1,MIN(12,IDATI(2))))
|
|
WRITE(YEAR,'(I4)') IDATI(1)
|
|
LOGO(31)(15:18)=YEAR
|
|
WRITE(HOUR,'(I2)') IDATI(4)
|
|
LOGO(31)(23:24)=HOUR
|
|
WRITE(MINU,'(I2)') IDATI(5)
|
|
LOGO(31)(26:27)=MINU
|
|
IF(IDATI(5).LT.10) LOGO(31)(26:26)='0'
|
|
WRITE(SECO,'(I2)') IDATI(6)
|
|
LOGO(31)(29:30)=SECO
|
|
IF(IDATI(6).LT.10) LOGO(31)(29:29)='0'
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Loop over lines in header. Define page feed and side borders.
|
|
DO 100 ILIN=1,29+IREFER
|
|
LINE=' '
|
|
IF(ILIN.EQ.1) THEN
|
|
LINE(1:1)='1'
|
|
ELSE
|
|
LINE(2:3)='**'
|
|
LINE(78:79)='**'
|
|
ENDIF
|
|
|
|
C...Separator lines and logos.
|
|
IF(ILIN.EQ.2.OR.ILIN.EQ.3.OR.ILIN.GE.28+IREFER) THEN
|
|
LINE(4:77)='***********************************************'//
|
|
& '***************************'
|
|
ELSEIF(ILIN.GE.6.AND.ILIN.LE.24) THEN
|
|
LINE(6:37)=LOGO(ILIN-5)
|
|
LINE(44:75)=LOGO(ILIN+14)
|
|
ELSEIF(ILIN.GE.26.AND.ILIN.LE.25+IREFER) THEN
|
|
LINE(5:40)=REFER(2*ILIN-51)
|
|
LINE(41:76)=REFER(2*ILIN-50)
|
|
ENDIF
|
|
|
|
C...Write lines to appropriate unit.
|
|
IF(MSTU(183)/10.EQ.199) THEN
|
|
WRITE(MSTU(11),'(A79)') LINE
|
|
ELSE
|
|
WRITE(*,'(A79)') LINE
|
|
ENDIF
|
|
100 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYUPDA
|
|
C...Facilitates the updating of particle and decay data
|
|
C...by allowing it to be done in an external file.
|
|
|
|
SUBROUTINE PYUPDA(MUPDA,LFN)
|
|
|
|
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/PYINT4/MWID(500),WIDS(500,5)
|
|
SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYINT4/
|
|
C...Local arrays, character variables and data.
|
|
CHARACTER CHINL*120,CHKF*9,CHVAR(22)*9,CHLIN*72,
|
|
&CHBLK(20)*72,CHOLD*16,CHTMP*16,CHNEW*16,CHCOM*24
|
|
DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','KCHG(I,4)',
|
|
&'PMAS(I,1)','PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)',
|
|
&'MDCY(I,2)','MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ',
|
|
&'KFDP(I,1)','KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)',
|
|
&'CHAF(I,1)','CHAF(I,2)','MWID(I) '/
|
|
|
|
C...Write header if not yet done.
|
|
IF(MSTU(12).GE.1) CALL PYLIST(0)
|
|
|
|
C...Write information on file for editing.
|
|
IF(MUPDA.EQ.1) THEN
|
|
DO 110 KC=1,500
|
|
WRITE(LFN,5000) KCHG(KC,4),(CHAF(KC,J1),J1=1,2),
|
|
& (KCHG(KC,J2),J2=1,3),(PMAS(KC,J3),J3=1,4),
|
|
& MWID(KC),MDCY(KC,1)
|
|
DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
|
|
WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
|
|
& (KFDP(IDC,J),J=1,5)
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
|
|
C...Read complete set of information from edited file or
|
|
C...read partial set of new or updated information from edited file.
|
|
ELSEIF(MUPDA.EQ.2.OR.MUPDA.EQ.3) THEN
|
|
|
|
C...Reset counters.
|
|
KCC=100
|
|
NDC=0
|
|
CHKF=' '
|
|
IF(MUPDA.EQ.2) THEN
|
|
DO 120 I=1,MSTU(6)
|
|
KCHG(I,4)=0
|
|
120 CONTINUE
|
|
ELSE
|
|
DO 130 KC=1,MSTU(6)
|
|
IF(KC.GT.100.AND.KCHG(KC,4).GT.100) KCC=KC
|
|
NDC=MAX(NDC,MDCY(KC,2)+MDCY(KC,3)-1)
|
|
130 CONTINUE
|
|
ENDIF
|
|
|
|
C...Begin of loop: read new line; unknown whether particle or
|
|
C...decay data.
|
|
140 READ(LFN,5200,END=190) CHINL
|
|
|
|
C...Identify particle code and whether already defined (for MUPDA=3).
|
|
IF(CHINL(2:10).NE.' ') THEN
|
|
CHKF=CHINL(2:10)
|
|
READ(CHKF,5300) KF
|
|
IF(MUPDA.EQ.2) THEN
|
|
IF(KF.LE.100) THEN
|
|
KC=KF
|
|
ELSE
|
|
KCC=KCC+1
|
|
KC=KCC
|
|
ENDIF
|
|
ELSE
|
|
KCREP=0
|
|
IF(KF.LE.100) THEN
|
|
KCREP=KF
|
|
ELSE
|
|
DO 150 KCR=101,KCC
|
|
IF(KCHG(KCR,4).EQ.KF) KCREP=KCR
|
|
150 CONTINUE
|
|
ENDIF
|
|
C...Remove duplicate old decay data.
|
|
IF(KCREP.NE.0) THEN
|
|
IDCREP=MDCY(KCREP,2)
|
|
NDCREP=MDCY(KCREP,3)
|
|
DO 160 I=1,KCC
|
|
IF(MDCY(I,2).GT.IDCREP) MDCY(I,2)=MDCY(I,2)-NDCREP
|
|
160 CONTINUE
|
|
DO 180 I=IDCREP,NDC-NDCREP
|
|
MDME(I,1)=MDME(I+NDCREP,1)
|
|
MDME(I,2)=MDME(I+NDCREP,2)
|
|
BRAT(I)=BRAT(I+NDCREP)
|
|
DO 170 J=1,5
|
|
KFDP(I,J)=KFDP(I+NDCREP,J)
|
|
170 CONTINUE
|
|
180 CONTINUE
|
|
NDC=NDC-NDCREP
|
|
KC=KCREP
|
|
ELSE
|
|
KCC=KCC+1
|
|
KC=KCC
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Study line with particle data.
|
|
IF(KC.GT.MSTU(6)) CALL PYERRM(27,
|
|
& '(PYUPDA:) Particle arrays full by KF ='//CHKF)
|
|
READ(CHINL,5000) KCHG(KC,4),(CHAF(KC,J1),J1=1,2),
|
|
& (KCHG(KC,J2),J2=1,3),(PMAS(KC,J3),J3=1,4),
|
|
& MWID(KC),MDCY(KC,1)
|
|
MDCY(KC,2)=0
|
|
MDCY(KC,3)=0
|
|
|
|
C...Study line with decay data.
|
|
ELSE
|
|
NDC=NDC+1
|
|
IF(NDC.GT.MSTU(7)) CALL PYERRM(27,
|
|
& '(PYUPDA:) Decay data arrays full by KF ='//CHKF)
|
|
IF(MDCY(KC,2).EQ.0) MDCY(KC,2)=NDC
|
|
MDCY(KC,3)=MDCY(KC,3)+1
|
|
READ(CHINL,5100) MDME(NDC,1),MDME(NDC,2),BRAT(NDC),
|
|
& (KFDP(NDC,J),J=1,5)
|
|
ENDIF
|
|
|
|
C...End of loop; ensure that PYCOMP tables are updated.
|
|
GOTO 140
|
|
190 CONTINUE
|
|
MSTU(20)=0
|
|
|
|
C...Perform possible tests that new information is consistent.
|
|
MSTJ24=MSTJ(24)
|
|
MSTJ(24)=0
|
|
DO 220 KC=1,MSTU(6)
|
|
KF=KCHG(KC,4)
|
|
IF(KF.EQ.0) GOTO 220
|
|
WRITE(CHKF,5300) KF
|
|
IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3),
|
|
& PMAS(KC,4)).LT.0D0.OR.MDCY(KC,3).LT.0) CALL PYERRM(17,
|
|
& '(PYUPDA:) Mass/width/life/(# channels) wrong for KF ='//CHKF)
|
|
BRSUM=0D0
|
|
DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
|
|
IF(MDME(IDC,2).GT.80) GOTO 210
|
|
KQ=KCHG(KC,1)
|
|
PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64)
|
|
MERR=0
|
|
DO 200 J=1,5
|
|
KP=KFDP(IDC,J)
|
|
IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN
|
|
IF(KP.EQ.81) KQ=0
|
|
ELSEIF(PYCOMP(KP).EQ.0) THEN
|
|
MERR=3
|
|
ELSE
|
|
KQ=KQ-PYCHGE(KP)
|
|
PMS=PMS-PYMASS(KP)
|
|
KPC=PYCOMP(KP)
|
|
PMS=PMS-PMAS(KPC,1)
|
|
IF(MSTJ(24).GT.0) PMS=PMS+0.5D0*MIN(PMAS(KPC,2),
|
|
& PMAS(KPC,3))
|
|
ENDIF
|
|
200 CONTINUE
|
|
IF(KQ.NE.0) MERR=MAX(2,MERR)
|
|
IF(MWID(KC).EQ.0.AND.KF.NE.311.AND.PMS.LT.0D0)
|
|
& MERR=MAX(1,MERR)
|
|
IF(MERR.EQ.3) CALL PYERRM(17,
|
|
& '(PYUPDA:) Unknown particle code in decay of KF ='//CHKF)
|
|
IF(MERR.EQ.2) CALL PYERRM(17,
|
|
& '(PYUPDA:) Charge not conserved in decay of KF ='//CHKF)
|
|
IF(MERR.EQ.1) CALL PYERRM(7,
|
|
& '(PYUPDA:) Kinematically unallowed decay of KF ='//CHKF)
|
|
BRSUM=BRSUM+BRAT(IDC)
|
|
210 CONTINUE
|
|
WRITE(CHTMP,5500) BRSUM
|
|
IF(ABS(BRSUM).GT.0.0005D0.AND.ABS(BRSUM-1D0).GT.0.0005D0)
|
|
& CALL PYERRM(7,'(PYUPDA:) Sum of branching ratios is '//
|
|
& CHTMP(9:16)//' for KF ='//CHKF)
|
|
220 CONTINUE
|
|
MSTJ(24)=MSTJ24
|
|
|
|
C...Write DATA statements for inclusion in program.
|
|
ELSEIF(MUPDA.EQ.4) THEN
|
|
|
|
C...Find out how many codes and decay channels are actually used.
|
|
KCC=0
|
|
NDC=0
|
|
DO 230 I=1,MSTU(6)
|
|
IF(KCHG(I,4).NE.0) THEN
|
|
KCC=I
|
|
NDC=MAX(NDC,MDCY(I,2)+MDCY(I,3)-1)
|
|
ENDIF
|
|
230 CONTINUE
|
|
|
|
C...Initialize writing of DATA statements for inclusion in program.
|
|
DO 300 IVAR=1,22
|
|
NDIM=MSTU(6)
|
|
IF(IVAR.GE.12.AND.IVAR.LE.19) NDIM=MSTU(7)
|
|
NLIN=1
|
|
CHLIN=' '
|
|
CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I= 1, )/'
|
|
LLIN=35
|
|
CHOLD='START'
|
|
|
|
C...Loop through variables for conversion to characters.
|
|
DO 280 IDIM=1,NDIM
|
|
IF(IVAR.EQ.1) WRITE(CHTMP,5400) KCHG(IDIM,1)
|
|
IF(IVAR.EQ.2) WRITE(CHTMP,5400) KCHG(IDIM,2)
|
|
IF(IVAR.EQ.3) WRITE(CHTMP,5400) KCHG(IDIM,3)
|
|
IF(IVAR.EQ.4) WRITE(CHTMP,5400) KCHG(IDIM,4)
|
|
IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,1)
|
|
IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,2)
|
|
IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,3)
|
|
IF(IVAR.EQ.8) WRITE(CHTMP,5500) PMAS(IDIM,4)
|
|
IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,1)
|
|
IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,2)
|
|
IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDCY(IDIM,3)
|
|
IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,1)
|
|
IF(IVAR.EQ.13) WRITE(CHTMP,5400) MDME(IDIM,2)
|
|
IF(IVAR.EQ.14) WRITE(CHTMP,5600) BRAT(IDIM)
|
|
IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,1)
|
|
IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,2)
|
|
IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,3)
|
|
IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,4)
|
|
IF(IVAR.EQ.19) WRITE(CHTMP,5400) KFDP(IDIM,5)
|
|
IF(IVAR.EQ.20) CHTMP=CHAF(IDIM,1)
|
|
IF(IVAR.EQ.21) CHTMP=CHAF(IDIM,2)
|
|
IF(IVAR.EQ.22) WRITE(CHTMP,5400) MWID(IDIM)
|
|
|
|
C...Replace variables beyond what is properly defined.
|
|
IF(IVAR.LE.4) THEN
|
|
IF(IDIM.GT.KCC) CHTMP=' 0'
|
|
ELSEIF(IVAR.LE.8) THEN
|
|
IF(IDIM.GT.KCC) CHTMP=' 0.0'
|
|
ELSEIF(IVAR.LE.11) THEN
|
|
IF(IDIM.GT.KCC) CHTMP=' 0'
|
|
ELSEIF(IVAR.LE.13) THEN
|
|
IF(IDIM.GT.NDC) CHTMP=' 0'
|
|
ELSEIF(IVAR.LE.14) THEN
|
|
IF(IDIM.GT.NDC) CHTMP=' 0.0'
|
|
ELSEIF(IVAR.LE.19) THEN
|
|
IF(IDIM.GT.NDC) CHTMP=' 0'
|
|
ELSEIF(IVAR.LE.21) THEN
|
|
IF(IDIM.GT.KCC) CHTMP=' '
|
|
ELSE
|
|
IF(IDIM.GT.KCC) CHTMP=' 0'
|
|
ENDIF
|
|
|
|
C...Length of variable, trailing decimal zeros, quotation marks.
|
|
LLOW=1
|
|
LHIG=1
|
|
DO 240 LL=1,16
|
|
IF(CHTMP(17-LL:17-LL).NE.' ') LLOW=17-LL
|
|
IF(CHTMP(LL:LL).NE.' ') LHIG=LL
|
|
240 CONTINUE
|
|
CHNEW=CHTMP(LLOW:LHIG)//' '
|
|
LNEW=1+LHIG-LLOW
|
|
IF((IVAR.GE.5.AND.IVAR.LE.8).OR.IVAR.EQ.14) THEN
|
|
LNEW=LNEW+1
|
|
250 LNEW=LNEW-1
|
|
IF(LNEW.GE.2.AND.CHNEW(LNEW:LNEW).EQ.'0') GOTO 250
|
|
IF(CHNEW(LNEW:LNEW).EQ.'.') LNEW=LNEW-1
|
|
IF(LNEW.EQ.0) THEN
|
|
CHNEW(1:3)='0D0'
|
|
LNEW=3
|
|
ELSE
|
|
CHNEW(LNEW+1:LNEW+2)='D0'
|
|
LNEW=LNEW+2
|
|
ENDIF
|
|
ELSEIF(IVAR.EQ.20.OR.IVAR.EQ.21) THEN
|
|
DO 260 LL=LNEW,1,-1
|
|
IF(CHNEW(LL:LL).EQ.'''') THEN
|
|
CHTMP=CHNEW
|
|
CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11)
|
|
LNEW=LNEW+1
|
|
ENDIF
|
|
260 CONTINUE
|
|
LNEW=MIN(14,LNEW)
|
|
CHTMP=CHNEW
|
|
CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//''''
|
|
LNEW=LNEW+2
|
|
ENDIF
|
|
|
|
C...Form composite character string, often including repetition counter.
|
|
IF(CHNEW.NE.CHOLD) THEN
|
|
NRPT=1
|
|
CHOLD=CHNEW
|
|
CHCOM=CHNEW
|
|
LCOM=LNEW
|
|
ELSE
|
|
LRPT=LNEW+1
|
|
IF(NRPT.GE.2) LRPT=LNEW+3
|
|
IF(NRPT.GE.10) LRPT=LNEW+4
|
|
IF(NRPT.GE.100) LRPT=LNEW+5
|
|
IF(NRPT.GE.1000) LRPT=LNEW+6
|
|
LLIN=LLIN-LRPT
|
|
NRPT=NRPT+1
|
|
WRITE(CHTMP,5400) NRPT
|
|
LRPT=1
|
|
IF(NRPT.GE.10) LRPT=2
|
|
IF(NRPT.GE.100) LRPT=3
|
|
IF(NRPT.GE.1000) LRPT=4
|
|
CHCOM(1:LRPT+1+LNEW)=CHTMP(17-LRPT:16)//'*'//CHNEW(1:LNEW)
|
|
LCOM=LRPT+1+LNEW
|
|
ENDIF
|
|
|
|
C...Add characters to end of line, to new line (after storing old line),
|
|
C...or to new block of lines (after writing old block).
|
|
IF(LLIN+LCOM.LE.70) THEN
|
|
CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//','
|
|
LLIN=LLIN+LCOM+1
|
|
ELSEIF(NLIN.LE.19) THEN
|
|
CHLIN(LLIN+1:72)=' '
|
|
CHBLK(NLIN)=CHLIN
|
|
NLIN=NLIN+1
|
|
CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//','
|
|
LLIN=6+LCOM+1
|
|
ELSE
|
|
CHLIN(LLIN:72)='/'//' '
|
|
CHBLK(NLIN)=CHLIN
|
|
WRITE(CHTMP,5400) IDIM-NRPT
|
|
CHBLK(1)(30:33)=CHTMP(13:16)
|
|
DO 270 ILIN=1,NLIN
|
|
WRITE(LFN,5700) CHBLK(ILIN)
|
|
270 CONTINUE
|
|
NLIN=1
|
|
CHLIN=' '
|
|
CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)//
|
|
& ',I= , )/'//CHCOM(1:LCOM)//','
|
|
WRITE(CHTMP,5400) IDIM-NRPT+1
|
|
CHLIN(25:28)=CHTMP(13:16)
|
|
LLIN=35+LCOM+1
|
|
ENDIF
|
|
280 CONTINUE
|
|
|
|
C...Write final block of lines.
|
|
CHLIN(LLIN:72)='/'//' '
|
|
CHBLK(NLIN)=CHLIN
|
|
WRITE(CHTMP,5400) NDIM
|
|
CHBLK(1)(30:33)=CHTMP(13:16)
|
|
DO 290 ILIN=1,NLIN
|
|
WRITE(LFN,5700) CHBLK(ILIN)
|
|
290 CONTINUE
|
|
300 CONTINUE
|
|
ENDIF
|
|
|
|
C...Formats for reading and writing particle data.
|
|
5000 FORMAT(1X,I9,2X,A16,2X,A16,3I3,3F12.5,1P,E13.5,2I3)
|
|
5100 FORMAT(10X,2I5,F12.6,5I10)
|
|
5200 FORMAT(A120)
|
|
5300 FORMAT(I9)
|
|
5400 FORMAT(I16)
|
|
5500 FORMAT(F16.5)
|
|
5600 FORMAT(F16.6)
|
|
5700 FORMAT(A72)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYK
|
|
C...Provides various integer-valued event related data.
|
|
|
|
FUNCTION PYK(I,J)
|
|
|
|
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...Default value. For I=0 number of entries, number of stable entries
|
|
C...or 3 times total charge.
|
|
PYK=0
|
|
IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN
|
|
ELSEIF(I.EQ.0.AND.J.EQ.1) THEN
|
|
PYK=N
|
|
ELSEIF(I.EQ.0.AND.(J.EQ.2.OR.J.EQ.6)) THEN
|
|
DO 100 I1=1,N
|
|
IF(J.EQ.2.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) PYK=PYK+1
|
|
IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) PYK=PYK+
|
|
& PYCHGE(K(I1,2))
|
|
100 CONTINUE
|
|
ELSEIF(I.EQ.0) THEN
|
|
|
|
C...For I > 0 direct readout of K matrix or charge.
|
|
ELSEIF(J.LE.5) THEN
|
|
PYK=K(I,J)
|
|
ELSEIF(J.EQ.6) THEN
|
|
PYK=PYCHGE(K(I,2))
|
|
|
|
C...Status (existing/fragmented/decayed), parton/hadron separation.
|
|
ELSEIF(J.LE.8) THEN
|
|
IF(K(I,1).GE.1.AND.K(I,1).LE.10) PYK=1
|
|
IF(J.EQ.8) PYK=PYK*K(I,2)
|
|
ELSEIF(J.LE.12) THEN
|
|
KFA=IABS(K(I,2))
|
|
KC=PYCOMP(KFA)
|
|
KQ=0
|
|
IF(KC.NE.0) KQ=KCHG(KC,2)
|
|
IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) PYK=K(I,2)
|
|
IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) PYK=K(I,2)
|
|
IF(J.EQ.11) PYK=KC
|
|
IF(J.EQ.12) PYK=KQ*ISIGN(1,K(I,2))
|
|
|
|
C...Heaviest flavour in hadron/diquark.
|
|
ELSEIF(J.EQ.13) THEN
|
|
KFA=IABS(K(I,2))
|
|
PYK=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10)
|
|
IF(KFA.LT.10) PYK=KFA
|
|
IF(MOD(KFA/1000,10).NE.0) PYK=MOD(KFA/1000,10)
|
|
PYK=PYK*ISIGN(1,K(I,2))
|
|
|
|
C...Particle history: generation, ancestor, rank.
|
|
ELSEIF(J.LE.15) THEN
|
|
I2=I
|
|
I1=I
|
|
110 PYK=PYK+1
|
|
I2=I1
|
|
I1=K(I1,3)
|
|
IF(I1.GT.0.AND.K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110
|
|
IF(J.EQ.15) PYK=I2
|
|
ELSEIF(J.EQ.16) THEN
|
|
KFA=IABS(K(I,2))
|
|
IF(K(I,1).LE.20.AND.((KFA.GE.11.AND.KFA.LE.20).OR.KFA.EQ.22.OR.
|
|
& (KFA.GT.100.AND.MOD(KFA/10,10).NE.0))) THEN
|
|
I1=I
|
|
120 I2=I1
|
|
I1=K(I1,3)
|
|
IF(I1.GT.0) THEN
|
|
KFAM=IABS(K(I1,2))
|
|
ILP=1
|
|
IF(KFAM.NE.0.AND.KFAM.LE.10) ILP=0
|
|
IF(KFAM.EQ.21.OR.KFAM.EQ.91.OR.KFAM.EQ.92.OR.KFAM.EQ.93)
|
|
& ILP=0
|
|
IF(KFAM.GT.100.AND.MOD(KFAM/10,10).EQ.0) ILP=0
|
|
IF(ILP.EQ.1) GOTO 120
|
|
ENDIF
|
|
IF(K(I1,1).EQ.12) THEN
|
|
DO 130 I3=I1+1,I2
|
|
IF(K(I3,3).EQ.K(I2,3).AND.K(I3,2).NE.91.AND.K(I3,2).NE.92
|
|
& .AND.K(I3,2).NE.93) PYK=PYK+1
|
|
130 CONTINUE
|
|
ELSE
|
|
I3=I2
|
|
140 PYK=PYK+1
|
|
I3=I3+1
|
|
IF(I3.LT.N.AND.K(I3,3).EQ.K(I2,3)) GOTO 140
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Particle coming from collapsing jet system or not.
|
|
ELSEIF(J.EQ.17) THEN
|
|
I1=I
|
|
150 PYK=PYK+1
|
|
I3=I1
|
|
I1=K(I1,3)
|
|
I0=MAX(1,I1)
|
|
KC=PYCOMP(K(I0,2))
|
|
IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN
|
|
IF(PYK.EQ.1) PYK=-1
|
|
IF(PYK.GT.1) PYK=0
|
|
RETURN
|
|
ENDIF
|
|
IF(KCHG(KC,2).EQ.0) GOTO 150
|
|
IF(K(I1,1).NE.12) PYK=0
|
|
IF(K(I1,1).NE.12) RETURN
|
|
I2=I1
|
|
160 I2=I2+1
|
|
IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 160
|
|
K3M=K(I3-1,3)
|
|
IF(K3M.GE.I1.AND.K3M.LE.I2) PYK=0
|
|
K3P=K(I3+1,3)
|
|
IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) PYK=0
|
|
|
|
C...Number of decay products. Colour flow.
|
|
ELSEIF(J.EQ.18) THEN
|
|
IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) PYK=MAX(0,K(I,5)-K(I,4)+1)
|
|
IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) PYK=0
|
|
ELSEIF(J.LE.22) THEN
|
|
IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN
|
|
IF(J.EQ.19) PYK=MOD(K(I,4)/MSTU(5),MSTU(5))
|
|
IF(J.EQ.20) PYK=MOD(K(I,5)/MSTU(5),MSTU(5))
|
|
IF(J.EQ.21) PYK=MOD(K(I,4),MSTU(5))
|
|
IF(J.EQ.22) PYK=MOD(K(I,5),MSTU(5))
|
|
ELSE
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYP
|
|
C...Provides various real-valued event related data.
|
|
|
|
FUNCTION PYP(I,J)
|
|
|
|
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...Local array.
|
|
DIMENSION PSUM(4)
|
|
|
|
C...Set default value. For I = 0 sum of momenta or charges,
|
|
C...or invariant mass of system.
|
|
PYP=0D0
|
|
IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN
|
|
ELSEIF(I.EQ.0.AND.J.LE.4) THEN
|
|
DO 100 I1=1,N
|
|
IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PYP=PYP+P(I1,J)
|
|
100 CONTINUE
|
|
ELSEIF(I.EQ.0.AND.J.EQ.5) THEN
|
|
DO 120 J1=1,4
|
|
PSUM(J1)=0D0
|
|
DO 110 I1=1,N
|
|
IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PSUM(J1)=PSUM(J1)+
|
|
& P(I1,J1)
|
|
110 CONTINUE
|
|
120 CONTINUE
|
|
PYP=SQRT(MAX(0D0,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2))
|
|
ELSEIF(I.EQ.0.AND.J.EQ.6) THEN
|
|
DO 130 I1=1,N
|
|
IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PYP=PYP+PYCHGE(K(I1,2))/3D0
|
|
130 CONTINUE
|
|
ELSEIF(I.EQ.0) THEN
|
|
|
|
C...Direct readout of P matrix.
|
|
ELSEIF(J.LE.5) THEN
|
|
PYP=P(I,J)
|
|
|
|
C...Charge, total momentum, transverse momentum, transverse mass.
|
|
ELSEIF(J.LE.12) THEN
|
|
IF(J.EQ.6) PYP=PYCHGE(K(I,2))/3D0
|
|
IF(J.EQ.7.OR.J.EQ.8) PYP=P(I,1)**2+P(I,2)**2+P(I,3)**2
|
|
IF(J.EQ.9.OR.J.EQ.10) PYP=P(I,1)**2+P(I,2)**2
|
|
IF(J.EQ.11.OR.J.EQ.12) PYP=P(I,5)**2+P(I,1)**2+P(I,2)**2
|
|
IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PYP=SQRT(PYP)
|
|
|
|
C...Theta and phi angle in radians or degrees.
|
|
ELSEIF(J.LE.16) THEN
|
|
IF(J.LE.14) PYP=PYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2))
|
|
IF(J.GE.15) PYP=PYANGL(P(I,1),P(I,2))
|
|
IF(J.EQ.14.OR.J.EQ.16) PYP=PYP*180D0/PARU(1)
|
|
|
|
C...True rapidity, rapidity with pion mass, pseudorapidity.
|
|
ELSEIF(J.LE.19) THEN
|
|
PMR=0D0
|
|
IF(J.EQ.17) PMR=P(I,5)
|
|
IF(J.EQ.18) PMR=PYMASS(211)
|
|
PR=MAX(1D-20,PMR**2+P(I,1)**2+P(I,2)**2)
|
|
PYP=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR),
|
|
& 1D20)),P(I,3))
|
|
|
|
C...Energy and momentum fractions (only to be used in CM frame).
|
|
ELSEIF(J.LE.25) THEN
|
|
IF(J.EQ.20) PYP=2D0*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21)
|
|
IF(J.EQ.21) PYP=2D0*P(I,3)/PARU(21)
|
|
IF(J.EQ.22) PYP=2D0*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21)
|
|
IF(J.EQ.23) PYP=2D0*P(I,4)/PARU(21)
|
|
IF(J.EQ.24) PYP=(P(I,4)+P(I,3))/PARU(21)
|
|
IF(J.EQ.25) PYP=(P(I,4)-P(I,3))/PARU(21)
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYSPHE
|
|
C...Performs sphericity tensor analysis to give sphericity,
|
|
C...aplanarity and the related event axes.
|
|
|
|
SUBROUTINE PYSPHE(SPH,APL)
|
|
|
|
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...Local arrays.
|
|
DIMENSION SM(3,3),SV(3,3)
|
|
|
|
C...Calculate matrix to be diagonalized.
|
|
NP=0
|
|
DO 110 J1=1,3
|
|
DO 100 J2=J1,3
|
|
SM(J1,J2)=0D0
|
|
100 CONTINUE
|
|
110 CONTINUE
|
|
PS=0D0
|
|
DO 140 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 140
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0)
|
|
& GOTO 140
|
|
ENDIF
|
|
NP=NP+1
|
|
PA=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
PWT=1D0
|
|
IF(ABS(PARU(41)-2D0).GT.0.001D0) PWT=
|
|
& MAX(1D-10,PA)**(PARU(41)-2D0)
|
|
DO 130 J1=1,3
|
|
DO 120 J2=J1,3
|
|
SM(J1,J2)=SM(J1,J2)+PWT*P(I,J1)*P(I,J2)
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
PS=PS+PWT*PA**2
|
|
140 CONTINUE
|
|
|
|
C...Very low multiplicities (0 or 1) not considered.
|
|
IF(NP.LE.1) THEN
|
|
CALL PYERRM(8,'(PYSPHE:) too few particles for analysis')
|
|
SPH=-1D0
|
|
APL=-1D0
|
|
RETURN
|
|
ENDIF
|
|
DO 160 J1=1,3
|
|
DO 150 J2=J1,3
|
|
SM(J1,J2)=SM(J1,J2)/PS
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
|
|
C...Find eigenvalues to matrix (third degree equation).
|
|
SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-
|
|
&SM(1,2)**2-SM(1,3)**2-SM(2,3)**2)/3D0-1D0/9D0
|
|
SR=-0.5D0*(SQ+1D0/9D0+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+
|
|
&SM(3,3)*SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+
|
|
&SM(1,2)*SM(1,3)*SM(2,3)+1D0/27D0
|
|
SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1D0),-1D0))/3D0)
|
|
P(N+1,4)=1D0/3D0+SQRT(-SQ)*MAX(2D0*SP,SQRT(3D0*(1D0-SP**2))-SP)
|
|
P(N+3,4)=1D0/3D0+SQRT(-SQ)*MIN(2D0*SP,-SQRT(3D0*(1D0-SP**2))-SP)
|
|
P(N+2,4)=1D0-P(N+1,4)-P(N+3,4)
|
|
IF(P(N+2,4).LT.1D-5) THEN
|
|
CALL PYERRM(8,'(PYSPHE:) all particles back-to-back')
|
|
SPH=-1D0
|
|
APL=-1D0
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Find first and last eigenvector by solving equation system.
|
|
DO 240 I=1,3,2
|
|
DO 180 J1=1,3
|
|
SV(J1,J1)=SM(J1,J1)-P(N+I,4)
|
|
DO 170 J2=J1+1,3
|
|
SV(J1,J2)=SM(J1,J2)
|
|
SV(J2,J1)=SM(J1,J2)
|
|
170 CONTINUE
|
|
180 CONTINUE
|
|
SMAX=0D0
|
|
DO 200 J1=1,3
|
|
DO 190 J2=1,3
|
|
IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 190
|
|
JA=J1
|
|
JB=J2
|
|
SMAX=ABS(SV(J1,J2))
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
SMAX=0D0
|
|
DO 220 J3=JA+1,JA+2
|
|
J1=J3-3*((J3-1)/3)
|
|
RL=SV(J1,JB)/SV(JA,JB)
|
|
DO 210 J2=1,3
|
|
SV(J1,J2)=SV(J1,J2)-RL*SV(JA,J2)
|
|
IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 210
|
|
JC=J1
|
|
SMAX=ABS(SV(J1,J2))
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
JB1=JB+1-3*(JB/3)
|
|
JB2=JB+2-3*((JB+1)/3)
|
|
P(N+I,JB1)=-SV(JC,JB2)
|
|
P(N+I,JB2)=SV(JC,JB1)
|
|
P(N+I,JB)=-(SV(JA,JB1)*P(N+I,JB1)+SV(JA,JB2)*P(N+I,JB2))/
|
|
& SV(JA,JB)
|
|
PA=SQRT(P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2)
|
|
SGN=(-1D0)**INT(PYR(0)+0.5D0)
|
|
DO 230 J=1,3
|
|
P(N+I,J)=SGN*P(N+I,J)/PA
|
|
230 CONTINUE
|
|
240 CONTINUE
|
|
|
|
C...Middle axis orthogonal to other two. Fill other codes.
|
|
SGN=(-1D0)**INT(PYR(0)+0.5D0)
|
|
P(N+2,1)=SGN*(P(N+1,2)*P(N+3,3)-P(N+1,3)*P(N+3,2))
|
|
P(N+2,2)=SGN*(P(N+1,3)*P(N+3,1)-P(N+1,1)*P(N+3,3))
|
|
P(N+2,3)=SGN*(P(N+1,1)*P(N+3,2)-P(N+1,2)*P(N+3,1))
|
|
DO 260 I=1,3
|
|
K(N+I,1)=31
|
|
K(N+I,2)=95
|
|
K(N+I,3)=I
|
|
K(N+I,4)=0
|
|
K(N+I,5)=0
|
|
P(N+I,5)=0D0
|
|
DO 250 J=1,5
|
|
V(I,J)=0D0
|
|
250 CONTINUE
|
|
260 CONTINUE
|
|
|
|
C...Calculate sphericity and aplanarity. Select storing option.
|
|
SPH=1.5D0*(P(N+2,4)+P(N+3,4))
|
|
APL=1.5D0*P(N+3,4)
|
|
MSTU(61)=N+1
|
|
MSTU(62)=NP
|
|
IF(MSTU(43).LE.1) MSTU(3)=3
|
|
IF(MSTU(43).GE.2) N=N+3
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYTHRU
|
|
C...Performs thrust analysis to give thrust, oblateness
|
|
C...and the related event axes.
|
|
|
|
SUBROUTINE PYTHRU(THR,OBL)
|
|
|
|
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...Local arrays.
|
|
DIMENSION TDI(3),TPR(3)
|
|
|
|
C...Take copy of particles that are to be considered in thrust analysis.
|
|
NP=0
|
|
PS=0D0
|
|
DO 100 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 100
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0)
|
|
& GOTO 100
|
|
ENDIF
|
|
IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYTHRU:) no more memory left in PYJETS')
|
|
THR=-2D0
|
|
OBL=-2D0
|
|
RETURN
|
|
ENDIF
|
|
NP=NP+1
|
|
K(N+NP,1)=23
|
|
P(N+NP,1)=P(I,1)
|
|
P(N+NP,2)=P(I,2)
|
|
P(N+NP,3)=P(I,3)
|
|
P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
P(N+NP,5)=1D0
|
|
IF(ABS(PARU(42)-1D0).GT.0.001D0) P(N+NP,5)=
|
|
& P(N+NP,4)**(PARU(42)-1D0)
|
|
PS=PS+P(N+NP,4)*P(N+NP,5)
|
|
100 CONTINUE
|
|
|
|
C...Very low multiplicities (0 or 1) not considered.
|
|
IF(NP.LE.1) THEN
|
|
CALL PYERRM(8,'(PYTHRU:) too few particles for analysis')
|
|
THR=-1D0
|
|
OBL=-1D0
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Loop over thrust and major. T axis along z direction in latter case.
|
|
DO 320 ILD=1,2
|
|
IF(ILD.EQ.2) THEN
|
|
K(N+NP+1,1)=31
|
|
PHI=PYANGL(P(N+NP+1,1),P(N+NP+1,2))
|
|
MSTU(33)=1
|
|
CALL PYROBO(N+1,N+NP+1,0D0,-PHI,0D0,0D0,0D0)
|
|
THE=PYANGL(P(N+NP+1,3),P(N+NP+1,1))
|
|
CALL PYROBO(N+1,N+NP+1,-THE,0D0,0D0,0D0,0D0)
|
|
ENDIF
|
|
|
|
C...Find and order particles with highest p (pT for major).
|
|
DO 110 ILF=N+NP+4,N+NP+MSTU(44)+4
|
|
P(ILF,4)=0D0
|
|
110 CONTINUE
|
|
DO 160 I=N+1,N+NP
|
|
IF(ILD.EQ.2) P(I,4)=SQRT(P(I,1)**2+P(I,2)**2)
|
|
DO 130 ILF=N+NP+MSTU(44)+3,N+NP+4,-1
|
|
IF(P(I,4).LE.P(ILF,4)) GOTO 140
|
|
DO 120 J=1,5
|
|
P(ILF+1,J)=P(ILF,J)
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
ILF=N+NP+3
|
|
140 DO 150 J=1,5
|
|
P(ILF+1,J)=P(I,J)
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
|
|
C...Find and order initial axes with highest thrust (major).
|
|
DO 170 ILG=N+NP+MSTU(44)+5,N+NP+MSTU(44)+15
|
|
P(ILG,4)=0D0
|
|
170 CONTINUE
|
|
NC=2**(MIN(MSTU(44),NP)-1)
|
|
DO 250 ILC=1,NC
|
|
DO 180 J=1,3
|
|
TDI(J)=0D0
|
|
180 CONTINUE
|
|
DO 200 ILF=1,MIN(MSTU(44),NP)
|
|
SGN=P(N+NP+ILF+3,5)
|
|
IF(2**ILF*((ILC+2**(ILF-1)-1)/2**ILF).GE.ILC) SGN=-SGN
|
|
DO 190 J=1,4-ILD
|
|
TDI(J)=TDI(J)+SGN*P(N+NP+ILF+3,J)
|
|
190 CONTINUE
|
|
200 CONTINUE
|
|
TDS=TDI(1)**2+TDI(2)**2+TDI(3)**2
|
|
DO 220 ILG=N+NP+MSTU(44)+MIN(ILC,10)+4,N+NP+MSTU(44)+5,-1
|
|
IF(TDS.LE.P(ILG,4)) GOTO 230
|
|
DO 210 J=1,4
|
|
P(ILG+1,J)=P(ILG,J)
|
|
210 CONTINUE
|
|
220 CONTINUE
|
|
ILG=N+NP+MSTU(44)+4
|
|
230 DO 240 J=1,3
|
|
P(ILG+1,J)=TDI(J)
|
|
240 CONTINUE
|
|
P(ILG+1,4)=TDS
|
|
250 CONTINUE
|
|
|
|
C...Iterate direction of axis until stable maximum.
|
|
P(N+NP+ILD,4)=0D0
|
|
ILG=0
|
|
260 ILG=ILG+1
|
|
THP=0D0
|
|
270 THPS=THP
|
|
DO 280 J=1,3
|
|
IF(THP.LE.1D-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J)
|
|
IF(THP.GT.1D-10) TDI(J)=TPR(J)
|
|
TPR(J)=0D0
|
|
280 CONTINUE
|
|
DO 300 I=N+1,N+NP
|
|
SGN=SIGN(P(I,5),TDI(1)*P(I,1)+TDI(2)*P(I,2)+TDI(3)*P(I,3))
|
|
DO 290 J=1,4-ILD
|
|
TPR(J)=TPR(J)+SGN*P(I,J)
|
|
290 CONTINUE
|
|
300 CONTINUE
|
|
THP=SQRT(TPR(1)**2+TPR(2)**2+TPR(3)**2)/PS
|
|
IF(THP.GE.THPS+PARU(48)) GOTO 270
|
|
|
|
C...Save good axis. Try new initial axis until a number of tries agree.
|
|
IF(THP.LT.P(N+NP+ILD,4)-PARU(48).AND.ILG.LT.MIN(10,NC)) GOTO 260
|
|
IF(THP.GT.P(N+NP+ILD,4)+PARU(48)) THEN
|
|
IAGR=0
|
|
SGN=(-1D0)**INT(PYR(0)+0.5D0)
|
|
DO 310 J=1,3
|
|
P(N+NP+ILD,J)=SGN*TPR(J)/(PS*THP)
|
|
310 CONTINUE
|
|
P(N+NP+ILD,4)=THP
|
|
P(N+NP+ILD,5)=0D0
|
|
ENDIF
|
|
IAGR=IAGR+1
|
|
IF(IAGR.LT.MSTU(45).AND.ILG.LT.MIN(10,NC)) GOTO 260
|
|
320 CONTINUE
|
|
|
|
C...Find minor axis and value by orthogonality.
|
|
SGN=(-1D0)**INT(PYR(0)+0.5D0)
|
|
P(N+NP+3,1)=-SGN*P(N+NP+2,2)
|
|
P(N+NP+3,2)=SGN*P(N+NP+2,1)
|
|
P(N+NP+3,3)=0D0
|
|
THP=0D0
|
|
DO 330 I=N+1,N+NP
|
|
THP=THP+P(I,5)*ABS(P(N+NP+3,1)*P(I,1)+P(N+NP+3,2)*P(I,2))
|
|
330 CONTINUE
|
|
P(N+NP+3,4)=THP/PS
|
|
P(N+NP+3,5)=0D0
|
|
|
|
C...Fill axis information. Rotate back to original coordinate system.
|
|
DO 350 ILD=1,3
|
|
K(N+ILD,1)=31
|
|
K(N+ILD,2)=96
|
|
K(N+ILD,3)=ILD
|
|
K(N+ILD,4)=0
|
|
K(N+ILD,5)=0
|
|
DO 340 J=1,5
|
|
P(N+ILD,J)=P(N+NP+ILD,J)
|
|
V(N+ILD,J)=0D0
|
|
340 CONTINUE
|
|
350 CONTINUE
|
|
CALL PYROBO(N+1,N+3,THE,PHI,0D0,0D0,0D0)
|
|
|
|
C...Calculate thrust and oblateness. Select storing option.
|
|
THR=P(N+1,4)
|
|
OBL=P(N+2,4)-P(N+3,4)
|
|
MSTU(61)=N+1
|
|
MSTU(62)=NP
|
|
IF(MSTU(43).LE.1) MSTU(3)=3
|
|
IF(MSTU(43).GE.2) N=N+3
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYCLUS
|
|
C...Subdivides the particle content of an event into jets/clusters.
|
|
|
|
SUBROUTINE PYCLUS(NJET)
|
|
|
|
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...Local arrays and saved variables.
|
|
DIMENSION PS(5)
|
|
SAVE NSAV,NP,PS,PSS,RINIT,NPRE,NREM
|
|
|
|
C...Functions: distance measure in pT, (pseudo)mass or Durham pT.
|
|
R2T(I1,I2)=(P(I1,5)*P(I2,5)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-
|
|
&P(I1,3)*P(I2,3))*2D0*P(I1,5)*P(I2,5)/(0.0001D0+P(I1,5)+P(I2,5))**2
|
|
R2M(I1,I2)=2D0*P(I1,4)*P(I2,4)*(1D0-(P(I1,1)*P(I2,1)+P(I1,2)*
|
|
&P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5)))
|
|
R2D(I1,I2)=2D0*MIN(P(I1,4),P(I2,4))**2*(1D0-(P(I1,1)*P(I2,1)+
|
|
&P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5)))
|
|
|
|
C...If first time, reset. If reentering, skip preliminaries.
|
|
IF(MSTU(48).LE.0) THEN
|
|
NP=0
|
|
DO 100 J=1,5
|
|
PS(J)=0D0
|
|
100 CONTINUE
|
|
PSS=0D0
|
|
PIMASS=PMAS(PYCOMP(211),1)
|
|
ELSE
|
|
NJET=NSAV
|
|
IF(MSTU(43).GE.2) N=N-NJET
|
|
DO 110 I=N+1,N+NJET
|
|
P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
110 CONTINUE
|
|
IF(MSTU(46).LE.3.OR.MSTU(46).EQ.5) THEN
|
|
R2ACC=PARU(44)**2
|
|
ELSE
|
|
R2ACC=PARU(45)*PS(5)**2
|
|
ENDIF
|
|
NLOOP=0
|
|
GOTO 300
|
|
ENDIF
|
|
|
|
C...Find which particles are to be considered in cluster search.
|
|
DO 140 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 140
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0)
|
|
& GOTO 140
|
|
ENDIF
|
|
IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYCLUS:) no more memory left in PYJETS')
|
|
NJET=-1
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Take copy of these particles, with space left for jets later on.
|
|
NP=NP+1
|
|
K(N+NP,3)=I
|
|
DO 120 J=1,5
|
|
P(N+NP,J)=P(I,J)
|
|
120 CONTINUE
|
|
IF(MSTU(42).EQ.0) P(N+NP,5)=0D0
|
|
IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PIMASS
|
|
P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
P(N+NP,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
DO 130 J=1,4
|
|
PS(J)=PS(J)+P(N+NP,J)
|
|
130 CONTINUE
|
|
PSS=PSS+P(N+NP,5)
|
|
140 CONTINUE
|
|
DO 160 I=N+1,N+NP
|
|
K(I+NP,3)=K(I,3)
|
|
DO 150 J=1,5
|
|
P(I+NP,J)=P(I,J)
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
PS(5)=SQRT(MAX(0D0,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))
|
|
|
|
C...Very low multiplicities not considered.
|
|
IF(NP.LT.MSTU(47)) THEN
|
|
CALL PYERRM(8,'(PYCLUS:) too few particles for analysis')
|
|
NJET=-1
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Find precluster configuration. If too few jets, make harder cuts.
|
|
NLOOP=0
|
|
IF(MSTU(46).LE.3.OR.MSTU(46).EQ.5) THEN
|
|
R2ACC=PARU(44)**2
|
|
ELSE
|
|
R2ACC=PARU(45)*PS(5)**2
|
|
ENDIF
|
|
RINIT=1.25D0*PARU(43)
|
|
IF(NP.LE.MSTU(47)+2) RINIT=0D0
|
|
170 RINIT=0.8D0*RINIT
|
|
NPRE=0
|
|
NREM=NP
|
|
DO 180 I=N+NP+1,N+2*NP
|
|
K(I,4)=0
|
|
180 CONTINUE
|
|
|
|
C...Sum up small momentum region. Jet if enough absolute momentum.
|
|
IF(MSTU(46).LE.2) THEN
|
|
DO 190 J=1,4
|
|
P(N+1,J)=0D0
|
|
190 CONTINUE
|
|
DO 210 I=N+NP+1,N+2*NP
|
|
IF(P(I,5).GT.2D0*RINIT) GOTO 210
|
|
NREM=NREM-1
|
|
K(I,4)=1
|
|
DO 200 J=1,4
|
|
P(N+1,J)=P(N+1,J)+P(I,J)
|
|
200 CONTINUE
|
|
210 CONTINUE
|
|
P(N+1,5)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2)
|
|
IF(P(N+1,5).GT.2D0*RINIT) NPRE=1
|
|
IF(RINIT.GE.0.2D0*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170
|
|
IF(NREM.EQ.0) GOTO 170
|
|
ENDIF
|
|
|
|
C...Find fastest remaining particle.
|
|
220 NPRE=NPRE+1
|
|
PMAX=0D0
|
|
DO 230 I=N+NP+1,N+2*NP
|
|
IF(K(I,4).NE.0.OR.P(I,5).LE.PMAX) GOTO 230
|
|
IMAX=I
|
|
PMAX=P(I,5)
|
|
230 CONTINUE
|
|
DO 240 J=1,5
|
|
P(N+NPRE,J)=P(IMAX,J)
|
|
240 CONTINUE
|
|
NREM=NREM-1
|
|
K(IMAX,4)=NPRE
|
|
|
|
C...Sum up precluster around it according to pT separation.
|
|
IF(MSTU(46).LE.2) THEN
|
|
DO 260 I=N+NP+1,N+2*NP
|
|
IF(K(I,4).NE.0) GOTO 260
|
|
R2=R2T(I,IMAX)
|
|
IF(R2.GT.RINIT**2) GOTO 260
|
|
NREM=NREM-1
|
|
K(I,4)=NPRE
|
|
DO 250 J=1,4
|
|
P(N+NPRE,J)=P(N+NPRE,J)+P(I,J)
|
|
250 CONTINUE
|
|
260 CONTINUE
|
|
P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2)
|
|
|
|
C...Sum up precluster around it according to mass or
|
|
C...Durham pT separation.
|
|
ELSE
|
|
270 IMIN=0
|
|
R2MIN=RINIT**2
|
|
DO 280 I=N+NP+1,N+2*NP
|
|
IF(K(I,4).NE.0) GOTO 280
|
|
IF(MSTU(46).LE.4) THEN
|
|
R2=R2M(I,N+NPRE)
|
|
ELSE
|
|
R2=R2D(I,N+NPRE)
|
|
ENDIF
|
|
IF(R2.GE.R2MIN) GOTO 280
|
|
IMIN=I
|
|
R2MIN=R2
|
|
280 CONTINUE
|
|
IF(IMIN.NE.0) THEN
|
|
DO 290 J=1,4
|
|
P(N+NPRE,J)=P(N+NPRE,J)+P(IMIN,J)
|
|
290 CONTINUE
|
|
P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2)
|
|
NREM=NREM-1
|
|
K(IMIN,4)=NPRE
|
|
GOTO 270
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Check if more preclusters to be found. Start over if too few.
|
|
IF(RINIT.GE.0.2D0*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170
|
|
IF(NREM.GT.0) GOTO 220
|
|
NJET=NPRE
|
|
|
|
C...Reassign all particles to nearest jet. Sum up new jet momenta.
|
|
300 TSAV=0D0
|
|
PSJT=0D0
|
|
310 IF(MSTU(46).LE.1) THEN
|
|
DO 330 I=N+1,N+NJET
|
|
DO 320 J=1,4
|
|
V(I,J)=0D0
|
|
320 CONTINUE
|
|
330 CONTINUE
|
|
DO 360 I=N+NP+1,N+2*NP
|
|
R2MIN=PSS**2
|
|
DO 340 IJET=N+1,N+NJET
|
|
IF(P(IJET,5).LT.RINIT) GOTO 340
|
|
R2=R2T(I,IJET)
|
|
IF(R2.GE.R2MIN) GOTO 340
|
|
IMIN=IJET
|
|
R2MIN=R2
|
|
340 CONTINUE
|
|
K(I,4)=IMIN-N
|
|
DO 350 J=1,4
|
|
V(IMIN,J)=V(IMIN,J)+P(I,J)
|
|
350 CONTINUE
|
|
360 CONTINUE
|
|
PSJT=0D0
|
|
DO 380 I=N+1,N+NJET
|
|
DO 370 J=1,4
|
|
P(I,J)=V(I,J)
|
|
370 CONTINUE
|
|
P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
PSJT=PSJT+P(I,5)
|
|
380 CONTINUE
|
|
ENDIF
|
|
|
|
C...Find two closest jets.
|
|
R2MIN=2D0*MAX(R2ACC,PS(5)**2)
|
|
DO 400 ITRY1=N+1,N+NJET-1
|
|
DO 390 ITRY2=ITRY1+1,N+NJET
|
|
IF(MSTU(46).LE.2) THEN
|
|
R2=R2T(ITRY1,ITRY2)
|
|
ELSEIF(MSTU(46).LE.4) THEN
|
|
R2=R2M(ITRY1,ITRY2)
|
|
ELSE
|
|
R2=R2D(ITRY1,ITRY2)
|
|
ENDIF
|
|
IF(R2.GE.R2MIN) GOTO 390
|
|
IMIN1=ITRY1
|
|
IMIN2=ITRY2
|
|
R2MIN=R2
|
|
390 CONTINUE
|
|
400 CONTINUE
|
|
|
|
C...If allowed, join two closest jets and start over.
|
|
IF(NJET.GT.MSTU(47).AND.R2MIN.LT.R2ACC) THEN
|
|
IREC=MIN(IMIN1,IMIN2)
|
|
IDEL=MAX(IMIN1,IMIN2)
|
|
DO 410 J=1,4
|
|
P(IREC,J)=P(IMIN1,J)+P(IMIN2,J)
|
|
410 CONTINUE
|
|
P(IREC,5)=SQRT(P(IREC,1)**2+P(IREC,2)**2+P(IREC,3)**2)
|
|
DO 430 I=IDEL+1,N+NJET
|
|
DO 420 J=1,5
|
|
P(I-1,J)=P(I,J)
|
|
420 CONTINUE
|
|
430 CONTINUE
|
|
IF(MSTU(46).GE.2) THEN
|
|
DO 440 I=N+NP+1,N+2*NP
|
|
IORI=N+K(I,4)
|
|
IF(IORI.EQ.IDEL) K(I,4)=IREC-N
|
|
IF(IORI.GT.IDEL) K(I,4)=K(I,4)-1
|
|
440 CONTINUE
|
|
ENDIF
|
|
NJET=NJET-1
|
|
GOTO 300
|
|
|
|
C...Divide up broad jet if empty cluster in list of final ones.
|
|
ELSEIF(NJET.EQ.MSTU(47).AND.MSTU(46).LE.1.AND.NLOOP.LE.2) THEN
|
|
DO 450 I=N+1,N+NJET
|
|
K(I,5)=0
|
|
450 CONTINUE
|
|
DO 460 I=N+NP+1,N+2*NP
|
|
K(N+K(I,4),5)=K(N+K(I,4),5)+1
|
|
460 CONTINUE
|
|
IEMP=0
|
|
DO 470 I=N+1,N+NJET
|
|
IF(K(I,5).EQ.0) IEMP=I
|
|
470 CONTINUE
|
|
IF(IEMP.NE.0) THEN
|
|
NLOOP=NLOOP+1
|
|
ISPL=0
|
|
R2MAX=0D0
|
|
DO 480 I=N+NP+1,N+2*NP
|
|
IF(K(N+K(I,4),5).LE.1.OR.P(I,5).LT.RINIT) GOTO 480
|
|
IJET=N+K(I,4)
|
|
R2=R2T(I,IJET)
|
|
IF(R2.LE.R2MAX) GOTO 480
|
|
ISPL=I
|
|
R2MAX=R2
|
|
480 CONTINUE
|
|
IF(ISPL.NE.0) THEN
|
|
IJET=N+K(ISPL,4)
|
|
DO 490 J=1,4
|
|
P(IEMP,J)=P(ISPL,J)
|
|
P(IJET,J)=P(IJET,J)-P(ISPL,J)
|
|
490 CONTINUE
|
|
P(IEMP,5)=P(ISPL,5)
|
|
P(IJET,5)=SQRT(P(IJET,1)**2+P(IJET,2)**2+P(IJET,3)**2)
|
|
IF(NLOOP.LE.2) GOTO 300
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...If generalized thrust has not yet converged, continue iteration.
|
|
IF(MSTU(46).LE.1.AND.NLOOP.LE.2.AND.PSJT/PSS.GT.TSAV+PARU(48))
|
|
&THEN
|
|
TSAV=PSJT/PSS
|
|
GOTO 310
|
|
ENDIF
|
|
|
|
C...Reorder jets according to energy.
|
|
DO 510 I=N+1,N+NJET
|
|
DO 500 J=1,5
|
|
V(I,J)=P(I,J)
|
|
500 CONTINUE
|
|
510 CONTINUE
|
|
DO 540 INEW=N+1,N+NJET
|
|
PEMAX=0D0
|
|
DO 520 ITRY=N+1,N+NJET
|
|
IF(V(ITRY,4).LE.PEMAX) GOTO 520
|
|
IMAX=ITRY
|
|
PEMAX=V(ITRY,4)
|
|
520 CONTINUE
|
|
K(INEW,1)=31
|
|
K(INEW,2)=97
|
|
K(INEW,3)=INEW-N
|
|
K(INEW,4)=0
|
|
DO 530 J=1,5
|
|
P(INEW,J)=V(IMAX,J)
|
|
530 CONTINUE
|
|
V(IMAX,4)=-1D0
|
|
K(IMAX,5)=INEW
|
|
540 CONTINUE
|
|
|
|
C...Clean up particle-jet assignments and jet information.
|
|
DO 550 I=N+NP+1,N+2*NP
|
|
IORI=K(N+K(I,4),5)
|
|
K(I,4)=IORI-N
|
|
IF(K(K(I,3),1).NE.3) K(K(I,3),4)=IORI-N
|
|
K(IORI,4)=K(IORI,4)+1
|
|
550 CONTINUE
|
|
IEMP=0
|
|
PSJT=0D0
|
|
DO 570 I=N+1,N+NJET
|
|
K(I,5)=0
|
|
PSJT=PSJT+P(I,5)
|
|
P(I,5)=SQRT(MAX(P(I,4)**2-P(I,5)**2,0D0))
|
|
DO 560 J=1,5
|
|
V(I,J)=0D0
|
|
560 CONTINUE
|
|
IF(K(I,4).EQ.0) IEMP=I
|
|
570 CONTINUE
|
|
|
|
C...Select storing option. Output variables. Check for failure.
|
|
MSTU(61)=N+1
|
|
MSTU(62)=NP
|
|
MSTU(63)=NPRE
|
|
PARU(61)=PS(5)
|
|
PARU(62)=PSJT/PSS
|
|
PARU(63)=SQRT(R2MIN)
|
|
IF(NJET.LE.1) PARU(63)=0D0
|
|
IF(IEMP.NE.0) THEN
|
|
CALL PYERRM(8,'(PYCLUS:) failed to reconstruct as requested')
|
|
NJET=-1
|
|
ENDIF
|
|
IF(MSTU(43).LE.1) MSTU(3)=NJET
|
|
IF(MSTU(43).GE.2) N=N+NJET
|
|
NSAV=NJET
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYCELL
|
|
C...Provides a simple way of jet finding in eta-phi-ET coordinates,
|
|
C...as used for calorimeters at hadron colliders.
|
|
|
|
SUBROUTINE PYCELL(NJET)
|
|
|
|
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...Loop over all particles. Find cell that was hit by given particle.
|
|
PTLRAT=1D0/SINH(PARU(51))**2
|
|
NP=0
|
|
NC=N
|
|
DO 110 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110
|
|
IF(P(I,1)**2+P(I,2)**2.LE.PTLRAT*P(I,3)**2) GOTO 110
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 110
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0)
|
|
& GOTO 110
|
|
ENDIF
|
|
NP=NP+1
|
|
PT=SQRT(P(I,1)**2+P(I,2)**2)
|
|
ETA=SIGN(LOG((SQRT(PT**2+P(I,3)**2)+ABS(P(I,3)))/PT),P(I,3))
|
|
IETA=MAX(1,MIN(MSTU(51),1+INT(MSTU(51)*0.5D0*
|
|
& (ETA/PARU(51)+1D0))))
|
|
PHI=PYANGL(P(I,1),P(I,2))
|
|
IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5D0*
|
|
& (PHI/PARU(1)+1D0))))
|
|
IETPH=MSTU(52)*IETA+IPHI
|
|
|
|
C...Add to cell already hit, or book new cell.
|
|
DO 100 IC=N+1,NC
|
|
IF(IETPH.EQ.K(IC,3)) THEN
|
|
K(IC,4)=K(IC,4)+1
|
|
P(IC,5)=P(IC,5)+PT
|
|
GOTO 110
|
|
ENDIF
|
|
100 CONTINUE
|
|
IF(NC.GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYCELL:) no more memory left in PYJETS')
|
|
NJET=-2
|
|
RETURN
|
|
ENDIF
|
|
NC=NC+1
|
|
K(NC,3)=IETPH
|
|
K(NC,4)=1
|
|
K(NC,5)=2
|
|
P(NC,1)=(PARU(51)/MSTU(51))*(2*IETA-1-MSTU(51))
|
|
P(NC,2)=(PARU(1)/MSTU(52))*(2*IPHI-1-MSTU(52))
|
|
P(NC,5)=PT
|
|
110 CONTINUE
|
|
|
|
C...Smear true bin content by calorimeter resolution.
|
|
IF(MSTU(53).GE.1) THEN
|
|
DO 130 IC=N+1,NC
|
|
PEI=P(IC,5)
|
|
IF(MSTU(53).EQ.2) PEI=P(IC,5)*COSH(P(IC,1))
|
|
120 PEF=PEI+PARU(55)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0)))*PEI)*
|
|
& COS(PARU(2)*PYR(0))
|
|
IF(PEF.LT.0D0.OR.PEF.GT.PARU(56)*PEI) GOTO 120
|
|
P(IC,5)=PEF
|
|
IF(MSTU(53).EQ.2) P(IC,5)=PEF/COSH(P(IC,1))
|
|
130 CONTINUE
|
|
ENDIF
|
|
|
|
C...Remove cells below threshold.
|
|
IF(PARU(58).GT.0D0) THEN
|
|
NCC=NC
|
|
NC=N
|
|
DO 140 IC=N+1,NCC
|
|
IF(P(IC,5).GT.PARU(58)) THEN
|
|
NC=NC+1
|
|
K(NC,3)=K(IC,3)
|
|
K(NC,4)=K(IC,4)
|
|
K(NC,5)=K(IC,5)
|
|
P(NC,1)=P(IC,1)
|
|
P(NC,2)=P(IC,2)
|
|
P(NC,5)=P(IC,5)
|
|
ENDIF
|
|
140 CONTINUE
|
|
ENDIF
|
|
|
|
C...Find initiator cell: the one with highest pT of not yet used ones.
|
|
NJ=NC
|
|
150 ETMAX=0D0
|
|
DO 160 IC=N+1,NC
|
|
IF(K(IC,5).NE.2) GOTO 160
|
|
IF(P(IC,5).LE.ETMAX) GOTO 160
|
|
ICMAX=IC
|
|
ETA=P(IC,1)
|
|
PHI=P(IC,2)
|
|
ETMAX=P(IC,5)
|
|
160 CONTINUE
|
|
IF(ETMAX.LT.PARU(52)) GOTO 220
|
|
IF(NJ.GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYCELL:) no more memory left in PYJETS')
|
|
NJET=-2
|
|
RETURN
|
|
ENDIF
|
|
K(ICMAX,5)=1
|
|
NJ=NJ+1
|
|
K(NJ,4)=0
|
|
K(NJ,5)=1
|
|
P(NJ,1)=ETA
|
|
P(NJ,2)=PHI
|
|
P(NJ,3)=0D0
|
|
P(NJ,4)=0D0
|
|
P(NJ,5)=0D0
|
|
|
|
C...Sum up unused cells within required distance of initiator.
|
|
DO 170 IC=N+1,NC
|
|
IF(K(IC,5).EQ.0) GOTO 170
|
|
IF(ABS(P(IC,1)-ETA).GT.PARU(54)) GOTO 170
|
|
DPHIA=ABS(P(IC,2)-PHI)
|
|
IF(DPHIA.GT.PARU(54).AND.DPHIA.LT.PARU(2)-PARU(54)) GOTO 170
|
|
PHIC=P(IC,2)
|
|
IF(DPHIA.GT.PARU(1)) PHIC=PHIC+SIGN(PARU(2),PHI)
|
|
IF((P(IC,1)-ETA)**2+(PHIC-PHI)**2.GT.PARU(54)**2) GOTO 170
|
|
K(IC,5)=-K(IC,5)
|
|
K(NJ,4)=K(NJ,4)+K(IC,4)
|
|
P(NJ,3)=P(NJ,3)+P(IC,5)*P(IC,1)
|
|
P(NJ,4)=P(NJ,4)+P(IC,5)*PHIC
|
|
P(NJ,5)=P(NJ,5)+P(IC,5)
|
|
170 CONTINUE
|
|
|
|
C...Reject cluster below minimum ET, else accept.
|
|
IF(P(NJ,5).LT.PARU(53)) THEN
|
|
NJ=NJ-1
|
|
DO 180 IC=N+1,NC
|
|
IF(K(IC,5).LT.0) K(IC,5)=-K(IC,5)
|
|
180 CONTINUE
|
|
ELSEIF(MSTU(54).LE.2) THEN
|
|
P(NJ,3)=P(NJ,3)/P(NJ,5)
|
|
P(NJ,4)=P(NJ,4)/P(NJ,5)
|
|
IF(ABS(P(NJ,4)).GT.PARU(1)) P(NJ,4)=P(NJ,4)-SIGN(PARU(2),
|
|
& P(NJ,4))
|
|
DO 190 IC=N+1,NC
|
|
IF(K(IC,5).LT.0) K(IC,5)=0
|
|
190 CONTINUE
|
|
ELSE
|
|
DO 200 J=1,4
|
|
P(NJ,J)=0D0
|
|
200 CONTINUE
|
|
DO 210 IC=N+1,NC
|
|
IF(K(IC,5).GE.0) GOTO 210
|
|
P(NJ,1)=P(NJ,1)+P(IC,5)*COS(P(IC,2))
|
|
P(NJ,2)=P(NJ,2)+P(IC,5)*SIN(P(IC,2))
|
|
P(NJ,3)=P(NJ,3)+P(IC,5)*SINH(P(IC,1))
|
|
P(NJ,4)=P(NJ,4)+P(IC,5)*COSH(P(IC,1))
|
|
K(IC,5)=0
|
|
210 CONTINUE
|
|
ENDIF
|
|
GOTO 150
|
|
|
|
C...Arrange clusters in falling ET sequence.
|
|
220 DO 250 I=1,NJ-NC
|
|
ETMAX=0D0
|
|
DO 230 IJ=NC+1,NJ
|
|
IF(K(IJ,5).EQ.0) GOTO 230
|
|
IF(P(IJ,5).LT.ETMAX) GOTO 230
|
|
IJMAX=IJ
|
|
ETMAX=P(IJ,5)
|
|
230 CONTINUE
|
|
K(IJMAX,5)=0
|
|
K(N+I,1)=31
|
|
K(N+I,2)=98
|
|
K(N+I,3)=I
|
|
K(N+I,4)=K(IJMAX,4)
|
|
K(N+I,5)=0
|
|
DO 240 J=1,5
|
|
P(N+I,J)=P(IJMAX,J)
|
|
V(N+I,J)=0D0
|
|
240 CONTINUE
|
|
250 CONTINUE
|
|
NJET=NJ-NC
|
|
|
|
C...Convert to massless or massive four-vectors.
|
|
IF(MSTU(54).EQ.2) THEN
|
|
DO 260 I=N+1,N+NJET
|
|
ETA=P(I,3)
|
|
P(I,1)=P(I,5)*COS(P(I,4))
|
|
P(I,2)=P(I,5)*SIN(P(I,4))
|
|
P(I,3)=P(I,5)*SINH(ETA)
|
|
P(I,4)=P(I,5)*COSH(ETA)
|
|
P(I,5)=0D0
|
|
260 CONTINUE
|
|
ELSEIF(MSTU(54).GE.3) THEN
|
|
DO 270 I=N+1,N+NJET
|
|
P(I,5)=SQRT(MAX(0D0,P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2))
|
|
270 CONTINUE
|
|
ENDIF
|
|
|
|
C...Information about storage.
|
|
MSTU(61)=N+1
|
|
MSTU(62)=NP
|
|
MSTU(63)=NC-N
|
|
IF(MSTU(43).LE.1) MSTU(3)=NJET
|
|
IF(MSTU(43).GE.2) N=N+NJET
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYJMAS
|
|
C...Determines, approximately, the two jet masses that minimize
|
|
C...the sum m_H^2 + m_L^2, a la Clavelli and Wyler.
|
|
|
|
SUBROUTINE PYJMAS(PMH,PML)
|
|
|
|
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...Local arrays.
|
|
DIMENSION SM(3,3),SAX(3),PS(3,5)
|
|
|
|
C...Reset.
|
|
NP=0
|
|
DO 120 J1=1,3
|
|
DO 100 J2=J1,3
|
|
SM(J1,J2)=0D0
|
|
100 CONTINUE
|
|
DO 110 J2=1,4
|
|
PS(J1,J2)=0D0
|
|
110 CONTINUE
|
|
120 CONTINUE
|
|
PSS=0D0
|
|
PIMASS=PMAS(PYCOMP(211),1)
|
|
|
|
C...Take copy of particles that are to be considered in mass analysis.
|
|
DO 170 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 170
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0)
|
|
& GOTO 170
|
|
ENDIF
|
|
IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYJMAS:) no more memory left in PYJETS')
|
|
PMH=-2D0
|
|
PML=-2D0
|
|
RETURN
|
|
ENDIF
|
|
NP=NP+1
|
|
DO 130 J=1,5
|
|
P(N+NP,J)=P(I,J)
|
|
130 CONTINUE
|
|
IF(MSTU(42).EQ.0) P(N+NP,5)=0D0
|
|
IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PIMASS
|
|
P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
|
|
C...Fill information in sphericity tensor and total momentum vector.
|
|
DO 150 J1=1,3
|
|
DO 140 J2=J1,3
|
|
SM(J1,J2)=SM(J1,J2)+P(I,J1)*P(I,J2)
|
|
140 CONTINUE
|
|
150 CONTINUE
|
|
PSS=PSS+(P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
DO 160 J=1,4
|
|
PS(3,J)=PS(3,J)+P(N+NP,J)
|
|
160 CONTINUE
|
|
170 CONTINUE
|
|
|
|
C...Very low multiplicities (0 or 1) not considered.
|
|
IF(NP.LE.1) THEN
|
|
CALL PYERRM(8,'(PYJMAS:) too few particles for analysis')
|
|
PMH=-1D0
|
|
PML=-1D0
|
|
RETURN
|
|
ENDIF
|
|
PARU(61)=SQRT(MAX(0D0,PS(3,4)**2-PS(3,1)**2-PS(3,2)**2-
|
|
&PS(3,3)**2))
|
|
|
|
C...Find largest eigenvalue to matrix (third degree equation).
|
|
DO 190 J1=1,3
|
|
DO 180 J2=J1,3
|
|
SM(J1,J2)=SM(J1,J2)/PSS
|
|
180 CONTINUE
|
|
190 CONTINUE
|
|
SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-
|
|
&SM(1,2)**2-SM(1,3)**2-SM(2,3)**2)/3D0-1D0/9D0
|
|
SR=-0.5D0*(SQ+1D0/9D0+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+
|
|
&SM(3,3)*SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+
|
|
&SM(1,2)*SM(1,3)*SM(2,3)+1D0/27D0
|
|
SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1D0),-1D0))/3D0)
|
|
SMA=1D0/3D0+SQRT(-SQ)*MAX(2D0*SP,SQRT(3D0*(1D0-SP**2))-SP)
|
|
|
|
C...Find largest eigenvector by solving equation system.
|
|
DO 210 J1=1,3
|
|
SM(J1,J1)=SM(J1,J1)-SMA
|
|
DO 200 J2=J1+1,3
|
|
SM(J2,J1)=SM(J1,J2)
|
|
200 CONTINUE
|
|
210 CONTINUE
|
|
SMAX=0D0
|
|
DO 230 J1=1,3
|
|
DO 220 J2=1,3
|
|
IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 220
|
|
JA=J1
|
|
JB=J2
|
|
SMAX=ABS(SM(J1,J2))
|
|
220 CONTINUE
|
|
230 CONTINUE
|
|
SMAX=0D0
|
|
DO 250 J3=JA+1,JA+2
|
|
J1=J3-3*((J3-1)/3)
|
|
RL=SM(J1,JB)/SM(JA,JB)
|
|
DO 240 J2=1,3
|
|
SM(J1,J2)=SM(J1,J2)-RL*SM(JA,J2)
|
|
IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 240
|
|
JC=J1
|
|
SMAX=ABS(SM(J1,J2))
|
|
240 CONTINUE
|
|
250 CONTINUE
|
|
JB1=JB+1-3*(JB/3)
|
|
JB2=JB+2-3*((JB+1)/3)
|
|
SAX(JB1)=-SM(JC,JB2)
|
|
SAX(JB2)=SM(JC,JB1)
|
|
SAX(JB)=-(SM(JA,JB1)*SAX(JB1)+SM(JA,JB2)*SAX(JB2))/SM(JA,JB)
|
|
|
|
C...Divide particles into two initial clusters by hemisphere.
|
|
DO 270 I=N+1,N+NP
|
|
PSAX=P(I,1)*SAX(1)+P(I,2)*SAX(2)+P(I,3)*SAX(3)
|
|
IS=1
|
|
IF(PSAX.LT.0D0) IS=2
|
|
K(I,3)=IS
|
|
DO 260 J=1,4
|
|
PS(IS,J)=PS(IS,J)+P(I,J)
|
|
260 CONTINUE
|
|
270 CONTINUE
|
|
PMS=MAX(1D-10,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+
|
|
&MAX(1D-10,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2)
|
|
|
|
C...Reassign one particle at a time; find maximum decrease of m^2 sum.
|
|
280 PMD=0D0
|
|
IM=0
|
|
DO 290 J=1,4
|
|
PS(3,J)=PS(1,J)-PS(2,J)
|
|
290 CONTINUE
|
|
DO 300 I=N+1,N+NP
|
|
PPS=P(I,4)*PS(3,4)-P(I,1)*PS(3,1)-P(I,2)*PS(3,2)-P(I,3)*PS(3,3)
|
|
IF(K(I,3).EQ.1) PMDI=2D0*(P(I,5)**2-PPS)
|
|
IF(K(I,3).EQ.2) PMDI=2D0*(P(I,5)**2+PPS)
|
|
IF(PMDI.LT.PMD) THEN
|
|
PMD=PMDI
|
|
IM=I
|
|
ENDIF
|
|
300 CONTINUE
|
|
|
|
C...Loop back if significant reduction in sum of m^2.
|
|
IF(PMD.LT.-PARU(48)*PMS) THEN
|
|
PMS=PMS+PMD
|
|
IS=K(IM,3)
|
|
DO 310 J=1,4
|
|
PS(IS,J)=PS(IS,J)-P(IM,J)
|
|
PS(3-IS,J)=PS(3-IS,J)+P(IM,J)
|
|
310 CONTINUE
|
|
K(IM,3)=3-IS
|
|
GOTO 280
|
|
ENDIF
|
|
|
|
C...Final masses and output.
|
|
MSTU(61)=N+1
|
|
MSTU(62)=NP
|
|
PS(1,5)=SQRT(MAX(0D0,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2))
|
|
PS(2,5)=SQRT(MAX(0D0,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2))
|
|
PMH=MAX(PS(1,5),PS(2,5))
|
|
PML=MIN(PS(1,5),PS(2,5))
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYFOWO
|
|
C...Calculates the first few Fox-Wolfram moments.
|
|
|
|
SUBROUTINE PYFOWO(H10,H20,H30,H40)
|
|
|
|
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...Copy momenta for particles and calculate H0.
|
|
NP=0
|
|
H0=0D0
|
|
HD=0D0
|
|
DO 110 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 110
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0)
|
|
& GOTO 110
|
|
ENDIF
|
|
IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN
|
|
CALL PYERRM(11,'(PYFOWO:) no more memory left in PYJETS')
|
|
H10=-1D0
|
|
H20=-1D0
|
|
H30=-1D0
|
|
H40=-1D0
|
|
RETURN
|
|
ENDIF
|
|
NP=NP+1
|
|
DO 100 J=1,3
|
|
P(N+NP,J)=P(I,J)
|
|
100 CONTINUE
|
|
P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
H0=H0+P(N+NP,4)
|
|
HD=HD+P(N+NP,4)**2
|
|
110 CONTINUE
|
|
H0=H0**2
|
|
|
|
C...Very low multiplicities (0 or 1) not considered.
|
|
IF(NP.LE.1) THEN
|
|
CALL PYERRM(8,'(PYFOWO:) too few particles for analysis')
|
|
H10=-1D0
|
|
H20=-1D0
|
|
H30=-1D0
|
|
H40=-1D0
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Calculate H1 - H4.
|
|
H10=0D0
|
|
H20=0D0
|
|
H30=0D0
|
|
H40=0D0
|
|
DO 130 I1=N+1,N+NP
|
|
DO 120 I2=I1+1,N+NP
|
|
CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/
|
|
& (P(I1,4)*P(I2,4))
|
|
H10=H10+P(I1,4)*P(I2,4)*CTHE
|
|
H20=H20+P(I1,4)*P(I2,4)*(1.5D0*CTHE**2-0.5D0)
|
|
H30=H30+P(I1,4)*P(I2,4)*(2.5D0*CTHE**3-1.5D0*CTHE)
|
|
H40=H40+P(I1,4)*P(I2,4)*(4.375D0*CTHE**4-3.75D0*CTHE**2+
|
|
& 0.375D0)
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
|
|
C...Calculate H1/H0 - H4/H0. Output.
|
|
MSTU(61)=N+1
|
|
MSTU(62)=NP
|
|
H10=(HD+2D0*H10)/H0
|
|
H20=(HD+2D0*H20)/H0
|
|
H30=(HD+2D0*H30)/H0
|
|
H40=(HD+2D0*H40)/H0
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYTABU
|
|
C...Evaluates various properties of an event, with statistics
|
|
C...accumulated during the course of the run and
|
|
C...printed at the end.
|
|
|
|
SUBROUTINE PYTABU(MTABU)
|
|
|
|
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)
|
|
SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/
|
|
C...Local arrays, character variables, saved variables and data.
|
|
DIMENSION KFIS(100,2),NPIS(100,0:10),KFFS(400),NPFS(400,4),
|
|
&FEVFM(10,4),FM1FM(3,10,4),FM2FM(3,10,4),FMOMA(4),FMOMS(4),
|
|
&FEVEE(50),FE1EC(50),FE2EC(50),FE1EA(25),FE2EA(25),
|
|
&KFDM(8),KFDC(200,0:8),NPDC(200)
|
|
SAVE NEVIS,NKFIS,KFIS,NPIS,NEVFS,NPRFS,NFIFS,NCHFS,NKFFS,
|
|
&KFFS,NPFS,NEVFM,NMUFM,FM1FM,FM2FM,NEVEE,FE1EC,FE2EC,FE1EA,
|
|
&FE2EA,NEVDC,NKFDC,NREDC,KFDC,NPDC
|
|
CHARACTER CHAU*16,CHIS(2)*12,CHDC(8)*12
|
|
DATA NEVIS/0/,NKFIS/0/,NEVFS/0/,NPRFS/0/,NFIFS/0/,NCHFS/0/,
|
|
&NKFFS/0/,NEVFM/0/,NMUFM/0/,FM1FM/120*0D0/,FM2FM/120*0D0/,
|
|
&NEVEE/0/,FE1EC/50*0D0/,FE2EC/50*0D0/,FE1EA/25*0D0/,FE2EA/25*0D0/,
|
|
&NEVDC/0/,NKFDC/0/,NREDC/0/
|
|
|
|
C...Reset statistics on initial parton state.
|
|
IF(MTABU.EQ.10) THEN
|
|
NEVIS=0
|
|
NKFIS=0
|
|
|
|
C...Identify and order flavour content of initial state.
|
|
ELSEIF(MTABU.EQ.11) THEN
|
|
NEVIS=NEVIS+1
|
|
KFM1=2*IABS(MSTU(161))
|
|
IF(MSTU(161).GT.0) KFM1=KFM1-1
|
|
KFM2=2*IABS(MSTU(162))
|
|
IF(MSTU(162).GT.0) KFM2=KFM2-1
|
|
KFMN=MIN(KFM1,KFM2)
|
|
KFMX=MAX(KFM1,KFM2)
|
|
DO 100 I=1,NKFIS
|
|
IF(KFMN.EQ.KFIS(I,1).AND.KFMX.EQ.KFIS(I,2)) THEN
|
|
IKFIS=-I
|
|
GOTO 110
|
|
ELSEIF(KFMN.LT.KFIS(I,1).OR.(KFMN.EQ.KFIS(I,1).AND.
|
|
& KFMX.LT.KFIS(I,2))) THEN
|
|
IKFIS=I
|
|
GOTO 110
|
|
ENDIF
|
|
100 CONTINUE
|
|
IKFIS=NKFIS+1
|
|
110 IF(IKFIS.LT.0) THEN
|
|
IKFIS=-IKFIS
|
|
ELSE
|
|
IF(NKFIS.GE.100) RETURN
|
|
DO 130 I=NKFIS,IKFIS,-1
|
|
KFIS(I+1,1)=KFIS(I,1)
|
|
KFIS(I+1,2)=KFIS(I,2)
|
|
DO 120 J=0,10
|
|
NPIS(I+1,J)=NPIS(I,J)
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
NKFIS=NKFIS+1
|
|
KFIS(IKFIS,1)=KFMN
|
|
KFIS(IKFIS,2)=KFMX
|
|
DO 140 J=0,10
|
|
NPIS(IKFIS,J)=0
|
|
140 CONTINUE
|
|
ENDIF
|
|
NPIS(IKFIS,0)=NPIS(IKFIS,0)+1
|
|
|
|
C...Count number of partons in initial state.
|
|
NP=0
|
|
DO 160 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.12) THEN
|
|
ELSEIF(IABS(K(I,2)).GT.80.AND.IABS(K(I,2)).LE.100) THEN
|
|
ELSEIF(IABS(K(I,2)).GT.100.AND.MOD(IABS(K(I,2))/10,10).NE.0)
|
|
& THEN
|
|
ELSE
|
|
IM=I
|
|
150 IM=K(IM,3)
|
|
IF(IM.LE.0.OR.IM.GT.N) THEN
|
|
NP=NP+1
|
|
ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN
|
|
NP=NP+1
|
|
ELSEIF(IABS(K(IM,2)).GT.80.AND.IABS(K(IM,2)).LE.100) THEN
|
|
ELSEIF(IABS(K(IM,2)).GT.100.AND.MOD(IABS(K(IM,2))/10,10)
|
|
& .NE.0) THEN
|
|
ELSE
|
|
GOTO 150
|
|
ENDIF
|
|
ENDIF
|
|
160 CONTINUE
|
|
NPCO=MAX(NP,1)
|
|
IF(NP.GE.6) NPCO=6
|
|
IF(NP.GE.8) NPCO=7
|
|
IF(NP.GE.11) NPCO=8
|
|
IF(NP.GE.16) NPCO=9
|
|
IF(NP.GE.26) NPCO=10
|
|
NPIS(IKFIS,NPCO)=NPIS(IKFIS,NPCO)+1
|
|
MSTU(62)=NP
|
|
|
|
C...Write statistics on initial parton state.
|
|
ELSEIF(MTABU.EQ.12) THEN
|
|
FAC=1D0/MAX(1,NEVIS)
|
|
WRITE(MSTU(11),5000) NEVIS
|
|
DO 170 I=1,NKFIS
|
|
KFMN=KFIS(I,1)
|
|
IF(KFMN.EQ.0) KFMN=KFIS(I,2)
|
|
KFM1=(KFMN+1)/2
|
|
IF(2*KFM1.EQ.KFMN) KFM1=-KFM1
|
|
CALL PYNAME(KFM1,CHAU)
|
|
CHIS(1)=CHAU(1:12)
|
|
IF(CHAU(13:13).NE.' ') CHIS(1)(12:12)='?'
|
|
KFMX=KFIS(I,2)
|
|
IF(KFIS(I,1).EQ.0) KFMX=0
|
|
KFM2=(KFMX+1)/2
|
|
IF(2*KFM2.EQ.KFMX) KFM2=-KFM2
|
|
CALL PYNAME(KFM2,CHAU)
|
|
CHIS(2)=CHAU(1:12)
|
|
IF(CHAU(13:13).NE.' ') CHIS(2)(12:12)='?'
|
|
WRITE(MSTU(11),5100) CHIS(1),CHIS(2),FAC*NPIS(I,0),
|
|
& (NPIS(I,J)/DBLE(NPIS(I,0)),J=1,10)
|
|
170 CONTINUE
|
|
|
|
C...Copy statistics on initial parton state into /PYJETS/.
|
|
ELSEIF(MTABU.EQ.13) THEN
|
|
FAC=1D0/MAX(1,NEVIS)
|
|
DO 190 I=1,NKFIS
|
|
KFMN=KFIS(I,1)
|
|
IF(KFMN.EQ.0) KFMN=KFIS(I,2)
|
|
KFM1=(KFMN+1)/2
|
|
IF(2*KFM1.EQ.KFMN) KFM1=-KFM1
|
|
KFMX=KFIS(I,2)
|
|
IF(KFIS(I,1).EQ.0) KFMX=0
|
|
KFM2=(KFMX+1)/2
|
|
IF(2*KFM2.EQ.KFMX) KFM2=-KFM2
|
|
K(I,1)=32
|
|
K(I,2)=99
|
|
K(I,3)=KFM1
|
|
K(I,4)=KFM2
|
|
K(I,5)=NPIS(I,0)
|
|
DO 180 J=1,5
|
|
P(I,J)=FAC*NPIS(I,J)
|
|
V(I,J)=FAC*NPIS(I,J+5)
|
|
180 CONTINUE
|
|
190 CONTINUE
|
|
N=NKFIS
|
|
DO 200 J=1,5
|
|
K(N+1,J)=0
|
|
P(N+1,J)=0D0
|
|
V(N+1,J)=0D0
|
|
200 CONTINUE
|
|
K(N+1,1)=32
|
|
K(N+1,2)=99
|
|
K(N+1,5)=NEVIS
|
|
MSTU(3)=1
|
|
|
|
C...Reset statistics on number of particles/partons.
|
|
ELSEIF(MTABU.EQ.20) THEN
|
|
NEVFS=0
|
|
NPRFS=0
|
|
NFIFS=0
|
|
NCHFS=0
|
|
NKFFS=0
|
|
|
|
C...Identify whether particle/parton is primary or not.
|
|
ELSEIF(MTABU.EQ.21) THEN
|
|
NEVFS=NEVFS+1
|
|
MSTU(62)=0
|
|
DO 260 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,1).EQ.13) GOTO 260
|
|
MSTU(62)=MSTU(62)+1
|
|
KC=PYCOMP(K(I,2))
|
|
MPRI=0
|
|
IF(K(I,3).LE.0.OR.K(I,3).GT.N) THEN
|
|
MPRI=1
|
|
ELSEIF(K(K(I,3),1).LE.0.OR.K(K(I,3),1).GT.20) THEN
|
|
MPRI=1
|
|
ELSEIF(K(K(I,3),2).GE.91.AND.K(K(I,3),2).LE.93) THEN
|
|
MPRI=1
|
|
ELSEIF(KC.EQ.0) THEN
|
|
ELSEIF(K(K(I,3),1).EQ.13) THEN
|
|
IM=K(K(I,3),3)
|
|
IF(IM.LE.0.OR.IM.GT.N) THEN
|
|
MPRI=1
|
|
ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN
|
|
MPRI=1
|
|
ENDIF
|
|
ELSEIF(KCHG(KC,2).EQ.0) THEN
|
|
KCM=PYCOMP(K(K(I,3),2))
|
|
IF(KCM.NE.0) THEN
|
|
IF(KCHG(KCM,2).NE.0) MPRI=1
|
|
ENDIF
|
|
ENDIF
|
|
IF(KC.NE.0.AND.MPRI.EQ.1) THEN
|
|
IF(KCHG(KC,2).EQ.0) NPRFS=NPRFS+1
|
|
ENDIF
|
|
IF(K(I,1).LE.10) THEN
|
|
NFIFS=NFIFS+1
|
|
IF(PYCHGE(K(I,2)).NE.0) NCHFS=NCHFS+1
|
|
ENDIF
|
|
|
|
C...Fill statistics on number of particles/partons in event.
|
|
KFA=IABS(K(I,2))
|
|
KFS=3-ISIGN(1,K(I,2))-MPRI
|
|
DO 210 IP=1,NKFFS
|
|
IF(KFA.EQ.KFFS(IP)) THEN
|
|
IKFFS=-IP
|
|
GOTO 220
|
|
ELSEIF(KFA.LT.KFFS(IP)) THEN
|
|
IKFFS=IP
|
|
GOTO 220
|
|
ENDIF
|
|
210 CONTINUE
|
|
IKFFS=NKFFS+1
|
|
220 IF(IKFFS.LT.0) THEN
|
|
IKFFS=-IKFFS
|
|
ELSE
|
|
IF(NKFFS.GE.400) RETURN
|
|
DO 240 IP=NKFFS,IKFFS,-1
|
|
KFFS(IP+1)=KFFS(IP)
|
|
DO 230 J=1,4
|
|
NPFS(IP+1,J)=NPFS(IP,J)
|
|
230 CONTINUE
|
|
240 CONTINUE
|
|
NKFFS=NKFFS+1
|
|
KFFS(IKFFS)=KFA
|
|
DO 250 J=1,4
|
|
NPFS(IKFFS,J)=0
|
|
250 CONTINUE
|
|
ENDIF
|
|
NPFS(IKFFS,KFS)=NPFS(IKFFS,KFS)+1
|
|
260 CONTINUE
|
|
|
|
C...Write statistics on particle/parton composition of events.
|
|
ELSEIF(MTABU.EQ.22) THEN
|
|
FAC=1D0/MAX(1,NEVFS)
|
|
WRITE(MSTU(11),5200) NEVFS,FAC*NPRFS,FAC*NFIFS,FAC*NCHFS
|
|
DO 270 I=1,NKFFS
|
|
CALL PYNAME(KFFS(I),CHAU)
|
|
KC=PYCOMP(KFFS(I))
|
|
MDCYF=0
|
|
IF(KC.NE.0) MDCYF=MDCY(KC,1)
|
|
WRITE(MSTU(11),5300) KFFS(I),CHAU,MDCYF,(FAC*NPFS(I,J),J=1,4),
|
|
& FAC*(NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4))
|
|
270 CONTINUE
|
|
|
|
C...Copy particle/parton composition information into /PYJETS/.
|
|
ELSEIF(MTABU.EQ.23) THEN
|
|
FAC=1D0/MAX(1,NEVFS)
|
|
DO 290 I=1,NKFFS
|
|
K(I,1)=32
|
|
K(I,2)=99
|
|
K(I,3)=KFFS(I)
|
|
K(I,4)=0
|
|
K(I,5)=NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4)
|
|
DO 280 J=1,4
|
|
P(I,J)=FAC*NPFS(I,J)
|
|
V(I,J)=0D0
|
|
280 CONTINUE
|
|
P(I,5)=FAC*K(I,5)
|
|
V(I,5)=0D0
|
|
290 CONTINUE
|
|
N=NKFFS
|
|
DO 300 J=1,5
|
|
K(N+1,J)=0
|
|
P(N+1,J)=0D0
|
|
V(N+1,J)=0D0
|
|
300 CONTINUE
|
|
K(N+1,1)=32
|
|
K(N+1,2)=99
|
|
K(N+1,5)=NEVFS
|
|
P(N+1,1)=FAC*NPRFS
|
|
P(N+1,2)=FAC*NFIFS
|
|
P(N+1,3)=FAC*NCHFS
|
|
MSTU(3)=1
|
|
|
|
C...Reset factorial moments statistics.
|
|
ELSEIF(MTABU.EQ.30) THEN
|
|
NEVFM=0
|
|
NMUFM=0
|
|
DO 330 IM=1,3
|
|
DO 320 IB=1,10
|
|
DO 310 IP=1,4
|
|
FM1FM(IM,IB,IP)=0D0
|
|
FM2FM(IM,IB,IP)=0D0
|
|
310 CONTINUE
|
|
320 CONTINUE
|
|
330 CONTINUE
|
|
|
|
C...Find particles to include, with (pion,pseudo)rapidity and azimuth.
|
|
ELSEIF(MTABU.EQ.31) THEN
|
|
NEVFM=NEVFM+1
|
|
NLOW=N+MSTU(3)
|
|
NUPP=NLOW
|
|
DO 410 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 410
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 410
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.
|
|
& PYCHGE(K(I,2)).EQ.0) GOTO 410
|
|
ENDIF
|
|
PMR=0D0
|
|
IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=PYMASS(211)
|
|
IF(MSTU(42).GE.2) PMR=P(I,5)
|
|
PR=MAX(1D-20,PMR**2+P(I,1)**2+P(I,2)**2)
|
|
YETA=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR),
|
|
& 1D20)),P(I,3))
|
|
IF(ABS(YETA).GT.PARU(57)) GOTO 410
|
|
PHI=PYANGL(P(I,1),P(I,2))
|
|
IYETA=512D0*(YETA+PARU(57))/(2D0*PARU(57))
|
|
IYETA=MAX(0,MIN(511,IYETA))
|
|
IPHI=512D0*(PHI+PARU(1))/PARU(2)
|
|
IPHI=MAX(0,MIN(511,IPHI))
|
|
IYEP=0
|
|
DO 340 IB=0,9
|
|
IYEP=IYEP+4**IB*(2*MOD(IYETA/2**IB,2)+MOD(IPHI/2**IB,2))
|
|
340 CONTINUE
|
|
|
|
C...Order particles in (pseudo)rapidity and/or azimuth.
|
|
IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN
|
|
CALL PYERRM(11,'(PYTABU:) no more memory left in PYJETS')
|
|
RETURN
|
|
ENDIF
|
|
NUPP=NUPP+1
|
|
IF(NUPP.EQ.NLOW+1) THEN
|
|
K(NUPP,1)=IYETA
|
|
K(NUPP,2)=IPHI
|
|
K(NUPP,3)=IYEP
|
|
ELSE
|
|
DO 350 I1=NUPP-1,NLOW+1,-1
|
|
IF(IYETA.GE.K(I1,1)) GOTO 360
|
|
K(I1+1,1)=K(I1,1)
|
|
350 CONTINUE
|
|
360 K(I1+1,1)=IYETA
|
|
DO 370 I1=NUPP-1,NLOW+1,-1
|
|
IF(IPHI.GE.K(I1,2)) GOTO 380
|
|
K(I1+1,2)=K(I1,2)
|
|
370 CONTINUE
|
|
380 K(I1+1,2)=IPHI
|
|
DO 390 I1=NUPP-1,NLOW+1,-1
|
|
IF(IYEP.GE.K(I1,3)) GOTO 400
|
|
K(I1+1,3)=K(I1,3)
|
|
390 CONTINUE
|
|
400 K(I1+1,3)=IYEP
|
|
ENDIF
|
|
410 CONTINUE
|
|
K(NUPP+1,1)=2**10
|
|
K(NUPP+1,2)=2**10
|
|
K(NUPP+1,3)=4**10
|
|
|
|
C...Calculate sum of factorial moments in event.
|
|
DO 480 IM=1,3
|
|
DO 430 IB=1,10
|
|
DO 420 IP=1,4
|
|
FEVFM(IB,IP)=0D0
|
|
420 CONTINUE
|
|
430 CONTINUE
|
|
DO 450 IB=1,10
|
|
IF(IM.LE.2) IBIN=2**(10-IB)
|
|
IF(IM.EQ.3) IBIN=4**(10-IB)
|
|
IAGR=K(NLOW+1,IM)/IBIN
|
|
NAGR=1
|
|
DO 440 I=NLOW+2,NUPP+1
|
|
ICUT=K(I,IM)/IBIN
|
|
IF(ICUT.EQ.IAGR) THEN
|
|
NAGR=NAGR+1
|
|
ELSE
|
|
IF(NAGR.EQ.1) THEN
|
|
ELSEIF(NAGR.EQ.2) THEN
|
|
FEVFM(IB,1)=FEVFM(IB,1)+2D0
|
|
ELSEIF(NAGR.EQ.3) THEN
|
|
FEVFM(IB,1)=FEVFM(IB,1)+6D0
|
|
FEVFM(IB,2)=FEVFM(IB,2)+6D0
|
|
ELSEIF(NAGR.EQ.4) THEN
|
|
FEVFM(IB,1)=FEVFM(IB,1)+12D0
|
|
FEVFM(IB,2)=FEVFM(IB,2)+24D0
|
|
FEVFM(IB,3)=FEVFM(IB,3)+24D0
|
|
ELSE
|
|
FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1D0)
|
|
FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1D0)*(NAGR-2D0)
|
|
FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1D0)*(NAGR-2D0)*
|
|
& (NAGR-3D0)
|
|
FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1D0)*(NAGR-2D0)*
|
|
& (NAGR-3D0)*(NAGR-4D0)
|
|
ENDIF
|
|
IAGR=ICUT
|
|
NAGR=1
|
|
ENDIF
|
|
440 CONTINUE
|
|
450 CONTINUE
|
|
|
|
C...Add results to total statistics.
|
|
DO 470 IB=10,1,-1
|
|
DO 460 IP=1,4
|
|
IF(FEVFM(1,IP).LT.0.5D0) THEN
|
|
FEVFM(IB,IP)=0D0
|
|
ELSEIF(IM.LE.2) THEN
|
|
FEVFM(IB,IP)=2D0**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP)
|
|
ELSE
|
|
FEVFM(IB,IP)=4D0**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP)
|
|
ENDIF
|
|
FM1FM(IM,IB,IP)=FM1FM(IM,IB,IP)+FEVFM(IB,IP)
|
|
FM2FM(IM,IB,IP)=FM2FM(IM,IB,IP)+FEVFM(IB,IP)**2
|
|
460 CONTINUE
|
|
470 CONTINUE
|
|
480 CONTINUE
|
|
NMUFM=NMUFM+(NUPP-NLOW)
|
|
MSTU(62)=NUPP-NLOW
|
|
|
|
C...Write accumulated statistics on factorial moments.
|
|
ELSEIF(MTABU.EQ.32) THEN
|
|
FAC=1D0/MAX(1,NEVFM)
|
|
IF(MSTU(42).LE.0) WRITE(MSTU(11),5400) NEVFM,'eta'
|
|
IF(MSTU(42).EQ.1) WRITE(MSTU(11),5400) NEVFM,'ypi'
|
|
IF(MSTU(42).GE.2) WRITE(MSTU(11),5400) NEVFM,'y '
|
|
DO 510 IM=1,3
|
|
WRITE(MSTU(11),5500)
|
|
DO 500 IB=1,10
|
|
BYETA=2D0*PARU(57)
|
|
IF(IM.NE.2) BYETA=BYETA/2**(IB-1)
|
|
BPHI=PARU(2)
|
|
IF(IM.NE.1) BPHI=BPHI/2**(IB-1)
|
|
IF(IM.LE.2) BNAVE=FAC*NMUFM/DBLE(2**(IB-1))
|
|
IF(IM.EQ.3) BNAVE=FAC*NMUFM/DBLE(4**(IB-1))
|
|
DO 490 IP=1,4
|
|
FMOMA(IP)=FAC*FM1FM(IM,IB,IP)
|
|
FMOMS(IP)=SQRT(MAX(0D0,FAC*(FAC*FM2FM(IM,IB,IP)-
|
|
& FMOMA(IP)**2)))
|
|
490 CONTINUE
|
|
WRITE(MSTU(11),5600) BYETA,BPHI,BNAVE,(FMOMA(IP),FMOMS(IP),
|
|
& IP=1,4)
|
|
500 CONTINUE
|
|
510 CONTINUE
|
|
|
|
C...Copy statistics on factorial moments into /PYJETS/.
|
|
ELSEIF(MTABU.EQ.33) THEN
|
|
FAC=1D0/MAX(1,NEVFM)
|
|
DO 540 IM=1,3
|
|
DO 530 IB=1,10
|
|
I=10*(IM-1)+IB
|
|
K(I,1)=32
|
|
K(I,2)=99
|
|
K(I,3)=1
|
|
IF(IM.NE.2) K(I,3)=2**(IB-1)
|
|
K(I,4)=1
|
|
IF(IM.NE.1) K(I,4)=2**(IB-1)
|
|
K(I,5)=0
|
|
P(I,1)=2D0*PARU(57)/K(I,3)
|
|
V(I,1)=PARU(2)/K(I,4)
|
|
DO 520 IP=1,4
|
|
P(I,IP+1)=FAC*FM1FM(IM,IB,IP)
|
|
V(I,IP+1)=SQRT(MAX(0D0,FAC*(FAC*FM2FM(IM,IB,IP)-
|
|
& P(I,IP+1)**2)))
|
|
520 CONTINUE
|
|
530 CONTINUE
|
|
540 CONTINUE
|
|
N=30
|
|
DO 550 J=1,5
|
|
K(N+1,J)=0
|
|
P(N+1,J)=0D0
|
|
V(N+1,J)=0D0
|
|
550 CONTINUE
|
|
K(N+1,1)=32
|
|
K(N+1,2)=99
|
|
K(N+1,5)=NEVFM
|
|
MSTU(3)=1
|
|
|
|
C...Reset statistics on Energy-Energy Correlation.
|
|
ELSEIF(MTABU.EQ.40) THEN
|
|
NEVEE=0
|
|
DO 560 J=1,25
|
|
FE1EC(J)=0D0
|
|
FE2EC(J)=0D0
|
|
FE1EC(51-J)=0D0
|
|
FE2EC(51-J)=0D0
|
|
FE1EA(J)=0D0
|
|
FE2EA(J)=0D0
|
|
560 CONTINUE
|
|
|
|
C...Find particles to include, with proper assumed mass.
|
|
ELSEIF(MTABU.EQ.41) THEN
|
|
NEVEE=NEVEE+1
|
|
NLOW=N+MSTU(3)
|
|
NUPP=NLOW
|
|
ECM=0D0
|
|
DO 570 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 570
|
|
IF(MSTU(41).GE.2) THEN
|
|
KC=PYCOMP(K(I,2))
|
|
IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
|
|
& KC.EQ.18) GOTO 570
|
|
IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.
|
|
& PYCHGE(K(I,2)).EQ.0) GOTO 570
|
|
ENDIF
|
|
PMR=0D0
|
|
IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=PYMASS(211)
|
|
IF(MSTU(42).GE.2) PMR=P(I,5)
|
|
IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN
|
|
CALL PYERRM(11,'(PYTABU:) no more memory left in PYJETS')
|
|
RETURN
|
|
ENDIF
|
|
NUPP=NUPP+1
|
|
P(NUPP,1)=P(I,1)
|
|
P(NUPP,2)=P(I,2)
|
|
P(NUPP,3)=P(I,3)
|
|
P(NUPP,4)=SQRT(PMR**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
|
|
P(NUPP,5)=MAX(1D-10,SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2))
|
|
ECM=ECM+P(NUPP,4)
|
|
570 CONTINUE
|
|
IF(NUPP.EQ.NLOW) RETURN
|
|
|
|
C...Analyze Energy-Energy Correlation in event.
|
|
FAC=(2D0/ECM**2)*50D0/PARU(1)
|
|
DO 580 J=1,50
|
|
FEVEE(J)=0D0
|
|
580 CONTINUE
|
|
DO 600 I1=NLOW+2,NUPP
|
|
DO 590 I2=NLOW+1,I1-1
|
|
CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/
|
|
& (P(I1,5)*P(I2,5))
|
|
THE=ACOS(MAX(-1D0,MIN(1D0,CTHE)))
|
|
ITHE=MAX(1,MIN(50,1+INT(50D0*THE/PARU(1))))
|
|
FEVEE(ITHE)=FEVEE(ITHE)+FAC*P(I1,4)*P(I2,4)
|
|
590 CONTINUE
|
|
600 CONTINUE
|
|
DO 610 J=1,25
|
|
FE1EC(J)=FE1EC(J)+FEVEE(J)
|
|
FE2EC(J)=FE2EC(J)+FEVEE(J)**2
|
|
FE1EC(51-J)=FE1EC(51-J)+FEVEE(51-J)
|
|
FE2EC(51-J)=FE2EC(51-J)+FEVEE(51-J)**2
|
|
FE1EA(J)=FE1EA(J)+(FEVEE(51-J)-FEVEE(J))
|
|
FE2EA(J)=FE2EA(J)+(FEVEE(51-J)-FEVEE(J))**2
|
|
610 CONTINUE
|
|
MSTU(62)=NUPP-NLOW
|
|
|
|
C...Write statistics on Energy-Energy Correlation.
|
|
ELSEIF(MTABU.EQ.42) THEN
|
|
FAC=1D0/MAX(1,NEVEE)
|
|
WRITE(MSTU(11),5700) NEVEE
|
|
DO 620 J=1,25
|
|
FEEC1=FAC*FE1EC(J)
|
|
FEES1=SQRT(MAX(0D0,FAC*(FAC*FE2EC(J)-FEEC1**2)))
|
|
FEEC2=FAC*FE1EC(51-J)
|
|
FEES2=SQRT(MAX(0D0,FAC*(FAC*FE2EC(51-J)-FEEC2**2)))
|
|
FEECA=FAC*FE1EA(J)
|
|
FEESA=SQRT(MAX(0D0,FAC*(FAC*FE2EA(J)-FEECA**2)))
|
|
WRITE(MSTU(11),5800) 3.6D0*(J-1),3.6D0*J,FEEC1,FEES1,
|
|
& FEEC2,FEES2,FEECA,FEESA
|
|
620 CONTINUE
|
|
|
|
C...Copy statistics on Energy-Energy Correlation into /PYJETS/.
|
|
ELSEIF(MTABU.EQ.43) THEN
|
|
FAC=1D0/MAX(1,NEVEE)
|
|
DO 630 I=1,25
|
|
K(I,1)=32
|
|
K(I,2)=99
|
|
K(I,3)=0
|
|
K(I,4)=0
|
|
K(I,5)=0
|
|
P(I,1)=FAC*FE1EC(I)
|
|
V(I,1)=SQRT(MAX(0D0,FAC*(FAC*FE2EC(I)-P(I,1)**2)))
|
|
P(I,2)=FAC*FE1EC(51-I)
|
|
V(I,2)=SQRT(MAX(0D0,FAC*(FAC*FE2EC(51-I)-P(I,2)**2)))
|
|
P(I,3)=FAC*FE1EA(I)
|
|
V(I,3)=SQRT(MAX(0D0,FAC*(FAC*FE2EA(I)-P(I,3)**2)))
|
|
P(I,4)=PARU(1)*(I-1)/50D0
|
|
P(I,5)=PARU(1)*I/50D0
|
|
V(I,4)=3.6D0*(I-1)
|
|
V(I,5)=3.6D0*I
|
|
630 CONTINUE
|
|
N=25
|
|
DO 640 J=1,5
|
|
K(N+1,J)=0
|
|
P(N+1,J)=0D0
|
|
V(N+1,J)=0D0
|
|
640 CONTINUE
|
|
K(N+1,1)=32
|
|
K(N+1,2)=99
|
|
K(N+1,5)=NEVEE
|
|
MSTU(3)=1
|
|
|
|
C...Reset statistics on decay channels.
|
|
ELSEIF(MTABU.EQ.50) THEN
|
|
NEVDC=0
|
|
NKFDC=0
|
|
NREDC=0
|
|
|
|
C...Identify and order flavour content of final state.
|
|
ELSEIF(MTABU.EQ.51) THEN
|
|
NEVDC=NEVDC+1
|
|
NDS=0
|
|
DO 670 I=1,N
|
|
IF(K(I,1).LE.0.OR.K(I,1).GE.6) GOTO 670
|
|
NDS=NDS+1
|
|
IF(NDS.GT.8) THEN
|
|
NREDC=NREDC+1
|
|
RETURN
|
|
ENDIF
|
|
KFM=2*IABS(K(I,2))
|
|
IF(K(I,2).LT.0) KFM=KFM-1
|
|
DO 650 IDS=NDS-1,1,-1
|
|
IIN=IDS+1
|
|
IF(KFM.LT.KFDM(IDS)) GOTO 660
|
|
KFDM(IDS+1)=KFDM(IDS)
|
|
650 CONTINUE
|
|
IIN=1
|
|
660 KFDM(IIN)=KFM
|
|
670 CONTINUE
|
|
|
|
C...Find whether old or new final state.
|
|
DO 690 IDC=1,NKFDC
|
|
IF(NDS.LT.KFDC(IDC,0)) THEN
|
|
IKFDC=IDC
|
|
GOTO 700
|
|
ELSEIF(NDS.EQ.KFDC(IDC,0)) THEN
|
|
DO 680 I=1,NDS
|
|
IF(KFDM(I).LT.KFDC(IDC,I)) THEN
|
|
IKFDC=IDC
|
|
GOTO 700
|
|
ELSEIF(KFDM(I).GT.KFDC(IDC,I)) THEN
|
|
GOTO 690
|
|
ENDIF
|
|
680 CONTINUE
|
|
IKFDC=-IDC
|
|
GOTO 700
|
|
ENDIF
|
|
690 CONTINUE
|
|
IKFDC=NKFDC+1
|
|
700 IF(IKFDC.LT.0) THEN
|
|
IKFDC=-IKFDC
|
|
ELSEIF(NKFDC.GE.200) THEN
|
|
NREDC=NREDC+1
|
|
RETURN
|
|
ELSE
|
|
DO 720 IDC=NKFDC,IKFDC,-1
|
|
NPDC(IDC+1)=NPDC(IDC)
|
|
DO 710 I=0,8
|
|
KFDC(IDC+1,I)=KFDC(IDC,I)
|
|
710 CONTINUE
|
|
720 CONTINUE
|
|
NKFDC=NKFDC+1
|
|
KFDC(IKFDC,0)=NDS
|
|
DO 730 I=1,NDS
|
|
KFDC(IKFDC,I)=KFDM(I)
|
|
730 CONTINUE
|
|
NPDC(IKFDC)=0
|
|
ENDIF
|
|
NPDC(IKFDC)=NPDC(IKFDC)+1
|
|
|
|
C...Write statistics on decay channels.
|
|
ELSEIF(MTABU.EQ.52) THEN
|
|
FAC=1D0/MAX(1,NEVDC)
|
|
WRITE(MSTU(11),5900) NEVDC
|
|
DO 750 IDC=1,NKFDC
|
|
DO 740 I=1,KFDC(IDC,0)
|
|
KFM=KFDC(IDC,I)
|
|
KF=(KFM+1)/2
|
|
IF(2*KF.NE.KFM) KF=-KF
|
|
CALL PYNAME(KF,CHAU)
|
|
CHDC(I)=CHAU(1:12)
|
|
IF(CHAU(13:13).NE.' ') CHDC(I)(12:12)='?'
|
|
740 CONTINUE
|
|
WRITE(MSTU(11),6000) FAC*NPDC(IDC),(CHDC(I),I=1,KFDC(IDC,0))
|
|
750 CONTINUE
|
|
IF(NREDC.NE.0) WRITE(MSTU(11),6100) FAC*NREDC
|
|
|
|
C...Copy statistics on decay channels into /PYJETS/.
|
|
ELSEIF(MTABU.EQ.53) THEN
|
|
FAC=1D0/MAX(1,NEVDC)
|
|
DO 780 IDC=1,NKFDC
|
|
K(IDC,1)=32
|
|
K(IDC,2)=99
|
|
K(IDC,3)=0
|
|
K(IDC,4)=0
|
|
K(IDC,5)=KFDC(IDC,0)
|
|
DO 760 J=1,5
|
|
P(IDC,J)=0D0
|
|
V(IDC,J)=0D0
|
|
760 CONTINUE
|
|
DO 770 I=1,KFDC(IDC,0)
|
|
KFM=KFDC(IDC,I)
|
|
KF=(KFM+1)/2
|
|
IF(2*KF.NE.KFM) KF=-KF
|
|
IF(I.LE.5) P(IDC,I)=KF
|
|
IF(I.GE.6) V(IDC,I-5)=KF
|
|
770 CONTINUE
|
|
V(IDC,5)=FAC*NPDC(IDC)
|
|
780 CONTINUE
|
|
N=NKFDC
|
|
DO 790 J=1,5
|
|
K(N+1,J)=0
|
|
P(N+1,J)=0D0
|
|
V(N+1,J)=0D0
|
|
790 CONTINUE
|
|
K(N+1,1)=32
|
|
K(N+1,2)=99
|
|
K(N+1,5)=NEVDC
|
|
V(N+1,5)=FAC*NREDC
|
|
MSTU(3)=1
|
|
ENDIF
|
|
|
|
C...Format statements for output on unit MSTU(11) (default 6).
|
|
5000 FORMAT(///20X,'Event statistics - initial state'/
|
|
&20X,'based on an analysis of ',I6,' events'//
|
|
&3X,'Main flavours after',8X,'Fraction',4X,'Subfractions ',
|
|
&'according to fragmenting system multiplicity'/
|
|
&4X,'hard interaction',24X,'1',7X,'2',7X,'3',7X,'4',7X,'5',
|
|
&6X,'6-7',5X,'8-10',3X,'11-15',3X,'16-25',4X,'>25'/)
|
|
5100 FORMAT(3X,A12,1X,A12,F10.5,1X,10F8.4)
|
|
5200 FORMAT(///20X,'Event statistics - final state'/
|
|
&20X,'based on an analysis of ',I7,' events'//
|
|
&5X,'Mean primary multiplicity =',F10.4/
|
|
&5X,'Mean final multiplicity =',F10.4/
|
|
&5X,'Mean charged multiplicity =',F10.4//
|
|
&5X,'Number of particles produced per event (directly and via ',
|
|
&'decays/branchings)'/
|
|
&8X,'KF Particle/jet MDCY',10X,'Particles',13X,'Antiparticles',
|
|
&8X,'Total'/35X,'prim seco prim seco'/)
|
|
5300 FORMAT(1X,I9,4X,A16,I2,5(1X,F11.6))
|
|
5400 FORMAT(///20X,'Factorial moments analysis of multiplicity'/
|
|
&20X,'based on an analysis of ',I6,' events'//
|
|
&3X,'delta-',A3,' delta-phi <n>/bin',10X,'<F2>',18X,'<F3>',
|
|
&18X,'<F4>',18X,'<F5>'/35X,4(' value error '))
|
|
5500 FORMAT(10X)
|
|
5600 FORMAT(2X,2F10.4,F12.4,4(F12.4,F10.4))
|
|
5700 FORMAT(///20X,'Energy-Energy Correlation and Asymmetry'/
|
|
&20X,'based on an analysis of ',I6,' events'//
|
|
&2X,'theta range',8X,'EEC(theta)',8X,'EEC(180-theta)',7X,
|
|
&'EECA(theta)'/2X,'in degrees ',3(' value error')/)
|
|
5800 FORMAT(2X,F4.1,' - ',F4.1,3(F11.4,F9.4))
|
|
5900 FORMAT(///20X,'Decay channel analysis - final state'/
|
|
&20X,'based on an analysis of ',I6,' events'//
|
|
&2X,'Probability',10X,'Complete final state'/)
|
|
6000 FORMAT(2X,F9.5,5X,8(A12,1X))
|
|
6100 FORMAT(2X,F9.5,5X,'into other channels (more than 8 particles ',
|
|
&'or table overflow)')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYEEVT
|
|
C...Handles the generation of an e+e- annihilation jet event.
|
|
|
|
SUBROUTINE PYEEVT(KFL,ECM)
|
|
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...Check input parameters.
|
|
IF(MSTU(12).GE.1) CALL PYLIST(0)
|
|
IF(KFL.LT.0.OR.KFL.GT.8) THEN
|
|
CALL PYERRM(16,'(PYEEVT:) called with unknown flavour code')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02D0*PARF(100+MAX(1,KFL))
|
|
IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02D0*PMAS(KFL,1)
|
|
IF(ECM.LT.ECMMIN) THEN
|
|
CALL PYERRM(16,'(PYEEVT:) called with too small CM energy')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
|
|
C...Check consistency of MSTJ options set.
|
|
IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN
|
|
CALL PYERRM(6,
|
|
& '(PYEEVT:) MSTJ(109) value requires MSTJ(110) = 1')
|
|
MSTJ(110)=1
|
|
ENDIF
|
|
IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN
|
|
CALL PYERRM(6,
|
|
& '(PYEEVT:) MSTJ(109) value requires MSTJ(111) = 0')
|
|
MSTJ(111)=0
|
|
ENDIF
|
|
|
|
C...Initialize alpha_strong and total cross-section.
|
|
MSTU(111)=MSTJ(108)
|
|
IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
|
|
&MSTU(111)=1
|
|
PARU(112)=PARJ(121)
|
|
IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
|
|
IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE.
|
|
&PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL PYXTEE(KFL,ECM,
|
|
&XTOT)
|
|
IF(MSTJ(116).GE.3) MSTJ(116)=1
|
|
PARJ(171)=0D0
|
|
|
|
C...Add initial e+e- to event record (documentation only).
|
|
NTRY=0
|
|
100 NTRY=NTRY+1
|
|
IF(NTRY.GT.100) THEN
|
|
CALL PYERRM(14,'(PYEEVT:) caught in an infinite loop')
|
|
RETURN
|
|
ENDIF
|
|
MSTU(24)=0
|
|
NC=0
|
|
IF(MSTJ(115).GE.2) THEN
|
|
NC=NC+2
|
|
CALL PY1ENT(NC-1,11,0.5D0*ECM,0D0,0D0)
|
|
K(NC-1,1)=21
|
|
CALL PY1ENT(NC,-11,0.5D0*ECM,PARU(1),0D0)
|
|
K(NC,1)=21
|
|
ENDIF
|
|
|
|
C...Radiative photon (in initial state).
|
|
MK=0
|
|
ECMC=ECM
|
|
IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL PYRADK(ECM,MK,PAK,
|
|
&THEK,PHIK,ALPK)
|
|
IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2D0*PAK))
|
|
IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN
|
|
NC=NC+1
|
|
CALL PY1ENT(NC,22,PAK,THEK,PHIK)
|
|
K(NC,3)=MIN(MSTJ(115)/2,1)
|
|
ENDIF
|
|
|
|
C...Virtual exchange boson (gamma or Z0).
|
|
IF(MSTJ(115).GE.3) THEN
|
|
NC=NC+1
|
|
KF=22
|
|
IF(MSTJ(102).EQ.2) KF=23
|
|
MSTU10=MSTU(10)
|
|
MSTU(10)=1
|
|
P(NC,5)=ECMC
|
|
CALL PY1ENT(NC,KF,ECMC,0D0,0D0)
|
|
K(NC,1)=21
|
|
K(NC,3)=1
|
|
MSTU(10)=MSTU10
|
|
ENDIF
|
|
|
|
C...Choice of flavour and jet configuration.
|
|
CALL PYXKFL(KFL,ECM,ECMC,KFLC)
|
|
IF(KFLC.EQ.0) GOTO 100
|
|
CALL PYXJET(ECMC,NJET,CUT)
|
|
KFLN=21
|
|
IF(NJET.EQ.4) CALL PYX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4,
|
|
&X12,X14)
|
|
IF(NJET.EQ.3) CALL PYX3JT(NJET,CUT,KFLC,ECMC,X1,X3)
|
|
IF(NJET.EQ.2) MSTJ(120)=1
|
|
|
|
C...Fill jet configuration and origin.
|
|
IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL PY2ENT(NC+1,KFLC,-KFLC,ECMC)
|
|
IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL PY2ENT(-(NC+1),KFLC,-KFLC,
|
|
&ECMC)
|
|
IF(NJET.EQ.3) CALL PY3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3)
|
|
IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL PY4ENT(NC+1,KFLC,KFLN,KFLN,
|
|
&-KFLC,ECMC,X1,X2,X4,X12,X14)
|
|
IF(NJET.EQ.4.AND.KFLN.NE.21) CALL PY4ENT(NC+1,KFLC,-KFLN,KFLN,
|
|
&-KFLC,ECMC,X1,X2,X4,X12,X14)
|
|
IF(MSTU(24).NE.0) GOTO 100
|
|
DO 110 IP=NC+1,N
|
|
K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1)
|
|
110 CONTINUE
|
|
|
|
C...Angular orientation according to matrix element.
|
|
IF(MSTJ(106).EQ.1) THEN
|
|
CALL PYXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI)
|
|
CALL PYROBO(NC+1,N,0D0,CHI,0D0,0D0,0D0)
|
|
CALL PYROBO(NC+1,N,THE,PHI,0D0,0D0,0D0)
|
|
ENDIF
|
|
|
|
C...Rotation and boost from radiative photon.
|
|
IF(MK.EQ.1) THEN
|
|
DBEK=-PAK/(ECM-PAK)
|
|
NMIN=NC+1-MSTJ(115)/3
|
|
CALL PYROBO(NMIN,N,0D0,-PHIK,0D0,0D0,0D0)
|
|
CALL PYROBO(NMIN,N,ALPK,0D0,DBEK*SIN(THEK),0D0,DBEK*COS(THEK))
|
|
CALL PYROBO(NMIN,N,0D0,PHIK,0D0,0D0,0D0)
|
|
ENDIF
|
|
|
|
C...Generate parton shower. Rearrange along strings and check.
|
|
IF(MSTJ(101).EQ.5) THEN
|
|
CALL PYSHOW(N-1,N,ECMC)
|
|
MSTJ14=MSTJ(14)
|
|
IF(MSTJ(105).EQ.-1) MSTJ(14)=-1
|
|
IF(MSTJ(105).GE.0) MSTU(28)=0
|
|
CALL PYPREP(0)
|
|
MSTJ(14)=MSTJ14
|
|
IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
|
|
ENDIF
|
|
|
|
C...Fragmentation/decay generation. Information for PYTABU.
|
|
IF(MSTJ(105).EQ.1) CALL PYEXEC
|
|
MSTU(161)=KFLC
|
|
MSTU(162)=-KFLC
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYXTEE
|
|
C...Calculates total cross-section, including initial state
|
|
C...radiation effects.
|
|
|
|
SUBROUTINE PYXTEE(KFL,ECM,XTOT)
|
|
|
|
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)
|
|
SAVE /PYDAT1/,/PYDAT2/
|
|
|
|
C...Status, (optimized) Q^2 scale, alpha_strong.
|
|
PARJ(151)=ECM
|
|
MSTJ(119)=10*MSTJ(102)+KFL
|
|
IF(MSTJ(111).EQ.0) THEN
|
|
Q2R=ECM**2
|
|
ELSEIF(MSTU(111).EQ.0) THEN
|
|
PARJ(168)=MIN(1D0,MAX(PARJ(128),EXP(-12D0*PARU(1)/
|
|
& ((33D0-2D0*MSTU(112))*PARU(111)))))
|
|
Q2R=PARJ(168)*ECM**2
|
|
ELSE
|
|
PARJ(168)=MIN(1D0,MAX(PARJ(128),PARU(112)/ECM,
|
|
& (2D0*PARU(112)/ECM)**2))
|
|
Q2R=PARJ(168)*ECM**2
|
|
ENDIF
|
|
ALSPI=PYALPS(Q2R)/PARU(1)
|
|
|
|
C...QCD corrections factor in R.
|
|
IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN
|
|
RQCD=1D0
|
|
ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN
|
|
RQCD=1D0+ALSPI
|
|
ELSEIF(MSTJ(109).EQ.0) THEN
|
|
RQCD=1D0+ALSPI+(1.986D0-0.115D0*MSTU(118))*ALSPI**2
|
|
IF(MSTJ(111).EQ.1) RQCD=MAX(1D0,RQCD+(33D0-2D0*MSTU(112))/12D0*
|
|
& LOG(PARJ(168))*ALSPI**2)
|
|
ELSEIF(IABS(MSTJ(101)).EQ.1) THEN
|
|
RQCD=1D0+(3D0/4D0)*ALSPI
|
|
ELSE
|
|
RQCD=1D0+(3D0/4D0)*ALSPI-(3D0/32D0+0.519D0*MSTU(118))*ALSPI**2
|
|
ENDIF
|
|
|
|
C...Calculate Z0 width if default value not acceptable.
|
|
IF(MSTJ(102).GE.3) THEN
|
|
RVA=3D0*(3D0+(4D0*PARU(102)-1D0)**2)+6D0*RQCD*(2D0+
|
|
& (1D0-8D0*PARU(102)/3D0)**2+(4D0*PARU(102)/3D0-1D0)**2)
|
|
DO 100 KFLC=5,6
|
|
VQ=1D0
|
|
IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,1D0-
|
|
& (2D0*PYMASS(KFLC)/ ECM)**2))
|
|
IF(KFLC.EQ.5) VF=4D0*PARU(102)/3D0-1D0
|
|
IF(KFLC.EQ.6) VF=1D0-8D0*PARU(102)/3D0
|
|
RVA=RVA+3D0*RQCD*(0.5D0*VQ*(3D0-VQ**2)*VF**2+VQ**3)
|
|
100 CONTINUE
|
|
PARJ(124)=PARU(101)*PARJ(123)*RVA/(48D0*PARU(102)*
|
|
& (1D0-PARU(102)))
|
|
ENDIF
|
|
|
|
C...Calculate propagator and related constants for QFD case.
|
|
POLL=1D0-PARJ(131)*PARJ(132)
|
|
IF(MSTJ(102).GE.2) THEN
|
|
SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102)))
|
|
SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
|
|
SFI=SFW*(1D0-(PARJ(123)/ECM)**2)
|
|
VE=4D0*PARU(102)-1D0
|
|
SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131))
|
|
SF1W=SFF**2*((VE**2+1D0)*POLL+2D0*VE*(PARJ(132)-PARJ(131)))
|
|
HF1I=SFI*SF1I
|
|
HF1W=SFW*SF1W
|
|
ENDIF
|
|
|
|
C...Loop over different flavours: charge, velocity.
|
|
RTOT=0D0
|
|
RQQ=0D0
|
|
RQV=0D0
|
|
RVA=0D0
|
|
DO 110 KFLC=1,MAX(MSTJ(104),KFL)
|
|
IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110
|
|
MSTJ(93)=1
|
|
PMQ=PYMASS(KFLC)
|
|
IF(ECM.LT.2D0*PMQ+PARJ(127)) GOTO 110
|
|
QF=KCHG(KFLC,1)/3D0
|
|
VQ=1D0
|
|
IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1D0-(2D0*PMQ/ECM)**2)
|
|
|
|
C...Calculate R and sum of charges for QED or QFD case.
|
|
RQQ=RQQ+3D0*QF**2*POLL
|
|
IF(MSTJ(102).LE.1) THEN
|
|
RTOT=RTOT+3D0*0.5D0*VQ*(3D0-VQ**2)*QF**2*POLL
|
|
ELSE
|
|
VF=SIGN(1D0,QF)-4D0*QF*PARU(102)
|
|
RQV=RQV-6D0*QF*VF*SF1I
|
|
RVA=RVA+3D0*(VF**2+1D0)*SF1W
|
|
RTOT=RTOT+3D0*(0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-
|
|
& 2D0*QF*VF*HF1I+VF**2*HF1W)+VQ**3*HF1W)
|
|
ENDIF
|
|
110 CONTINUE
|
|
RSUM=RQQ
|
|
IF(MSTJ(102).GE.2) RSUM=RQQ+SFI*RQV+SFW*RVA
|
|
|
|
C...Calculate cross-section, including QCD corrections.
|
|
PARJ(141)=RQQ
|
|
PARJ(142)=RTOT
|
|
PARJ(143)=RTOT*RQCD
|
|
PARJ(144)=PARJ(143)
|
|
PARJ(145)=PARJ(141)*86.8D0/ECM**2
|
|
PARJ(146)=PARJ(142)*86.8D0/ECM**2
|
|
PARJ(147)=PARJ(143)*86.8D0/ECM**2
|
|
PARJ(148)=PARJ(147)
|
|
PARJ(157)=RSUM*RQCD
|
|
PARJ(158)=0D0
|
|
PARJ(159)=0D0
|
|
XTOT=PARJ(147)
|
|
IF(MSTJ(107).LE.0) RETURN
|
|
|
|
C...Virtual cross-section.
|
|
XKL=PARJ(135)
|
|
XKU=MIN(PARJ(136),1D0-(2D0*PARJ(127)/ECM)**2)
|
|
ALE=2D0*LOG(ECM/PYMASS(11))-1D0
|
|
SIGV=ALE/3D0+2D0*LOG(ECM**2/(PYMASS(13)*PYMASS(15)))/3D0-4D0/3D0+
|
|
&1.526D0*LOG(ECM**2/0.932D0)
|
|
|
|
C...Soft and hard radiative cross-section in QED case.
|
|
IF(MSTJ(102).LE.1) THEN
|
|
SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+2D0*SIGV
|
|
SIGS=ALE*(2D0*LOG(XKL)-LOG(1D0-XKL)-XKL)
|
|
SIGH=ALE*(2D0*LOG(XKU/XKL)-LOG((1D0-XKU)/(1D0-XKL))-(XKU-XKL))
|
|
|
|
C...Soft and hard radiative cross-section in QFD case.
|
|
ELSE
|
|
SZM=1D0-(PARJ(123)/ECM)**2
|
|
SZW=PARJ(123)*PARJ(124)/ECM**2
|
|
PARJ(161)=-RQQ/RSUM
|
|
PARJ(162)=-(RQQ+RQV+RVA)/RSUM
|
|
PARJ(163)=(RQV*(1D0-0.5D0*SZM-SFI)+RVA*(1.5D0-SZM-SFW))/RSUM
|
|
PARJ(164)=(RQV*SZW**2*(1D0-2D0*SFW)+RVA*(2D0*SFI+SZW**2-
|
|
& 4D0+3D0*SZM-SZM**2))/(SZW*RSUM)
|
|
SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+((2D0*RQQ+SFI*RQV)/
|
|
& RSUM)*SIGV+(SZW*SFW*RQV/RSUM)*PARU(1)*20D0/9D0
|
|
SIGS=ALE*(2D0*LOG(XKL)+PARJ(161)*LOG(1D0-XKL)+PARJ(162)*XKL+
|
|
& PARJ(163)*LOG(((XKL-SZM)**2+SZW**2)/(SZM**2+SZW**2))+
|
|
& PARJ(164)*(ATAN((XKL-SZM)/SZW)-ATAN(-SZM/SZW)))
|
|
SIGH=ALE*(2D0*LOG(XKU/XKL)+PARJ(161)*LOG((1D0-XKU)/
|
|
& (1D0-XKL))+PARJ(162)*(XKU-XKL)+PARJ(163)*
|
|
& LOG(((XKU-SZM)**2+SZW**2)/((XKL-SZM)**2+SZW**2))+
|
|
& PARJ(164)*(ATAN((XKU-SZM)/SZW)-ATAN((XKL-SZM)/SZW)))
|
|
ENDIF
|
|
|
|
C...Total cross-section and fraction of hard photon events.
|
|
PARJ(160)=SIGH/(PARU(1)/PARU(101)+SIGV+SIGS+SIGH)
|
|
PARJ(157)=RSUM*(1D0+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD
|
|
PARJ(144)=PARJ(157)
|
|
PARJ(148)=PARJ(144)*86.8D0/ECM**2
|
|
XTOT=PARJ(148)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYRADK
|
|
C...Generates initial state photon radiation.
|
|
|
|
SUBROUTINE PYRADK(ECM,MK,PAK,THEK,PHIK,ALPK)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
|
|
C...Function: cumulative hard photon spectrum in QFD case.
|
|
FXK(XX)=2D0*LOG(XX)+PARJ(161)*LOG(1D0-XX)+PARJ(162)*XX+
|
|
&PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW)
|
|
|
|
C...Determine whether radiative photon or not.
|
|
MK=0
|
|
PAK=0D0
|
|
IF(PARJ(160).LT.PYR(0)) RETURN
|
|
MK=1
|
|
|
|
C...Photon energy range. Find photon momentum in QED case.
|
|
XKL=PARJ(135)
|
|
XKU=MIN(PARJ(136),1D0-(2D0*PARJ(127)/ECM)**2)
|
|
IF(MSTJ(102).LE.1) THEN
|
|
100 XK=1D0/(1D0+(1D0/XKL-1D0)*((1D0/XKU-1D0)/(1D0/XKL-1D0))**PYR(0))
|
|
IF(1D0+(1D0-XK)**2.LT.2D0*PYR(0)) GOTO 100
|
|
|
|
C...Ditto in QFD case, by numerical inversion of integrated spectrum.
|
|
ELSE
|
|
SZM=1D0-(PARJ(123)/ECM)**2
|
|
SZW=PARJ(123)*PARJ(124)/ECM**2
|
|
FXKL=FXK(XKL)
|
|
FXKU=FXK(XKU)
|
|
FXKD=1D-4*(FXKU-FXKL)
|
|
FXKR=FXKL+PYR(0)*(FXKU-FXKL)
|
|
NXK=0
|
|
110 NXK=NXK+1
|
|
XK=0.5D0*(XKL+XKU)
|
|
FXKV=FXK(XK)
|
|
IF(FXKV.GT.FXKR) THEN
|
|
XKU=XK
|
|
FXKU=FXKV
|
|
ELSE
|
|
XKL=XK
|
|
FXKL=FXKV
|
|
ENDIF
|
|
IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110
|
|
XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL)
|
|
ENDIF
|
|
PAK=0.5D0*ECM*XK
|
|
|
|
C...Photon polar and azimuthal angle.
|
|
PME=2D0*(PYMASS(11)/ECM)**2
|
|
120 CTHM=PME*(2D0/PME)**PYR(0)
|
|
IF(1D0-(XK**2*CTHM*(1D0-0.5D0*CTHM)+2D0*(1D0-XK)*PME/MAX(PME,
|
|
&CTHM*(1D0-0.5D0*CTHM)))/(1D0+(1D0-XK)**2).LT.PYR(0)) GOTO 120
|
|
CTHE=1D0-CTHM
|
|
IF(PYR(0).GT.0.5D0) CTHE=-CTHE
|
|
STHE=SQRT(MAX(0D0,(CTHM-PME)*(2D0-CTHM)))
|
|
THEK=PYANGL(CTHE,STHE)
|
|
PHIK=PARU(2)*PYR(0)
|
|
|
|
C...Rotation angle for hadronic system.
|
|
SGN=1D0
|
|
IF(0.5D0*(2D0-XK*(1D0-CTHE))**2/((2D0-XK)**2+(XK*CTHE)**2).GT.
|
|
&PYR(0)) SGN=-1D0
|
|
ALPK=ASIN(SGN*STHE*(XK-SGN*(2D0*SQRT(1D0-XK)-2D0+XK)*CTHE)/
|
|
&(2D0-XK*(1D0-SGN*CTHE)))
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYXKFL
|
|
C...Selects flavour for produced qqbar pair.
|
|
|
|
SUBROUTINE PYXKFL(KFL,ECM,ECMC,KFLC)
|
|
|
|
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)
|
|
SAVE /PYDAT1/,/PYDAT2/
|
|
|
|
C...Calculate maximum weight in QED or QFD case.
|
|
IF(MSTJ(102).LE.1) THEN
|
|
RFMAX=4D0/9D0
|
|
ELSE
|
|
POLL=1D0-PARJ(131)*PARJ(132)
|
|
SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102)))
|
|
SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
|
|
SFI=SFW*(1D0-(PARJ(123)/ECMC)**2)
|
|
VE=4D0*PARU(102)-1D0
|
|
HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131))
|
|
HF1W=SFW*SFF**2*((VE**2+1D0)*POLL+2D0*VE*(PARJ(132)-PARJ(131)))
|
|
RFMAX=MAX(4D0/9D0*POLL-4D0/3D0*(1D0-8D0*PARU(102)/3D0)*HF1I+
|
|
& ((1D0-8D0*PARU(102)/3D0)**2+1D0)*HF1W,1D0/9D0*POLL+2D0/3D0*
|
|
& (-1D0+4D0*PARU(102)/3D0)*HF1I+((-1D0+4D0*PARU(102)/3D0)**2+
|
|
& 1D0)*HF1W)
|
|
ENDIF
|
|
|
|
C...Choose flavour. Gives charge and velocity.
|
|
NTRY=0
|
|
100 NTRY=NTRY+1
|
|
IF(NTRY.GT.100) THEN
|
|
CALL PYERRM(14,'(PYXKFL:) caught in an infinite loop')
|
|
KFLC=0
|
|
RETURN
|
|
ENDIF
|
|
KFLC=KFL
|
|
IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*PYR(0))
|
|
MSTJ(93)=1
|
|
PMQ=PYMASS(KFLC)
|
|
IF(ECM.LT.2D0*PMQ+PARJ(127)) GOTO 100
|
|
QF=KCHG(KFLC,1)/3D0
|
|
VQ=1D0
|
|
IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,1D0-(2D0*PMQ/ECMC)**2))
|
|
|
|
C...Calculate weight in QED or QFD case.
|
|
IF(MSTJ(102).LE.1) THEN
|
|
RF=QF**2
|
|
RFV=0.5D0*VQ*(3D0-VQ**2)*QF**2
|
|
ELSE
|
|
VF=SIGN(1D0,QF)-4D0*QF*PARU(102)
|
|
RF=QF**2*POLL-2D0*QF*VF*HF1I+(VF**2+1D0)*HF1W
|
|
RFV=0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-2D0*QF*VF*HF1I+VF**2*HF1W)+
|
|
& VQ**3*HF1W
|
|
IF(RFV.GT.0D0) PARJ(171)=MIN(1D0,VQ**3*HF1W/RFV)
|
|
ENDIF
|
|
|
|
C...Weighting or new event (radiative photon). Cross-section update.
|
|
IF(KFL.LE.0.AND.RF.LT.PYR(0)*RFMAX) GOTO 100
|
|
PARJ(158)=PARJ(158)+1D0
|
|
IF(ECMC.LT.2D0*PMQ+PARJ(127).OR.RFV.LT.PYR(0)*RF) KFLC=0
|
|
IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100
|
|
IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1D0
|
|
PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158)
|
|
PARJ(148)=PARJ(144)*86.8D0/ECM**2
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYXJET
|
|
C...Selects number of jets in matrix element approach.
|
|
|
|
SUBROUTINE PYXJET(ECM,NJET,CUT)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
C...Local array and data.
|
|
DIMENSION ZHUT(5)
|
|
DATA ZHUT/3.0922D0, 6.2291D0, 7.4782D0, 7.8440D0, 8.2560D0/
|
|
|
|
C...Trivial result for two-jets only, including parton shower.
|
|
IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN
|
|
CUT=0D0
|
|
|
|
C...QCD and Abelian vector gluon theory: Q^2 for jet rate and R.
|
|
ELSEIF(MSTJ(109).EQ.0.OR.MSTJ(109).EQ.2) THEN
|
|
CF=4D0/3D0
|
|
IF(MSTJ(109).EQ.2) CF=1D0
|
|
IF(MSTJ(111).EQ.0) THEN
|
|
Q2=ECM**2
|
|
Q2R=ECM**2
|
|
ELSEIF(MSTU(111).EQ.0) THEN
|
|
PARJ(169)=MIN(1D0,PARJ(129))
|
|
Q2=PARJ(169)*ECM**2
|
|
PARJ(168)=MIN(1D0,MAX(PARJ(128),EXP(-12D0*PARU(1)/
|
|
& ((33D0-2D0*MSTU(112))*PARU(111)))))
|
|
Q2R=PARJ(168)*ECM**2
|
|
ELSE
|
|
PARJ(169)=MIN(1D0,MAX(PARJ(129),(2D0*PARU(112)/ECM)**2))
|
|
Q2=PARJ(169)*ECM**2
|
|
PARJ(168)=MIN(1D0,MAX(PARJ(128),PARU(112)/ECM,
|
|
& (2D0*PARU(112)/ECM)**2))
|
|
Q2R=PARJ(168)*ECM**2
|
|
ENDIF
|
|
|
|
C...alpha_strong for R and R itself.
|
|
ALSPI=(3D0/4D0)*CF*PYALPS(Q2R)/PARU(1)
|
|
IF(IABS(MSTJ(101)).EQ.1) THEN
|
|
RQCD=1D0+ALSPI
|
|
ELSEIF(MSTJ(109).EQ.0) THEN
|
|
RQCD=1D0+ALSPI+(1.986D0-0.115D0*MSTU(118))*ALSPI**2
|
|
IF(MSTJ(111).EQ.1) RQCD=MAX(1D0,RQCD+
|
|
& (33D0-2D0*MSTU(112))/12D0*LOG(PARJ(168))*ALSPI**2)
|
|
ELSE
|
|
RQCD=1D0+ALSPI-(3D0/32D0+0.519D0*MSTU(118))*(4D0*ALSPI/3D0)**2
|
|
ENDIF
|
|
|
|
C...alpha_strong for jet rate. Initial value for y cut.
|
|
ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1)
|
|
CUT=MAX(0.001D0,PARJ(125),(PARJ(126)/ECM)**2)
|
|
IF(IABS(MSTJ(101)).LE.1.OR.(MSTJ(109).EQ.0.AND.MSTJ(111).EQ.0))
|
|
& CUT=MAX(CUT,EXP(-SQRT(0.75D0/ALSPI))/2D0)
|
|
IF(MSTJ(110).EQ.2) CUT=MAX(0.01D0,MIN(0.05D0,CUT))
|
|
|
|
C...Parametrization of first order three-jet cross-section.
|
|
100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25D0) THEN
|
|
PARJ(152)=0D0
|
|
ELSE
|
|
PARJ(152)=(2D0*ALSPI/3D0)*((3D0-6D0*CUT+2D0*LOG(CUT))*
|
|
& LOG(CUT/(1D0-2D0*CUT))+(2.5D0+1.5D0*CUT-6.571D0)*
|
|
& (1D0-3D0*CUT)+5.833D0*(1D0-3D0*CUT)**2-3.894D0*
|
|
& (1D0-3D0*CUT)**3+1.342D0*(1D0-3D0*CUT)**4)/RQCD
|
|
IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2))
|
|
& PARJ(152)=0D0
|
|
ENDIF
|
|
|
|
C...Parametrization of second order three-jet cross-section.
|
|
IF(IABS(MSTJ(101)).LE.1.OR.MSTJ(101).EQ.3.OR.MSTJ(109).EQ.2.OR.
|
|
& CUT.GE.0.25D0) THEN
|
|
PARJ(153)=0D0
|
|
ELSEIF(MSTJ(110).LE.1) THEN
|
|
CT=LOG(1D0/CUT-2D0)
|
|
PARJ(153)=ALSPI**2*CT**2*(2.419D0+0.5989D0*CT+0.6782D0*CT**2-
|
|
& 0.2661D0*CT**3+0.01159D0*CT**4)/RQCD
|
|
|
|
C...Interpolation in second/first order ratio for Zhu parametrization.
|
|
ELSEIF(MSTJ(110).EQ.2) THEN
|
|
IZA=0
|
|
DO 110 IY=1,5
|
|
IF(ABS(CUT-0.01D0*IY).LT.0.0001D0) IZA=IY
|
|
110 CONTINUE
|
|
IF(IZA.NE.0) THEN
|
|
ZHURAT=ZHUT(IZA)
|
|
ELSE
|
|
IZ=100D0*CUT
|
|
ZHURAT=ZHUT(IZ)+(100D0*CUT-IZ)*(ZHUT(IZ+1)-ZHUT(IZ))
|
|
ENDIF
|
|
PARJ(153)=ALSPI*PARJ(152)*ZHURAT
|
|
ENDIF
|
|
|
|
C...Shift in second order three-jet cross-section with optimized Q^2.
|
|
IF(MSTJ(111).EQ.1.AND.IABS(MSTJ(101)).GE.2.AND.MSTJ(101).NE.3
|
|
& .AND.CUT.LT.0.25D0) PARJ(153)=PARJ(153)+
|
|
& (33D0-2D0*MSTU(112))/12D0*LOG(PARJ(169))*ALSPI*PARJ(152)
|
|
|
|
C...Parametrization of second order four-jet cross-section.
|
|
IF(IABS(MSTJ(101)).LE.1.OR.CUT.GE.0.125D0) THEN
|
|
PARJ(154)=0D0
|
|
ELSE
|
|
CT=LOG(1D0/CUT-5D0)
|
|
IF(CUT.LE.0.018D0) THEN
|
|
XQQGG=6.349D0-4.330D0*CT+0.8304D0*CT**2
|
|
IF(MSTJ(109).EQ.2) XQQGG=(4D0/3D0)**2*(3.035D0-2.091D0*CT+
|
|
& 0.4059D0*CT**2)
|
|
XQQQQ=1.25D0*(-0.1080D0+0.01486D0*CT+0.009364D0*CT**2)
|
|
IF(MSTJ(109).EQ.2) XQQQQ=8D0*XQQQQ
|
|
ELSE
|
|
XQQGG=-0.09773D0+0.2959D0*CT-0.2764D0*CT**2+0.08832D0*CT**3
|
|
IF(MSTJ(109).EQ.2) XQQGG=(4D0/3D0)**2*(-0.04079D0+
|
|
& 0.1340D0*CT-0.1326D0*CT**2+0.04365D0*CT**3)
|
|
XQQQQ=1.25D0*(0.003661D0-0.004888D0*CT-0.001081D0*CT**2+
|
|
& 0.002093D0*CT**3)
|
|
IF(MSTJ(109).EQ.2) XQQQQ=8D0*XQQQQ
|
|
ENDIF
|
|
PARJ(154)=ALSPI**2*CT**2*(XQQGG+XQQQQ)/RQCD
|
|
PARJ(155)=XQQQQ/(XQQGG+XQQQQ)
|
|
ENDIF
|
|
|
|
C...If negative three-jet rate, change y' optimization parameter.
|
|
IF(MSTJ(111).EQ.1.AND.PARJ(152)+PARJ(153).LT.0D0.AND.
|
|
& PARJ(169).LT.0.99D0) THEN
|
|
PARJ(169)=MIN(1D0,1.2D0*PARJ(169))
|
|
Q2=PARJ(169)*ECM**2
|
|
ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1)
|
|
GOTO 100
|
|
ENDIF
|
|
|
|
C...If too high cross-section, use harder cuts, or fail.
|
|
IF(PARJ(152)+PARJ(153)+PARJ(154).GE.1) THEN
|
|
IF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499D0.AND.MSTJ(111).EQ.1.AND.
|
|
& PARJ(169).LT.0.99D0) THEN
|
|
PARJ(169)=MIN(1D0,1.2D0*PARJ(169))
|
|
Q2=PARJ(169)*ECM**2
|
|
ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1)
|
|
GOTO 100
|
|
ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499D0) THEN
|
|
CALL PYERRM(26,
|
|
& '(PYXJET:) no allowed y cut value for Zhu parametrization')
|
|
ENDIF
|
|
CUT=0.26D0*(4D0*CUT)**(PARJ(152)+PARJ(153)+
|
|
& PARJ(154))**(-1D0/3D0)
|
|
IF(MSTJ(110).EQ.2) CUT=MAX(0.01D0,MIN(0.05D0,CUT))
|
|
GOTO 100
|
|
ENDIF
|
|
|
|
C...Scalar gluon (first order only).
|
|
ELSE
|
|
ALSPI=PYALPS(ECM**2)/PARU(1)
|
|
CUT=MAX(0.001D0,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3D0/ALSPI))
|
|
PARJ(152)=0D0
|
|
IF(CUT.LT.0.25D0) PARJ(152)=(ALSPI/3D0)*((1D0-2D0*CUT)*
|
|
& LOG((1D0-2D0*CUT)/CUT)+0.5D0*(9D0*CUT**2-1D0))
|
|
PARJ(153)=0D0
|
|
PARJ(154)=0D0
|
|
ENDIF
|
|
|
|
C...Select number of jets.
|
|
PARJ(150)=CUT
|
|
IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN
|
|
NJET=2
|
|
ELSEIF(MSTJ(101).LE.0) THEN
|
|
NJET=MIN(4,2-MSTJ(101))
|
|
ELSE
|
|
RNJ=PYR(0)
|
|
NJET=2
|
|
IF(PARJ(152)+PARJ(153)+PARJ(154).GT.RNJ) NJET=3
|
|
IF(PARJ(154).GT.RNJ) NJET=4
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYX3JT
|
|
C...Selects the kinematical variables of three-jet events.
|
|
|
|
SUBROUTINE PYX3JT(NJET,CUT,KFL,ECM,X1,X2)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
C...Local array.
|
|
DIMENSION ZHUP(5,12)
|
|
|
|
C...Coefficients of Zhu second order parametrization.
|
|
DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/
|
|
&18.29D0, 89.56D0, 4.541D0, -52.09D0, -109.8D0, 24.90D0,
|
|
&11.63D0, 3.683D0, 17.50D0,0.002440D0, -1.362D0,-0.3537D0,
|
|
&11.42D0, 6.299D0, -22.55D0, -8.915D0, 59.25D0, -5.855D0,
|
|
&-32.85D0, -1.054D0, -16.90D0,0.006489D0,-0.8156D0,0.01095D0,
|
|
&7.847D0, -3.964D0, -35.83D0, 1.178D0, 29.39D0, 0.2806D0,
|
|
&47.82D0, -12.36D0, -56.72D0, 0.04054D0,-0.4365D0, 0.6062D0,
|
|
&5.441D0, -56.89D0, -50.27D0, 15.13D0, 114.3D0, -18.19D0,
|
|
&97.05D0, -1.890D0, -139.9D0, 0.08153D0,-0.4984D0, 0.9439D0,
|
|
&-17.65D0, 51.44D0, -58.32D0, 70.95D0, -255.7D0, -78.99D0,
|
|
&476.9D0, 29.65D0, -239.3D0, 0.4745D0, -1.174D0, 6.081D0/
|
|
|
|
C...Dilogarithm of x for x<0.5 (x>0.5 obtained by analytic trick).
|
|
DILOG(X)=X+X**2/4D0+X**3/9D0+X**4/16D0+X**5/25D0+X**6/36D0+
|
|
&X**7/49D0
|
|
|
|
C...Event type. Mass effect factors and other common constants.
|
|
MSTJ(120)=2
|
|
MSTJ(121)=0
|
|
PMQ=PYMASS(KFL)
|
|
QME=(2D0*PMQ/ECM)**2
|
|
IF(MSTJ(109).NE.1) THEN
|
|
CUTL=LOG(CUT)
|
|
CUTD=LOG(1D0/CUT-2D0)
|
|
IF(MSTJ(109).EQ.0) THEN
|
|
CF=4D0/3D0
|
|
CN=3D0
|
|
TR=2D0
|
|
WTMX=MIN(20D0,37D0-6D0*CUTD)
|
|
IF(MSTJ(110).EQ.2) WTMX=2D0*(7.5D0+80D0*CUT)
|
|
ELSE
|
|
CF=1D0
|
|
CN=0D0
|
|
TR=12D0
|
|
WTMX=0D0
|
|
ENDIF
|
|
|
|
C...Alpha_strong and effects of optimized Q^2 scale. Maximum weight.
|
|
ALS2PI=PARU(118)/PARU(2)
|
|
WTOPT=0D0
|
|
IF(MSTJ(111).EQ.1) WTOPT=(33D0-2D0*MSTU(112))/6D0*
|
|
& LOG(PARJ(169))*ALS2PI
|
|
WTMAX=MAX(0D0,1D0+WTOPT+ALS2PI*WTMX)
|
|
|
|
C...Choose three-jet events in allowed region.
|
|
100 NJET=3
|
|
110 Y13L=CUTL+CUTD*PYR(0)
|
|
Y23L=CUTL+CUTD*PYR(0)
|
|
Y13=EXP(Y13L)
|
|
Y23=EXP(Y23L)
|
|
Y12=1D0-Y13-Y23
|
|
IF(Y12.LE.CUT) GOTO 110
|
|
IF(Y13**2+Y23**2+2D0*Y12.LE.2D0*PYR(0)) GOTO 110
|
|
|
|
C...Second order corrections.
|
|
IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN
|
|
Y12L=LOG(Y12)
|
|
Y13M=LOG(1D0-Y13)
|
|
Y23M=LOG(1D0-Y23)
|
|
Y12M=LOG(1D0-Y12)
|
|
IF(Y13.LE.0.5D0) Y13I=DILOG(Y13)
|
|
IF(Y13.GE.0.5D0) Y13I=1.644934D0-Y13L*Y13M-DILOG(1D0-Y13)
|
|
IF(Y23.LE.0.5D0) Y23I=DILOG(Y23)
|
|
IF(Y23.GE.0.5D0) Y23I=1.644934D0-Y23L*Y23M-DILOG(1D0-Y23)
|
|
IF(Y12.LE.0.5D0) Y12I=DILOG(Y12)
|
|
IF(Y12.GE.0.5D0) Y12I=1.644934D0-Y12L*Y12M-DILOG(1D0-Y12)
|
|
WT1=(Y13**2+Y23**2+2D0*Y12)/(Y13*Y23)
|
|
WT2=CF*(-2D0*(CUTL-Y12L)**2-3D0*CUTL-1D0+3.289868D0+
|
|
& 2D0*(2D0*CUTL-Y12L)*CUT/Y12)+
|
|
& CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2-
|
|
& 11D0*CUTL/6D0+67D0/18D0+1.644934D0-(2D0*CUTL-Y12L)*CUT/Y12+
|
|
& (2D0*CUTL-Y13L)*CUT/Y13+(2D0*CUTL-Y23L)*CUT/Y23)+
|
|
& TR*(2D0*CUTL/3D0-10D0/9D0)+
|
|
& CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+
|
|
& Y13L*(4D0*Y12**2+2D0*Y12*Y13+4D0*Y12*Y23+Y13*Y23)/
|
|
& (Y12+Y23)**2+Y23L*(4D0*Y12**2+2D0*Y12*Y23+4D0*Y12*Y13+
|
|
& Y13*Y23)/(Y12+Y13)**2)/WT1+
|
|
& CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+(CN-2D0*CF)*
|
|
& ((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L*
|
|
& Y23M+1.644934D0-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)*
|
|
& (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934D0-Y12I-Y13I)/
|
|
& (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))-
|
|
& 2D0*Y12L*Y12**2/(Y13+Y23)**2-4D0*Y12L*Y12/(Y13+Y23))/WT1-
|
|
& CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934D0-Y13I-Y23I)
|
|
IF(1D0+WTOPT+ALS2PI*WT2.LE.0D0) MSTJ(121)=1
|
|
IF(1D0+WTOPT+ALS2PI*WT2.LE.WTMAX*PYR(0)) GOTO 110
|
|
PARJ(156)=(WTOPT+ALS2PI*WT2)/(1D0+WTOPT+ALS2PI*WT2)
|
|
|
|
ELSEIF(MSTJ(101).EQ.2.AND.MSTJ(110).EQ.2) THEN
|
|
C...Second order corrections; Zhu parametrization of ERT.
|
|
ZX=(Y23-Y13)**2
|
|
ZY=1D0-Y12
|
|
IZA=0
|
|
DO 120 IY=1,5
|
|
IF(ABS(CUT-0.01D0*IY).LT.0.0001D0) IZA=IY
|
|
120 CONTINUE
|
|
IF(IZA.NE.0) THEN
|
|
IZ=IZA
|
|
WT2=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+
|
|
& ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+
|
|
& (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+
|
|
& ZHUP(IZ,11)/(1D0-ZY)+ZHUP(IZ,12)/ZY
|
|
ELSE
|
|
IZ=100D0*CUT
|
|
WTL=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+
|
|
& ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+
|
|
& (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+
|
|
& ZHUP(IZ,11)/(1D0-ZY)+ZHUP(IZ,12)/ZY
|
|
IZ=IZ+1
|
|
WTU=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+
|
|
& ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+
|
|
& (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+
|
|
& ZHUP(IZ,11)/(1D0-ZY)+ZHUP(IZ,12)/ZY
|
|
WT2=WTL+(WTU-WTL)*(100D0*CUT+1D0-IZ)
|
|
ENDIF
|
|
IF(1D0+WTOPT+2D0*ALS2PI*WT2.LE.0D0) MSTJ(121)=1
|
|
IF(1D0+WTOPT+2D0*ALS2PI*WT2.LE.WTMAX*PYR(0)) GOTO 110
|
|
PARJ(156)=(WTOPT+2D0*ALS2PI*WT2)/(1D0+WTOPT+2D0*ALS2PI*WT2)
|
|
ENDIF
|
|
|
|
C...Impose mass cuts (gives two jets). For fixed jet number new try.
|
|
X1=1D0-Y23
|
|
X2=1D0-Y13
|
|
X3=1D0-Y12
|
|
IF(4D0*Y23*Y13*Y12/X3**2.LE.QME) NJET=2
|
|
IF(MOD(MSTJ(103),4).GE.2.AND.IABS(MSTJ(101)).LE.1.AND.QME*X3+
|
|
& 0.5D0*QME**2+(0.5D0*QME+0.25D0*QME**2)*((1D0-X2)/(1D0-X1)+
|
|
& (1D0-X1)/(1D0-X2)).GT.(X1**2+X2**2)*PYR(0)) NJET=2
|
|
IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 100
|
|
|
|
C...Scalar gluon model (first order only, no mass effects).
|
|
ELSE
|
|
130 NJET=3
|
|
140 X3=SQRT(4D0*CUT**2+PYR(0)*((1D0-CUT)**2-4D0*CUT**2))
|
|
IF(LOG((X3-CUT)/CUT).LE.PYR(0)*LOG((1D0-2D0*CUT)/CUT)) GOTO 140
|
|
YD=SIGN(2D0*CUT*((X3-CUT)/CUT)**PYR(0)-X3,PYR(0)-0.5D0)
|
|
X1=1D0-0.5D0*(X3+YD)
|
|
X2=1D0-0.5D0*(X3-YD)
|
|
IF(4D0*(1D0-X1)*(1D0-X2)*(1D0-X3)/X3**2.LE.QME) NJET=2
|
|
IF(MSTJ(102).GE.2) THEN
|
|
IF(X3**2-2D0*(1D0+X3)*(1D0-X1)*(1D0-X2)*PARJ(171).LT.
|
|
& X3**2*PYR(0)) NJET=2
|
|
ENDIF
|
|
IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 130
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYX4JT
|
|
C...Selects the kinematical variables of four-jet events.
|
|
|
|
SUBROUTINE PYX4JT(NJET,CUT,KFL,ECM,KFLN,X1,X2,X4,X12,X14)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
C...Local arrays.
|
|
DIMENSION WTA(4),WTB(4),WTC(4),WTD(4),WTE(4)
|
|
|
|
C...Common constants. Colour factors for QCD and Abelian gluon theory.
|
|
PMQ=PYMASS(KFL)
|
|
QME=(2D0*PMQ/ECM)**2
|
|
CT=LOG(1D0/CUT-5D0)
|
|
IF(MSTJ(109).EQ.0) THEN
|
|
CF=4D0/3D0
|
|
CN=3D0
|
|
TR=2.5D0
|
|
ELSE
|
|
CF=1D0
|
|
CN=0D0
|
|
TR=15D0
|
|
ENDIF
|
|
|
|
C...Choice of process (qqbargg or qqbarqqbar).
|
|
100 NJET=4
|
|
IT=1
|
|
IF(PARJ(155).GT.PYR(0)) IT=2
|
|
IF(MSTJ(101).LE.-3) IT=-MSTJ(101)-2
|
|
IF(IT.EQ.1) WTMX=0.7D0/CUT**2
|
|
IF(IT.EQ.1.AND.MSTJ(109).EQ.2) WTMX=0.6D0/CUT**2
|
|
IF(IT.EQ.2) WTMX=0.1125D0*CF*TR/CUT**2
|
|
ID=1
|
|
|
|
C...Sample the five kinematical variables (for qqgg preweighted in y34).
|
|
110 Y134=3D0*CUT+(1D0-6D0*CUT)*PYR(0)
|
|
Y234=3D0*CUT+(1D0-6D0*CUT)*PYR(0)
|
|
IF(IT.EQ.1) Y34=(1D0-5D0*CUT)*EXP(-CT*PYR(0))
|
|
IF(IT.EQ.2) Y34=CUT+(1D0-6D0*CUT)*PYR(0)
|
|
IF(Y34.LE.Y134+Y234-1D0.OR.Y34.GE.Y134*Y234) GOTO 110
|
|
VT=PYR(0)
|
|
CP=COS(PARU(1)*PYR(0))
|
|
Y14=(Y134-Y34)*VT
|
|
Y13=Y134-Y14-Y34
|
|
VB=Y34*(1D0-Y134-Y234+Y34)/((Y134-Y34)*(Y234-Y34))
|
|
Y24=0.5D0*(Y234-Y34)*(1D0-4D0*SQRT(MAX(0D0,VT*(1D0-VT)*
|
|
&VB*(1D0-VB)))*CP-(1D0-2D0*VT)*(1D0-2D0*VB))
|
|
Y23=Y234-Y34-Y24
|
|
Y12=1D0-Y134-Y23-Y24
|
|
IF(MIN(Y12,Y13,Y14,Y23,Y24).LE.CUT) GOTO 110
|
|
Y123=Y12+Y13+Y23
|
|
Y124=Y12+Y14+Y24
|
|
|
|
C...Calculate matrix elements for qqgg or qqqq process.
|
|
IC=0
|
|
WTTOT=0D0
|
|
120 IC=IC+1
|
|
IF(IT.EQ.1) THEN
|
|
WTA(IC)=(Y12*Y34**2-Y13*Y24*Y34+Y14*Y23*Y34+3D0*Y12*Y23*Y34+
|
|
& 3D0*Y12*Y14*Y34+4D0*Y12**2*Y34-Y13*Y23*Y24+2D0*Y12*Y23*Y24-
|
|
& Y13*Y14*Y24-2D0*Y12*Y13*Y24+2D0*Y12**2*Y24+Y14*Y23**2+2D0*Y12*
|
|
& Y23**2+Y14**2*Y23+4D0*Y12*Y14*Y23+4D0*Y12**2*Y23+2D0*Y12*Y14**2+
|
|
& 2D0*Y12*Y13*Y14+4D0*Y12**2*Y14+2D0*Y12**2*Y13+2D0*Y12**3)/
|
|
& (2D0*Y13*Y134*Y234*Y24)+(Y24*Y34+Y12*Y34+Y13*Y24-
|
|
& Y14*Y23+Y12*Y13)/(Y13*Y134**2)+2D0*Y23*(1D0-Y13)/
|
|
& (Y13*Y134*Y24)+Y34/(2D0*Y13*Y24)
|
|
WTB(IC)=(Y12*Y24*Y34+Y12*Y14*Y34-Y13*Y24**2+Y13*Y14*Y24+2D0*Y12*
|
|
& Y14*Y24)/(Y13*Y134*Y23*Y14)+Y12*(1D0+Y34)*Y124/(Y134*Y234*Y14*
|
|
& Y24)-(2D0*Y13*Y24+Y14**2+Y13*Y23+2D0*Y12*Y13)/(Y13*Y134*Y14)+
|
|
& Y12*Y123*Y124/(2D0*Y13*Y14*Y23*Y24)
|
|
WTC(IC)=-(5D0*Y12*Y34**2+2D0*Y12*Y24*Y34+2D0*Y12*Y23*Y34+
|
|
& 2D0*Y12*Y14*Y34+2D0*Y12*Y13*Y34+4D0*Y12**2*Y34-Y13*Y24**2+
|
|
& Y14*Y23*Y24+Y13*Y23*Y24+Y13*Y14*Y24-Y12*Y14*Y24-Y13**2*Y24-
|
|
& 3D0*Y12*Y13*Y24-Y14*Y23**2-Y14**2*Y23+Y13*Y14*Y23-
|
|
& 3D0*Y12*Y14*Y23-Y12*Y13*Y23)/(4D0*Y134*Y234*Y34**2)+
|
|
& (3D0*Y12*Y34**2-3D0*Y13*Y24*Y34+3D0*Y12*Y24*Y34+
|
|
& 3D0*Y14*Y23*Y34-Y13*Y24**2-Y12*Y23*Y34+6D0*Y12*Y14*Y34+
|
|
& 2D0*Y12*Y13*Y34-2D0*Y12**2*Y34+Y14*Y23*Y24-3D0*Y13*Y23*Y24-
|
|
& 2D0*Y13*Y14*Y24+4D0*Y12*Y14*Y24+2D0*Y12*Y13*Y24+
|
|
& 3D0*Y14*Y23**2+2D0*Y14**2*Y23+2D0*Y14**2*Y12+
|
|
& 2D0*Y12**2*Y14+6D0*Y12*Y14*Y23-2D0*Y12*Y13**2-
|
|
& 2D0*Y12**2*Y13)/(4D0*Y13*Y134*Y234*Y34)
|
|
WTC(IC)=WTC(IC)+(2D0*Y12*Y34**2-2D0*Y13*Y24*Y34+Y12*Y24*Y34+
|
|
& 4D0*Y13*Y23*Y34+4D0*Y12*Y14*Y34+2D0*Y12*Y13*Y34+2D0*Y12**2*Y34-
|
|
& Y13*Y24**2+3D0*Y14*Y23*Y24+4D0*Y13*Y23*Y24-2D0*Y13*Y14*Y24+
|
|
& 4D0*Y12*Y14*Y24+2D0*Y12*Y13*Y24+2D0*Y14*Y23**2+4D0*Y13*Y23**2+
|
|
& 2D0*Y13*Y14*Y23+2D0*Y12*Y14*Y23+4D0*Y12*Y13*Y23+2D0*Y12*Y14**2+
|
|
& 4D0*Y12**2*Y13+4D0*Y12*Y13*Y14+2D0*Y12**2*Y14)/
|
|
& (4D0*Y13*Y134*Y24*Y34)-(Y12*Y34**2-2D0*Y14*Y24*Y34-
|
|
& 2D0*Y13*Y24*Y34-Y14*Y23*Y34+Y13*Y23*Y34+Y12*Y14*Y34+
|
|
& 2D0*Y12*Y13*Y34-2D0*Y14**2*Y24-4D0*Y13*Y14*Y24-
|
|
& 4D0*Y13**2*Y24-Y14**2*Y23-Y13**2*Y23+Y12*Y13*Y14-
|
|
& Y12*Y13**2)/(2D0*Y13*Y34*Y134**2)+(Y12*Y34**2-
|
|
& 4D0*Y14*Y24*Y34-2D0*Y13*Y24*Y34-2D0*Y14*Y23*Y34-
|
|
& 4D0*Y13*Y23*Y34-4D0*Y12*Y14*Y34-4D0*Y12*Y13*Y34-
|
|
& 2D0*Y13*Y14*Y24+2D0*Y13**2*Y24+2D0*Y14**2*Y23-
|
|
& 2D0*Y13*Y14*Y23-Y12*Y14**2-6D0*Y12*Y13*Y14-
|
|
& Y12*Y13**2)/(4D0*Y34**2*Y134**2)
|
|
WTTOT=WTTOT+Y34*CF*(CF*WTA(IC)+(CF-0.5D0*CN)*WTB(IC)+
|
|
& CN*WTC(IC))/8D0
|
|
ELSE
|
|
WTD(IC)=(Y13*Y23*Y34+Y12*Y23*Y34-Y12**2*Y34+Y13*Y23*Y24+2D0*Y12*
|
|
& Y23*Y24-Y14*Y23**2+Y12*Y13*Y24+Y12*Y14*Y23+Y12*Y13*Y14)/(Y13**2*
|
|
& Y123**2)-(Y12*Y34**2-Y13*Y24*Y34+Y12*Y24*Y34-Y14*Y23*Y34-Y12*
|
|
& Y23*Y34-Y13*Y24**2+Y14*Y23*Y24-Y13*Y23*Y24-Y13**2*Y24+Y14*
|
|
& Y23**2)/(Y13**2*Y123*Y134)+(Y13*Y14*Y12+Y34*Y14*Y12-Y34**2*Y12+
|
|
& Y13*Y14*Y24+2D0*Y34*Y14*Y24-Y23*Y14**2+Y34*Y13*Y24+Y34*Y23*Y14+
|
|
& Y34*Y13*Y23)/(Y13**2*Y134**2)-(Y34*Y12**2-Y13*Y24*Y12+Y34*Y24*
|
|
& Y12-Y23*Y14*Y12-Y34*Y14*Y12-Y13*Y24**2+Y23*Y14*Y24-Y13*Y14*Y24-
|
|
& Y13**2*Y24+Y23*Y14**2)/(Y13**2*Y134*Y123)
|
|
WTE(IC)=(Y12*Y34*(Y23-Y24+Y14+Y13)+Y13*Y24**2-Y14*Y23*Y24+Y13*
|
|
& Y23*Y24+Y13*Y14*Y24+Y13**2*Y24-Y14*Y23*(Y14+Y23+Y13))/(Y13*Y23*
|
|
& Y123*Y134)-Y12*(Y12*Y34-Y23*Y24-Y13*Y24-Y14*Y23-Y14*Y13)/(Y13*
|
|
& Y23*Y123**2)-(Y14+Y13)*(Y24+Y23)*Y34/(Y13*Y23*Y134*Y234)+
|
|
& (Y12*Y34*(Y14-Y24+Y23+Y13)+Y13*Y24**2-Y23*Y14*Y24+Y13*Y14*Y24+
|
|
& Y13*Y23*Y24+Y13**2*Y24-Y23*Y14*(Y14+Y23+Y13))/(Y13*Y14*Y134*
|
|
& Y123)-Y34*(Y34*Y12-Y14*Y24-Y13*Y24-Y23*Y14-Y23*Y13)/(Y13*Y14*
|
|
& Y134**2)-(Y23+Y13)*(Y24+Y14)*Y12/(Y13*Y14*Y123*Y124)
|
|
WTTOT=WTTOT+CF*(TR*WTD(IC)+(CF-0.5D0*CN)*WTE(IC))/16D0
|
|
ENDIF
|
|
|
|
C...Permutations of momenta in matrix element. Weighting.
|
|
130 IF(IC.EQ.1.OR.IC.EQ.3.OR.ID.EQ.2.OR.ID.EQ.3) THEN
|
|
YSAV=Y13
|
|
Y13=Y14
|
|
Y14=YSAV
|
|
YSAV=Y23
|
|
Y23=Y24
|
|
Y24=YSAV
|
|
YSAV=Y123
|
|
Y123=Y124
|
|
Y124=YSAV
|
|
ENDIF
|
|
IF(IC.EQ.2.OR.IC.EQ.4.OR.ID.EQ.3.OR.ID.EQ.4) THEN
|
|
YSAV=Y13
|
|
Y13=Y23
|
|
Y23=YSAV
|
|
YSAV=Y14
|
|
Y14=Y24
|
|
Y24=YSAV
|
|
YSAV=Y134
|
|
Y134=Y234
|
|
Y234=YSAV
|
|
ENDIF
|
|
IF(IC.LE.3) GOTO 120
|
|
IF(ID.EQ.1.AND.WTTOT.LT.PYR(0)*WTMX) GOTO 110
|
|
IC=5
|
|
|
|
C...qqgg events: string configuration and event type.
|
|
IF(IT.EQ.1) THEN
|
|
IF(MSTJ(109).EQ.0.AND.ID.EQ.1) THEN
|
|
PARJ(156)=Y34*(2D0*(WTA(1)+WTA(2)+WTA(3)+WTA(4))+4D0*(WTC(1)+
|
|
& WTC(2)+WTC(3)+WTC(4)))/(9D0*WTTOT)
|
|
IF(WTA(2)+WTA(4)+2D0*(WTC(2)+WTC(4)).GT.PYR(0)*(WTA(1)+WTA(2)+
|
|
& WTA(3)+WTA(4)+2D0*(WTC(1)+WTC(2)+WTC(3)+WTC(4)))) ID=2
|
|
IF(ID.EQ.2) GOTO 130
|
|
ELSEIF(MSTJ(109).EQ.2.AND.ID.EQ.1) THEN
|
|
PARJ(156)=Y34*(WTA(1)+WTA(2)+WTA(3)+WTA(4))/(8D0*WTTOT)
|
|
IF(WTA(2)+WTA(4).GT.PYR(0)*(WTA(1)+WTA(2)+WTA(3)+WTA(4))) ID=2
|
|
IF(ID.EQ.2) GOTO 130
|
|
ENDIF
|
|
MSTJ(120)=3
|
|
IF(MSTJ(109).EQ.0.AND.0.5D0*Y34*(WTC(1)+WTC(2)+WTC(3)+
|
|
& WTC(4)).GT.PYR(0)*WTTOT) MSTJ(120)=4
|
|
KFLN=21
|
|
|
|
C...Mass cuts. Kinematical variables out.
|
|
IF(Y12.LE.CUT+QME) NJET=2
|
|
IF(NJET.EQ.2) GOTO 150
|
|
Q12=0.5D0*(1D0-SQRT(1D0-QME/Y12))
|
|
X1=1D0-(1D0-Q12)*Y234-Q12*Y134
|
|
X4=1D0-(1D0-Q12)*Y134-Q12*Y234
|
|
X2=1D0-Y124
|
|
X12=(1D0-Q12)*Y13+Q12*Y23
|
|
X14=Y12-0.5D0*QME
|
|
IF(Y134*Y234/((1D0-X1)*(1D0-X4)).LE.PYR(0)) NJET=2
|
|
|
|
C...qqbarqqbar events: string configuration, choose new flavour.
|
|
ELSE
|
|
IF(ID.EQ.1) THEN
|
|
WTR=PYR(0)*(WTD(1)+WTD(2)+WTD(3)+WTD(4))
|
|
IF(WTR.LT.WTD(2)+WTD(3)+WTD(4)) ID=2
|
|
IF(WTR.LT.WTD(3)+WTD(4)) ID=3
|
|
IF(WTR.LT.WTD(4)) ID=4
|
|
IF(ID.GE.2) GOTO 130
|
|
ENDIF
|
|
MSTJ(120)=5
|
|
PARJ(156)=CF*TR*(WTD(1)+WTD(2)+WTD(3)+WTD(4))/(16D0*WTTOT)
|
|
140 KFLN=1+INT(5D0*PYR(0))
|
|
IF(KFLN.NE.KFL.AND.0.2D0*PARJ(156).LE.PYR(0)) GOTO 140
|
|
IF(KFLN.EQ.KFL.AND.1D0-0.8D0*PARJ(156).LE.PYR(0)) GOTO 140
|
|
IF(KFLN.GT.MSTJ(104)) NJET=2
|
|
PMQN=PYMASS(KFLN)
|
|
QMEN=(2D0*PMQN/ECM)**2
|
|
|
|
C...Mass cuts. Kinematical variables out.
|
|
IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1D0*QMEN) NJET=2
|
|
IF(NJET.EQ.2) GOTO 150
|
|
Q24=0.5D0*(1D0-SQRT(1D0-QME/Y24))
|
|
Q13=0.5D0*(1D0-SQRT(1D0-QMEN/Y13))
|
|
X1=1D0-(1D0-Q24)*Y123-Q24*Y134
|
|
X4=1D0-(1D0-Q24)*Y134-Q24*Y123
|
|
X2=1D0-(1D0-Q13)*Y234-Q13*Y124
|
|
X12=(1D0-Q24)*((1D0-Q13)*Y14+Q13*Y34)+Q24*((1D0-Q13)*Y12+
|
|
& Q13*Y23)
|
|
X14=Y24-0.5D0*QME
|
|
X34=(1D0-Q24)*((1D0-Q13)*Y23+Q13*Y12)+Q24*((1D0-Q13)*Y34+
|
|
& Q13*Y14)
|
|
IF(PMQ**2+PMQN**2+MIN(X12,X34)*ECM**2.LE.
|
|
& (PARJ(127)+PMQ+PMQN)**2) NJET=2
|
|
IF(Y123*Y134/((1D0-X1)*(1D0-X4)).LE.PYR(0)) NJET=2
|
|
ENDIF
|
|
150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYXDIF
|
|
C...Gives the angular orientation of events.
|
|
|
|
SUBROUTINE PYXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI)
|
|
|
|
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...Charge. Factors depending on polarization for QED case.
|
|
QF=KCHG(KFL,1)/3D0
|
|
POLL=1D0-PARJ(131)*PARJ(132)
|
|
POLD=PARJ(132)-PARJ(131)
|
|
IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN
|
|
HF1=POLL
|
|
HF2=0D0
|
|
HF3=PARJ(133)**2
|
|
HF4=0D0
|
|
|
|
C...Factors depending on flavour, energy and polarization for QFD case.
|
|
ELSE
|
|
SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102)))
|
|
SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
|
|
SFI=SFW*(1D0-(PARJ(123)/ECM)**2)
|
|
AE=-1D0
|
|
VE=4D0*PARU(102)-1D0
|
|
AF=SIGN(1D0,QF)
|
|
VF=AF-4D0*QF*PARU(102)
|
|
HF1=QF**2*POLL-2D0*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+
|
|
& (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2D0*VE*AE*POLD)
|
|
HF2=-2D0*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2D0*VF*AF*SFW*SFF**2*
|
|
& (2D0*VE*AE*POLL-(VE**2+AE**2)*POLD)
|
|
HF3=PARJ(133)**2*(QF**2-2D0*QF*VF*SFI*SFF*VE+(VF**2+AF**2)*
|
|
& SFW*SFF**2*(VE**2-AE**2))
|
|
HF4=-PARJ(133)**2*2D0*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)*
|
|
& SFF*AE
|
|
ENDIF
|
|
|
|
C...Mass factor. Differential cross-sections for two-jet events.
|
|
SQ2=SQRT(2D0)
|
|
QME=0D0
|
|
IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND.
|
|
&MSTJ(109).NE.1) QME=(2D0*PYMASS(KFL)/ECM)**2
|
|
IF(NJET.EQ.2) THEN
|
|
SIGU=4D0*SQRT(1D0-QME)
|
|
SIGL=2D0*QME*SQRT(1D0-QME)
|
|
SIGT=0D0
|
|
SIGI=0D0
|
|
SIGA=0D0
|
|
SIGP=4D0
|
|
|
|
C...Kinematical variables. Reduce four-jet event to three-jet one.
|
|
ELSE
|
|
IF(NJET.EQ.3) THEN
|
|
X1=2D0*P(NC+1,4)/ECM
|
|
X2=2D0*P(NC+3,4)/ECM
|
|
ELSE
|
|
ECMR=P(NC+1,4)+P(NC+4,4)+SQRT((P(NC+2,1)+P(NC+3,1))**2+
|
|
& (P(NC+2,2)+P(NC+3,2))**2+(P(NC+2,3)+P(NC+3,3))**2)
|
|
X1=2D0*P(NC+1,4)/ECMR
|
|
X2=2D0*P(NC+4,4)/ECMR
|
|
ENDIF
|
|
|
|
C...Differential cross-sections for three-jet (or reduced four-jet).
|
|
XQ=(1D0-X1)/(1D0-X2)
|
|
CT12=(X1*X2-2D0*X1-2D0*X2+2D0+QME)/SQRT((X1**2-QME)*(X2**2-QME))
|
|
ST12=SQRT(1D0-CT12**2)
|
|
IF(MSTJ(109).NE.1) THEN
|
|
SIGU=2D0*X1**2+X2**2*(1D0+CT12**2)-QME*(3D0+CT12**2-X1-X2)-
|
|
& QME*X1/XQ+0.5D0*QME*((X2**2-QME)*ST12**2-2D0*X2)*XQ
|
|
SIGL=(X2*ST12)**2-QME*(3D0-CT12**2-2.5D0*(X1+X2)+X1*X2+QME)+
|
|
& 0.5D0*QME*(X1**2-X1-QME)/XQ+0.5D0*QME*((X2**2-QME)*CT12**2-
|
|
& X2)*XQ
|
|
SIGT=0.5D0*(X2**2-QME-0.5D0*QME*(X2**2-QME)/XQ)*ST12**2
|
|
SIGI=((1D0-0.5D0*QME*XQ)*(X2**2-QME)*ST12*CT12+
|
|
& QME*(1D0-X1-X2+0.5D0*X1*X2+0.5D0*QME)*ST12/CT12)/SQ2
|
|
SIGA=X2**2*ST12/SQ2
|
|
SIGP=2D0*(X1**2-X2**2*CT12)
|
|
|
|
C...Differential cross-sect for scalar gluons (no mass effects).
|
|
ELSE
|
|
X3=2D0-X1-X2
|
|
XT=X2*ST12
|
|
CT13=SQRT(MAX(0D0,1D0-(XT/X3)**2))
|
|
SIGU=(1D0-PARJ(171))*(X3**2-0.5D0*XT**2)+
|
|
& PARJ(171)*(X3**2-0.5D0*XT**2-4D0*(1D0-X1)*(1D0-X2)**2/X1)
|
|
SIGL=(1D0-PARJ(171))*0.5D0*XT**2+
|
|
& PARJ(171)*0.5D0*(1D0-X1)**2*XT**2
|
|
SIGT=(1D0-PARJ(171))*0.25D0*XT**2+
|
|
& PARJ(171)*0.25D0*XT**2*(1D0-2D0*X1)
|
|
SIGI=-(0.5D0/SQ2)*((1D0-PARJ(171))*XT*X3*CT13+
|
|
& PARJ(171)*XT*((1D0-2D0*X1)*X3*CT13-X1*(X1-X2)))
|
|
SIGA=(0.25D0/SQ2)*XT*(2D0*(1D0-X1)-X1*X3)
|
|
SIGP=X3**2-2D0*(1D0-X1)*(1D0-X2)/X1
|
|
ENDIF
|
|
ENDIF
|
|
|
|
C...Upper bounds for differential cross-section.
|
|
HF1A=ABS(HF1)
|
|
HF2A=ABS(HF2)
|
|
HF3A=ABS(HF3)
|
|
HF4A=ABS(HF4)
|
|
SIGMAX=(2D0*HF1A+HF3A+HF4A)*ABS(SIGU)+2D0*(HF1A+HF3A+HF4A)*
|
|
&ABS(SIGL)+2D0*(HF1A+2D0*HF3A+2D0*HF4A)*ABS(SIGT)+2D0*SQ2*
|
|
&(HF1A+2D0*HF3A+2D0*HF4A)*ABS(SIGI)+4D0*SQ2*HF2A*ABS(SIGA)+
|
|
&2D0*HF2A*ABS(SIGP)
|
|
|
|
C...Generate angular orientation according to differential cross-sect.
|
|
100 CHI=PARU(2)*PYR(0)
|
|
CTHE=2D0*PYR(0)-1D0
|
|
PHI=PARU(2)*PYR(0)
|
|
CCHI=COS(CHI)
|
|
SCHI=SIN(CHI)
|
|
C2CHI=COS(2D0*CHI)
|
|
S2CHI=SIN(2D0*CHI)
|
|
THE=ACOS(CTHE)
|
|
STHE=SIN(THE)
|
|
C2PHI=COS(2D0*(PHI-PARJ(134)))
|
|
S2PHI=SIN(2D0*(PHI-PARJ(134)))
|
|
SIG=((1D0+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+
|
|
&2D0*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+
|
|
&2D0*(STHE**2*C2CHI*HF1+((1D0+CTHE**2)*C2CHI*C2PHI-2D0*CTHE*S2CHI*
|
|
&S2PHI)*HF3-((1D0+CTHE**2)*C2CHI*S2PHI+2D0*CTHE*S2CHI*C2PHI)*HF4)*
|
|
&SIGT-2D0*SQ2*(2D0*STHE*CTHE*CCHI*HF1-2D0*STHE*(CTHE*CCHI*C2PHI-
|
|
&SCHI*S2PHI)*HF3+2D0*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+
|
|
&4D0*SQ2*STHE*CCHI*HF2*SIGA+2D0*CTHE*HF2*SIGP
|
|
IF(SIG.LT.SIGMAX*PYR(0)) GOTO 100
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYONIA
|
|
C...Generates Upsilon and toponium decays into three gluons
|
|
C...or two gluons and a photon.
|
|
|
|
SUBROUTINE PYONIA(KFL,ECM)
|
|
|
|
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...Printout. Check input parameters.
|
|
IF(MSTU(12).GE.1) CALL PYLIST(0)
|
|
IF(KFL.LT.0.OR.KFL.GT.8) THEN
|
|
CALL PYERRM(16,'(PYONIA:) called with unknown flavour code')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
IF(ECM.LT.PARJ(127)+2.02D0*PARF(101)) THEN
|
|
CALL PYERRM(16,'(PYONIA:) called with too small CM energy')
|
|
IF(MSTU(21).GE.1) RETURN
|
|
ENDIF
|
|
|
|
C...Initial e+e- and onium state (optional).
|
|
NC=0
|
|
IF(MSTJ(115).GE.2) THEN
|
|
NC=NC+2
|
|
CALL PY1ENT(NC-1,11,0.5D0*ECM,0D0,0D0)
|
|
K(NC-1,1)=21
|
|
CALL PY1ENT(NC,-11,0.5D0*ECM,PARU(1),0D0)
|
|
K(NC,1)=21
|
|
ENDIF
|
|
KFLC=IABS(KFL)
|
|
IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN
|
|
NC=NC+1
|
|
KF=110*KFLC+3
|
|
MSTU10=MSTU(10)
|
|
MSTU(10)=1
|
|
P(NC,5)=ECM
|
|
CALL PY1ENT(NC,KF,ECM,0D0,0D0)
|
|
K(NC,1)=21
|
|
K(NC,3)=1
|
|
MSTU(10)=MSTU10
|
|
ENDIF
|
|
|
|
C...Choose x1 and x2 according to matrix element.
|
|
NTRY=0
|
|
100 X1=PYR(0)
|
|
X2=PYR(0)
|
|
X3=2D0-X1-X2
|
|
IF(X3.GE.1D0.OR.((1D0-X1)/(X2*X3))**2+((1D0-X2)/(X1*X3))**2+
|
|
&((1D0-X3)/(X1*X2))**2.LE.2D0*PYR(0)) GOTO 100
|
|
NTRY=NTRY+1
|
|
NJET=3
|
|
IF(MSTJ(101).LE.4) CALL PY3ENT(NC+1,21,21,21,ECM,X1,X3)
|
|
IF(MSTJ(101).GE.5) CALL PY3ENT(-(NC+1),21,21,21,ECM,X1,X3)
|
|
|
|
C...Photon-gluon-gluon events. Small system modifications. Jet origin.
|
|
MSTU(111)=MSTJ(108)
|
|
IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
|
|
&MSTU(111)=1
|
|
PARU(112)=PARJ(121)
|
|
IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
|
|
QF=0D0
|
|
IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3D0
|
|
RGAM=7.2D0*QF**2*PARU(101)/PYALPS(ECM**2)
|
|
MK=0
|
|
ECMC=ECM
|
|
IF(PYR(0).GT.RGAM/(1D0+RGAM)) THEN
|
|
IF(1D0-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125)))
|
|
& NJET=2
|
|
IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL PY2ENT(NC+1,21,21,ECM)
|
|
IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL PY2ENT(-(NC+1),21,21,ECM)
|
|
ELSE
|
|
MK=1
|
|
ECMC=SQRT(1D0-X1)*ECM
|
|
IF(ECMC.LT.2D0*PARJ(127)) GOTO 100
|
|
K(NC+1,1)=1
|
|
K(NC+1,2)=22
|
|
K(NC+1,4)=0
|
|
K(NC+1,5)=0
|
|
IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3)
|
|
IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3)
|
|
IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2)
|
|
IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2)
|
|
NJET=2
|
|
IF(ECMC.LT.4D0*PARJ(127)) THEN
|
|
MSTU10=MSTU(10)
|
|
MSTU(10)=1
|
|
P(NC+2,5)=ECMC
|
|
CALL PY1ENT(NC+2,83,0.5D0*(X2+X3)*ECM,PARU(1),0D0)
|
|
MSTU(10)=MSTU10
|
|
NJET=0
|
|
ENDIF
|
|
ENDIF
|
|
DO 110 IP=NC+1,N
|
|
K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1)
|
|
110 CONTINUE
|
|
|
|
C...Differential cross-sections. Upper limit for cross-section.
|
|
IF(MSTJ(106).EQ.1) THEN
|
|
SQ2=SQRT(2D0)
|
|
HF1=1D0-PARJ(131)*PARJ(132)
|
|
HF3=PARJ(133)**2
|
|
CT13=(X1*X3-2D0*X1-2D0*X3+2D0)/(X1*X3)
|
|
ST13=SQRT(1D0-CT13**2)
|
|
SIGL=0.5D0*X3**2*((1D0-X2)**2+(1D0-X3)**2)*ST13**2
|
|
SIGU=(X1*(1D0-X1))**2+(X2*(1D0-X2))**2+(X3*(1D0-X3))**2-SIGL
|
|
SIGT=0.5D0*SIGL
|
|
SIGI=(SIGL*CT13/ST13+0.5D0*X1*X3*(1D0-X2)**2*ST13)/SQ2
|
|
SIGMAX=(2D0*HF1+HF3)*ABS(SIGU)+2D0*(HF1+HF3)*ABS(SIGL)+2D0*(HF1+
|
|
& 2D0*HF3)*ABS(SIGT)+2D0*SQ2*(HF1+2D0*HF3)*ABS(SIGI)
|
|
|
|
C...Angular orientation of event.
|
|
120 CHI=PARU(2)*PYR(0)
|
|
CTHE=2D0*PYR(0)-1D0
|
|
PHI=PARU(2)*PYR(0)
|
|
CCHI=COS(CHI)
|
|
SCHI=SIN(CHI)
|
|
C2CHI=COS(2D0*CHI)
|
|
S2CHI=SIN(2D0*CHI)
|
|
THE=ACOS(CTHE)
|
|
STHE=SIN(THE)
|
|
C2PHI=COS(2D0*(PHI-PARJ(134)))
|
|
S2PHI=SIN(2D0*(PHI-PARJ(134)))
|
|
SIG=((1D0+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2D0*(STHE**2*HF1-
|
|
& STHE**2*C2PHI*HF3)*SIGL+2D0*(STHE**2*C2CHI*HF1+((1D0+CTHE**2)*
|
|
& C2CHI*C2PHI-2D0*CTHE*S2CHI*S2PHI)*HF3)*SIGT-
|
|
& 2D0*SQ2*(2D0*STHE*CTHE*CCHI*HF1-2D0*STHE*
|
|
& (CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI
|
|
IF(SIG.LT.SIGMAX*PYR(0)) GOTO 120
|
|
CALL PYROBO(NC+1,N,0D0,CHI,0D0,0D0,0D0)
|
|
CALL PYROBO(NC+1,N,THE,PHI,0D0,0D0,0D0)
|
|
ENDIF
|
|
|
|
C...Generate parton shower. Rearrange along strings and check.
|
|
IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN
|
|
CALL PYSHOW(NC+MK+1,-NJET,ECMC)
|
|
MSTJ14=MSTJ(14)
|
|
IF(MSTJ(105).EQ.-1) MSTJ(14)=-1
|
|
IF(MSTJ(105).GE.0) MSTU(28)=0
|
|
CALL PYPREP(0)
|
|
MSTJ(14)=MSTJ14
|
|
IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
|
|
ENDIF
|
|
|
|
C...Generate fragmentation. Information for PYTABU:
|
|
IF(MSTJ(105).EQ.1) CALL PYEXEC
|
|
MSTU(161)=110*KFLC+3
|
|
MSTU(162)=0
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYBOOK
|
|
C...Books a histogram.
|
|
|
|
SUBROUTINE PYBOOK(ID,TITLE,NX,XL,XU)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
C...Commonblock.
|
|
COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
|
|
SAVE /PYBINS/
|
|
C...Local character variables.
|
|
CHARACTER TITLE*(*), TITFX*60
|
|
|
|
C...Check that input is sensible. Find initial address in memory.
|
|
IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28,
|
|
&'(PYBOOK:) not allowed histogram number')
|
|
IF(NX.LE.0.OR.NX.GT.100) CALL PYERRM(28,
|
|
&'(PYBOOK:) not allowed number of bins')
|
|
IF(XL.GE.XU) CALL PYERRM(28,
|
|
&'(PYBOOK:) x limits in wrong order')
|
|
INDX(ID)=IHIST(4)
|
|
IHIST(4)=IHIST(4)+28+NX
|
|
IF(IHIST(4).GT.IHIST(2)) CALL PYERRM(28,
|
|
&'(PYBOOK:) out of histogram space')
|
|
IS=INDX(ID)
|
|
|
|
C...Store histogram size and reset contents.
|
|
BIN(IS+1)=NX
|
|
BIN(IS+2)=XL
|
|
BIN(IS+3)=XU
|
|
BIN(IS+4)=(XU-XL)/NX
|
|
CALL PYNULL(ID)
|
|
|
|
C...Store title by conversion to integer to double precision.
|
|
TITFX=TITLE//' '
|
|
DO 100 IT=1,20
|
|
BIN(IS+8+NX+IT)=256**2*ICHAR(TITFX(3*IT-2:3*IT-2))+
|
|
& 256*ICHAR(TITFX(3*IT-1:3*IT-1))+ICHAR(TITFX(3*IT:3*IT))
|
|
100 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYFILL
|
|
C...Fills entry in histogram.
|
|
|
|
SUBROUTINE PYFILL(ID,X,W)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
C...Commonblock.
|
|
COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
|
|
SAVE /PYBINS/
|
|
|
|
C...Find initial address in memory. Increase number of entries.
|
|
IS=INDX(ID)
|
|
BIN(IS+5)=BIN(IS+5)+1D0
|
|
|
|
C...Find bin in x, including under/overflow, and fill.
|
|
IF(X.LT.BIN(IS+2)) THEN
|
|
BIN(IS+6)=BIN(IS+6)+W
|
|
ELSEIF(X.GE.BIN(IS+3)) THEN
|
|
BIN(IS+8)=BIN(IS+8)+W
|
|
ELSE
|
|
BIN(IS+7)=BIN(IS+7)+W
|
|
IX=(X-BIN(IS+2))/BIN(IS+4)
|
|
IX=MAX(0,MIN(NINT(BIN(IS+1))-1,IX))
|
|
BIN(IS+9+IX)=BIN(IS+9+IX)+W
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYFACT
|
|
C...Multiplies histogram contents by factor.
|
|
|
|
SUBROUTINE PYFACT(ID,F)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
C...Commonblock.
|
|
COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
|
|
SAVE /PYBINS/
|
|
|
|
C...Find initial address in memory. Multiply all contents bins.
|
|
IS=INDX(ID)
|
|
DO 100 IX=IS+6,IS+8+NINT(BIN(IS+1))
|
|
BIN(IX)=F*BIN(IX)
|
|
100 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYOPER
|
|
C...Performs operations between histograms.
|
|
|
|
SUBROUTINE PYOPER(ID1,OPER,ID2,ID3,F1,F2)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
C...Commonblock.
|
|
COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
|
|
SAVE /PYBINS/
|
|
C...Character variable.
|
|
CHARACTER OPER*(*)
|
|
|
|
C...Find initial addresses in memory, and histogram size.
|
|
IS1=INDX(ID1)
|
|
IS2=INDX(MIN(IHIST(1),MAX(1,ID2)))
|
|
IS3=INDX(MIN(IHIST(1),MAX(1,ID3)))
|
|
NX=NINT(BIN(IS3+1))
|
|
IF(OPER.EQ.'M'.AND.ID3.EQ.0) NX=NINT(BIN(IS2+1))
|
|
|
|
C...Update info on number of histogram entries.
|
|
IF(OPER.EQ.'+'.OR.OPER.EQ.'-'.OR.OPER.EQ.'*'.OR.OPER.EQ.'/') THEN
|
|
BIN(IS3+5)=BIN(IS1+5)+BIN(IS2+5)
|
|
ELSEIF(OPER.EQ.'A'.OR.OPER.EQ.'S'.OR.OPER.EQ.'L') THEN
|
|
BIN(IS3+5)=BIN(IS1+5)
|
|
ENDIF
|
|
|
|
C...Operations on pair of histograms: addition, subtraction,
|
|
C...multiplication, division.
|
|
IF(OPER.EQ.'+') THEN
|
|
DO 100 IX=6,8+NX
|
|
BIN(IS3+IX)=F1*BIN(IS1+IX)+F2*BIN(IS2+IX)
|
|
100 CONTINUE
|
|
ELSEIF(OPER.EQ.'-') THEN
|
|
DO 110 IX=6,8+NX
|
|
BIN(IS3+IX)=F1*BIN(IS1+IX)-F2*BIN(IS2+IX)
|
|
110 CONTINUE
|
|
ELSEIF(OPER.EQ.'*') THEN
|
|
DO 120 IX=6,8+NX
|
|
BIN(IS3+IX)=F1*BIN(IS1+IX)*F2*BIN(IS2+IX)
|
|
120 CONTINUE
|
|
ELSEIF(OPER.EQ.'/') THEN
|
|
DO 130 IX=6,8+NX
|
|
FA2=F2*BIN(IS2+IX)
|
|
IF(ABS(FA2).LE.1D-20) THEN
|
|
BIN(IS3+IX)=0D0
|
|
ELSE
|
|
BIN(IS3+IX)=F1*BIN(IS1+IX)/FA2
|
|
ENDIF
|
|
130 CONTINUE
|
|
|
|
C...Operations on single histogram: multiplication+addition,
|
|
C...square root+addition, logarithm+addition.
|
|
ELSEIF(OPER.EQ.'A') THEN
|
|
DO 140 IX=6,8+NX
|
|
BIN(IS3+IX)=F1*BIN(IS1+IX)+F2
|
|
140 CONTINUE
|
|
ELSEIF(OPER.EQ.'S') THEN
|
|
DO 150 IX=6,8+NX
|
|
BIN(IS3+IX)=F1*SQRT(MAX(0D0,BIN(IS1+IX)))+F2
|
|
150 CONTINUE
|
|
ELSEIF(OPER.EQ.'L') THEN
|
|
ZMIN=1D20
|
|
DO 160 IX=9,8+NX
|
|
IF(BIN(IS1+IX).LT.ZMIN.AND.BIN(IS1+IX).GT.1D-20)
|
|
& ZMIN=0.8D0*BIN(IS1+IX)
|
|
160 CONTINUE
|
|
DO 170 IX=6,8+NX
|
|
BIN(IS3+IX)=F1*LOG10(MAX(ZMIN,BIN(IS1+IX)))+F2
|
|
170 CONTINUE
|
|
|
|
C...Operation on two or three histograms: average and
|
|
C...standard deviation.
|
|
ELSEIF(OPER.EQ.'M') THEN
|
|
DO 180 IX=6,8+NX
|
|
IF(ABS(BIN(IS1+IX)).LE.1D-20) THEN
|
|
BIN(IS2+IX)=0D0
|
|
ELSE
|
|
BIN(IS2+IX)=BIN(IS2+IX)/BIN(IS1+IX)
|
|
ENDIF
|
|
IF(ID3.NE.0) THEN
|
|
IF(ABS(BIN(IS1+IX)).LE.1D-20) THEN
|
|
BIN(IS3+IX)=0D0
|
|
ELSE
|
|
BIN(IS3+IX)=SQRT(MAX(0D0,BIN(IS3+IX)/BIN(IS1+IX)-
|
|
& BIN(IS2+IX)**2))
|
|
ENDIF
|
|
ENDIF
|
|
BIN(IS1+IX)=F1*BIN(IS1+IX)
|
|
180 CONTINUE
|
|
ENDIF
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYHIST
|
|
C...Prints and resets all histograms.
|
|
|
|
SUBROUTINE PYHIST
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
C...Commonblock.
|
|
COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
|
|
SAVE /PYBINS/
|
|
|
|
C...Loop over histograms, print and reset used ones.
|
|
DO 100 ID=1,IHIST(1)
|
|
IS=INDX(ID)
|
|
IF(IS.NE.0.AND.NINT(BIN(IS+5)).GT.0) THEN
|
|
CALL PYPLOT(ID)
|
|
CALL PYNULL(ID)
|
|
ENDIF
|
|
100 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYPLOT
|
|
C...Prints a histogram (but does not reset it).
|
|
|
|
SUBROUTINE PYPLOT(ID)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
C...Commonblocks.
|
|
COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
|
|
COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
|
|
SAVE /PYDAT1/,/PYBINS/
|
|
C...Local arrays and character variables.
|
|
DIMENSION IDATI(6), IROW(100), IFRA(100), DYAC(10)
|
|
CHARACTER TITLE*60, OUT*100, CHA(0:11)*1
|
|
|
|
C...Steps in histogram scale. Character sequence.
|
|
DATA DYAC/.04,.05,.06,.08,.10,.12,.15,.20,.25,.30/
|
|
DATA CHA/'0','1','2','3','4','5','6','7','8','9','X','-'/
|
|
|
|
C...Find initial address in memory; skip if empty histogram.
|
|
IS=INDX(ID)
|
|
IF(NINT(BIN(IS+5)).LE.0) THEN
|
|
WRITE(MSTU(11),5000) ID
|
|
RETURN
|
|
ENDIF
|
|
|
|
C...Number of histogram lines and x bins.
|
|
LIN=IHIST(3)-18
|
|
NX=NINT(BIN(IS+1))
|
|
|
|
C...Extract title by conversion from double precision via integer.
|
|
DO 100 IT=1,20
|
|
IEQ=NINT(BIN(IS+8+NX+IT))
|
|
TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)//CHAR(MOD(IEQ,256**2)/256)
|
|
& //CHAR(MOD(IEQ,256))
|
|
100 CONTINUE
|
|
|
|
C...Find time; print title.
|
|
CALL PYTIME(IDATI)
|
|
IF(IDATI(1).GT.0) THEN
|
|
WRITE(MSTU(11),5100) ID, TITLE, (IDATI(J),J=1,5)
|
|
ELSE
|
|
WRITE(MSTU(11),5200) ID, TITLE
|
|
ENDIF
|
|
|
|
C...Find minimum and maximum bin content.
|
|
YMIN=BIN(IS+9)
|
|
YMAX=BIN(IS+9)
|
|
DO 110 IX=IS+10,IS+8+NX
|
|
IF(BIN(IX).LT.YMIN) YMIN=BIN(IX)
|
|
IF(BIN(IX).GT.YMAX) YMAX=BIN(IX)
|
|
110 CONTINUE
|
|
|
|
C...Determine scale and step size for y axis.
|
|
IF(YMAX-YMIN.GT.LIN*DYAC(1)*1D-9) THEN
|
|
IF(YMIN.GT.0D0.AND.YMIN.LT.0.1D0*YMAX) YMIN=0D0
|
|
IF(YMAX.LT.0D0.AND.YMAX.GT.0.1D0*YMIN) YMAX=0D0
|
|
IPOT=INT(LOG10(YMAX-YMIN)+10D0)-10
|
|
IF(YMAX-YMIN.LT.LIN*DYAC(1)*10D0**IPOT) IPOT=IPOT-1
|
|
IF(YMAX-YMIN.GT.LIN*DYAC(10)*10D0**IPOT) IPOT=IPOT+1
|
|
DELY=DYAC(1)
|
|
DO 120 IDEL=1,9
|
|
IF(YMAX-YMIN.GE.LIN*DYAC(IDEL)*10D0**IPOT) DELY=DYAC(IDEL+1)
|
|
120 CONTINUE
|
|
DY=DELY*10D0**IPOT
|
|
|
|
C...Convert bin contents to integer form; fractional fill in top row.
|
|
DO 130 IX=1,NX
|
|
CTA=ABS(BIN(IS+8+IX))/DY
|
|
IROW(IX)=SIGN(CTA+0.95D0,BIN(IS+8+IX))
|
|
IFRA(IX)=10D0*(CTA+1.05D0-DBLE(INT(CTA+0.95D0)))
|
|
130 CONTINUE
|
|
IRMI=SIGN(ABS(YMIN)/DY+0.95D0,YMIN)
|
|
IRMA=SIGN(ABS(YMAX)/DY+0.95D0,YMAX)
|
|
|
|
C...Print histogram row by row.
|
|
DO 150 IR=IRMA,IRMI,-1
|
|
IF(IR.EQ.0) GOTO 150
|
|
OUT=' '
|
|
DO 140 IX=1,NX
|
|
IF(IR.EQ.IROW(IX)) OUT(IX:IX)=CHA(IFRA(IX))
|
|
IF(IR*(IROW(IX)-IR).GT.0) OUT(IX:IX)=CHA(10)
|
|
140 CONTINUE
|
|
WRITE(MSTU(11),5300) IR*DELY, IPOT, OUT
|
|
150 CONTINUE
|
|
|
|
C...Print sign and value of bin contents.
|
|
IPOT=INT(LOG10(MAX(YMAX,-YMIN))+10.0001D0)-10
|
|
OUT=' '
|
|
DO 160 IX=1,NX
|
|
IF(BIN(IS+8+IX).LT.-10D0**(IPOT-4)) OUT(IX:IX)=CHA(11)
|
|
IROW(IX)=NINT(10D0**(3-IPOT)*ABS(BIN(IS+8+IX)))
|
|
160 CONTINUE
|
|
WRITE(MSTU(11),5400) OUT
|
|
DO 180 IR=4,1,-1
|
|
DO 170 IX=1,NX
|
|
OUT(IX:IX)=CHA(MOD(IROW(IX),10**IR)/10**(IR-1))
|
|
170 CONTINUE
|
|
WRITE(MSTU(11),5500) IPOT+IR-4, OUT
|
|
180 CONTINUE
|
|
|
|
C...Print sign and value of lower bin edge.
|
|
IPOT=INT(LOG10(MAX(-BIN(IS+2),BIN(IS+3)-BIN(IS+4)))+
|
|
& 10.0001D0)-10
|
|
OUT=' '
|
|
DO 190 IX=1,NX
|
|
IF(BIN(IS+2)+(IX-1)*BIN(IS+4).LT.-10D0**(IPOT-3))
|
|
& OUT(IX:IX)=CHA(11)
|
|
IROW(IX)=NINT(10D0**(2-IPOT)*ABS(BIN(IS+2)+(IX-1)*BIN(IS+4)))
|
|
190 CONTINUE
|
|
WRITE(MSTU(11),5600) OUT
|
|
DO 210 IR=3,1,-1
|
|
DO 200 IX=1,NX
|
|
OUT(IX:IX)=CHA(MOD(IROW(IX),10**IR)/10**(IR-1))
|
|
200 CONTINUE
|
|
WRITE(MSTU(11),5500) IPOT+IR-3, OUT
|
|
210 CONTINUE
|
|
ENDIF
|
|
|
|
C...Calculate and print statistics.
|
|
CSUM=0D0
|
|
CXSUM=0D0
|
|
CXXSUM=0D0
|
|
DO 220 IX=1,NX
|
|
CTA=ABS(BIN(IS+8+IX))
|
|
X=BIN(IS+2)+(IX-0.5D0)*BIN(IS+4)
|
|
CSUM=CSUM+CTA
|
|
CXSUM=CXSUM+CTA*X
|
|
CXXSUM=CXXSUM+CTA*X**2
|
|
220 CONTINUE
|
|
XMEAN=CXSUM/MAX(CSUM,1D-20)
|
|
XRMS=SQRT(MAX(0D0,CXXSUM/MAX(CSUM,1D-20)-XMEAN**2))
|
|
WRITE(MSTU(11),5700) NINT(BIN(IS+5)),XMEAN,BIN(IS+6),
|
|
&BIN(IS+2),BIN(IS+7),XRMS,BIN(IS+8),BIN(IS+3)
|
|
|
|
C...Formats for output.
|
|
5000 FORMAT(/5X,'Histogram no',I5,' : no entries')
|
|
5100 FORMAT('1'/5X,'Histogram no',I5,6X,A60,5X,I4,'-',I2,'-',I2,1X,
|
|
&I2,':',I2/)
|
|
5200 FORMAT('1'/5X,'Histogram no',I5,6X,A60/)
|
|
5300 FORMAT(2X,F7.2,'*10**',I2,3X,A100)
|
|
5400 FORMAT(/8X,'Contents',3X,A100)
|
|
5500 FORMAT(9X,'*10**',I2,3X,A100)
|
|
5600 FORMAT(/8X,'Low edge',3X,A100)
|
|
5700 FORMAT(/5X,'Entries =',I12,1P,6X,'Mean =',D12.4,6X,'Underflow ='
|
|
&,D12.4,6X,'Low edge =',D12.4/5X,'All chan =',D12.4,6X,
|
|
&'Rms =',D12.4,6X,'Overflow =',D12.4,6X,'High edge =',D12.4)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYNULL
|
|
C...Resets bin contents of a histogram.
|
|
|
|
SUBROUTINE PYNULL(ID)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
C...Commonblock.
|
|
COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
|
|
SAVE /PYBINS/
|
|
|
|
IS=INDX(ID)
|
|
DO 100 IX=IS+5,IS+8+NINT(BIN(IS+1))
|
|
BIN(IX)=0D0
|
|
100 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYDUMP
|
|
C...Dumps histogram contents on file for reading by other program.
|
|
C...Can also read back own dump.
|
|
|
|
SUBROUTINE PYDUMP(MDUMP,LFN,NHI,IHI)
|
|
|
|
C...Double precision declaration.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
C...Commonblock.
|
|
COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
|
|
SAVE /PYBINS/
|
|
C...Local arrays and character variables.
|
|
DIMENSION IHI(*),ISS(100),VAL(5)
|
|
CHARACTER TITLE*60,FORMAT*13
|
|
|
|
C...Dump all histograms that have been booked,
|
|
C...including titles and ranges, one after the other.
|
|
IF(MDUMP.EQ.1) THEN
|
|
|
|
C...Loop over histograms and find which are wanted and booked.
|
|
IF(NHI.LE.0) THEN
|
|
NW=IHIST(1)
|
|
ELSE
|
|
NW=NHI
|
|
ENDIF
|
|
DO 130 IW=1,NW
|
|
IF(NHI.EQ.0) THEN
|
|
ID=IW
|
|
ELSE
|
|
ID=IHI(IW)
|
|
ENDIF
|
|
IS=INDX(ID)
|
|
IF(IS.NE.0) THEN
|
|
|
|
C...Write title and histogram size.
|
|
NX=NINT(BIN(IS+1))
|
|
DO 100 IT=1,20
|
|
IEQ=NINT(BIN(IS+8+NX+IT))
|
|
TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)//
|
|
& CHAR(MOD(IEQ,256**2)/256)//CHAR(MOD(IEQ,256))
|
|
100 CONTINUE
|
|
WRITE(LFN,5100) ID,TITLE
|
|
WRITE(LFN,5200) NX,BIN(IS+2),BIN(IS+3)
|
|
|
|
C...Write histogram contents, in groups of five.
|
|
DO 120 IXG=1,(NX+4)/5
|
|
DO 110 IXV=1,5
|
|
IX=5*IXG+IXV-5
|
|
IF(IX.LE.NX) THEN
|
|
VAL(IXV)=BIN(IS+8+IX)
|
|
ELSE
|
|
VAL(IXV)=0D0
|
|
ENDIF
|
|
110 CONTINUE
|
|
WRITE(LFN,5300) (VAL(IXV),IXV=1,5)
|
|
120 CONTINUE
|
|
|
|
C...Go to next histogram; finish.
|
|
ELSEIF(NHI.GT.0) THEN
|
|
CALL PYERRM(8,'(PYDUMP:) unknown histogram number')
|
|
ENDIF
|
|
130 CONTINUE
|
|
|
|
C...Read back in histograms dumped MDUMP=1.
|
|
ELSEIF(MDUMP.EQ.2) THEN
|
|
|
|
C...Read histogram number, title and range, and book.
|
|
140 READ(LFN,5100,END=170) ID,TITLE
|
|
READ(LFN,5200) NX,XL,XU
|
|
CALL PYBOOK(ID,TITLE,NX,XL,XU)
|
|
IS=INDX(ID)
|
|
|
|
C...Read histogram contents, in groups of five.
|
|
DO 160 IXG=1,(NX+4)/5
|
|
READ(LFN,5300) (VAL(IXV),IXV=1,5)
|
|
DO 150 IXV=1,5
|
|
IX=5*IXG+IXV-5
|
|
IF(IX.LE.NX) BIN(IS+8+IX)=VAL(IXV)
|
|
150 CONTINUE
|
|
160 CONTINUE
|
|
|
|
C...Go to next histogram; finish.
|
|
GOTO 140
|
|
170 CONTINUE
|
|
|
|
C...Write histogram contents in column format,
|
|
C...convenient e.g. for GNUPLOT input.
|
|
ELSEIF(MDUMP.EQ.3) THEN
|
|
|
|
C...Find addresses to wanted histograms.
|
|
NSS=0
|
|
IF(NHI.LE.0) THEN
|
|
NW=IHIST(1)
|
|
ELSE
|
|
NW=NHI
|
|
ENDIF
|
|
DO 180 IW=1,NW
|
|
IF(NHI.EQ.0) THEN
|
|
ID=IW
|
|
ELSE
|
|
ID=IHI(IW)
|
|
ENDIF
|
|
IS=INDX(ID)
|
|
IF(IS.NE.0.AND.NSS.LT.100) THEN
|
|
NSS=NSS+1
|
|
ISS(NSS)=IS
|
|
ELSEIF(NSS.GE.100) THEN
|
|
CALL PYERRM(8,'(PYDUMP:) too many histograms requested')
|
|
ELSEIF(NHI.GT.0) THEN
|
|
CALL PYERRM(8,'(PYDUMP:) unknown histogram number')
|
|
ENDIF
|
|
180 CONTINUE
|
|
|
|
C...Check that they have common number of x bins. Fix format.
|
|
NX=NINT(BIN(ISS(1)+1))
|
|
DO 190 IW=2,NSS
|
|
IF(NINT(BIN(ISS(IW)+1)).NE.NX) THEN
|
|
CALL PYERRM(8,'(PYDUMP:) different number of bins')
|
|
RETURN
|
|
ENDIF
|
|
190 CONTINUE
|
|
FORMAT='(1P,000D12.4)'
|
|
WRITE(FORMAT(5:7),'(I3)') NSS+1
|
|
|
|
C...Write histogram contents; first column x values.
|
|
DO 200 IX=1,NX
|
|
X=BIN(ISS(1)+2)+(IX-0.5D0)*BIN(ISS(1)+4)
|
|
WRITE(LFN,FORMAT) X, (BIN(ISS(IW)+8+IX),IW=1,NSS)
|
|
200 CONTINUE
|
|
|
|
ENDIF
|
|
|
|
C...Formats for output.
|
|
5100 FORMAT(I5,5X,A60)
|
|
5200 FORMAT(I5,1P,2D12.4)
|
|
5300 FORMAT(1P,5D12.4)
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYKCUT
|
|
C...Dummy routine, which the user can replace in order to make cuts on
|
|
C...the kinematics on the parton level before the matrix elements are
|
|
C...evaluated and the event is generated. The cross-section estimates
|
|
C...will automatically take these cuts into account, so the given
|
|
C...values are for the allowed phase space region only. MCUT=0 means
|
|
C...that the event has passed the cuts, MCUT=1 that it has failed.
|
|
|
|
SUBROUTINE PYKCUT(MCUT)
|
|
|
|
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/PYINT1/MINT(400),VINT(400)
|
|
COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
|
|
SAVE /PYDAT1/,/PYINT1/,/PYINT2/
|
|
|
|
C...Set default value (accepting event) for MCUT.
|
|
MCUT=0
|
|
|
|
C...Read out subprocess number.
|
|
ISUB=MINT(1)
|
|
ISTSB=ISET(ISUB)
|
|
|
|
C...Read out tau, y*, cos(theta), tau' (where defined, else =0).
|
|
TAU=VINT(21)
|
|
YST=VINT(22)
|
|
CTH=0D0
|
|
IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) CTH=VINT(23)
|
|
TAUP=0D0
|
|
IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUP=VINT(26)
|
|
|
|
C...Calculate x_1, x_2, x_F.
|
|
IF(ISTSB.LE.2.OR.ISTSB.GE.5) THEN
|
|
X1=SQRT(TAU)*EXP(YST)
|
|
X2=SQRT(TAU)*EXP(-YST)
|
|
ELSE
|
|
X1=SQRT(TAUP)*EXP(YST)
|
|
X2=SQRT(TAUP)*EXP(-YST)
|
|
ENDIF
|
|
XF=X1-X2
|
|
|
|
C...Calculate shat, that, uhat, p_T^2.
|
|
SHAT=TAU*VINT(2)
|
|
SQM3=VINT(63)
|
|
SQM4=VINT(64)
|
|
RM3=SQM3/SHAT
|
|
RM4=SQM4/SHAT
|
|
BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4))
|
|
RPTS=4D0*VINT(71)**2/SHAT
|
|
BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS))
|
|
RM34=2D0*RM3*RM4
|
|
RSQM=1D0+RM34
|
|
RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L)
|
|
THAT=-0.5D0*SHAT*MAX(RTHM,1D0-RM3-RM4-BE34*CTH)
|
|
UHAT=-0.5D0*SHAT*MAX(RTHM,1D0-RM3-RM4+BE34*CTH)
|
|
PT2=MAX(VINT(71)**2,0.25D0*SHAT*BE34**2*(1D0-CTH**2))
|
|
|
|
C...Decisions by user to be put here.
|
|
|
|
C...Stop program if this routine is ever called.
|
|
C...You should not copy these lines to your own routine.
|
|
WRITE(MSTU(11),5000)
|
|
IF(PYR(0).LT.10D0) STOP
|
|
|
|
C...Format for error printout.
|
|
5000 FORMAT(1X,'Error: you did not link your PYKCUT routine ',
|
|
&'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/
|
|
&1X,'Execution stopped!')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYEVWT
|
|
C...Dummy routine, which the user can replace in order to multiply the
|
|
C...standard PYTHIA differential cross-section by a process- and
|
|
C...kinematics-dependent factor WTXS. For MSTP(142)=1 this corresponds
|
|
C...to generation of weighted events, with weight 1/WTXS, while for
|
|
C...MSTP(142)=2 it corresponds to a modification of the underlying
|
|
C...physics.
|
|
|
|
SUBROUTINE PYEVWT(WTXS)
|
|
|
|
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/PYINT1/MINT(400),VINT(400)
|
|
COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
|
|
SAVE /PYDAT1/,/PYINT1/,/PYINT2/
|
|
|
|
C...Set default weight for WTXS.
|
|
WTXS=1D0
|
|
|
|
C...Read out subprocess number.
|
|
ISUB=MINT(1)
|
|
ISTSB=ISET(ISUB)
|
|
|
|
C...Read out tau, y*, cos(theta), tau' (where defined, else =0).
|
|
TAU=VINT(21)
|
|
YST=VINT(22)
|
|
CTH=0D0
|
|
IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) CTH=VINT(23)
|
|
TAUP=0D0
|
|
IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUP=VINT(26)
|
|
|
|
C...Read out x_1, x_2, x_F, shat, that, uhat, p_T^2.
|
|
X1=VINT(41)
|
|
X2=VINT(42)
|
|
XF=X1-X2
|
|
SHAT=VINT(44)
|
|
THAT=VINT(45)
|
|
UHAT=VINT(46)
|
|
PT2=VINT(48)
|
|
|
|
C...Modifications by user to be put here.
|
|
|
|
C...Stop program if this routine is ever called.
|
|
C...You should not copy these lines to your own routine.
|
|
WRITE(MSTU(11),5000)
|
|
IF(PYR(0).LT.10D0) STOP
|
|
|
|
C...Format for error printout.
|
|
5000 FORMAT(1X,'Error: you did not link your PYEVWT routine ',
|
|
&'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/
|
|
&1X,'Execution stopped!')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYUPIN
|
|
C...Dummy copy of routine to be called by user to set up a user-defined
|
|
C...process.
|
|
|
|
SUBROUTINE PYUPIN(ISUB,TITLE,SIGMAX)
|
|
|
|
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/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
|
|
COMMON/PYINT6/PROC(0:500)
|
|
CHARACTER PROC*28
|
|
SAVE /PYDAT1/,/PYINT2/,/PYINT6/
|
|
C...Local character variable.
|
|
CHARACTER*(*) TITLE
|
|
|
|
C...Check that subprocess number free.
|
|
IF(ISUB.LT.1.OR.ISUB.GT.200.OR.ISET(ISUB).GE.0) THEN
|
|
WRITE(MSTU(11),5000) ISUB
|
|
STOP
|
|
ENDIF
|
|
|
|
C...Fill information on new process.
|
|
ISET(ISUB)=11
|
|
COEF(ISUB,1)=SIGMAX
|
|
PROC(ISUB)=TITLE//' '
|
|
|
|
C...Format for error output.
|
|
5000 FORMAT(1X,'Error: user-defined subprocess code ',I4,
|
|
&' not allowed.'//1X,'Execution stopped!')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYUPEV
|
|
C...Dummy routine, to be replaced by user. When called from PYTHIA
|
|
C...the subprocess number ISUB will be given, and PYUPEV is supposed
|
|
C...to generate an event of this type, to be stored in the PYUPPR
|
|
C...commonblock. SIGEV gives the differential cross-section associated
|
|
C...with the event, i.e. the acceptance probability of the event is
|
|
C...taken to be SIGEV/SIGMAX, where SIGMAX was given in the PYUPIN
|
|
C...call.
|
|
|
|
SUBROUTINE PYUPEV(ISUB,SIGEV)
|
|
|
|
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/PYUPPR/NUP,KUP(20,7),NFUP,IFUP(10,2),PUP(20,5),Q2UP(0:10)
|
|
SAVE /PYDAT1/,/PYUPPR/
|
|
|
|
C...Stop program if this routine is ever called.
|
|
C...You should not copy these lines to your own routine.
|
|
WRITE(MSTU(11),5000)
|
|
IF(PYR(0).LT.10D0) STOP
|
|
SIGEV=ISUB
|
|
|
|
C...Format for error printout.
|
|
5000 FORMAT(1X,'Error: you did not link your PYUPEV routine ',
|
|
&'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/
|
|
&1X,'Execution stopped!')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PDFSET
|
|
C...Dummy routine, to be removed when PDFLIB is to be linked.
|
|
|
|
SUBROUTINE PDFSET(PARM,VALUE)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
C...Local arrays and character variables.
|
|
CHARACTER*20 PARM(20)
|
|
DOUBLE PRECISION VALUE(20)
|
|
|
|
C...Stop program if this routine is ever called.
|
|
WRITE(MSTU(11),5000)
|
|
IF(PYR(0).LT.10D0) STOP
|
|
PARM(20)=PARM(1)
|
|
VALUE(20)=VALUE(1)
|
|
|
|
C...Format for error printout.
|
|
5000 FORMAT(1X,'Error: you did not link PDFLIB correctly.'/
|
|
&1X,'Dummy routine PDFSET in PYTHIA file called instead.'/
|
|
&1X,'Execution stopped!')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...STRUCTM
|
|
C...Dummy routine, to be removed when PDFLIB is to be linked.
|
|
|
|
SUBROUTINE STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU)
|
|
|
|
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)
|
|
SAVE /PYDAT1/
|
|
C...Local variables
|
|
DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU
|
|
|
|
C...Stop program if this routine is ever called.
|
|
WRITE(MSTU(11),5000)
|
|
IF(PYR(0).LT.10D0) STOP
|
|
UPV=XX+QQ
|
|
DNV=XX+2D0*QQ
|
|
USEA=XX+3D0*QQ
|
|
DSEA=XX+4D0*QQ
|
|
STR=XX+5D0*QQ
|
|
CHM=XX+6D0*QQ
|
|
BOT=XX+7D0*QQ
|
|
TOP=XX+8D0*QQ
|
|
GLU=XX+9D0*QQ
|
|
|
|
C...Format for error printout.
|
|
5000 FORMAT(1X,'Error: you did not link PDFLIB correctly.'/
|
|
&1X,'Dummy routine STRUCTM in PYTHIA file called instead.'/
|
|
&1X,'Execution stopped!')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYTAUD
|
|
C...Dummy routine, to be replaced by user, to handle the decay of a
|
|
C...polarized tau lepton.
|
|
C...Input:
|
|
C...ITAU is the position where the decaying tau is stored in /PYJETS/.
|
|
C...IORIG is the position where the mother of the tau is stored;
|
|
C... is 0 when the mother is not stored.
|
|
C...KFORIG is the flavour of the mother of the tau;
|
|
C... is 0 when the mother is not known.
|
|
C...Note that IORIG=0 does not necessarily imply KFORIG=0;
|
|
C... e.g. in B hadron semileptonic decays the W propagator
|
|
C... is not explicitly stored but the W code is still unambiguous.
|
|
C...Output:
|
|
C...NDECAY is the number of decay products in the current tau decay.
|
|
C...These decay products should be added to the /PYJETS/ common block,
|
|
C...in positions N+1 through N+NDECAY. For each product I you must
|
|
C...give the flavour codes K(I,2) and the five-momenta P(I,1), P(I,2),
|
|
C...P(I,3), P(I,4) and P(I,5). The rest will be stored automatically.
|
|
|
|
SUBROUTINE PYTAUD(ITAU,IORIG,KFORIG,NDECAY)
|
|
|
|
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)
|
|
SAVE /PYJETS/,/PYDAT1/
|
|
|
|
C...Stop program if this routine is ever called.
|
|
C...You should not copy these lines to your own routine.
|
|
NDECAY=ITAU+IORIG+KFORIG
|
|
WRITE(MSTU(11),5000)
|
|
IF(PYR(0).LT.10D0) STOP
|
|
|
|
C...Format for error printout.
|
|
5000 FORMAT(1X,'Error: you did not link your PYTAUD routine ',
|
|
&'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/
|
|
&1X,'Execution stopped!')
|
|
|
|
RETURN
|
|
END
|
|
|
|
C*********************************************************************
|
|
|
|
C...PYTIME
|
|
C...Finds current date and time.
|
|
C...Since this task is not standardized in Fortran 77, the routine
|
|
C...is dummy, to be replaced by the user. Examples are given for
|
|
C...the Fortran 90 routine and DEC Fortran 77, and what to do if
|
|
C...you do not have access to suitable routines.
|
|
|
|
SUBROUTINE PYTIME(IDATI)
|
|
|
|
C...Double precision and integer declarations.
|
|
IMPLICIT DOUBLE PRECISION(A-H, O-Z)
|
|
INTEGER PYK,PYCHGE,PYCOMP
|
|
CHARACTER*8 ATIME
|
|
C...Local array.
|
|
INTEGER IDATI(6),IDTEMP(3)
|
|
|
|
C...Example 0: if you do not have suitable routines.
|
|
DO 100 J=1,6
|
|
IDATI(J)=0
|
|
100 CONTINUE
|
|
|
|
C...Example 1: Fortran 90 routine.
|
|
C INTEGER IVAL(8)
|
|
C CALL DATE_AND_TIME(VALUES=IVAL)
|
|
C IDATI(1)=IVAL(1)
|
|
C IDATI(2)=IVAL(2)
|
|
C IDATI(3)=IVAL(3)
|
|
C IDATI(4)=IVAL(5)
|
|
C IDATI(5)=IVAL(6)
|
|
C IDATI(6)=IVAL(7)
|
|
|
|
C...Example 2: DEC Fortran 77.
|
|
C CALL IDATE(IMON,IDAY,IYEAR)
|
|
C IDATI(1)=1900+IYEAR
|
|
C IDATI(2)=IMON
|
|
C IDATI(3)=IDAY
|
|
C CALL ITIME(IHOUR,IMIN,ISEC)
|
|
C IDATI(4)=IHOUR
|
|
C IDATI(5)=IMIN
|
|
C IDATI(6)=ISEC
|
|
|
|
C...Example 3: DEC Fortran
|
|
C CALL IDATE(IMON,IDAY,IYEAR)
|
|
C IDATI(1)=1900+IYEAR
|
|
C IDATI(2)=IMON
|
|
C IDATI(3)=IDAY
|
|
C CALL TIME(ATIME)
|
|
C IHOUR=0
|
|
C IMIN=0
|
|
C ISEC=0
|
|
C READ(ATIME(1:2),'(I2)') IHOUR
|
|
C READ(ATIME(4:5),'(I2)') IMIN
|
|
C READ(ATIME(7:8),'(I2)') ISEC
|
|
C IDATI(4)=IHOUR
|
|
C IDATI(5)=IMIN
|
|
C IDATI(6)=ISEC
|
|
|
|
C...Example 4: GNU LINUX libU77.
|
|
C CALL IDATE(IDTEMP)
|
|
C IDATI(1)=IDTEMP(3)
|
|
C IDATI(2)=IDTEMP(2)
|
|
C IDATI(3)=IDTEMP(1)
|
|
C CALL ITIME(IDTEMP)
|
|
C IDATI(4)=IDTEMP(1)
|
|
C IDATI(5)=IDTEMP(2)
|
|
C IDATI(6)=IDTEMP(3)
|
|
|
|
RETURN
|
|
END
|