]>
Commit | Line | Data |
---|---|---|
2dfa57d1 | 1 | C********************************************************************* |
2 | C********************************************************************* | |
3 | C* ** | |
4 | C* January 2003 ** | |
5 | C* ** | |
6 | C* The Lund Monte Carlo ** | |
7 | C* ** | |
8 | C* PYTHIA version 6.2 ** | |
9 | C* ** | |
10 | C* Torbjorn Sjostrand ** | |
11 | C* Department of Theoretical Physics ** | |
12 | C* Lund University ** | |
13 | C* Solvegatan 14A, S-223 62 Lund, Sweden ** | |
14 | C* phone +46 - 46 - 222 48 16 ** | |
15 | C* E-mail torbjorn@thep.lu.se ** | |
16 | C* ** | |
17 | C* SUSY and Technicolor parts by ** | |
18 | C* Stephen Mrenna ** | |
19 | C* Computing Division, Simulations Group ** | |
20 | C* Fermi National Accelerator Laboratory ** | |
21 | C* MS 234, Batavia, IL 60510, USA ** | |
22 | C* phone + 1 - 630 - 840 - 2556 ** | |
23 | C* E-mail mrenna@fnal.gov ** | |
24 | C* ** | |
25 | C* Baryon and lepton number violation parts by ** | |
26 | C* Peter Skands ** | |
27 | C* Department of Theoretical Physics ** | |
28 | C* Lund University ** | |
29 | C* Solvegatan 14A, S-223 62 Lund, Sweden ** | |
30 | C* phone +46 - 46 - 222 31 92 ** | |
31 | C* E-mail zeiler@thep.lu.se ** | |
32 | C* ** | |
33 | C* PYTHIA 7 efforts coordinated by ** | |
34 | C* Leif Lonnblad ** | |
35 | C* Department of Theoretical Physics ** | |
36 | C* Lund University ** | |
37 | C* Solvegatan 14A, S-223 62 Lund, Sweden ** | |
38 | C* phone +46 - 46 - 222 77 80 ** | |
39 | C* E-mail leif@thep.lu.se ** | |
40 | C* ** | |
41 | C* Several parts are written by Hans-Uno Bengtsson ** | |
42 | C* PYSHOW is written together with Mats Bengtsson ** | |
43 | C* PYMAEL is written by Emanuel Norrbin ** | |
44 | C* advanced popcorn baryon production written by Patrik Eden ** | |
45 | C* code for virtual photons mainly written by Christer Friberg ** | |
46 | C* code for low-mass strings mainly written by Emanuel Norrbin ** | |
47 | C* Bose-Einstein code mainly written by Leif Lonnblad ** | |
48 | C* CTEQ parton distributions are by the CTEQ collaboration ** | |
49 | C* GRV 94 parton distributions are by Glueck, Reya and Vogt ** | |
50 | C* SaS photon parton distributions together with Gerhard Schuler ** | |
51 | C* g + g and q + qbar -> t + tbar + H code by Zoltan Kunszt ** | |
52 | C* MSSM Higgs mass calculation code by M. Carena, ** | |
53 | C* J.R. Espinosa, M. Quiros and C.E.M. Wagner ** | |
54 | C* PYGAUS adapted from CERN library (K.S. Kolbig) ** | |
55 | C* ** | |
56 | C* The latest program version and documentation is found on WWW ** | |
57 | C* http://www.thep.lu.se/~torbjorn/Pythia.html ** | |
58 | C* ** | |
59 | C* Copyright Torbjorn Sjostrand, Lund 2003 ** | |
60 | C* ** | |
61 | C********************************************************************* | |
62 | C********************************************************************* | |
63 | C * | |
64 | C List of subprograms in order of appearance, with main purpose * | |
65 | C (S = subroutine, F = function, B = block data) * | |
66 | C * | |
67 | C B PYDATA to contain all default values * | |
68 | C S PYTEST to test the proper functioning of the package * | |
69 | C S PYHEPC to convert between /PYJETS/ and /HEPEVT/ records * | |
70 | C * | |
71 | C S PYINIT to administer the initialization procedure * | |
72 | C S PYEVNT to administer the generation of an event * | |
73 | C S PYSTAT to print cross-section and other information * | |
74 | C S PYINRE to initialize treatment of resonances * | |
75 | C S PYINBM to read in beam, target and frame choices * | |
76 | C S PYINKI to initialize kinematics of incoming particles * | |
77 | C S PYINPR to set up the selection of included processes * | |
78 | C S PYXTOT to give total, elastic and diffractive cross-sect. * | |
79 | C S PYMAXI to find differential cross-section maxima * | |
80 | C S PYPILE to select multiplicity of pileup events * | |
81 | C S PYSAVE to save alternatives for gamma-p and gamma-gamma * | |
82 | C S PYGAGA to handle lepton -> lepton + gamma branchings * | |
83 | C S PYRAND to select subprocess and kinematics for event * | |
84 | C S PYSCAT to set up kinematics and colour flow of event * | |
85 | C S PYSSPA to simulate initial state spacelike showers * | |
86 | C S PYMEMX auxiliary to PYSSPA for ME correction maximum * | |
87 | C S PYMEWT auxiliary to PYSSPA for matrix element correction * | |
88 | C S PYADSH to administrate sequential final-state showers * | |
89 | C S PYRESD to perform resonance decays * | |
90 | C S PYMULT to generate multiple interactions * | |
91 | C S PYREMN to add on target remnants * | |
92 | C S PYDIFF to set up kinematics for diffractive events * | |
93 | C S PYDISG to set up kinematics, remnant and showers for DIS * | |
94 | C S PYDOCU to compute cross-sections and handle documentation * | |
95 | C S PYFRAM to perform boosts between different frames * | |
96 | C S PYWIDT to calculate full and partial widths of resonances * | |
97 | C S PYOFSH to calculate partial width into off-shell channels * | |
98 | C S PYRECO to handle colour reconnection in W+W- events * | |
99 | C S PYKLIM to calculate borders of allowed kinematical region * | |
100 | C S PYKMAP to construct value of kinematical variable * | |
101 | C S PYSIGH to calculate differential cross-sections * | |
102 | C S PYPDFU to evaluate parton distributions * | |
103 | C S PYPDFL to evaluate parton distributions at low x and Q^2 * | |
104 | C S PYPDEL to evaluate electron parton distributions * | |
105 | C S PYPDGA to evaluate photon parton distributions (generic) * | |
106 | C S PYGGAM to evaluate photon parton distributions (SaS sets) * | |
107 | C S PYGVMD to evaluate VMD part of photon parton distributions * | |
108 | C S PYGANO to evaluate anomalous part of photon pdf's * | |
109 | C S PYGBEH to evaluate Bethe-Heitler part of photon pdf's * | |
110 | C S PYGDIR to evaluate direct contribution to photon pdf's * | |
111 | C S PYPDPI to evaluate pion parton distributions * | |
112 | C S PYPDPR to evaluate proton parton distributions * | |
113 | C F PYCTEQ to evaluate the CTEQ 3 proton parton distributions * | |
114 | C S PYGRVL to evaluate the GRV 94L proton parton distributions * | |
115 | C S PYGRVM to evaluate the GRV 94M proton parton distributions * | |
116 | C S PYGRVD to evaluate the GRV 94D proton parton distributions * | |
117 | C F PYGRVV auxiliary to the PYGRV* routines * | |
118 | C F PYGRVW auxiliary to the PYGRV* routines * | |
119 | C F PYGRVS auxiliary to the PYGRV* routines * | |
120 | C F PYCT5L to evaluate the CTEQ 5L proton parton distributions * | |
121 | C F PYCT5M to evaluate the CTEQ 5M1 proton parton distributions * | |
122 | C S PYPDPO to evaluate old proton parton distributions * | |
123 | C F PYHFTH to evaluate threshold factor for heavy flavour * | |
124 | C S PYSPLI to find flavours left in hadron when one removed * | |
125 | C F PYGAMM to evaluate ordinary Gamma function Gamma(x) * | |
126 | C S PYWAUX to evaluate auxiliary functions W1(s) and W2(s) * | |
127 | C S PYI3AU to evaluate auxiliary function I3(s,t,u,v) * | |
128 | C F PYSPEN to evaluate Spence (dilogarithm) function Sp(x) * | |
129 | C S PYQQBH to evaluate matrix element for g + g -> Q + Qbar + H * | |
130 | C * | |
131 | C S PYMSIN to initialize the supersymmetry simulation * | |
132 | C S PYAPPS to determine MSSM parameters from SUGRA input * | |
133 | C S PYSUGI to determine MSSM parameters using ISASUSY * | |
134 | C F PYRNMQ to determine running squark masses * | |
135 | C S PYTHRG to calculate sfermion third-gen. mass eigenstates * | |
136 | C S PYINOM to calculate neutralino/chargino mass eigenstates * | |
137 | C F PYRNM3 to determine running M3, gluino mass * | |
138 | C S PYEIG4 to calculate eigenvalues and -vectors in 4*4 matrix * | |
139 | C S PYHGGM to determine Higgs mass spectrum * | |
140 | C S PYSUBH to determine Higgs masses in the MSSM * | |
141 | C S PYPOLE to determine Higgs masses in the MSSM * | |
142 | C S PYRGHM auxiliary to PYPOLE * | |
143 | C S PYGFXX auxiliary to PYRGHM * | |
144 | C F PYFINT auxiliary to PYPOLE * | |
145 | C F PYFISB auxiliary to PYFINT * | |
146 | C S PYSFDC to calculate sfermion decay partial widths * | |
147 | C S PYGLUI to calculate gluino decay partial widths * | |
148 | C S PYTBBN to calculate 3-body decay of gluino to neutralino * | |
149 | C S PYTBBC to calculate 3-body decay of gluino to chargino * | |
150 | C S PYNJDC to calculate neutralino decay partial widths * | |
151 | C S PYCJDC to calculate chargino decay partial widths * | |
152 | C F PYXXZ6 auxiliary for ino 3-body decays * | |
153 | C F PYXXGA auxiliary for ino -> ino + gamma decay * | |
154 | C F PYX2XG auxiliary for ino -> ino + gauge boson decay * | |
155 | C F PYX2XH auxiliary for ino -> ino + Higgs decay * | |
156 | C S PYHEXT to calculate non-SM Higgs decay partial widths * | |
157 | C F PYH2XX auxiliary for H -> ino + ino decay * | |
158 | C F PYGAUS to perform Gaussian integration * | |
159 | C F PYGAU2 copy of PYGAUS to allow two-dimensional integration * | |
160 | C F PYSIMP to perform Simpson integration * | |
161 | C F PYLAMF to evaluate the lambda kinematics function * | |
162 | C S PYTBDY to perform 3-body decay of gauginos * | |
163 | C S PYTECM to calculate techni_rho/omega masses * | |
164 | C S PYEICG to calculate eigenvalues of a 4*4 complex matrix * | |
165 | C S PYCMQR auxiliary to PYEICG * | |
166 | C S PYCMQ2 auxiliary to PYEICG * | |
167 | C S PYCDIV auxiliary to PYCMQR * | |
168 | C S PYCSRT auxiliary to PYCMQR * | |
169 | C S PYTHAG auxiliary to PYCMQR * | |
170 | C S PYCBAL auxiliary to PYEICG * | |
171 | C S PYCBA2 auxiliary to PYEICG * | |
172 | C S PYCRTH auxiliary to PYEICG * | |
173 | C S PYLDCM auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 * | |
174 | C S PYBKSB auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 * | |
175 | C S PYWIDX to calculate decay widths from within PYWIDT * | |
176 | C S PYRVSF to calculate R-violating sfermion decay widths * | |
177 | C S PYRVNE to calculate R-violating neutralino decay widths * | |
178 | C S PYRVCH to calculate R-violating chargino decay widths * | |
179 | C S PYRVGL to calculate R-violating gluino decay widths * | |
180 | C F PYRVSB auxiliary to PYRVSF * | |
181 | C S PYRVGW to calculate R-Violating 3-body widths * | |
182 | C F PYRVI1 auxiliary to PYRVGW, to do PS integration for res. * | |
183 | C F PYRVI2 auxiliary to PYRVGW, to do PS integration for LR-int.* | |
184 | C F PYRVI3 auxiliary to PYRVGW, to do PS X integral for int. * | |
185 | C F PYRVG1 auxiliary to PYRVI1, general matrix element, res. * | |
186 | C F PYRVG2 auxiliary to PYRVI2, general matrix element, LR-int. * | |
187 | C F PYRVG3 auxiliary to PYRVI3, to do PS Y integral for int. * | |
188 | C F PYRVG4 auxiliary to PYRVG3, general matrix element, int. * | |
189 | C F PYRVR auxiliary to PYRVG1, Breit-Wigner * | |
190 | C F PYRVS auxiliary to PYRVG2 & PYRVG4 * | |
191 | C * | |
192 | C S PY1ENT to fill one entry (= parton or particle) * | |
193 | C S PY2ENT to fill two entries * | |
194 | C S PY3ENT to fill three entries * | |
195 | C S PY4ENT to fill four entries * | |
196 | C S PY2FRM to interface to generic two-fermion generator * | |
197 | C S PY4FRM to interface to generic four-fermion generator * | |
198 | C S PY6FRM to interface to generic six-fermion generator * | |
199 | C S PY4JET to generate a shower from a given 4-parton config * | |
200 | C S PY4JTW to evaluate the weight od a shower history for above * | |
201 | C S PY4JTS to set up the parton configuration for above * | |
202 | C S PYJOIN to connect entries with colour flow information * | |
203 | C S PYGIVE to fill (or query) commonblock variables * | |
204 | C S PYEXEC to administrate fragmentation and decay chain * | |
205 | C S PYPREP to rearrange showered partons along strings * | |
206 | C S PYSTRF to do string fragmentation of jet system * | |
207 | C S PYJURF to find boost to string junction rest frame * | |
208 | C S PYINDF to do independent fragmentation of one or many jets * | |
209 | C S PYDECY to do the decay of a particle * | |
210 | C S PYDCYK to select parton and hadron flavours in decays * | |
211 | C S PYKFDI to select parton and hadron flavours in fragm * | |
212 | C S PYNMES to select number of popcorn mesons * | |
213 | C S PYKFIN to calculate falvour prod. ratios from input params. * | |
214 | C S PYPTDI to select transverse momenta in fragm * | |
215 | C S PYZDIS to select longitudinal scaling variable in fragm * | |
216 | C S PYSHOW to do timelike parton shower evolution * | |
217 | C F PYMAEL auxiliary to PYSHOW, with gluon emission ME's * | |
218 | C S PYBOEI to include Bose-Einstein effects (crudely) * | |
219 | C S PYBESQ auxiliary to PYBOEI * | |
220 | C F PYMASS to give the mass of a particle or parton * | |
221 | C F PYMRUN to give the running MSbar mass of a quark * | |
222 | C S PYNAME to give the name of a particle or parton * | |
223 | C F PYCHGE to give three times the electric charge * | |
224 | C F PYCOMP to compress standard KF flavour code to internal KC * | |
225 | C S PYERRM to write error messages and abort faulty run * | |
226 | C F PYALEM to give the alpha_electromagnetic value * | |
227 | C F PYALPS to give the alpha_strong value * | |
228 | C F PYANGL to give the angle from known x and y components * | |
229 | C F PYR to provide a random number generator * | |
230 | C S PYRGET to save the state of the random number generator * | |
231 | C S PYRSET to set the state of the random number generator * | |
232 | C S PYROBO to rotate and/or boost an event * | |
233 | C S PYEDIT to remove unwanted entries from record * | |
234 | C S PYLIST to list event record or particle data * | |
235 | C S PYLOGO to write a logo * | |
236 | C S PYUPDA to update particle data * | |
237 | C F PYK to provide integer-valued event information * | |
238 | C F PYP to provide real-valued event information * | |
239 | C S PYSPHE to perform sphericity analysis * | |
240 | C S PYTHRU to perform thrust analysis * | |
241 | C S PYCLUS to perform three-dimensional cluster analysis * | |
242 | C S PYCELL to perform cluster analysis in (eta, phi, E_T) * | |
243 | C S PYJMAS to give high and low jet mass of event * | |
244 | C S PYFOWO to give Fox-Wolfram moments * | |
245 | C S PYTABU to analyze events, with tabular output * | |
246 | C * | |
247 | C S PYEEVT to administrate the generation of an e+e- event * | |
248 | C S PYXTEE to give the total cross-section at given CM energy * | |
249 | C S PYRADK to generate initial state photon radiation * | |
250 | C S PYXKFL to select flavour of primary qqbar pair * | |
251 | C S PYXJET to select (matrix element) jet multiplicity * | |
252 | C S PYX3JT to select kinematics of three-jet event * | |
253 | C S PYX4JT to select kinematics of four-jet event * | |
254 | C S PYXDIF to select angular orientation of event * | |
255 | C S PYONIA to perform generation of onium decay to gluons * | |
256 | C * | |
257 | C S PYBOOK to book a histogram * | |
258 | C S PYFILL to fill an entry in a histogram * | |
259 | C S PYFACT to multiply histogram contents by a factor * | |
260 | C S PYOPER to perform operations between histograms * | |
261 | C S PYHIST to print and reset all histograms * | |
262 | C S PYPLOT to print a single histogram * | |
263 | C S PYNULL to reset contents of a single histogram * | |
264 | C S PYDUMP to dump histogram contents onto a file * | |
265 | C * | |
266 | C S PYKCUT dummy routine for user kinematical cuts * | |
267 | C S PYEVWT dummy routine for weighting events * | |
268 | C S UPINIT dummy routine to initialize user processes * | |
269 | C S UPEVNT dummy routine to generate a user process event * | |
270 | C S PDFSET dummy routine to be removed when using PDFLIB * | |
271 | C S STRUCTM dummy routine to be removed when using PDFLIB * | |
272 | C S STRUCTP dummy routine to be removed when using PDFLIB * | |
273 | C S SUGRA dummy routine to be removed when linking with ISAJET * | |
274 | C F VISAJE dummy functn. to be removed when linking with ISAJET * | |
275 | C S PYTAUD dummy routine for interface to tau decay libraries * | |
276 | C S PYTIME dummy routine for giving date and time * | |
277 | C * | |
278 | C********************************************************************* | |
279 | ||
280 | C...PYDATA | |
281 | C...Default values for switches and parameters, | |
282 | C...and particle, decay and process data. | |
283 | ||
284 | BLOCK DATA PYDATA | |
285 | ||
286 | C...Double precision and integer declarations. | |
287 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
288 | IMPLICIT INTEGER(I-N) | |
8285a88d | 289 | C INTEGER PYK,PYCHGE,PYCOMP |
2dfa57d1 | 290 | C...Commonblocks. |
291 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
292 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
293 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
294 | COMMON/PYDAT4/CHAF(500,2) | |
295 | CHARACTER CHAF*16 | |
296 | COMMON/PYDATR/MRPY(6),RRPY(100) | |
297 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
298 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
299 | COMMON/PYINT1/MINT(400),VINT(400) | |
300 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
301 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
302 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
303 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
304 | COMMON/PYINT6/PROC(0:500) | |
305 | CHARACTER PROC*28 | |
306 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
307 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
308 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
309 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
310 | COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) | |
311 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
312 | COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) | |
313 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/,/PYSUBS/, | |
314 | &/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/, | |
315 | &/PYINT6/,/PYINT7/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYTCSM/,/PYBINS/ | |
316 | ||
317 | C...PYDAT1, containing status codes and most parameters. | |
318 | DATA MSTU/ | |
319 | & 0, 0, 0, 4000,10000, 500, 8000, 0, 0, 2, | |
320 | 1 6, 1, 1, 0, 0, 1, 0, 0, 0, 0, | |
321 | 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0, | |
322 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
323 | 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0, | |
324 | 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0, | |
325 | 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
326 | 7 30*0, | |
327 | 1 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
328 | 2 1, 5, 3, 5, 0, 0, 0, 0, 0, 0, | |
329 | & 80*0/ | |
330 | DATA (PARU(I),I=1,100)/ | |
331 | & 3.141592653589793D0, 6.283185307179586D0, | |
332 | & 0.197327D0, 5.06773D0, 0.389380D0, 2.56819D0, 4*0D0, | |
333 | 1 0.001D0, 0.09D0, 0.01D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
334 | 2 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
335 | 3 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
336 | 4 2.0D0, 1.0D0, 0.25D0, 2.5D0, 0.05D0, | |
337 | 4 0D0, 0D0, 0.0001D0, 0D0, 0D0, | |
338 | 5 2.5D0,1.5D0,7.0D0,1.0D0,0.5D0,2.0D0,3.2D0, 0D0, 0D0, 0D0, | |
339 | 6 40*0D0/ | |
340 | DATA (PARU(I),I=101,200)/ | |
341 | & 0.00729735D0, 0.232D0, 0.007764D0, 1.0D0, 1.16639D-5, | |
342 | & 0D0, 0D0, 0D0, 0D0, 0D0, | |
343 | 1 0.20D0, 0.25D0, 1.0D0, 4.0D0, 10D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
344 | 2 -0.693D0, -1.0D0, 0.387D0, 1.0D0, -0.08D0, | |
345 | 2 -1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0, | |
346 | 3 1.0D0,-1.0D0, 1.0D0,-1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
347 | 4 5.0D0, 1.0D0, 1.0D0, 0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, | |
348 | 5 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
349 | 6 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
350 | 7 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0, | |
351 | 8 1.0D0, 1.0D0, 1.0D0, 0.0D0, 0.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0, | |
352 | 9 0D0, 0D0, 0D0, 0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0/ | |
353 | DATA MSTJ/ | |
354 | & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, | |
355 | 1 4, 2, 0, 1, 0, 2, 2, 10, 0, 0, | |
356 | 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0, | |
357 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
358 | 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 3, | |
359 | 5 0, 3, 0, 2, 0, 0, 1, 0, 0, 0, | |
360 | 6 40*0, | |
361 | & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2, | |
362 | 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, | |
363 | 2 80*0/ | |
364 | DATA PARJ/ | |
365 | & 0.10D0, 0.30D0, 0.40D0, 0.05D0, 0.50D0, | |
366 | & 0.50D0, 0.50D0, 0.6D0, 1.2D0, 0.6D0, | |
367 | 1 0.50D0,0.60D0,0.75D0, 0D0, 0D0, 0D0, 0D0, 1.0D0, 1.0D0, 0D0, | |
368 | 2 0.36D0, 1.0D0,0.01D0, 2.0D0,1.0D0,0.4D0, 0D0, 0D0, 0D0, 0D0, | |
369 | 3 0.10D0, 1.0D0, 0.8D0, 1.5D0,0D0,2.0D0,0.2D0, 0D0,0.08D0,1D0, | |
370 | 4 0.3D0, 0.58D0, 0.5D0, 0.9D0,0.5D0,1.0D0,1.0D0,1.5D0,1D0,10D0, | |
371 | 5 0.77D0, 0.77D0, 0.77D0, -0.05D0, -0.005D0, | |
372 | 5 0D0, 0D0, 0D0, 1.0D0, 0D0, | |
373 | 6 4.5D0, 0.7D0, 0D0,0.003D0, 0.5D0, 0.5D0, 0D0, 0D0, 0D0, 0D0, | |
374 | 7 10D0, 1000D0, 100D0, 1000D0, 0D0, 0.7D0,10D0, 0D0,0D0,0.5D0, | |
375 | 8 0.29D0, 1.0D0, 1.0D0, 0D0, 10D0, 10D0, 0D0, 0D0, 0D0,1D-4, | |
376 | 9 0.02D0, 1.0D0, 0.2D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
377 | & 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
378 | 1 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
379 | 2 1.0D0, 0.25D0,91.187D0,2.489D0, 0.01D0, | |
380 | 2 2.0D0, 1.0D0, 0.25D0,0.002D0, 0D0, | |
381 | 3 0D0, 0D0, 0D0, 0D0, 0.01D0, 0.99D0, 0D0, 0D0, 0.2D0, 0D0, | |
382 | 4 10*0D0, | |
383 | 5 10*0D0, | |
384 | 6 10*0D0, | |
385 | 7 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, -0.693D0, | |
386 | 8 -1.0D0, 0.387D0, 1.0D0, -0.08D0, -1.0D0, | |
387 | 8 1.0D0, 1.0D0, -0.693D0, -1.0D0, 0.387D0, | |
388 | 9 1.0D0, -0.08D0, -1.0D0, 1.0D0, 1.0D0, | |
389 | 9 5*0D0/ | |
390 | ||
391 | C...PYDAT2, with particle data and flavour treatment parameters. | |
392 | DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, | |
393 | &-3,0,-3,6*0,3,9*0,3,2*0,3,4*0,-1,41*0,2,-1,20*0,3*3,7*0,3*3,3*0, | |
394 | &3*3,3*0,3*3,6*0,3*3,3*0,3*3,4*0,-2,-3,2*1,2*0,4,2*3,6,2*-2,2*-3, | |
395 | &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, | |
396 | &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, | |
397 | &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, | |
398 | &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, | |
399 | &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, | |
400 | &2,-1,2,-3,0,-3,0,-3,2*0,3,3*0,3,8*0,-1,2,-3,6*0,3,2*6,0,3,4*0,3, | |
401 | &139*0/ | |
402 | DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,20*0,1,107*0,-1,0,2*-1, | |
403 | &2*0,-1,3*0,2*-1,3*0,2*-1,4*0,-1,5*0,2*-1,4*0,2*-1,5*0,2*-1,6*0, | |
404 | &-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, | |
405 | &6*1,9*0,2,3*0,2,0,5*2,2*1,156*0/ | |
406 | DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,3*0, | |
407 | &2*1,39*0,1,0,2*1,20*0,3*1,4*0,6*1,3*0,9*1,3*0,12*1,4*0,100*1,2*0, | |
408 | &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, | |
409 | &1,2*0,1,0,12*1,0,1,3*0,1,8*0,4*1,5*0,3*1,0,1,3*0,2*1,139*0/ | |
410 | DATA (KCHG(I,4),I= 1, 290)/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, | |
411 | &16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36, | |
412 | &37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57, | |
413 | &58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78, | |
414 | &79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99, | |
415 | &100,110,111,113,115,130,211,213,215,221,223,225,310,311,313,315, | |
416 | &321,323,325,331,333,335,411,413,415,421,423,425,431,433,435,441, | |
417 | &443,445,511,513,515,521,523,525,531,533,535,541,543,545,551,553, | |
418 | &555,990,1103,1114,2101,2103,2112,2114,2203,2212,2214,2224,3101, | |
419 | &3103,3112,3114,3122,3201,3203,3212,3214,3222,3224,3303,3312,3314, | |
420 | &3322,3324,3334,4101,4103,4112,4114,4122,4132,4201,4203,4212,4214, | |
421 | &4222,4224,4232,4301,4303,4312,4314,4322,4324,4332,4334,4403,4412, | |
422 | &4414,4422,4424,4432,4434,4444,5101,5103,5112,5114,5122,5132,5142, | |
423 | &5201,5203,5212,5214,5222,5224,5232,5242,5301,5303,5312,5314,5322, | |
424 | &5324,5332,5334,5342,5401,5403,5412,5414,5422,5424,5432,5434,5442, | |
425 | &5444,5503,5512,5514,5522,5524,5532,5534,5542,5544,5554,10111, | |
426 | &10113,10211,10213,10221,10223,10311,10313,10321,10323,10331, | |
427 | &10333,10411,10413,10421,10423,10431,10433,10441,10443,10511, | |
428 | &10513,10521,10523,10531,10533,10541,10543,10551,10553,20113, | |
429 | &20213,20223,20313,20323,20333,20413,20423,20433,20443,20513/ | |
430 | DATA (KCHG(I,4),I= 291, 500)/20523,20533,20543,20553,100443, | |
431 | &100553,1000001,1000002,1000003,1000004,1000005,1000006,1000011, | |
432 | &1000012,1000013,1000014,1000015,1000016,1000021,1000022,1000023, | |
433 | &1000024,1000025,1000035,1000037,1000039,2000001,2000002,2000003, | |
434 | &2000004,2000005,2000006,2000011,2000012,2000013,2000014,2000015, | |
435 | &2000016,3000111,3000211,3000221,3000331,3000113,3000213,3000223, | |
436 | &3100021,3100111,3200111,3100113,3200113,3300113,3400113,4000001, | |
437 | &4000002,4000011,4000012,5000039,9900012,9900014,9900016,9900023, | |
438 | &9900024,9900041,9900042,9900110,9900210,9900220,9900330,9900440, | |
439 | &9902110,9902210,139*0/ | |
440 | DATA (PMAS(I,1),I= 1, 217)/2*0.33D0,0.5D0,1.5D0,4.8D0,175D0, | |
441 | &2*400D0,2*0D0,0.00051D0,0D0,0.10566D0,0D0,1.777D0,0D0,400D0, | |
442 | &5*0D0,91.188D0,80.45D0,115D0,6*0D0,500D0,900D0,500D0,3*300D0, | |
443 | &3*0D0,5000D0,200D0,40*0D0,1D0,2D0,5D0,16*0D0,0.13498D0,0.7685D0, | |
444 | &1.318D0,0.49767D0,0.13957D0,0.7669D0,1.318D0,0.54745D0,0.78194D0, | |
445 | &1.275D0,2*0.49767D0,0.8961D0,1.432D0,0.4936D0,0.8916D0,1.425D0, | |
446 | &0.95777D0,1.0194D0,1.525D0,1.8693D0,2.01D0,2.46D0,1.8645D0, | |
447 | &2.0067D0,2.46D0,1.9685D0,2.1124D0,2.5735D0,2.9798D0,3.09688D0, | |
448 | &3.5562D0,5.2792D0,5.3248D0,5.83D0,5.2789D0,5.3248D0,5.83D0, | |
449 | &5.3693D0,5.4163D0,6.07D0,6.594D0,6.602D0,7.35D0,9.4D0,9.4603D0, | |
450 | &9.9132D0,0D0,0.77133D0,1.234D0,0.57933D0,0.77133D0,0.93957D0, | |
451 | &1.233D0,0.77133D0,0.93827D0,1.232D0,1.231D0,0.80473D0,0.92953D0, | |
452 | &1.19744D0,1.3872D0,1.11568D0,0.80473D0,0.92953D0,1.19255D0, | |
453 | &1.3837D0,1.18937D0,1.3828D0,1.09361D0,1.3213D0,1.535D0,1.3149D0, | |
454 | &1.5318D0,1.67245D0,1.96908D0,2.00808D0,2.4521D0,2.5D0,2.2849D0, | |
455 | &2.4703D0,1.96908D0,2.00808D0,2.4535D0,2.5D0,2.4529D0,2.5D0, | |
456 | &2.4656D0,2.15432D0,2.17967D0,2.55D0,2.63D0,2.55D0,2.63D0,2.704D0, | |
457 | &2.8D0,3.27531D0,3.59798D0,3.65648D0,3.59798D0,3.65648D0, | |
458 | &3.78663D0,3.82466D0,4.91594D0,5.38897D0,5.40145D0,5.8D0,5.81D0, | |
459 | &5.641D0,5.84D0,7.00575D0,5.38897D0,5.40145D0,5.8D0,5.81D0,5.8D0/ | |
460 | DATA (PMAS(I,1),I= 218, 500)/5.81D0,5.84D0,7.00575D0,5.56725D0, | |
461 | &5.57536D0,5.96D0,5.97D0,5.96D0,5.97D0,6.12D0,6.13D0,7.19099D0, | |
462 | &6.67143D0,6.67397D0,7.03724D0,7.0485D0,7.03724D0,7.0485D0, | |
463 | &7.21101D0,7.219D0,8.30945D0,8.31325D0,10.07354D0,10.42272D0, | |
464 | &10.44144D0,10.42272D0,10.44144D0,10.60209D0,10.61426D0, | |
465 | &11.70767D0,11.71147D0,15.11061D0,0.9835D0,1.231D0,0.9835D0, | |
466 | &1.231D0,1D0,1.17D0,1.429D0,1.29D0,1.429D0,1.29D0,2*1.4D0,2.272D0, | |
467 | &2.424D0,2.272D0,2.424D0,2.5D0,2.536D0,3.4151D0,3.46D0,5.68D0, | |
468 | &5.73D0,5.68D0,5.73D0,5.92D0,5.97D0,7.25D0,7.3D0,9.8598D0,9.875D0, | |
469 | &2*1.23D0,1.282D0,2*1.402D0,1.427D0,2*2.372D0,2.56D0,3.5106D0, | |
470 | &2*5.78D0,6.02D0,7.3D0,9.8919D0,3.686D0,10.0233D0,32*500D0, | |
471 | &3*110D0,350D0,3*210D0,500D0,125D0,250D0,400D0,2*350D0,300D0, | |
472 | &4*400D0,1000D0,3*500D0,1200D0,750D0,2*200D0,7*0D0,139*0D0/ | |
473 | DATA (PMAS(I,2),I= 1, 500)/5*0D0,1.39816D0,16*0D0,2.47813D0, | |
474 | &2.07115D0,0.00367D0,6*0D0,14.54029D0,0D0,16.66099D0,8.38842D0, | |
475 | &3.3752D0,4.17669D0,3*0D0,417.29147D0,0.39162D0,60*0D0,0.151D0, | |
476 | &0.107D0,2*0D0,0.149D0,0.107D0,0D0,0.00843D0,0.185D0,2*0D0, | |
477 | &0.0505D0,0.109D0,0D0,0.0498D0,0.098D0,0.0002D0,0.00443D0,0.076D0, | |
478 | &2*0D0,0.023D0,2*0D0,0.023D0,2*0D0,0.015D0,0.0013D0,0D0,0.002D0, | |
479 | &2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,5*0D0,0.12D0, | |
480 | &3*0D0,0.12D0,2*0D0,2*0.12D0,3*0D0,0.0394D0,4*0D0,0.036D0,0D0, | |
481 | &0.0358D0,2*0D0,0.0099D0,0D0,0.0091D0,74*0D0,0.06D0,0.142D0, | |
482 | &0.06D0,0.142D0,0D0,0.36D0,0.287D0,0.09D0,0.287D0,0.09D0,0.25D0, | |
483 | &0.08D0,0.05D0,0.02D0,0.05D0,0.02D0,0.05D0,0D0,0.014D0,0.01D0, | |
484 | &8*0.05D0,0D0,0.01D0,2*0.4D0,0.025D0,2*0.174D0,0.053D0,3*0.05D0, | |
485 | &0.0009D0,4*0.05D0,3*0D0,19*1D0,0D0,7*1D0,0D0,1D0,0D0,1D0,0D0, | |
486 | &0.02911D0,0.01741D0,0.04536D0,0.09511D0,0.8686D0,0.62395D0, | |
487 | &0.19192D0,123.27638D0,0.02296D0,0.18886D0,23.26819D0,2.86306D0, | |
488 | &0D0,3.45903D0,2.59359D0,2.59687D0,0.42896D0,0.41912D0,0.14153D0, | |
489 | &2*0.00098D0,0.00097D0,26.7245D0,21.74916D0,0.88159D0,0.88001D0, | |
490 | &7*0D0,139*0D0/ | |
491 | DATA (PMAS(I,3),I= 1, 500)/5*0D0,13.98156D0,16*0D0,24.78129D0, | |
492 | &20.71149D0,0.03669D0,6*0D0,145.40294D0,0D0,166.60993D0, | |
493 | &83.88423D0,33.75195D0,41.76694D0,3*0D0,4172.91467D0,3.91621D0, | |
494 | &60*0D0,0.4D0,0.25D0,2*0D0,0.4D0,0.25D0,0D0,0.1D0,0.17D0,2*0D0, | |
495 | &0.2D0,0.12D0,0D0,0.2D0,0.12D0,0.002D0,0.015D0,0.2D0,2*0D0,0.12D0, | |
496 | &2*0D0,0.12D0,2*0D0,0.05D0,0.005D0,0D0,0.01D0,2*0D0,0.05D0,2*0D0, | |
497 | &0.05D0,2*0D0,0.05D0,2*0D0,0.05D0,5*0D0,0.14D0,3*0D0,0.14D0,2*0D0, | |
498 | &2*0.14D0,3*0D0,0.04D0,4*0D0,0.035D0,0D0,0.035D0,2*0D0,0.05D0,0D0, | |
499 | &0.05D0,74*0D0,0.05D0,0.25D0,0.05D0,0.25D0,0D0,0.2D0,0.4D0, | |
500 | &0.005D0,0.4D0,0.01D0,0.35D0,0.001D0,0.1D0,0.08D0,0.1D0,0.08D0, | |
501 | &0.1D0,0D0,0.05D0,0.02D0,6*0.1D0,0.05D0,0.1D0,0D0,0.02D0,2*0.3D0, | |
502 | &0.05D0,2*0.3D0,0.02D0,2*0.1D0,0.03D0,0.001D0,4*0.1D0,3*0D0, | |
503 | &19*10D0,0.00001D0,7*10D0,0.00001D0,10D0,0.00001D0,10D0,0.00001D0, | |
504 | &0.29108D0,0.17412D0,0.45362D0,0.95114D0,8.68604D0,6.23946D0, | |
505 | &1.91923D0,450D0,0.22959D0,1.88863D0,232.68185D0,28.63059D0,0D0, | |
506 | &34.59032D0,25.93594D0,25.96873D0,4.28961D0,4.19124D0,1.41528D0, | |
507 | &0.00977D0,0.00976D0,0.00973D0,267.24501D0,217.49162D0,8.81592D0, | |
508 | &8.80013D0,7*0D0,139*0D0/ | |
509 | DATA (PMAS(I,4),I= 1, 500)/12*0D0,658654D0,0D0,0.0872D0,68*0D0, | |
510 | &0.1D0,0.387D0,16*0D0,0.00003D0,2*0D0,15500D0,7804.5D0,5*0D0, | |
511 | &26.762D0,3*0D0,3709D0,5*0D0,0.317D0,2*0D0,0.1244D0,2*0D0,0.14D0, | |
512 | &5*0D0,0.468D0,2*0D0,0.462D0,2*0D0,0.483D0,2*0D0,0.15D0,18*0D0, | |
513 | &44.34D0,0D0,78.88D0,4*0D0,23.96D0,2*0D0,49.1D0,0D0,87.1D0,0D0, | |
514 | &24.6D0,4*0D0,0.0618D0,0.029D0,6*0D0,0.106D0,6*0D0,0.019D0,2*0D0, | |
515 | &7*0.1D0,4*0D0,0.342D0,2*0.387D0,6*0D0,2*0.387D0,6*0D0,0.387D0, | |
516 | &0D0,0.387D0,2*0D0,8*0.387D0,0D0,9*0.387D0,112*0D0,139*0D0/ | |
517 | DATA PARF/ | |
518 | & 0.5D0,0.25D0, 0.5D0,0.25D0, 1D0, 0.5D0, 0D0, 0D0, 0D0, 0D0, | |
519 | 1 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, | |
520 | 2 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, | |
521 | 3 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, | |
522 | 4 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, | |
523 | 5 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, | |
524 | 6 0.75D0, 0.5D0, 0D0,0.1667D0,0.0833D0,0.1667D0,0D0,0D0,0D0, 0D0, | |
525 | 7 0D0, 0D0, 1D0,0.3333D0,0.6667D0,0.3333D0,0D0,0D0,0D0, 0D0, | |
526 | 8 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
527 | 9 0.0099D0, 0.0056D0, 0.199D0, 1.23D0, 4.17D0, 165D0, 4*0D0, | |
528 | & 0.325D0,0.325D0,0.5D0,1.6D0, 5.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
529 | 1 0D0,0.11D0,0.16D0,0.048D0,0.50D0,0.45D0,0.55D0,0.60D0,0D0,0D0, | |
530 | 2 0.2D0, 0.1D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
531 | 3 60*0D0, | |
532 | 4 0.2D0, 0.5D0, 8*0D0, | |
533 | 5 1800*0D0/ | |
534 | DATA ((VCKM(I,J),J=1,4),I=1,4)/ | |
535 | & 0.95113D0, 0.04884D0, 0.00003D0, 0.00000D0, | |
536 | & 0.04884D0, 0.94940D0, 0.00176D0, 0.00000D0, | |
537 | & 0.00003D0, 0.00176D0, 0.99821D0, 0.00000D0, | |
538 | & 0.00000D0, 0.00000D0, 0.00000D0, 1.00000D0/ | |
539 | ||
540 | C...PYDAT3, with particle decay parameters and data. | |
541 | DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0, | |
542 | &4*1,3*0,2*1,40*0,3*1,16*0,3*1,2*0,9*1,0,32*1,2*0,1,3*0,1,2*0,2*1, | |
543 | &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, | |
544 | &6*1,2*0,7*1,2*0,8*1,0,75*1,0,7*1,0,1,0,1,0,26*1,146*0/ | |
545 | DATA (MDCY(I,2),I= 1, 351)/1,9,17,25,33,41,56,66,2*0,76,80,82, | |
546 | &87,89,143,145,150,2*0,153,162,174,190,210,6*0,289,0,311,334,420, | |
547 | &503,3*0,530,539,40*0,540,541,545,16*0,554,556,561,570,579,581, | |
548 | &583,590,598,604,613,615,617,620,630,636,639,650,656,667,673,736, | |
549 | &739,747,808,810,818,851,853,857,858,861,863,899,900,908,944,945, | |
550 | &953,992,993,997,1028,1029,1033,1034,1043,2*0,1045,3*0,1046,2*0, | |
551 | &1049,1052,2*0,1053,1055,1058,2*0,1062,1063,1066,1069,0,1072,1077, | |
552 | &1079,1082,1084,2*0,1088,1089,1090,1166,2*0,1170,1171,1172,1173, | |
553 | &1174,2*0,1178,1179,1181,1182,1184,1188,0,1189,1193,1197,1201, | |
554 | &1205,1209,1213,2*0,1217,1218,1219,1236,1245,2*0,1254,1255,1256, | |
555 | &1257,1258,1267,2*0,1276,1277,1278,1279,1280,1289,1290,2*0,1299, | |
556 | &1308,1317,1326,1335,1344,1353,1362,0,1371,1380,1389,1398,1407, | |
557 | &1416,1425,1434,1443,1452,1453,1454,1455,1456,1461,1464,1466,1471, | |
558 | &1473,1478,1485,1489,1491,1493,1495,1497,1499,1501,1503,1504,1506, | |
559 | &1508,1510,1512,1514,1516,1518,1520,1522,1523,1525,1527,1541,1543, | |
560 | &1545,1549,1551,1553,1555,1557,1559,1561,1563,1565,1567,1578,1592, | |
561 | &1637,1661,1706,1730,1775,1802,1833,1859,1891,1917,1949,1975,2162, | |
562 | &2331,2595,2826,3106,3402,0,3657,3706,3734,3783,3811,3860,3888,0, | |
563 | &3924,0,3960,0,3996,4004,4012,4020,4023,4047,4073,4097,4103,4110, | |
564 | &4117,4124,4130,4136,4145,4149,4153,4156,4158,4178,4200,4222,4244/ | |
565 | DATA (MDCY(I,2),I= 352, 500)/4259,4271,4278,146*0/ | |
566 | DATA (MDCY(I,3),I= 1, 500)/5*8,15,2*10,2*0,4,2,5,2,54,2,5,3, | |
567 | &2*0,9,12,16,20,79,6*0,22,0,23,86,83,27,3*0,9,1,40*0,1,4,9,16*0,2, | |
568 | &5,2*9,2*2,7,8,6,9,2*2,3,10,6,3,11,6,11,6,63,3,8,61,2,8,33,2,4,1, | |
569 | &3,2,36,1,8,36,1,8,39,1,4,31,1,4,1,9,2,2*0,1,3*0,3,2*0,3,1,2*0,2, | |
570 | &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, | |
571 | &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, | |
572 | &5,3,2,5,2,5,7,4,7*2,1,9*2,1,2*2,14,2*2,4,9*2,11,14,45,24,45,24, | |
573 | &45,27,31,26,32,26,32,26,187,169,264,231,280,296,255,0,49,28,49, | |
574 | &28,49,28,36,0,36,0,36,0,3*8,3,24,26,24,6,3*7,2*6,9,2*4,3,2,20, | |
575 | &3*22,15,12,2*7,146*0/ | |
576 | DATA (MDME(I,1),I= 1,8000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, | |
577 | &7*1,-1,1,7*-1,8*1,2*-1,8*1,2*-1,73*1,-1,2*1,-1,5*1,0,2*-1,6*1,0, | |
578 | &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, | |
579 | &2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,200*1,2*-1,2*1,-1, | |
580 | &1249*1,2*-1,377*1,2*-1,1868*1,2*-1,6*1,2*-1,9*1,-1,3*1,-1,3*1, | |
581 | &5*-1,3*1,-1,14*1,2*-1,6*1,2*-1,67*1,2*-1,6*1,2*-1,111*1,3716*0/ | |
582 | DATA (MDME(I,2),I= 1,8000)/43*102,4*0,102,0,6*53,3*102,4*0,102, | |
583 | &2*0,3*102,4*0,102,2*0,6*102,42,6*102,2*42,2*0,8*41,2*0,36*41, | |
584 | &8*102,0,102,0,102,2*0,21*102,8*32,8*0,16*32,4*0,8*32,9*0,62*53, | |
585 | &8*32,14*0,16*32,7*0,8*32,16*0,62*53,8*32,13*0,62*53,4*32,5*0, | |
586 | &18*53,6*32,4*0,12,2*42,2*11,9*42,0,2,3,15*0,4*42,5*0,3,12*0,2, | |
587 | &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, | |
588 | &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, | |
589 | &14*42,16*0,48,3*13,2*42,9*0,14*42,16*0,48,3*13,2*42,9*0,14*42, | |
590 | &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, | |
591 | &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, | |
592 | &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, | |
593 | &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, | |
594 | &17*0,2*32,33*0,12,9*0,32,2*0,12,11*0,4*32,2*4,5*0,2404*53,4*32, | |
595 | &3*0,6*32,3*0,4*32,3*0,4*32,8*0,8*32,14*0,16*32,12*0,8*32,8*0, | |
596 | &46*32,3*53,12*0,8*32,12*0,66*51,6*32,9*0,9*32,3733*0/ | |
597 | DATA (BRAT(I) ,I= 1, 346)/43*0D0,0.00003D0,0.001765D0, | |
598 | &0.998205D0,35*0D0,1D0,6*0D0,0.1783D0,0.1735D0,0.1131D0,0.2494D0, | |
599 | &0.003D0,0.09D0,0.0027D0,0.01D0,0.0014D0,0.0012D0,2*0.00025D0, | |
600 | &0.0071D0,0.012D0,0.0004D0,0.00075D0,0.00006D0,2*0.00078D0, | |
601 | &0.0034D0,0.08D0,0.011D0,0.0191D0,0.00006D0,0.005D0,0.0133D0, | |
602 | &0.0067D0,0.0005D0,0.0035D0,0.0006D0,0.0015D0,0.00021D0,0.0002D0, | |
603 | &0.00075D0,0.0001D0,0.0002D0,0.0011D0,3*0.0002D0,0.00022D0, | |
604 | &0.0004D0,0.0001D0,2*0.00205D0,2*0.00069D0,0.00025D0,0.00051D0, | |
605 | &0.00025D0,35*0D0,0.153995D0,0.11942D0,0.153984D0,0.119259D0, | |
606 | &0.152272D0,3*0D0,0.033576D0,0.066806D0,0.033576D0,0.066806D0, | |
607 | &0.0335D0,0.066806D0,2*0D0,0.321369D0,0.016494D0,2*0D0,0.016502D0, | |
608 | &0.320615D0,2*0D0,0.00001D0,0.000591D0,6*0D0,2*0.108166D0, | |
609 | &0.108087D0,0D0,0.000001D0,0D0,0.000349D0,0.048707D0,0.768308D0, | |
610 | &4*0D0,0.000227D0,0.064048D0,0D0,0.040621D0,0.002043D0,0.000615D0, | |
611 | &0.006981D0,0.068099D0,62*0D0,0.145835D0,0.113276D0,0.145835D0, | |
612 | &0.113271D0,0.145781D0,0.049002D0,2*0D0,0.032025D0,0.063642D0, | |
613 | &0.032025D0,0.063642D0,0.032022D0,0.063642D0,8*0D0,0.251225D0, | |
614 | &0.0129D0,0.000006D0,0D0,0.0129D0,0.250764D0,0.00038D0,0D0, | |
615 | &0.000008D0,0.000465D0,0.215418D0,5*0D0,2*0.085312D0,0.08531D0, | |
616 | &7*0D0,0.000049D0,0.000774D0,5*0D0,0.000074D0,0D0,0.000417D0/ | |
617 | DATA (BRAT(I) ,I= 347, 651)/0.000015D0,0.000061D0,0.30671D0, | |
618 | &0.689011D0,0D0,0.002889D0,69*0D0,0.000001D0,0.000121D0, | |
619 | &0.001924D0,4*0D0,0.000001D0,0.000184D0,0D0,0.003106D0,0.000015D0, | |
620 | &0.000003D0,2*0D0,0.994646D0,66*0D0,0.000021D0,0.090135D0,2*0D0, | |
621 | &0.000013D0,0.003714D0,0D0,0.906117D0,18*0D0,3*0.215119D0, | |
622 | &0.214724D0,2*0D0,0.06996D0,0.069959D0,0D0,2*1D0,2*0.08D0,0.76D0, | |
623 | &0.08D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, | |
624 | &0.005D0,0.988D0,0.012D0,0.998739D0,0.00079D0,0.00038D0, | |
625 | &0.000046D0,0.000045D0,2*0.34725D0,0.144D0,0.104D0,0.0245D0, | |
626 | &2*0.01225D0,0.0028D0,0.0057D0,0.2112D0,0.1256D0,2*0.1939D0, | |
627 | &2*0.1359D0,0.002D0,0.001D0,0.0006D0,0.999877D0,0.000123D0, | |
628 | &0.99955D0,0.00045D0,2*0.34725D0,0.144D0,0.104D0,0.049D0,0.0028D0, | |
629 | &0.0057D0,0.3923D0,0.321D0,0.2317D0,0.0478D0,0.0049D0,0.0013D0, | |
630 | &0.0003D0,0.0007D0,0.89D0,0.08693D0,0.0221D0,0.00083D0, | |
631 | &2*0.00007D0,0.564D0,0.282D0,0.072D0,0.028D0,0.023D0,2*0.0115D0, | |
632 | &0.005D0,0.003D0,0.6861D0,0.3139D0,2*0.5D0,0.665D0,0.333D0, | |
633 | &0.002D0,0.333D0,0.166D0,0.168D0,0.084D0,0.087D0,0.043D0,0.059D0, | |
634 | &2*0.029D0,0.002D0,0.6352D0,0.2116D0,0.0559D0,0.0173D0,0.0482D0, | |
635 | &0.0318D0,0.666D0,0.333D0,0.001D0,0.332D0,0.166D0,0.168D0,0.084D0, | |
636 | &0.086D0,0.043D0,0.059D0,2*0.029D0,2*0.002D0,0.437D0,0.208D0/ | |
637 | DATA (BRAT(I) ,I= 652, 823)/0.302D0,0.0302D0,0.0212D0,0.0016D0, | |
638 | &0.48947D0,0.34D0,3*0.043D0,0.027D0,0.0126D0,0.0013D0,0.0003D0, | |
639 | &0.00025D0,0.00008D0,0.444D0,2*0.222D0,0.104D0,2*0.004D0,0.07D0, | |
640 | &0.065D0,2*0.005D0,2*0.011D0,5*0.001D0,0.07D0,0.065D0,2*0.005D0, | |
641 | &2*0.011D0,5*0.001D0,0.026D0,0.019D0,0.066D0,0.041D0,0.045D0, | |
642 | &0.076D0,0.0073D0,2*0.0047D0,0.026D0,0.001D0,0.0006D0,0.0066D0, | |
643 | &0.005D0,2*0.003D0,2*0.0006D0,2*0.001D0,0.006D0,0.005D0,0.012D0, | |
644 | &0.0057D0,0.067D0,0.008D0,0.0022D0,0.027D0,0.004D0,0.019D0, | |
645 | &0.012D0,0.002D0,0.009D0,0.0218D0,0.001D0,0.022D0,0.087D0,0.001D0, | |
646 | &0.0019D0,0.0015D0,0.0028D0,0.683D0,0.306D0,0.011D0,0.3D0,0.15D0, | |
647 | &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.034D0,0.027D0, | |
648 | &2*0.002D0,2*0.004D0,2*0.002D0,0.034D0,0.027D0,2*0.002D0, | |
649 | &2*0.004D0,2*0.002D0,0.0365D0,0.045D0,0.073D0,0.062D0,3*0.021D0, | |
650 | &0.0061D0,0.015D0,0.025D0,0.0088D0,0.074D0,0.0109D0,0.0041D0, | |
651 | &0.002D0,0.0035D0,0.0011D0,0.001D0,0.0027D0,2*0.0016D0,0.0018D0, | |
652 | &0.011D0,0.0063D0,0.0052D0,0.018D0,0.016D0,0.0034D0,0.0036D0, | |
653 | &0.0009D0,0.0006D0,0.015D0,0.0923D0,0.018D0,0.022D0,0.0077D0, | |
654 | &0.009D0,0.0075D0,0.024D0,0.0085D0,0.067D0,0.0511D0,0.017D0, | |
655 | &0.0004D0,0.0028D0,0.619D0,0.381D0,0.3D0,0.15D0,0.16D0,0.08D0, | |
656 | &0.13D0,0.06D0,0.08D0,0.04D0,0.01D0,2*0.02D0,0.03D0,2*0.005D0/ | |
657 | DATA (BRAT(I) ,I= 824, 991)/2*0.02D0,0.03D0,2*0.005D0,0.015D0, | |
658 | &0.037D0,0.028D0,0.079D0,0.095D0,0.052D0,0.0078D0,4*0.001D0, | |
659 | &0.028D0,0.033D0,0.026D0,0.05D0,0.01D0,4*0.005D0,0.25D0,0.0952D0, | |
660 | &0.94D0,0.06D0,2*0.4D0,2*0.1D0,1D0,0.0602D0,0.0601D0,0.8797D0, | |
661 | &0.135D0,0.865D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.02D0, | |
662 | &0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0, | |
663 | &0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0,0.0135D0, | |
664 | &0.025D0,0.0004D0,0.0007D0,0.0008D0,0.0014D0,0.0019D0,0.0025D0, | |
665 | &0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0, | |
666 | &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.02D0,0.055D0, | |
667 | &2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0, | |
668 | &0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0, | |
669 | &0.018D0,0.015D0,0.0185D0,0.0135D0,0.025D0,0.0004D0,0.0007D0, | |
670 | &0.0008D0,0.0014D0,0.0019D0,0.0025D0,0.4291D0,0.08D0,0.07D0, | |
671 | &0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0, | |
672 | &0.06D0,0.08D0,0.04D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0, | |
673 | &0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0, | |
674 | &0.011D0,0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0, | |
675 | &0.0135D0,0.025D0,2*0.0002D0,0.0007D0,2*0.0004D0,0.0014D0,0.001D0, | |
676 | &0.0009D0,0.0025D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0/ | |
677 | DATA (BRAT(I) ,I= 992,1183)/1D0,2*0.3D0,2*0.2D0,0.047D0,0.122D0, | |
678 | &0.006D0,0.012D0,0.035D0,0.012D0,0.035D0,0.003D0,0.007D0,0.15D0, | |
679 | &0.037D0,0.008D0,0.002D0,0.05D0,0.015D0,0.003D0,0.001D0,0.014D0, | |
680 | &0.042D0,0.014D0,0.042D0,0.24D0,0.065D0,0.012D0,0.003D0,0.001D0, | |
681 | &0.002D0,0.001D0,0.002D0,0.014D0,0.003D0,1D0,2*0.3D0,2*0.2D0,1D0, | |
682 | &0.0252D0,0.0248D0,0.0267D0,0.015D0,0.045D0,0.015D0,0.045D0, | |
683 | &0.7743D0,0.029D0,0.22D0,0.78D0,1D0,0.331D0,0.663D0,0.006D0, | |
684 | &0.663D0,0.331D0,0.006D0,1D0,0.999D0,0.001D0,0.88D0,2*0.06D0, | |
685 | &0.639D0,0.358D0,0.002D0,0.001D0,1D0,0.88D0,2*0.06D0,0.516D0, | |
686 | &0.483D0,0.001D0,0.88D0,2*0.06D0,0.9988D0,0.0001D0,0.0006D0, | |
687 | &0.0004D0,0.0001D0,0.667D0,0.333D0,0.9954D0,0.0011D0,0.0035D0, | |
688 | &0.333D0,0.667D0,0.676D0,0.234D0,0.085D0,0.005D0,2*1D0,0.018D0, | |
689 | &2*0.005D0,0.003D0,0.002D0,2*0.006D0,0.018D0,2*0.005D0,0.003D0, | |
690 | &0.002D0,2*0.006D0,0.0066D0,0.025D0,0.016D0,0.0088D0,2*0.005D0, | |
691 | &0.0058D0,0.005D0,0.0055D0,4*0.004D0,2*0.002D0,2*0.004D0,0.003D0, | |
692 | &0.002D0,2*0.003D0,3*0.002D0,2*0.001D0,0.002D0,2*0.001D0, | |
693 | &2*0.002D0,0.0013D0,0.0018D0,5*0.001D0,4*0.003D0,2*0.005D0, | |
694 | &2*0.002D0,2*0.001D0,2*0.002D0,2*0.001D0,0.2432D0,0.057D0, | |
695 | &2*0.035D0,0.15D0,2*0.075D0,0.03D0,2*0.015D0,2*0.08D0,0.76D0, | |
696 | &0.08D0,4*1D0,2*0.08D0,0.76D0,0.08D0,1D0,2*0.5D0,1D0,2*0.5D0/ | |
697 | DATA (BRAT(I) ,I=1184,1377)/2*0.08D0,0.76D0,0.08D0,1D0,2*0.08D0, | |
698 | &0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0, | |
699 | &0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,0.08D0,2*1D0,2*0.105D0, | |
700 | &0.04D0,0.0077D0,0.02D0,0.0235D0,0.0285D0,0.0435D0,0.0011D0, | |
701 | &0.0022D0,0.0044D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0, | |
702 | &2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0, | |
703 | &2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0, | |
704 | &4*1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, | |
705 | &0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, | |
706 | &0.005D0,4*1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
707 | &0.015D0,0.005D0,1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
708 | &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
709 | &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
710 | &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
711 | &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
712 | &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
713 | &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
714 | &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
715 | &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, | |
716 | &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0/ | |
717 | DATA (BRAT(I) ,I=1378,1580)/0.015D0,0.005D0,2*0.105D0,0.04D0, | |
718 | &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, | |
719 | &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, | |
720 | &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, | |
721 | &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, | |
722 | &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, | |
723 | &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, | |
724 | &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, | |
725 | &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,4*1D0,0.52D0,0.26D0, | |
726 | &0.11D0,2*0.055D0,0.333D0,0.334D0,0.333D0,0.667D0,0.333D0,0.28D0, | |
727 | &0.14D0,0.313D0,0.157D0,0.11D0,0.667D0,0.333D0,0.28D0,0.14D0, | |
728 | &0.313D0,0.157D0,0.11D0,0.36D0,0.18D0,0.03D0,2*0.015D0,2*0.2D0, | |
729 | &4*0.25D0,0.667D0,0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,0.667D0, | |
730 | &0.333D0,4*0.5D0,0.007D0,0.993D0,1D0,0.667D0,0.333D0,0.667D0, | |
731 | &0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,8*0.5D0,0.02D0,0.98D0, | |
732 | &1D0,4*0.5D0,3*0.146D0,3*0.05D0,0.15D0,2*0.05D0,4*0.024D0,0.066D0, | |
733 | &0.667D0,0.333D0,0.667D0,0.333D0,4*0.25D0,0.667D0,0.333D0,0.667D0, | |
734 | &0.333D0,2*0.5D0,0.273D0,0.727D0,0.667D0,0.333D0,0.667D0,0.333D0, | |
735 | &4*0.5D0,0.35D0,0.65D0,2*0.0083D0,0.1866D0,0.324D0,0.184D0, | |
736 | &0.027D0,0.001D0,0.093D0,0.087D0,0.078D0,0.0028D0,3*0.014D0/ | |
737 | DATA (BRAT(I) ,I=1581,4149)/0.008D0,0.024D0,0.008D0,0.024D0, | |
738 | &0.425D0,0.02D0,0.185D0,0.088D0,0.043D0,0.067D0,0.066D0,2404*0D0, | |
739 | &0.017431D0,0.054048D0,0.857694D0,2*0D0,0.00025D0,0.070578D0,0D0, | |
740 | &0.022748D0,0.026576D0,0.359486D0,0.561581D0,2*0D0,0.000104D0, | |
741 | &0.029504D0,0.011185D0,0.034681D0,0.550354D0,2*0D0,0.00016D0, | |
742 | &0.045287D0,0.358333D0,0.445781D0,0D0,0.554219D0,0.144051D0, | |
743 | &2*0.351902D0,0D0,0.082107D0,0.029566D0,0.001511D0,0.000726D0, | |
744 | &0.004518D0,0.006522D0,0.004518D0,0.006522D0,0.004513D0,3*0D0, | |
745 | &0.002908D0,0.000973D0,0.002908D0,0.000973D0,0.002908D0, | |
746 | &0.000973D0,2*0D0,0.143982D0,0.489888D0,0.1951D0,0D0,0.114302D0, | |
747 | &0.008426D0,0.014868D0,0.000763D0,2*0D0,0.000763D0,0.01484D0, | |
748 | &0.000003D0,2*0D0,0.000027D0,0.001945D0,5*0D0,3*0.00503D0,0D0, | |
749 | &0.133776D0,0.003284D0,0.37169D0,0.006838D0,2*0.030954D0, | |
750 | &0.00163D0,0D0,0.047224D0,0.073737D0,0.047224D0,0.073732D0, | |
751 | &0.047179D0,3*0D0,0.034761D0,0.009166D0,0.034761D0,0.009166D0, | |
752 | &0.034759D0,0.009166D0,2*0D0,4*0.009069D0,0.510147D0,0.453576D0, | |
753 | &6*0D0,1D0,6*0D0,1D0,4*0.001128D0,0.571047D0,0.382288D0, | |
754 | &0.042153D0,4*0.016597D0,0.93361D0,0D0,4*0.016597D0,0.93361D0,0D0, | |
755 | &4*0.05515D0,0.34469D0,0D0,0.228998D0,0.164208D0,0.041503D0, | |
756 | &0.850973D0,0.005411D0,0.045025D0,0.098591D0,0.849898D0/ | |
757 | DATA (BRAT(I) ,I=4150,4280)/0.021617D0,0.030018D0,0.098466D0, | |
758 | &0.294448D0,0.10945D0,0.596102D0,0.389906D0,0.610094D0,3*0.0633D0, | |
759 | &0.063299D0,0.063295D0,0.056281D0,2*0D0,6*0.020495D0,2*0D0, | |
760 | &0.327919D0,0.04099D0,0.045236D0,0.090112D0,0.19874D0,0.010204D0, | |
761 | &0.000003D0,0.010205D0,0.198356D0,0.000151D0,0.000006D0, | |
762 | &0.000367D0,0.081967D0,0.19874D0,0.010204D0,0.000003D0,0.010205D0, | |
763 | &0.198356D0,0.000151D0,0.000006D0,0.000367D0,0.081967D0,4*0D0, | |
764 | &0.198776D0,0.010206D0,0.000003D0,0.010207D0,0.19839D0,0.000151D0, | |
765 | &0.000006D0,0.000367D0,0.081893D0,0.198776D0,0.010206D0, | |
766 | &0.000003D0,0.010207D0,0.19839D0,0.000151D0,0.000006D0,0.000367D0, | |
767 | &0.081893D0,4*0D0,0.199344D0,0.010234D0,0.000003D0,0.010236D0, | |
768 | &0.198928D0,0.000149D0,0.000006D0,0.000368D0,0.080733D0, | |
769 | &0.199344D0,0.010234D0,0.000003D0,0.010236D0,0.198928D0, | |
770 | &0.000149D0,0.000006D0,0.000368D0,0.080733D0,4*0D0,0.184738D0, | |
771 | &0.104588D0,0.184738D0,0.104587D0,0.184731D0,0.09582D0,0.022902D0, | |
772 | &0.008429D0,0.015602D0,0.022902D0,0.008429D0,0.015602D0, | |
773 | &0.022902D0,0.008429D0,0.015602D0,0.28959D0,0.01487D0,0.000008D0, | |
774 | &0.01487D0,0.289061D0,0.000492D0,0.000009D0,0.000536D0,0.27911D0, | |
775 | &2*0.037151D0,0.03715D0,0.090266D0,2*0.001805D0,0.090266D0, | |
776 | &0.001805D0,0.812263D0,0.00179D0,0.090428D0,0.001809D0,0.001808D0/ | |
777 | DATA (BRAT(I) ,I=4281,8000)/0.090428D0,0.001808D0,0.81372D0,0D0, | |
778 | &3716*0D0/ | |
779 | DATA (KFDP(I,1),I= 1, 377)/21,22,23,4*-24,25,21,22,23,4*24,25, | |
780 | &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23, | |
781 | &4*24,25,37,1000022,1000023,1000025,1000035,1000021,1000039,21,22, | |
782 | &23,4*-24,25,2*-37,21,22,23,4*24,25,2*37,22,23,-24,25,23,24,-12, | |
783 | &22,23,-24,25,23,24,-12,-14,48*16,22,23,-24,25,23,24,22,23,-24,25, | |
784 | &-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, | |
785 | &3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1,4*-3,4*-5,4*-7,-11,-13, | |
786 | &-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,1000022, | |
787 | &2*1000023,3*1000025,4*1000035,2*1000024,2*1000037,1000001, | |
788 | &2000001,1000001,-1000001,1000002,2000002,1000002,-1000002, | |
789 | &1000003,2000003,1000003,-1000003,1000004,2000004,1000004, | |
790 | &-1000004,1000005,2000005,1000005,-1000005,1000006,2000006, | |
791 | &1000006,-1000006,1000011,2000011,1000011,-1000011,1000012, | |
792 | &2000012,1000012,-1000012,1000013,2000013,1000013,-1000013, | |
793 | &1000014,2000014,1000014,-1000014,1000015,2000015,1000015, | |
794 | &-1000015,1000016,2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,12, | |
795 | &13,14,15,16,17,18,24,37,2*23,25,35,4*-1,4*-3,4*-5,4*-7,-11,-13, | |
796 | &-15,-17,3*24,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,23,25,24, | |
797 | &37,23,25,36,1000022,2*1000023,3*1000025,4*1000035,2*1000024, | |
798 | &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002/ | |
799 | DATA (KFDP(I,1),I= 378, 580)/1000002,-1000002,1000003,2000003, | |
800 | &1000003,-1000003,1000004,2000004,1000004,-1000004,1000005, | |
801 | &2000005,1000005,-1000005,1000006,2000006,1000006,-1000006, | |
802 | &1000011,2000011,1000011,-1000011,1000012,2000012,1000012, | |
803 | &-1000012,1000013,2000013,1000013,-1000013,1000014,2000014, | |
804 | &1000014,-1000014,1000015,2000015,1000015,-1000015,1000016, | |
805 | &2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23, | |
806 | &24,23,25,24,37,1000022,2*1000023,3*1000025,4*1000035,2*1000024, | |
807 | &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002, | |
808 | &1000002,-1000002,1000003,2000003,1000003,-1000003,1000004, | |
809 | &2000004,1000004,-1000004,1000005,2000005,1000005,-1000005, | |
810 | &1000006,2000006,1000006,-1000006,1000011,2000011,1000011, | |
811 | &-1000011,1000012,2000012,1000012,-1000012,1000013,2000013, | |
812 | &1000013,-1000013,1000014,2000014,1000014,-1000014,1000015, | |
813 | &2000015,1000015,-1000015,1000016,2000016,1000016,-1000016,-1,-3, | |
814 | &-5,-7,-11,-13,-15,-17,24,2*1000022,2*1000023,2*1000025,2*1000035, | |
815 | &1000006,2000006,1000006,2000006,-1000001,-1000003,-1000011, | |
816 | &-1000013,-1000015,-2000015,1,2,3,4,5,6,11,13,15,2,82,-11,-13,2*2, | |
817 | &-12,-14,-16,2*-2,2*-4,-2,-4,2*22,211,111,221,13,11,213,-213,221, | |
818 | &223,321,130,310,111,331,111,211,-12,12,-14,14,211,111,22,-13,-11/ | |
819 | DATA (KFDP(I,1),I= 581, 992)/2*211,213,113,221,223,321,211,331, | |
820 | &22,111,211,2*22,211,22,111,211,22,211,221,111,11,211,111,2*211, | |
821 | &321,130,310,221,111,211,111,130,310,321,2*311,321,311,323,313, | |
822 | &323,313,321,3*311,-13,3*211,12,14,311,2*321,311,321,313,323,313, | |
823 | &323,311,4*321,211,111,3*22,111,321,130,-213,113,213,211,22,111, | |
824 | &11,13,211,321,130,310,221,211,111,11*-11,11*-13,-311,-313,-311, | |
825 | &-313,-20313,2*-311,-313,-311,-313,2*111,2*221,2*331,2*113,2*223, | |
826 | &2*333,-311,-313,2*-321,211,-311,-321,333,-311,-313,-321,211, | |
827 | &2*-321,2*-311,-321,211,113,421,2*411,421,411,423,413,423,413,421, | |
828 | &411,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311,-313,2*-311, | |
829 | &-321,-10323,-321,-323,-321,-311,2*-313,211,111,333,3*-321,-311, | |
830 | &-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211,-321,3*-311, | |
831 | &211,113,321,2*421,411,421,413,423,413,423,411,421,-15,5*-11, | |
832 | &5*-13,221,331,333,221,331,333,10221,211,213,211,213,321,323,321, | |
833 | &323,2212,221,331,333,221,2*2,2*431,421,411,423,413,82,11,13,82, | |
834 | &443,82,6*12,6*14,2*16,3*-411,3*-413,2*-411,2*-413,2*441,2*443, | |
835 | &2*20443,2*2,2*4,2,4,511,521,511,523,513,523,513,521,511,6*12, | |
836 | &6*14,2*16,3*-421,3*-423,2*-421,2*-423,2*441,2*443,2*20443,2*2, | |
837 | &2*4,2,4,521,511,521,513,523,513,523,511,521,6*12,6*14,2*16, | |
838 | &3*-431,3*-433,2*-431,2*-433,3*441,3*443,3*20443,2*2,2*4,2,4,531/ | |
839 | DATA (KFDP(I,1),I= 993,1402)/521,511,523,513,16,2*4,2*12,2*14, | |
840 | &2*16,4*2,4*4,2*-11,2*-13,2*-1,2*-3,2*-11,2*-13,2*-1,541,511,521, | |
841 | &513,523,21,11,13,15,1,2,3,4,21,22,553,21,2112,2212,2*2112,2212, | |
842 | &2112,2*2212,2112,-12,3122,3212,3112,2212,2*2112,-12,2*3122,3222, | |
843 | &3112,2212,2112,2212,3122,3222,3212,3122,3112,-12,-14,-12,3322, | |
844 | &3312,2*3122,3212,3322,3312,3122,3322,3312,-12,2*4122,7*-11,7*-13, | |
845 | &2*2224,2*2212,2*2214,2*3122,2*3212,2*3214,5*3222,4*3224,2*3322, | |
846 | &3324,2*2224,7*2212,5*2214,2*2112,2*2114,2*3122,2*3212,2*3214, | |
847 | &2*3222,2*3224,4*2,3,2*2,1,2*2,-11,-13,2*2,4*4122,-11,-13,2*2, | |
848 | &3*4132,3*4232,-11,-13,2*2,4332,-11,-13,2*2,-11,-13,2*2,-11,-13, | |
849 | &2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,2*5122,-12, | |
850 | &-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2, | |
851 | &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,4*5122,-12,-14,-16,2*-2, | |
852 | &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,2*5132,2*5232,-12,-14,-16, | |
853 | &2*-2,2*-4,-2,-4,5332,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16, | |
854 | &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2, | |
855 | &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2, | |
856 | &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12, | |
857 | &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16, | |
858 | &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2/ | |
859 | DATA (KFDP(I,1),I=1403,1713)/2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2, | |
860 | &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12, | |
861 | &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,221,223,221, | |
862 | &223,211,111,321,130,310,213,113,-213,321,311,321,311,323,313, | |
863 | &2*311,321,311,321,313,323,321,211,111,321,130,310,2*211,313,-313, | |
864 | &323,-323,421,411,423,413,411,421,413,423,411,421,423,413,443, | |
865 | &2*82,521,511,523,513,511,521,513,523,521,511,523,513,511,521,513, | |
866 | &523,553,2*21,213,-213,113,213,10211,10111,-10211,2*221,213,2*113, | |
867 | &-213,2*321,2*311,113,323,2*313,323,313,-313,323,-323,423,2*413, | |
868 | &2*423,413,443,82,523,2*513,2*523,2*513,523,553,21,11,13,82,4*443, | |
869 | &10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553,10551,20553,555, | |
870 | &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, | |
871 | &1000002,2000002,1000002,2000002,1000021,3*-12,3*-14,3*-16,12,11, | |
872 | &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6, | |
873 | &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000001, | |
874 | &2000001,1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3, | |
875 | &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, | |
876 | &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11, | |
877 | &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6, | |
878 | &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000003/ | |
879 | DATA (KFDP(I,1),I=1714,1984)/2000003,1000003,2000003,1000021, | |
880 | &3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024,-1000037,1000022, | |
881 | &1000023,1000025,1000035,1000006,2000006,1000006,2000006,1000021, | |
882 | &3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13,14,13,16,15,16, | |
883 | &15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037,1000022,1000023, | |
884 | &1000025,1000035,1000005,2000005,1000005,2000005,1000021,1000022, | |
885 | &1000016,-1000015,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024, | |
886 | &-1000037,1000022,1000023,1000025,1000035,1000012,2000012,1000012, | |
887 | &2*12,2*14,2*16,3*-14,3*-16,3*-2,3*-4,3*-6,1000039,1000024, | |
888 | &1000037,1000022,1000023,1000025,1000035,1000011,2000011,1000011, | |
889 | &2000011,3*-13,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037, | |
890 | &1000022,1000023,1000025,1000035,1000014,2000014,1000014,2000014, | |
891 | &2*12,2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,1000024, | |
892 | &1000037,1000022,1000023,1000025,1000035,1000013,2000013,1000013, | |
893 | &2000013,3*-11,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037, | |
894 | &1000022,1000023,1000025,1000035,1000016,2000016,1000016,2000016, | |
895 | &2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,1000039,1000024, | |
896 | &1000037,1000022,1000023,1000025,1000035,1000015,2000015,1000015, | |
897 | &2000015,3*-11,3*-13,3*-1,3*-3,3*-5,1000039,1000001,-1000001, | |
898 | &2000001,-2000001,1000002,-1000002,2000002,-2000002,1000003/ | |
899 | DATA (KFDP(I,1),I=1985,2321)/-1000003,2000003,-2000003,1000004, | |
900 | &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, | |
901 | &1000006,-1000006,2000006,-2000006,6*1000022,6*1000023,6*1000025, | |
902 | &6*1000035,1000024,-1000024,1000024,-1000024,1000024,-1000024, | |
903 | &1000037,-1000037,1000037,-1000037,1000037,-1000037,-12,12,-11,11, | |
904 | &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12, | |
905 | &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13, | |
906 | &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14, | |
907 | &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15, | |
908 | &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16, | |
909 | &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2, | |
910 | &-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039,4,1,-12,12,-12,12,-12,12, | |
911 | &-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14,14,-14,14,-14,14, | |
912 | &-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12,12,-11,11,-12,12, | |
913 | &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11, | |
914 | &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13,-14,14, | |
915 | &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13, | |
916 | &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15,-16,16, | |
917 | &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15, | |
918 | &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2,-4,4,-4/ | |
919 | DATA (KFDP(I,1),I=2322,2573)/4,-4,4,-6,6,-6,6,-6,6,5*1000039, | |
920 | &16*1000022,1000024,-1000024,1000024,-1000024,1000024,-1000024, | |
921 | &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000037, | |
922 | &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037, | |
923 | &1000037,-1000037,1000037,-1000037,1000024,-1000024,1000037, | |
924 | &-1000037,1000001,-1000001,2000001,-2000001,1000002,-1000002, | |
925 | &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004, | |
926 | &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, | |
927 | &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011, | |
928 | &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013, | |
929 | &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015, | |
930 | &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016, | |
931 | &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14, | |
932 | &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16, | |
933 | &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, | |
934 | &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12, | |
935 | &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, | |
936 | &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14, | |
937 | &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, | |
938 | &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16/ | |
939 | DATA (KFDP(I,1),I=2574,2892)/16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4, | |
940 | &-4,4,-6,6,-6,6,-6,6,2*1000039,6*1000022,6*1000023,6*1000025, | |
941 | &6*1000035,1000022,1000023,1000025,1000035,1000002,2000002, | |
942 | &-1000001,-2000001,1000004,2000004,-1000003,-2000003,1000006, | |
943 | &2000006,-1000005,-2000005,1000012,2000012,-1000011,-2000011, | |
944 | &1000014,2000014,-1000013,-2000013,1000016,2000016,-1000015, | |
945 | &-2000015,2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11, | |
946 | &-12,12,-11,-12,12,-11,-14,-13,-14,-13,-14,-13,-14,14,-13,-14,14, | |
947 | &-13,-14,14,-13,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15, | |
948 | &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12, | |
949 | &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-14,2*-13,14, | |
950 | &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14, | |
951 | &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16,2*-15,16,-16,2*-15,16, | |
952 | &-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16, | |
953 | &-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1,2,-1,3*2,-1,2*4,-3, | |
954 | &3*4,-3,2*6,5*1000039,16*1000022,16*1000023,1000024,-1000024, | |
955 | &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000024, | |
956 | &-1000024,1000024,-1000024,1000037,-1000037,1000037,-1000037, | |
957 | &1000037,-1000037,1000037,-1000037,1000037,-1000037,1000037, | |
958 | &-1000037,1000024,-1000024,1000037,-1000037,1000001,-1000001/ | |
959 | DATA (KFDP(I,1),I=2893,3182)/2000001,-2000001,1000002,-1000002, | |
960 | &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004, | |
961 | &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, | |
962 | &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011, | |
963 | &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013, | |
964 | &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015, | |
965 | &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016, | |
966 | &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14, | |
967 | &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16, | |
968 | &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, | |
969 | &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12, | |
970 | &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, | |
971 | &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14, | |
972 | &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, | |
973 | &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16, | |
974 | &16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039, | |
975 | &16*1000022,16*1000023,16*1000025,1000024,-1000024,1000024, | |
976 | &-1000024,1000024,-1000024,1000024,-1000024,1000024,-1000024, | |
977 | &1000024,-1000024,1000037,-1000037,1000037,-1000037,1000037, | |
978 | &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037/ | |
979 | DATA (KFDP(I,1),I=3183,3459)/1000024,-1000024,1000037,-1000037, | |
980 | &1000001,-1000001,2000001,-2000001,1000002,-1000002,2000002, | |
981 | &-2000002,1000003,-1000003,2000003,-2000003,1000004,-1000004, | |
982 | &2000004,-2000004,1000005,-1000005,2000005,-2000005,1000006, | |
983 | &-1000006,2000006,-2000006,1000011,-1000011,2000011,-2000011, | |
984 | &1000012,-1000012,2000012,-2000012,1000013,-1000013,2000013, | |
985 | &-2000013,1000014,-1000014,2000014,-2000014,1000015,-1000015, | |
986 | &2000015,-2000015,1000016,-1000016,2000016,-2000016,5*1000021,-12, | |
987 | &12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14, | |
988 | &14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12, | |
989 | &12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, | |
990 | &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14, | |
991 | &14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, | |
992 | &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16, | |
993 | &16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, | |
994 | &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2, | |
995 | &-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,2*1000039,15*1000024, | |
996 | &6*1000022,6*1000023,6*1000025,6*1000035,1000022,1000023,1000025, | |
997 | &1000035,1000002,2000002,-1000001,-2000001,1000004,2000004, | |
998 | &-1000003,-2000003,1000006,2000006,-1000005,-2000005,1000012/ | |
999 | DATA (KFDP(I,1),I=3460,3782)/2000012,-1000011,-2000011,1000014, | |
1000 | &2000014,-1000013,-2000013,1000016,2000016,-1000015,-2000015, | |
1001 | &2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11, | |
1002 | &-12,12,-11,-14,14,-13,-14,14,-13,-14,14,-13,-14,14,-13,-14,14, | |
1003 | &-13,-14,14,-13,-16,16,-15,-16,16,-15,-16,16,-15,-16,16,-15,-16, | |
1004 | &16,-15,-16,16,-15,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12, | |
1005 | &2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12, | |
1006 | &2*-11,12,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14, | |
1007 | &2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16, | |
1008 | &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16, | |
1009 | &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1, | |
1010 | &2,-1,3*2,-1,2*4,-3,3*4,-3,2*6,1000039,-1000024,-1000037,1000022, | |
1011 | &1000023,1000025,1000035,4*1000001,1000002,2000002,1000002, | |
1012 | &2000002,1000021,3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13, | |
1013 | &14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037, | |
1014 | &1000022,1000023,1000025,1000035,4*1000002,1000001,2000001, | |
1015 | &1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039, | |
1016 | &-1000024,-1000037,1000022,1000023,1000025,1000035,4*1000003, | |
1017 | &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11, | |
1018 | &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6/ | |
1019 | DATA (KFDP(I,1),I=3783,4127)/1000039,1000024,1000037,1000022, | |
1020 | &1000023,1000025,1000035,4*1000004,1000003,2000003,1000003, | |
1021 | &2000003,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024, | |
1022 | &-1000037,1000022,1000023,1000025,1000035,4*1000005,1000006, | |
1023 | &2000006,1000006,2000006,1000021,3*-12,3*-14,3*-16,12,11,12,11,12, | |
1024 | &11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039, | |
1025 | &1000024,1000037,1000022,1000023,1000025,1000035,4*1000006, | |
1026 | &1000005,2000005,1000005,2000005,1000021,3*-11,3*-13,3*-15,2*-1, | |
1027 | &-3,1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, | |
1028 | &4*1000011,1000012,2000012,1000012,2000012,2*12,2*14,2*16,3*-14, | |
1029 | &3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037,1000022,1000023, | |
1030 | &1000025,1000035,4*1000013,1000014,2000014,1000014,2000014,2*12, | |
1031 | &2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037, | |
1032 | &1000022,1000023,1000025,1000035,4*1000015,1000016,2000016, | |
1033 | &1000016,2000016,2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,3,4,5, | |
1034 | &6,11,13,15,21,2*4,2,4,24,-11,-13,-15,3,4,5,6,11,13,15,21,5,6,21, | |
1035 | &2*24,2*3000211,2*22,2*23,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18, | |
1036 | &2*24,3*3000211,24,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,22,23,22, | |
1037 | &23,24,3000211,24,3000211,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18, | |
1038 | &1,2,3,4,5,6,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4/ | |
1039 | DATA (KFDP(I,1),I=4128,8000)/5,6,1,2,3,4,5,6,1,2,3,4,5,6,21, | |
1040 | &3100111,3200111,21,22,23,-24,21,22,23,24,22,23,-24,23,24,1,2,3,4, | |
1041 | &5,6,7,8,11,12,13,14,15,16,17,18,21,22,23,24,9*11,9*-11,2*11, | |
1042 | &2*-11,9*13,9*-13,2*13,2*-13,9*15,9*-15,2*15,2*-15,1,2,3,4,5,6,11, | |
1043 | &12,9900012,13,14,9900014,15,16,9900016,3*-1,3*-3,3*-5,-11,-13, | |
1044 | &-15,3*-11,2*-13,-15,24,3*-11,2*-13,-15,9900024,3716*0/ | |
1045 | DATA (KFDP(I,2),I= 1, 339)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4, | |
1046 | &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,5,6*1000006,3*7, | |
1047 | &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, | |
1048 | &13,11,13,-211,-213,-211,-213,-211,-213,-211,-213,2*-211,-321, | |
1049 | &-323,-321,2*-323,3*-321,4*-211,-213,-211,-213,-211,-213,-211, | |
1050 | &-213,-211,-213,3*-211,-213,4*-211,-323,-321,2*-211,2*-321,3*-211, | |
1051 | &2*15,16,15,16,15,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21, | |
1052 | &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8, | |
1053 | &-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8, | |
1054 | &12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23, | |
1055 | &-24,2*1000022,1000023,1000022,1000023,1000025,1000022,1000023, | |
1056 | &1000025,1000035,-1000024,-1000037,-1000024,-1000037,-1000001, | |
1057 | &2*-2000001,2000001,-1000002,2*-2000002,2000002,-1000003, | |
1058 | &2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005, | |
1059 | &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011, | |
1060 | &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013, | |
1061 | &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015, | |
1062 | &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6, | |
1063 | &-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,-37,22,25,2*36,2,4,6,8, | |
1064 | &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/ | |
1065 | DATA (KFDP(I,2),I= 340, 533)/-7,-8,-11,-13,-15,-17,21,22,2*23, | |
1066 | &-24,2*25,-37,-24,3*36,2*1000022,1000023,1000022,1000023,1000025, | |
1067 | &1000022,1000023,1000025,1000035,-1000024,-1000037,-1000024, | |
1068 | &-1000037,-1000001,2*-2000001,2000001,-1000002,2*-2000002,2000002, | |
1069 | &-1000003,2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005, | |
1070 | &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011, | |
1071 | &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013, | |
1072 | &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015, | |
1073 | &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6, | |
1074 | &-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25,-37,-24,2*1000022, | |
1075 | &1000023,1000022,1000023,1000025,1000022,1000023,1000025,1000035, | |
1076 | &-1000024,-1000037,-1000024,-1000037,-1000001,2*-2000001,2000001, | |
1077 | &-1000002,2*-2000002,2000002,-1000003,2*-2000003,2000003,-1000004, | |
1078 | &2*-2000004,2000004,-1000005,2*-2000005,2000005,-1000006, | |
1079 | &2*-2000006,2000006,-1000011,2*-2000011,2000011,-1000012, | |
1080 | &2*-2000012,2000012,-1000013,2*-2000013,2000013,-1000014, | |
1081 | &2*-2000014,2000014,-1000015,2*-2000015,2000015,-1000016, | |
1082 | &2*-2000016,2000016,2,4,6,8,12,14,16,18,25,1000024,1000037, | |
1083 | &1000024,1000037,1000024,1000037,1000024,1000037,2*-1000005, | |
1084 | &2*-2000005,1000002,1000004,1000012,1000014,2*1000016,-3,-4,-5,-6/ | |
1085 | DATA (KFDP(I,2),I= 534, 938)/-7,-8,-13,-15,-17,11,-82,12,14,-1, | |
1086 | &-3,11,13,15,1,4,3,4,1,3,22,11,-211,2*22,-13,-11,-211,211,111,211, | |
1087 | &-321,130,310,22,2*111,-211,11,-11,13,-13,-211,111,22,14,12,111, | |
1088 | &22,111,3*211,-311,22,211,22,111,-211,211,11,-211,13,22,-211,111, | |
1089 | &-211,22,111,-11,-211,111,2*-211,-321,130,310,221,111,-211,111, | |
1090 | &2*0,-211,111,22,-211,111,-211,111,-211,211,-213,113,223,221,14, | |
1091 | &111,211,111,-11,-13,211,111,22,211,111,211,111,2*211,213,113,223, | |
1092 | &221,22,-211,111,113,223,22,111,-321,310,211,111,2*-211,221,22, | |
1093 | &-11,-13,-211,-321,130,310,221,-211,111,11*12,11*14,2*211,2*213, | |
1094 | &211,20213,2*321,2*323,211,213,211,213,211,213,211,213,211,213, | |
1095 | &211,213,3*211,213,211,2*321,8*211,2*113,3*211,111,22,211,111,211, | |
1096 | &111,4*211,8*12,8*14,2*211,2*213,2*111,221,2*113,223,333,20213, | |
1097 | &211,2*321,323,2*311,313,-211,111,113,2*211,321,2*211,311,321,310, | |
1098 | &211,-211,4*211,321,4*211,113,2*211,-321,111,22,-211,111,-211,111, | |
1099 | &-211,211,-211,211,16,5*12,5*14,3*211,3*213,211,2*111,2*113, | |
1100 | &2*-311,2*-313,-2112,3*321,323,2*-1,22,111,321,311,321,311,-82, | |
1101 | &-11,-13,-82,22,-82,6*-11,6*-13,2*-15,211,213,20213,211,213,20213, | |
1102 | &431,433,431,433,311,313,311,313,311,313,-1,-4,-3,-4,-1,-3,22, | |
1103 | &-211,111,-211,111,-211,211,-211,211,6*-11,6*-13,2*-15,211,213, | |
1104 | &20213,211,213,20213,431,433,431,433,321,323,321,323,321,323,-1/ | |
1105 | DATA (KFDP(I,2),I= 939,1352)/-4,-3,-4,-1,-3,22,211,111,211,111, | |
1106 | &4*211,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,431,433,431, | |
1107 | &433,221,331,333,221,331,333,221,331,333,-1,-4,-3,-4,-1,-3,22, | |
1108 | &-321,-311,-321,-311,-15,-3,-1,2*-11,2*-13,2*-15,-1,-4,-3,-4,-3, | |
1109 | &-4,-1,-4,2*12,2*14,2,3,2,3,2*12,2*14,2,1,22,411,421,411,421,21, | |
1110 | &-11,-13,-15,-1,-2,-3,-4,2*21,22,21,2*-211,111,22,111,211,22,211, | |
1111 | &-211,11,2*-211,111,-211,111,22,11,22,111,-211,211,111,211,22,211, | |
1112 | &111,211,-211,22,11,13,11,-211,2*111,2*22,111,211,-321,-211,111, | |
1113 | &11,2*-211,7*12,7*14,-321,-323,-311,-313,-311,-313,211,213,211, | |
1114 | &213,211,213,111,221,331,113,223,111,221,113,223,321,323,321,-211, | |
1115 | &-213,111,221,331,113,223,333,10221,111,221,331,113,223,211,213, | |
1116 | &211,213,321,323,321,323,321,323,311,313,311,313,2*-1,-3,-1,2203, | |
1117 | &3201,3203,2203,2101,2103,12,14,-1,-3,2*111,2*211,12,14,-1,-3,22, | |
1118 | &111,2*22,111,22,12,14,-1,-3,22,12,14,-1,-3,12,14,-1,-3,12,14,-1, | |
1119 | &-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,2*-211,11,13, | |
1120 | &15,-211,-213,-20213,-431,-433,3*3122,1,4,3,4,1,3,11,13,15,1,4,3, | |
1121 | &4,1,3,11,13,15,1,4,3,4,1,3,2*111,2*211,11,13,15,1,4,3,4,1,3,11, | |
1122 | &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, | |
1123 | &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, | |
1124 | &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/ | |
1125 | DATA (KFDP(I,2),I=1353,1815)/11,13,15,1,4,3,4,1,3,11,13,15,1,4,3, | |
1126 | &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, | |
1127 | &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, | |
1128 | &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, | |
1129 | &2*111,2*211,-211,111,-321,130,310,-211,111,211,-211,111,-213,113, | |
1130 | &-211,111,223,211,111,213,113,211,111,223,-211,111,-321,130,310, | |
1131 | &2*-211,-311,311,-321,321,211,111,211,111,-211,111,-211,111,311, | |
1132 | &2*321,311,22,2*-82,-211,111,-211,111,211,111,211,111,-321,-311, | |
1133 | &-321,-311,411,421,411,421,22,2*21,-211,2*211,111,-211,111,2*211, | |
1134 | &111,-211,211,111,211,-321,2*-311,-321,22,-211,111,211,111,-311, | |
1135 | &311,-321,321,211,111,-211,111,321,311,22,-82,-211,111,211,111, | |
1136 | &-321,-311,411,421,22,21,-11,-13,-82,211,111,221,111,4*22,-11,-13, | |
1137 | &-15,-1,-2,-3,-4,2*21,211,111,3*22,1,2*2,4*1,2*-24,2*-37,2*1,3,5, | |
1138 | &1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3, | |
1139 | &-5,2,2*1,4*2,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3, | |
1140 | &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4, | |
1141 | &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,2*24,2*37,4,1,3,5,1,3,5,1,3,5,-3, | |
1142 | &2*-5,5,2*6,4*5,2*-24,2*-37,5,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3, | |
1143 | &4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6,2*5,4*6,2*24,2*37,6,4,-15, | |
1144 | &16,1,3,5,1,3,5,1,3,5,-3,2*-5,11,2*12,4*11,2*-24,-37,13,15,11,15/ | |
1145 | DATA (KFDP(I,2),I=1816,2317)/11,13,11,13,15,11,13,15,1,3,5,1,3,5, | |
1146 | &1,3,5,12,2*11,4*12,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5, | |
1147 | &13,2*14,4*13,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3, | |
1148 | &5,1,3,5,1,3,5,14,2*13,4*14,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3, | |
1149 | &5,1,3,5,15,2*16,4*15,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11, | |
1150 | &13,15,1,3,5,1,3,5,1,3,5,16,2*15,4*16,2*24,2*37,11,13,15,11,13,15, | |
1151 | &1,3,5,1,3,5,1,3,5,21,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5, | |
1152 | &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, | |
1153 | &1,-1,3,-3,5,-5,1,-1,3,-3,5,-5,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3, | |
1154 | &-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2, | |
1155 | &-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5, | |
1156 | &-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4, | |
1157 | &-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1, | |
1158 | &-3,3,-1,1,-1,1,-3,3,22,23,25,35,36,-1,-3,-13,13,-13,13,-13,13, | |
1159 | &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15, | |
1160 | &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1, | |
1161 | &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6, | |
1162 | &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5, | |
1163 | &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4, | |
1164 | &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3/ | |
1165 | DATA (KFDP(I,2),I=2318,2770)/3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22, | |
1166 | &23,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,-24,24,11, | |
1167 | &-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15,-15,1,-1,3, | |
1168 | &-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5,5,-5, | |
1169 | &5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13,13,-14,14,-14, | |
1170 | &14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13, | |
1171 | &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15, | |
1172 | &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1, | |
1173 | &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6, | |
1174 | &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5, | |
1175 | &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4, | |
1176 | &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3, | |
1177 | &3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,24,37,24,-11,-13,-15,-1,-3,24, | |
1178 | &-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,4*37, | |
1179 | &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, | |
1180 | &-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15,16,2*-15,16,-15, | |
1181 | &6*-11,-15,16,2*-15,16,2*-15,16,-15,6*-11,6*-13,-1,-2,-1,2,-1,-2, | |
1182 | &-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5, | |
1183 | &-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4, | |
1184 | &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1/ | |
1185 | DATA (KFDP(I,2),I=2771,3221)/2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4, | |
1186 | &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1, | |
1187 | &2*4,-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,22,23,25,35,36,22,23,11,13, | |
1188 | &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, | |
1189 | &25,35,36,-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13, | |
1190 | &-13,15,-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3, | |
1191 | &-4,4,-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13, | |
1192 | &-13,13,-14,14,-14,14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13, | |
1193 | &13,-13,13,-13,13,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15, | |
1194 | &15,-15,15,-15,15,-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1, | |
1195 | &-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6, | |
1196 | &-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3, | |
1197 | &-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2, | |
1198 | &-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5, | |
1199 | &-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22,23,25,35,36, | |
1200 | &22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14, | |
1201 | &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, | |
1202 | &-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15, | |
1203 | &-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4, | |
1204 | &-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13/ | |
1205 | DATA (KFDP(I,2),I=3222,3669)/13,-14,14,-14,14,-15,15,-15,15,-16, | |
1206 | &16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13,-15,15,-15,15,-15,15, | |
1207 | &-11,11,-11,11,-11,11,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11, | |
1208 | &-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3, | |
1209 | &3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2, | |
1210 | &2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5, | |
1211 | &5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4, | |
1212 | &4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1, | |
1213 | &1,-1,1,-3,3,24,37,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,24,-11, | |
1214 | &-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11, | |
1215 | &-13,-15,-1,-3,4*37,2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13, | |
1216 | &2*14,2*-15,2*16,-1,-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15, | |
1217 | &16,2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-15,16,2*-15,16, | |
1218 | &2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-13,14,2*-13,14,2*-13, | |
1219 | &14,-13,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3, | |
1220 | &-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2, | |
1221 | &-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5, | |
1222 | &6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4, | |
1223 | &-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1,2*4, | |
1224 | &-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,1,2*2,4*1,23,25,35,36,2*-24/ | |
1225 | DATA (KFDP(I,2),I=3670,4136)/2*-37,2*1,3,5,1,3,5,1,3,5,1,2,3,4,5, | |
1226 | &6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3,-5,2,2*1,4*2,23,25,35, | |
1227 | &36,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3,23,25,35,36, | |
1228 | &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4, | |
1229 | &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,23,25,35,36,2*24,2*37,4,1,3,5,1, | |
1230 | &3,5,1,3,5,-3,2*-5,5,2*6,4*5,23,25,35,36,2*-24,2*-37,5,1,3,5,1,3, | |
1231 | &5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6, | |
1232 | &2*5,4*6,23,25,35,36,2*24,2*37,6,1,3,5,1,3,5,1,3,5,-3,2*-5,11, | |
1233 | &2*12,4*11,23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11, | |
1234 | &13,15,1,3,5,1,3,5,1,3,5,13,2*14,4*13,23,25,35,36,2*-24,2*-37,13, | |
1235 | &15,11,15,11,13,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5,15,2*16,4*15, | |
1236 | &23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3, | |
1237 | &5,1,3,5,1,3,5,-3,-4,-5,-6,-11,-13,-15,21,-1,-3,2*-5,5,12,14,16, | |
1238 | &-3,-4,-5,-6,-11,-13,-15,21,-5,-6,21,-24,-3000211,-24,-3000211, | |
1239 | &3000111,3000221,3000111,3000221,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12, | |
1240 | &-13,-14,-15,-16,-17,-18,23,3000111,23,3000111,22,3000221,2,4,6,8, | |
1241 | &2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,2*3000111,2*3000221,-3000211, | |
1242 | &2*-24,-3000211,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16, | |
1243 | &-17,-18,-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6,21,-1,-2,-3,-4,-5,-6, | |
1244 | &21,-1,-2,-3,-4,-5,-6,21,-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6,-1/ | |
1245 | DATA (KFDP(I,2),I=4137,8000)/-2,-3,-4,-5,-6,3*21,3*1,4*2,1,2*11, | |
1246 | &2*12,11,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18, | |
1247 | &21,22,23,-24,3*-1,3*-3,3*-5,3*1,3*3,3*5,2*-13,2*15,3*-1,3*-3, | |
1248 | &3*-5,3*1,3*3,3*5,2*-11,2*15,3*-1,3*-3,3*-5,3*1,3*3,3*5,2*-11, | |
1249 | &2*13,-1,-2,-3,-4,-5,-6,-11,-12,9900012,-13,-14,9900014,-15,-16, | |
1250 | &9900016,2,4,6,2,4,6,2,4,6,9900012,9900014,9900016,-11,-13,-15, | |
1251 | &-13,2*-15,24,-11,-13,-15,-13,2*-15,9900024,3716*0/ | |
1252 | DATA (KFDP(I,3),I= 1,1021)/81*0,14,6*0,2*16,2*0,6*111,310,130, | |
1253 | &2*0,3*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221, | |
1254 | &2*113,221,2*113,2*213,-213,113,2*111,310,130,310,130,2*310,130, | |
1255 | &402*0,4*3,4*4,1,4,3,2*2,0,-11,8*0,-211,5*0,2*111,211,-211,211, | |
1256 | &-211,10*0,111,4*0,2*111,-211,-11,11,-13,22,111,3*0,22,3*0,111, | |
1257 | &211,4*0,111,11*0,111,-211,6*0,-211,3*111,7*0,111,-211,5*0,2*221, | |
1258 | &3*0,111,5*0,111,11*0,-311,-313,-311,-321,-313,-323,111,221,331, | |
1259 | &113,223,-311,-313,-311,-321,-313,-323,111,221,331,113,223,22*0, | |
1260 | &111,113,2*211,-211,-311,211,111,3*211,-211,7*211,7*0,111,-211, | |
1261 | &111,-211,-321,-323,-311,-321,-313,-323,-211,-213,-321,-323,-311, | |
1262 | &-321,-313,-323,-211,-213,22*0,111,113,-311,2*-211,211,-211,310, | |
1263 | &-211,2*111,211,2*-211,-321,-211,2*211,-211,111,-211,2*211,6*0, | |
1264 | &111,-211,111,-211,0,221,331,333,321,311,221,331,333,321,311,20*0, | |
1265 | &3,13*0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413, | |
1266 | &-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211, | |
1267 | &111,-211,-421,-423,-10423,-10421,-20423,-425,-421,-423,-10423, | |
1268 | &-10421,-20423,-425,-421,-423,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211, | |
1269 | &111,-211,-431,-433,-10433,-10431,-20433,-435,-431,-433,-10433, | |
1270 | &-10431,-20433,-435,-431,-433,19*0,-4,-1,-4,-3,2*-2,8*0,441,443, | |
1271 | &441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531,533,531,533,3,2,3,2/ | |
1272 | DATA (KFDP(I,3),I=1022,2223)/511,513,511,513,1,2,13*0,2*21,11*0, | |
1273 | &2112,6*0,2212,12*0,2*3122,3212,10*0,3322,2*0,3122,3212,3214,2112, | |
1274 | &2114,2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,6*0, | |
1275 | &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, | |
1276 | &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, | |
1277 | &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, | |
1278 | &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, | |
1279 | &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, | |
1280 | &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, | |
1281 | &3,2*2,31*0,211,111,45*0,-211,2*111,-211,3*111,-211,111,211,30*0, | |
1282 | &-211,111,13*0,2*21,-211,111,199*0,2*5,210*0,-1,-3,-5,-2,-4,-6,-1, | |
1283 | &-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-2,2,-4,4,-6, | |
1284 | &6,-2,2,-4,4,-6,6,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3, | |
1285 | &-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, | |
1286 | &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, | |
1287 | &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, | |
1288 | &-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,-3,3, | |
1289 | &-5,5,-5,5,5*0,11,12,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11, | |
1290 | &-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11, | |
1291 | &-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/ | |
1292 | DATA (KFDP(I,3),I=2224,2783)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, | |
1293 | &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, | |
1294 | &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, | |
1295 | &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3, | |
1296 | &-5,5,-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14, | |
1297 | &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12, | |
1298 | &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15, | |
1299 | &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, | |
1300 | &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5, | |
1301 | &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, | |
1302 | &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, | |
1303 | &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, | |
1304 | &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5, | |
1305 | &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,3*0,12,14,16,2,4,0,12,14,16,2, | |
1306 | &4,0,12,14,16,2,4,0,12,14,16,2,4,28*0,2,4,12,-11,11,14,-13,13,16, | |
1307 | &-15,15,12,-11,11,14,-13,13,16,-15,15,12,11,14,13,16,15,12,-11,11, | |
1308 | &14,-13,13,16,-15,15,12,11,14,13,16,15,12,11,14,13,16,15,2*2,1,-1, | |
1309 | &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, | |
1310 | &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5, | |
1311 | &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1/ | |
1312 | DATA (KFDP(I,3),I=2784,3354)/2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, | |
1313 | &2*6,5,-5,3,-3,5,-5,1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,7*0, | |
1314 | &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14, | |
1315 | &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12, | |
1316 | &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15, | |
1317 | &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, | |
1318 | &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5, | |
1319 | &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, | |
1320 | &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, | |
1321 | &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, | |
1322 | &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5, | |
1323 | &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14,-16, | |
1324 | &-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0, | |
1325 | &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16, | |
1326 | &-2,2,-4,4,2*0,-12,12,-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4, | |
1327 | &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, | |
1328 | &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1, | |
1329 | &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, | |
1330 | &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3, | |
1331 | &-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/ | |
1332 | DATA (KFDP(I,3),I=3355,8000)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, | |
1333 | &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5, | |
1334 | &-5,5,-3,3,-5,5,-5,5,3*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4, | |
1335 | &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, | |
1336 | &28*0,2,4,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16, | |
1337 | &-15,15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15, | |
1338 | &15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15,15, | |
1339 | &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1, | |
1340 | &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, | |
1341 | &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5, | |
1342 | &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,3,-3,5,-5, | |
1343 | &1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,351*0,-5,169*0,2,4,6,2, | |
1344 | &4,6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900014,2*9900016,2,4,6,2, | |
1345 | &4,6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900016,2,4,6,2, | |
1346 | &4,6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900014,3757*0/ | |
1347 | DATA (KFDP(I,4),I= 1,8000)/94*0,4*111,6*0,111,2*0,-211,0,-211, | |
1348 | &3*0,111,2*-211,0,111,0,2*111,113,221,2*111,-213,-211,211,113, | |
1349 | &6*111,310,2*130,402*0,13*81,41*0,-11,10*0,111,-211,4*0,111,62*0, | |
1350 | &111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111, | |
1351 | &-211,2*211,2*-211,13*0,-211,111,-211,111,4*0,-211,111,-211,111, | |
1352 | &34*0,111,-211,3*111,3*-211,2*111,3*-211,14*0,-321,-311,3*0,-321, | |
1353 | &-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, | |
1354 | &2*-5,67*0,-211,111,5*0,-211,111,52*0,2101,2103,2*2101,6*0,4*81, | |
1355 | &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, | |
1356 | &162*81,31*0,-211,111,6516*0/ | |
1357 | DATA (KFDP(I,5),I= 1,8000)/96*0,2*111,17*0,111,7*0,2*111,0, | |
1358 | &3*111,0,111,597*0,-211,2*111,-211,111,-211,111,65*0,111,-211, | |
1359 | &3*111,-211,111,7193*0/ | |
1360 | ||
1361 | C...PYDAT4, with particle names (character strings). | |
1362 | DATA (CHAF(I,1),I= 1, 100)/'d','u','s','c','b','t','b''','t''', | |
1363 | &2*' ','e-','nu_e','mu-','nu_mu','tau-','nu_tau','tau''-', | |
1364 | &'nu''_tau',2*' ','g','gamma','Z0','W+','h0',6*' ','Z''0','Z"0', | |
1365 | &'W''+','H0','A0','H+',' ','Graviton',' ','R0','LQ_ue',38*' ', | |
1366 | &'specflav','rndmflav','phasespa','c-hadron','b-hadron',2*' ', | |
1367 | &'junction',' ','system','cluster','string','indep.','CMshower', | |
1368 | &'SPHEaxis','THRUaxis','CLUSjet','CELLjet','table',' '/ | |
1369 | DATA (CHAF(I,1),I= 101, 202)/'reggeon','pi0', | |
1370 | &'rho0','a_20','K_L0','pi+','rho+','a_2+','eta','omega','f_2', | |
1371 | &'K_S0','K0','K*0','K*_20','K+','K*+','K*_2+','eta''','phi', | |
1372 | &'f''_2','D+','D*+','D*_2+','D0','D*0','D*_20','D_s+','D*_s+', | |
1373 | &'D*_2s+','eta_c','J/psi','chi_2c','B0','B*0','B*_20','B+','B*+', | |
1374 | &'B*_2+','B_s0','B*_s0','B*_2s0','B_c+','B*_c+','B*_2c+','eta_b', | |
1375 | &'Upsilon','chi_2b','pomeron','dd_1','Delta-','ud_0','ud_1','n0', | |
1376 | &'Delta0','uu_1','p+','Delta+','Delta++','sd_0','sd_1','Sigma-', | |
1377 | &'Sigma*-','Lambda0','su_0','su_1','Sigma0','Sigma*0','Sigma+', | |
1378 | &'Sigma*+','ss_1','Xi-','Xi*-','Xi0','Xi*0','Omega-','cd_0', | |
1379 | &'cd_1','Sigma_c0','Sigma*_c0','Lambda_c+','Xi_c0','cu_0','cu_1', | |
1380 | &'Sigma_c+','Sigma*_c+','Sigma_c++','Sigma*_c++','Xi_c+','cs_0', | |
1381 | &'cs_1','Xi''_c0','Xi*_c0','Xi''_c+','Xi*_c+','Omega_c0', | |
1382 | &'Omega*_c0','cc_1','Xi_cc+','Xi*_cc+','Xi_cc++','Xi*_cc++'/ | |
1383 | DATA (CHAF(I,1),I= 203, 332)/'Omega_cc+','Omega*_cc+', | |
1384 | &'Omega*_ccc++','bd_0','bd_1','Sigma_b-','Sigma*_b-','Lambda_b0', | |
1385 | &'Xi_b-','Xi_bc0','bu_0','bu_1','Sigma_b0','Sigma*_b0','Sigma_b+', | |
1386 | &'Sigma*_b+','Xi_b0','Xi_bc+','bs_0','bs_1','Xi''_b-','Xi*_b-', | |
1387 | &'Xi''_b0','Xi*_b0','Omega_b-','Omega*_b-','Omega_bc0','bc_0', | |
1388 | &'bc_1','Xi''_bc0','Xi*_bc0','Xi''_bc+','Xi*_bc+','Omega''_bc0', | |
1389 | &'Omega*_bc0','Omega_bcc+','Omega*_bcc+','bb_1','Xi_bb-', | |
1390 | &'Xi*_bb-','Xi_bb0','Xi*_bb0','Omega_bb-','Omega*_bb-', | |
1391 | &'Omega_bbc0','Omega*_bbc0','Omega*_bbb-','a_00','b_10','a_0+', | |
1392 | &'b_1+','f_0','h_1','K*_00','K_10','K*_0+','K_1+','f''_0','h''_1', | |
1393 | &'D*_0+','D_1+','D*_00','D_10','D*_0s+','D_1s+','chi_0c','h_1c', | |
1394 | &'B*_00','B_10','B*_0+','B_1+','B*_0s0','B_1s0','B*_0c+','B_1c+', | |
1395 | &'chi_0b','h_1b','a_10','a_1+','f_1','K*_10','K*_1+','f''_1', | |
1396 | &'D*_1+','D*_10','D*_1s+','chi_1c','B*_10','B*_1+','B*_1s0', | |
1397 | &'B*_1c+','chi_1b','psi''','Upsilon''','~d_L','~u_L','~s_L', | |
1398 | &'~c_L','~b_1','~t_1','~e_L-','~nu_eL','~mu_L-','~nu_muL', | |
1399 | &'~tau_1-','~nu_tauL','~g','~chi_10','~chi_20','~chi_1+', | |
1400 | &'~chi_30','~chi_40','~chi_2+','~Gravitino','~d_R','~u_R','~s_R', | |
1401 | &'~c_R','~b_2','~t_2','~e_R-','~nu_eR','~mu_R-','~nu_muR', | |
1402 | &'~tau_2-','~nu_tauR','pi_tc0','pi_tc+','pi''_tc0','eta_tc0'/ | |
1403 | DATA (CHAF(I,1),I= 333, 500)/'rho_tc0','rho_tc+','omega_tc', | |
1404 | &'V8_tc','pi_22_1_tc','pi_22_8_tc','rho_11_tc','rho_12_tc', | |
1405 | &'rho_21_tc','rho_22_tc','d*','u*','e*-','nu*_e0','Graviton*', | |
1406 | &'nu_Re','nu_Rmu','nu_Rtau','Z_R0','W_R+','H_L++','H_R++', | |
1407 | &'rho_diff0','pi_diffr+','omega_di','phi_diff','J/psi_di', | |
1408 | &'n_diffr0','p_diffr+',139*' '/ | |
1409 | DATA (CHAF(I,2),I= 1, 205)/'dbar','ubar','sbar','cbar','bbar', | |
1410 | &'tbar','b''bar','t''bar',2*' ','e+','nu_ebar','mu+','nu_mubar', | |
1411 | &'tau+','nu_taubar','tau''+','nu''_taubar',5*' ','W-',9*' ', | |
1412 | &'W''-',2*' ','H-',3*' ','Rbar0','LQ_uebar',39*' ','rndmflavbar', | |
1413 | &' ','c-hadronbar','b-hadronbar',20*' ','pi-','rho-','a_2-',4*' ', | |
1414 | &'Kbar0','K*bar0','K*_2bar0','K-','K*-','K*_2-',3*' ','D-','D*-', | |
1415 | &'D*_2-','Dbar0','D*bar0','D*_2bar0','D_s-','D*_s-','D*_2s-', | |
1416 | &3*' ','Bbar0','B*bar0','B*_2bar0','B-','B*-','B*_2-','B_sbar0', | |
1417 | &'B*_sbar0','B*_2sbar0','B_c-','B*_c-','B*_2c-',4*' ','dd_1bar', | |
1418 | &'Deltabar+','ud_0bar','ud_1bar','nbar0','Deltabar0','uu_1bar', | |
1419 | &'pbar-','Deltabar-','Deltabar--','sd_0bar','sd_1bar','Sigmabar+', | |
1420 | &'Sigma*bar+','Lambdabar0','su_0bar','su_1bar','Sigmabar0', | |
1421 | &'Sigma*bar0','Sigmabar-','Sigma*bar-','ss_1bar','Xibar+', | |
1422 | &'Xi*bar+','Xibar0','Xi*bar0','Omegabar+','cd_0bar','cd_1bar', | |
1423 | &'Sigma_cbar0','Sigma*_cbar0','Lambda_cbar-','Xi_cbar0','cu_0bar', | |
1424 | &'cu_1bar','Sigma_cbar-','Sigma*_cbar-','Sigma_cbar--', | |
1425 | &'Sigma*_cbar--','Xi_cbar-','cs_0bar','cs_1bar','Xi''_cbar0', | |
1426 | &'Xi*_cbar0','Xi''_cbar-','Xi*_cbar-','Omega_cbar0', | |
1427 | &'Omega*_cbar0','cc_1bar','Xi_ccbar-','Xi*_ccbar-','Xi_ccbar--', | |
1428 | &'Xi*_ccbar--','Omega_ccbar-','Omega*_ccbar-','Omega*_cccbar-'/ | |
1429 | DATA (CHAF(I,2),I= 206, 325)/'bd_0bar','bd_1bar','Sigma_bbar+', | |
1430 | &'Sigma*_bbar+','Lambda_bbar0','Xi_bbar+','Xi_bcbar0','bu_0bar', | |
1431 | &'bu_1bar','Sigma_bbar0','Sigma*_bbar0','Sigma_bbar-', | |
1432 | &'Sigma*_bbar-','Xi_bbar0','Xi_bcbar-','bs_0bar','bs_1bar', | |
1433 | &'Xi''_bbar+','Xi*_bbar+','Xi''_bbar0','Xi*_bbar0','Omega_bbar+', | |
1434 | &'Omega*_bbar+','Omega_bcbar0','bc_0bar','bc_1bar','Xi''_bcbar0', | |
1435 | &'Xi*_bcbar0','Xi''_bcbar-','Xi*_bcbar-','Omega''_bcba', | |
1436 | &'Omega*_bcbar0','Omega_bccbar-','Omega*_bccbar-','bb_1bar', | |
1437 | &'Xi_bbbar+','Xi*_bbbar+','Xi_bbbar0','Xi*_bbbar0','Omega_bbbar+', | |
1438 | &'Omega*_bbbar+','Omega_bbcbar0','Omega*_bbcbar0', | |
1439 | &'Omega*_bbbbar+',2*' ','a_0-','b_1-',2*' ','K*_0bar0','K_1bar0', | |
1440 | &'K*_0-','K_1-',2*' ','D*_0-','D_1-','D*_0bar0','D_1bar0', | |
1441 | &'D*_0s-','D_1s-',2*' ','B*_0bar0','B_1bar0','B*_0-','B_1-', | |
1442 | &'B*_0sbar0','B_1sbar0','B*_0c-','B_1c-',3*' ','a_1-',' ', | |
1443 | &'K*_1bar0','K*_1-',' ','D*_1-','D*_1bar0','D*_1s-',' ', | |
1444 | &'B*_1bar0','B*_1-','B*_1sbar0','B*_1c-',3*' ','~d_Lbar', | |
1445 | &'~u_Lbar','~s_Lbar','~c_Lbar','~b_1bar','~t_1bar','~e_L+', | |
1446 | &'~nu_eLbar','~mu_L+','~nu_muLbar','~tau_1+','~nu_tauLbar',3*' ', | |
1447 | &'~chi_1-',2*' ','~chi_2-',' ','~d_Rbar','~u_Rbar','~s_Rbar', | |
1448 | &'~c_Rbar','~b_2bar','~t_2bar','~e_R+','~nu_eRbar','~mu_R+'/ | |
1449 | DATA (CHAF(I,2),I= 326, 500)/'~nu_muRbar','~tau_2+', | |
1450 | &'~nu_tauRbar',' ','pi_tc-',3*' ','rho_tc-',8*' ','d*bar','u*bar', | |
1451 | &'e*bar+','nu*_ebar0',5*' ','W_R-','H_L--','H_R--',' ', | |
1452 | &'pi_diffr-',3*' ','n_diffrbar0','p_diffrbar-',139*' '/ | |
1453 | ||
1454 | C...PYDATR, with initial values for the random number generator. | |
1455 | DATA MRPY/19780503,0,0,97,33,0/ | |
1456 | ||
1457 | C...Default values for allowed processes and kinematics constraints. | |
1458 | DATA MSEL/1/ | |
1459 | DATA MSUB/500*0/ | |
1460 | DATA ((KFIN(I,J),J=-40,40),I=1,2)/16*0,4*1,4*0,6*1,5*0,5*1,0, | |
1461 | &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, | |
1462 | &6*1,4*0,4*1,16*0/ | |
1463 | DATA CKIN/ | |
1464 | & 2.0D0, -1.0D0, 0.0D0, -1.0D0, 1.0D0, | |
1465 | & 1.0D0, -10D0, 10D0, -40D0, 40D0, | |
1466 | 1 -40D0, 40D0, -40D0, 40D0, -40D0, | |
1467 | 1 40D0, -1.0D0, 1.0D0, -1.0D0, 1.0D0, | |
1468 | 2 0.0D0, 1.0D0, 0.0D0, 1.0D0, -1.0D0, | |
1469 | 2 1.0D0, -1.0D0, 1.0D0, 0D0, 0D0, | |
1470 | 3 2.0D0, -1.0D0, 0D0, 0D0, 0.0D0, | |
1471 | 3 -1.0D0, 0.0D0, -1.0D0, 4.0D0, -1.0D0, | |
1472 | 4 12.0D0, -1.0D0, 12.0D0, -1.0D0, 12.0D0, | |
1473 | 4 -1.0D0, 12.0D0, -1.0D0, 0D0, 0D0, | |
1474 | 5 0.0D0, -1.0D0, 0.0D0, -1.0D0, 0.0D0, | |
1475 | 5 -1.0D0, 0D0, 0D0, 0D0, 0D0, | |
1476 | 6 0.0001D0, 0.99D0, 0.0001D0, 0.99D0, 0D0, | |
1477 | 6 -1D0, 0D0, -1D0, 0D0, -1D0, | |
1478 | 7 0D0, -1D0, 0.0001D0, 0.99D0, 0.0001D0, | |
1479 | 7 0.99D0, 2D0, -1D0, 0D0, 0D0, | |
1480 | 8 120*0D0/ | |
1481 | ||
1482 | C...Default values for main switches and parameters. Reset information. | |
1483 | DATA (MSTP(I),I=1,100)/ | |
1484 | & 3, 1, 2, 0, 0, 0, 0, 0, 0, 0, | |
1485 | 1 1, 0, 1, 30, 0, 1, 4, 3, 4, 3, | |
1486 | 2 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, | |
1487 | 3 1, 8, 0, 1, 0, 2, 1, 5, 2, 0, | |
1488 | 4 2, 1, 3, 7, 3, 1, 1, 0, 1, 0, | |
1489 | 5 7, 1, 3, 1, 5, 1, 1, 5, 1, 7, | |
1490 | 6 2, 3, 2, 2, 1, 5, 2, 1, 0, 0, | |
1491 | 7 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1492 | 8 1, 1, 100, 0, 0, 2, 0, 0, 0, 0, | |
1493 | 9 1, 3, 1, 3, 0, 0, 0, 0, 0, 0/ | |
1494 | DATA (MSTP(I),I=101,200)/ | |
1495 | & 3, 1, 0, 0, 0, 0, 0, 0, 0, 0, | |
1496 | 1 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, | |
1497 | 2 0, 1, 2, 1, 1, 100, 0, 0, 10, 0, | |
1498 | 3 0, 4, 0, 1, 0, 0, 0, 0, 0, 0, | |
1499 | 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1500 | 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1501 | 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1502 | 7 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, | |
1503 | 8 6, 214, 2003, 01, 22, 0, 0, 0, 0, 0, | |
1504 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
1505 | DATA (PARP(I),I=1,100)/ | |
1506 | & 0.25D0, 10D0, 8*0D0, | |
1507 | 1 0D0, 0D0, 1.0D0, 0.01D0, 0.5D0, 1.0D0, 1.0D0, 0.4D0, 2*0D0, | |
1508 | 2 10*0D0, | |
1509 | 3 1.5D0,2.0D0,0.075D0,1.0D0,0.2D0,0D0,1.0D0,0.70D0,0.006D0,0D0, | |
1510 | 4 0.02D0,2.0D0,0.10D0,1000D0,2054D0,123D0,246D0,50D0,0D0,0.054D0, | |
1511 | 5 10*0D0, | |
1512 | 6 0.25D0, 1.0D0,0.25D0, 1.0D0, 2.0D0,1D-3, 1.0D0,1D-3,2*0D0, | |
1513 | 7 4.0D0, 0.25D0, 8*0D0, | |
1514 | 8 1.90D0, 1.90D0, 0.5D0, 0.2D0, 0.33D0, | |
1515 | 8 0.66D0, 0.7D0, 0.5D0, 1000D0, 0.16D0, | |
1516 | 9 1.0D0,0.40D0,5.0D0,1.0D0,0D0,3.0D0,1.0D0,0.75D0,1.0D0,5.0D0/ | |
1517 | DATA (PARP(I),I=101,200)/ | |
1518 | & 0.5D0, 0.28D0, 1.0D0, 0.8D0, 0D0, 0D0, 0D0, 0D0, 0D0, 1D0, | |
1519 | 1 2.0D0, 3*0D0, 1.5D0, 0.5D0, 0.6D0, 2.5D0, 2.0D0, 1.0D0, | |
1520 | 2 1.0D0, 0.4D0, 8*0D0, | |
1521 | 3 0.01D0, 9*0D0, | |
1522 | 4 10*0D0, | |
1523 | 5 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, | |
1524 | 6 2.20D0, 23.6D0, 18.4D0, 11.5D0, 0.5D0, 0D0, 0D0, 0D0, 2*0D0, | |
1525 | 7 0D0, 0D0, 0D0, 1.0D0, 6*0D0, | |
1526 | 8 0.1D0, 0.01D0, 0.01D0, 0.01D0, 0.1D0, 0.01D0, 0.01D0, 0.01D0, | |
1527 | 8 0.3D0, 0.64D0, | |
1528 | 9 0.64D0, 5.0D0, 8*0D0/ | |
1529 | DATA MSTI/200*0/ | |
1530 | DATA PARI/200*0D0/ | |
1531 | DATA MINT/400*0/ | |
1532 | DATA VINT/400*0D0/ | |
1533 | ||
1534 | C...Constants for the generation of the various processes. | |
1535 | DATA (ISET(I),I=1,100)/ | |
1536 | & 1, 1, 1, -1, 3, -1, -1, 3, -2, 2, | |
1537 | 1 2, 2, 2, 2, 2, 2, -1, 2, 2, 2, | |
1538 | 2 -1, 2, 2, 2, 2, 2, -1, 2, 2, 2, | |
1539 | 3 2, 2, 2, 2, 2, 2, -1, -1, -1, -1, | |
1540 | 4 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, | |
1541 | 5 -1, -1, 2, 2, -1, -1, -1, 2, -1, -1, | |
1542 | 6 -1, -1, -1, -1, -1, -1, -1, 2, 2, 2, | |
1543 | 7 4, 4, 4, -1, -1, 4, 4, -1, -1, 2, | |
1544 | 8 2, 2, 2, 2, 2, 2, 2, 2, 2, -2, | |
1545 | 9 0, 0, 0, 0, 0, 9, -2, -2, 8, -2/ | |
1546 | DATA (ISET(I),I=101,200)/ | |
1547 | & -1, 1, 1, 1, 1, 2, 2, 2, -2, 2, | |
1548 | 1 2, 2, 2, 2, 2, -1, -1, -1, -2, -2, | |
1549 | 2 5, 5, 5, 5, -2, -2, -2, -2, -2, -2, | |
1550 | 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, | |
1551 | 4 1, 1, 1, 1, 1, 1, 1, 1, 1, -2, | |
1552 | 5 1, 1, 1, -2, -2, 1, 1, 1, -2, -2, | |
1553 | 6 2, 2, 2, 2, 2, 2, 2, 2, 2, -2, | |
1554 | 7 2, 2, 5, 5, -2, 2, 2, 5, 5, -2, | |
1555 | 8 5, 5, 2, 2, 2, 5, 5, 2, 2, 2, | |
1556 | 9 1, 1, 1, 2, 2, -2, -2, -2, -2, -2/ | |
1557 | DATA (ISET(I),I=201,300)/ | |
1558 | & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, | |
1559 | 1 2, 2, 2, 2, -2, 2, 2, 2, 2, 2, | |
1560 | 2 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, | |
1561 | 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, | |
1562 | 4 2, 2, 2, 2, -1, 2, 2, 2, 2, 2, | |
1563 | 5 2, 2, 2, 2, -1, 2, -1, 2, 2, -2, | |
1564 | 6 2, 2, 2, 2, 2, -1, -1, -1, -1, -1, | |
1565 | 7 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, | |
1566 | 8 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, | |
1567 | 9 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/ | |
1568 | DATA (ISET(I),I=301,500)/ | |
1569 | & 2, 39*-2, | |
1570 | 4 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, | |
1571 | 5 5, 5, 1, 1, -1, -1, -1, -1, -1, -1, | |
1572 | 6 2, 2, 2, 2, 2, 2, 2, 2, -1, 2, | |
1573 | 7 2, 2, 2, 2, 2, 2, 2, -1, -1, -1, | |
1574 | 8 2, 2, 2, 2, 2, 2, 2, 2, -2, -2, | |
1575 | 9 1, 1, 2, 2, 2, 5*-2, | |
1576 | & 100*-2/ | |
1577 | DATA ((KFPR(I,J),J=1,2),I=1,50)/ | |
1578 | & 23, 0, 24, 0, 25, 0, 24, 0, 25, 0, | |
1579 | & 24, 0, 23, 0, 25, 0, 0, 0, 0, 0, | |
1580 | 1 0, 0, 0, 0, 21, 21, 21, 22, 21, 23, | |
1581 | 1 21, 24, 21, 25, 22, 22, 22, 23, 22, 24, | |
1582 | 2 22, 25, 23, 23, 23, 24, 23, 25, 24, 24, | |
1583 | 2 24, 25, 25, 25, 0, 21, 0, 22, 0, 23, | |
1584 | 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, | |
1585 | 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, | |
1586 | 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, | |
1587 | 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23/ | |
1588 | DATA ((KFPR(I,J),J=1,2),I=51,100)/ | |
1589 | 5 0, 24, 0, 25, 0, 0, 0, 0, 0, 0, | |
1590 | 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1591 | 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1592 | 6 0, 0, 0, 0, 21, 21, 24, 24, 23, 24, | |
1593 | 7 23, 23, 24, 24, 23, 24, 23, 25, 22, 22, | |
1594 | 7 23, 23, 24, 24, 24, 25, 25, 25, 0, 211, | |
1595 | 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1596 | 8 443, 21,10441, 21,20443, 21, 445, 21, 0, 0, | |
1597 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1598 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
1599 | DATA ((KFPR(I,J),J=1,2),I=101,150)/ | |
1600 | & 23, 0, 25, 0, 25, 0,10441, 0, 445, 0, | |
1601 | & 443, 22, 443, 21, 443, 22, 0, 0, 22, 25, | |
1602 | 1 21, 25, 0, 25, 21, 25, 22, 22, 21, 22, | |
1603 | 1 22, 23, 23, 23, 24, 24, 0, 0, 0, 0, | |
1604 | 2 25, 6, 25, 6, 25, 0, 25, 0, 0, 0, | |
1605 | 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1606 | 3 0, 21, 0, 21, 0, 22, 0, 22, 0, 0, | |
1607 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1608 | 4 32, 0, 34, 0, 37, 0, 41, 0, 42, 0, | |
1609 | 4 4000011, 0, 4000001, 0, 4000002, 0, 3000331, 0, 0, 0/ | |
1610 | DATA ((KFPR(I,J),J=1,2),I=151,200)/ | |
1611 | 5 35, 0, 35, 0, 35, 0, 0, 0, 0, 0, | |
1612 | 5 36, 0, 36, 0, 36, 0, 0, 0, 0, 0, | |
1613 | 6 6, 37, 42, 0, 42, 42, 42, 42, 11, 0, | |
1614 | 6 11, 0, 0, 4000001, 0, 4000002, 0, 4000011, 0, 0, | |
1615 | 7 23, 35, 24, 35, 35, 0, 35, 0, 0, 0, | |
1616 | 7 23, 36, 24, 36, 36, 0, 36, 0, 0, 0, | |
1617 | 8 35, 6, 35, 6, 21, 35, 0, 35, 21, 35, | |
1618 | 8 36, 6, 36, 6, 21, 36, 0, 36, 21, 36, | |
1619 | 9 3000113, 0, 3000213, 0, 3000223, 0, 11, 0, 11, 0, | |
1620 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
1621 | DATA ((KFPR(I,J),J=1,2),I=201,240)/ | |
1622 | & 1000011, 1000011, 2000011, 2000011, 1000011, | |
1623 | & 2000011, 1000013, 1000013, 2000013, 2000013, | |
1624 | & 1000013, 2000013, 1000015, 1000015, 2000015, | |
1625 | & 2000015, 1000015, 2000015, 1000011, 1000012, | |
1626 | 1 1000015, 1000016, 2000015, 1000016, 1000012, | |
1627 | 1 1000012, 1000016, 1000016, 0, 0, | |
1628 | 1 1000022, 1000022, 1000023, 1000023, 1000025, | |
1629 | 1 1000025, 1000035, 1000035, 1000022, 1000023, | |
1630 | 2 1000022, 1000025, 1000022, 1000035, 1000023, | |
1631 | 2 1000025, 1000023, 1000035, 1000025, 1000035, | |
1632 | 2 1000024, 1000024, 1000037, 1000037, 1000024, | |
1633 | 2 1000037, 1000022, 1000024, 1000023, 1000024, | |
1634 | 3 1000025, 1000024, 1000035, 1000024, 1000022, | |
1635 | 3 1000037, 1000023, 1000037, 1000025, 1000037, | |
1636 | 3 1000035, 1000037, 1000021, 1000022, 1000021, | |
1637 | 3 1000023, 1000021, 1000025, 1000021, 1000035/ | |
1638 | DATA ((KFPR(I,J),J=1,2),I=241,280)/ | |
1639 | 4 1000021, 1000024, 1000021, 1000037, 1000021, | |
1640 | 4 1000021, 1000021, 1000021, 0, 0, | |
1641 | 4 1000002, 1000022, 2000002, 1000022, 1000002, | |
1642 | 4 1000023, 2000002, 1000023, 1000002, 1000025, | |
1643 | 5 2000002, 1000025, 1000002, 1000035, 2000002, | |
1644 | 5 1000035, 1000001, 1000024, 2000005, 1000024, | |
1645 | 5 1000001, 1000037, 2000005, 1000037, 1000002, | |
1646 | 5 1000021, 2000002, 1000021, 0, 0, | |
1647 | 6 1000006, 1000006, 2000006, 2000006, 1000006, | |
1648 | 6 2000006, 1000006, 1000006, 2000006, 2000006, | |
1649 | 6 0, 0, 0, 0, 0, | |
1650 | 6 0, 0, 0, 0, 0, | |
1651 | 7 1000002, 1000002, 2000002, 2000002, 1000002, | |
1652 | 7 2000002, 1000002, 1000002, 2000002, 2000002, | |
1653 | 7 1000002, 2000002, 1000002, 1000002, 2000002, | |
1654 | 7 2000002, 1000002, 1000002, 2000002, 2000002/ | |
1655 | DATA ((KFPR(I,J),J=1,2),I=281,350)/ | |
1656 | 8 1000005, 1000002, 2000005, 2000002, 1000005, | |
1657 | 8 2000002, 1000005, 1000002, 2000005, 2000002, | |
1658 | 8 1000005, 2000002, 1000005, 1000005, 2000005, | |
1659 | 8 2000005, 1000005, 1000005, 2000005, 2000005, | |
1660 | 9 1000005, 1000005, 2000005, 2000005, 1000005, | |
1661 | 9 2000005, 1000005, 1000021, 2000005, 1000021, | |
1662 | 9 1000005, 2000005, 37, 25, 37, | |
1663 | 9 35, 36, 25, 36, 35, | |
1664 | & 37, 37, 78*0, | |
1665 | 4 9900041, 0, 9900042, 0, 9900041, | |
1666 | 4 11, 9900042, 11, 9900041, 13, | |
1667 | 4 9900042, 13, 9900041, 15, 9900042, | |
1668 | 4 15, 9900041, 9900041, 9900042, 9900042/ | |
1669 | DATA ((KFPR(I,J),J=1,2),I=351,500)/ | |
1670 | 5 9900041, 0, 9900042, 0, 9900023, | |
1671 | 5 0, 9900024, 0, 0, 0, | |
1672 | 5 0, 0, 0, 0, 0, | |
1673 | 5 0, 0, 0, 0, 0, | |
1674 | 6 24, 24, 24, 3000211, 3000211, | |
1675 | 6 3000211, 22, 3000111, 22, 3000221, | |
1676 | 6 23, 3000111, 23, 3000221, 24, | |
1677 | 6 3000211, 0, 0, 24, 23, | |
1678 | 7 24, 3000111, 3000211, 23, 3000211, | |
1679 | 7 3000111, 22, 3000211, 23, 3000211, | |
1680 | 7 24, 3000111, 24, 3000221, 0, | |
1681 | 7 0, 0, 0, 0, 0, | |
1682 | 8 0, 0, 0, 0, 21, 21, 0, 21, 0, 0, | |
1683 | 8 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, | |
1684 | 9 5000039, 0, 5000039, 0, 21, | |
1685 | 9 5000039, 0, 5000039, 21, 5000039, | |
1686 | 9 10*0, | |
1687 | & 200*0/ | |
1688 | DATA COEF/10000*0D0/ | |
1689 | DATA (((ICOL(I,J,K),K=1,2),J=1,4),I=1,40)/ | |
1690 | &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, | |
1691 | &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, | |
1692 | &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, | |
1693 | &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, | |
1694 | &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, | |
1695 | &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, | |
1696 | &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, | |
1697 | &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, | |
1698 | &4,4,3,3,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, | |
1699 | &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/ | |
1700 | ||
1701 | C...Treatment of resonances. | |
1702 | DATA (MWID(I) ,I= 1, 500)/5*0,3*1,8*0,1,5*0,3*1,6*0,1,0,4*1, | |
1703 | &3*0,2*1,254*0,19*2,0,7*2,0,2,0,2,0,26*1,146*0/ | |
1704 | ||
1705 | C...Character constants: name of processes. | |
1706 | DATA PROC(0)/ 'All included subprocesses '/ | |
1707 | DATA (PROC(I),I=1,20)/ | |
1708 | &'f + fbar -> gamma*/Z0 ', 'f + fbar'' -> W+/- ', | |
1709 | &'f + fbar -> h0 ', 'gamma + W+/- -> W+/- ', | |
1710 | &'Z0 + Z0 -> h0 ', 'Z0 + W+/- -> W+/- ', | |
1711 | &' ', 'W+ + W- -> h0 ', | |
1712 | &' ', 'f + f'' -> f + f'' (QFD) ', | |
1713 | 1'f + f'' -> f + f'' (QCD) ','f + fbar -> f'' + fbar'' ', | |
1714 | 1'f + fbar -> g + g ', 'f + fbar -> g + gamma ', | |
1715 | 1'f + fbar -> g + Z0 ', 'f + fbar'' -> g + W+/- ', | |
1716 | 1'f + fbar -> g + h0 ', 'f + fbar -> gamma + gamma ', | |
1717 | 1'f + fbar -> gamma + Z0 ', 'f + fbar'' -> gamma + W+/- '/ | |
1718 | DATA (PROC(I),I=21,40)/ | |
1719 | 2'f + fbar -> gamma + h0 ', 'f + fbar -> Z0 + Z0 ', | |
1720 | 2'f + fbar'' -> Z0 + W+/- ', 'f + fbar -> Z0 + h0 ', | |
1721 | 2'f + fbar -> W+ + W- ', 'f + fbar'' -> W+/- + h0 ', | |
1722 | 2'f + fbar -> h0 + h0 ', 'f + g -> f + g ', | |
1723 | 2'f + g -> f + gamma ', 'f + g -> f + Z0 ', | |
1724 | 3'f + g -> f'' + W+/- ', 'f + g -> f + h0 ', | |
1725 | 3'f + gamma -> f + g ', 'f + gamma -> f + gamma ', | |
1726 | 3'f + gamma -> f + Z0 ', 'f + gamma -> f'' + W+/- ', | |
1727 | 3'f + gamma -> f + h0 ', 'f + Z0 -> f + g ', | |
1728 | 3'f + Z0 -> f + gamma ', 'f + Z0 -> f + Z0 '/ | |
1729 | DATA (PROC(I),I=41,60)/ | |
1730 | 4'f + Z0 -> f'' + W+/- ', 'f + Z0 -> f + h0 ', | |
1731 | 4'f + W+/- -> f'' + g ', 'f + W+/- -> f'' + gamma ', | |
1732 | 4'f + W+/- -> f'' + Z0 ', 'f + W+/- -> f'' + W+/- ', | |
1733 | 4'f + W+/- -> f'' + h0 ', 'f + h0 -> f + g ', | |
1734 | 4'f + h0 -> f + gamma ', 'f + h0 -> f + Z0 ', | |
1735 | 5'f + h0 -> f'' + W+/- ', 'f + h0 -> f + h0 ', | |
1736 | 5'g + g -> f + fbar ', 'g + gamma -> f + fbar ', | |
1737 | 5'g + Z0 -> f + fbar ', 'g + W+/- -> f + fbar'' ', | |
1738 | 5'g + h0 -> f + fbar ', 'gamma + gamma -> f + fbar ', | |
1739 | 5'gamma + Z0 -> f + fbar ', 'gamma + W+/- -> f + fbar'' '/ | |
1740 | DATA (PROC(I),I=61,80)/ | |
1741 | 6'gamma + h0 -> f + fbar ', 'Z0 + Z0 -> f + fbar ', | |
1742 | 6'Z0 + W+/- -> f + fbar'' ', 'Z0 + h0 -> f + fbar ', | |
1743 | 6'W+ + W- -> f + fbar ', 'W+/- + h0 -> f + fbar'' ', | |
1744 | 6'h0 + h0 -> f + fbar ', 'g + g -> g + g ', | |
1745 | 6'gamma + gamma -> W+ + W- ', 'gamma + W+/- -> Z0 + W+/- ', | |
1746 | 7'Z0 + Z0 -> Z0 + Z0 ', 'Z0 + Z0 -> W+ + W- ', | |
1747 | 7'Z0 + W+/- -> Z0 + W+/- ', 'Z0 + Z0 -> Z0 + h0 ', | |
1748 | 7'W+ + W- -> gamma + gamma ', 'W+ + W- -> Z0 + Z0 ', | |
1749 | 7'W+/- + W+/- -> W+/- + W+/- ', 'W+/- + h0 -> W+/- + h0 ', | |
1750 | 7'h0 + h0 -> h0 + h0 ', 'q + gamma -> q'' + pi+/- '/ | |
1751 | DATA (PROC(I),I=81,100)/ | |
1752 | 8'q + qbar -> Q + Qbar, mass ', 'g + g -> Q + Qbar, massive ', | |
1753 | 8'f + q -> f'' + Q, massive ', 'g + gamma -> Q + Qbar, mass ', | |
1754 | 8'gamma + gamma -> F + Fbar, m', 'g + g -> J/Psi + g ', | |
1755 | 8'g + g -> chi_0c + g ', 'g + g -> chi_1c + g ', | |
1756 | 8'g + g -> chi_2c + g ', ' ', | |
1757 | 9'Elastic scattering ', 'Single diffractive (XB) ', | |
1758 | 9'Single diffractive (AX) ', 'Double diffractive ', | |
1759 | 9'Low-pT scattering ', 'Semihard QCD 2 -> 2 ', | |
1760 | 9' ', ' ', | |
1761 | 9'q + gamma* -> q ', ' '/ | |
1762 | DATA (PROC(I),I=101,120)/ | |
1763 | &'g + g -> gamma*/Z0 ', 'g + g -> h0 ', | |
1764 | &'gamma + gamma -> h0 ', 'g + g -> chi_0c ', | |
1765 | &'g + g -> chi_2c ', 'g + g -> J/Psi + gamma ', | |
1766 | &'gamma + g -> J/Psi + g ', 'gamma+gamma -> J/Psi + gamma', | |
1767 | &' ', 'f + fbar -> gamma + h0 ', | |
1768 | 1'q + qbar -> g + h0 ', 'q + g -> q + h0 ', | |
1769 | 1'g + g -> g + h0 ', 'g + g -> gamma + gamma ', | |
1770 | 1'g + g -> g + gamma ', 'g + g -> gamma + Z0 ', | |
1771 | 1'g + g -> Z0 + Z0 ', 'g + g -> W+ + W- ', | |
1772 | 1' ', ' '/ | |
1773 | DATA (PROC(I),I=121,140)/ | |
1774 | 2'g + g -> Q + Qbar + h0 ', 'q + qbar -> Q + Qbar + h0 ', | |
1775 | 2'f + f'' -> f + f'' + h0 ', | |
1776 | 2'f + f'' -> f" + f"'' + h0 ', | |
1777 | 2' ', ' ', | |
1778 | 2' ', ' ', | |
1779 | 2' ', ' ', | |
1780 | 3'f + gamma*_T -> f + g ', 'f + gamma*_L -> f + g ', | |
1781 | 3'f + gamma*_T -> f + gamma ', 'f + gamma*_L -> f + gamma ', | |
1782 | 3'g + gamma*_T -> f + fbar ', 'g + gamma*_L -> f + fbar ', | |
1783 | 3'gamma*_T+gamma*_T -> f+fbar ', 'gamma*_T+gamma*_L -> f+fbar ', | |
1784 | 3'gamma*_L+gamma*_T -> f+fbar ', 'gamma*_L+gamma*_L -> f+fbar '/ | |
1785 | DATA (PROC(I),I=141,160)/ | |
1786 | 4'f + fbar -> gamma*/Z0/Z''0 ', 'f + fbar'' -> W''+/- ', | |
1787 | 4'f + fbar'' -> H+/- ', 'f + fbar'' -> R ', | |
1788 | 4'q + l -> LQ ', 'e + gamma -> e* ', | |
1789 | 4'd + g -> d* ', 'u + g -> u* ', | |
1790 | 4'g + g -> eta_tc ', ' ', | |
1791 | 5'f + fbar -> H0 ', 'g + g -> H0 ', | |
1792 | 5'gamma + gamma -> H0 ', ' ', | |
1793 | 5' ', 'f + fbar -> A0 ', | |
1794 | 5'g + g -> A0 ', 'gamma + gamma -> A0 ', | |
1795 | 5' ', ' '/ | |
1796 | DATA (PROC(I),I=161,180)/ | |
1797 | 6'f + g -> f'' + H+/- ', 'q + g -> LQ + lbar ', | |
1798 | 6'g + g -> LQ + LQbar ', 'q + qbar -> LQ + LQbar ', | |
1799 | 6'f + fbar -> f'' + fbar'' (g/Z)', | |
1800 | 6'f +fbar'' -> f" + fbar"'' (W) ', | |
1801 | 6'q + q'' -> q" + d* ', 'q + q'' -> q" + u* ', | |
1802 | 6'q + qbar -> e + e* ', ' ', | |
1803 | 7'f + fbar -> Z0 + H0 ', 'f + fbar'' -> W+/- + H0 ', | |
1804 | 7'f + f'' -> f + f'' + H0 ', | |
1805 | 7'f + f'' -> f" + f"'' + H0 ', | |
1806 | 7' ', 'f + fbar -> Z0 + A0 ', | |
1807 | 7'f + fbar'' -> W+/- + A0 ', | |
1808 | 7'f + f'' -> f + f'' + A0 ', | |
1809 | 7'f + f'' -> f" + f"'' + A0 ', | |
1810 | 7' '/ | |
1811 | DATA (PROC(I),I=181,200)/ | |
1812 | 8'g + g -> Q + Qbar + H0 ', 'q + qbar -> Q + Qbar + H0 ', | |
1813 | 8'q + qbar -> g + H0 ', 'q + g -> q + H0 ', | |
1814 | 8'g + g -> g + H0 ', 'g + g -> Q + Qbar + A0 ', | |
1815 | 8'q + qbar -> Q + Qbar + A0 ', 'q + qbar -> g + A0 ', | |
1816 | 8'q + g -> q + A0 ', 'g + g -> g + A0 ', | |
1817 | 9'f + fbar -> rho_tc0 ', 'f + f'' -> rho_tc+/- ', | |
1818 | 9'f + fbar -> omega_tc0 ', 'f+fbar -> f''+fbar'' (ETC) ', | |
1819 | 9'f+fbar'' -> f"+fbar"'' (ETC)',' ', | |
1820 | 9' ', ' ', | |
1821 | 9' ', ' '/ | |
1822 | DATA (PROC(I),I=201,220)/ | |
1823 | &'f + fbar -> ~e_L + ~e_Lbar ', 'f + fbar -> ~e_R + ~e_Rbar ', | |
1824 | &'f + fbar -> ~e_R + ~e_Lbar ', 'f + fbar -> ~mu_L + ~mu_Lbar', | |
1825 | &'f + fbar -> ~mu_R + ~mu_Rbar', 'f + fbar -> ~mu_L + ~mu_Rbar', | |
1826 | &'f+fbar -> ~tau_1 + ~tau_1bar', 'f+fbar -> ~tau_2 + ~tau_2bar', | |
1827 | &'f+fbar -> ~tau_1 + ~tau_2bar', 'q + qbar'' -> ~l_L + ~nulbar ', | |
1828 | 1'q+qbar''-> ~tau_1 + ~nutaubar', 'q+qbar''-> ~tau_2 + ~nutaubar', | |
1829 | 1'f + fbar -> ~nul + ~nulbar ', 'f+fbar -> ~nutau + ~nutaubar', | |
1830 | 1' ', 'f + fbar -> ~chi1 + ~chi1 ', | |
1831 | 1'f + fbar -> ~chi2 + ~chi2 ', 'f + fbar -> ~chi3 + ~chi3 ', | |
1832 | 1'f + fbar -> ~chi4 + ~chi4 ', 'f + fbar -> ~chi1 + ~chi2 '/ | |
1833 | DATA (PROC(I),I=221,240)/ | |
1834 | 2'f + fbar -> ~chi1 + ~chi3 ', 'f + fbar -> ~chi1 + ~chi4 ', | |
1835 | 2'f + fbar -> ~chi2 + ~chi3 ', 'f + fbar -> ~chi2 + ~chi4 ', | |
1836 | 2'f + fbar -> ~chi3 + ~chi4 ', 'f+fbar -> ~chi+-1 + ~chi-+1 ', | |
1837 | 2'f+fbar -> ~chi+-2 + ~chi-+2 ', 'f+fbar -> ~chi+-1 + ~chi-+2 ', | |
1838 | 2'q + qbar'' -> ~chi1 + ~chi+-1', 'q + qbar'' -> ~chi2 + ~chi+-1', | |
1839 | 3'q + qbar'' -> ~chi3 + ~chi+-1', 'q + qbar'' -> ~chi4 + ~chi+-1', | |
1840 | 3'q + qbar'' -> ~chi1 + ~chi+-2', 'q + qbar'' -> ~chi2 + ~chi+-2', | |
1841 | 3'q + qbar'' -> ~chi3 + ~chi+-2', 'q + qbar'' -> ~chi4 + ~chi+-2', | |
1842 | 3'q + qbar -> ~chi1 + ~g ', 'q + qbar -> ~chi2 + ~g ', | |
1843 | 3'q + qbar -> ~chi3 + ~g ', 'q + qbar -> ~chi4 + ~g '/ | |
1844 | DATA (PROC(I),I=241,260)/ | |
1845 | 4'q + qbar'' -> ~chi+-1 + ~g ', 'q + qbar'' -> ~chi+-2 + ~g ', | |
1846 | 4'q + qbar -> ~g + ~g ', 'g + g -> ~g + ~g ', | |
1847 | 4' ', 'qj + g -> ~qj_L + ~chi1 ', | |
1848 | 4'qj + g -> ~qj_R + ~chi1 ', 'qj + g -> ~qj_L + ~chi2 ', | |
1849 | 4'qj + g -> ~qj_R + ~chi2 ', 'qj + g -> ~qj_L + ~chi3 ', | |
1850 | 5'qj + g -> ~qj_R + ~chi3 ', 'qj + g -> ~qj_L + ~chi4 ', | |
1851 | 5'qj + g -> ~qj_R + ~chi4 ', 'qj + g -> ~qk_L + ~chi+-1 ', | |
1852 | 5'qj + g -> ~qk_R + ~chi+-1 ', 'qj + g -> ~qk_L + ~chi+-2 ', | |
1853 | 5'qj + g -> ~qk_R + ~chi+-2 ', 'qj + g -> ~qj_L + ~g ', | |
1854 | 5'qj + g -> ~qj_R + ~g ', ' '/ | |
1855 | DATA (PROC(I),I=261,300)/ | |
1856 | 6'f + fbar -> ~t_1 + ~t_1bar ', 'f + fbar -> ~t_2 + ~t_2bar ', | |
1857 | 6'f + fbar -> ~t_1 + ~t_2bar ', 'g + g -> ~t_1 + ~t_1bar ', | |
1858 | 6'g + g -> ~t_2 + ~t_2bar ', ' ', | |
1859 | 6' ', ' ', | |
1860 | 6' ', ' ', | |
1861 | 7'qi + qj -> ~qi_L + ~qj_L ', 'qi + qj -> ~qi_R + ~qj_R ', | |
1862 | 7'qi + qj -> ~qi_L + ~qj_R ', 'qi+qjbar -> ~qi_L + ~qj_Lbar', | |
1863 | 7'qi+qjbar -> ~qi_R + ~qj_Rbar', 'qi+qjbar -> ~qi_L + ~qj_Rbar', | |
1864 | 7'f + fbar -> ~qi_L + ~qi_Lbar', 'f + fbar -> ~qi_R + ~qi_Rbar', | |
1865 | 7'g + g -> ~qi_L + ~qi_Lbar ', 'g + g -> ~qi_R + ~qi_Rbar ', | |
1866 | 8'b + qj -> ~b_1 + ~qj_L ', 'b + qj -> ~b_2 + ~qj_R ', | |
1867 | 8'b + qj -> ~b_1 + ~qj_R ', 'b + qjbar -> ~b_1 + ~qj_Lbar', | |
1868 | 8'b + qjbar -> ~b_2 + ~qj_Rbar', 'b + qjbar -> ~b_1 + ~qj_Rbar', | |
1869 | 8'f + fbar -> ~b_1 + ~b_1bar ', 'f + fbar -> ~b_2 + ~b_2bar ', | |
1870 | 8'g + g -> ~b_1 + ~b_1bar ', 'g + g -> ~b_2 + ~b_2bar ', | |
1871 | 9'b + b -> ~b_1 + ~b_1 ', 'b + b -> ~b_2 + ~b_2 ', | |
1872 | 9'b + b -> ~b_1 + ~b_2 ', 'b + g -> ~b_1 + ~g ', | |
1873 | 9'b + g -> ~b_2 + ~g ', 'b + bbar -> ~b_1 + ~b_2bar ', | |
1874 | 9'f + fbar'' -> H+/- + h0 ', 'f + fbar -> H+/- + H0 ', | |
1875 | 9'f + fbar -> A0 + h0 ', 'f + fbar -> A0 + H0 '/ | |
1876 | DATA (PROC(I),I=301,340)/ | |
1877 | &'f + fbar -> H+ + H- ', 39*' '/ | |
1878 | DATA (PROC(I),I=341,380)/ | |
1879 | 4'l + l -> H_L++/-- ', 'l + l -> H_R++/-- ', | |
1880 | 4'l + gamma -> H_L++/-- e-/+ ', 'l + gamma -> H_R++/-- e-/+ ', | |
1881 | 4'l + gamma -> H_L++/-- mu-/+ ', 'l + gamma -> H_R++/-- mu-/+ ', | |
1882 | 4'l + gamma -> H_L++/-- tau-/+', 'l + gamma -> H_R++/-- tau-/+', | |
1883 | 4'f + fbar -> H_L++ + H_L-- ', 'f + fbar -> H_R++ + H_R-- ', | |
1884 | 5'f + f -> f'' + f'' + H_L++/-- ', | |
1885 | 5'f + f -> f'' + f'' + H_R++/-- ','f + fbar -> Z_R0 ', | |
1886 | 5'f + fbar'' -> W_R+/- ',5*' ', | |
1887 | 6' ', 'f + fbar -> W_L+ W_L- ', | |
1888 | 6'f + fbar -> W_L+/- pi_T-/+ ', 'f + fbar -> pi_T+ pi_T- ', | |
1889 | 6'f + fbar -> gamma pi_T0 ', 'f + fbar -> gamma pi_T0'' ', | |
1890 | 6'f + fbar -> Z0 pi_T0 ', 'f + fbar -> Z0 pi_T0'' ', | |
1891 | 6'f + fbar -> W+/- pi_T-/+ ', ' ', | |
1892 | 7'f + fbar'' -> W_L+/- Z_L0 ', 'f + fbar'' -> W_L+/- pi_T0 ', | |
1893 | 7'f + fbar'' -> pi_T+/- Z_L0 ', 'f + fbar'' -> pi_T+/- pi_T0 ', | |
1894 | 7'f + fbar'' -> gamma pi_T+/- ', 'f + fbar'' -> Z0 pi_T+/- ', | |
1895 | 7'f + fbar'' -> W+/- pi_T0 ', | |
1896 | 7'f + fbar'' -> W+/- pi_T0'' ', | |
1897 | 7' ',' ', | |
1898 | 7' '/ | |
1899 | DATA (PROC(I),I=381,500)/ | |
1900 | 8'f + f'' -> f + f'' (ETC) ','f + fbar -> f'' + fbar'' (ETC)', | |
1901 | 8'f + fbar -> g + g (ETC) ', 'f + g -> f + g (ETC) ', | |
1902 | 8'g + g -> f + fbar (ETC) ', 'g + g -> g + g (ETC) ', | |
1903 | 8'q + qbar -> Q + Qbar (ETC) ', 'g + g -> Q + Qbar (ETC) ', | |
1904 | 8' ', ' ', | |
1905 | 9'f + fbar -> G* ', 'g + g -> G* ', | |
1906 | 9'q + qbar -> g + G* ', 'q + g -> q + G* ', | |
1907 | 9'g + g -> g + G* ',' ', | |
1908 | & 104*' '/ | |
1909 | ||
1910 | C...Cross sections and slope offsets. | |
1911 | DATA SIGT/294*0D0/ | |
1912 | ||
1913 | C...Supersymmetry switches and parameters. | |
1914 | DATA IMSS/0, | |
1915 | & 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, | |
1916 | 1 89*0/ | |
1917 | DATA RMSS/0D0, | |
1918 | & 80D0,160D0,500D0,800D0,2D0,250D0,200D0,800D0,700D0,800D0, | |
1919 | 1 700D0,500D0,250D0,200D0,800D0,400D0,0D0,0.1D0,850D0,0.041D0, | |
1920 | 2 1D0,800D0,1D4,1D4,1D4,0D0,0D0,0D0,24D17,0D0, | |
1921 | 3 69*0D0/ | |
1922 | C...Initial values for R-violating SUSY couplings. | |
1923 | C...Should not be changed here. See PYMSIN. | |
1924 | DATA RVLAM/27*0D0/ | |
1925 | DATA RVLAMP/27*0D0/ | |
1926 | DATA RVLAMB/27*0D0/ | |
1927 | ||
1928 | C...Technicolor switches and parameters | |
1929 | DATA ITCM/0, | |
1930 | & 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
1931 | 1 89*0/ | |
1932 | DATA RTCM/0D0, | |
1933 | & 82D0,1.333D0,.333D0,0.408D0,1D0,1D0,.0182D0,1D0,0D0,1.333D0, | |
1934 | 1 .05D0,200D0,200D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0, | |
1935 | 2 .283D0,.707D0,0D0,0D0,0D0,1.667D0,250D0,250D0,.707D0,0D0, | |
1936 | 3 .707D0,0D0,1D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0, | |
1937 | 4 1000D0, 1D0, 1D0, 1D0, 1D0, 0D0, 4*0D0, | |
1938 | 4 49*0D0/ | |
1939 | ||
1940 | C...Data for histogramming routines. | |
1941 | DATA IHIST/1000,20000,55,1/ | |
1942 | DATA INDX/1000*0/ | |
1943 | ||
1944 | END | |
1945 | ||
1946 | C********************************************************************* | |
1947 | ||
1948 | C...PYTEST | |
1949 | C...A simple program (disguised as subroutine) to run at installation | |
1950 | C...as a check that the program works as intended. | |
1951 | ||
1952 | SUBROUTINE PYTEST(MTEST) | |
1953 | ||
1954 | C...Double precision and integer declarations. | |
1955 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
1956 | IMPLICIT INTEGER(I-N) | |
1957 | INTEGER PYK,PYCHGE,PYCOMP | |
1958 | C...Commonblocks. | |
1959 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
1960 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
1961 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
1962 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
1963 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
1964 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
1965 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/ | |
1966 | C...Local arrays. | |
1967 | DIMENSION PSUM(5),PINI(6),PFIN(6) | |
1968 | ||
1969 | C...Save defaults for values that are changed. | |
1970 | MSTJ1=MSTJ(1) | |
1971 | MSTJ3=MSTJ(3) | |
1972 | MSTJ11=MSTJ(11) | |
1973 | MSTJ42=MSTJ(42) | |
1974 | MSTJ43=MSTJ(43) | |
1975 | MSTJ44=MSTJ(44) | |
1976 | PARJ17=PARJ(17) | |
1977 | PARJ22=PARJ(22) | |
1978 | PARJ43=PARJ(43) | |
1979 | PARJ54=PARJ(54) | |
1980 | MST101=MSTJ(101) | |
1981 | MST104=MSTJ(104) | |
1982 | MST105=MSTJ(105) | |
1983 | MST107=MSTJ(107) | |
1984 | MST116=MSTJ(116) | |
1985 | ||
1986 | C...First part: loop over simple events to be generated. | |
1987 | IF(MTEST.GE.1) CALL PYTABU(20) | |
1988 | NERR=0 | |
1989 | DO 180 IEV=1,500 | |
1990 | ||
1991 | C...Reset parameter values. Switch on some nonstandard features. | |
1992 | MSTJ(1)=1 | |
1993 | MSTJ(3)=0 | |
1994 | MSTJ(11)=1 | |
1995 | MSTJ(42)=2 | |
1996 | MSTJ(43)=4 | |
1997 | MSTJ(44)=2 | |
1998 | PARJ(17)=0.1D0 | |
1999 | PARJ(22)=1.5D0 | |
2000 | PARJ(43)=1D0 | |
2001 | PARJ(54)=-0.05D0 | |
2002 | MSTJ(101)=5 | |
2003 | MSTJ(104)=5 | |
2004 | MSTJ(105)=0 | |
2005 | MSTJ(107)=1 | |
2006 | IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3 | |
2007 | ||
2008 | C...Ten events each for some single jets configurations. | |
2009 | IF(IEV.LE.50) THEN | |
2010 | ITY=(IEV+9)/10 | |
2011 | MSTJ(3)=-1 | |
2012 | IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2 | |
2013 | IF(ITY.EQ.1) CALL PY1ENT(1,1,15D0,0D0,0D0) | |
2014 | IF(ITY.EQ.2) CALL PY1ENT(1,3101,15D0,0D0,0D0) | |
2015 | IF(ITY.EQ.3) CALL PY1ENT(1,-2203,15D0,0D0,0D0) | |
2016 | IF(ITY.EQ.4) CALL PY1ENT(1,-4,30D0,0D0,0D0) | |
2017 | IF(ITY.EQ.5) CALL PY1ENT(1,21,15D0,0D0,0D0) | |
2018 | ||
2019 | C...Ten events each for some simple jet systems; string fragmentation. | |
2020 | ELSEIF(IEV.LE.130) THEN | |
2021 | ITY=(IEV-41)/10 | |
2022 | IF(ITY.EQ.1) CALL PY2ENT(1,1,-1,40D0) | |
2023 | IF(ITY.EQ.2) CALL PY2ENT(1,4,-4,30D0) | |
2024 | IF(ITY.EQ.3) CALL PY2ENT(1,2,2103,100D0) | |
2025 | IF(ITY.EQ.4) CALL PY2ENT(1,21,21,40D0) | |
2026 | IF(ITY.EQ.5) CALL PY3ENT(1,2101,21,-3203,30D0,0.6D0,0.8D0) | |
2027 | IF(ITY.EQ.6) CALL PY3ENT(1,5,21,-5,40D0,0.9D0,0.8D0) | |
2028 | IF(ITY.EQ.7) CALL PY3ENT(1,21,21,21,60D0,0.7D0,0.5D0) | |
2029 | IF(ITY.EQ.8) CALL PY4ENT(1,2,21,21,-2,40D0, | |
2030 | & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) | |
2031 | ||
2032 | C...Seventy events with independent fragmentation and momentum cons. | |
2033 | ELSEIF(IEV.LE.200) THEN | |
2034 | ITY=1+(IEV-131)/16 | |
2035 | MSTJ(2)=1+MOD(IEV-131,4) | |
2036 | MSTJ(3)=1+MOD((IEV-131)/4,4) | |
2037 | IF(ITY.EQ.1) CALL PY2ENT(1,4,-5,40D0) | |
2038 | IF(ITY.EQ.2) CALL PY3ENT(1,3,21,-3,40D0,0.9D0,0.4D0) | |
2039 | IF(ITY.EQ.3) CALL PY4ENT(1,2,21,21,-2,40D0, | |
2040 | & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) | |
2041 | IF(ITY.GE.4) CALL PY4ENT(1,2,-3,3,-2,40D0, | |
2042 | & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) | |
2043 | ||
2044 | C...A hundred events with random jets (check invariant mass). | |
2045 | ELSEIF(IEV.LE.300) THEN | |
2046 | 100 DO 110 J=1,5 | |
2047 | PSUM(J)=0D0 | |
2048 | 110 CONTINUE | |
2049 | NJET=2D0+6D0*PYR(0) | |
2050 | DO 130 I=1,NJET | |
2051 | KFL=21 | |
2052 | IF(I.EQ.1) KFL=INT(1D0+4D0*PYR(0)) | |
2053 | IF(I.EQ.NJET) KFL=-INT(1D0+4D0*PYR(0)) | |
2054 | EJET=5D0+20D0*PYR(0) | |
2055 | THETA=ACOS(2D0*PYR(0)-1D0) | |
2056 | PHI=6.2832D0*PYR(0) | |
2057 | IF(I.LT.NJET) CALL PY1ENT(-I,KFL,EJET,THETA,PHI) | |
2058 | IF(I.EQ.NJET) CALL PY1ENT(I,KFL,EJET,THETA,PHI) | |
2059 | IF(I.EQ.1.OR.I.EQ.NJET) MSTJ(93)=1 | |
2060 | IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+PYMASS(KFL) | |
2061 | DO 120 J=1,4 | |
2062 | PSUM(J)=PSUM(J)+P(I,J) | |
2063 | 120 CONTINUE | |
2064 | 130 CONTINUE | |
2065 | IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT. | |
2066 | & (PSUM(5)+PARJ(32))**2) GOTO 100 | |
2067 | ||
2068 | C...Fifty e+e- continuum events with matrix elements. | |
2069 | ELSEIF(IEV.LE.350) THEN | |
2070 | MSTJ(101)=2 | |
2071 | CALL PYEEVT(0,40D0) | |
2072 | ||
2073 | C...Fifty e+e- continuum event with varying shower options. | |
2074 | ELSEIF(IEV.LE.400) THEN | |
2075 | MSTJ(42)=1+MOD(IEV,2) | |
2076 | MSTJ(43)=1+MOD(IEV/2,4) | |
2077 | MSTJ(44)=MOD(IEV/8,3) | |
2078 | CALL PYEEVT(0,90D0) | |
2079 | ||
2080 | C...Fifty e+e- continuum events with coherent shower. | |
2081 | ELSEIF(IEV.LE.450) THEN | |
2082 | CALL PYEEVT(0,500D0) | |
2083 | ||
2084 | C...Fifty Upsilon decays to ggg or gammagg with coherent shower. | |
2085 | ELSE | |
2086 | CALL PYONIA(5,9.46D0) | |
2087 | ENDIF | |
2088 | ||
2089 | C...Generate event. Find total momentum, energy and charge. | |
2090 | DO 140 J=1,4 | |
2091 | PINI(J)=PYP(0,J) | |
2092 | 140 CONTINUE | |
2093 | PINI(6)=PYP(0,6) | |
2094 | CALL PYEXEC | |
2095 | DO 150 J=1,4 | |
2096 | PFIN(J)=PYP(0,J) | |
2097 | 150 CONTINUE | |
2098 | PFIN(6)=PYP(0,6) | |
2099 | ||
2100 | C...Check conservation of energy, momentum and charge; | |
2101 | C...usually exact, but only approximate for single jets. | |
2102 | MERR=0 | |
2103 | IF(IEV.LE.50) THEN | |
2104 | IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.10D0) | |
2105 | & MERR=MERR+1 | |
2106 | EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3) | |
2107 | IF(EPZREM.LT.0D0.OR.EPZREM.GT.2D0*PARJ(31)) MERR=MERR+1 | |
2108 | IF(ABS(PFIN(6)-PINI(6)).GT.2.1D0) MERR=MERR+1 | |
2109 | ELSE | |
2110 | DO 160 J=1,4 | |
2111 | IF(ABS(PFIN(J)-PINI(J)).GT.0.0001D0*PINI(4)) MERR=MERR+1 | |
2112 | 160 CONTINUE | |
2113 | IF(ABS(PFIN(6)-PINI(6)).GT.0.1D0) MERR=MERR+1 | |
2114 | ENDIF | |
2115 | IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), | |
2116 | & (PFIN(J),J=1,4),PFIN(6) | |
2117 | ||
2118 | C...Check that all KF codes are known ones, and that partons/particles | |
2119 | C...satisfy energy-momentum-mass relation. Store particle statistics. | |
2120 | DO 170 I=1,N | |
2121 | IF(K(I,1).GT.20) GOTO 170 | |
2122 | IF(PYCOMP(K(I,2)).EQ.0) THEN | |
2123 | WRITE(MSTU(11),5100) I | |
2124 | MERR=MERR+1 | |
2125 | ENDIF | |
2126 | PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 | |
2127 | IF(ABS(PD).GT.MAX(0.1D0,0.001D0*P(I,4)**2).OR.P(I,4).LT.0D0) | |
2128 | & THEN | |
2129 | WRITE(MSTU(11),5200) I | |
2130 | MERR=MERR+1 | |
2131 | ENDIF | |
2132 | 170 CONTINUE | |
2133 | IF(MTEST.GE.1) CALL PYTABU(21) | |
2134 | ||
2135 | C...List all erroneous events and some normal ones. | |
2136 | IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN | |
2137 | IF(MERR.GE.1) WRITE(MSTU(11),6400) | |
2138 | CALL PYLIST(2) | |
2139 | ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN | |
2140 | CALL PYLIST(1) | |
2141 | ENDIF | |
2142 | ||
2143 | C...Stop execution if too many errors. | |
2144 | IF(MERR.NE.0) NERR=NERR+1 | |
2145 | IF(NERR.GE.10) THEN | |
2146 | WRITE(MSTU(11),6300) | |
2147 | CALL PYLIST(1) | |
2148 | STOP | |
2149 | ENDIF | |
2150 | 180 CONTINUE | |
2151 | ||
2152 | C...Summarize result of run. | |
2153 | IF(MTEST.GE.1) CALL PYTABU(22) | |
2154 | ||
2155 | C...Reset commonblock variables changed during run. | |
2156 | MSTJ(1)=MSTJ1 | |
2157 | MSTJ(3)=MSTJ3 | |
2158 | MSTJ(11)=MSTJ11 | |
2159 | MSTJ(42)=MSTJ42 | |
2160 | MSTJ(43)=MSTJ43 | |
2161 | MSTJ(44)=MSTJ44 | |
2162 | PARJ(17)=PARJ17 | |
2163 | PARJ(22)=PARJ22 | |
2164 | PARJ(43)=PARJ43 | |
2165 | PARJ(54)=PARJ54 | |
2166 | MSTJ(101)=MST101 | |
2167 | MSTJ(104)=MST104 | |
2168 | MSTJ(105)=MST105 | |
2169 | MSTJ(107)=MST107 | |
2170 | MSTJ(116)=MST116 | |
2171 | ||
2172 | C...Second part: complete events of various kinds. | |
2173 | C...Common initial values. Loop over initiating conditions. | |
2174 | MSTP(122)=MAX(0,MIN(2,MTEST)) | |
2175 | MDCY(PYCOMP(111),1)=0 | |
2176 | DO 230 IPROC=1,8 | |
2177 | ||
2178 | C...Reset process type, kinematics cuts, and the flags used. | |
2179 | MSEL=0 | |
2180 | DO 190 ISUB=1,500 | |
2181 | MSUB(ISUB)=0 | |
2182 | 190 CONTINUE | |
2183 | CKIN(1)=2D0 | |
2184 | CKIN(3)=0D0 | |
2185 | MSTP(2)=1 | |
2186 | MSTP(11)=0 | |
2187 | MSTP(33)=0 | |
2188 | MSTP(81)=1 | |
2189 | MSTP(82)=1 | |
2190 | MSTP(111)=1 | |
2191 | MSTP(131)=0 | |
2192 | MSTP(133)=0 | |
2193 | PARP(131)=0.01D0 | |
2194 | ||
2195 | C...Prompt photon production at fixed target. | |
2196 | IF(IPROC.EQ.1) THEN | |
2197 | PZSUM=300D0 | |
2198 | PESUM=SQRT(PZSUM**2+PYMASS(211)**2)+PYMASS(2212) | |
2199 | PQSUM=2D0 | |
2200 | MSEL=10 | |
2201 | CKIN(3)=5D0 | |
2202 | CALL PYINIT('FIXT','pi+','p',PZSUM) | |
2203 | ||
2204 | C...QCD processes at ISR energies. | |
2205 | ELSEIF(IPROC.EQ.2) THEN | |
2206 | PESUM=63D0 | |
2207 | PZSUM=0D0 | |
2208 | PQSUM=2D0 | |
2209 | MSEL=1 | |
2210 | CKIN(3)=5D0 | |
2211 | CALL PYINIT('CMS','p','p',PESUM) | |
2212 | ||
2213 | C...W production + multiple interactions at CERN Collider. | |
2214 | ELSEIF(IPROC.EQ.3) THEN | |
2215 | PESUM=630D0 | |
2216 | PZSUM=0D0 | |
2217 | PQSUM=0D0 | |
2218 | MSEL=12 | |
2219 | CKIN(1)=20D0 | |
2220 | MSTP(82)=4 | |
2221 | MSTP(2)=2 | |
2222 | MSTP(33)=3 | |
2223 | CALL PYINIT('CMS','p','pbar',PESUM) | |
2224 | ||
2225 | C...W/Z gauge boson pairs + pileup events at the Tevatron. | |
2226 | ELSEIF(IPROC.EQ.4) THEN | |
2227 | PESUM=1800D0 | |
2228 | PZSUM=0D0 | |
2229 | PQSUM=0D0 | |
2230 | MSUB(22)=1 | |
2231 | MSUB(23)=1 | |
2232 | MSUB(25)=1 | |
2233 | CKIN(1)=200D0 | |
2234 | MSTP(111)=0 | |
2235 | MSTP(131)=1 | |
2236 | MSTP(133)=2 | |
2237 | PARP(131)=0.04D0 | |
2238 | CALL PYINIT('CMS','p','pbar',PESUM) | |
2239 | ||
2240 | C...Higgs production at LHC. | |
2241 | ELSEIF(IPROC.EQ.5) THEN | |
2242 | PESUM=15400D0 | |
2243 | PZSUM=0D0 | |
2244 | PQSUM=2D0 | |
2245 | MSUB(3)=1 | |
2246 | MSUB(102)=1 | |
2247 | MSUB(123)=1 | |
2248 | MSUB(124)=1 | |
2249 | PMAS(25,1)=300D0 | |
2250 | CKIN(1)=200D0 | |
2251 | MSTP(81)=0 | |
2252 | MSTP(111)=0 | |
2253 | CALL PYINIT('CMS','p','p',PESUM) | |
2254 | ||
2255 | C...Z' production at SSC. | |
2256 | ELSEIF(IPROC.EQ.6) THEN | |
2257 | PESUM=40000D0 | |
2258 | PZSUM=0D0 | |
2259 | PQSUM=2D0 | |
2260 | MSEL=21 | |
2261 | PMAS(32,1)=600D0 | |
2262 | CKIN(1)=400D0 | |
2263 | MSTP(81)=0 | |
2264 | MSTP(111)=0 | |
2265 | CALL PYINIT('CMS','p','p',PESUM) | |
2266 | ||
2267 | C...W pair production at 1 TeV e+e- collider. | |
2268 | ELSEIF(IPROC.EQ.7) THEN | |
2269 | PESUM=1000D0 | |
2270 | PZSUM=0D0 | |
2271 | PQSUM=0D0 | |
2272 | MSUB(25)=1 | |
2273 | MSUB(69)=1 | |
2274 | MSTP(11)=1 | |
2275 | CALL PYINIT('CMS','e+','e-',PESUM) | |
2276 | ||
2277 | C...Deep inelastic scattering at a LEP+LHC ep collider. | |
2278 | ELSEIF(IPROC.EQ.8) THEN | |
2279 | P(1,1)=0D0 | |
2280 | P(1,2)=0D0 | |
2281 | P(1,3)=8000D0 | |
2282 | P(2,1)=0D0 | |
2283 | P(2,2)=0D0 | |
2284 | P(2,3)=-80D0 | |
2285 | PESUM=8080D0 | |
2286 | PZSUM=7920D0 | |
2287 | PQSUM=0D0 | |
2288 | MSUB(10)=1 | |
2289 | CKIN(3)=50D0 | |
2290 | MSTP(111)=0 | |
2291 | CALL PYINIT('3MOM','p','e-',PESUM) | |
2292 | ENDIF | |
2293 | ||
2294 | C...Generate 20 events of each required type. | |
2295 | DO 220 IEV=1,20 | |
2296 | CALL PYEVNT | |
2297 | PESUMM=PESUM | |
2298 | IF(IPROC.EQ.4) PESUMM=MSTI(41)*PESUM | |
2299 | ||
2300 | C...Check conservation of energy/momentum/flavour. | |
2301 | PINI(1)=0D0 | |
2302 | PINI(2)=0D0 | |
2303 | PINI(3)=PZSUM | |
2304 | PINI(4)=PESUMM | |
2305 | PINI(6)=PQSUM | |
2306 | DO 200 J=1,4 | |
2307 | PFIN(J)=PYP(0,J) | |
2308 | 200 CONTINUE | |
2309 | PFIN(6)=PYP(0,6) | |
2310 | MERR=0 | |
2311 | DEVE=ABS(PFIN(4)-PINI(4))+ABS(PFIN(3)-PINI(3)) | |
2312 | DEVT=ABS(PFIN(1)-PINI(1))+ABS(PFIN(2)-PINI(2)) | |
2313 | DEVQ=ABS(PFIN(6)-PINI(6)) | |
2314 | IF(DEVE.GT.2D-3*PESUM.OR.DEVT.GT.MAX(0.01D0,1D-4*PESUM).OR. | |
2315 | & DEVQ.GT.0.1D0) MERR=1 | |
2316 | IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), | |
2317 | & (PFIN(J),J=1,4),PFIN(6) | |
2318 | ||
2319 | C...Check that all KF codes are known ones, and that partons/particles | |
2320 | C...satisfy energy-momentum-mass relation. | |
2321 | DO 210 I=1,N | |
2322 | IF(K(I,1).GT.20) GOTO 210 | |
2323 | IF(PYCOMP(K(I,2)).EQ.0) THEN | |
2324 | WRITE(MSTU(11),5100) I | |
2325 | MERR=MERR+1 | |
2326 | ENDIF | |
2327 | PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2* | |
2328 | & SIGN(1D0,P(I,5)) | |
2329 | IF(ABS(PD).GT.MAX(0.1D0,0.002D0*P(I,4)**2,0.002D0*P(I,5)**2) | |
2330 | & .OR.(P(I,5).GE.0D0.AND.P(I,4).LT.0D0)) THEN | |
2331 | WRITE(MSTU(11),5200) I | |
2332 | MERR=MERR+1 | |
2333 | ENDIF | |
2334 | 210 CONTINUE | |
2335 | ||
2336 | C...Listing of erroneous events, and first event of each type. | |
2337 | IF(MERR.GE.1) NERR=NERR+1 | |
2338 | IF(NERR.GE.10) THEN | |
2339 | WRITE(MSTU(11),6300) | |
2340 | CALL PYLIST(1) | |
2341 | STOP | |
2342 | ENDIF | |
2343 | IF(MTEST.GE.1.AND.(MERR.GE.1.OR.IEV.EQ.1)) THEN | |
2344 | IF(MERR.GE.1) WRITE(MSTU(11),6400) | |
2345 | CALL PYLIST(1) | |
2346 | ENDIF | |
2347 | 220 CONTINUE | |
2348 | ||
2349 | C...List statistics for each process type. | |
2350 | IF(MTEST.GE.1) CALL PYSTAT(1) | |
2351 | 230 CONTINUE | |
2352 | ||
2353 | C...Summarize result of run. | |
2354 | IF(NERR.EQ.0) WRITE(MSTU(11),6500) | |
2355 | IF(NERR.GT.0) WRITE(MSTU(11),6600) NERR | |
2356 | ||
2357 | C...Format statements for output. | |
2358 | 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ', | |
2359 | &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X, | |
2360 | &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X, | |
2361 | &4(1X,F12.5),1X,F8.2) | |
2362 | 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code') | |
2363 | 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ', | |
2364 | &'kinematics') | |
2365 | 6300 FORMAT(/5X,'This is the tenth error experienced! Something is ', | |
2366 | &'wrong.'/5X,'Execution will be stopped after listing of event.') | |
2367 | 6400 FORMAT(5X,'Faulty event follows:') | |
2368 | 6500 FORMAT(//5X,'End result of PYTEST: no errors detected.') | |
2369 | 6600 FORMAT(//5X,'End result of PYTEST:',I2,' errors detected.'/ | |
2370 | &5X,'This should not have happened!') | |
2371 | ||
2372 | RETURN | |
2373 | END | |
2374 | ||
2375 | C********************************************************************* | |
2376 | ||
2377 | C...PYHEPC | |
2378 | C...Converts PYTHIA event record contents to or from | |
2379 | C...the standard event record commonblock. | |
2380 | ||
2381 | SUBROUTINE PYHEPC(MCONV) | |
2382 | ||
2383 | C...Double precision and integer declarations. | |
2384 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
2385 | IMPLICIT INTEGER(I-N) | |
2386 | INTEGER PYK,PYCHGE,PYCOMP | |
2387 | C...Commonblocks. | |
2388 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
2389 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
2390 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
2391 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
2392 | C...HEPEVT commonblock. | |
2393 | PARAMETER (NMXHEP=4000) | |
2394 | COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
2395 | &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) | |
2396 | DOUBLE PRECISION PHEP,VHEP | |
2397 | SAVE /HEPEVT/ | |
2398 | ||
2399 | C...Conversion from PYTHIA to standard, the easy part. | |
2400 | IF(MCONV.EQ.1) THEN | |
2401 | NEVHEP=0 | |
2402 | IF(N.GT.NMXHEP) CALL PYERRM(8, | |
2403 | & '(PYHEPC:) no more space in /HEPEVT/') | |
2404 | NHEP=MIN(N,NMXHEP) | |
2405 | DO 150 I=1,NHEP | |
2406 | ISTHEP(I)=0 | |
2407 | IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1 | |
2408 | IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2 | |
2409 | IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3 | |
2410 | IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1) | |
2411 | IDHEP(I)=K(I,2) | |
2412 | JMOHEP(1,I)=K(I,3) | |
2413 | JMOHEP(2,I)=0 | |
2414 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN | |
2415 | JDAHEP(1,I)=K(I,4) | |
2416 | JDAHEP(2,I)=K(I,5) | |
2417 | ELSE | |
2418 | JDAHEP(1,I)=0 | |
2419 | JDAHEP(2,I)=0 | |
2420 | ENDIF | |
2421 | DO 100 J=1,5 | |
2422 | PHEP(J,I)=P(I,J) | |
2423 | 100 CONTINUE | |
2424 | DO 110 J=1,4 | |
2425 | VHEP(J,I)=V(I,J) | |
2426 | 110 CONTINUE | |
2427 | ||
2428 | C...Check if new event (from pileup). | |
2429 | IF(I.EQ.1) THEN | |
2430 | INEW=1 | |
2431 | ELSE | |
2432 | IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I | |
2433 | ENDIF | |
2434 | ||
2435 | C...Fill in missing mother information. | |
2436 | IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN | |
2437 | IMO1=I-2 | |
2438 | 120 IF(IMO1.GT.INEW.AND.K(IMO1+1,1).EQ.21.AND.K(IMO1+1,3).EQ.0) | |
2439 | & THEN | |
2440 | IMO1=IMO1-1 | |
2441 | GOTO 120 | |
2442 | ENDIF | |
2443 | JMOHEP(1,I)=IMO1 | |
2444 | JMOHEP(2,I)=IMO1+1 | |
2445 | ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN | |
2446 | I1=K(I,3)-1 | |
2447 | 130 I1=I1+1 | |
2448 | IF(I1.GE.I) CALL PYERRM(8, | |
2449 | & '(PYHEPC:) translation of inconsistent event history') | |
2450 | IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 130 | |
2451 | KC=PYCOMP(K(I1,2)) | |
2452 | IF(I1.LT.I.AND.KC.EQ.0) GOTO 130 | |
2453 | IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 130 | |
2454 | JMOHEP(2,I)=I1 | |
2455 | ELSEIF(K(I,2).EQ.94) THEN | |
2456 | NJET=2 | |
2457 | IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3 | |
2458 | IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4 | |
2459 | JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5)) | |
2460 | IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)= | |
2461 | & MOD(K(I+1,4)/MSTU(5),MSTU(5)) | |
2462 | ENDIF | |
2463 | ||
2464 | C...Fill in missing daughter information. | |
2465 | IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN | |
2466 | DO 140 I1=JDAHEP(1,I),JDAHEP(2,I) | |
2467 | I2=MOD(K(I1,4)/MSTU(5),MSTU(5)) | |
2468 | JDAHEP(1,I2)=I | |
2469 | 140 CONTINUE | |
2470 | ENDIF | |
2471 | IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 150 | |
2472 | I1=JMOHEP(1,I) | |
2473 | IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 150 | |
2474 | IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 150 | |
2475 | IF(JDAHEP(1,I1).EQ.0) THEN | |
2476 | JDAHEP(1,I1)=I | |
2477 | ELSE | |
2478 | JDAHEP(2,I1)=I | |
2479 | ENDIF | |
2480 | 150 CONTINUE | |
2481 | DO 160 I=1,NHEP | |
2482 | IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 160 | |
2483 | IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I) | |
2484 | 160 CONTINUE | |
2485 | ||
2486 | C...Conversion from standard to PYTHIA, the easy part. | |
2487 | ELSE | |
2488 | IF(NHEP.GT.MSTU(4)) CALL PYERRM(8, | |
2489 | & '(PYHEPC:) no more space in /PYJETS/') | |
2490 | N=MIN(NHEP,MSTU(4)) | |
2491 | NKQ=0 | |
2492 | KQSUM=0 | |
2493 | DO 190 I=1,N | |
2494 | K(I,1)=0 | |
2495 | IF(ISTHEP(I).EQ.1) K(I,1)=1 | |
2496 | IF(ISTHEP(I).EQ.2) K(I,1)=11 | |
2497 | IF(ISTHEP(I).EQ.3) K(I,1)=21 | |
2498 | K(I,2)=IDHEP(I) | |
2499 | K(I,3)=JMOHEP(1,I) | |
2500 | K(I,4)=JDAHEP(1,I) | |
2501 | K(I,5)=JDAHEP(2,I) | |
2502 | DO 170 J=1,5 | |
2503 | P(I,J)=PHEP(J,I) | |
2504 | 170 CONTINUE | |
2505 | DO 180 J=1,4 | |
2506 | V(I,J)=VHEP(J,I) | |
2507 | 180 CONTINUE | |
2508 | V(I,5)=0D0 | |
2509 | IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN | |
2510 | I1=JDAHEP(1,I) | |
2511 | IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))* | |
2512 | & PHEP(5,I)/PHEP(4,I) | |
2513 | ENDIF | |
2514 | ||
2515 | C...Fill in missing information on colour connection in jet systems. | |
2516 | IF(ISTHEP(I).EQ.1) THEN | |
2517 | KC=PYCOMP(K(I,2)) | |
2518 | KQ=0 | |
2519 | IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
2520 | IF(KQ.NE.0) NKQ=NKQ+1 | |
2521 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
2522 | IF(KQ.NE.0.AND.KQSUM.NE.0) THEN | |
2523 | K(I,1)=2 | |
2524 | ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN | |
2525 | IF(K(I+1,2).EQ.21) K(I,1)=2 | |
2526 | ENDIF | |
2527 | ENDIF | |
2528 | 190 CONTINUE | |
2529 | IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL PYERRM(8, | |
2530 | & '(PYHEPC:) input parton configuration not colour singlet') | |
2531 | ENDIF | |
2532 | ||
2533 | END | |
2534 | ||
2535 | C********************************************************************* | |
2536 | ||
2537 | C...PYINIT | |
2538 | C...Initializes the generation procedure; finds maxima of the | |
2539 | C...differential cross-sections to be used for weighting. | |
2540 | ||
2541 | SUBROUTINE PYINIT(FRAME,BEAM,TARGET,WIN) | |
2542 | ||
2543 | C...Double precision and integer declarations. | |
2544 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
2545 | IMPLICIT INTEGER(I-N) | |
2546 | INTEGER PYK,PYCHGE,PYCOMP | |
2547 | C...Commonblocks. | |
2548 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
2549 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
2550 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
2551 | COMMON/PYDAT4/CHAF(500,2) | |
2552 | CHARACTER CHAF*16 | |
2553 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
2554 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
2555 | COMMON/PYINT1/MINT(400),VINT(400) | |
2556 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
2557 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
2558 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, | |
2559 | &/PYINT1/,/PYINT2/,/PYINT5/ | |
2560 | C...Local arrays and character variables. | |
2561 | DIMENSION ALAMIN(20),NFIN(20) | |
2562 | CHARACTER*(*) FRAME,BEAM,TARGET | |
2563 | CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHLH(2)*6 | |
2564 | ||
2565 | C...Interface to PDFLIB. | |
81935ff8 | 2566 | COMMON/LW50512/QCDL4,QCDL5 |
2567 | SAVE /LW50512/ | |
2dfa57d1 | 2568 | DOUBLE PRECISION VALUE(20),QCDL4,QCDL5 |
2569 | CHARACTER*20 PARM(20) | |
2570 | DATA VALUE/20*0D0/,PARM/20*' '/ | |
2571 | ||
2572 | C...Data:Lambda and n_f values for parton distributions.. | |
2573 | DATA ALAMIN/0.177D0,0.239D0,0.247D0,0.2322D0,0.248D0,0.248D0, | |
2574 | &0.192D0,0.326D0,2*0.2D0,0.2D0,0.2D0,0.29D0,0.2D0,0.4D0,5*0.2D0/, | |
2575 | &NFIN/20*4/ | |
2576 | DATA CHLH/'lepton','hadron'/ | |
2577 | ||
2578 | C...Reset MINT and VINT arrays. Write headers. | |
2579 | MSTI(53)=0 | |
2580 | DO 100 J=1,400 | |
2581 | MINT(J)=0 | |
2582 | VINT(J)=0D0 | |
2583 | 100 CONTINUE | |
2584 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
2585 | IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) | |
2586 | ||
2587 | C...Call user process initialization routine. | |
2588 | IF(FRAME(1:1).EQ.'u'.OR.FRAME(1:1).EQ.'U') THEN | |
2589 | MSEL=0 | |
2590 | CALL UPINIT | |
2591 | MSEL=0 | |
2592 | ENDIF | |
2593 | ||
2594 | C...Maximum 4 generations; set maximum number of allowed flavours. | |
2595 | MSTP(1)=MIN(4,MSTP(1)) | |
2596 | MSTU(114)=MIN(MSTU(114),2*MSTP(1)) | |
2597 | MSTP(58)=MIN(MSTP(58),2*MSTP(1)) | |
2598 | ||
2599 | C...Sum up Cabibbo-Kobayashi-Maskawa factors for each quark/lepton. | |
2600 | DO 120 I=-20,20 | |
2601 | VINT(180+I)=0D0 | |
2602 | IA=IABS(I) | |
2603 | IF(IA.GE.1.AND.IA.LE.2*MSTP(1)) THEN | |
2604 | DO 110 J=1,MSTP(1) | |
2605 | IB=2*J-1+MOD(IA,2) | |
2606 | IF(IB.GE.6.AND.MSTP(9).EQ.0) GOTO 110 | |
2607 | IPM=(5-ISIGN(1,I))/2 | |
2608 | IDC=J+MDCY(IA,2)+2 | |
2609 | IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) VINT(180+I)= | |
2610 | & VINT(180+I)+VCKM((IA+1)/2,(IB+1)/2) | |
2611 | 110 CONTINUE | |
2612 | ELSEIF(IA.GE.11.AND.IA.LE.10+2*MSTP(1)) THEN | |
2613 | VINT(180+I)=1D0 | |
2614 | ENDIF | |
2615 | 120 CONTINUE | |
2616 | ||
2617 | C...Initialize parton distributions: PDFLIB. | |
2618 | IF(MSTP(52).EQ.2) THEN | |
2619 | PARM(1)='NPTYPE' | |
2620 | VALUE(1)=1 | |
2621 | PARM(2)='NGROUP' | |
2622 | VALUE(2)=MSTP(51)/1000 | |
2623 | PARM(3)='NSET' | |
2624 | VALUE(3)=MOD(MSTP(51),1000) | |
2625 | PARM(4)='TMAS' | |
2626 | VALUE(4)=PMAS(6,1) | |
2627 | CALL PDFSET_ALICE(PARM,VALUE) | |
2628 | MINT(93)=1000000+MSTP(51) | |
2629 | ENDIF | |
2630 | ||
2631 | C...Choose Lambda value to use in alpha-strong. | |
2632 | MSTU(111)=MSTP(2) | |
2633 | IF(MSTP(3).GE.2) THEN | |
2634 | ALAM=0.2D0 | |
2635 | NF=4 | |
2636 | IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.20) THEN | |
2637 | ALAM=ALAMIN(MSTP(51)) | |
2638 | NF=NFIN(MSTP(51)) | |
2639 | ELSEIF(MSTP(52).EQ.2) THEN | |
2640 | ALAM=QCDL4 | |
2641 | NF=4 | |
2642 | ENDIF | |
2643 | PARP(1)=ALAM | |
2644 | PARP(61)=ALAM | |
2645 | PARP(72)=ALAM | |
2646 | PARU(112)=ALAM | |
2647 | MSTU(112)=NF | |
2648 | IF(MSTP(3).EQ.3) PARJ(81)=ALAM | |
2649 | ENDIF | |
2650 | ||
2651 | C...Initialize the SUSY generation: couplings, masses, | |
2652 | C...decay modes, branching ratios, and so on. | |
2653 | CALL PYMSIN | |
2654 | C...Initialize widths and partial widths for resonances. | |
2655 | CALL PYINRE | |
2656 | C...Set Z0 mass and width for e+e- routines. | |
2657 | PARJ(123)=PMAS(23,1) | |
2658 | PARJ(124)=PMAS(23,2) | |
2659 | ||
2660 | C...Identify beam and target particles and frame of process. | |
2661 | CHFRAM=FRAME//' ' | |
2662 | CHBEAM=BEAM//' ' | |
2663 | CHTARG=TARGET//' ' | |
2664 | CALL PYINBM(CHFRAM,CHBEAM,CHTARG,WIN) | |
2665 | IF(MINT(65).EQ.1) GOTO 170 | |
2666 | ||
2667 | C...For gamma-p or gamma-gamma allow many (3 or 6) alternatives. | |
2668 | C...For e-gamma allow 2 alternatives. | |
2669 | MINT(121)=1 | |
2670 | IF(MSTP(14).EQ.10.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN | |
2671 | IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. | |
2672 | & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3 | |
2673 | IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=6 | |
2674 | IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. | |
2675 | & (IABS(MINT(11)).EQ.11.OR.IABS(MINT(12)).EQ.11)) MINT(121)=2 | |
2676 | ELSEIF(MSTP(14).EQ.20.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN | |
2677 | IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. | |
2678 | & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3 | |
2679 | IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=9 | |
2680 | ELSEIF(MSTP(14).EQ.25.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN | |
2681 | IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. | |
2682 | & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=2 | |
2683 | IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=4 | |
2684 | ELSEIF(MSTP(14).EQ.30.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN | |
2685 | IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. | |
2686 | & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=4 | |
2687 | IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=13 | |
2688 | ENDIF | |
2689 | MINT(123)=MSTP(14) | |
2690 | IF((MSTP(14).EQ.10.OR.MSTP(14).EQ.20.OR.MSTP(14).EQ.25.OR. | |
2691 | &MSTP(14).EQ.30).AND.MSEL.NE.1.AND.MSEL.NE.2) MINT(123)=0 | |
2692 | IF(MSTP(14).GE.11.AND.MSTP(14).LE.19) THEN | |
2693 | IF(MSTP(14).EQ.11) MINT(123)=0 | |
2694 | IF(MSTP(14).EQ.12.OR.MSTP(14).EQ.14) MINT(123)=5 | |
2695 | IF(MSTP(14).EQ.13.OR.MSTP(14).EQ.17) MINT(123)=6 | |
2696 | IF(MSTP(14).EQ.15) MINT(123)=2 | |
2697 | IF(MSTP(14).EQ.16.OR.MSTP(14).EQ.18) MINT(123)=7 | |
2698 | IF(MSTP(14).EQ.19) MINT(123)=3 | |
2699 | ELSEIF(MSTP(14).GE.21.AND.MSTP(14).LE.24) THEN | |
2700 | IF(MSTP(14).EQ.21) MINT(123)=0 | |
2701 | IF(MSTP(14).EQ.22.OR.MSTP(14).EQ.23) MINT(123)=4 | |
2702 | IF(MSTP(14).EQ.24) MINT(123)=1 | |
2703 | ELSEIF(MSTP(14).GE.26.AND.MSTP(14).LE.29) THEN | |
2704 | IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28) MINT(123)=8 | |
2705 | IF(MSTP(14).EQ.27.OR.MSTP(14).EQ.29) MINT(123)=9 | |
2706 | ENDIF | |
2707 | ||
2708 | C...Set up kinematics of process. | |
2709 | CALL PYINKI(0) | |
2710 | ||
2711 | C...Set up kinematics for photons inside leptons. | |
2712 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(1,WTGAGA) | |
2713 | ||
2714 | C...Precalculate flavour selection weights. | |
2715 | CALL PYKFIN | |
2716 | ||
2717 | C...Loop over gamma-p or gamma-gamma alternatives. | |
2718 | CKIN3=CKIN(3) | |
2719 | MSAV48=0 | |
2720 | DO 160 IGA=1,MINT(121) | |
2721 | CKIN(3)=CKIN3 | |
2722 | MINT(122)=IGA | |
2723 | ||
2724 | C...Select partonic subprocesses to be included in the simulation. | |
2725 | CALL PYINPR | |
2726 | MINT(101)=1 | |
2727 | MINT(102)=1 | |
2728 | MINT(103)=MINT(11) | |
2729 | MINT(104)=MINT(12) | |
2730 | ||
2731 | C...Count number of subprocesses on. | |
2732 | MINT(48)=0 | |
2733 | DO 130 ISUB=1,500 | |
2734 | IF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND. | |
2735 | & MSUB(ISUB).EQ.1.AND.MINT(121).GT.1) THEN | |
2736 | MSUB(ISUB)=0 | |
2737 | ELSEIF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND. | |
2738 | & MSUB(ISUB).EQ.1) THEN | |
2739 | WRITE(MSTU(11),5200) ISUB,CHLH(MINT(41)),CHLH(MINT(42)) | |
2740 | STOP | |
2741 | ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).EQ.-1) THEN | |
2742 | WRITE(MSTU(11),5300) ISUB | |
2743 | STOP | |
2744 | ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).LE.-2) THEN | |
2745 | WRITE(MSTU(11),5400) ISUB | |
2746 | STOP | |
2747 | ELSEIF(MSUB(ISUB).EQ.1) THEN | |
2748 | MINT(48)=MINT(48)+1 | |
2749 | ENDIF | |
2750 | 130 CONTINUE | |
2751 | ||
2752 | C...Stop or raise warning flag if no subprocesses on. | |
2753 | IF(MINT(121).EQ.1.AND.MINT(48).EQ.0) THEN | |
2754 | IF(MSTP(127).NE.1) THEN | |
2755 | WRITE(MSTU(11),5500) | |
2756 | STOP | |
2757 | ELSE | |
2758 | WRITE(MSTU(11),5700) | |
2759 | MSTI(53)=1 | |
2760 | ENDIF | |
2761 | ENDIF | |
2762 | MINT(49)=MINT(48)-MSUB(91)-MSUB(92)-MSUB(93)-MSUB(94) | |
2763 | MSAV48=MSAV48+MINT(48) | |
2764 | ||
2765 | C...Reset variables for cross-section calculation. | |
2766 | DO 150 I=0,500 | |
2767 | DO 140 J=1,3 | |
2768 | NGEN(I,J)=0 | |
2769 | XSEC(I,J)=0D0 | |
2770 | 140 CONTINUE | |
2771 | 150 CONTINUE | |
2772 | ||
2773 | C...Find parametrized total cross-sections. | |
2774 | CALL PYXTOT | |
2775 | VINT(318)=VINT(317) | |
2776 | ||
2777 | C...Maxima of differential cross-sections. | |
2778 | IF(MSTP(121).LE.1) CALL PYMAXI | |
2779 | ||
2780 | C...Initialize possibility of pileup events. | |
2781 | IF(MINT(121).GT.1) MSTP(131)=0 | |
2782 | IF(MSTP(131).NE.0) CALL PYPILE(1) | |
2783 | ||
2784 | C...Initialize multiple interactions with variable impact parameter. | |
2785 | IF(MINT(50).EQ.1) THEN | |
2786 | PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) | |
2787 | IF(MSTP(81).EQ.0.AND.CKIN(3).GT.PTMN) MSTP(82)=MIN(1,MSTP(82)) | |
2788 | IF((MINT(49).NE.0.OR.MSTP(131).NE.0).AND.MSTP(82).GE.2) | |
2789 | & CALL PYMULT(1) | |
2790 | ENDIF | |
2791 | ||
2792 | C...Save results for gamma-p and gamma-gamma alternatives. | |
2793 | IF(MINT(121).GT.1) CALL PYSAVE(1,IGA) | |
2794 | 160 CONTINUE | |
2795 | ||
2796 | C...Initialization finished. | |
2797 | IF(MSAV48.EQ.0) THEN | |
2798 | IF(MSTP(127).NE.1) THEN | |
2799 | WRITE(MSTU(11),5500) | |
2800 | STOP | |
2801 | ELSE | |
2802 | WRITE(MSTU(11),5700) | |
2803 | MSTI(53)=1 | |
2804 | ENDIF | |
2805 | ENDIF | |
2806 | 170 IF(MSTP(122).GE.1) WRITE(MSTU(11),5600) | |
2807 | ||
2808 | C...Formats for initialization information. | |
2809 | 5100 FORMAT('1',18('*'),1X,'PYINIT: initialization of PYTHIA ', | |
2810 | &'routines',1X,17('*')) | |
2811 | 5200 FORMAT(1X,'Error: process number ',I3,' not meaningful for ',A6, | |
2812 | &'-',A6,' interactions.'/1X,'Execution stopped!') | |
2813 | 5300 FORMAT(1X,'Error: requested subprocess',I4,' not implemented.'/ | |
2814 | &1X,'Execution stopped!') | |
2815 | 5400 FORMAT(1X,'Error: requested subprocess',I4,' not existing.'/ | |
2816 | &1X,'Execution stopped!') | |
2817 | 5500 FORMAT(1X,'Error: no subprocess switched on.'/ | |
2818 | &1X,'Execution stopped.') | |
2819 | 5600 FORMAT(/1X,22('*'),1X,'PYINIT: initialization completed',1X, | |
2820 | &22('*')) | |
2821 | 5700 FORMAT(1X,'Error: no subprocess switched on.'/ | |
2822 | &1X,'Execution will stop if you try to generate events.') | |
2823 | ||
2824 | RETURN | |
2825 | END | |
2826 | ||
2827 | C********************************************************************* | |
2828 | ||
2829 | C...PYEVNT | |
2830 | C...Administers the generation of a high-pT event via calls to | |
2831 | C...a number of subroutines. | |
2832 | ||
2833 | SUBROUTINE PYEVNT | |
2834 | ||
2835 | C...Double precision and integer declarations. | |
2836 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
2837 | IMPLICIT INTEGER(I-N) | |
2838 | INTEGER PYK,PYCHGE,PYCOMP | |
2839 | C...Commonblocks. | |
2840 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
2841 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
2842 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
2843 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
2844 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
2845 | COMMON/PYINT1/MINT(400),VINT(400) | |
2846 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
2847 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
2848 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
2849 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/, | |
2850 | &/PYINT2/,/PYINT4/,/PYINT5/ | |
2851 | C...Local array. | |
2852 | DIMENSION VTX(4) | |
2853 | ||
2854 | C...Stop if no subprocesses on. | |
2855 | IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN | |
2856 | WRITE(MSTU(11),5100) | |
2857 | STOP | |
2858 | ENDIF | |
bf6cd108 | 2859 | |
2dfa57d1 | 2860 | C...Initial values for some counters. |
2861 | N=0 | |
2862 | MINT(5)=MINT(5)+1 | |
2863 | MINT(7)=0 | |
2864 | MINT(8)=0 | |
2865 | MINT(83)=0 | |
2866 | MINT(84)=MSTP(126) | |
2867 | MSTU(24)=0 | |
2868 | MSTU70=0 | |
2869 | MSTJ14=MSTJ(14) | |
2870 | ||
2871 | C...If variable energies: redo incoming kinematics and cross-section. | |
2872 | MSTI(61)=0 | |
2873 | IF(MSTP(171).EQ.1) THEN | |
2874 | CALL PYINKI(1) | |
2875 | IF(MSTI(61).EQ.1) THEN | |
2876 | MINT(5)=MINT(5)-1 | |
2877 | RETURN | |
2878 | ENDIF | |
2879 | IF(MINT(121).GT.1) CALL PYSAVE(3,1) | |
2880 | CALL PYXTOT | |
2881 | ENDIF | |
2882 | ||
2883 | C...Loop over number of pileup events; check space left. | |
2884 | IF(MSTP(131).LE.0) THEN | |
2885 | NPILE=1 | |
2886 | ELSE | |
2887 | CALL PYPILE(2) | |
2888 | NPILE=MINT(81) | |
2889 | ENDIF | |
2890 | DO 250 IPILE=1,NPILE | |
2891 | IF(MINT(84)+100.GE.MSTU(4)) THEN | |
2892 | CALL PYERRM(11, | |
2893 | & '(PYEVNT:) no more space in PYJETS for pileup events') | |
2894 | IF(MSTU(21).GE.1) GOTO 260 | |
2895 | ENDIF | |
2896 | MINT(82)=IPILE | |
2897 | ||
2898 | C...Generate variables of hard scattering. | |
2899 | MINT(51)=0 | |
2900 | MSTI(52)=0 | |
2901 | 100 CONTINUE | |
2902 | IF(MINT(51).NE.0.OR.MSTU(24).NE.0) MSTI(52)=MSTI(52)+1 | |
2903 | MINT(31)=0 | |
2904 | MINT(51)=0 | |
2905 | MINT(57)=0 | |
2906 | CALL PYRAND | |
2907 | IF(MSTI(61).EQ.1) THEN | |
2908 | MINT(5)=MINT(5)-1 | |
2909 | RETURN | |
2910 | ENDIF | |
2911 | IF(MINT(51).EQ.2) RETURN | |
2912 | ISUB=MINT(1) | |
2913 | IF(MSTP(111).EQ.-1) GOTO 240 | |
2914 | ||
2915 | IF((ISUB.LE.90.OR.ISUB.GE.95).AND.ISUB.NE.99) THEN | |
2916 | C...Hard scattering (including low-pT): | |
2917 | C...reconstruct kinematics and colour flow of hard scattering. | |
2918 | MINT31=MINT(31) | |
2919 | 110 MINT(31)=MINT31 | |
2920 | MINT(51)=0 | |
2921 | CALL PYSCAT | |
2922 | IF(MINT(51).EQ.1) GOTO 100 | |
2923 | IPU1=MINT(84)+1 | |
2924 | IPU2=MINT(84)+2 | |
2925 | IF(ISUB.EQ.95) GOTO 120 | |
2926 | ||
2927 | C...Showering of initial state partons (optional). | |
2928 | NFIN=N | |
2929 | ALAMSV=PARJ(81) | |
2930 | PARJ(81)=PARP(72) | |
2931 | IF(MSTP(61).GE.1.AND.MINT(47).GE.2) CALL PYSSPA(IPU1,IPU2) | |
2932 | PARJ(81)=ALAMSV | |
2933 | IF(MINT(51).EQ.1) GOTO 100 | |
2934 | ||
2935 | C...Showering of final state partons (optional). | |
2936 | ALAMSV=PARJ(81) | |
2937 | PARJ(81)=PARP(72) | |
2938 | IF(MSTP(71).GE.1.AND.ISET(ISUB).GE.2.AND.ISET(ISUB).LE.10) | |
2939 | & THEN | |
2940 | IPU3=MINT(84)+3 | |
2941 | IPU4=MINT(84)+4 | |
2942 | IF(ISET(ISUB).EQ.5) IPU4=-3 | |
2943 | QMAX=VINT(55) | |
2944 | IF(ISET(ISUB).EQ.2) QMAX=SQRT(PARP(71))*VINT(55) | |
2945 | CALL PYSHOW(IPU3,IPU4,QMAX) | |
2946 | ELSEIF(ISET(ISUB).EQ.11) THEN | |
2947 | CALL PYADSH(NFIN) | |
2948 | ENDIF | |
2949 | PARJ(81)=ALAMSV | |
2950 | ||
2951 | C...Decay of final state resonances. | |
2952 | MINT(32)=0 | |
2953 | IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10) CALL PYRESD(0) | |
2954 | IF(MINT(51).EQ.1) GOTO 100 | |
2955 | MINT(52)=N | |
2956 | ||
2957 | C...Multiple interactions. | |
2958 | IF(MSTP(81).GE.1.AND.MINT(50).EQ.1) CALL PYMULT(6) | |
2959 | MINT(53)=N | |
2960 | ||
2961 | C...Hadron remnants and primordial kT. | |
2962 | 120 CALL PYREMN(IPU1,IPU2) | |
2963 | IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) GOTO 110 | |
2964 | IF(MINT(51).EQ.1) GOTO 100 | |
2965 | ||
2966 | ELSEIF(ISUB.NE.99) THEN | |
2967 | C...Diffractive and elastic scattering. | |
2968 | CALL PYDIFF | |
2969 | ||
2970 | ELSE | |
2971 | C...DIS scattering (photon flux external). | |
2972 | CALL PYDISG | |
2973 | IF(MINT(51).EQ.1) GOTO 100 | |
2974 | ENDIF | |
2975 | ||
2976 | C...Check that no odd resonance left undecayed. | |
2977 | IF(MSTP(111).GE.1) THEN | |
2978 | NFIX=N | |
2979 | DO 130 I=MINT(84)+1,NFIX | |
2980 | IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND. | |
2981 | & K(I,2).NE.22) THEN | |
2982 | KCA=PYCOMP(K(I,2)) | |
2983 | IF(MWID(KCA).NE.0.AND.MDCY(KCA,1).GE.1) THEN | |
2984 | CALL PYRESD(I) | |
2985 | IF(MINT(51).EQ.1) GOTO 100 | |
2986 | ENDIF | |
2987 | ENDIF | |
2988 | 130 CONTINUE | |
2989 | ENDIF | |
2990 | ||
2991 | C...Boost hadronic subsystem to overall rest frame. | |
2992 | C..(Only relevant when photon inside lepton beam.) | |
2993 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(4,WTGAGA) | |
2994 | ||
2995 | C...Recalculate energies from momenta and masses (if desired). | |
2996 | IF(MSTP(113).GE.1) THEN | |
2997 | DO 140 I=MINT(83)+1,N | |
2998 | IF(K(I,1).GT.0.AND.K(I,1).LE.10) P(I,4)=SQRT(P(I,1)**2+ | |
2999 | & P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
3000 | 140 CONTINUE | |
3001 | NRECAL=N | |
3002 | ENDIF | |
3003 | ||
3004 | C...Rearrange partons along strings, check invariant mass cuts. | |
3005 | MSTU(28)=0 | |
3006 | IF(MSTP(111).LE.0) MSTJ(14)=-1 | |
3007 | CALL PYPREP(MINT(84)+1) | |
3008 | MSTJ(14)=MSTJ14 | |
3009 | IF(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100 | |
3010 | IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN | |
3011 | DO 170 I=MINT(84)+1,N | |
3012 | IF(K(I,2).EQ.94) THEN | |
3013 | DO 160 I1=I+1,MIN(N,I+10) | |
3014 | IF(K(I1,3).EQ.I) THEN | |
3015 | K(I1,3)=MOD(K(I1,4)/MSTU(5),MSTU(5)) | |
3016 | IF(K(I1,3).EQ.0) THEN | |
3017 | DO 150 II=MINT(84)+1,I-1 | |
3018 | IF(K(II,2).EQ.K(I1,2)) THEN | |
3019 | IF(MOD(K(II,4),MSTU(5)).EQ.I1.OR. | |
3020 | & MOD(K(II,5),MSTU(5)).EQ.I1) K(I1,3)=II | |
3021 | ENDIF | |
3022 | 150 CONTINUE | |
3023 | IF(K(I+1,3).EQ.0) K(I+1,3)=K(I,3) | |
3024 | ENDIF | |
3025 | ENDIF | |
3026 | 160 CONTINUE | |
3027 | ENDIF | |
3028 | 170 CONTINUE | |
3029 | CALL PYEDIT(12) | |
3030 | CALL PYEDIT(14) | |
3031 | IF(MSTP(125).EQ.0) CALL PYEDIT(15) | |
3032 | IF(MSTP(125).EQ.0) MINT(4)=0 | |
3033 | DO 190 I=MINT(83)+1,N | |
3034 | IF(K(I,1).EQ.11.AND.K(I,4).EQ.0.AND.K(I,5).EQ.0) THEN | |
3035 | DO 180 I1=I+1,N | |
3036 | IF(K(I1,3).EQ.I.AND.K(I,4).EQ.0) K(I,4)=I1 | |
3037 | IF(K(I1,3).EQ.I) K(I,5)=I1 | |
3038 | 180 CONTINUE | |
3039 | ENDIF | |
3040 | 190 CONTINUE | |
3041 | ENDIF | |
3042 | ||
3043 | C...Introduce separators between sections in PYLIST event listing. | |
3044 | IF(IPILE.EQ.1.AND.MSTP(125).LE.0) THEN | |
3045 | MSTU70=1 | |
3046 | MSTU(71)=N | |
3047 | ELSEIF(IPILE.EQ.1) THEN | |
3048 | MSTU70=3 | |
3049 | MSTU(71)=2 | |
3050 | MSTU(72)=MINT(4) | |
3051 | MSTU(73)=N | |
3052 | ENDIF | |
3053 | ||
3054 | C...Go back to lab frame (needed for vertices, also in fragmentation). | |
3055 | CALL PYFRAM(1) | |
3056 | ||
3057 | C...Set nonvanishing production vertex (optional). | |
3058 | IF(MSTP(151).EQ.1) THEN | |
3059 | DO 200 J=1,4 | |
3060 | VTX(J)=PARP(150+J)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0))))* | |
3061 | & SIN(PARU(2)*PYR(0)) | |
3062 | 200 CONTINUE | |
3063 | DO 220 I=MINT(83)+1,N | |
3064 | DO 210 J=1,4 | |
3065 | V(I,J)=V(I,J)+VTX(J) | |
3066 | 210 CONTINUE | |
3067 | 220 CONTINUE | |
3068 | ENDIF | |
3069 | ||
3070 | C...Perform hadronization (if desired). | |
3071 | IF(MSTP(111).GE.1) THEN | |
3072 | CALL PYEXEC | |
3073 | IF(MSTU(24).NE.0) GOTO 100 | |
3074 | ENDIF | |
3075 | IF(MSTP(113).GE.1) THEN | |
3076 | DO 230 I=NRECAL,N | |
3077 | IF(P(I,5).GT.0D0) P(I,4)=SQRT(P(I,1)**2+ | |
3078 | & P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
3079 | 230 CONTINUE | |
3080 | ENDIF | |
3081 | IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) CALL PYEDIT(14) | |
3082 | ||
3083 | C...Store event information and calculate Monte Carlo estimates of | |
3084 | C...subprocess cross-sections. | |
3085 | 240 IF(IPILE.EQ.1) CALL PYDOCU | |
3086 | ||
3087 | C...Set counters for current pileup event and loop to next one. | |
3088 | MSTI(41)=IPILE | |
3089 | IF(IPILE.GE.2.AND.IPILE.LE.10) MSTI(40+IPILE)=ISUB | |
3090 | IF(MSTU70.LT.10) THEN | |
3091 | MSTU70=MSTU70+1 | |
3092 | MSTU(70+MSTU70)=N | |
3093 | ENDIF | |
3094 | MINT(83)=N | |
3095 | MINT(84)=N+MSTP(126) | |
3096 | IF(IPILE.LT.NPILE) CALL PYFRAM(2) | |
3097 | 250 CONTINUE | |
3098 | ||
3099 | C...Generic information on pileup events. Reconstruct missing history. | |
3100 | IF(MSTP(131).EQ.1.AND.MSTP(133).GE.1) THEN | |
3101 | PARI(91)=VINT(132) | |
3102 | PARI(92)=VINT(133) | |
3103 | PARI(93)=VINT(134) | |
3104 | IF(MSTP(133).GE.2) PARI(93)=PARI(93)*XSEC(0,3)/VINT(131) | |
3105 | ENDIF | |
3106 | CALL PYEDIT(16) | |
3107 | ||
3108 | C...Transform to the desired coordinate frame. | |
3109 | 260 CALL PYFRAM(MSTP(124)) | |
3110 | MSTU(70)=MSTU70 | |
3111 | PARU(21)=VINT(1) | |
3112 | ||
3113 | C...Error messages | |
3114 | 5100 FORMAT(1X,'Error: no subprocess switched on.'/ | |
3115 | &1X,'Execution stopped.') | |
3116 | ||
3117 | RETURN | |
3118 | END | |
3119 | ||
3120 | C*********************************************************************** | |
3121 | ||
3122 | C...PYSTAT | |
3123 | C...Prints out information about cross-sections, decay widths, branching | |
3124 | C...ratios, kinematical limits, status codes and parameter values. | |
3125 | ||
3126 | SUBROUTINE PYSTAT(MSTAT) | |
3127 | ||
3128 | C...Double precision and integer declarations. | |
3129 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
3130 | IMPLICIT INTEGER(I-N) | |
3131 | INTEGER PYK,PYCHGE,PYCOMP | |
3132 | C...Parameter statement to help give large particle numbers. | |
3133 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
3134 | &KEXCIT=4000000,KDIMEN=5000000) | |
3135 | PARAMETER (EPS=1D-3) | |
3136 | C...Commonblocks. | |
3137 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
3138 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
3139 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
3140 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
3141 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
3142 | COMMON/PYINT1/MINT(400),VINT(400) | |
3143 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
3144 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
3145 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
3146 | COMMON/PYINT6/PROC(0:500) | |
3147 | CHARACTER PROC*28, CHTMP*16 | |
3148 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
3149 | COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) | |
3150 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
3151 | &/PYINT2/,/PYINT4/,/PYINT5/,/PYINT6/,/PYMSSM/,/PYMSRV/ | |
3152 | C...Local arrays, character variables and data. | |
3153 | DIMENSION WDTP(0:400),WDTE(0:400,0:5),NMODES(0:20),PBRAT(10) | |
3154 | CHARACTER PROGA(6)*28,CHAU*16,CHKF*16,CHD1*16,CHD2*16,CHD3*16, | |
3155 | &CHIN(2)*12,STATE(-1:5)*4,CHKIN(21)*18,DISGA(2)*28, | |
3156 | &PROGG9(13)*28,PROGG4(4)*28,PROGG2(2)*28,PROGP4(4)*28 | |
3157 | CHARACTER*24 CHD0, CHDC(10) | |
3158 | CHARACTER*6 DNAME(3) | |
3159 | DATA PROGA/ | |
3160 | &'VMD/hadron * VMD ','VMD/hadron * direct ', | |
3161 | &'VMD/hadron * anomalous ','direct * direct ', | |
3162 | &'direct * anomalous ','anomalous * anomalous '/ | |
3163 | DATA DISGA/'e * VMD','e * anomalous'/ | |
3164 | DATA PROGG9/ | |
3165 | &'direct * direct ','direct * VMD ', | |
3166 | &'direct * anomalous ','VMD * direct ', | |
3167 | &'VMD * VMD ','VMD * anomalous ', | |
3168 | &'anomalous * direct ','anomalous * VMD ', | |
3169 | &'anomalous * anomalous ','DIS * VMD ', | |
3170 | &'DIS * anomalous ','VMD * DIS ', | |
3171 | &'anomalous * DIS '/ | |
3172 | DATA PROGG4/ | |
3173 | &'direct * direct ','direct * resolved ', | |
3174 | &'resolved * direct ','resolved * resolved '/ | |
3175 | DATA PROGG2/ | |
3176 | &'direct * hadron ','resolved * hadron '/ | |
3177 | DATA PROGP4/ | |
3178 | &'VMD * hadron ','direct * hadron ', | |
3179 | &'anomalous * hadron ','DIS * hadron '/ | |
3180 | DATA STATE/'----','off ','on ','on/+','on/-','on/1','on/2'/, | |
3181 | &CHKIN/' m_hard (GeV/c^2) ',' p_T_hard (GeV/c) ', | |
3182 | &'m_finite (GeV/c^2)',' y*_subsystem ',' y*_large ', | |
3183 | &' y*_small ',' eta*_large ',' eta*_small ', | |
3184 | &'cos(theta*)_large ','cos(theta*)_small ',' x_1 ', | |
3185 | &' x_2 ',' x_F ',' cos(theta_hard) ', | |
3186 | &'m''_hard (GeV/c^2) ',' tau ',' y* ', | |
3187 | &'cos(theta_hard^-) ','cos(theta_hard^+) ',' x_T^2 ', | |
3188 | &' tau'' '/ | |
3189 | DATA DNAME /'q ','lepton','nu '/ | |
3190 | ||
3191 | C...Cross-sections. | |
3192 | IF(MSTAT.LE.1) THEN | |
3193 | IF(MINT(121).GT.1) CALL PYSAVE(5,0) | |
3194 | WRITE(MSTU(11),5000) | |
3195 | WRITE(MSTU(11),5100) | |
3196 | WRITE(MSTU(11),5200) 0,PROC(0),NGEN(0,3),NGEN(0,1),XSEC(0,3) | |
3197 | DO 100 I=1,500 | |
3198 | IF(MSUB(I).NE.1) GOTO 100 | |
3199 | WRITE(MSTU(11),5200) I,PROC(I),NGEN(I,3),NGEN(I,1),XSEC(I,3) | |
3200 | 100 CONTINUE | |
3201 | IF(MINT(121).GT.1) THEN | |
3202 | WRITE(MSTU(11),5300) | |
3203 | DO 110 IGA=1,MINT(121) | |
3204 | CALL PYSAVE(3,IGA) | |
3205 | IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN | |
3206 | WRITE(MSTU(11),5200) IGA,DISGA(IGA),NGEN(0,3),NGEN(0,1), | |
3207 | & XSEC(0,3) | |
3208 | ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN | |
3209 | WRITE(MSTU(11),5200) IGA,PROGG9(IGA),NGEN(0,3),NGEN(0,1), | |
3210 | & XSEC(0,3) | |
3211 | ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.30) THEN | |
3212 | WRITE(MSTU(11),5200) IGA,PROGP4(IGA),NGEN(0,3),NGEN(0,1), | |
3213 | & XSEC(0,3) | |
3214 | ELSEIF(MINT(121).EQ.4) THEN | |
3215 | WRITE(MSTU(11),5200) IGA,PROGG4(IGA),NGEN(0,3),NGEN(0,1), | |
3216 | & XSEC(0,3) | |
3217 | ELSEIF(MINT(121).EQ.2) THEN | |
3218 | WRITE(MSTU(11),5200) IGA,PROGG2(IGA),NGEN(0,3),NGEN(0,1), | |
3219 | & XSEC(0,3) | |
3220 | ELSE | |
3221 | WRITE(MSTU(11),5200) IGA,PROGA(IGA),NGEN(0,3),NGEN(0,1), | |
3222 | & XSEC(0,3) | |
3223 | ENDIF | |
3224 | 110 CONTINUE | |
3225 | CALL PYSAVE(5,0) | |
3226 | ENDIF | |
3227 | WRITE(MSTU(11),5400) 1D0-DBLE(NGEN(0,3))/ | |
3228 | & MAX(1D0,DBLE(NGEN(0,2))) | |
3229 | ||
3230 | C...Decay widths and branching ratios. | |
3231 | ELSEIF(MSTAT.EQ.2) THEN | |
3232 | WRITE(MSTU(11),5500) | |
3233 | WRITE(MSTU(11),5600) | |
3234 | DO 140 KC=1,500 | |
3235 | KF=KCHG(KC,4) | |
3236 | CALL PYNAME(KF,CHKF) | |
3237 | IOFF=0 | |
3238 | IF(KC.LE.22) THEN | |
3239 | IF(KC.GT.2*MSTP(1).AND.KC.LE.10) GOTO 140 | |
3240 | IF(KC.GT.10+2*MSTP(1).AND.KC.LE.20) GOTO 140 | |
3241 | IF(KC.LE.5.OR.(KC.GE.11.AND.KC.LE.16)) IOFF=1 | |
3242 | IF(KC.EQ.18.AND.PMAS(18,1).LT.1D0) IOFF=1 | |
3243 | IF(KC.EQ.21.OR.KC.EQ.22) IOFF=1 | |
3244 | ELSE | |
3245 | IF(MWID(KC).LE.0) GOTO 140 | |
3246 | IF(IMSS(1).LE.0.AND.(KF/KSUSY1.EQ.1.OR. | |
3247 | & KF/KSUSY1.EQ.2)) GOTO 140 | |
3248 | ENDIF | |
3249 | C...Off-shell branchings. | |
3250 | IF(IOFF.EQ.1) THEN | |
3251 | NGP=0 | |
3252 | IF(KC.LE.20) NGP=(MOD(KC,10)+1)/2 | |
3253 | IF(NGP.LE.MSTP(1)) WRITE(MSTU(11),5700) KF,CHKF(1:10), | |
3254 | & PMAS(KC,1),0D0,0D0,STATE(MDCY(KC,1)),0D0 | |
3255 | DO 120 J=1,MDCY(KC,3) | |
3256 | IDC=J+MDCY(KC,2)-1 | |
3257 | NGP1=0 | |
3258 | IF(IABS(KFDP(IDC,1)).LE.20) NGP1= | |
3259 | & (MOD(IABS(KFDP(IDC,1)),10)+1)/2 | |
3260 | NGP2=0 | |
3261 | IF(IABS(KFDP(IDC,2)).LE.20) NGP2= | |
3262 | & (MOD(IABS(KFDP(IDC,2)),10)+1)/2 | |
3263 | CALL PYNAME(KFDP(IDC,1),CHD1) | |
3264 | CALL PYNAME(KFDP(IDC,2),CHD2) | |
3265 | IF(KFDP(IDC,3).EQ.0) THEN | |
3266 | IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND. | |
3267 | & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5800) IDC,CHD1(1:10), | |
3268 | & CHD2(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0 | |
3269 | ELSE | |
3270 | CALL PYNAME(KFDP(IDC,3),CHD3) | |
3271 | IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND. | |
3272 | & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5900) IDC,CHD1(1:10), | |
3273 | & CHD2(1:10),CHD3(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0 | |
3274 | ENDIF | |
3275 | 120 CONTINUE | |
3276 | C...On-shell decays. | |
3277 | ELSE | |
3278 | CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE) | |
3279 | BRFIN=1D0 | |
3280 | IF(WDTE(0,0).LE.0D0) BRFIN=0D0 | |
3281 | WRITE(MSTU(11),5700) KF,CHKF(1:10),PMAS(KC,1),WDTP(0),1D0, | |
3282 | & STATE(MDCY(KC,1)),BRFIN | |
3283 | DO 130 J=1,MDCY(KC,3) | |
3284 | IDC=J+MDCY(KC,2)-1 | |
3285 | NGP1=0 | |
3286 | IF(IABS(KFDP(IDC,1)).LE.20) NGP1= | |
3287 | & (MOD(IABS(KFDP(IDC,1)),10)+1)/2 | |
3288 | NGP2=0 | |
3289 | IF(IABS(KFDP(IDC,2)).LE.20) NGP2= | |
3290 | & (MOD(IABS(KFDP(IDC,2)),10)+1)/2 | |
3291 | BRFIN=0D0 | |
3292 | IF(WDTE(0,0).GT.0D0) BRFIN=WDTE(J,0)/WDTE(0,0) | |
3293 | CALL PYNAME(KFDP(IDC,1),CHD1) | |
3294 | CALL PYNAME(KFDP(IDC,2),CHD2) | |
3295 | IF(KFDP(IDC,3).EQ.0) THEN | |
3296 | IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1)) | |
3297 | & WRITE(MSTU(11),5800) IDC,CHD1(1:10), | |
3298 | & CHD2(1:10),WDTP(J),WDTP(J)/WDTP(0), | |
3299 | & STATE(MDME(IDC,1)),BRFIN | |
3300 | ELSE | |
3301 | CALL PYNAME(KFDP(IDC,3),CHD3) | |
3302 | IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1)) | |
3303 | & WRITE(MSTU(11),5900) IDC,CHD1(1:10), | |
3304 | & CHD2(1:10),CHD3(1:10),WDTP(J),WDTP(J)/WDTP(0), | |
3305 | & STATE(MDME(IDC,1)),BRFIN | |
3306 | ENDIF | |
3307 | 130 CONTINUE | |
3308 | ENDIF | |
3309 | 140 CONTINUE | |
3310 | WRITE(MSTU(11),6000) | |
3311 | ||
3312 | C...Allowed incoming partons/particles at hard interaction. | |
3313 | ELSEIF(MSTAT.EQ.3) THEN | |
3314 | WRITE(MSTU(11),6100) | |
3315 | CALL PYNAME(MINT(11),CHAU) | |
3316 | CHIN(1)=CHAU(1:12) | |
3317 | CALL PYNAME(MINT(12),CHAU) | |
3318 | CHIN(2)=CHAU(1:12) | |
3319 | WRITE(MSTU(11),6200) CHIN(1),CHIN(2) | |
3320 | DO 150 I=-20,22 | |
3321 | IF(I.EQ.0) GOTO 150 | |
3322 | IA=IABS(I) | |
3323 | IF(IA.GT.MSTP(58).AND.IA.LE.10) GOTO 150 | |
3324 | IF(IA.GT.10+2*MSTP(1).AND.IA.LE.20) GOTO 150 | |
3325 | CALL PYNAME(I,CHAU) | |
3326 | WRITE(MSTU(11),6300) CHAU,STATE(KFIN(1,I)),CHAU, | |
3327 | & STATE(KFIN(2,I)) | |
3328 | 150 CONTINUE | |
3329 | WRITE(MSTU(11),6400) | |
3330 | ||
3331 | C...User-defined limits on kinematical variables. | |
3332 | ELSEIF(MSTAT.EQ.4) THEN | |
3333 | WRITE(MSTU(11),6500) | |
3334 | WRITE(MSTU(11),6600) | |
3335 | SHRMAX=CKIN(2) | |
3336 | IF(SHRMAX.LT.0D0) SHRMAX=VINT(1) | |
3337 | WRITE(MSTU(11),6700) CKIN(1),CHKIN(1),SHRMAX | |
3338 | PTHMIN=MAX(CKIN(3),CKIN(5)) | |
3339 | PTHMAX=CKIN(4) | |
3340 | IF(PTHMAX.LT.0D0) PTHMAX=0.5D0*SHRMAX | |
3341 | WRITE(MSTU(11),6800) CKIN(3),PTHMIN,CHKIN(2),PTHMAX | |
3342 | WRITE(MSTU(11),6900) CHKIN(3),CKIN(6) | |
3343 | DO 160 I=4,14 | |
3344 | WRITE(MSTU(11),6700) CKIN(2*I-1),CHKIN(I),CKIN(2*I) | |
3345 | 160 CONTINUE | |
3346 | SPRMAX=CKIN(32) | |
3347 | IF(SPRMAX.LT.0D0) SPRMAX=VINT(1) | |
3348 | WRITE(MSTU(11),6700) CKIN(31),CHKIN(15),SPRMAX | |
3349 | WRITE(MSTU(11),7000) | |
3350 | ||
3351 | C...Status codes and parameter values. | |
3352 | ELSEIF(MSTAT.EQ.5) THEN | |
3353 | WRITE(MSTU(11),7100) | |
3354 | WRITE(MSTU(11),7200) | |
3355 | DO 170 I=1,100 | |
3356 | WRITE(MSTU(11),7300) I,MSTP(I),PARP(I),100+I,MSTP(100+I), | |
3357 | & PARP(100+I) | |
3358 | 170 CONTINUE | |
3359 | ||
3360 | C...List of all processes implemented in the program. | |
3361 | ELSEIF(MSTAT.EQ.6) THEN | |
3362 | WRITE(MSTU(11),7400) | |
3363 | WRITE(MSTU(11),7500) | |
3364 | DO 180 I=1,500 | |
3365 | IF(ISET(I).LT.0) GOTO 180 | |
3366 | WRITE(MSTU(11),7600) I,PROC(I),ISET(I),KFPR(I,1),KFPR(I,2) | |
3367 | 180 CONTINUE | |
3368 | WRITE(MSTU(11),7700) | |
3369 | ||
3370 | ELSEIF(MSTAT.EQ.7) THEN | |
3371 | WRITE (MSTU(11),8000) | |
3372 | NMODES(0)=0 | |
3373 | NMODES(10)=0 | |
3374 | NMODES(9)=0 | |
3375 | DO 290 ILR=1,2 | |
3376 | DO 280 KFSM=1,16 | |
3377 | KFSUSY=ILR*KSUSY1+KFSM | |
3378 | NRVDC=0 | |
3379 | C...SDOWN DECAYS | |
3380 | IF (KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5) THEN | |
3381 | NRVDC=3 | |
3382 | DO 190 I=1,NRVDC | |
3383 | PBRAT(I)=0D0 | |
3384 | NMODES(I)=0 | |
3385 | 190 CONTINUE | |
3386 | CALL PYNAME(KFSUSY,CHTMP) | |
3387 | CHD0=CHTMP//' ' | |
3388 | CHDC(1)=DNAME(3) // ' + ' // DNAME(1) | |
3389 | CHDC(2)=DNAME(2) // ' + ' // DNAME(1) | |
3390 | CHDC(3)=DNAME(1) // ' + ' // DNAME(1) | |
3391 | KC=PYCOMP(KFSUSY) | |
3392 | DO 200 J=1,MDCY(KC,3) | |
3393 | IDC=J+MDCY(KC,2)-1 | |
3394 | ID1=IABS(KFDP(IDC,1)) | |
3395 | ID2=IABS(KFDP(IDC,2)) | |
3396 | IF (KFDP(IDC,3).EQ.0) THEN | |
3397 | IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 | |
3398 | & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN | |
3399 | PBRAT(1)=PBRAT(1)+BRAT(IDC) | |
3400 | NMODES(1)=NMODES(1)+1 | |
3401 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3402 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3403 | ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND | |
3404 | & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6)) THEN | |
3405 | PBRAT(2)=PBRAT(2)+BRAT(IDC) | |
3406 | NMODES(2)=NMODES(2)+1 | |
3407 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3408 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3409 | ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND | |
3410 | & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN | |
3411 | PBRAT(3)=PBRAT(3)+BRAT(IDC) | |
3412 | NMODES(3)=NMODES(3)+1 | |
3413 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3414 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3415 | ENDIF | |
3416 | ENDIF | |
3417 | 200 CONTINUE | |
3418 | ENDIF | |
3419 | C...SUP DECAYS | |
3420 | IF (KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6) THEN | |
3421 | NRVDC=2 | |
3422 | DO 210 I=1,NRVDC | |
3423 | NMODES(I)=0 | |
3424 | PBRAT(I)=0D0 | |
3425 | 210 CONTINUE | |
3426 | CALL PYNAME(KFSUSY,CHTMP) | |
3427 | CHD0=CHTMP//' ' | |
3428 | CHDC(1)=DNAME(2) // ' + ' // DNAME(1) | |
3429 | CHDC(2)=DNAME(1) // ' + ' // DNAME(1) | |
3430 | KC=PYCOMP(KFSUSY) | |
3431 | DO 220 J=1,MDCY(KC,3) | |
3432 | IDC=J+MDCY(KC,2)-1 | |
3433 | ID1=IABS(KFDP(IDC,1)) | |
3434 | ID2=IABS(KFDP(IDC,2)) | |
3435 | IF (KFDP(IDC,3).EQ.0) THEN | |
3436 | IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2 | |
3437 | & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN | |
3438 | PBRAT(1)=PBRAT(1)+BRAT(IDC) | |
3439 | NMODES(1)=NMODES(1)+1 | |
3440 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3441 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3442 | ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2 | |
3443 | & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN | |
3444 | PBRAT(2)=PBRAT(2)+BRAT(IDC) | |
3445 | NMODES(2)=NMODES(2)+1 | |
3446 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3447 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3448 | ENDIF | |
3449 | ENDIF | |
3450 | 220 CONTINUE | |
3451 | ENDIF | |
3452 | C...SLEPTON DECAYS | |
3453 | IF (KFSM.EQ.11.OR.KFSM.EQ.13.OR.KFSM.EQ.15) THEN | |
3454 | NRVDC=2 | |
3455 | DO 230 I=1,NRVDC | |
3456 | PBRAT(I)=0D0 | |
3457 | NMODES(I)=0 | |
3458 | 230 CONTINUE | |
3459 | CALL PYNAME(KFSUSY,CHTMP) | |
3460 | CHD0=CHTMP//' ' | |
3461 | CHDC(1)=DNAME(3) // ' + ' // DNAME(2) | |
3462 | CHDC(2)=DNAME(1) // ' + ' // DNAME(1) | |
3463 | KC=PYCOMP(KFSUSY) | |
3464 | DO 240 J=1,MDCY(KC,3) | |
3465 | IDC=J+MDCY(KC,2)-1 | |
3466 | ID1=IABS(KFDP(IDC,1)) | |
3467 | ID2=IABS(KFDP(IDC,2)) | |
3468 | IF (KFDP(IDC,3).EQ.0) THEN | |
3469 | IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 | |
3470 | & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN | |
3471 | PBRAT(1)=PBRAT(1)+BRAT(IDC) | |
3472 | NMODES(1)=NMODES(1)+1 | |
3473 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3474 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3475 | ENDIF | |
3476 | IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND.(ID2 | |
3477 | & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN | |
3478 | PBRAT(2)=PBRAT(2)+BRAT(IDC) | |
3479 | NMODES(2)=NMODES(2)+1 | |
3480 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3481 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3482 | ENDIF | |
3483 | ENDIF | |
3484 | 240 CONTINUE | |
3485 | ENDIF | |
3486 | C...SNEUTRINO DECAYS | |
3487 | IF ((KFSM.EQ.12.OR.KFSM.EQ.14.OR.KFSM.EQ.16).AND.ILR.EQ.1) | |
3488 | & THEN | |
3489 | NRVDC=2 | |
3490 | DO 250 I=1,NRVDC | |
3491 | PBRAT(I)=0D0 | |
3492 | NMODES(I)=0 | |
3493 | 250 CONTINUE | |
3494 | CALL PYNAME(KFSUSY,CHTMP) | |
3495 | CHD0=CHTMP//' ' | |
3496 | CHDC(1)=DNAME(2) // ' + ' // DNAME(2) | |
3497 | CHDC(2)=DNAME(1) // ' + ' // DNAME(1) | |
3498 | KC=PYCOMP(KFSUSY) | |
3499 | DO 260 J=1,MDCY(KC,3) | |
3500 | IDC=J+MDCY(KC,2)-1 | |
3501 | ID1=IABS(KFDP(IDC,1)) | |
3502 | ID2=IABS(KFDP(IDC,2)) | |
3503 | IF (KFDP(IDC,3).EQ.0) THEN | |
3504 | IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2 | |
3505 | & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN | |
3506 | PBRAT(1)=PBRAT(1)+BRAT(IDC) | |
3507 | NMODES(1)=NMODES(1)+1 | |
3508 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3509 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3510 | ENDIF | |
3511 | IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2 | |
3512 | & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN | |
3513 | NMODES(2)=NMODES(2)+1 | |
3514 | PBRAT(2)=PBRAT(2)+BRAT(IDC) | |
3515 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3516 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3517 | ENDIF | |
3518 | ENDIF | |
3519 | 260 CONTINUE | |
3520 | ENDIF | |
3521 | IF (NRVDC.NE.0) THEN | |
3522 | DO 270 I=1,NRVDC | |
3523 | WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I) | |
3524 | NMODES(0)=NMODES(0)+NMODES(I) | |
3525 | 270 CONTINUE | |
3526 | ENDIF | |
3527 | 280 CONTINUE | |
3528 | 290 CONTINUE | |
3529 | DO 370 KFSM=21,37 | |
3530 | KFSUSY=KSUSY1+KFSM | |
3531 | NRVDC=0 | |
3532 | C...NEUTRALINO DECAYS | |
3533 | IF (KFSM.EQ.22.OR.KFSM.EQ.23.OR.KFSM.EQ.25.OR.KFSM.EQ.35) THEN | |
3534 | NRVDC=4 | |
3535 | DO 300 I=1,NRVDC | |
3536 | PBRAT(I)=0D0 | |
3537 | NMODES(I)=0 | |
3538 | 300 CONTINUE | |
3539 | CALL PYNAME(KFSUSY,CHTMP) | |
3540 | CHD0=CHTMP//' ' | |
3541 | CHDC(1)=DNAME(3) // ' + ' // DNAME(2) // ' + ' // DNAME(2) | |
3542 | CHDC(2)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) | |
3543 | CHDC(3)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) | |
3544 | CHDC(4)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) | |
3545 | KC=PYCOMP(KFSUSY) | |
3546 | DO 310 J=1,MDCY(KC,3) | |
3547 | IDC=J+MDCY(KC,2)-1 | |
3548 | ID1=IABS(KFDP(IDC,1)) | |
3549 | ID2=IABS(KFDP(IDC,2)) | |
3550 | ID3=IABS(KFDP(IDC,3)) | |
3551 | IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 | |
3552 | & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.11.OR | |
3553 | & .ID3.EQ.13.OR.ID3.EQ.15)) THEN | |
3554 | PBRAT(1)=PBRAT(1)+BRAT(IDC) | |
3555 | NMODES(1)=NMODES(1)+1 | |
3556 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3557 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3558 | ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND | |
3559 | & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 | |
3560 | & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3561 | PBRAT(2)=PBRAT(2)+BRAT(IDC) | |
3562 | NMODES(2)=NMODES(2)+1 | |
3563 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3564 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3565 | ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND | |
3566 | & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1 | |
3567 | & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3568 | PBRAT(3)=PBRAT(3)+BRAT(IDC) | |
3569 | NMODES(3)=NMODES(3)+1 | |
3570 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3571 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3572 | ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND | |
3573 | & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 | |
3574 | & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3575 | PBRAT(4)=PBRAT(4)+BRAT(IDC) | |
3576 | NMODES(4)=NMODES(4)+1 | |
3577 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3578 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3579 | ENDIF | |
3580 | 310 CONTINUE | |
3581 | ENDIF | |
3582 | C...CHARGINO DECAYS | |
3583 | IF (KFSM.EQ.24.OR.KFSM.EQ.37) THEN | |
3584 | NRVDC=5 | |
3585 | DO 320 I=1,NRVDC | |
3586 | PBRAT(I)=0D0 | |
3587 | NMODES(I)=0 | |
3588 | 320 CONTINUE | |
3589 | CALL PYNAME(KFSUSY,CHTMP) | |
3590 | CHD0=CHTMP//' ' | |
3591 | CHDC(1)=DNAME(3) // ' + ' // DNAME(3) // ' + ' // DNAME(2) | |
3592 | CHDC(2)=DNAME(2) // ' + ' // DNAME(2) // ' + ' // DNAME(2) | |
3593 | CHDC(3)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) | |
3594 | CHDC(4)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) | |
3595 | CHDC(5)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) | |
3596 | KC=PYCOMP(KFSUSY) | |
3597 | DO 330 J=1,MDCY(KC,3) | |
3598 | IDC=J+MDCY(KC,2)-1 | |
3599 | ID1=IABS(KFDP(IDC,1)) | |
3600 | ID2=IABS(KFDP(IDC,2)) | |
3601 | ID3=IABS(KFDP(IDC,3)) | |
3602 | IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 | |
3603 | & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.12.OR | |
3604 | & .ID3.EQ.14.OR.ID3.EQ.16)) THEN | |
3605 | PBRAT(1)=PBRAT(1)+BRAT(IDC) | |
3606 | NMODES(1)=NMODES(1)+1 | |
3607 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3608 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3609 | ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND | |
3610 | & .(ID2.EQ.12.OR.ID2.EQ.14.OR.ID2.EQ.16).AND.(ID3.EQ | |
3611 | & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN | |
3612 | PBRAT(1)=PBRAT(1)+BRAT(IDC) | |
3613 | NMODES(1)=NMODES(1)+1 | |
3614 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3615 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3616 | ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND | |
3617 | & .(ID2.EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ | |
3618 | & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN | |
3619 | PBRAT(2)=PBRAT(2)+BRAT(IDC) | |
3620 | NMODES(2)=NMODES(2)+1 | |
3621 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3622 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3623 | ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND | |
3624 | & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ | |
3625 | & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN | |
3626 | PBRAT(3)=PBRAT(3)+BRAT(IDC) | |
3627 | NMODES(3)=NMODES(3)+1 | |
3628 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3629 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3630 | ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND | |
3631 | & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ | |
3632 | & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3633 | PBRAT(3)=PBRAT(3)+BRAT(IDC) | |
3634 | NMODES(3)=NMODES(3)+1 | |
3635 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3636 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3637 | ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND | |
3638 | & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ | |
3639 | & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN | |
3640 | PBRAT(4)=PBRAT(4)+BRAT(IDC) | |
3641 | NMODES(4)=NMODES(4)+1 | |
3642 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3643 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3644 | ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND | |
3645 | & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ | |
3646 | & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3647 | PBRAT(4)=PBRAT(4)+BRAT(IDC) | |
3648 | NMODES(4)=NMODES(4)+1 | |
3649 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3650 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3651 | ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND | |
3652 | & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ | |
3653 | & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3654 | PBRAT(5)=PBRAT(5)+BRAT(IDC) | |
3655 | NMODES(5)=NMODES(5)+1 | |
3656 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3657 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3658 | ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND | |
3659 | & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ | |
3660 | & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3661 | PBRAT(5)=PBRAT(5)+BRAT(IDC) | |
3662 | NMODES(5)=NMODES(5)+1 | |
3663 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3664 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3665 | ENDIF | |
3666 | 330 CONTINUE | |
3667 | ENDIF | |
3668 | C...GLUINO DECAYS | |
3669 | IF (KFSM.EQ.21) THEN | |
3670 | NRVDC=3 | |
3671 | DO 340 I=1,NRVDC | |
3672 | PBRAT(I)=0D0 | |
3673 | NMODES(I)=0 | |
3674 | 340 CONTINUE | |
3675 | CALL PYNAME(KFSUSY,CHTMP) | |
3676 | CHD0=CHTMP//' ' | |
3677 | CHDC(1)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) | |
3678 | CHDC(2)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) | |
3679 | CHDC(3)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) | |
3680 | KC=PYCOMP(KFSUSY) | |
3681 | DO 350 J=1,MDCY(KC,3) | |
3682 | IDC=J+MDCY(KC,2)-1 | |
3683 | ID1=IABS(KFDP(IDC,1)) | |
3684 | ID2=IABS(KFDP(IDC,2)) | |
3685 | ID3=IABS(KFDP(IDC,3)) | |
3686 | IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 | |
3687 | & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1.OR | |
3688 | & .ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3689 | PBRAT(1)=PBRAT(1)+BRAT(IDC) | |
3690 | NMODES(1)=NMODES(1)+1 | |
3691 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3692 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3693 | ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND | |
3694 | & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1 | |
3695 | & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3696 | PBRAT(2)=PBRAT(2)+BRAT(IDC) | |
3697 | NMODES(2)=NMODES(2)+1 | |
3698 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3699 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3700 | ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND | |
3701 | & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 | |
3702 | & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN | |
3703 | PBRAT(3)=PBRAT(3)+BRAT(IDC) | |
3704 | NMODES(3)=NMODES(3)+1 | |
3705 | IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 | |
3706 | IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 | |
3707 | ENDIF | |
3708 | 350 CONTINUE | |
3709 | ENDIF | |
3710 | ||
3711 | IF (NRVDC.NE.0) THEN | |
3712 | DO 360 I=1,NRVDC | |
3713 | WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I) | |
3714 | NMODES(0)=NMODES(0)+NMODES(I) | |
3715 | 360 CONTINUE | |
3716 | ENDIF | |
3717 | 370 CONTINUE | |
3718 | WRITE (MSTU(11),8100) NMODES(0), NMODES(10), NMODES(9) | |
3719 | ||
3720 | IF (IMSS(51).GE.1.OR.IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN | |
3721 | WRITE (MSTU(11),8500) | |
3722 | DO 400 IRV=1,3 | |
3723 | DO 390 JRV=1,3 | |
3724 | DO 380 KRV=1,3 | |
3725 | WRITE (MSTU(11),8700) IRV,JRV,KRV,RVLAM(IRV,JRV,KRV) | |
3726 | & ,RVLAMP(IRV,JRV,KRV),RVLAMB(IRV,JRV,KRV) | |
3727 | 380 CONTINUE | |
3728 | 390 CONTINUE | |
3729 | 400 CONTINUE | |
3730 | WRITE (MSTU(11),8600) | |
3731 | ENDIF | |
3732 | ENDIF | |
3733 | ||
3734 | C...Formats for printouts. | |
3735 | 5000 FORMAT('1',9('*'),1X,'PYSTAT: Statistics on Number of ', | |
3736 | &'Events and Cross-sections',1X,9('*')) | |
3737 | 5100 FORMAT(/1X,78('=')/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',12X, | |
3738 | &'Subprocess',12X,'I',6X,'Number of points',6X,'I',4X,'Sigma',3X, | |
3739 | &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',34('-'),'I',28('-'), | |
3740 | &'I',4X,'(mb)',4X,'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',1X, | |
3741 | &'N:o',1X,'Type',25X,'I',4X,'Generated',9X,'Tried',1X,'I',12X, | |
3742 | &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/1X,'I',34X,'I',28X, | |
3743 | &'I',12X,'I') | |
3744 | 5200 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I12,1X,I13,1X,'I',1X,1P, | |
3745 | &D10.3,1X,'I') | |
3746 | 5300 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/ | |
3747 | &1X,'I',34X,'I',28X,'I',12X,'I') | |
3748 | 5400 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')// | |
3749 | &1X,'********* Fraction of events that fail fragmentation ', | |
3750 | &'cuts =',1X,F8.5,' *********'/) | |
3751 | 5500 FORMAT('1',27('*'),1X,'PYSTAT: Decay Widths and Branching ', | |
3752 | &'Ratios',1X,27('*')) | |
3753 | 5600 FORMAT(/1X,98('=')/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/ | |
3754 | &1X,'I',5X,'Mother --> Branching/Decay Channel',8X,'I',1X, | |
3755 | &'Width (GeV)',1X,'I',7X,'B.R.',1X,'I',1X,'Stat',1X,'I',2X, | |
3756 | &'Eff. B.R.',1X,'I'/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/ | |
3757 | &1X,98('=')) | |
3758 | 5700 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,'I',1X, | |
3759 | &I8,2X,A10,3X,'(m =',F10.3,')',2X,'-->',5X,'I',2X,1P,D10.3,0P,1X, | |
3760 | &'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,1P,D10.3,0P,1X,'I') | |
3761 | 5800 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,15X,'I',2X, | |
3762 | &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X, | |
3763 | &1P,D10.3,0P,1X,'I') | |
3764 | 5900 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,1X,'+',1X,A10,2X,'I',2X, | |
3765 | &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X, | |
3766 | &1P,D10.3,0P,1X,'I') | |
3767 | 6000 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,98('=')) | |
3768 | 6100 FORMAT('1',7('*'),1X,'PYSTAT: Allowed Incoming Partons/', | |
3769 | &'Particles at Hard Interaction',1X,7('*')) | |
3770 | 6200 FORMAT(/1X,78('=')/1X,'I',38X,'I',37X,'I'/1X,'I',1X, | |
3771 | &'Beam particle:',1X,A12,10X,'I',1X,'Target particle:',1X,A12,7X, | |
3772 | &'I'/1X,'I',38X,'I',37X,'I'/1X,'I',1X,'Content',6X,'State',19X, | |
3773 | &'I',1X,'Content',6X,'State',18X,'I'/1X,'I',38X,'I',37X,'I'/1X, | |
3774 | &78('=')/1X,'I',38X,'I',37X,'I') | |
3775 | 6300 FORMAT(1X,'I',1X,A9,5X,A4,19X,'I',1X,A9,5X,A4,18X,'I') | |
3776 | 6400 FORMAT(1X,'I',38X,'I',37X,'I'/1X,78('=')) | |
3777 | 6500 FORMAT('1',12('*'),1X,'PYSTAT: User-Defined Limits on ', | |
3778 | &'Kinematical Variables',1X,12('*')) | |
3779 | 6600 FORMAT(/1X,78('=')/1X,'I',76X,'I') | |
3780 | 6700 FORMAT(1X,'I',16X,1P,D10.3,0P,1X,'<',1X,A,1X,'<',1X,1P,D10.3,0P, | |
3781 | &16X,'I') | |
3782 | 6800 FORMAT(1X,'I',3X,1P,D10.3,0P,1X,'(',1P,D10.3,0P,')',1X,'<',1X,A, | |
3783 | &1X,'<',1X,1P,D10.3,0P,16X,'I') | |
3784 | 6900 FORMAT(1X,'I',29X,A,1X,'=',1X,1P,D10.3,0P,16X,'I') | |
3785 | 7000 FORMAT(1X,'I',76X,'I'/1X,78('=')) | |
3786 | 7100 FORMAT('1',12('*'),1X,'PYSTAT: Summary of Status Codes and ', | |
3787 | &'Parameter Values',1X,12('*')) | |
3788 | 7200 FORMAT(/3X,'I',4X,'MSTP(I)',9X,'PARP(I)',20X,'I',4X,'MSTP(I)',9X, | |
3789 | &'PARP(I)'/) | |
3790 | 7300 FORMAT(1X,I3,5X,I6,6X,1P,D10.3,0P,18X,I3,5X,I6,6X,1P,D10.3) | |
3791 | 7400 FORMAT('1',13('*'),1X,'PYSTAT: List of implemented processes', | |
3792 | &1X,13('*')) | |
3793 | 7500 FORMAT(/1X,65('=')/1X,'I',34X,'I',28X,'I'/1X,'I',12X, | |
3794 | &'Subprocess',12X,'I',1X,'ISET',2X,'KFPR(I,1)',2X,'KFPR(I,2)',1X, | |
3795 | &'I'/1X,'I',34X,'I',28X,'I'/1X,65('=')/1X,'I',34X,'I',28X,'I') | |
3796 | 7600 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I4,1X,I10,1X,I10,1X,'I') | |
3797 | 7700 FORMAT(1X,'I',34X,'I',28X,'I'/1X,65('=')) | |
3798 | 8000 FORMAT(1X/ 1X/ | |
3799 | & 17X,'Sums over R-Violating branching ratios',1X/ 1X | |
3800 | & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I'/1X,'I',4X | |
3801 | & ,'Mother --> Sum over final state flavours',4X,'I',2X | |
3802 | & ,'BR(sum)',2X,'I',2X,'N',2X,'I'/1X,'I',50X,'I',11X,'I',5X,'I' | |
3803 | & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I') | |
3804 | 8100 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I'/1X,70('=')/1X,'I',1X | |
3805 | & ,'Total number of R-Violating modes :',3X,I5,24X,'I'/ | |
3806 | & 1X,'I',1X,'Total number with non-vanishing BR :',2X,I5,24X | |
3807 | & ,'I'/1X,'I',1X,'Total number with BR > 0.001 :',8X,I5,24X,'I' | |
3808 | & /1X,70('=')) | |
3809 | 8200 FORMAT(1X,'I',1X,A9,1X,'-->',1X,A24,11X, | |
3810 | & 'I',2X,1P,D8.2,0P,1X,'I',2X,I2,1X,'I') | |
3811 | 8300 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I') | |
3812 | 8500 FORMAT(1X/ 1X/ | |
3813 | & 1X,'R-Violating couplings',1X/ 1X / | |
3814 | & 1X,55('=')/ | |
3815 | & 1X,'I',1X,'IJK',1X,'I',2X,'LAMBDA(IJK)',2X,'I',2X | |
3816 | & ,'LAMBDA''(IJK)',1X,'I',1X,"LAMBDA''(IJK)",1X,'I'/1X,'I',5X | |
3817 | & ,'I',15X,'I',15X,'I',15X,'I') | |
3818 | 8600 FORMAT(1X,55('=')) | |
3819 | 8700 FORMAT(1X,'I',1X,I1,I1,I1,1X,'I',1X,1P,D13.3,0P,1X,'I',1X,1P | |
3820 | & ,D13.3,0P,1X,'I',1X,1P,D13.3,0P,1X,'I') | |
3821 | ||
3822 | RETURN | |
3823 | END | |
3824 | ||
3825 | C********************************************************************* | |
3826 | ||
3827 | C...PYINRE | |
3828 | C...Calculates full and effective widths of gauge bosons, stores | |
3829 | C...masses and widths, rescales coefficients to be used for | |
3830 | C...resonance production generation. | |
3831 | ||
3832 | SUBROUTINE PYINRE | |
3833 | ||
3834 | C...Double precision and integer declarations. | |
3835 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
3836 | IMPLICIT INTEGER(I-N) | |
3837 | INTEGER PYK,PYCHGE,PYCOMP | |
3838 | C...Parameter statement to help give large particle numbers. | |
3839 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
3840 | &KEXCIT=4000000,KDIMEN=5000000) | |
3841 | C...Commonblocks. | |
3842 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
3843 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
3844 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
3845 | COMMON/PYDAT4/CHAF(500,2) | |
3846 | CHARACTER CHAF*16 | |
3847 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
3848 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
3849 | COMMON/PYINT1/MINT(400),VINT(400) | |
3850 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
3851 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
3852 | COMMON/PYINT6/PROC(0:500) | |
3853 | CHARACTER PROC*28 | |
3854 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
3855 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, | |
3856 | &/PYINT1/,/PYINT2/,/PYINT4/,/PYINT6/,/PYMSSM/ | |
3857 | C...Local arrays and data. | |
3858 | DIMENSION WDTP(0:400),WDTE(0:400,0:5),WDTPM(0:400), | |
3859 | &WDTEM(0:400,0:5),KCORD(500),PMORD(500) | |
3860 | ||
3861 | C...Born level couplings in MSSM Higgs doublet sector. | |
3862 | XW=PARU(102) | |
3863 | XWV=XW | |
3864 | IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 | |
3865 | XW1=1D0-XW | |
3866 | IF(MSTP(4).EQ.2) THEN | |
3867 | TANBE=PARU(141) | |
3868 | RATBE=((1D0-TANBE**2)/(1D0+TANBE**2))**2 | |
3869 | SQMZ=PMAS(23,1)**2 | |
3870 | SQMW=PMAS(24,1)**2 | |
3871 | SQMH=PMAS(25,1)**2 | |
3872 | SQMA=SQMH*(SQMZ-SQMH)/(SQMZ*RATBE-SQMH) | |
3873 | SQMHP=0.5D0*(SQMA+SQMZ+SQRT((SQMA+SQMZ)**2-4D0*SQMA*SQMZ*RATBE)) | |
3874 | SQMHC=SQMA+SQMW | |
3875 | IF(SQMH.GE.SQMZ.OR.MIN(SQMA,SQMHP,SQMHC).LE.0D0) THEN | |
3876 | WRITE(MSTU(11),5000) | |
3877 | STOP | |
3878 | ENDIF | |
3879 | PMAS(35,1)=SQRT(SQMHP) | |
3880 | PMAS(36,1)=SQRT(SQMA) | |
3881 | PMAS(37,1)=SQRT(SQMHC) | |
3882 | ALSU=0.5D0*ATAN(2D0*TANBE*(SQMA+SQMZ)/((1D0-TANBE**2)* | |
3883 | & (SQMA-SQMZ))) | |
3884 | BESU=ATAN(TANBE) | |
3885 | PARU(142)=1D0 | |
3886 | PARU(143)=1D0 | |
3887 | PARU(161)=-SIN(ALSU)/COS(BESU) | |
3888 | PARU(162)=COS(ALSU)/SIN(BESU) | |
3889 | PARU(163)=PARU(161) | |
3890 | PARU(164)=SIN(BESU-ALSU) | |
3891 | PARU(165)=PARU(164) | |
3892 | PARU(168)=SIN(BESU-ALSU)+0.5D0*COS(2D0*BESU)*SIN(BESU+ALSU)/XW | |
3893 | PARU(171)=COS(ALSU)/COS(BESU) | |
3894 | PARU(172)=SIN(ALSU)/SIN(BESU) | |
3895 | PARU(173)=PARU(171) | |
3896 | PARU(174)=COS(BESU-ALSU) | |
3897 | PARU(175)=PARU(174) | |
3898 | PARU(176)=COS(2D0*ALSU)*COS(BESU+ALSU)-2D0*SIN(2D0*ALSU)* | |
3899 | & SIN(BESU+ALSU) | |
3900 | PARU(177)=COS(2D0*BESU)*COS(BESU+ALSU) | |
3901 | PARU(178)=COS(BESU-ALSU)-0.5D0*COS(2D0*BESU)*COS(BESU+ALSU)/XW | |
3902 | PARU(181)=TANBE | |
3903 | PARU(182)=1D0/TANBE | |
3904 | PARU(183)=PARU(181) | |
3905 | PARU(184)=0D0 | |
3906 | PARU(185)=PARU(184) | |
3907 | PARU(186)=COS(BESU-ALSU) | |
3908 | PARU(187)=SIN(BESU-ALSU) | |
3909 | PARU(188)=PARU(186) | |
3910 | PARU(189)=PARU(187) | |
3911 | PARU(190)=0D0 | |
3912 | PARU(195)=COS(BESU-ALSU) | |
3913 | ENDIF | |
3914 | ||
3915 | C...Reset effective widths of gauge bosons. | |
3916 | DO 110 I=1,500 | |
3917 | DO 100 J=1,5 | |
3918 | WIDS(I,J)=1D0 | |
3919 | 100 CONTINUE | |
3920 | 110 CONTINUE | |
3921 | ||
3922 | C...Order resonances by increasing mass (except Z0 and W+/-). | |
3923 | NRES=0 | |
3924 | DO 140 KC=1,500 | |
3925 | KF=KCHG(KC,4) | |
3926 | IF(KF.EQ.0) GOTO 140 | |
3927 | IF(MWID(KC).EQ.0) GOTO 140 | |
3928 | IF(KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18) THEN | |
3929 | IF(MSTP(1).LE.3) GOTO 140 | |
3930 | ENDIF | |
3931 | IF(KF/KSUSY1.EQ.1.OR.KF/KSUSY1.EQ.2) THEN | |
3932 | IF(IMSS(1).LE.0) GOTO 140 | |
3933 | ENDIF | |
3934 | NRES=NRES+1 | |
3935 | PMRES=PMAS(KC,1) | |
3936 | IF(KC.EQ.23.OR.KC.EQ.24) PMRES=0D0 | |
3937 | DO 120 I1=NRES-1,1,-1 | |
3938 | IF(PMRES.GE.PMORD(I1)) GOTO 130 | |
3939 | KCORD(I1+1)=KCORD(I1) | |
3940 | PMORD(I1+1)=PMORD(I1) | |
3941 | 120 CONTINUE | |
3942 | 130 KCORD(I1+1)=KC | |
3943 | PMORD(I1+1)=PMRES | |
3944 | 140 CONTINUE | |
3945 | ||
3946 | C...Loop over possible resonances. | |
3947 | DO 180 I=1,NRES | |
3948 | KC=KCORD(I) | |
3949 | KF=KCHG(KC,4) | |
3950 | ||
3951 | C...Check that no fourth generation channels on by mistake. | |
3952 | IF(MSTP(1).LE.3) THEN | |
3953 | DO 150 J=1,MDCY(KC,3) | |
3954 | IDC=J+MDCY(KC,2)-1 | |
3955 | KFA1=IABS(KFDP(IDC,1)) | |
3956 | KFA2=IABS(KFDP(IDC,2)) | |
3957 | IF(KFA1.EQ.7.OR.KFA1.EQ.8.OR.KFA1.EQ.17.OR.KFA1.EQ.18.OR. | |
3958 | & KFA2.EQ.7.OR.KFA2.EQ.8.OR.KFA2.EQ.17.OR.KFA2.EQ.18) | |
3959 | & MDME(IDC,1)=-1 | |
3960 | 150 CONTINUE | |
3961 | ENDIF | |
3962 | ||
3963 | C...Check that no supersymmetric channels on by mistake. | |
3964 | IF(IMSS(1).LE.0) THEN | |
3965 | DO 160 J=1,MDCY(KC,3) | |
3966 | IDC=J+MDCY(KC,2)-1 | |
3967 | KFA1S=IABS(KFDP(IDC,1))/KSUSY1 | |
3968 | KFA2S=IABS(KFDP(IDC,2))/KSUSY1 | |
3969 | IF(KFA1S.EQ.1.OR.KFA1S.EQ.2.OR.KFA2S.EQ.1.OR.KFA2S.EQ.2) | |
3970 | & MDME(IDC,1)=-1 | |
3971 | 160 CONTINUE | |
3972 | ENDIF | |
3973 | ||
3974 | C...Find mass and evaluate width. | |
3975 | PMR=PMAS(KC,1) | |
3976 | IF(KF.EQ.25.OR.KF.EQ.35.OR.KF.EQ.36) MINT(62)=1 | |
3977 | IF(MWID(KC).EQ.3) MINT(63)=1 | |
3978 | CALL PYWIDT(KF,PMR**2,WDTP,WDTE) | |
3979 | MINT(51)=0 | |
3980 | ||
3981 | C...Evaluate suppression factors due to non-simulated channels. | |
ced15360 | 3982 | C...AM |
3983 | C...Protection against division by 0 since rho_21_tc is causing problem here | |
3984 | IF (WDTP(0) .GT. 0.) THEN | |
3985 | ||
3986 | IF(KCHG(KC,3).EQ.0) THEN | |
3987 | WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))**2+ | |
3988 | & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ | |
3989 | & 2D0*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2 | |
3990 | WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
3991 | WIDS(KC,3)=0D0 | |
3992 | WIDS(KC,4)=0D0 | |
3993 | WIDS(KC,5)=0D0 | |
3994 | ELSE | |
3995 | IF(MWID(KC).EQ.3) MINT(63)=1 | |
3996 | CALL PYWIDT(-KF,PMR**2,WDTPM,WDTEM) | |
3997 | MINT(51)=0 | |
3998 | WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))*(WDTEM(0,1)+WDTEM(0,3))+ | |
3999 | & (WDTE(0,1)+WDTE(0,2))*(WDTEM(0,4)+WDTEM(0,5))+ | |
4000 | & (WDTE(0,4)+WDTE(0,5))*(WDTEM(0,1)+WDTEM(0,3))+ | |
4001 | & WDTE(0,4)*WDTEM(0,5)+WDTE(0,5)*WDTEM(0,4))/WDTP(0)**2 | |
4002 | WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
4003 | WIDS(KC,3)=(WDTEM(0,1)+WDTEM(0,3)+WDTEM(0,4))/WDTP(0) | |
4004 | WIDS(KC,4)=((WDTE(0,1)+WDTE(0,2))**2+ | |
4005 | & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ | |
4006 | & 2D0*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2 | |
4007 | WIDS(KC,5)=((WDTEM(0,1)+WDTEM(0,3))**2+ | |
4008 | & 2D0*(WDTEM(0,1)+WDTEM(0,3))*(WDTEM(0,4)+WDTEM(0,5))+ | |
4009 | & 2D0*WDTEM(0,4)*WDTEM(0,5))/WDTP(0)**2 | |
4010 | ENDIF | |
4011 | ||
2dfa57d1 | 4012 | ENDIF |
2dfa57d1 | 4013 | C...Set resonance widths and branching ratios; |
4014 | C...also on/off switch for decays. | |
4015 | IF(MWID(KC).EQ.1.OR.MWID(KC).EQ.3) THEN | |
4016 | PMAS(KC,2)=WDTP(0) | |
4017 | PMAS(KC,3)=MIN(0.9D0*PMAS(KC,1),10D0*PMAS(KC,2)) | |
4018 | IF(MSTP(41).EQ.0.OR.MSTP(41).EQ.1) MDCY(KC,1)=MSTP(41) | |
4019 | DO 170 J=1,MDCY(KC,3) | |
4020 | IDC=J+MDCY(KC,2)-1 | |
4021 | BRAT(IDC)=0D0 | |
4022 | IF(WDTP(0).GT.0D0) BRAT(IDC)=WDTP(J)/WDTP(0) | |
4023 | 170 CONTINUE | |
4024 | ENDIF | |
4025 | 180 CONTINUE | |
4026 | ||
4027 | C...Flavours of leptoquark: redefine charge and name. | |
4028 | KFLQQ=KFDP(MDCY(42,2),1) | |
4029 | KFLQL=KFDP(MDCY(42,2),2) | |
4030 | KCHG(42,1)=KCHG(PYCOMP(KFLQQ),1)*ISIGN(1,KFLQQ)+ | |
4031 | &KCHG(PYCOMP(KFLQL),1)*ISIGN(1,KFLQL) | |
4032 | LL=1 | |
4033 | IF(IABS(KFLQL).EQ.13) LL=2 | |
4034 | IF(IABS(KFLQL).EQ.15) LL=3 | |
4035 | CHAF(42,1)='LQ_'//CHAF(IABS(KFLQQ),1)(1:1)// | |
4036 | &CHAF(IABS(KFLQL),1)(1:LL)//' ' | |
4037 | CHAF(42,2)=CHAF(42,2)(1:4+LL)//'bar ' | |
4038 | ||
4039 | C...Special cases in treatment of gamma*/Z0: redefine process name. | |
4040 | IF(MSTP(43).EQ.1) THEN | |
4041 | PROC(1)='f + fbar -> gamma*' | |
4042 | PROC(15)='f + fbar -> g + gamma*' | |
4043 | PROC(19)='f + fbar -> gamma + gamma*' | |
4044 | PROC(30)='f + g -> f + gamma*' | |
4045 | PROC(35)='f + gamma -> f + gamma*' | |
4046 | ELSEIF(MSTP(43).EQ.2) THEN | |
4047 | PROC(1)='f + fbar -> Z0' | |
4048 | PROC(15)='f + fbar -> g + Z0' | |
4049 | PROC(19)='f + fbar -> gamma + Z0' | |
4050 | PROC(30)='f + g -> f + Z0' | |
4051 | PROC(35)='f + gamma -> f + Z0' | |
4052 | ELSEIF(MSTP(43).EQ.3) THEN | |
4053 | PROC(1)='f + fbar -> gamma*/Z0' | |
4054 | PROC(15)='f + fbar -> g + gamma*/Z0' | |
4055 | PROC(19)='f + fbar -> gamma + gamma*/Z0' | |
4056 | PROC(30)='f + g -> f + gamma*/Z0' | |
4057 | PROC(35)='f + gamma -> f + gamma*/Z0' | |
4058 | ENDIF | |
4059 | ||
4060 | C...Special cases in treatment of gamma*/Z0/Z'0: redefine process name. | |
4061 | IF(MSTP(44).EQ.1) THEN | |
4062 | PROC(141)='f + fbar -> gamma*' | |
4063 | ELSEIF(MSTP(44).EQ.2) THEN | |
4064 | PROC(141)='f + fbar -> Z0' | |
4065 | ELSEIF(MSTP(44).EQ.3) THEN | |
4066 | PROC(141)='f + fbar -> Z''0' | |
4067 | ELSEIF(MSTP(44).EQ.4) THEN | |
4068 | PROC(141)='f + fbar -> gamma*/Z0' | |
4069 | ELSEIF(MSTP(44).EQ.5) THEN | |
4070 | PROC(141)='f + fbar -> gamma*/Z''0' | |
4071 | ELSEIF(MSTP(44).EQ.6) THEN | |
4072 | PROC(141)='f + fbar -> Z0/Z''0' | |
4073 | ELSEIF(MSTP(44).EQ.7) THEN | |
4074 | PROC(141)='f + fbar -> gamma*/Z0/Z''0' | |
4075 | ENDIF | |
4076 | ||
4077 | C...Special cases in treatment of WW -> WW: redefine process name. | |
4078 | IF(MSTP(45).EQ.1) THEN | |
4079 | PROC(77)='W+ + W+ -> W+ + W+' | |
4080 | ELSEIF(MSTP(45).EQ.2) THEN | |
4081 | PROC(77)='W+ + W- -> W+ + W-' | |
4082 | ELSEIF(MSTP(45).EQ.3) THEN | |
4083 | PROC(77)='W+/- + W+/- -> W+/- + W+/-' | |
4084 | ENDIF | |
4085 | ||
4086 | C...Format for error information. | |
4087 | 5000 FORMAT(1X,'Error: unphysical input tan^2(beta) and m_H ', | |
4088 | &'combination'/1X,'Execution stopped!') | |
4089 | ||
4090 | RETURN | |
4091 | END | |
4092 | ||
4093 | C********************************************************************* | |
4094 | ||
4095 | C...PYINBM | |
4096 | C...Identifies the two incoming particles and the choice of frame. | |
4097 | ||
4098 | SUBROUTINE PYINBM(CHFRAM,CHBEAM,CHTARG,WIN) | |
4099 | ||
4100 | C...Double precision and integer declarations. | |
4101 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
4102 | IMPLICIT INTEGER(I-N) | |
4103 | INTEGER PYK,PYCHGE,PYCOMP | |
4104 | ||
4105 | C...User process initialization commonblock. | |
4106 | INTEGER MAXPUP | |
4107 | PARAMETER (MAXPUP=100) | |
4108 | INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP | |
4109 | DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP | |
4110 | COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), | |
4111 | &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), | |
4112 | &LPRUP(MAXPUP) | |
4113 | SAVE /HEPRUP/ | |
4114 | ||
4115 | C...Commonblocks. | |
4116 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
4117 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4118 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
4119 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
4120 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
4121 | COMMON/PYINT1/MINT(400),VINT(400) | |
4122 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ | |
4123 | ||
4124 | C...Local arrays, character variables and data. | |
4125 | CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHCOM(3)*12,CHALP(2)*26, | |
4126 | &CHIDNT(3)*12,CHTEMP*12,CHCDE(39)*12,CHINIT*76,CHNAME*16 | |
4127 | DIMENSION LEN(3),KCDE(39),PM(2) | |
4128 | DATA CHALP/'abcdefghijklmnopqrstuvwxyz', | |
4129 | &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ | |
4130 | DATA CHCDE/ 'e- ','e+ ','nu_e ', | |
4131 | &'nu_ebar ','mu- ','mu+ ','nu_mu ', | |
4132 | &'nu_mubar ','tau- ','tau+ ','nu_tau ', | |
4133 | &'nu_taubar ','pi+ ','pi- ','n0 ', | |
4134 | &'nbar0 ','p+ ','pbar- ','gamma ', | |
4135 | &'lambda0 ','sigma- ','sigma0 ','sigma+ ', | |
4136 | &'xi- ','xi0 ','omega- ','pi0 ', | |
4137 | &'reggeon ','pomeron ','gamma/e- ','gamma/e+ ', | |
4138 | &'gamma/mu- ','gamma/mu+ ','gamma/tau- ','gamma/tau+ ', | |
4139 | &'k+ ','k- ','ks0 ','kl0 '/ | |
4140 | DATA KCDE/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16, | |
4141 | &211,-211,2112,-2112,2212,-2212,22,3122,3112,3212,3222, | |
4142 | &3312,3322,3334,111,110,990,6*22,321,-321,310,130/ | |
4143 | ||
4144 | C...Store initial energy. Default frame. | |
4145 | VINT(290)=WIN | |
4146 | MINT(111)=0 | |
4147 | ||
4148 | C...Special user process initialization; convert to normal input. | |
4149 | IF(CHFRAM(1:1).EQ.'u'.OR.CHFRAM(1:1).EQ.'U') THEN | |
4150 | MINT(111)=11 | |
4151 | CALL PYNAME(IDBMUP(1),CHNAME) | |
4152 | CHBEAM=CHNAME(1:12) | |
4153 | CALL PYNAME(IDBMUP(2),CHNAME) | |
4154 | CHTARG=CHNAME(1:12) | |
4155 | ENDIF | |
4156 | ||
4157 | C...Convert character variables to lowercase and find their length. | |
4158 | CHCOM(1)=CHFRAM | |
4159 | CHCOM(2)=CHBEAM | |
4160 | CHCOM(3)=CHTARG | |
4161 | DO 130 I=1,3 | |
4162 | LEN(I)=12 | |
4163 | DO 110 LL=12,1,-1 | |
4164 | IF(LEN(I).EQ.LL.AND.CHCOM(I)(LL:LL).EQ.' ') LEN(I)=LL-1 | |
4165 | DO 100 LA=1,26 | |
4166 | IF(CHCOM(I)(LL:LL).EQ.CHALP(2)(LA:LA)) CHCOM(I)(LL:LL)= | |
4167 | & CHALP(1)(LA:LA) | |
4168 | 100 CONTINUE | |
4169 | 110 CONTINUE | |
4170 | CHIDNT(I)=CHCOM(I) | |
4171 | ||
4172 | C...Fix up bar, underscore and charge in particle name (if needed). | |
4173 | DO 120 LL=1,10 | |
4174 | IF(CHIDNT(I)(LL:LL).EQ.'~') THEN | |
4175 | CHTEMP=CHIDNT(I) | |
4176 | CHIDNT(I)=CHTEMP(1:LL-1)//'bar'//CHTEMP(LL+1:10)//' ' | |
4177 | ENDIF | |
4178 | 120 CONTINUE | |
4179 | IF(CHIDNT(I)(1:2).EQ.'nu'.AND.CHIDNT(I)(3:3).NE.'_') THEN | |
4180 | CHTEMP=CHIDNT(I) | |
4181 | CHIDNT(I)='nu_'//CHTEMP(3:7) | |
4182 | ELSEIF(CHIDNT(I)(1:2).EQ.'n ') THEN | |
4183 | CHIDNT(I)(1:3)='n0 ' | |
4184 | ELSEIF(CHIDNT(I)(1:4).EQ.'nbar') THEN | |
4185 | CHIDNT(I)(1:5)='nbar0' | |
4186 | ELSEIF(CHIDNT(I)(1:2).EQ.'p ') THEN | |
4187 | CHIDNT(I)(1:3)='p+ ' | |
4188 | ELSEIF(CHIDNT(I)(1:4).EQ.'pbar'.OR. | |
4189 | & CHIDNT(I)(1:2).EQ.'p-') THEN | |
4190 | CHIDNT(I)(1:5)='pbar-' | |
4191 | ELSEIF(CHIDNT(I)(1:6).EQ.'lambda') THEN | |
4192 | CHIDNT(I)(7:7)='0' | |
4193 | ELSEIF(CHIDNT(I)(1:3).EQ.'reg') THEN | |
4194 | CHIDNT(I)(1:7)='reggeon' | |
4195 | ELSEIF(CHIDNT(I)(1:3).EQ.'pom') THEN | |
4196 | CHIDNT(I)(1:7)='pomeron' | |
4197 | ENDIF | |
4198 | 130 CONTINUE | |
4199 | ||
4200 | C...Identify free initialization. | |
4201 | IF(CHCOM(1)(1:2).EQ.'no') THEN | |
4202 | MINT(65)=1 | |
4203 | RETURN | |
4204 | ENDIF | |
4205 | ||
4206 | C...Identify incoming beam and target particles. | |
4207 | DO 160 I=1,2 | |
4208 | DO 140 J=1,39 | |
4209 | IF(CHIDNT(I+1).EQ.CHCDE(J)) MINT(10+I)=KCDE(J) | |
4210 | 140 CONTINUE | |
4211 | PM(I)=PYMASS(MINT(10+I)) | |
4212 | VINT(2+I)=PM(I) | |
4213 | MINT(140+I)=0 | |
4214 | IF(MINT(10+I).EQ.22.AND.CHIDNT(I+1)(6:6).EQ.'/') THEN | |
4215 | CHTEMP=CHIDNT(I+1)(7:12)//' ' | |
4216 | DO 150 J=1,12 | |
4217 | IF(CHTEMP.EQ.CHCDE(J)) MINT(140+I)=KCDE(J) | |
4218 | 150 CONTINUE | |
4219 | PM(I)=PYMASS(MINT(140+I)) | |
4220 | VINT(302+I)=PM(I) | |
4221 | ENDIF | |
4222 | 160 CONTINUE | |
4223 | IF(MINT(11).EQ.0) WRITE(MSTU(11),5000) CHBEAM(1:LEN(2)) | |
4224 | IF(MINT(12).EQ.0) WRITE(MSTU(11),5100) CHTARG(1:LEN(3)) | |
4225 | IF(MINT(11).EQ.0.OR.MINT(12).EQ.0) STOP | |
4226 | ||
4227 | C...Identify choice of frame and input energies. | |
4228 | CHINIT=' ' | |
4229 | ||
4230 | C...Events defined in the CM frame. | |
4231 | IF(CHCOM(1)(1:2).EQ.'cm') THEN | |
4232 | MINT(111)=1 | |
4233 | S=WIN**2 | |
4234 | IF(MSTP(122).GE.1) THEN | |
4235 | IF(CHCOM(2)(1:1).NE.'e') THEN | |
4236 | LOFFS=(31-(LEN(2)+LEN(3)))/2 | |
4237 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for a '// | |
4238 | & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// | |
4239 | & ' collider'//' ' | |
4240 | ELSE | |
4241 | LOFFS=(30-(LEN(2)+LEN(3)))/2 | |
4242 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for an '// | |
4243 | & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// | |
4244 | & ' collider'//' ' | |
4245 | ENDIF | |
4246 | WRITE(MSTU(11),5200) CHINIT | |
4247 | WRITE(MSTU(11),5300) WIN | |
4248 | ENDIF | |
4249 | ||
4250 | C...Events defined in fixed target frame. | |
4251 | ELSEIF(CHCOM(1)(1:3).EQ.'fix') THEN | |
4252 | MINT(111)=2 | |
4253 | S=PM(1)**2+PM(2)**2+2D0*PM(2)*SQRT(PM(1)**2+WIN**2) | |
4254 | IF(MSTP(122).GE.1) THEN | |
4255 | LOFFS=(29-(LEN(2)+LEN(3)))/2 | |
4256 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// | |
4257 | & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// | |
4258 | & ' fixed target'//' ' | |
4259 | WRITE(MSTU(11),5200) CHINIT | |
4260 | WRITE(MSTU(11),5400) WIN | |
4261 | WRITE(MSTU(11),5500) SQRT(S) | |
4262 | ENDIF | |
4263 | ||
4264 | C...Frame defined by user three-vectors. | |
4265 | ELSEIF(CHCOM(1)(1:1).EQ.'3') THEN | |
4266 | MINT(111)=3 | |
4267 | P(1,5)=PM(1) | |
4268 | P(2,5)=PM(2) | |
4269 | P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2) | |
4270 | P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2) | |
4271 | S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- | |
4272 | & (P(1,3)+P(2,3))**2 | |
4273 | IF(MSTP(122).GE.1) THEN | |
4274 | LOFFS=(22-(LEN(2)+LEN(3)))/2 | |
4275 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// | |
4276 | & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// | |
4277 | & ' user configuration'//' ' | |
4278 | WRITE(MSTU(11),5200) CHINIT | |
4279 | WRITE(MSTU(11),5600) | |
4280 | WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) | |
4281 | WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) | |
4282 | WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) | |
4283 | ENDIF | |
4284 | ||
4285 | C...Frame defined by user four-vectors. | |
4286 | ELSEIF(CHCOM(1)(1:1).EQ.'4') THEN | |
4287 | MINT(111)=4 | |
4288 | PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2 | |
4289 | P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1) | |
4290 | PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2 | |
4291 | P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2) | |
4292 | S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- | |
4293 | & (P(1,3)+P(2,3))**2 | |
4294 | IF(MSTP(122).GE.1) THEN | |
4295 | LOFFS=(22-(LEN(2)+LEN(3)))/2 | |
4296 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// | |
4297 | & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// | |
4298 | & ' user configuration'//' ' | |
4299 | WRITE(MSTU(11),5200) CHINIT | |
4300 | WRITE(MSTU(11),5600) | |
4301 | WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) | |
4302 | WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) | |
4303 | WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) | |
4304 | ENDIF | |
4305 | ||
4306 | C...Frame defined by user five-vectors. | |
4307 | ELSEIF(CHCOM(1)(1:1).EQ.'5') THEN | |
4308 | MINT(111)=5 | |
4309 | S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- | |
4310 | & (P(1,3)+P(2,3))**2 | |
4311 | IF(MSTP(122).GE.1) THEN | |
4312 | LOFFS=(22-(LEN(2)+LEN(3)))/2 | |
4313 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// | |
4314 | & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// | |
4315 | & ' user configuration'//' ' | |
4316 | WRITE(MSTU(11),5200) CHINIT | |
4317 | WRITE(MSTU(11),5600) | |
4318 | WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) | |
4319 | WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) | |
4320 | WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) | |
4321 | ENDIF | |
4322 | ||
4323 | C...Frame defined by HEPRUP common block. | |
4324 | ELSEIF(MINT(111).EQ.11) THEN | |
4325 | S=(EBMUP(1)+EBMUP(2))**2-(SQRT(MAX(0D0,EBMUP(1)**2-PM(1)**2))- | |
4326 | & SQRT(MAX(0D0,EBMUP(2)**2-PM(2)**2)))**2 | |
4327 | IF(MSTP(122).GE.1) THEN | |
4328 | LOFFS=(22-(LEN(2)+LEN(3)))/2 | |
4329 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// | |
4330 | & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// | |
4331 | & ' user configuration'//' ' | |
4332 | WRITE(MSTU(11),5200) CHINIT | |
4333 | WRITE(MSTU(11),6000) EBMUP(1),EBMUP(2) | |
4334 | WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) | |
4335 | ENDIF | |
4336 | ||
4337 | C...Unknown frame. Error for too low CM energy. | |
4338 | ELSE | |
4339 | WRITE(MSTU(11),5800) CHFRAM(1:LEN(1)) | |
4340 | STOP | |
4341 | ENDIF | |
4342 | IF(S.LT.PARP(2)**2) THEN | |
4343 | WRITE(MSTU(11),5900) SQRT(S) | |
4344 | STOP | |
4345 | ENDIF | |
4346 | ||
4347 | C...Formats for initialization and error information. | |
4348 | 5000 FORMAT(1X,'Error: unrecognized beam particle ''',A,'''D0'/ | |
4349 | &1X,'Execution stopped!') | |
4350 | 5100 FORMAT(1X,'Error: unrecognized target particle ''',A,'''D0'/ | |
4351 | &1X,'Execution stopped!') | |
4352 | 5200 FORMAT(/1X,78('=')/1X,'I',76X,'I'/1X,'I',A76,'I') | |
4353 | 5300 FORMAT(1X,'I',18X,'at',1X,F10.3,1X,'GeV center-of-mass energy', | |
4354 | &19X,'I'/1X,'I',76X,'I'/1X,78('=')) | |
4355 | 5400 FORMAT(1X,'I',22X,'at',1X,F10.3,1X,'GeV/c lab-momentum',22X,'I') | |
4356 | 5500 FORMAT(1X,'I',76X,'I'/1X,'I',11X,'corresponding to',1X,F10.3,1X, | |
4357 | &'GeV center-of-mass energy',12X,'I'/1X,'I',76X,'I'/1X,78('=')) | |
4358 | 5600 FORMAT(1X,'I',76X,'I'/1X,'I',18X,'px (GeV/c)',3X,'py (GeV/c)',3X, | |
4359 | &'pz (GeV/c)',6X,'E (GeV)',9X,'I') | |
4360 | 5700 FORMAT(1X,'I',8X,A8,4(2X,F10.3,1X),8X,'I') | |
4361 | 5800 FORMAT(1X,'Error: unrecognized coordinate frame ''',A,'''D0'/ | |
4362 | &1X,'Execution stopped!') | |
4363 | 5900 FORMAT(1X,'Error: too low CM energy,',F8.3,' GeV for event ', | |
4364 | &'generation.'/1X,'Execution stopped!') | |
4365 | 6000 FORMAT(1X,'I',12X,'with',1X,F10.3,1X,'GeV on',1X,F10.3,1X, | |
4366 | &'GeV beam energies',13X,'I') | |
4367 | ||
4368 | RETURN | |
4369 | END | |
4370 | ||
4371 | C********************************************************************* | |
4372 | ||
4373 | C...PYINKI | |
4374 | C...Sets up kinematics, including rotations and boosts to/from CM frame. | |
4375 | ||
4376 | SUBROUTINE PYINKI(MODKI) | |
4377 | ||
4378 | C...Double precision and integer declarations. | |
4379 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
4380 | IMPLICIT INTEGER(I-N) | |
4381 | INTEGER PYK,PYCHGE,PYCOMP | |
4382 | ||
4383 | C...User process initialization commonblock. | |
4384 | INTEGER MAXPUP | |
4385 | PARAMETER (MAXPUP=100) | |
4386 | INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP | |
4387 | DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP | |
4388 | COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), | |
4389 | &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), | |
4390 | &LPRUP(MAXPUP) | |
4391 | SAVE /HEPRUP/ | |
4392 | ||
4393 | C...Commonblocks. | |
4394 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
4395 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4396 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
4397 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
4398 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
4399 | COMMON/PYINT1/MINT(400),VINT(400) | |
4400 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ | |
4401 | ||
4402 | C...Set initial flavour state. | |
4403 | N=2 | |
4404 | DO 100 I=1,2 | |
4405 | K(I,1)=1 | |
4406 | K(I,2)=MINT(10+I) | |
4407 | IF(MINT(140+I).NE.0) K(I,2)=MINT(140+I) | |
4408 | 100 CONTINUE | |
4409 | ||
4410 | C...Reset boost. Do kinematics for various cases. | |
4411 | DO 110 J=6,10 | |
4412 | VINT(J)=0D0 | |
4413 | 110 CONTINUE | |
4414 | ||
4415 | C...Set up kinematics for events defined in CM frame. | |
4416 | IF(MINT(111).EQ.1) THEN | |
4417 | WIN=VINT(290) | |
4418 | IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290) | |
4419 | S=WIN**2 | |
4420 | P(1,5)=VINT(3) | |
4421 | P(2,5)=VINT(4) | |
4422 | IF(MINT(141).NE.0) P(1,5)=VINT(303) | |
4423 | IF(MINT(142).NE.0) P(2,5)=VINT(304) | |
4424 | P(1,1)=0D0 | |
4425 | P(1,2)=0D0 | |
4426 | P(2,1)=0D0 | |
4427 | P(2,2)=0D0 | |
4428 | P(1,3)=SQRT(((S-P(1,5)**2-P(2,5)**2)**2-(2D0*P(1,5)*P(2,5))**2)/ | |
4429 | & (4D0*S)) | |
4430 | P(2,3)=-P(1,3) | |
4431 | P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) | |
4432 | P(2,4)=SQRT(P(2,3)**2+P(2,5)**2) | |
4433 | ||
4434 | C...Set up kinematics for fixed target events. | |
4435 | ELSEIF(MINT(111).EQ.2) THEN | |
4436 | WIN=VINT(290) | |
4437 | IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290) | |
4438 | P(1,5)=VINT(3) | |
4439 | P(2,5)=VINT(4) | |
4440 | IF(MINT(141).NE.0) P(1,5)=VINT(303) | |
4441 | IF(MINT(142).NE.0) P(2,5)=VINT(304) | |
4442 | P(1,1)=0D0 | |
4443 | P(1,2)=0D0 | |
4444 | P(2,1)=0D0 | |
4445 | P(2,2)=0D0 | |
4446 | P(1,3)=WIN | |
4447 | P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) | |
4448 | P(2,3)=0D0 | |
4449 | P(2,4)=P(2,5) | |
4450 | S=P(1,5)**2+P(2,5)**2+2D0*P(2,4)*P(1,4) | |
4451 | VINT(10)=P(1,3)/(P(1,4)+P(2,4)) | |
4452 | CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10)) | |
4453 | ||
4454 | C...Set up kinematics for events in user-defined frame. | |
4455 | ELSEIF(MINT(111).EQ.3) THEN | |
4456 | P(1,5)=VINT(3) | |
4457 | P(2,5)=VINT(4) | |
4458 | IF(MINT(141).NE.0) P(1,5)=VINT(303) | |
4459 | IF(MINT(142).NE.0) P(2,5)=VINT(304) | |
4460 | P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2) | |
4461 | P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2) | |
4462 | DO 120 J=1,3 | |
4463 | VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) | |
4464 | 120 CONTINUE | |
4465 | CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) | |
4466 | VINT(7)=PYANGL(P(1,1),P(1,2)) | |
4467 | CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) | |
4468 | VINT(6)=PYANGL(P(1,3),P(1,1)) | |
4469 | CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) | |
4470 | S=P(1,5)**2+P(2,5)**2+2D0*(P(1,4)*P(2,4)-P(1,3)*P(2,3)) | |
4471 | ||
4472 | C...Set up kinematics for events with user-defined four-vectors. | |
4473 | ELSEIF(MINT(111).EQ.4) THEN | |
4474 | PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2 | |
4475 | P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1) | |
4476 | PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2 | |
4477 | P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2) | |
4478 | DO 130 J=1,3 | |
4479 | VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) | |
4480 | 130 CONTINUE | |
4481 | CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) | |
4482 | VINT(7)=PYANGL(P(1,1),P(1,2)) | |
4483 | CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) | |
4484 | VINT(6)=PYANGL(P(1,3),P(1,1)) | |
4485 | CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) | |
4486 | S=(P(1,4)+P(2,4))**2 | |
4487 | ||
4488 | C...Set up kinematics for events with user-defined five-vectors. | |
4489 | ELSEIF(MINT(111).EQ.5) THEN | |
4490 | DO 140 J=1,3 | |
4491 | VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) | |
4492 | 140 CONTINUE | |
4493 | CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) | |
4494 | VINT(7)=PYANGL(P(1,1),P(1,2)) | |
4495 | CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) | |
4496 | VINT(6)=PYANGL(P(1,3),P(1,1)) | |
4497 | CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) | |
4498 | S=(P(1,4)+P(2,4))**2 | |
4499 | ||
4500 | C...Set up kinematics for events with external user processes. | |
4501 | ELSEIF(MINT(111).EQ.11) THEN | |
4502 | P(1,5)=VINT(3) | |
4503 | P(2,5)=VINT(4) | |
4504 | IF(MINT(141).NE.0) P(1,5)=VINT(303) | |
4505 | IF(MINT(142).NE.0) P(2,5)=VINT(304) | |
4506 | P(1,1)=0D0 | |
4507 | P(1,2)=0D0 | |
4508 | P(2,1)=0D0 | |
4509 | P(2,2)=0D0 | |
4510 | P(1,3)=SQRT(MAX(0D0,EBMUP(1)**2-P(1,5)**2)) | |
4511 | P(2,3)=-SQRT(MAX(0D0,EBMUP(2)**2-P(2,5)**2)) | |
4512 | P(1,4)=EBMUP(1) | |
4513 | P(2,4)=EBMUP(2) | |
4514 | VINT(10)=(P(1,3)+P(2,3))/(P(1,4)+P(2,4)) | |
4515 | CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10)) | |
4516 | S=(P(1,4)+P(2,4))**2 | |
4517 | ENDIF | |
4518 | ||
4519 | C...Return or error for too low CM energy. | |
4520 | IF(MODKI.EQ.1.AND.S.LT.PARP(2)**2) THEN | |
4521 | IF(MSTP(172).LE.1) THEN | |
4522 | CALL PYERRM(23, | |
4523 | & '(PYINKI:) too low invariant mass in this event') | |
4524 | ELSE | |
4525 | MSTI(61)=1 | |
4526 | RETURN | |
4527 | ENDIF | |
4528 | ENDIF | |
4529 | ||
4530 | C...Save information on incoming particles. | |
4531 | VINT(1)=SQRT(S) | |
4532 | VINT(2)=S | |
4533 | IF(MINT(111).GE.4) THEN | |
4534 | IF(MINT(141).EQ.0) THEN | |
4535 | VINT(3)=P(1,5) | |
4536 | IF(MINT(11).EQ.22.AND.P(1,5).LT.0) VINT(307)=P(1,5)**2 | |
4537 | ELSE | |
4538 | VINT(303)=P(1,5) | |
4539 | ENDIF | |
4540 | IF(MINT(142).EQ.0) THEN | |
4541 | VINT(4)=P(2,5) | |
4542 | IF(MINT(12).EQ.22.AND.P(2,5).LT.0) VINT(308)=P(2,5)**2 | |
4543 | ELSE | |
4544 | VINT(304)=P(2,5) | |
4545 | ENDIF | |
4546 | ENDIF | |
4547 | VINT(5)=P(1,3) | |
4548 | IF(MODKI.EQ.0) VINT(289)=S | |
4549 | DO 150 J=1,5 | |
4550 | V(1,J)=0D0 | |
4551 | V(2,J)=0D0 | |
4552 | VINT(290+J)=P(1,J) | |
4553 | VINT(295+J)=P(2,J) | |
4554 | 150 CONTINUE | |
4555 | ||
4556 | C...Store pT cut-off and related constants to be used in generation. | |
4557 | IF(MODKI.EQ.0) VINT(285)=CKIN(3) | |
4558 | IF(MSTP(82).LE.1) THEN | |
4559 | PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) | |
4560 | ELSE | |
4561 | PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) | |
4562 | ENDIF | |
4563 | VINT(149)=4D0*PTMN**2/S | |
4564 | VINT(154)=PTMN | |
4565 | ||
4566 | RETURN | |
4567 | END | |
4568 | ||
4569 | C********************************************************************* | |
4570 | ||
4571 | C...PYINPR | |
4572 | C...Selects partonic subprocesses to be included in the simulation. | |
4573 | ||
4574 | SUBROUTINE PYINPR | |
4575 | ||
4576 | C...Double precision and integer declarations. | |
4577 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
4578 | IMPLICIT INTEGER(I-N) | |
4579 | INTEGER PYK,PYCHGE,PYCOMP | |
4580 | ||
4581 | C...User process initialization commonblock. | |
4582 | INTEGER MAXPUP | |
4583 | PARAMETER (MAXPUP=100) | |
4584 | INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP | |
4585 | DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP | |
4586 | COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), | |
4587 | &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), | |
4588 | &LPRUP(MAXPUP) | |
4589 | SAVE /HEPRUP/ | |
4590 | ||
4591 | C...Commonblocks and character variables. | |
4592 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4593 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
4594 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
4595 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
4596 | COMMON/PYINT1/MINT(400),VINT(400) | |
4597 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
4598 | COMMON/PYINT6/PROC(0:500) | |
4599 | CHARACTER PROC*28 | |
4600 | SAVE /PYDAT1/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, | |
4601 | &/PYINT6/ | |
4602 | CHARACTER CHIPR*10 | |
4603 | ||
4604 | C...Reset processes to be included. | |
4605 | IF(MSEL.NE.0) THEN | |
4606 | DO 100 I=1,500 | |
4607 | MSUB(I)=0 | |
4608 | 100 CONTINUE | |
4609 | ENDIF | |
4610 | ||
4611 | C...Set running pTmin scale. | |
4612 | IF(MSTP(82).LE.1) THEN | |
4613 | PTMRUN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) | |
4614 | ELSE | |
4615 | PTMRUN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) | |
4616 | ENDIF | |
4617 | ||
4618 | C...Begin by assuming incoming photon to enter subprocess. | |
4619 | IF(MINT(11).EQ.22) MINT(15)=22 | |
4620 | IF(MINT(12).EQ.22) MINT(16)=22 | |
4621 | ||
4622 | C...For e-gamma with MSTP(14)=10 allow mixture of VMD and anomalous. | |
4623 | IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN | |
4624 | MSUB(10)=1 | |
4625 | MINT(123)=MINT(122)+1 | |
4626 | ||
4627 | C...For gamma-p or gamma-gamma with MSTP(14) = 10, 20, 25 or 30 | |
4628 | C...allow mixture. | |
4629 | C...Here also set a few parameters otherwise normally not touched. | |
4630 | ELSEIF(MINT(121).GT.1) THEN | |
4631 | ||
4632 | C...Parton distributions dampened at small Q2; go to low energies, | |
4633 | C...alpha_s <1; no minimum pT cut-off a priori. | |
4634 | IF(MSTP(18).EQ.2) THEN | |
4635 | MSTP(57)=3 | |
4636 | PARP(2)=2D0 | |
4637 | PARU(115)=1D0 | |
4638 | CKIN(5)=0.2D0 | |
4639 | CKIN(6)=0.2D0 | |
4640 | ENDIF | |
4641 | ||
4642 | C...Define pT cut-off parameters and whether run involves low-pT. | |
4643 | PTMVMD=PTMRUN | |
4644 | VINT(154)=PTMVMD | |
4645 | PTMDIR=PTMVMD | |
4646 | IF(MSTP(18).EQ.2) PTMDIR=PARP(15) | |
4647 | PTMANO=PTMVMD | |
4648 | IF(MSTP(15).EQ.5) PTMANO=0.60D0+ | |
4649 | & 0.125D0*LOG(1D0+0.10D0*VINT(1))**2 | |
4650 | IPTL=1 | |
4651 | IF(VINT(285).GT.MAX(PTMVMD,PTMDIR,PTMANO)) IPTL=0 | |
4652 | IF(MSEL.EQ.2) IPTL=1 | |
4653 | ||
4654 | C...Set up for p/gamma * gamma; real or virtual photons. | |
4655 | IF(MINT(121).EQ.3.OR.MINT(121).EQ.6.OR.(MINT(121).EQ.4.AND. | |
4656 | & MSTP(14).EQ.30)) THEN | |
4657 | ||
4658 | C...Set up for p/VMD * VMD. | |
4659 | IF(MINT(122).EQ.1) THEN | |
4660 | MINT(123)=2 | |
4661 | MSUB(11)=1 | |
4662 | MSUB(12)=1 | |
4663 | MSUB(13)=1 | |
4664 | MSUB(28)=1 | |
4665 | MSUB(53)=1 | |
4666 | MSUB(68)=1 | |
4667 | IF(IPTL.EQ.1) MSUB(95)=1 | |
4668 | IF(MSEL.EQ.2) THEN | |
4669 | MSUB(91)=1 | |
4670 | MSUB(92)=1 | |
4671 | MSUB(93)=1 | |
4672 | MSUB(94)=1 | |
4673 | ENDIF | |
4674 | IF(IPTL.EQ.1) CKIN(3)=0D0 | |
4675 | ||
4676 | C...Set up for p/VMD * direct gamma. | |
4677 | ELSEIF(MINT(122).EQ.2) THEN | |
4678 | MINT(123)=0 | |
4679 | IF(MINT(121).EQ.6) MINT(123)=5 | |
4680 | MSUB(131)=1 | |
4681 | MSUB(132)=1 | |
4682 | MSUB(135)=1 | |
4683 | MSUB(136)=1 | |
4684 | IF(IPTL.EQ.1) CKIN(3)=PTMDIR | |
4685 | ||
4686 | C...Set up for p/VMD * anomalous gamma. | |
4687 | ELSEIF(MINT(122).EQ.3) THEN | |
4688 | MINT(123)=3 | |
4689 | IF(MINT(121).EQ.6) MINT(123)=7 | |
4690 | MSUB(11)=1 | |
4691 | MSUB(12)=1 | |
4692 | MSUB(13)=1 | |
4693 | MSUB(28)=1 | |
4694 | MSUB(53)=1 | |
4695 | MSUB(68)=1 | |
4696 | IF(IPTL.EQ.1) MSUB(95)=1 | |
4697 | IF(MSEL.EQ.2) THEN | |
4698 | MSUB(91)=1 | |
4699 | MSUB(92)=1 | |
4700 | MSUB(93)=1 | |
4701 | MSUB(94)=1 | |
4702 | ENDIF | |
4703 | IF(IPTL.EQ.1) CKIN(3)=0D0 | |
4704 | ||
4705 | C...Set up for DIS * p. | |
4706 | ELSEIF(MINT(122).EQ.4.AND.(IABS(MINT(11)).GT.100.OR. | |
4707 | & IABS(MINT(12)).GT.100)) THEN | |
4708 | MINT(123)=8 | |
4709 | IF(IPTL.EQ.1) MSUB(99)=1 | |
4710 | ||
4711 | C...Set up for direct * direct gamma (switch off leptons). | |
4712 | ELSEIF(MINT(122).EQ.4) THEN | |
4713 | MINT(123)=0 | |
4714 | MSUB(137)=1 | |
4715 | MSUB(138)=1 | |
4716 | MSUB(139)=1 | |
4717 | MSUB(140)=1 | |
4718 | DO 110 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 | |
4719 | IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) | |
4720 | 110 CONTINUE | |
4721 | IF(IPTL.EQ.1) CKIN(3)=PTMDIR | |
4722 | ||
4723 | C...Set up for direct * anomalous gamma. | |
4724 | ELSEIF(MINT(122).EQ.5) THEN | |
4725 | MINT(123)=6 | |
4726 | MSUB(131)=1 | |
4727 | MSUB(132)=1 | |
4728 | MSUB(135)=1 | |
4729 | MSUB(136)=1 | |
4730 | IF(IPTL.EQ.1) CKIN(3)=PTMANO | |
4731 | ||
4732 | C...Set up for anomalous * anomalous gamma. | |
4733 | ELSEIF(MINT(122).EQ.6) THEN | |
4734 | MINT(123)=3 | |
4735 | MSUB(11)=1 | |
4736 | MSUB(12)=1 | |
4737 | MSUB(13)=1 | |
4738 | MSUB(28)=1 | |
4739 | MSUB(53)=1 | |
4740 | MSUB(68)=1 | |
4741 | IF(IPTL.EQ.1) MSUB(95)=1 | |
4742 | IF(MSEL.EQ.2) THEN | |
4743 | MSUB(91)=1 | |
4744 | MSUB(92)=1 | |
4745 | MSUB(93)=1 | |
4746 | MSUB(94)=1 | |
4747 | ENDIF | |
4748 | IF(IPTL.EQ.1) CKIN(3)=0D0 | |
4749 | ENDIF | |
4750 | ||
4751 | C...Set up for gamma* * gamma*; virtual photons = dir, VMD, anom. | |
4752 | ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN | |
4753 | ||
4754 | C...Set up for direct * direct gamma (switch off leptons). | |
4755 | IF(MINT(122).EQ.1) THEN | |
4756 | MINT(123)=0 | |
4757 | MSUB(137)=1 | |
4758 | MSUB(138)=1 | |
4759 | MSUB(139)=1 | |
4760 | MSUB(140)=1 | |
4761 | DO 120 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 | |
4762 | IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) | |
4763 | 120 CONTINUE | |
4764 | IF(IPTL.EQ.1) CKIN(3)=PTMDIR | |
4765 | ||
4766 | C...Set up for direct * VMD and VMD * direct gamma. | |
4767 | ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.4) THEN | |
4768 | MINT(123)=5 | |
4769 | MSUB(131)=1 | |
4770 | MSUB(132)=1 | |
4771 | MSUB(135)=1 | |
4772 | MSUB(136)=1 | |
4773 | IF(IPTL.EQ.1) CKIN(3)=PTMDIR | |
4774 | ||
4775 | C...Set up for direct * anomalous and anomalous * direct gamma. | |
4776 | ELSEIF(MINT(122).EQ.3.OR.MINT(122).EQ.7) THEN | |
4777 | MINT(123)=6 | |
4778 | MSUB(131)=1 | |
4779 | MSUB(132)=1 | |
4780 | MSUB(135)=1 | |
4781 | MSUB(136)=1 | |
4782 | IF(IPTL.EQ.1) CKIN(3)=PTMANO | |
4783 | ||
4784 | C...Set up for VMD*VMD. | |
4785 | ELSEIF(MINT(122).EQ.5) THEN | |
4786 | MINT(123)=2 | |
4787 | MSUB(11)=1 | |
4788 | MSUB(12)=1 | |
4789 | MSUB(13)=1 | |
4790 | MSUB(28)=1 | |
4791 | MSUB(53)=1 | |
4792 | MSUB(68)=1 | |
4793 | IF(IPTL.EQ.1) MSUB(95)=1 | |
4794 | IF(MSEL.EQ.2) THEN | |
4795 | MSUB(91)=1 | |
4796 | MSUB(92)=1 | |
4797 | MSUB(93)=1 | |
4798 | MSUB(94)=1 | |
4799 | ENDIF | |
4800 | IF(IPTL.EQ.1) CKIN(3)=0D0 | |
4801 | ||
4802 | C...Set up for VMD * anomalous and anomalous * VMD gamma. | |
4803 | ELSEIF(MINT(122).EQ.6.OR.MINT(122).EQ.8) THEN | |
4804 | MINT(123)=7 | |
4805 | MSUB(11)=1 | |
4806 | MSUB(12)=1 | |
4807 | MSUB(13)=1 | |
4808 | MSUB(28)=1 | |
4809 | MSUB(53)=1 | |
4810 | MSUB(68)=1 | |
4811 | IF(IPTL.EQ.1) MSUB(95)=1 | |
4812 | IF(MSEL.EQ.2) THEN | |
4813 | MSUB(91)=1 | |
4814 | MSUB(92)=1 | |
4815 | MSUB(93)=1 | |
4816 | MSUB(94)=1 | |
4817 | ENDIF | |
4818 | IF(IPTL.EQ.1) CKIN(3)=0D0 | |
4819 | ||
4820 | C...Set up for anomalous * anomalous gamma. | |
4821 | ELSEIF(MINT(122).EQ.9) THEN | |
4822 | MINT(123)=3 | |
4823 | MSUB(11)=1 | |
4824 | MSUB(12)=1 | |
4825 | MSUB(13)=1 | |
4826 | MSUB(28)=1 | |
4827 | MSUB(53)=1 | |
4828 | MSUB(68)=1 | |
4829 | IF(IPTL.EQ.1) MSUB(95)=1 | |
4830 | IF(MSEL.EQ.2) THEN | |
4831 | MSUB(91)=1 | |
4832 | MSUB(92)=1 | |
4833 | MSUB(93)=1 | |
4834 | MSUB(94)=1 | |
4835 | ENDIF | |
4836 | IF(IPTL.EQ.1) CKIN(3)=0D0 | |
4837 | ||
4838 | C...Set up for DIS * VMD and VMD * DIS gamma. | |
4839 | ELSEIF(MINT(122).EQ.10.OR.MINT(122).EQ.12) THEN | |
4840 | MINT(123)=8 | |
4841 | IF(IPTL.EQ.1) MSUB(99)=1 | |
4842 | ||
4843 | C...Set up for DIS * anomalous and anomalous * DIS gamma. | |
4844 | ELSEIF(MINT(122).EQ.11.OR.MINT(122).EQ.13) THEN | |
4845 | MINT(123)=9 | |
4846 | IF(IPTL.EQ.1) MSUB(99)=1 | |
4847 | ENDIF | |
4848 | ||
4849 | C...Set up for gamma* * p; virtual photons = dir, res. | |
4850 | ELSEIF(MINT(121).EQ.2) THEN | |
4851 | ||
4852 | C...Set up for direct * p. | |
4853 | IF(MINT(122).EQ.1) THEN | |
4854 | MINT(123)=0 | |
4855 | MSUB(131)=1 | |
4856 | MSUB(132)=1 | |
4857 | MSUB(135)=1 | |
4858 | MSUB(136)=1 | |
4859 | IF(IPTL.EQ.1) CKIN(3)=PTMDIR | |
4860 | ||
4861 | C...Set up for resolved * p. | |
4862 | ELSEIF(MINT(122).EQ.2) THEN | |
4863 | MINT(123)=1 | |
4864 | MSUB(11)=1 | |
4865 | MSUB(12)=1 | |
4866 | MSUB(13)=1 | |
4867 | MSUB(28)=1 | |
4868 | MSUB(53)=1 | |
4869 | MSUB(68)=1 | |
4870 | IF(IPTL.EQ.1) MSUB(95)=1 | |
4871 | IF(MSEL.EQ.2) THEN | |
4872 | MSUB(91)=1 | |
4873 | MSUB(92)=1 | |
4874 | MSUB(93)=1 | |
4875 | MSUB(94)=1 | |
4876 | ENDIF | |
4877 | IF(IPTL.EQ.1) CKIN(3)=0D0 | |
4878 | ENDIF | |
4879 | ||
4880 | C...Set up for gamma* * gamma*; virtual photons = dir, res. | |
4881 | ELSEIF(MINT(121).EQ.4) THEN | |
4882 | ||
4883 | C...Set up for direct * direct gamma (switch off leptons). | |
4884 | IF(MINT(122).EQ.1) THEN | |
4885 | MINT(123)=0 | |
4886 | MSUB(137)=1 | |
4887 | MSUB(138)=1 | |
4888 | MSUB(139)=1 | |
4889 | MSUB(140)=1 | |
4890 | DO 130 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 | |
4891 | IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) | |
4892 | 130 CONTINUE | |
4893 | IF(IPTL.EQ.1) CKIN(3)=PTMDIR | |
4894 | ||
4895 | C...Set up for direct * resolved and resolved * direct gamma. | |
4896 | ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.3) THEN | |
4897 | MINT(123)=5 | |
4898 | MSUB(131)=1 | |
4899 | MSUB(132)=1 | |
4900 | MSUB(135)=1 | |
4901 | MSUB(136)=1 | |
4902 | IF(IPTL.EQ.1) CKIN(3)=PTMDIR | |
4903 | ||
4904 | C...Set up for resolved * resolved gamma. | |
4905 | ELSEIF(MINT(122).EQ.4) THEN | |
4906 | MINT(123)=2 | |
4907 | MSUB(11)=1 | |
4908 | MSUB(12)=1 | |
4909 | MSUB(13)=1 | |
4910 | MSUB(28)=1 | |
4911 | MSUB(53)=1 | |
4912 | MSUB(68)=1 | |
4913 | IF(IPTL.EQ.1) MSUB(95)=1 | |
4914 | IF(MSEL.EQ.2) THEN | |
4915 | MSUB(91)=1 | |
4916 | MSUB(92)=1 | |
4917 | MSUB(93)=1 | |
4918 | MSUB(94)=1 | |
4919 | ENDIF | |
4920 | IF(IPTL.EQ.1) CKIN(3)=0D0 | |
4921 | ENDIF | |
4922 | ||
4923 | C...End of special set up for gamma-p and gamma-gamma. | |
4924 | ENDIF | |
4925 | CKIN(1)=2D0*CKIN(3) | |
4926 | ENDIF | |
4927 | ||
4928 | C...Flavour information for individual beams. | |
4929 | DO 140 I=1,2 | |
4930 | MINT(40+I)=1 | |
4931 | IF(MINT(123).GE.1.AND.MINT(10+I).EQ.22) MINT(40+I)=2 | |
4932 | IF(IABS(MINT(10+I)).GT.100) MINT(40+I)=2 | |
4933 | MINT(44+I)=MINT(40+I) | |
4934 | IF(MSTP(11).GE.1.AND.(IABS(MINT(10+I)).EQ.11.OR. | |
4935 | & IABS(MINT(10+I)).EQ.13.OR.IABS(MINT(10+I)).EQ.15)) MINT(44+I)=3 | |
4936 | 140 CONTINUE | |
4937 | ||
4938 | C...If two real gammas, whereof one direct, pick the first. | |
4939 | C...For two virtual photons, keep requested order. | |
4940 | IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN | |
4941 | IF(MSTP(14).LE.10.AND.MINT(123).GE.4.AND.MINT(123).LE.6) THEN | |
4942 | MINT(41)=1 | |
4943 | MINT(45)=1 | |
4944 | ELSEIF(MSTP(14).EQ.12.OR.MSTP(14).EQ.13.OR.MSTP(14).EQ.22.OR. | |
4945 | & MSTP(14).EQ.26.OR.MSTP(14).EQ.27) THEN | |
4946 | MINT(41)=1 | |
4947 | MINT(45)=1 | |
4948 | ELSEIF(MSTP(14).EQ.14.OR.MSTP(14).EQ.17.OR.MSTP(14).EQ.23.OR. | |
4949 | & MSTP(14).EQ.28.OR.MSTP(14).EQ.29) THEN | |
4950 | MINT(42)=1 | |
4951 | MINT(46)=1 | |
4952 | ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.2 | |
4953 | & .OR.MINT(122).EQ.3.OR.MINT(122).EQ.10.OR.MINT(122).EQ.11)) THEN | |
4954 | MINT(41)=1 | |
4955 | MINT(45)=1 | |
4956 | ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.4 | |
4957 | & .OR.MINT(122).EQ.7.OR.MINT(122).EQ.12.OR.MINT(122).EQ.13)) THEN | |
4958 | MINT(42)=1 | |
4959 | MINT(46)=1 | |
4960 | ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.2) THEN | |
4961 | MINT(41)=1 | |
4962 | MINT(45)=1 | |
4963 | ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.3) THEN | |
4964 | MINT(42)=1 | |
4965 | MINT(46)=1 | |
4966 | ENDIF | |
4967 | ELSEIF(MINT(11).EQ.22.OR.MINT(12).EQ.22) THEN | |
4968 | IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28.OR.MINT(122).EQ.4) THEN | |
4969 | IF(MINT(11).EQ.22) THEN | |
4970 | MINT(41)=1 | |
4971 | MINT(45)=1 | |
4972 | ELSE | |
4973 | MINT(42)=1 | |
4974 | MINT(46)=1 | |
4975 | ENDIF | |
4976 | ENDIF | |
4977 | IF(MINT(123).GE.4.AND.MINT(123).LE.7) CALL PYERRM(26, | |
4978 | & '(PYINPR:) unallowed MSTP(14) code for single photon') | |
4979 | ENDIF | |
4980 | ||
4981 | C...Flavour information on combination of incoming particles. | |
4982 | MINT(43)=2*MINT(41)+MINT(42)-2 | |
4983 | MINT(44)=MINT(43) | |
4984 | IF(MINT(123).LE.0) THEN | |
4985 | IF(MINT(11).EQ.22) MINT(43)=MINT(43)+2 | |
4986 | IF(MINT(12).EQ.22) MINT(43)=MINT(43)+1 | |
4987 | ELSEIF(MINT(123).LE.3) THEN | |
4988 | IF(MINT(11).EQ.22) MINT(44)=MINT(44)-2 | |
4989 | IF(MINT(12).EQ.22) MINT(44)=MINT(44)-1 | |
4990 | ELSEIF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN | |
4991 | MINT(43)=4 | |
4992 | MINT(44)=1 | |
4993 | ENDIF | |
4994 | MINT(47)=2*MIN(2,MINT(45))+MIN(2,MINT(46))-2 | |
4995 | IF(MIN(MINT(45),MINT(46)).EQ.3) MINT(47)=5 | |
4996 | IF(MINT(45).EQ.1.AND.MINT(46).EQ.3) MINT(47)=6 | |
4997 | IF(MINT(45).EQ.3.AND.MINT(46).EQ.1) MINT(47)=7 | |
4998 | MINT(50)=0 | |
4999 | IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) MINT(50)=1 | |
5000 | MINT(107)=0 | |
5001 | MINT(108)=0 | |
5002 | IF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN | |
5003 | IF((MINT(122).GE.4.AND.MINT(122).LE.6).OR.MINT(122).EQ.12) | |
5004 | & MINT(107)=2 | |
5005 | IF((MINT(122).GE.7.AND.MINT(122).LE.9).OR.MINT(122).EQ.13) | |
5006 | & MINT(107)=3 | |
5007 | IF(MINT(122).EQ.10.OR.MINT(122).EQ.11) MINT(107)=4 | |
5008 | IF(MINT(122).EQ.2.OR.MINT(122).EQ.5.OR.MINT(122).EQ.8.OR. | |
5009 | & MINT(122).EQ.10) MINT(108)=2 | |
5010 | IF(MINT(122).EQ.3.OR.MINT(122).EQ.6.OR.MINT(122).EQ.9.OR. | |
5011 | & MINT(122).EQ.11) MINT(108)=3 | |
5012 | IF(MINT(122).EQ.12.OR.MINT(122).EQ.13) MINT(108)=4 | |
5013 | ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.25) THEN | |
5014 | IF(MINT(122).GE.3) MINT(107)=1 | |
5015 | IF(MINT(122).EQ.2.OR.MINT(122).EQ.4) MINT(108)=1 | |
5016 | ELSEIF(MINT(121).EQ.2) THEN | |
5017 | IF(MINT(122).EQ.2.AND.MINT(11).EQ.22) MINT(107)=1 | |
5018 | IF(MINT(122).EQ.2.AND.MINT(12).EQ.22) MINT(108)=1 | |
5019 | ELSE | |
5020 | IF(MINT(11).EQ.22) THEN | |
5021 | MINT(107)=MINT(123) | |
5022 | IF(MINT(123).GE.4) MINT(107)=0 | |
5023 | IF(MINT(123).EQ.7) MINT(107)=2 | |
5024 | IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.27) MINT(107)=4 | |
5025 | IF(MSTP(14).EQ.28) MINT(107)=2 | |
5026 | IF(MSTP(14).EQ.29) MINT(107)=3 | |
5027 | IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4) | |
5028 | & MINT(107)=4 | |
5029 | ENDIF | |
5030 | IF(MINT(12).EQ.22) THEN | |
5031 | MINT(108)=MINT(123) | |
5032 | IF(MINT(123).GE.4) MINT(108)=MINT(123)-3 | |
5033 | IF(MINT(123).EQ.7) MINT(108)=3 | |
5034 | IF(MSTP(14).EQ.26) MINT(108)=2 | |
5035 | IF(MSTP(14).EQ.27) MINT(108)=3 | |
5036 | IF(MSTP(14).EQ.28.OR.MSTP(14).EQ.29) MINT(108)=4 | |
5037 | IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4) | |
5038 | & MINT(108)=4 | |
5039 | ENDIF | |
5040 | IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.(MSTP(14).EQ.14.OR. | |
5041 | & MSTP(14).EQ.17.OR.MSTP(14).EQ.18.OR.MSTP(14).EQ.23)) THEN | |
5042 | MINTTP=MINT(107) | |
5043 | MINT(107)=MINT(108) | |
5044 | MINT(108)=MINTTP | |
5045 | ENDIF | |
5046 | ENDIF | |
5047 | IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0 | |
5048 | IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0 | |
5049 | ||
5050 | C...Select default processes according to incoming beams | |
5051 | C...(already done for gamma-p and gamma-gamma with | |
5052 | C...MSTP(14) = 10, 20, 25 or 30). | |
5053 | IF(MINT(121).GT.1) THEN | |
5054 | ELSEIF(MSEL.EQ.1.OR.MSEL.EQ.2) THEN | |
5055 | ||
5056 | IF(MINT(43).EQ.1) THEN | |
5057 | C...Lepton + lepton -> gamma/Z0 or W. | |
5058 | IF(MINT(11)+MINT(12).EQ.0) MSUB(1)=1 | |
5059 | IF(MINT(11)+MINT(12).NE.0) MSUB(2)=1 | |
5060 | ||
5061 | ELSEIF(MINT(43).LE.3.AND.MINT(123).EQ.0.AND. | |
5062 | & (MINT(11).EQ.22.OR.MINT(12).EQ.22)) THEN | |
5063 | C...Unresolved photon + lepton: Compton scattering. | |
5064 | MSUB(133)=1 | |
5065 | MSUB(134)=1 | |
5066 | ||
5067 | ELSEIF((MINT(123).EQ.8.OR.MINT(123).EQ.9).AND.(MINT(11).EQ.22 | |
5068 | & .OR.MINT(12).EQ.22)) THEN | |
5069 | C...DIS as pure gamma* + f -> f process. | |
5070 | MSUB(99)=1 | |
5071 | ||
5072 | ELSEIF(MINT(43).LE.3) THEN | |
5073 | C...Lepton + hadron: deep inelastic scattering. | |
5074 | MSUB(10)=1 | |
5075 | ||
5076 | ELSEIF(MINT(123).EQ.0.AND.MINT(11).EQ.22.AND. | |
5077 | & MINT(12).EQ.22) THEN | |
5078 | C...Two unresolved photons: fermion pair production, | |
5079 | C...exclude lepton pairs. | |
5080 | DO 150 ISUB=137,140 | |
5081 | MSUB(ISUB)=1 | |
5082 | 150 CONTINUE | |
5083 | DO 160 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 | |
5084 | IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) | |
5085 | 160 CONTINUE | |
5086 | PTMDIR=PTMRUN | |
5087 | IF(MSTP(18).EQ.2) PTMDIR=PARP(15) | |
5088 | IF(CKIN(3).LT.PTMRUN.OR.MSEL.EQ.2) CKIN(3)=PTMDIR | |
5089 | CKIN(1)=MAX(CKIN(1),2D0*CKIN(3)) | |
5090 | ||
5091 | ELSEIF((MINT(123).EQ.0.AND.(MINT(11).EQ.22.OR.MINT(12).EQ.22)) | |
5092 | & .OR.(MINT(123).GE.4.AND.MINT(123).LE.6.AND.MINT(11).EQ.22.AND. | |
5093 | & MINT(12).EQ.22)) THEN | |
5094 | C...Unresolved photon + hadron: photon-parton scattering. | |
5095 | DO 170 ISUB=131,136 | |
5096 | MSUB(ISUB)=1 | |
5097 | 170 CONTINUE | |
5098 | ||
5099 | ELSEIF(MSEL.EQ.1) THEN | |
5100 | C...High-pT QCD processes: | |
5101 | MSUB(11)=1 | |
5102 | MSUB(12)=1 | |
5103 | MSUB(13)=1 | |
5104 | MSUB(28)=1 | |
5105 | MSUB(53)=1 | |
5106 | MSUB(68)=1 | |
5107 | PTMN=PTMRUN | |
5108 | VINT(154)=PTMN | |
5109 | IF(CKIN(3).LT.PTMN) MSUB(95)=1 | |
5110 | IF(MSUB(95).EQ.1.AND.MINT(50).EQ.0) MSUB(95)=0 | |
5111 | ||
5112 | ELSE | |
5113 | C...All QCD processes: | |
5114 | MSUB(11)=1 | |
5115 | MSUB(12)=1 | |
5116 | MSUB(13)=1 | |
5117 | MSUB(28)=1 | |
5118 | MSUB(53)=1 | |
5119 | MSUB(68)=1 | |
5120 | MSUB(91)=1 | |
5121 | MSUB(92)=1 | |
5122 | MSUB(93)=1 | |
5123 | MSUB(94)=1 | |
5124 | MSUB(95)=1 | |
5125 | ENDIF | |
5126 | ||
5127 | ELSEIF(MSEL.GE.4.AND.MSEL.LE.8) THEN | |
5128 | C...Heavy quark production. | |
5129 | MSUB(81)=1 | |
5130 | MSUB(82)=1 | |
5131 | MSUB(84)=1 | |
5132 | DO 180 J=1,MIN(8,MDCY(21,3)) | |
5133 | MDME(MDCY(21,2)+J-1,1)=0 | |
5134 | 180 CONTINUE | |
5135 | MDME(MDCY(21,2)+MSEL-1,1)=1 | |
5136 | MSUB(85)=1 | |
5137 | DO 190 J=1,MIN(12,MDCY(22,3)) | |
5138 | MDME(MDCY(22,2)+J-1,1)=0 | |
5139 | 190 CONTINUE | |
5140 | MDME(MDCY(22,2)+MSEL-1,1)=1 | |
5141 | ||
5142 | ELSEIF(MSEL.EQ.10) THEN | |
5143 | C...Prompt photon production: | |
5144 | MSUB(14)=1 | |
5145 | MSUB(18)=1 | |
5146 | MSUB(29)=1 | |
5147 | ||
5148 | ELSEIF(MSEL.EQ.11) THEN | |
5149 | C...Z0/gamma* production: | |
5150 | MSUB(1)=1 | |
5151 | ||
5152 | ELSEIF(MSEL.EQ.12) THEN | |
5153 | C...W+/- production: | |
5154 | MSUB(2)=1 | |
5155 | ||
5156 | ELSEIF(MSEL.EQ.13) THEN | |
5157 | C...Z0 + jet: | |
5158 | MSUB(15)=1 | |
5159 | MSUB(30)=1 | |
5160 | ||
5161 | ELSEIF(MSEL.EQ.14) THEN | |
5162 | C...W+/- + jet: | |
5163 | MSUB(16)=1 | |
5164 | MSUB(31)=1 | |
5165 | ||
5166 | ELSEIF(MSEL.EQ.15) THEN | |
5167 | C...Z0 & W+/- pair production: | |
5168 | MSUB(19)=1 | |
5169 | MSUB(20)=1 | |
5170 | MSUB(22)=1 | |
5171 | MSUB(23)=1 | |
5172 | MSUB(25)=1 | |
5173 | ||
5174 | ELSEIF(MSEL.EQ.16) THEN | |
5175 | C...h0 production: | |
5176 | MSUB(3)=1 | |
5177 | MSUB(102)=1 | |
5178 | MSUB(103)=1 | |
5179 | MSUB(123)=1 | |
5180 | MSUB(124)=1 | |
5181 | ||
5182 | ELSEIF(MSEL.EQ.17) THEN | |
5183 | C...h0 & Z0 or W+/- pair production: | |
5184 | MSUB(24)=1 | |
5185 | MSUB(26)=1 | |
5186 | ||
5187 | ELSEIF(MSEL.EQ.18) THEN | |
5188 | C...h0 production; interesting processes in e+e-. | |
5189 | MSUB(24)=1 | |
5190 | MSUB(103)=1 | |
5191 | MSUB(123)=1 | |
5192 | MSUB(124)=1 | |
5193 | ||
5194 | ELSEIF(MSEL.EQ.19) THEN | |
5195 | C...h0, H0 and A0 production; interesting processes in e+e-. | |
5196 | MSUB(24)=1 | |
5197 | MSUB(103)=1 | |
5198 | MSUB(123)=1 | |
5199 | MSUB(124)=1 | |
5200 | MSUB(153)=1 | |
5201 | MSUB(171)=1 | |
5202 | MSUB(173)=1 | |
5203 | MSUB(174)=1 | |
5204 | MSUB(158)=1 | |
5205 | MSUB(176)=1 | |
5206 | MSUB(178)=1 | |
5207 | MSUB(179)=1 | |
5208 | ||
5209 | ELSEIF(MSEL.EQ.21) THEN | |
5210 | C...Z'0 production: | |
5211 | MSUB(141)=1 | |
5212 | ||
5213 | ELSEIF(MSEL.EQ.22) THEN | |
5214 | C...W'+/- production: | |
5215 | MSUB(142)=1 | |
5216 | ||
5217 | ELSEIF(MSEL.EQ.23) THEN | |
5218 | C...H+/- production: | |
5219 | MSUB(143)=1 | |
5220 | ||
5221 | ELSEIF(MSEL.EQ.24) THEN | |
5222 | C...R production: | |
5223 | MSUB(144)=1 | |
5224 | ||
5225 | ELSEIF(MSEL.EQ.25) THEN | |
5226 | C...LQ (leptoquark) production. | |
5227 | MSUB(145)=1 | |
5228 | MSUB(162)=1 | |
5229 | MSUB(163)=1 | |
5230 | MSUB(164)=1 | |
5231 | ||
5232 | ELSEIF(MSEL.GE.35.AND.MSEL.LE.38) THEN | |
5233 | C...Production of one heavy quark (W exchange): | |
5234 | MSUB(83)=1 | |
5235 | DO 200 J=1,MIN(8,MDCY(21,3)) | |
5236 | MDME(MDCY(21,2)+J-1,1)=0 | |
5237 | 200 CONTINUE | |
5238 | MDME(MDCY(21,2)+MSEL-31,1)=1 | |
5239 | ||
5240 | CMRENNA++Define SUSY alternatives. | |
5241 | ELSEIF(MSEL.EQ.39) THEN | |
5242 | C...Turn on all SUSY processes. | |
5243 | IF(MINT(43).EQ.4) THEN | |
5244 | C...Hadron-hadron processes. | |
5245 | DO 210 I=201,301 | |
5246 | IF(ISET(I).GE.0) MSUB(I)=1 | |
5247 | 210 CONTINUE | |
5248 | ELSEIF(MINT(43).EQ.1) THEN | |
5249 | C...Lepton-lepton processes: QED production of squarks. | |
5250 | DO 220 I=201,214 | |
5251 | MSUB(I)=1 | |
5252 | 220 CONTINUE | |
5253 | MSUB(210)=0 | |
5254 | MSUB(211)=0 | |
5255 | MSUB(212)=0 | |
5256 | DO 230 I=216,228 | |
5257 | MSUB(I)=1 | |
5258 | 230 CONTINUE | |
5259 | DO 240 I=261,263 | |
5260 | MSUB(I)=1 | |
5261 | 240 CONTINUE | |
5262 | MSUB(277)=1 | |
5263 | MSUB(278)=1 | |
5264 | ENDIF | |
5265 | ||
5266 | ELSEIF(MSEL.EQ.40) THEN | |
5267 | C...Gluinos and squarks. | |
5268 | IF(MINT(43).EQ.4) THEN | |
5269 | MSUB(243)=1 | |
5270 | MSUB(244)=1 | |
5271 | MSUB(258)=1 | |
5272 | MSUB(259)=1 | |
5273 | MSUB(261)=1 | |
5274 | MSUB(262)=1 | |
5275 | MSUB(264)=1 | |
5276 | MSUB(265)=1 | |
5277 | DO 250 I=271,296 | |
5278 | MSUB(I)=1 | |
5279 | 250 CONTINUE | |
5280 | ELSEIF(MINT(43).EQ.1) THEN | |
5281 | MSUB(277)=1 | |
5282 | MSUB(278)=1 | |
5283 | ENDIF | |
5284 | ||
5285 | ELSEIF(MSEL.EQ.41) THEN | |
5286 | C...Stop production. | |
5287 | MSUB(261)=1 | |
5288 | MSUB(262)=1 | |
5289 | MSUB(263)=1 | |
5290 | IF(MINT(43).EQ.4) THEN | |
5291 | MSUB(264)=1 | |
5292 | MSUB(265)=1 | |
5293 | ENDIF | |
5294 | ||
5295 | ELSEIF(MSEL.EQ.42) THEN | |
5296 | C...Slepton production. | |
5297 | DO 260 I=201,214 | |
5298 | MSUB(I)=1 | |
5299 | 260 CONTINUE | |
5300 | IF(MINT(43).NE.4) THEN | |
5301 | MSUB(210)=0 | |
5302 | MSUB(211)=0 | |
5303 | MSUB(212)=0 | |
5304 | ENDIF | |
5305 | ||
5306 | ELSEIF(MSEL.EQ.43) THEN | |
5307 | C...Neutralino/Chargino + Gluino/Squark. | |
5308 | IF(MINT(43).EQ.4) THEN | |
5309 | DO 270 I=237,242 | |
5310 | MSUB(I)=1 | |
5311 | 270 CONTINUE | |
5312 | DO 280 I=246,257 | |
5313 | MSUB(I)=1 | |
5314 | 280 CONTINUE | |
5315 | ENDIF | |
5316 | ||
5317 | ELSEIF(MSEL.EQ.44) THEN | |
5318 | C...Neutralino/Chargino pair production. | |
5319 | IF(MINT(43).EQ.4) THEN | |
5320 | DO 290 I=216,236 | |
5321 | MSUB(I)=1 | |
5322 | 290 CONTINUE | |
5323 | ELSEIF(MINT(43).EQ.1) THEN | |
5324 | DO 300 I=216,228 | |
5325 | MSUB(I)=1 | |
5326 | 300 CONTINUE | |
5327 | ENDIF | |
5328 | ||
5329 | ELSEIF(MSEL.EQ.45) THEN | |
5330 | C...Sbottom production. | |
5331 | MSUB(287)=1 | |
5332 | MSUB(288)=1 | |
5333 | IF(MINT(43).EQ.4) THEN | |
5334 | DO 310 I=281,296 | |
5335 | MSUB(I)=1 | |
5336 | 310 CONTINUE | |
5337 | ENDIF | |
5338 | ||
5339 | ELSEIF(MSEL.EQ.50) THEN | |
5340 | C...Pair production of technipions and gauge bosons. | |
5341 | DO 320 I=361,368 | |
5342 | MSUB(I)=1 | |
5343 | 320 CONTINUE | |
5344 | IF(MINT(43).EQ.4) THEN | |
5345 | DO 330 I=370,377 | |
5346 | MSUB(I)=1 | |
5347 | 330 CONTINUE | |
5348 | ENDIF | |
5349 | ||
5350 | ELSEIF(MSEL.EQ.51) THEN | |
5351 | C...QCD 2 -> 2 processes with compositeness/technicolor modifications. | |
5352 | DO 340 I=381,386 | |
5353 | MSUB(I)=1 | |
5354 | 340 CONTINUE | |
5355 | ENDIF | |
5356 | ||
5357 | C...Find heaviest new quark flavour allowed in processes 81-84. | |
5358 | KFLQM=1 | |
5359 | DO 350 I=1,MIN(8,MDCY(21,3)) | |
5360 | IDC=I+MDCY(21,2)-1 | |
5361 | IF(MDME(IDC,1).LE.0) GOTO 350 | |
5362 | KFLQM=I | |
5363 | 350 CONTINUE | |
5364 | IF(MSTP(7).GE.1.AND.MSTP(7).LE.8.AND.(MSEL.LE.3.OR.MSEL.GE.9)) | |
5365 | &KFLQM=MSTP(7) | |
5366 | MINT(55)=KFLQM | |
5367 | KFPR(81,1)=KFLQM | |
5368 | KFPR(81,2)=KFLQM | |
5369 | KFPR(82,1)=KFLQM | |
5370 | KFPR(82,2)=KFLQM | |
5371 | KFPR(83,1)=KFLQM | |
5372 | KFPR(84,1)=KFLQM | |
5373 | KFPR(84,2)=KFLQM | |
5374 | ||
5375 | C...Find heaviest new fermion flavour allowed in process 85. | |
5376 | KFLFM=1 | |
5377 | DO 360 I=1,MIN(12,MDCY(22,3)) | |
5378 | IDC=I+MDCY(22,2)-1 | |
5379 | IF(MDME(IDC,1).LE.0) GOTO 360 | |
5380 | KFLFM=KFDP(IDC,1) | |
5381 | 360 CONTINUE | |
5382 | IF(((MSTP(7).GE.1.AND.MSTP(7).LE.8).OR.(MSTP(7).GE.11.AND. | |
5383 | &MSTP(7).LE.18)).AND.(MSEL.LE.3.OR.MSEL.GE.9)) KFLFM=MSTP(7) | |
5384 | MINT(56)=KFLFM | |
5385 | KFPR(85,1)=KFLFM | |
5386 | KFPR(85,2)=KFLFM | |
5387 | ||
5388 | C...Import relevant information on external user processes. | |
5389 | IF(MINT(111).EQ.11) THEN | |
5390 | IPYPR=0 | |
5391 | DO 390 IUP=1,NPRUP | |
5392 | C...Find next empty PYTHIA process number slot and enable it. | |
5393 | 370 IPYPR=IPYPR+1 | |
5394 | IF(IPYPR.GT.500) CALL PYERRM(26, | |
5395 | & '(PYINPR.) no more empty slots for user processes') | |
5396 | IF(ISET(IPYPR).GE.0.AND.ISET(IPYPR).LE.9) GOTO 370 | |
5397 | IF(IPYPR.GE.91.AND.IPYPR.LE.100) GOTO 370 | |
5398 | ISET(IPYPR)=11 | |
5399 | C...Overwrite KFPR with references back to process number and ID. | |
5400 | KFPR(IPYPR,1)=IUP | |
5401 | KFPR(IPYPR,2)=LPRUP(IUP) | |
5402 | C...Process title. | |
5403 | WRITE(CHIPR,'(I10)') LPRUP(IUP) | |
5404 | ICHIN=1 | |
5405 | DO 380 ICH=1,9 | |
5406 | IF(CHIPR(ICH:ICH).EQ.' ') ICHIN=ICH+1 | |
5407 | 380 CONTINUE | |
5408 | PROC(IPYPR)='User process '//CHIPR(ICHIN:10)//' ' | |
5409 | C...Switch on process. | |
5410 | MSUB(IPYPR)=1 | |
5411 | 390 CONTINUE | |
5412 | ENDIF | |
5413 | ||
5414 | RETURN | |
5415 | END | |
5416 | ||
5417 | C********************************************************************* | |
5418 | ||
5419 | C...PYXTOT | |
5420 | C...Parametrizes total, elastic and diffractive cross-sections | |
5421 | C...for different energies and beams. Donnachie-Landshoff for | |
5422 | C...total and Schuler-Sjostrand for elastic and diffractive. | |
5423 | C...Process code IPROC: | |
5424 | C...= 1 : p + p; | |
5425 | C...= 2 : pbar + p; | |
5426 | C...= 3 : pi+ + p; | |
5427 | C...= 4 : pi- + p; | |
5428 | C...= 5 : pi0 + p; | |
5429 | C...= 6 : phi + p; | |
5430 | C...= 7 : J/psi + p; | |
5431 | C...= 11 : rho + rho; | |
5432 | C...= 12 : rho + phi; | |
5433 | C...= 13 : rho + J/psi; | |
5434 | C...= 14 : phi + phi; | |
5435 | C...= 15 : phi + J/psi; | |
5436 | C...= 16 : J/psi + J/psi; | |
5437 | C...= 21 : gamma + p (DL); | |
5438 | C...= 22 : gamma + p (VDM). | |
5439 | C...= 23 : gamma + pi (DL); | |
5440 | C...= 24 : gamma + pi (VDM); | |
5441 | C...= 25 : gamma + gamma (DL); | |
5442 | C...= 26 : gamma + gamma (VDM). | |
5443 | ||
5444 | SUBROUTINE PYXTOT | |
5445 | ||
5446 | C...Double precision and integer declarations. | |
5447 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
5448 | IMPLICIT INTEGER(I-N) | |
5449 | INTEGER PYK,PYCHGE,PYCOMP | |
5450 | C...Commonblocks. | |
5451 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5452 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
5453 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
5454 | COMMON/PYINT1/MINT(400),VINT(400) | |
5455 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
5456 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
5457 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT5/,/PYINT7/ | |
5458 | C...Local arrays. | |
5459 | DIMENSION NPROC(30),XPAR(30),YPAR(30),IHADA(20),IHADB(20), | |
5460 | &PMHAD(4),BHAD(4),BETP(4),IFITSD(20),IFITDD(20),CEFFS(10,8), | |
5461 | &CEFFD(10,9),SIGTMP(6,0:5) | |
5462 | ||
5463 | C...Common constants. | |
5464 | DATA EPS/0.0808D0/, ETA/-0.4525D0/, ALP/0.25D0/, CRES/2D0/, | |
5465 | &PMRC/1.062D0/, SMP/0.880D0/, FACEL/0.0511D0/, FACSD/0.0336D0/, | |
5466 | &FACDD/0.0084D0/ | |
5467 | ||
5468 | C...Number of multiple processes to be evaluated (= 0 : undefined). | |
5469 | DATA NPROC/7*1,3*0,6*1,4*0,4*3,2*6,4*0/ | |
5470 | C...X and Y parameters of sigmatot = X * s**epsilon + Y * s**(-eta). | |
5471 | DATA XPAR/2*21.70D0,3*13.63D0,10.01D0,0.970D0,3*0D0, | |
5472 | &8.56D0,6.29D0,0.609D0,4.62D0,0.447D0,0.0434D0,4*0D0, | |
5473 | &0.0677D0,0.0534D0,0.0425D0,0.0335D0,2.11D-4,1.31D-4,4*0D0/ | |
5474 | DATA YPAR/ | |
5475 | &56.08D0,98.39D0,27.56D0,36.02D0,31.79D0,-1.51D0,-0.146D0,3*0D0, | |
5476 | &13.08D0,-0.62D0,-0.060D0,0.030D0,-0.0028D0,0.00028D0,4*0D0, | |
5477 | &0.129D0,0.115D0,0.081D0,0.072D0,2.15D-4,1.70D-4,4*0D0/ | |
5478 | ||
5479 | C...Beam and target hadron class: | |
5480 | C...= 1 : p/n ; = 2 : pi/rho/omega; = 3 : phi; = 4 : J/psi. | |
5481 | DATA IHADA/2*1,3*2,3,4,3*0,3*2,2*3,4,4*0/ | |
5482 | DATA IHADB/7*1,3*0,2,3,4,3,2*4,4*0/ | |
5483 | C...Characteristic class masses, slope parameters, beta = sqrt(X). | |
5484 | DATA PMHAD/0.938D0,0.770D0,1.020D0,3.097D0/ | |
5485 | DATA BHAD/2.3D0,1.4D0,1.4D0,0.23D0/ | |
5486 | DATA BETP/4.658D0,2.926D0,2.149D0,0.208D0/ | |
5487 | ||
5488 | C...Fitting constants used in parametrizations of diffractive results. | |
5489 | DATA IFITSD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/ | |
5490 | DATA IFITDD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/ | |
5491 | DATA ((CEFFS(J1,J2),J2=1,8),J1=1,10)/ | |
5492 | &0.213D0, 0.0D0, -0.47D0, 150D0, 0.213D0, 0.0D0, -0.47D0, 150D0, | |
5493 | &0.213D0, 0.0D0, -0.47D0, 150D0, 0.267D0, 0.0D0, -0.47D0, 100D0, | |
5494 | &0.213D0, 0.0D0, -0.47D0, 150D0, 0.232D0, 0.0D0, -0.47D0, 110D0, | |
5495 | &0.213D0, 7.0D0, -0.55D0, 800D0, 0.115D0, 0.0D0, -0.47D0, 110D0, | |
5496 | &0.267D0, 0.0D0, -0.46D0, 75D0, 0.267D0, 0.0D0, -0.46D0, 75D0, | |
5497 | &0.232D0, 0.0D0, -0.46D0, 85D0, 0.267D0, 0.0D0, -0.48D0, 100D0, | |
5498 | &0.115D0, 0.0D0, -0.50D0, 90D0, 0.267D0, 6.0D0, -0.56D0, 420D0, | |
5499 | &0.232D0, 0.0D0, -0.48D0, 110D0, 0.232D0, 0.0D0, -0.48D0, 110D0, | |
5500 | &0.115D0, 0.0D0, -0.52D0, 120D0, 0.232D0, 6.0D0, -0.56D0, 470D0, | |
5501 | &0.115D0, 5.5D0, -0.58D0, 570D0, 0.115D0, 5.5D0, -0.58D0, 570D0/ | |
5502 | DATA ((CEFFD(J1,J2),J2=1,9),J1=1,10)/ | |
5503 | &3.11D0, -7.34D0, 9.71D0, 0.068D0, -0.42D0, 1.31D0, | |
5504 | &-1.37D0, 35.0D0, 118D0, 3.11D0, -7.10D0, 10.6D0, | |
5505 | &0.073D0, -0.41D0, 1.17D0, -1.41D0, 31.6D0, 95D0, | |
5506 | &3.12D0, -7.43D0, 9.21D0, 0.067D0, -0.44D0, 1.41D0, | |
5507 | &-1.35D0, 36.5D0, 132D0, 3.13D0, -8.18D0, -4.20D0, | |
5508 | &0.056D0, -0.71D0, 3.12D0, -1.12D0, 55.2D0, 1298D0, | |
5509 | &3.11D0, -6.90D0, 11.4D0, 0.078D0, -0.40D0, 1.05D0, | |
5510 | &-1.40D0, 28.4D0, 78D0, 3.11D0, -7.13D0, 10.0D0, | |
5511 | &0.071D0, -0.41D0, 1.23D0, -1.34D0, 33.1D0, 105D0, | |
5512 | &3.12D0, -7.90D0, -1.49D0, 0.054D0, -0.64D0, 2.72D0, | |
5513 | &-1.13D0, 53.1D0, 995D0, 3.11D0, -7.39D0, 8.22D0, | |
5514 | &0.065D0, -0.44D0, 1.45D0, -1.36D0, 38.1D0, 148D0, | |
5515 | &3.18D0, -8.95D0, -3.37D0, 0.057D0, -0.76D0, 3.32D0, | |
5516 | &-1.12D0, 55.6D0, 1472D0, 4.18D0, -29.2D0, 56.2D0, | |
5517 | &0.074D0, -1.36D0, 6.67D0, -1.14D0, 116.2D0, 6532D0/ | |
5518 | ||
5519 | C...Parameters. Combinations of the energy. | |
5520 | AEM=PARU(101) | |
5521 | PMTH=PARP(102) | |
5522 | S=VINT(2) | |
5523 | SRT=VINT(1) | |
5524 | SEPS=S**EPS | |
5525 | SETA=S**ETA | |
5526 | SLOG=LOG(S) | |
5527 | ||
5528 | C...Ratio of gamma/pi (for rescaling in parton distributions). | |
5529 | VINT(281)=(XPAR(22)*SEPS+YPAR(22)*SETA)/ | |
5530 | &(XPAR(5)*SEPS+YPAR(5)*SETA) | |
5531 | VINT(317)=1D0 | |
5532 | IF(MINT(50).NE.1) RETURN | |
5533 | ||
5534 | C...Order flavours of incoming particles: KF1 < KF2. | |
5535 | IF(IABS(MINT(11)).LE.IABS(MINT(12))) THEN | |
5536 | KF1=IABS(MINT(11)) | |
5537 | KF2=IABS(MINT(12)) | |
5538 | IORD=1 | |
5539 | ELSE | |
5540 | KF1=IABS(MINT(12)) | |
5541 | KF2=IABS(MINT(11)) | |
5542 | IORD=2 | |
5543 | ENDIF | |
5544 | ISGN12=ISIGN(1,MINT(11)*MINT(12)) | |
5545 | ||
5546 | C...Find process number (for lookup tables). | |
5547 | IF(KF1.GT.1000) THEN | |
5548 | IPROC=1 | |
5549 | IF(ISGN12.LT.0) IPROC=2 | |
5550 | ELSEIF(KF1.GT.100.AND.KF2.GT.1000) THEN | |
5551 | IPROC=3 | |
5552 | IF(ISGN12.LT.0) IPROC=4 | |
5553 | IF(KF1.EQ.111) IPROC=5 | |
5554 | ELSEIF(KF1.GT.100) THEN | |
5555 | IPROC=11 | |
5556 | ELSEIF(KF2.GT.1000) THEN | |
5557 | IPROC=21 | |
5558 | IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=22 | |
5559 | ELSEIF(KF2.GT.100) THEN | |
5560 | IPROC=23 | |
5561 | IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=24 | |
5562 | ELSE | |
5563 | IPROC=25 | |
5564 | IF(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7) IPROC=26 | |
5565 | ENDIF | |
5566 | ||
5567 | C... Number of multiple processes to be stored; beam/target side. | |
5568 | NPR=NPROC(IPROC) | |
5569 | MINT(101)=1 | |
5570 | MINT(102)=1 | |
5571 | IF(NPR.EQ.3) THEN | |
5572 | MINT(100+IORD)=4 | |
5573 | ELSEIF(NPR.EQ.6) THEN | |
5574 | MINT(101)=4 | |
5575 | MINT(102)=4 | |
5576 | ENDIF | |
5577 | N1=0 | |
5578 | IF(MINT(101).EQ.4) N1=4 | |
5579 | N2=0 | |
5580 | IF(MINT(102).EQ.4) N2=4 | |
5581 | ||
5582 | C...Do not do any more for user-set or undefined cross-sections. | |
5583 | IF(MSTP(31).LE.0) RETURN | |
5584 | IF(NPR.EQ.0) CALL PYERRM(26, | |
5585 | &'(PYXTOT:) cross section for this process not yet implemented') | |
5586 | ||
5587 | C...Parameters. Combinations of the energy. | |
5588 | AEM=PARU(101) | |
5589 | PMTH=PARP(102) | |
5590 | S=VINT(2) | |
5591 | SRT=VINT(1) | |
5592 | SEPS=S**EPS | |
5593 | SETA=S**ETA | |
5594 | SLOG=LOG(S) | |
5595 | ||
5596 | C...Loop over multiple processes (for VDM). | |
5597 | DO 110 I=1,NPR | |
5598 | IF(NPR.EQ.1) THEN | |
5599 | IPR=IPROC | |
5600 | ELSEIF(NPR.EQ.3) THEN | |
5601 | IPR=I+4 | |
5602 | IF(KF2.LT.1000) IPR=I+10 | |
5603 | ELSEIF(NPR.EQ.6) THEN | |
5604 | IPR=I+10 | |
5605 | ENDIF | |
5606 | ||
5607 | C...Evaluate hadron species, mass, slope contribution and fit number. | |
5608 | IHA=IHADA(IPR) | |
5609 | IHB=IHADB(IPR) | |
5610 | PMA=PMHAD(IHA) | |
5611 | PMB=PMHAD(IHB) | |
5612 | BHA=BHAD(IHA) | |
5613 | BHB=BHAD(IHB) | |
5614 | ISD=IFITSD(IPR) | |
5615 | IDD=IFITDD(IPR) | |
5616 | ||
5617 | C...Skip if energy too low relative to masses. | |
5618 | DO 100 J=0,5 | |
5619 | SIGTMP(I,J)=0D0 | |
5620 | 100 CONTINUE | |
5621 | IF(SRT.LT.PMA+PMB+PARP(104)) GOTO 110 | |
5622 | ||
5623 | C...Total cross-section. Elastic slope parameter and cross-section. | |
5624 | SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA | |
5625 | BEL=2D0*BHA+2D0*BHB+4D0*SEPS-4.2D0 | |
5626 | SIGTMP(I,1)=FACEL*SIGTMP(I,0)**2/BEL | |
5627 | ||
5628 | C...Diffractive scattering A + B -> X + B. | |
5629 | BSD=2D0*BHB | |
5630 | SQML=(PMA+PMTH)**2 | |
5631 | SQMU=S*CEFFS(ISD,1)+CEFFS(ISD,2) | |
5632 | SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/ | |
5633 | & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP) | |
5634 | BXB=CEFFS(ISD,3)+CEFFS(ISD,4)/S | |
5635 | SUM2=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)/ | |
5636 | & (BSD+2D0*ALP*LOG(S/((PMA+PMTH)*(PMA+PMRC)))+BXB) | |
5637 | SIGTMP(I,2)=FACSD*XPAR(IPR)*BETP(IHB)*MAX(0D0,SUM1+SUM2) | |
5638 | ||
5639 | C...Diffractive scattering A + B -> A + X. | |
5640 | BSD=2D0*BHA | |
5641 | SQML=(PMB+PMTH)**2 | |
5642 | SQMU=S*CEFFS(ISD,5)+CEFFS(ISD,6) | |
5643 | SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/ | |
5644 | & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP) | |
5645 | BAX=CEFFS(ISD,7)+CEFFS(ISD,8)/S | |
5646 | SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/ | |
5647 | & (BSD+2D0*ALP*LOG(S/((PMB+PMTH)*(PMB+PMRC)))+BAX) | |
5648 | SIGTMP(I,3)=FACSD*XPAR(IPR)*BETP(IHA)*MAX(0D0,SUM1+SUM2) | |
5649 | ||
5650 | C...Order single diffractive correctly. | |
5651 | IF(IORD.EQ.2) THEN | |
5652 | SIGSAV=SIGTMP(I,2) | |
5653 | SIGTMP(I,2)=SIGTMP(I,3) | |
5654 | SIGTMP(I,3)=SIGSAV | |
5655 | ENDIF | |
5656 | ||
5657 | C...Double diffractive scattering A + B -> X1 + X2. | |
5658 | YEFF=LOG(S*SMP/((PMA+PMTH)*(PMB+PMTH))**2) | |
5659 | DEFF=CEFFD(IDD,1)+CEFFD(IDD,2)/SLOG+CEFFD(IDD,3)/SLOG**2 | |
5660 | SUM1=DEFF+YEFF*(LOG(MAX(1D-10,YEFF/DEFF))-1D0)/(2D0*ALP) | |
5661 | IF(YEFF.LE.0) SUM1=0D0 | |
5662 | SQMU=S*(CEFFD(IDD,4)+CEFFD(IDD,5)/SLOG+CEFFD(IDD,6)/SLOG**2) | |
5663 | SLUP=LOG(MAX(1.1D0,S/(ALP*(PMA+PMTH)**2*(PMB+PMTH)*(PMB+PMRC)))) | |
5664 | SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMB+PMTH)*(PMB+PMRC)))) | |
5665 | SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)*LOG(SLUP/SLDN)/ | |
5666 | & (2D0*ALP) | |
5667 | SLUP=LOG(MAX(1.1D0,S/(ALP*(PMB+PMTH)**2*(PMA+PMTH)*(PMA+PMRC)))) | |
5668 | SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMA+PMTH)*(PMA+PMRC)))) | |
5669 | SUM3=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*LOG(SLUP/SLDN)/ | |
5670 | & (2D0*ALP) | |
5671 | BXX=CEFFD(IDD,7)+CEFFD(IDD,8)/SRT+CEFFD(IDD,9)/S | |
5672 | SLRR=LOG(S/(ALP*(PMA+PMTH)*(PMA+PMRC)*(PMB+PMTH)*(PMB*PMRC))) | |
5673 | SUM4=CRES**2*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)* | |
5674 | & LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/MAX(0.1D0,2D0*ALP*SLRR+BXX) | |
5675 | SIGTMP(I,4)=FACDD*XPAR(IPR)*MAX(0D0,SUM1+SUM2+SUM3+SUM4) | |
5676 | ||
5677 | C...Non-diffractive by unitarity. | |
5678 | SIGTMP(I,5)=SIGTMP(I,0)-SIGTMP(I,1)-SIGTMP(I,2)-SIGTMP(I,3)- | |
5679 | & SIGTMP(I,4) | |
5680 | 110 CONTINUE | |
5681 | ||
5682 | C...Put temporary results in output array: only one process. | |
5683 | IF(MINT(101).EQ.1.AND.MINT(102).EQ.1) THEN | |
5684 | DO 120 J=0,5 | |
5685 | SIGT(0,0,J)=SIGTMP(1,J) | |
5686 | 120 CONTINUE | |
5687 | ||
5688 | C...Beam multiple processes. | |
5689 | ELSEIF(MINT(101).EQ.4.AND.MINT(102).EQ.1) THEN | |
5690 | IF(MINT(107).EQ.2) THEN | |
5691 | VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2 | |
5692 | ELSE | |
5693 | VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ | |
5694 | & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307))) | |
5695 | ENDIF | |
5696 | IF(MSTP(20).GT.0) THEN | |
5697 | VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)))**MSTP(20) | |
5698 | ENDIF | |
5699 | DO 140 I=1,4 | |
5700 | IF(MINT(107).EQ.2) THEN | |
5701 | CONV=(AEM/PARP(160+I))*VINT(317) | |
5702 | ELSEIF(VINT(154).GT.PARP(15)) THEN | |
5703 | CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2* | |
5704 | & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) | |
5705 | ELSE | |
5706 | CONV=0D0 | |
5707 | ENDIF | |
5708 | I1=MAX(1,I-1) | |
5709 | DO 130 J=0,5 | |
5710 | SIGT(I,0,J)=CONV*SIGTMP(I1,J) | |
5711 | 130 CONTINUE | |
5712 | 140 CONTINUE | |
5713 | DO 150 J=0,5 | |
5714 | SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J) | |
5715 | 150 CONTINUE | |
5716 | ||
5717 | C...Target multiple processes. | |
5718 | ELSEIF(MINT(101).EQ.1.AND.MINT(102).EQ.4) THEN | |
5719 | IF(MINT(108).EQ.2) THEN | |
5720 | VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2 | |
5721 | ELSE | |
5722 | VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ | |
5723 | & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308))) | |
5724 | ENDIF | |
5725 | IF(MSTP(20).GT.0) THEN | |
5726 | VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(308)))**MSTP(20) | |
5727 | ENDIF | |
5728 | DO 170 I=1,4 | |
5729 | IF(MINT(108).EQ.2) THEN | |
5730 | CONV=(AEM/PARP(160+I))*VINT(317) | |
5731 | ELSEIF(VINT(154).GT.PARP(15)) THEN | |
5732 | CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2* | |
5733 | & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) | |
5734 | ELSE | |
5735 | CONV=0D0 | |
5736 | ENDIF | |
5737 | IV=MAX(1,I-1) | |
5738 | DO 160 J=0,5 | |
5739 | SIGT(0,I,J)=CONV*SIGTMP(IV,J) | |
5740 | 160 CONTINUE | |
5741 | 170 CONTINUE | |
5742 | DO 180 J=0,5 | |
5743 | SIGT(0,0,J)=SIGT(0,1,J)+SIGT(0,2,J)+SIGT(0,3,J)+SIGT(0,4,J) | |
5744 | 180 CONTINUE | |
5745 | ||
5746 | C...Both beam and target multiple processes. | |
5747 | ELSE | |
5748 | IF(MINT(107).EQ.2) THEN | |
5749 | VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2 | |
5750 | ELSE | |
5751 | VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ | |
5752 | & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307))) | |
5753 | ENDIF | |
5754 | IF(MINT(108).EQ.2) THEN | |
5755 | VINT(317)=VINT(317)*(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2 | |
5756 | ELSE | |
5757 | VINT(317)=VINT(317)*16D0*PARP(15)**2*VINT(154)**2/ | |
5758 | & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308))) | |
5759 | ENDIF | |
5760 | IF(MSTP(20).GT.0) THEN | |
5761 | VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)+ | |
5762 | & VINT(308)))**MSTP(20) | |
5763 | ENDIF | |
5764 | DO 210 I1=1,4 | |
5765 | DO 200 I2=1,4 | |
5766 | IF(MINT(107).EQ.2) THEN | |
5767 | CONV=(AEM/PARP(160+I1))*VINT(317) | |
5768 | ELSEIF(VINT(154).GT.PARP(15)) THEN | |
5769 | CONV=(AEM/PARU(1))*(KCHG(I1,1)/3D0)**2*PARP(18)**2* | |
5770 | & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) | |
5771 | ELSE | |
5772 | CONV=0D0 | |
5773 | ENDIF | |
5774 | IF(MINT(108).EQ.2) THEN | |
5775 | CONV=CONV*(AEM/PARP(160+I2)) | |
5776 | ELSEIF(VINT(154).GT.PARP(15)) THEN | |
5777 | CONV=CONV*(AEM/PARU(1))*(KCHG(I2,1)/3D0)**2*PARP(18)**2* | |
5778 | & (1D0/PARP(15)**2-1D0/VINT(154)**2) | |
5779 | ELSE | |
5780 | CONV=0D0 | |
5781 | ENDIF | |
5782 | IF(I1.LE.2) THEN | |
5783 | IV=MAX(1,I2-1) | |
5784 | ELSEIF(I2.LE.2) THEN | |
5785 | IV=MAX(1,I1-1) | |
5786 | ELSEIF(I1.EQ.I2) THEN | |
5787 | IV=2*I1-2 | |
5788 | ELSE | |
5789 | IV=5 | |
5790 | ENDIF | |
5791 | DO 190 J=0,5 | |
5792 | JV=J | |
5793 | IF(I2.GT.I1.AND.(J.EQ.2.OR.J.EQ.3)) JV=5-J | |
5794 | SIGT(I1,I2,J)=CONV*SIGTMP(IV,JV) | |
5795 | 190 CONTINUE | |
5796 | 200 CONTINUE | |
5797 | 210 CONTINUE | |
5798 | DO 230 J=0,5 | |
5799 | DO 220 I=1,4 | |
5800 | SIGT(I,0,J)=SIGT(I,1,J)+SIGT(I,2,J)+SIGT(I,3,J)+SIGT(I,4,J) | |
5801 | SIGT(0,I,J)=SIGT(1,I,J)+SIGT(2,I,J)+SIGT(3,I,J)+SIGT(4,I,J) | |
5802 | 220 CONTINUE | |
5803 | SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J) | |
5804 | 230 CONTINUE | |
5805 | ENDIF | |
5806 | ||
5807 | C...Scale up uniformly for Donnachie-Landshoff parametrization. | |
5808 | IF(IPROC.EQ.21.OR.IPROC.EQ.23.OR.IPROC.EQ.25) THEN | |
5809 | RFAC=(XPAR(IPROC)*SEPS+YPAR(IPROC)*SETA)/SIGT(0,0,0) | |
5810 | DO 260 I1=0,N1 | |
5811 | DO 250 I2=0,N2 | |
5812 | DO 240 J=0,5 | |
5813 | SIGT(I1,I2,J)=RFAC*SIGT(I1,I2,J) | |
5814 | 240 CONTINUE | |
5815 | 250 CONTINUE | |
5816 | 260 CONTINUE | |
5817 | ENDIF | |
5818 | ||
5819 | RETURN | |
5820 | END | |
5821 | ||
5822 | C********************************************************************* | |
5823 | ||
5824 | C...PYMAXI | |
5825 | C...Finds optimal set of coefficients for kinematical variable selection | |
5826 | C...and the maximum of the part of the differential cross-section used | |
5827 | C...in the event weighting. | |
5828 | ||
5829 | SUBROUTINE PYMAXI | |
5830 | ||
5831 | C...Double precision and integer declarations. | |
5832 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
5833 | IMPLICIT INTEGER(I-N) | |
5834 | INTEGER PYK,PYCHGE,PYCOMP | |
5835 | C...Parameter statement to help give large particle numbers. | |
5836 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
5837 | &KEXCIT=4000000,KDIMEN=5000000) | |
5838 | ||
5839 | C...User process initialization commonblock. | |
5840 | INTEGER MAXPUP | |
5841 | PARAMETER (MAXPUP=100) | |
5842 | INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP | |
5843 | DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP | |
5844 | COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), | |
5845 | &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), | |
5846 | &LPRUP(MAXPUP) | |
5847 | SAVE /HEPRUP/ | |
5848 | ||
5849 | C...Commonblocks. | |
5850 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5851 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
5852 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
5853 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
5854 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
5855 | COMMON/PYINT1/MINT(400),VINT(400) | |
5856 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
5857 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
5858 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
5859 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
5860 | COMMON/PYINT6/PROC(0:500) | |
5861 | CHARACTER PROC*28 | |
5862 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
5863 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
5864 | &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT6/,/PYINT7/ | |
5865 | C...Local arrays, character variables and data. | |
5866 | CHARACTER CVAR(4)*4 | |
5867 | DIMENSION NPTS(4),MVARPT(500,4),VINTPT(500,30),SIGSPT(500), | |
5868 | &NAREL(7),WTREL(7),WTMAT(7,7),WTRELN(7),COEFU(7),COEFO(7), | |
5869 | &IACCMX(4),SIGSMX(4),SIGSSM(3),PMMN(2) | |
5870 | DATA CVAR/'tau ','tau''','y* ','cth '/ | |
5871 | DATA SIGSSM/3*0D0/ | |
5872 | ||
5873 | C...Initial values and loop over subprocesses. | |
5874 | NPOSI=0 | |
5875 | VINT(143)=1D0 | |
5876 | VINT(144)=1D0 | |
5877 | XSEC(0,1)=0D0 | |
5878 | DO 460 ISUB=1,500 | |
5879 | MINT(1)=ISUB | |
5880 | MINT(51)=0 | |
5881 | ||
5882 | C...Find maximum weight factors for photon flux. | |
5883 | IF(MSUB(ISUB).EQ.1.OR.(ISUB.GE.91.AND.ISUB.LE.100)) THEN | |
5884 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(2,WTGAGA) | |
5885 | ENDIF | |
5886 | ||
5887 | C...Select subprocess to study: skip cases not applicable. | |
5888 | IF(ISET(ISUB).EQ.11) THEN | |
5889 | IF(MSUB(ISUB).NE.1) GOTO 460 | |
5890 | C...User process intialization: cross section model dependent. | |
5891 | IF(IABS(IDWTUP).EQ.1) THEN | |
5892 | IF(IDWTUP.GT.0.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL | |
5893 | & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process') | |
5894 | XSEC(ISUB,1)=1.00000001D-9*ABS(XMAXUP(KFPR(ISUB,1))) | |
5895 | ELSE | |
5896 | IF((IDWTUP.EQ.2.OR.IDWTUP.EQ.3).AND. | |
5897 | & XSECUP(KFPR(ISUB,1)).LT.0D0) CALL | |
5898 | & PYERRM(26,'(PYMAXI:) Negative XSECUP for user process') | |
5899 | IF(IDWTUP.EQ.2.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL | |
5900 | & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process') | |
5901 | XSEC(ISUB,1)=1.00000001D-9*ABS(XSECUP(KFPR(ISUB,1))) | |
5902 | ENDIF | |
5903 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= | |
5904 | & WTGAGA*XSEC(ISUB,1) | |
5905 | NPOSI=NPOSI+1 | |
5906 | GOTO 450 | |
5907 | ELSEIF(ISUB.GE.91.AND.ISUB.LE.95) THEN | |
5908 | CALL PYSIGH(NCHN,SIGS) | |
5909 | XSEC(ISUB,1)=SIGS | |
5910 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= | |
5911 | & WTGAGA*XSEC(ISUB,1) | |
5912 | IF(MSUB(ISUB).NE.1) GOTO 460 | |
5913 | NPOSI=NPOSI+1 | |
5914 | GOTO 450 | |
5915 | ELSEIF(ISUB.EQ.99.AND.MSUB(ISUB).EQ.1) THEN | |
5916 | CALL PYSIGH(NCHN,SIGS) | |
5917 | XSEC(ISUB,1)=SIGS | |
5918 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= | |
5919 | & WTGAGA*XSEC(ISUB,1) | |
5920 | IF(XSEC(ISUB,1).EQ.0D0) THEN | |
5921 | MSUB(ISUB)=0 | |
5922 | ELSE | |
5923 | NPOSI=NPOSI+1 | |
5924 | ENDIF | |
5925 | GOTO 450 | |
5926 | ELSEIF(ISUB.EQ.96) THEN | |
5927 | IF(MINT(50).EQ.0) GOTO 460 | |
5928 | IF(MSUB(95).NE.1.AND.MSTP(81).LE.0.AND.MSTP(131).LE.0) | |
5929 | & GOTO 460 | |
5930 | IF(MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 460 | |
5931 | ELSEIF(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.ISUB.EQ.28.OR. | |
5932 | & ISUB.EQ.53.OR.ISUB.EQ.68) THEN | |
5933 | IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460 | |
5934 | ELSEIF(ISUB.GE.381.AND.ISUB.LE.386) THEN | |
5935 | IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460 | |
5936 | ELSE | |
5937 | IF(MSUB(ISUB).NE.1) GOTO 460 | |
5938 | ENDIF | |
5939 | ISTSB=ISET(ISUB) | |
5940 | IF(ISUB.EQ.96) ISTSB=2 | |
5941 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5000) ISUB | |
5942 | MWTXS=0 | |
5943 | IF(MSTP(142).GE.1.AND.ISUB.NE.96.AND.MSUB(91)+MSUB(92)+MSUB(93)+ | |
5944 | & MSUB(94)+MSUB(95).EQ.0) MWTXS=1 | |
5945 | ||
5946 | C...Find resonances (explicit or implicit in cross-section). | |
5947 | MINT(72)=0 | |
5948 | KFR1=0 | |
5949 | IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN | |
5950 | KFR1=KFPR(ISUB,1) | |
5951 | ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165 | |
5952 | & .OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN | |
5953 | KFR1=23 | |
5954 | ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172 | |
5955 | & .OR.ISUB.EQ.177) THEN | |
5956 | KFR1=24 | |
5957 | ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN | |
5958 | KFR1=25 | |
5959 | IF(MSTP(46).EQ.5) THEN | |
5960 | KFR1=89 | |
5961 | PMAS(89,1)=PARP(45) | |
5962 | PMAS(89,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) | |
5963 | ENDIF | |
5964 | ELSEIF(ISUB.EQ.194) THEN | |
5965 | KFR1=KTECHN+113 | |
5966 | ELSEIF(ISUB.EQ.195) THEN | |
5967 | KFR1=KTECHN+213 | |
5968 | ELSEIF(ISUB.GE.361.AND.ISUB.LE.368) THEN | |
5969 | KFR1=KTECHN+113 | |
5970 | ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN | |
5971 | KFR1=KTECHN+213 | |
5972 | ENDIF | |
5973 | CKMX=CKIN(2) | |
5974 | IF(CKMX.LE.0D0) CKMX=VINT(1) | |
5975 | KCR1=PYCOMP(KFR1) | |
5976 | IF(KFR1.NE.0) THEN | |
5977 | IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. | |
5978 | & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 | |
5979 | ENDIF | |
5980 | IF(KFR1.NE.0) THEN | |
5981 | TAUR1=PMAS(KCR1,1)**2/VINT(2) | |
5982 | IF(KFR1.EQ.KTECHN+113) THEN | |
5983 | CALL PYTECM(S1,S2) | |
5984 | TAUR1=S1/VINT(2) | |
5985 | ENDIF | |
5986 | GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) | |
5987 | MINT(72)=1 | |
5988 | MINT(73)=KFR1 | |
5989 | VINT(73)=TAUR1 | |
5990 | VINT(74)=GAMR1 | |
5991 | ENDIF | |
5992 | KFR2=0 | |
5993 | IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.(ISUB.GE.364.AND.ISUB.LE.368)) | |
5994 | $ THEN | |
5995 | KFR2=23 | |
5996 | IF(ISUB.EQ.194) THEN | |
5997 | KFR2=KTECHN+223 | |
5998 | ELSEIF(ISUB.GE.364.AND.ISUB.LE.368) THEN | |
5999 | KFR2=KTECHN+223 | |
6000 | ENDIF | |
6001 | KCR2=PYCOMP(KFR2) | |
6002 | TAUR2=PMAS(KCR2,1)**2/VINT(2) | |
6003 | IF(KFR2.EQ.KTECHN+223) THEN | |
6004 | CALL PYTECM(S1,S2) | |
6005 | TAUR2=S2/VINT(2) | |
6006 | ENDIF | |
6007 | GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) | |
6008 | IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. | |
6009 | & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) KFR2=0 | |
6010 | IF(KFR2.NE.0.AND.KFR1.NE.0) THEN | |
6011 | MINT(72)=2 | |
6012 | MINT(74)=KFR2 | |
6013 | VINT(75)=TAUR2 | |
6014 | VINT(76)=GAMR2 | |
6015 | ELSEIF(KFR2.NE.0) THEN | |
6016 | KFR1=KFR2 | |
6017 | TAUR1=TAUR2 | |
6018 | GAMR1=GAMR2 | |
6019 | MINT(72)=1 | |
6020 | MINT(73)=KFR1 | |
6021 | VINT(73)=TAUR1 | |
6022 | VINT(74)=GAMR1 | |
6023 | KFR2=0 | |
6024 | ENDIF | |
6025 | ENDIF | |
6026 | ||
6027 | C...Find product masses and minimum pT of process. | |
6028 | SQM3=0D0 | |
6029 | SQM4=0D0 | |
6030 | MINT(71)=0 | |
6031 | VINT(71)=CKIN(3) | |
6032 | VINT(80)=1D0 | |
6033 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN | |
6034 | NBW=0 | |
6035 | DO 110 I=1,2 | |
6036 | PMMN(I)=0D0 | |
6037 | IF(KFPR(ISUB,I).EQ.0) THEN | |
6038 | ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT. | |
6039 | & PARP(41)) THEN | |
6040 | IF(I.EQ.1) SQM3=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 | |
6041 | IF(I.EQ.2) SQM4=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 | |
6042 | ELSE | |
6043 | NBW=NBW+1 | |
6044 | C...This prevents SUSY/t particles from becoming too light. | |
6045 | KFLW=KFPR(ISUB,I) | |
6046 | IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN | |
6047 | KCW=PYCOMP(KFLW) | |
6048 | PMMN(I)=PMAS(KCW,1) | |
6049 | DO 100 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 | |
6050 | IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN | |
6051 | PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ | |
6052 | & PMAS(PYCOMP(KFDP(IDC,2)),1) | |
6053 | IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ | |
6054 | & PMAS(PYCOMP(KFDP(IDC,3)),1) | |
6055 | PMMN(I)=MIN(PMMN(I),PMSUM) | |
6056 | ENDIF | |
6057 | 100 CONTINUE | |
6058 | ELSEIF(KFLW.EQ.6) THEN | |
6059 | PMMN(I)=PMAS(24,1)+PMAS(5,1) | |
6060 | ENDIF | |
6061 | ENDIF | |
6062 | 110 CONTINUE | |
6063 | IF(NBW.GE.1) THEN | |
6064 | CKIN41=CKIN(41) | |
6065 | CKIN43=CKIN(43) | |
6066 | CKIN(41)=MAX(PMMN(1),CKIN(41)) | |
6067 | CKIN(43)=MAX(PMMN(2),CKIN(43)) | |
6068 | CALL PYOFSH(3,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) | |
6069 | CKIN(41)=CKIN41 | |
6070 | CKIN(43)=CKIN43 | |
6071 | IF(MINT(51).EQ.1) THEN | |
6072 | WRITE(MSTU(11),5100) ISUB | |
6073 | MSUB(ISUB)=0 | |
6074 | GOTO 460 | |
6075 | ENDIF | |
6076 | SQM3=PQM3**2 | |
6077 | SQM4=PQM4**2 | |
6078 | ENDIF | |
6079 | IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) MINT(71)=1 | |
6080 | IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) | |
6081 | IF(ISUB.EQ.96.AND.MSTP(82).LE.1) THEN | |
6082 | VINT(71)=PARP(81)*(VINT(1)/PARP(89))**PARP(90) | |
6083 | ELSEIF(ISUB.EQ.96) THEN | |
6084 | VINT(71)=0.08D0*PARP(82)*(VINT(1)/PARP(89))**PARP(90) | |
6085 | ENDIF | |
6086 | ENDIF | |
6087 | VINT(63)=SQM3 | |
6088 | VINT(64)=SQM4 | |
6089 | ||
6090 | C...Prepare for additional variable choices in 2 -> 3. | |
6091 | IF(ISTSB.EQ.5) THEN | |
6092 | VINT(201)=0D0 | |
6093 | IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1) | |
6094 | VINT(206)=VINT(201) | |
6095 | VINT(204)=PMAS(23,1) | |
6096 | IF(ISUB.EQ.124.OR.ISUB.EQ.351) VINT(204)=PMAS(24,1) | |
6097 | IF(ISUB.EQ.352) VINT(204)=PMAS(PYCOMP(9900024),1) | |
6098 | IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182 | |
6099 | & .OR.ISUB.EQ.186.OR.ISUB.EQ.187) VINT(204)=VINT(201) | |
6100 | VINT(209)=VINT(204) | |
6101 | ENDIF | |
6102 | ||
6103 | C...Number of points for each variable: tau, tau', y*, cos(theta-hat). | |
6104 | NPTS(1)=2+2*MINT(72) | |
6105 | IF(MINT(47).EQ.1) THEN | |
6106 | IF(ISTSB.EQ.1.OR.ISTSB.EQ.2) NPTS(1)=1 | |
6107 | ELSEIF(MINT(47).GE.5) THEN | |
6108 | IF(ISTSB.LE.2.OR.ISTSB.GT.5) NPTS(1)=NPTS(1)+1 | |
6109 | ENDIF | |
6110 | NPTS(2)=1 | |
6111 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN | |
6112 | IF(MINT(47).GE.2) NPTS(2)=2 | |
6113 | IF(MINT(47).GE.5) NPTS(2)=3 | |
6114 | ENDIF | |
6115 | NPTS(3)=1 | |
6116 | IF(MINT(47).EQ.4.OR.MINT(47).EQ.5) THEN | |
6117 | NPTS(3)=3 | |
6118 | IF(MINT(45).EQ.3) NPTS(3)=NPTS(3)+1 | |
6119 | IF(MINT(46).EQ.3) NPTS(3)=NPTS(3)+1 | |
6120 | ENDIF | |
6121 | NPTS(4)=1 | |
6122 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) NPTS(4)=5 | |
6123 | NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4) | |
6124 | ||
6125 | C...Reset coefficients of cross-section weighting. | |
6126 | DO 120 J=1,20 | |
6127 | COEF(ISUB,J)=0D0 | |
6128 | 120 CONTINUE | |
6129 | COEF(ISUB,1)=1D0 | |
6130 | COEF(ISUB,8)=0.5D0 | |
6131 | COEF(ISUB,9)=0.5D0 | |
6132 | COEF(ISUB,13)=1D0 | |
6133 | COEF(ISUB,18)=1D0 | |
6134 | MCTH=0 | |
6135 | MTAUP=0 | |
6136 | METAUP=0 | |
6137 | VINT(23)=0D0 | |
6138 | VINT(26)=0D0 | |
6139 | SIGSAM=0D0 | |
6140 | ||
6141 | C...Find limits and select tau, y*, cos(theta-hat) and tau' values, | |
6142 | C...in grid of phase space points. | |
6143 | CALL PYKLIM(1) | |
6144 | METAU=MINT(51) | |
6145 | NACC=0 | |
6146 | DO 150 ITRY=1,NTRY | |
6147 | MINT(51)=0 | |
6148 | IF(METAU.EQ.1) GOTO 150 | |
6149 | IF(MOD(ITRY-1,NPTS(2)*NPTS(3)*NPTS(4)).EQ.0) THEN | |
6150 | MTAU=1+(ITRY-1)/(NPTS(2)*NPTS(3)*NPTS(4)) | |
6151 | IF(MTAU.GT.2+2*MINT(72)) MTAU=7 | |
6152 | RTAU=0.5D0 | |
6153 | C...Special case when both resonances have same mass, | |
6154 | C...as is often the case in process 194. | |
6155 | IF(MINT(72).EQ.2) THEN | |
6156 | IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LT. | |
6157 | & 0.01D0*(PMAS(KCR2,1)+PMAS(KCR1,1))) THEN | |
6158 | IF(MTAU.EQ.3.OR.MTAU.EQ.4) THEN | |
6159 | RTAU=0.4D0 | |
6160 | ELSEIF(MTAU.EQ.5.OR.MTAU.EQ.6) THEN | |
6161 | RTAU=0.6D0 | |
6162 | ENDIF | |
6163 | ENDIF | |
6164 | ENDIF | |
6165 | CALL PYKMAP(1,MTAU,RTAU) | |
6166 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) CALL PYKLIM(4) | |
6167 | METAUP=MINT(51) | |
6168 | ENDIF | |
6169 | IF(METAUP.EQ.1) GOTO 150 | |
6170 | IF(ISTSB.GE.3.AND.ISTSB.LE.5.AND.MOD(ITRY-1,NPTS(3)*NPTS(4)) | |
6171 | & .EQ.0) THEN | |
6172 | MTAUP=1+MOD((ITRY-1)/(NPTS(3)*NPTS(4)),NPTS(2)) | |
6173 | CALL PYKMAP(4,MTAUP,0.5D0) | |
6174 | ENDIF | |
6175 | IF(MOD(ITRY-1,NPTS(3)*NPTS(4)).EQ.0) THEN | |
6176 | CALL PYKLIM(2) | |
6177 | MEYST=MINT(51) | |
6178 | ENDIF | |
6179 | IF(MEYST.EQ.1) GOTO 150 | |
6180 | IF(MOD(ITRY-1,NPTS(4)).EQ.0) THEN | |
6181 | MYST=1+MOD((ITRY-1)/NPTS(4),NPTS(3)) | |
6182 | IF(MYST.EQ.4.AND.MINT(45).NE.3) MYST=5 | |
6183 | CALL PYKMAP(2,MYST,0.5D0) | |
6184 | CALL PYKLIM(3) | |
6185 | MECTH=MINT(51) | |
6186 | ENDIF | |
6187 | IF(MECTH.EQ.1) GOTO 150 | |
6188 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN | |
6189 | MCTH=1+MOD(ITRY-1,NPTS(4)) | |
6190 | CALL PYKMAP(3,MCTH,0.5D0) | |
6191 | ENDIF | |
6192 | IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1D0-VINT(23)**2) | |
6193 | ||
6194 | C...Store position and limits. | |
6195 | MINT(51)=0 | |
6196 | CALL PYKLIM(0) | |
6197 | IF(MINT(51).EQ.1) GOTO 150 | |
6198 | NACC=NACC+1 | |
6199 | MVARPT(NACC,1)=MTAU | |
6200 | MVARPT(NACC,2)=MTAUP | |
6201 | MVARPT(NACC,3)=MYST | |
6202 | MVARPT(NACC,4)=MCTH | |
6203 | DO 130 J=1,30 | |
6204 | VINTPT(NACC,J)=VINT(10+J) | |
6205 | 130 CONTINUE | |
6206 | ||
6207 | C...Normal case: calculate cross-section. | |
6208 | IF(ISTSB.NE.5) THEN | |
6209 | CALL PYSIGH(NCHN,SIGS) | |
6210 | IF(MWTXS.EQ.1) THEN | |
6211 | CALL PYEVWT(WTXS) | |
6212 | SIGS=WTXS*SIGS | |
6213 | ENDIF | |
6214 | ||
6215 | C..2 -> 3: find highest value out of a number of tries. | |
6216 | ELSE | |
6217 | SIGS=0D0 | |
6218 | DO 140 IKIN3=1,MSTP(129) | |
6219 | CALL PYKMAP(5,0,0D0) | |
6220 | IF(MINT(51).EQ.1) GOTO 140 | |
6221 | CALL PYSIGH(NCHN,SIGTMP) | |
6222 | IF(MWTXS.EQ.1) THEN | |
6223 | CALL PYEVWT(WTXS) | |
6224 | SIGTMP=WTXS*SIGTMP | |
6225 | ENDIF | |
6226 | IF(SIGTMP.GT.SIGS) SIGS=SIGTMP | |
6227 | 140 CONTINUE | |
6228 | ENDIF | |
6229 | ||
6230 | C...Store cross-section. | |
6231 | SIGSPT(NACC)=SIGS | |
6232 | IF(SIGS.GT.SIGSAM) SIGSAM=SIGS | |
6233 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5200) MTAU,MYST,MCTH,MTAUP, | |
6234 | & VINT(21),VINT(22),VINT(23),VINT(26),SIGS | |
6235 | 150 CONTINUE | |
6236 | IF(NACC.EQ.0) THEN | |
6237 | WRITE(MSTU(11),5100) ISUB | |
6238 | MSUB(ISUB)=0 | |
6239 | GOTO 460 | |
6240 | ELSEIF(SIGSAM.EQ.0D0) THEN | |
6241 | WRITE(MSTU(11),5300) ISUB | |
6242 | MSUB(ISUB)=0 | |
6243 | GOTO 460 | |
6244 | ENDIF | |
6245 | IF(ISUB.NE.96) NPOSI=NPOSI+1 | |
6246 | ||
6247 | C...Calculate integrals in tau over maximal phase space limits. | |
6248 | TAUMIN=VINT(11) | |
6249 | TAUMAX=VINT(31) | |
6250 | ATAU1=LOG(TAUMAX/TAUMIN) | |
6251 | IF(NPTS(1).GE.2) THEN | |
6252 | ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) | |
6253 | ENDIF | |
6254 | IF(NPTS(1).GE.4) THEN | |
6255 | ATAU3=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1 | |
6256 | ATAU4=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/ | |
6257 | & GAMR1 | |
6258 | ENDIF | |
6259 | IF(NPTS(1).GE.6) THEN | |
6260 | ATAU5=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2 | |
6261 | ATAU6=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/ | |
6262 | & GAMR2 | |
6263 | ENDIF | |
6264 | IF(NPTS(1).GT.2+2*MINT(72)) THEN | |
6265 | ATAU7=LOG(MAX(2D-10,1D0-TAUMIN)/MAX(2D-10,1D0-TAUMAX)) | |
6266 | ENDIF | |
6267 | ||
6268 | C...Reset. Sum up cross-sections in points calculated. | |
6269 | DO 320 IVAR=1,4 | |
6270 | IF(NPTS(IVAR).EQ.1) GOTO 320 | |
6271 | IF(ISUB.EQ.96.AND.IVAR.EQ.4) GOTO 320 | |
6272 | NBIN=NPTS(IVAR) | |
6273 | DO 170 J1=1,NBIN | |
6274 | NAREL(J1)=0 | |
6275 | WTREL(J1)=0D0 | |
6276 | COEFU(J1)=0D0 | |
6277 | DO 160 J2=1,NBIN | |
6278 | WTMAT(J1,J2)=0D0 | |
6279 | 160 CONTINUE | |
6280 | 170 CONTINUE | |
6281 | DO 180 IACC=1,NACC | |
6282 | IBIN=MVARPT(IACC,IVAR) | |
6283 | IF(IVAR.EQ.1.AND.IBIN.EQ.7) IBIN=3+2*MINT(72) | |
6284 | IF(IVAR.EQ.3.AND.IBIN.EQ.5.AND.MINT(45).NE.3) IBIN=4 | |
6285 | NAREL(IBIN)=NAREL(IBIN)+1 | |
6286 | WTREL(IBIN)=WTREL(IBIN)+SIGSPT(IACC) | |
6287 | ||
6288 | C...Sum up tau cross-section pieces in points used. | |
6289 | IF(IVAR.EQ.1) THEN | |
6290 | TAU=VINTPT(IACC,11) | |
6291 | WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 | |
6292 | WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAU1/ATAU2)/TAU | |
6293 | IF(NBIN.GE.4) THEN | |
6294 | WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAU1/ATAU3)/(TAU+TAUR1) | |
6295 | WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ATAU1/ATAU4)*TAU/ | |
6296 | & ((TAU-TAUR1)**2+GAMR1**2) | |
6297 | ENDIF | |
6298 | IF(NBIN.GE.6) THEN | |
6299 | WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ATAU1/ATAU5)/(TAU+TAUR2) | |
6300 | WTMAT(IBIN,6)=WTMAT(IBIN,6)+(ATAU1/ATAU6)*TAU/ | |
6301 | & ((TAU-TAUR2)**2+GAMR2**2) | |
6302 | ENDIF | |
6303 | IF(NBIN.GT.2+2*MINT(72)) THEN | |
6304 | WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(ATAU1/ATAU7)* | |
6305 | & TAU/MAX(2D-10,1D0-TAU) | |
6306 | ENDIF | |
6307 | ||
6308 | C...Sum up tau' cross-section pieces in points used. | |
6309 | ELSEIF(IVAR.EQ.2) THEN | |
6310 | TAU=VINTPT(IACC,11) | |
6311 | TAUP=VINTPT(IACC,16) | |
6312 | TAUPMN=VINTPT(IACC,6) | |
6313 | TAUPMX=VINTPT(IACC,26) | |
6314 | ATAUP1=LOG(TAUPMX/TAUPMN) | |
6315 | ATAUP2=((1D0-TAU/TAUPMX)**4-(1D0-TAU/TAUPMN)**4)/(4D0*TAU) | |
6316 | WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 | |
6317 | WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAUP1/ATAUP2)* | |
6318 | & (1D0-TAU/TAUP)**3/TAUP | |
6319 | IF(NBIN.GE.3) THEN | |
6320 | ATAUP3=LOG(MAX(2D-10,1D0-TAUPMN)/MAX(2D-10,1D0-TAUPMX)) | |
6321 | WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAUP1/ATAUP3)* | |
6322 | & TAUP/MAX(2D-10,1D0-TAUP) | |
6323 | ENDIF | |
6324 | ||
6325 | C...Sum up y* cross-section pieces in points used. | |
6326 | ELSEIF(IVAR.EQ.3) THEN | |
6327 | YST=VINTPT(IACC,12) | |
6328 | YSTMIN=VINTPT(IACC,2) | |
6329 | YSTMAX=VINTPT(IACC,22) | |
6330 | AYST0=YSTMAX-YSTMIN | |
6331 | AYST1=0.5D0*(YSTMAX-YSTMIN)**2 | |
6332 | AYST2=AYST1 | |
6333 | AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) | |
6334 | WTMAT(IBIN,1)=WTMAT(IBIN,1)+(AYST0/AYST1)*(YST-YSTMIN) | |
6335 | WTMAT(IBIN,2)=WTMAT(IBIN,2)+(AYST0/AYST2)*(YSTMAX-YST) | |
6336 | WTMAT(IBIN,3)=WTMAT(IBIN,3)+(AYST0/AYST3)/COSH(YST) | |
6337 | IF(MINT(45).EQ.3) THEN | |
6338 | TAUE=VINTPT(IACC,11) | |
6339 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINTPT(IACC,16) | |
6340 | YST0=-0.5D0*LOG(TAUE) | |
6341 | AYST4=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)/ | |
6342 | & MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) | |
6343 | WTMAT(IBIN,4)=WTMAT(IBIN,4)+(AYST0/AYST4)/ | |
6344 | & MAX(1D-10,1D0-EXP(YST-YST0)) | |
6345 | ENDIF | |
6346 | IF(MINT(46).EQ.3) THEN | |
6347 | TAUE=VINTPT(IACC,11) | |
6348 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINTPT(IACC,16) | |
6349 | YST0=-0.5D0*LOG(TAUE) | |
6350 | AYST5=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)/ | |
6351 | & MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) | |
6352 | WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(AYST0/AYST5)/ | |
6353 | & MAX(1D-10,1D0-EXP(-YST-YST0)) | |
6354 | ENDIF | |
6355 | ||
6356 | C...Sum up cos(theta-hat) cross-section pieces in points used. | |
6357 | ELSE | |
6358 | RM34=MAX(1D-20,2D0*SQM3*SQM4/(VINTPT(IACC,11)*VINT(2))**2) | |
6359 | RSQM=1D0+RM34 | |
6360 | CTHMAX=SQRT(1D0-4D0*VINT(71)**2/(TAUMAX*VINT(2))) | |
6361 | CTHMIN=-CTHMAX | |
6362 | IF(CTHMAX.GT.0.9999D0) RM34=MAX(RM34,2D0*VINT(71)**2/ | |
6363 | & (TAUMAX*VINT(2))) | |
6364 | ACTH1=CTHMAX-CTHMIN | |
6365 | ACTH2=LOG(MAX(RM34,RSQM-CTHMIN)/MAX(RM34,RSQM-CTHMAX)) | |
6366 | ACTH3=LOG(MAX(RM34,RSQM+CTHMAX)/MAX(RM34,RSQM+CTHMIN)) | |
6367 | ACTH4=1D0/MAX(RM34,RSQM-CTHMAX)-1D0/MAX(RM34,RSQM-CTHMIN) | |
6368 | ACTH5=1D0/MAX(RM34,RSQM+CTHMIN)-1D0/MAX(RM34,RSQM+CTHMAX) | |
6369 | CTH=VINTPT(IACC,13) | |
6370 | WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 | |
6371 | WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ACTH1/ACTH2)/ | |
6372 | & MAX(RM34,RSQM-CTH) | |
6373 | WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ACTH1/ACTH3)/ | |
6374 | & MAX(RM34,RSQM+CTH) | |
6375 | WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ACTH1/ACTH4)/ | |
6376 | & MAX(RM34,RSQM-CTH)**2 | |
6377 | WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ACTH1/ACTH5)/ | |
6378 | & MAX(RM34,RSQM+CTH)**2 | |
6379 | ENDIF | |
6380 | 180 CONTINUE | |
6381 | ||
6382 | C...Check that equation system solvable. | |
6383 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5400) CVAR(IVAR) | |
6384 | MSOLV=1 | |
6385 | WTRELS=0D0 | |
6386 | DO 190 IBIN=1,NBIN | |
6387 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5500) (WTMAT(IBIN,IRED), | |
6388 | & IRED=1,NBIN),WTREL(IBIN) | |
6389 | IF(NAREL(IBIN).EQ.0) MSOLV=0 | |
6390 | WTRELS=WTRELS+WTREL(IBIN) | |
6391 | 190 CONTINUE | |
6392 | IF(ABS(WTRELS).LT.1D-20) MSOLV=0 | |
6393 | ||
6394 | C...Solve to find relative importance of cross-section pieces. | |
6395 | IF(MSOLV.EQ.1) THEN | |
6396 | DO 200 IBIN=1,NBIN | |
6397 | WTRELN(IBIN)=MAX(0.1D0,WTREL(IBIN)/WTRELS) | |
6398 | 200 CONTINUE | |
6399 | DO 230 IRED=1,NBIN-1 | |
6400 | DO 220 IBIN=IRED+1,NBIN | |
6401 | IF(ABS(WTMAT(IRED,IRED)).LT.1D-20) THEN | |
6402 | MSOLV=0 | |
6403 | GOTO 260 | |
6404 | ENDIF | |
6405 | RQT=WTMAT(IBIN,IRED)/WTMAT(IRED,IRED) | |
6406 | WTREL(IBIN)=WTREL(IBIN)-RQT*WTREL(IRED) | |
6407 | DO 210 ICOE=IRED,NBIN | |
6408 | WTMAT(IBIN,ICOE)=WTMAT(IBIN,ICOE)-RQT*WTMAT(IRED,ICOE) | |
6409 | 210 CONTINUE | |
6410 | 220 CONTINUE | |
6411 | 230 CONTINUE | |
6412 | DO 250 IRED=NBIN,1,-1 | |
6413 | DO 240 ICOE=IRED+1,NBIN | |
6414 | WTREL(IRED)=WTREL(IRED)-WTMAT(IRED,ICOE)*COEFU(ICOE) | |
6415 | 240 CONTINUE | |
6416 | COEFU(IRED)=WTREL(IRED)/WTMAT(IRED,IRED) | |
6417 | 250 CONTINUE | |
6418 | ENDIF | |
6419 | ||
6420 | C...Share evenly if failure. | |
6421 | 260 IF(MSOLV.EQ.0) THEN | |
6422 | DO 270 IBIN=1,NBIN | |
6423 | COEFU(IBIN)=1D0 | |
6424 | WTRELN(IBIN)=0.1D0 | |
6425 | IF(WTRELS.GT.0D0) WTRELN(IBIN)=MAX(0.1D0, | |
6426 | & WTREL(IBIN)/WTRELS) | |
6427 | 270 CONTINUE | |
6428 | ENDIF | |
6429 | ||
6430 | C...Normalize coefficients, with piece shared democratically. | |
6431 | COEFSU=0D0 | |
6432 | WTRELS=0D0 | |
6433 | DO 280 IBIN=1,NBIN | |
6434 | COEFU(IBIN)=MAX(0D0,COEFU(IBIN)) | |
6435 | COEFSU=COEFSU+COEFU(IBIN) | |
6436 | WTRELS=WTRELS+WTRELN(IBIN) | |
6437 | 280 CONTINUE | |
6438 | IF(COEFSU.GT.0D0) THEN | |
6439 | DO 290 IBIN=1,NBIN | |
6440 | COEFO(IBIN)=PARP(122)/NBIN+(1D0-PARP(122))*0.5D0* | |
6441 | & (COEFU(IBIN)/COEFSU+WTRELN(IBIN)/WTRELS) | |
6442 | 290 CONTINUE | |
6443 | ELSE | |
6444 | DO 300 IBIN=1,NBIN | |
6445 | COEFO(IBIN)=1D0/NBIN | |
6446 | 300 CONTINUE | |
6447 | ENDIF | |
6448 | IF(IVAR.EQ.1) IOFF=0 | |
6449 | IF(IVAR.EQ.2) IOFF=17 | |
6450 | IF(IVAR.EQ.3) IOFF=7 | |
6451 | IF(IVAR.EQ.4) IOFF=12 | |
6452 | DO 310 IBIN=1,NBIN | |
6453 | ICOF=IOFF+IBIN | |
6454 | IF(IVAR.EQ.1.AND.IBIN.GT.2+2*MINT(72)) ICOF=7 | |
6455 | IF(IVAR.EQ.3.AND.IBIN.EQ.4.AND.MINT(45).NE.3) ICOF=ICOF+1 | |
6456 | COEF(ISUB,ICOF)=COEFO(IBIN) | |
6457 | 310 CONTINUE | |
6458 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5600) CVAR(IVAR), | |
6459 | & (COEFO(IBIN),IBIN=1,NBIN) | |
6460 | 320 CONTINUE | |
6461 | ||
6462 | C...Find two most promising maxima among points previously determined. | |
6463 | DO 330 J=1,4 | |
6464 | IACCMX(J)=0 | |
6465 | SIGSMX(J)=0D0 | |
6466 | 330 CONTINUE | |
6467 | NMAX=0 | |
6468 | DO 390 IACC=1,NACC | |
6469 | DO 340 J=1,30 | |
6470 | VINT(10+J)=VINTPT(IACC,J) | |
6471 | 340 CONTINUE | |
6472 | IF(ISTSB.NE.5) THEN | |
6473 | CALL PYSIGH(NCHN,SIGS) | |
6474 | IF(MWTXS.EQ.1) THEN | |
6475 | CALL PYEVWT(WTXS) | |
6476 | SIGS=WTXS*SIGS | |
6477 | ENDIF | |
6478 | ELSE | |
6479 | SIGS=0D0 | |
6480 | DO 350 IKIN3=1,MSTP(129) | |
6481 | CALL PYKMAP(5,0,0D0) | |
6482 | IF(MINT(51).EQ.1) GOTO 350 | |
6483 | CALL PYSIGH(NCHN,SIGTMP) | |
6484 | IF(MWTXS.EQ.1) THEN | |
6485 | CALL PYEVWT(WTXS) | |
6486 | SIGTMP=WTXS*SIGTMP | |
6487 | ENDIF | |
6488 | IF(SIGTMP.GT.SIGS) SIGS=SIGTMP | |
6489 | 350 CONTINUE | |
6490 | ENDIF | |
6491 | IEQ=0 | |
6492 | DO 360 IMV=1,NMAX | |
6493 | IF(ABS(SIGS-SIGSMX(IMV)).LT.1D-4*(SIGS+SIGSMX(IMV))) IEQ=IMV | |
6494 | 360 CONTINUE | |
6495 | IF(IEQ.EQ.0) THEN | |
6496 | DO 370 IMV=NMAX,1,-1 | |
6497 | IIN=IMV+1 | |
6498 | IF(SIGS.LE.SIGSMX(IMV)) GOTO 380 | |
6499 | IACCMX(IMV+1)=IACCMX(IMV) | |
6500 | SIGSMX(IMV+1)=SIGSMX(IMV) | |
6501 | 370 CONTINUE | |
6502 | IIN=1 | |
6503 | 380 IACCMX(IIN)=IACC | |
6504 | SIGSMX(IIN)=SIGS | |
6505 | IF(NMAX.LE.1) NMAX=NMAX+1 | |
6506 | ENDIF | |
6507 | 390 CONTINUE | |
6508 | ||
6509 | C...Read out starting position for search. | |
6510 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5700) | |
6511 | SIGSAM=SIGSMX(1) | |
6512 | DO 440 IMAX=1,NMAX | |
6513 | IACC=IACCMX(IMAX) | |
6514 | MTAU=MVARPT(IACC,1) | |
6515 | MTAUP=MVARPT(IACC,2) | |
6516 | MYST=MVARPT(IACC,3) | |
6517 | MCTH=MVARPT(IACC,4) | |
6518 | VTAU=0.5D0 | |
6519 | VYST=0.5D0 | |
6520 | VCTH=0.5D0 | |
6521 | VTAUP=0.5D0 | |
6522 | ||
6523 | C...Starting point and step size in parameter space. | |
6524 | DO 430 IRPT=1,2 | |
6525 | DO 420 IVAR=1,4 | |
6526 | IF(NPTS(IVAR).EQ.1) GOTO 420 | |
6527 | IF(IVAR.EQ.1) VVAR=VTAU | |
6528 | IF(IVAR.EQ.2) VVAR=VTAUP | |
6529 | IF(IVAR.EQ.3) VVAR=VYST | |
6530 | IF(IVAR.EQ.4) VVAR=VCTH | |
6531 | IF(IVAR.EQ.1) MVAR=MTAU | |
6532 | IF(IVAR.EQ.2) MVAR=MTAUP | |
6533 | IF(IVAR.EQ.3) MVAR=MYST | |
6534 | IF(IVAR.EQ.4) MVAR=MCTH | |
6535 | IF(IRPT.EQ.1) VDEL=0.1D0 | |
6536 | IF(IRPT.EQ.2) VDEL=MAX(0.01D0,MIN(0.05D0,VVAR-0.02D0, | |
6537 | & 0.98D0-VVAR)) | |
6538 | IF(IRPT.EQ.1) VMAR=0.02D0 | |
6539 | IF(IRPT.EQ.2) VMAR=0.002D0 | |
6540 | IMOV0=1 | |
6541 | IF(IRPT.EQ.1.AND.IVAR.EQ.1) IMOV0=0 | |
6542 | DO 410 IMOV=IMOV0,8 | |
6543 | ||
6544 | C...Define new point in parameter space. | |
6545 | IF(IMOV.EQ.0) THEN | |
6546 | INEW=2 | |
6547 | VNEW=VVAR | |
6548 | ELSEIF(IMOV.EQ.1) THEN | |
6549 | INEW=3 | |
6550 | VNEW=VVAR+VDEL | |
6551 | ELSEIF(IMOV.EQ.2) THEN | |
6552 | INEW=1 | |
6553 | VNEW=VVAR-VDEL | |
6554 | ELSEIF(SIGSSM(3).GE.MAX(SIGSSM(1),SIGSSM(2)).AND. | |
6555 | & VVAR+2D0*VDEL.LT.1D0-VMAR) THEN | |
6556 | VVAR=VVAR+VDEL | |
6557 | SIGSSM(1)=SIGSSM(2) | |
6558 | SIGSSM(2)=SIGSSM(3) | |
6559 | INEW=3 | |
6560 | VNEW=VVAR+VDEL | |
6561 | ELSEIF(SIGSSM(1).GE.MAX(SIGSSM(2),SIGSSM(3)).AND. | |
6562 | & VVAR-2D0*VDEL.GT.VMAR) THEN | |
6563 | VVAR=VVAR-VDEL | |
6564 | SIGSSM(3)=SIGSSM(2) | |
6565 | SIGSSM(2)=SIGSSM(1) | |
6566 | INEW=1 | |
6567 | VNEW=VVAR-VDEL | |
6568 | ELSEIF(SIGSSM(3).GE.SIGSSM(1)) THEN | |
6569 | VDEL=0.5D0*VDEL | |
6570 | VVAR=VVAR+VDEL | |
6571 | SIGSSM(1)=SIGSSM(2) | |
6572 | INEW=2 | |
6573 | VNEW=VVAR | |
6574 | ELSE | |
6575 | VDEL=0.5D0*VDEL | |
6576 | VVAR=VVAR-VDEL | |
6577 | SIGSSM(3)=SIGSSM(2) | |
6578 | INEW=2 | |
6579 | VNEW=VVAR | |
6580 | ENDIF | |
6581 | ||
6582 | C...Convert to relevant variables and find derived new limits. | |
6583 | ILERR=0 | |
6584 | IF(IVAR.EQ.1) THEN | |
6585 | VTAU=VNEW | |
6586 | CALL PYKMAP(1,MTAU,VTAU) | |
6587 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN | |
6588 | CALL PYKLIM(4) | |
6589 | IF(MINT(51).EQ.1) ILERR=1 | |
6590 | ENDIF | |
6591 | ENDIF | |
6592 | IF(IVAR.LE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5.AND. | |
6593 | & ILERR.EQ.0) THEN | |
6594 | IF(IVAR.EQ.2) VTAUP=VNEW | |
6595 | CALL PYKMAP(4,MTAUP,VTAUP) | |
6596 | ENDIF | |
6597 | IF(IVAR.LE.2.AND.ILERR.EQ.0) THEN | |
6598 | CALL PYKLIM(2) | |
6599 | IF(MINT(51).EQ.1) ILERR=1 | |
6600 | ENDIF | |
6601 | IF(IVAR.LE.3.AND.ILERR.EQ.0) THEN | |
6602 | IF(IVAR.EQ.3) VYST=VNEW | |
6603 | CALL PYKMAP(2,MYST,VYST) | |
6604 | CALL PYKLIM(3) | |
6605 | IF(MINT(51).EQ.1) ILERR=1 | |
6606 | ENDIF | |
6607 | IF((ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6).AND. | |
6608 | & ILERR.EQ.0) THEN | |
6609 | IF(IVAR.EQ.4) VCTH=VNEW | |
6610 | CALL PYKMAP(3,MCTH,VCTH) | |
6611 | ENDIF | |
6612 | IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2) | |
6613 | ||
6614 | C...Evaluate cross-section. Save new maximum. Final maximum. | |
6615 | IF(ILERR.NE.0) THEN | |
6616 | SIGS=0. | |
6617 | ELSEIF(ISTSB.NE.5) THEN | |
6618 | CALL PYSIGH(NCHN,SIGS) | |
6619 | IF(MWTXS.EQ.1) THEN | |
6620 | CALL PYEVWT(WTXS) | |
6621 | SIGS=WTXS*SIGS | |
6622 | ENDIF | |
6623 | ELSE | |
6624 | SIGS=0D0 | |
6625 | DO 400 IKIN3=1,MSTP(129) | |
6626 | CALL PYKMAP(5,0,0D0) | |
6627 | IF(MINT(51).EQ.1) GOTO 400 | |
6628 | CALL PYSIGH(NCHN,SIGTMP) | |
6629 | IF(MWTXS.EQ.1) THEN | |
6630 | CALL PYEVWT(WTXS) | |
6631 | SIGTMP=WTXS*SIGTMP | |
6632 | ENDIF | |
6633 | IF(SIGTMP.GT.SIGS) SIGS=SIGTMP | |
6634 | 400 CONTINUE | |
6635 | ENDIF | |
6636 | SIGSSM(INEW)=SIGS | |
6637 | IF(SIGS.GT.SIGSAM) SIGSAM=SIGS | |
6638 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5800) IMAX,IVAR,MVAR, | |
6639 | & IMOV,VNEW,VINT(21),VINT(22),VINT(23),VINT(26),SIGS | |
6640 | 410 CONTINUE | |
6641 | 420 CONTINUE | |
6642 | 430 CONTINUE | |
6643 | 440 CONTINUE | |
6644 | IF(MSTP(121).EQ.1) SIGSAM=PARP(121)*SIGSAM | |
6645 | XSEC(ISUB,1)=1.05D0*SIGSAM | |
6646 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= | |
6647 | & WTGAGA*XSEC(ISUB,1) | |
6648 | 450 CONTINUE | |
6649 | IF(MSTP(173).EQ.1.AND.ISUB.NE.96) XSEC(ISUB,1)= | |
6650 | & PARP(174)*XSEC(ISUB,1) | |
6651 | IF(ISUB.NE.96) XSEC(0,1)=XSEC(0,1)+XSEC(ISUB,1) | |
6652 | 460 CONTINUE | |
6653 | MINT(51)=0 | |
6654 | ||
6655 | C...Print summary table. | |
6656 | IF(MINT(121).EQ.1.AND.NPOSI.EQ.0) THEN | |
6657 | IF(MSTP(127).NE.1) THEN | |
6658 | WRITE(MSTU(11),5900) | |
6659 | STOP | |
6660 | ELSE | |
6661 | WRITE(MSTU(11),6400) | |
6662 | MSTI(53)=1 | |
6663 | ENDIF | |
6664 | ENDIF | |
6665 | IF(MSTP(122).GE.1) THEN | |
6666 | WRITE(MSTU(11),6000) | |
6667 | WRITE(MSTU(11),6100) | |
6668 | DO 470 ISUB=1,500 | |
6669 | IF(MSUB(ISUB).NE.1.AND.ISUB.NE.96) GOTO 470 | |
6670 | IF(ISUB.EQ.96.AND.MINT(50).EQ.0) GOTO 470 | |
6671 | IF(ISUB.EQ.96.AND.MSUB(95).NE.1.AND.MSTP(81).LE.0) GOTO 470 | |
6672 | IF(ISUB.EQ.96.AND.MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 470 | |
6673 | IF(MSUB(95).EQ.1.AND.(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13 | |
6674 | & .OR.ISUB.EQ.28.OR.ISUB.EQ.53.OR.ISUB.EQ.68)) GOTO 470 | |
6675 | IF(MSUB(95).EQ.1.AND.ISUB.GE.381.AND.ISUB.LE.386) GOTO 470 | |
6676 | WRITE(MSTU(11),6200) ISUB,PROC(ISUB),XSEC(ISUB,1) | |
6677 | 470 CONTINUE | |
6678 | WRITE(MSTU(11),6300) | |
6679 | ENDIF | |
6680 | ||
6681 | C...Format statements for maximization results. | |
6682 | 5000 FORMAT(/1X,'Coefficient optimization and maximum search for ', | |
6683 | &'subprocess no',I4/1X,'Coefficient modes tau',10X,'y*',9X, | |
6684 | &'cth',9X,'tau''',7X,'sigma') | |
6685 | 5100 FORMAT(1X,'Warning: requested subprocess ',I3,' has no allowed ', | |
6686 | &'phase space.'/1X,'Process switched off!') | |
6687 | 5200 FORMAT(1X,4I4,F12.8,F12.6,F12.7,F12.8,1P,D12.4) | |
6688 | 5300 FORMAT(1X,'Warning: requested subprocess ',I3,' has vanishing ', | |
6689 | &'cross-section.'/1X,'Process switched off!') | |
6690 | 5400 FORMAT(1X,'Coefficients of equation system to be solved for ',A4) | |
6691 | 5500 FORMAT(1X,1P,8D11.3) | |
6692 | 5600 FORMAT(1X,'Result for ',A4,':',7F9.4) | |
6693 | 5700 FORMAT(1X,'Maximum search for given coefficients'/2X,'MAX VAR ', | |
6694 | &'MOD MOV VNEW',7X,'tau',7X,'y*',8X,'cth',7X,'tau''',7X,'sigma') | |
6695 | 5800 FORMAT(1X,4I4,F8.4,F11.7,F9.3,F11.6,F11.7,1P,D12.4) | |
6696 | 5900 FORMAT(1X,'Error: no requested process has non-vanishing ', | |
6697 | &'cross-section.'/1X,'Execution stopped!') | |
6698 | 6000 FORMAT(/1X,8('*'),1X,'PYMAXI: summary of differential ', | |
6699 | &'cross-section maximum search',1X,8('*')) | |
6700 | 6100 FORMAT(/11X,58('=')/11X,'I',38X,'I',17X,'I'/11X,'I ISUB ', | |
6701 | &'Subprocess name',15X,'I Maximum value I'/11X,'I',38X,'I', | |
6702 | &17X,'I'/11X,58('=')/11X,'I',38X,'I',17X,'I') | |
6703 | 6200 FORMAT(11X,'I',2X,I3,3X,A28,2X,'I',2X,1P,D12.4,3X,'I') | |
6704 | 6300 FORMAT(11X,'I',38X,'I',17X,'I'/11X,58('=')) | |
6705 | 6400 FORMAT(1X,'Error: no requested process has non-vanishing ', | |
6706 | &'cross-section.'/ | |
6707 | &1X,'Execution will stop if you try to generate events.') | |
6708 | ||
6709 | RETURN | |
6710 | END | |
6711 | ||
6712 | C********************************************************************* | |
6713 | ||
6714 | C...PYPILE | |
6715 | C...Initializes multiplicity distribution and selects mutliplicity | |
6716 | C...of pileup events, i.e. several events occuring at the same | |
6717 | C...beam crossing. | |
6718 | ||
6719 | SUBROUTINE PYPILE(MPILE) | |
6720 | ||
6721 | C...Double precision and integer declarations. | |
6722 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
6723 | IMPLICIT INTEGER(I-N) | |
6724 | INTEGER PYK,PYCHGE,PYCOMP | |
6725 | C...Commonblocks. | |
6726 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6727 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
6728 | COMMON/PYINT1/MINT(400),VINT(400) | |
6729 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
6730 | SAVE /PYDAT1/,/PYPARS/,/PYINT1/,/PYINT7/ | |
6731 | C...Local arrays and saved variables. | |
6732 | DIMENSION WTI(0:200) | |
6733 | SAVE IMIN,IMAX,WTI,WTS | |
6734 | ||
6735 | C...Sum of allowed cross-sections for pileup events. | |
6736 | IF(MPILE.EQ.1) THEN | |
6737 | VINT(131)=SIGT(0,0,5) | |
6738 | IF(MSTP(132).GE.2) VINT(131)=VINT(131)+SIGT(0,0,4) | |
6739 | IF(MSTP(132).GE.3) VINT(131)=VINT(131)+SIGT(0,0,2)+SIGT(0,0,3) | |
6740 | IF(MSTP(132).GE.4) VINT(131)=VINT(131)+SIGT(0,0,1) | |
6741 | IF(MSTP(133).LE.0) RETURN | |
6742 | ||
6743 | C...Initialize multiplicity distribution at maximum. | |
6744 | XNAVE=VINT(131)*PARP(131) | |
6745 | IF(XNAVE.GT.120D0) WRITE(MSTU(11),5000) XNAVE | |
6746 | INAVE=MAX(1,MIN(200,NINT(XNAVE))) | |
6747 | WTI(INAVE)=1D0 | |
6748 | WTS=WTI(INAVE) | |
6749 | WTN=WTI(INAVE)*INAVE | |
6750 | ||
6751 | C...Find shape of multiplicity distribution below maximum. | |
6752 | IMIN=INAVE | |
6753 | DO 100 I=INAVE-1,1,-1 | |
6754 | IF(MSTP(133).EQ.1) WTI(I)=WTI(I+1)*(I+1)/XNAVE | |
6755 | IF(MSTP(133).GE.2) WTI(I)=WTI(I+1)*I/XNAVE | |
6756 | IF(WTI(I).LT.1D-6) GOTO 110 | |
6757 | WTS=WTS+WTI(I) | |
6758 | WTN=WTN+WTI(I)*I | |
6759 | IMIN=I | |
6760 | 100 CONTINUE | |
6761 | ||
6762 | C...Find shape of multiplicity distribution above maximum. | |
6763 | 110 IMAX=INAVE | |
6764 | DO 120 I=INAVE+1,200 | |
6765 | IF(MSTP(133).EQ.1) WTI(I)=WTI(I-1)*XNAVE/I | |
6766 | IF(MSTP(133).GE.2) WTI(I)=WTI(I-1)*XNAVE/(I-1) | |
6767 | IF(WTI(I).LT.1D-6) GOTO 130 | |
6768 | WTS=WTS+WTI(I) | |
6769 | WTN=WTN+WTI(I)*I | |
6770 | IMAX=I | |
6771 | 120 CONTINUE | |
6772 | 130 VINT(132)=XNAVE | |
6773 | VINT(133)=WTN/WTS | |
6774 | IF(MSTP(133).EQ.1.AND.IMIN.EQ.1) VINT(134)= | |
6775 | & WTS/(WTS+WTI(1)/XNAVE) | |
6776 | IF(MSTP(133).EQ.1.AND.IMIN.GT.1) VINT(134)=1D0 | |
6777 | IF(MSTP(133).GE.2) VINT(134)=XNAVE | |
6778 | ||
6779 | C...Pick multiplicity of pileup events. | |
6780 | ELSE | |
6781 | IF(MSTP(133).LE.0) THEN | |
6782 | MINT(81)=MAX(1,MSTP(134)) | |
6783 | ELSE | |
6784 | WTR=WTS*PYR(0) | |
6785 | DO 140 I=IMIN,IMAX | |
6786 | MINT(81)=I | |
6787 | WTR=WTR-WTI(I) | |
6788 | IF(WTR.LE.0D0) GOTO 150 | |
6789 | 140 CONTINUE | |
6790 | 150 CONTINUE | |
6791 | ENDIF | |
6792 | ENDIF | |
6793 | ||
6794 | C...Format statement for error message. | |
6795 | 5000 FORMAT(1X,'Warning: requested average number of events per bunch', | |
6796 | &'crossing too large, ',1P,D12.4) | |
6797 | ||
6798 | RETURN | |
6799 | END | |
6800 | ||
6801 | C********************************************************************* | |
6802 | ||
6803 | C...PYSAVE | |
6804 | C...Saves and restores parameter and cross section values for the | |
6805 | C...3 gamma-p and 6 (or 4, or 9, or 13) gamma-gamma alternatives. | |
6806 | C...Also makes random choice between alternatives. | |
6807 | ||
6808 | SUBROUTINE PYSAVE(ISAVE,IGA) | |
6809 | ||
6810 | C...Double precision and integer declarations. | |
6811 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
6812 | IMPLICIT INTEGER(I-N) | |
6813 | INTEGER PYK,PYCHGE,PYCOMP | |
6814 | C...Commonblocks. | |
6815 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
6816 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
6817 | COMMON/PYINT1/MINT(400),VINT(400) | |
6818 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
6819 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
6820 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
6821 | SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT5/,/PYINT7/ | |
6822 | C...Local arrays and saved variables. | |
6823 | DIMENSION NCP(15),NSUBCP(15,20),MSUBCP(15,20),COEFCP(15,20,20), | |
6824 | &NGENCP(15,0:20,3),XSECCP(15,0:20,3),SIGTCP(15,0:6,0:6,0:5), | |
6825 | &INTCP(15,20),RECP(15,20) | |
6826 | SAVE NCP,NSUBCP,MSUBCP,COEFCP,NGENCP,XSECCP,SIGTCP,INTCP,RECP | |
6827 | ||
6828 | C...Save list of subprocesses and cross-section information. | |
6829 | IF(ISAVE.EQ.1) THEN | |
6830 | ICP=0 | |
6831 | DO 120 I=1,500 | |
6832 | IF(MSUB(I).EQ.0.AND.I.NE.96.AND.I.NE.97) GOTO 120 | |
6833 | ICP=ICP+1 | |
6834 | NSUBCP(IGA,ICP)=I | |
6835 | MSUBCP(IGA,ICP)=MSUB(I) | |
6836 | DO 100 J=1,20 | |
6837 | COEFCP(IGA,ICP,J)=COEF(I,J) | |
6838 | 100 CONTINUE | |
6839 | DO 110 J=1,3 | |
6840 | NGENCP(IGA,ICP,J)=NGEN(I,J) | |
6841 | XSECCP(IGA,ICP,J)=XSEC(I,J) | |
6842 | 110 CONTINUE | |
6843 | 120 CONTINUE | |
6844 | NCP(IGA)=ICP | |
6845 | DO 130 J=1,3 | |
6846 | NGENCP(IGA,0,J)=NGEN(0,J) | |
6847 | XSECCP(IGA,0,J)=XSEC(0,J) | |
6848 | 130 CONTINUE | |
6849 | DO 160 I1=0,6 | |
6850 | DO 150 I2=0,6 | |
6851 | DO 140 J=0,5 | |
6852 | SIGTCP(IGA,I1,I2,J)=SIGT(I1,I2,J) | |
6853 | 140 CONTINUE | |
6854 | 150 CONTINUE | |
6855 | 160 CONTINUE | |
6856 | ||
6857 | C...Save various common process variables. | |
6858 | DO 170 J=1,10 | |
6859 | INTCP(IGA,J)=MINT(40+J) | |
6860 | 170 CONTINUE | |
6861 | INTCP(IGA,11)=MINT(101) | |
6862 | INTCP(IGA,12)=MINT(102) | |
6863 | INTCP(IGA,13)=MINT(107) | |
6864 | INTCP(IGA,14)=MINT(108) | |
6865 | INTCP(IGA,15)=MINT(123) | |
6866 | RECP(IGA,1)=CKIN(3) | |
6867 | RECP(IGA,2)=VINT(318) | |
6868 | ||
6869 | C...Save cross-section information only. | |
6870 | ELSEIF(ISAVE.EQ.2) THEN | |
6871 | DO 190 ICP=1,NCP(IGA) | |
6872 | I=NSUBCP(IGA,ICP) | |
6873 | DO 180 J=1,3 | |
6874 | NGENCP(IGA,ICP,J)=NGEN(I,J) | |
6875 | XSECCP(IGA,ICP,J)=XSEC(I,J) | |
6876 | 180 CONTINUE | |
6877 | 190 CONTINUE | |
6878 | DO 200 J=1,3 | |
6879 | NGENCP(IGA,0,J)=NGEN(0,J) | |
6880 | XSECCP(IGA,0,J)=XSEC(0,J) | |
6881 | 200 CONTINUE | |
6882 | ||
6883 | C...Choose between allowed alternatives. | |
6884 | ELSEIF(ISAVE.EQ.3.OR.ISAVE.EQ.4) THEN | |
6885 | IF(ISAVE.EQ.4) THEN | |
6886 | XSUMCP=0D0 | |
6887 | DO 210 IG=1,MINT(121) | |
6888 | XSUMCP=XSUMCP+XSECCP(IG,0,1) | |
6889 | 210 CONTINUE | |
6890 | XSUMCP=XSUMCP*PYR(0) | |
6891 | DO 220 IG=1,MINT(121) | |
6892 | IGA=IG | |
6893 | XSUMCP=XSUMCP-XSECCP(IG,0,1) | |
6894 | IF(XSUMCP.LE.0D0) GOTO 230 | |
6895 | 220 CONTINUE | |
6896 | 230 CONTINUE | |
6897 | ENDIF | |
6898 | ||
6899 | C...Restore cross-section information. | |
6900 | DO 240 I=1,500 | |
6901 | MSUB(I)=0 | |
6902 | 240 CONTINUE | |
6903 | DO 270 ICP=1,NCP(IGA) | |
6904 | I=NSUBCP(IGA,ICP) | |
6905 | MSUB(I)=MSUBCP(IGA,ICP) | |
6906 | DO 250 J=1,20 | |
6907 | COEF(I,J)=COEFCP(IGA,ICP,J) | |
6908 | 250 CONTINUE | |
6909 | DO 260 J=1,3 | |
6910 | NGEN(I,J)=NGENCP(IGA,ICP,J) | |
6911 | XSEC(I,J)=XSECCP(IGA,ICP,J) | |
6912 | 260 CONTINUE | |
6913 | 270 CONTINUE | |
6914 | DO 280 J=1,3 | |
6915 | NGEN(0,J)=NGENCP(IGA,0,J) | |
6916 | XSEC(0,J)=XSECCP(IGA,0,J) | |
6917 | 280 CONTINUE | |
6918 | DO 310 I1=0,6 | |
6919 | DO 300 I2=0,6 | |
6920 | DO 290 J=0,5 | |
6921 | SIGT(I1,I2,J)=SIGTCP(IGA,I1,I2,J) | |
6922 | 290 CONTINUE | |
6923 | 300 CONTINUE | |
6924 | 310 CONTINUE | |
6925 | ||
6926 | C...Restore various common process variables. | |
6927 | DO 320 J=1,10 | |
6928 | MINT(40+J)=INTCP(IGA,J) | |
6929 | 320 CONTINUE | |
6930 | MINT(101)=INTCP(IGA,11) | |
6931 | MINT(102)=INTCP(IGA,12) | |
6932 | MINT(107)=INTCP(IGA,13) | |
6933 | MINT(108)=INTCP(IGA,14) | |
6934 | MINT(123)=INTCP(IGA,15) | |
6935 | CKIN(3)=RECP(IGA,1) | |
6936 | CKIN(1)=2D0*CKIN(3) | |
6937 | VINT(318)=RECP(IGA,2) | |
6938 | ||
6939 | C...Sum up cross-section info (for PYSTAT). | |
6940 | ELSEIF(ISAVE.EQ.5) THEN | |
6941 | DO 330 I=1,500 | |
6942 | MSUB(I)=0 | |
6943 | NGEN(I,1)=0 | |
6944 | NGEN(I,3)=0 | |
6945 | XSEC(I,3)=0D0 | |
6946 | 330 CONTINUE | |
6947 | NGEN(0,1)=0 | |
6948 | NGEN(0,2)=0 | |
6949 | NGEN(0,3)=0 | |
6950 | XSEC(0,3)=0 | |
6951 | DO 350 IG=1,MINT(121) | |
6952 | DO 340 ICP=1,NCP(IG) | |
6953 | I=NSUBCP(IG,ICP) | |
6954 | IF(MSUBCP(IG,ICP).EQ.1) MSUB(I)=1 | |
6955 | NGEN(I,1)=NGEN(I,1)+NGENCP(IG,ICP,1) | |
6956 | NGEN(I,3)=NGEN(I,3)+NGENCP(IG,ICP,3) | |
6957 | XSEC(I,3)=XSEC(I,3)+XSECCP(IG,ICP,3) | |
6958 | 340 CONTINUE | |
6959 | NGEN(0,1)=NGEN(0,1)+NGENCP(IG,0,1) | |
6960 | NGEN(0,2)=NGEN(0,2)+NGENCP(IG,0,2) | |
6961 | NGEN(0,3)=NGEN(0,3)+NGENCP(IG,0,3) | |
6962 | XSEC(0,3)=XSEC(0,3)+XSECCP(IG,0,3) | |
6963 | 350 CONTINUE | |
6964 | ENDIF | |
6965 | ||
6966 | RETURN | |
6967 | END | |
6968 | ||
6969 | C********************************************************************* | |
6970 | ||
6971 | C...PYGAGA | |
6972 | C...For lepton beams it gives photon-hadron or photon-photon systems | |
6973 | C...to be treated with the ordinary machinery and combines this with a | |
6974 | C...description of the lepton -> lepton + photon branching. | |
6975 | ||
6976 | SUBROUTINE PYGAGA(IGAGA,WTGAGA) | |
6977 | ||
6978 | C...Double precision and integer declarations. | |
6979 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
6980 | IMPLICIT INTEGER(I-N) | |
6981 | INTEGER PYK,PYCHGE,PYCOMP | |
6982 | C...Commonblocks. | |
6983 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
6984 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6985 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
6986 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
6987 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
6988 | COMMON/PYINT1/MINT(400),VINT(400) | |
6989 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
6990 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
6991 | &/PYINT5/ | |
6992 | C...Local variables and data statement. | |
6993 | DIMENSION PMS(2),XMIN(2),XMAX(2),Q2MIN(2),Q2MAX(2),PMC(3), | |
6994 | &X(2),Q2(2),Y(2),THETA(2),PHI(2),PT(2),BETA(3) | |
6995 | SAVE PMS,XMIN,XMAX,Q2MIN,Q2MAX,PMC,X,Q2,THETA,PHI,PT,W2MIN | |
6996 | DATA EPS/1D-4/ | |
6997 | ||
6998 | C...Initialize generation of photons inside leptons. | |
6999 | IF(IGAGA.EQ.1) THEN | |
7000 | ||
7001 | C...Save quantities on incoming lepton system. | |
7002 | VINT(301)=VINT(1) | |
7003 | VINT(302)=VINT(2) | |
7004 | PMS(1)=VINT(303)**2 | |
7005 | IF(MINT(141).EQ.0) PMS(1)=SIGN(VINT(3)**2,VINT(3)) | |
7006 | PMS(2)=VINT(304)**2 | |
7007 | IF(MINT(142).EQ.0) PMS(2)=SIGN(VINT(4)**2,VINT(4)) | |
7008 | PMC(3)=VINT(302)-PMS(1)-PMS(2) | |
7009 | W2MIN=MAX(CKIN(77),2D0*CKIN(3),2D0*CKIN(5))**2 | |
7010 | ||
7011 | C...Calculate range of x and Q2 values allowed in generation. | |
7012 | DO 100 I=1,2 | |
7013 | PMC(I)=VINT(302)+PMS(I)-PMS(3-I) | |
7014 | IF(MINT(140+I).NE.0) THEN | |
7015 | XMIN(I)=MAX(CKIN(59+2*I),EPS) | |
7016 | XMAX(I)=MIN(CKIN(60+2*I),1D0-2D0*VINT(301)*SQRT(PMS(I))/ | |
7017 | & PMC(I),1D0-EPS) | |
7018 | YMIN=MAX(CKIN(71+2*I),EPS) | |
7019 | YMAX=MIN(CKIN(72+2*I),1D0-EPS) | |
7020 | IF(CKIN(64+2*I).GT.0D0) XMIN(I)=MAX(XMIN(I), | |
7021 | & (YMIN*PMC(3)-CKIN(64+2*I))/PMC(I)) | |
7022 | XMAX(I)=MIN(XMAX(I),(YMAX*PMC(3)-CKIN(63+2*I))/PMC(I)) | |
7023 | THEMIN=MAX(CKIN(67+2*I),0D0) | |
7024 | THEMAX=MIN(CKIN(68+2*I),PARU(1)) | |
7025 | IF(CKIN(68+2*I).LT.0D0) THEMAX=PARU(1) | |
7026 | Q2MIN(I)=MAX(CKIN(63+2*I),XMIN(I)**2*PMS(I)/(1D0-XMIN(I))+ | |
7027 | & ((1D0-XMAX(I))*(VINT(302)-2D0*PMS(3-I))- | |
7028 | & 2D0*PMS(I)/(1D0-XMAX(I)))*SIN(THEMIN/2D0)**2,0D0) | |
7029 | Q2MAX(I)=XMAX(I)**2*PMS(I)/(1D0-XMAX(I))+ | |
7030 | & ((1D0-XMIN(I))*(VINT(302)-2D0*PMS(3-I))- | |
7031 | & 2D0*PMS(I)/(1D0-XMIN(I)))*SIN(THEMAX/2D0)**2 | |
7032 | IF(CKIN(64+2*I).GT.0D0) Q2MAX(I)=MIN(CKIN(64+2*I),Q2MAX(I)) | |
7033 | C...W limits when lepton on one side only. | |
7034 | IF(MINT(143-I).EQ.0) THEN | |
7035 | XMIN(I)=MAX(XMIN(I),(W2MIN-PMS(3-I))/PMC(I)) | |
7036 | IF(CKIN(78).GT.0D0) XMAX(I)=MIN(XMAX(I), | |
7037 | & (CKIN(78)**2-PMS(3-I))/PMC(I)) | |
7038 | ENDIF | |
7039 | ENDIF | |
7040 | 100 CONTINUE | |
7041 | ||
7042 | C...W limits when lepton on both sides. | |
7043 | IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN | |
7044 | IF(CKIN(78).GT.0D0) XMAX(1)=MIN(XMAX(1), | |
7045 | & (CKIN(78)**2+PMC(3)-PMC(2)*XMIN(2))/PMC(1)) | |
7046 | IF(CKIN(78).GT.0D0) XMAX(2)=MIN(XMAX(2), | |
7047 | & (CKIN(78)**2+PMC(3)-PMC(1)*XMIN(1))/PMC(2)) | |
7048 | IF(IABS(MINT(141)).NE.IABS(MINT(142))) THEN | |
7049 | XMIN(1)=MAX(XMIN(1),(PMS(1)-PMS(2)+VINT(302)*(W2MIN- | |
7050 | & PMS(1)-PMS(2))/(PMC(2)*XMAX(2)+PMS(1)-PMS(2)))/PMC(1)) | |
7051 | XMIN(2)=MAX(XMIN(2),(PMS(2)-PMS(1)+VINT(302)*(W2MIN- | |
7052 | & PMS(1)-PMS(2))/(PMC(1)*XMAX(1)+PMS(2)-PMS(1)))/PMC(2)) | |
7053 | ELSE | |
7054 | XMIN(1)=MAX(XMIN(1),W2MIN/(VINT(302)*XMAX(2))) | |
7055 | XMIN(2)=MAX(XMIN(2),W2MIN/(VINT(302)*XMAX(1))) | |
7056 | ENDIF | |
7057 | ENDIF | |
7058 | ||
7059 | C...Q2 and W values and photon flux weight factors for initialization. | |
7060 | ELSEIF(IGAGA.EQ.2) THEN | |
7061 | ISUB=MINT(1) | |
7062 | MINT(15)=0 | |
7063 | MINT(16)=0 | |
7064 | ||
7065 | C...W value for photon on one or both sides, and for processes | |
7066 | C...with gamma-gamma cross section peaked at small shat. | |
7067 | IF(MINT(141).NE.0.AND.MINT(142).EQ.0) THEN | |
7068 | VINT(2)=VINT(302)+PMS(1)-PMC(1)*(1D0-XMAX(1)) | |
7069 | ELSEIF(MINT(141).EQ.0.AND.MINT(142).NE.0) THEN | |
7070 | VINT(2)=VINT(302)+PMS(2)-PMC(2)*(1D0-XMAX(2)) | |
7071 | ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN | |
7072 | VINT(2)=MAX(CKIN(77)**2,12D0*MAX(CKIN(3),CKIN(5))**2) | |
7073 | IF(CKIN(78).GT.0D0) VINT(2)=MIN(VINT(2),CKIN(78)**2) | |
7074 | ELSE | |
7075 | VINT(2)=XMAX(1)*XMAX(2)*VINT(302) | |
7076 | IF(CKIN(78).GT.0D0) VINT(2)=MIN(VINT(2),CKIN(78)**2) | |
7077 | ENDIF | |
7078 | VINT(1)=SQRT(MAX(0D0,VINT(2))) | |
7079 | ||
7080 | C...Upper estimate of photon flux weight factor. | |
7081 | C...Initialization Q2 scale. Flag incoming unresolved photon. | |
7082 | WTGAGA=1D0 | |
7083 | DO 110 I=1,2 | |
7084 | IF(MINT(140+I).NE.0) THEN | |
7085 | WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* | |
7086 | & LOG(XMAX(I)/XMIN(I))*LOG(Q2MAX(I)/Q2MIN(I)) | |
7087 | IF(ISUB.EQ.99.AND.MINT(106+I).EQ.4.AND.MINT(109-I).EQ.3) | |
7088 | & THEN | |
7089 | Q2INIT=5D0+Q2MIN(3-I) | |
7090 | ELSEIF(ISUB.EQ.99.AND.MINT(106+I).EQ.4) THEN | |
7091 | Q2INIT=PMAS(PYCOMP(113),1)**2+Q2MIN(3-I) | |
7092 | ELSEIF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN | |
7093 | Q2INIT=MAX(CKIN(1),2D0*CKIN(3),2D0*CKIN(5))**2/3D0 | |
7094 | ELSEIF((ISUB.EQ.138.AND.I.EQ.2).OR. | |
7095 | & (ISUB.EQ.139.AND.I.EQ.1)) THEN | |
7096 | Q2INIT=VINT(2)/3D0 | |
7097 | ELSEIF(ISUB.EQ.140) THEN | |
7098 | Q2INIT=VINT(2)/2D0 | |
7099 | ELSE | |
7100 | Q2INIT=Q2MIN(I) | |
7101 | ENDIF | |
7102 | VINT(2+I)=-SQRT(MAX(Q2MIN(I),MIN(Q2MAX(I),Q2INIT))) | |
7103 | IF(MSTP(14).EQ.0.OR.(ISUB.GE.131.AND.ISUB.LE.140)) | |
7104 | & MINT(14+I)=22 | |
7105 | VINT(306+I)=VINT(2+I)**2 | |
7106 | ENDIF | |
7107 | 110 CONTINUE | |
7108 | VINT(320)=WTGAGA | |
7109 | ||
7110 | C...Update pTmin and cross section information. | |
7111 | IF(MSTP(82).LE.1) THEN | |
7112 | PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) | |
7113 | ELSE | |
7114 | PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) | |
7115 | ENDIF | |
7116 | VINT(149)=4D0*PTMN**2/VINT(2) | |
7117 | VINT(154)=PTMN | |
7118 | CALL PYXTOT | |
7119 | VINT(318)=VINT(317) | |
7120 | ||
7121 | C...Generate photons inside leptons and | |
7122 | C...calculate photon flux weight factors. | |
7123 | ELSEIF(IGAGA.EQ.3) THEN | |
7124 | ISUB=MINT(1) | |
7125 | MINT(15)=0 | |
7126 | MINT(16)=0 | |
7127 | ||
7128 | C...Generate phase space point and check against cuts. | |
7129 | LOOP=0 | |
7130 | 120 LOOP=LOOP+1 | |
7131 | DO 130 I=1,2 | |
7132 | IF(MINT(140+I).NE.0) THEN | |
7133 | C...Pick x and Q2 | |
7134 | X(I)=XMIN(I)*(XMAX(I)/XMIN(I))**PYR(0) | |
7135 | Q2(I)=Q2MIN(I)*(Q2MAX(I)/Q2MIN(I))**PYR(0) | |
7136 | C...Cuts on internal consistency in x and Q2. | |
7137 | IF(Q2(I).LT.X(I)**2*PMS(I)/(1D0-X(I))) GOTO 120 | |
7138 | IF(Q2(I).GT.(1D0-X(I))*(VINT(302)-2D0*PMS(3-I))- | |
7139 | & (2D0-X(I)**2)*PMS(I)/(1D0-X(I))) GOTO 120 | |
7140 | C...Cuts on y and theta. | |
7141 | Y(I)=(PMC(I)*X(I)+Q2(I))/PMC(3) | |
7142 | IF(Y(I).LT.CKIN(71+2*I).OR.Y(I).GT.CKIN(72+2*I)) GOTO 120 | |
7143 | RAT=((1D0-X(I))*Q2(I)-X(I)**2*PMS(I))/ | |
7144 | & ((1D0-X(I))**2*(VINT(302)-2D0*PMS(3-I)-2D0*PMS(I))) | |
7145 | THETA(I)=2D0*ASIN(SQRT(MAX(0D0,MIN(1D0,RAT)))) | |
7146 | IF(THETA(I).LT.CKIN(67+2*I)) GOTO 120 | |
7147 | IF(CKIN(68+2*I).GT.0D0.AND.THETA(I).GT.CKIN(68+2*I)) | |
7148 | & GOTO 120 | |
7149 | ||
7150 | C...Phi angle isotropic. Reconstruct pT. | |
7151 | PHI(I)=PARU(2)*PYR(0) | |
7152 | PT(I)=SQRT(((1D0-X(I))*PMC(I))**2/(4D0*VINT(302))- | |
7153 | & PMS(I))*SIN(THETA(I)) | |
7154 | ||
7155 | C...Store info on variables selected, for documentation purposes. | |
7156 | VINT(2+I)=-SQRT(Q2(I)) | |
7157 | VINT(304+I)=X(I) | |
7158 | VINT(306+I)=Q2(I) | |
7159 | VINT(308+I)=Y(I) | |
7160 | VINT(310+I)=THETA(I) | |
7161 | VINT(312+I)=PHI(I) | |
7162 | ELSE | |
7163 | VINT(304+I)=1D0 | |
7164 | VINT(306+I)=0D0 | |
7165 | VINT(308+I)=1D0 | |
7166 | VINT(310+I)=0D0 | |
7167 | VINT(312+I)=0D0 | |
7168 | ENDIF | |
7169 | 130 CONTINUE | |
7170 | ||
7171 | C...Cut on W combines info from two sides. | |
7172 | IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN | |
7173 | W2=-Q2(1)-Q2(2)+0.5D0*X(1)*PMC(1)*X(2)*PMC(2)/VINT(302)- | |
7174 | & 2D0*PT(1)*PT(2)*COS(PHI(1)-PHI(2))+2D0* | |
7175 | & SQRT((0.5D0*X(1)*PMC(1)/VINT(301))**2+Q2(1)-PT(1)**2)* | |
7176 | & SQRT((0.5D0*X(2)*PMC(2)/VINT(301))**2+Q2(2)-PT(2)**2) | |
7177 | IF(W2.LT.W2MIN) GOTO 120 | |
7178 | IF(CKIN(78).GT.0D0.AND.W2.GT.CKIN(78)**2) GOTO 120 | |
7179 | PMS1=-Q2(1) | |
7180 | PMS2=-Q2(2) | |
7181 | ELSEIF(MINT(141).NE.0) THEN | |
7182 | W2=(VINT(302)+PMS(1))*X(1)+PMS(2)*(1D0-X(1)) | |
7183 | PMS1=-Q2(1) | |
7184 | PMS2=PMS(2) | |
7185 | ELSEIF(MINT(142).NE.0) THEN | |
7186 | W2=(VINT(302)+PMS(2))*X(2)+PMS(1)*(1D0-X(2)) | |
7187 | PMS1=PMS(1) | |
7188 | PMS2=-Q2(2) | |
7189 | ENDIF | |
7190 | ||
7191 | C...Store kinematics info for photon(s) in subsystem cm frame. | |
7192 | VINT(2)=W2 | |
7193 | VINT(1)=SQRT(W2) | |
7194 | VINT(291)=0D0 | |
7195 | VINT(292)=0D0 | |
7196 | VINT(293)=0.5D0*SQRT((W2-PMS1-PMS2)**2-4D0*PMS1*PMS2)/VINT(1) | |
7197 | VINT(294)=0.5D0*(W2+PMS1-PMS2)/VINT(1) | |
7198 | VINT(295)=SIGN(SQRT(ABS(PMS1)),PMS1) | |
7199 | VINT(296)=0D0 | |
7200 | VINT(297)=0D0 | |
7201 | VINT(298)=-VINT(293) | |
7202 | VINT(299)=0.5D0*(W2+PMS2-PMS1)/VINT(1) | |
7203 | VINT(300)=SIGN(SQRT(ABS(PMS2)),PMS2) | |
7204 | ||
7205 | C...Assign weight for photon flux; different for transverse and | |
7206 | C...longitudinal photons. Flag incoming unresolved photon. | |
7207 | WTGAGA=1D0 | |
7208 | DO 140 I=1,2 | |
7209 | IF(MINT(140+I).NE.0) THEN | |
7210 | WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* | |
7211 | & LOG(XMAX(I)/XMIN(I))*LOG(Q2MAX(I)/Q2MIN(I)) | |
7212 | IF(MSTP(16).EQ.0) THEN | |
7213 | XY=X(I) | |
7214 | ELSE | |
7215 | WTGAGA=WTGAGA*X(I)/Y(I) | |
7216 | XY=Y(I) | |
7217 | ENDIF | |
7218 | IF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN | |
7219 | WTGAGA=WTGAGA*(1D0-XY) | |
7220 | ELSEIF(I.EQ.1.AND.(ISUB.EQ.139.OR.ISUB.EQ.140)) THEN | |
7221 | WTGAGA=WTGAGA*(1D0-XY) | |
7222 | ELSEIF(I.EQ.2.AND.(ISUB.EQ.138.OR.ISUB.EQ.140)) THEN | |
7223 | WTGAGA=WTGAGA*(1D0-XY) | |
7224 | ELSE | |
7225 | WTGAGA=WTGAGA*(0.5D0*(1D0+(1D0-XY)**2)- | |
7226 | & PMS(I)*XY**2/Q2(I)) | |
7227 | ENDIF | |
7228 | IF(MINT(106+I).EQ.0) MINT(14+I)=22 | |
7229 | ENDIF | |
7230 | 140 CONTINUE | |
7231 | VINT(319)=WTGAGA | |
7232 | MINT(143)=LOOP | |
7233 | ||
7234 | C...Update pTmin and cross section information. | |
7235 | IF(MSTP(82).LE.1) THEN | |
7236 | PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) | |
7237 | ELSE | |
7238 | PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) | |
7239 | ENDIF | |
7240 | VINT(149)=4D0*PTMN**2/VINT(2) | |
7241 | VINT(154)=PTMN | |
7242 | CALL PYXTOT | |
7243 | ||
7244 | C...Reconstruct kinematics of photons inside leptons. | |
7245 | ELSEIF(IGAGA.EQ.4) THEN | |
7246 | ||
7247 | C...Make place for incoming particles and scattered leptons. | |
7248 | MOVE=3 | |
7249 | IF(MINT(141).NE.0.AND.MINT(142).NE.0) MOVE=4 | |
7250 | MINT(4)=MINT(4)+MOVE | |
7251 | DO 160 I=MINT(84)-MOVE,MINT(83)+1,-1 | |
7252 | IF(K(I,1).EQ.21) THEN | |
7253 | DO 150 J=1,5 | |
7254 | K(I+MOVE,J)=K(I,J) | |
7255 | P(I+MOVE,J)=P(I,J) | |
7256 | V(I+MOVE,J)=V(I,J) | |
7257 | 150 CONTINUE | |
7258 | IF(K(I,3).GT.MINT(83).AND.K(I,3).LE.MINT(84)) | |
7259 | & K(I+MOVE,3)=K(I,3)+MOVE | |
7260 | IF(K(I,4).GT.MINT(83).AND.K(I,4).LE.MINT(84)) | |
7261 | & K(I+MOVE,4)=K(I,4)+MOVE | |
7262 | IF(K(I,5).GT.MINT(83).AND.K(I,5).LE.MINT(84)) | |
7263 | & K(I+MOVE,5)=K(I,5)+MOVE | |
7264 | ENDIF | |
7265 | 160 CONTINUE | |
7266 | DO 170 I=MINT(84)+1,N | |
7267 | IF(K(I,3).GT.MINT(83).AND.K(I,3).LE.MINT(84)) | |
7268 | & K(I,3)=K(I,3)+MOVE | |
7269 | 170 CONTINUE | |
7270 | ||
7271 | C...Fill in incoming particles. | |
7272 | DO 190 I=MINT(83)+1,MINT(83)+MOVE | |
7273 | DO 180 J=1,5 | |
7274 | K(I,J)=0 | |
7275 | P(I,J)=0D0 | |
7276 | V(I,J)=0D0 | |
7277 | 180 CONTINUE | |
7278 | 190 CONTINUE | |
7279 | DO 200 I=1,2 | |
7280 | K(MINT(83)+I,1)=21 | |
7281 | IF(MINT(140+I).NE.0) THEN | |
7282 | K(MINT(83)+I,2)=MINT(140+I) | |
7283 | P(MINT(83)+I,5)=VINT(302+I) | |
7284 | ELSE | |
7285 | K(MINT(83)+I,2)=MINT(10+I) | |
7286 | P(MINT(83)+I,5)=VINT(2+I) | |
7287 | ENDIF | |
7288 | P(MINT(83)+I,3)=0.5D0*SQRT((PMC(3)**2-4D0*PMS(1)*PMS(2))/ | |
7289 | & VINT(302))*(-1D0)**(I+1) | |
7290 | P(MINT(83)+I,4)=0.5D0*PMC(I)/VINT(301) | |
7291 | 200 CONTINUE | |
7292 | ||
7293 | C...New mother-daughter relations in documentation section. | |
7294 | IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN | |
7295 | K(MINT(83)+1,4)=MINT(83)+3 | |
7296 | K(MINT(83)+1,5)=MINT(83)+5 | |
7297 | K(MINT(83)+2,4)=MINT(83)+4 | |
7298 | K(MINT(83)+2,5)=MINT(83)+6 | |
7299 | K(MINT(83)+3,3)=MINT(83)+1 | |
7300 | K(MINT(83)+5,3)=MINT(83)+1 | |
7301 | K(MINT(83)+4,3)=MINT(83)+2 | |
7302 | K(MINT(83)+6,3)=MINT(83)+2 | |
7303 | ELSEIF(MINT(141).NE.0) THEN | |
7304 | K(MINT(83)+1,4)=MINT(83)+3 | |
7305 | K(MINT(83)+1,5)=MINT(83)+4 | |
7306 | K(MINT(83)+2,4)=MINT(83)+5 | |
7307 | K(MINT(83)+3,3)=MINT(83)+1 | |
7308 | K(MINT(83)+4,3)=MINT(83)+1 | |
7309 | K(MINT(83)+5,3)=MINT(83)+2 | |
7310 | ELSEIF(MINT(142).NE.0) THEN | |
7311 | K(MINT(83)+1,4)=MINT(83)+4 | |
7312 | K(MINT(83)+2,4)=MINT(83)+3 | |
7313 | K(MINT(83)+2,5)=MINT(83)+5 | |
7314 | K(MINT(83)+3,3)=MINT(83)+2 | |
7315 | K(MINT(83)+4,3)=MINT(83)+1 | |
7316 | K(MINT(83)+5,3)=MINT(83)+2 | |
7317 | ENDIF | |
7318 | ||
7319 | C...Fill scattered lepton(s). | |
7320 | DO 210 I=1,2 | |
7321 | IF(MINT(140+I).NE.0) THEN | |
7322 | LSC=MINT(83)+MIN(I+2,MOVE) | |
7323 | K(LSC,1)=21 | |
7324 | K(LSC,2)=MINT(140+I) | |
7325 | P(LSC,1)=PT(I)*COS(PHI(I)) | |
7326 | P(LSC,2)=PT(I)*SIN(PHI(I)) | |
7327 | P(LSC,4)=(1D0-X(I))*P(MINT(83)+I,4) | |
7328 | P(LSC,3)=SQRT(P(LSC,4)**2-PMS(I))*COS(THETA(I))* | |
7329 | & (-1D0)**(I-1) | |
7330 | P(LSC,5)=VINT(302+I) | |
7331 | ENDIF | |
7332 | 210 CONTINUE | |
7333 | ||
7334 | C...Find incoming four-vectors to subprocess. | |
7335 | K(N+1,1)=21 | |
7336 | IF(MINT(141).NE.0) THEN | |
7337 | DO 220 J=1,4 | |
7338 | P(N+1,J)=P(MINT(83)+1,J)-P(MINT(83)+3,J) | |
7339 | 220 CONTINUE | |
7340 | ELSE | |
7341 | DO 230 J=1,4 | |
7342 | P(N+1,J)=P(MINT(83)+1,J) | |
7343 | 230 CONTINUE | |
7344 | ENDIF | |
7345 | K(N+2,1)=21 | |
7346 | IF(MINT(142).NE.0) THEN | |
7347 | DO 240 J=1,4 | |
7348 | P(N+2,J)=P(MINT(83)+2,J)-P(MINT(83)+MOVE,J) | |
7349 | 240 CONTINUE | |
7350 | ELSE | |
7351 | DO 250 J=1,4 | |
7352 | P(N+2,J)=P(MINT(83)+2,J) | |
7353 | 250 CONTINUE | |
7354 | ENDIF | |
7355 | ||
7356 | C...Define boost and rotation between hadronic subsystem and | |
7357 | C...collision rest frame; boost hadronic subsystem to this frame. | |
7358 | DO 260 J=1,3 | |
7359 | BETA(J)=(P(N+1,J)+P(N+2,J))/(P(N+1,4)+P(N+2,4)) | |
7360 | 260 CONTINUE | |
7361 | CALL PYROBO(N+1,N+2,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) | |
7362 | BPHI=PYANGL(P(N+1,1),P(N+1,2)) | |
7363 | CALL PYROBO(N+1,N+2,0D0,-BPHI,0D0,0D0,0D0) | |
7364 | BTHETA=PYANGL(P(N+1,3),P(N+1,1)) | |
7365 | CALL PYROBO(MINT(83)+MOVE+1,N,BTHETA,BPHI,BETA(1),BETA(2), | |
7366 | & BETA(3)) | |
7367 | ||
7368 | C...Add on scattered leptons to final state. | |
7369 | DO 280 I=1,2 | |
7370 | IF(MINT(140+I).NE.0) THEN | |
7371 | LSC=MINT(83)+MIN(I+2,MOVE) | |
7372 | N=N+1 | |
7373 | DO 270 J=1,5 | |
7374 | K(N,J)=K(LSC,J) | |
7375 | P(N,J)=P(LSC,J) | |
7376 | V(N,J)=V(LSC,J) | |
7377 | 270 CONTINUE | |
7378 | K(N,1)=1 | |
7379 | K(N,3)=LSC | |
7380 | ENDIF | |
7381 | 280 CONTINUE | |
7382 | ENDIF | |
7383 | ||
7384 | RETURN | |
7385 | END | |
7386 | ||
7387 | C********************************************************************* | |
7388 | ||
7389 | C...PYRAND | |
7390 | C...Generates quantities characterizing the high-pT scattering at the | |
7391 | C...parton level according to the matrix elements. Chooses incoming, | |
7392 | C...reacting partons, their momentum fractions and one of the possible | |
7393 | C...subprocesses. | |
7394 | ||
7395 | SUBROUTINE PYRAND | |
7396 | ||
7397 | C...Double precision and integer declarations. | |
7398 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
7399 | IMPLICIT INTEGER(I-N) | |
7400 | INTEGER PYK,PYCHGE,PYCOMP | |
7401 | C...Parameter statement to help give large particle numbers. | |
7402 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
7403 | &KEXCIT=4000000,KDIMEN=5000000) | |
7404 | ||
7405 | C...User process initialization and event commonblocks. | |
7406 | INTEGER MAXPUP | |
7407 | PARAMETER (MAXPUP=100) | |
7408 | INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP | |
7409 | DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP | |
7410 | COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), | |
7411 | &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), | |
7412 | &LPRUP(MAXPUP) | |
7413 | INTEGER MAXNUP | |
7414 | PARAMETER (MAXNUP=500) | |
7415 | INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP | |
7416 | DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP | |
7417 | COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), | |
7418 | &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), | |
7419 | &VTIMUP(MAXNUP),SPINUP(MAXNUP) | |
7420 | SAVE /HEPRUP/,/HEPEUP/ | |
7421 | ||
7422 | C...Commonblocks. | |
7423 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7424 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
7425 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
7426 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
7427 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
7428 | COMMON/PYINT1/MINT(400),VINT(400) | |
7429 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
7430 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
7431 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
7432 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
7433 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
7434 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
7435 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
7436 | &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/,/PYMSSM/ | |
7437 | C...Local arrays. | |
7438 | DIMENSION XPQ(-25:25),PMM(2),PDIF(4),BHAD(4),PMMN(2) | |
7439 | ||
7440 | C...Parameters and data used in elastic/diffractive treatment. | |
7441 | DATA EPS/0.0808D0/, ALP/0.25D0/, CRES/2D0/, PMRC/1.062D0/, | |
7442 | &SMP/0.880D0/, BHAD/2.3D0,1.4D0,1.4D0,0.23D0/ | |
7443 | ||
7444 | C...Initial values, specifically for (first) semihard interaction. | |
7445 | MINT(10)=0 | |
7446 | MINT(17)=0 | |
7447 | MINT(18)=0 | |
7448 | VINT(97)=1D0 | |
7449 | VINT(143)=1D0 | |
7450 | VINT(144)=1D0 | |
7451 | VINT(157)=0D0 | |
7452 | VINT(158)=0D0 | |
7453 | MFAIL=0 | |
7454 | IF(MSTP(171).EQ.1.AND.MSTP(172).EQ.2) MFAIL=1 | |
7455 | ISUB=0 | |
7456 | ISTSB=0 | |
7457 | LOOP=0 | |
7458 | 100 LOOP=LOOP+1 | |
7459 | MINT(51)=0 | |
7460 | MINT(143)=1 | |
7461 | ||
7462 | C...Start by assuming incoming photon is entering subprocess. | |
7463 | IF(MINT(11).EQ.22) THEN | |
7464 | MINT(15)=22 | |
7465 | VINT(307)=VINT(3)**2 | |
7466 | ENDIF | |
7467 | IF(MINT(12).EQ.22) THEN | |
7468 | MINT(16)=22 | |
7469 | VINT(308)=VINT(4)**2 | |
7470 | ENDIF | |
7471 | MINT(103)=MINT(11) | |
7472 | MINT(104)=MINT(12) | |
7473 | ||
7474 | C...Choice of process type - first event of pileup. | |
7475 | INMULT=0 | |
7476 | IF(MINT(82).EQ.1.AND.ISUB.GE.91.AND.ISUB.LE.96) THEN | |
7477 | ELSEIF(MINT(82).EQ.1) THEN | |
7478 | ||
7479 | C...For gamma-p or gamma-gamma first pick between alternatives. | |
7480 | IGA=0 | |
7481 | IF(MINT(121).GT.1) CALL PYSAVE(4,IGA) | |
7482 | MINT(122)=IGA | |
7483 | ||
7484 | C...For real gamma + gamma with different nature, flip at random. | |
7485 | IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4.AND. | |
7486 | & MSTP(14).LE.10.AND.PYR(0).GT.0.5D0) THEN | |
7487 | MINTSV=MINT(41) | |
7488 | MINT(41)=MINT(42) | |
7489 | MINT(42)=MINTSV | |
7490 | MINTSV=MINT(45) | |
7491 | MINT(45)=MINT(46) | |
7492 | MINT(46)=MINTSV | |
7493 | MINTSV=MINT(107) | |
7494 | MINT(107)=MINT(108) | |
7495 | MINT(108)=MINTSV | |
7496 | IF(MINT(47).EQ.2.OR.MINT(47).EQ.3) MINT(47)=5-MINT(47) | |
7497 | ENDIF | |
7498 | ||
7499 | C...Pick process type, possibly by user process machinery. | |
7500 | C...(If the latter, also event will be picked here.) | |
7501 | IF(MINT(111).EQ.11.AND.IABS(IDWTUP).EQ.2.AND.LOOP.GE.2) THEN | |
7502 | CALL UPEVNT | |
7503 | ELSEIF(MINT(111).EQ.11.AND.IABS(IDWTUP).GE.3) THEN | |
7504 | CALL UPEVNT | |
7505 | ISUB=0 | |
7506 | 110 ISUB=ISUB+1 | |
7507 | IF((ISET(ISUB).NE.11.OR.KFPR(ISUB,2).NE.IDPRUP).AND. | |
7508 | & ISUB.LT.500) GOTO 110 | |
7509 | ELSE | |
7510 | RSUB=XSEC(0,1)*PYR(0) | |
7511 | DO 120 I=1,500 | |
7512 | IF(MSUB(I).NE.1) GOTO 120 | |
7513 | ISUB=I | |
7514 | RSUB=RSUB-XSEC(I,1) | |
7515 | IF(RSUB.LE.0D0) GOTO 130 | |
7516 | 120 CONTINUE | |
7517 | 130 IF(ISUB.EQ.95) ISUB=96 | |
7518 | IF(ISUB.EQ.96) INMULT=1 | |
7519 | IF(ISET(ISUB).EQ.11) THEN | |
7520 | IDPRUP=KFPR(ISUB,2) | |
7521 | CALL UPEVNT | |
7522 | ENDIF | |
7523 | ENDIF | |
7524 | ||
7525 | C...Choice of inclusive process type - pileup events. | |
7526 | ELSEIF(MINT(82).GE.2.AND.ISUB.EQ.0) THEN | |
7527 | RSUB=VINT(131)*PYR(0) | |
7528 | ISUB=96 | |
7529 | IF(RSUB.GT.SIGT(0,0,5)) ISUB=94 | |
7530 | IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)) ISUB=93 | |
7531 | IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)+SIGT(0,0,3)) ISUB=92 | |
7532 | IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)+SIGT(0,0,3)+SIGT(0,0,2)) | |
7533 | & ISUB=91 | |
7534 | IF(ISUB.EQ.96) INMULT=1 | |
7535 | ENDIF | |
7536 | ||
7537 | C...Choice of photon energy and flux factor inside lepton. | |
7538 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) THEN | |
7539 | CALL PYGAGA(3,WTGAGA) | |
7540 | IF(ISUB.GE.131.AND.ISUB.LE.140) THEN | |
7541 | CKIN(3)=MAX(VINT(285),VINT(154)) | |
7542 | CKIN(1)=2D0*CKIN(3) | |
7543 | ENDIF | |
7544 | C...When necessary set direct/resolved photon by hand. | |
7545 | ELSEIF(MINT(15).EQ.22.OR.MINT(16).EQ.22) THEN | |
7546 | IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0 | |
7547 | IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0 | |
7548 | ENDIF | |
7549 | ||
7550 | C...Restrict direct*resolved processes to pTmin >= Q, | |
7551 | C...to avoid doublecounting with DIS. | |
7552 | IF(MSTP(18).EQ.3.AND.ISUB.GE.131.AND.ISUB.LE.136) THEN | |
7553 | IF(MINT(15).EQ.22) THEN | |
7554 | CKIN(3)=MAX(VINT(285),VINT(154),ABS(VINT(3))) | |
7555 | ELSE | |
7556 | CKIN(3)=MAX(VINT(285),VINT(154),ABS(VINT(4))) | |
7557 | ENDIF | |
7558 | CKIN(1)=2D0*CKIN(3) | |
7559 | ENDIF | |
7560 | ||
7561 | C...Set up for multiple interactions. | |
7562 | IF(INMULT.EQ.1) CALL PYMULT(2) | |
7563 | ||
7564 | C...Loopback point for minimum bias in photon physics. | |
7565 | LOOP2=0 | |
7566 | 140 LOOP2=LOOP2+1 | |
7567 | IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)+MINT(143) | |
7568 | IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)+MINT(143) | |
7569 | IF(ISUB.EQ.96.AND.LOOP2.EQ.1.AND.MINT(82).EQ.1) | |
7570 | &NGEN(97,1)=NGEN(97,1)+MINT(143) | |
7571 | MINT(1)=ISUB | |
7572 | ISTSB=ISET(ISUB) | |
7573 | ||
7574 | C...Random choice of flavour for some SUSY processes. | |
7575 | IF(ISUB.GE.201.AND.ISUB.LE.301) THEN | |
7576 | C...~e_L ~nu_e or ~mu_L ~nu_mu. | |
7577 | IF(ISUB.EQ.210) THEN | |
7578 | KFPR(ISUB,1)=KSUSY1+11+2*INT(0.5D0+PYR(0)) | |
7579 | KFPR(ISUB,2)=KFPR(ISUB,1)+1 | |
7580 | C...~nu_e ~nu_e(bar) or ~nu_mu ~nu_mu(bar). | |
7581 | ELSEIF(ISUB.EQ.213) THEN | |
7582 | KFPR(ISUB,1)=KSUSY1+12+2*INT(0.5D0+PYR(0)) | |
7583 | KFPR(ISUB,2)=KFPR(ISUB,1) | |
7584 | C...~q ~chi/~g; ~q = ~d, ~u, ~s, ~c or ~b. | |
7585 | ELSEIF(ISUB.GE.246.AND.ISUB.LE.259) THEN | |
7586 | IF(ISUB.GE.258) THEN | |
7587 | RKF=4D0 | |
7588 | ELSE | |
7589 | RKF=5D0 | |
7590 | ENDIF | |
7591 | IF(MOD(ISUB,2).EQ.0) THEN | |
7592 | KFPR(ISUB,1)=KSUSY1+1+INT(RKF*PYR(0)) | |
7593 | ELSE | |
7594 | KFPR(ISUB,1)=KSUSY2+1+INT(RKF*PYR(0)) | |
7595 | ENDIF | |
7596 | C...~q1 ~q2; ~q = ~d, ~u, ~s, or ~c. | |
7597 | ELSEIF(ISUB.GE.271.AND.ISUB.LE.276) THEN | |
7598 | IF(ISUB.EQ.271.OR.ISUB.EQ.274) THEN | |
7599 | KSU1=KSUSY1 | |
7600 | KSU2=KSUSY1 | |
7601 | ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.275) THEN | |
7602 | KSU1=KSUSY2 | |
7603 | KSU2=KSUSY2 | |
7604 | ELSEIF(PYR(0).LT.0.5D0) THEN | |
7605 | KSU1=KSUSY1 | |
7606 | KSU2=KSUSY2 | |
7607 | ELSE | |
7608 | KSU1=KSUSY2 | |
7609 | KSU2=KSUSY1 | |
7610 | ENDIF | |
7611 | KFPR(ISUB,1)=KSU1+1+INT(4D0*PYR(0)) | |
7612 | KFPR(ISUB,2)=KSU2+1+INT(4D0*PYR(0)) | |
7613 | C...~q ~q(bar); ~q = ~d, ~u, ~s, or ~c. | |
7614 | ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.279) THEN | |
7615 | KFPR(ISUB,1)=KSUSY1+1+INT(4D0*PYR(0)) | |
7616 | KFPR(ISUB,2)=KFPR(ISUB,1) | |
7617 | ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.280) THEN | |
7618 | KFPR(ISUB,1)=KSUSY2+1+INT(4D0*PYR(0)) | |
7619 | KFPR(ISUB,2)=KFPR(ISUB,1) | |
7620 | C...~q1 ~q2; ~q = ~d, ~u, ~s, or ~c. | |
7621 | ELSEIF(ISUB.GE.281.AND.ISUB.LE.286) THEN | |
7622 | IF(ISUB.EQ.281.OR.ISUB.EQ.284) THEN | |
7623 | KSU1=KSUSY1 | |
7624 | KSU2=KSUSY1 | |
7625 | ELSEIF(ISUB.EQ.282.OR.ISUB.EQ.285) THEN | |
7626 | KSU1=KSUSY2 | |
7627 | KSU2=KSUSY2 | |
7628 | ELSEIF(PYR(0).LT.0.5D0) THEN | |
7629 | KSU1=KSUSY1 | |
7630 | KSU2=KSUSY2 | |
7631 | ELSE | |
7632 | KSU1=KSUSY2 | |
7633 | KSU2=KSUSY1 | |
7634 | ENDIF | |
7635 | IF(ISUB.EQ.281.OR.ISUB.LE.283) THEN | |
7636 | RKF=5D0 | |
7637 | ELSE | |
7638 | RKF=4D0 | |
7639 | ENDIF | |
7640 | KFPR(ISUB,2)=KSU2+1+INT(RKF*PYR(0)) | |
7641 | ENDIF | |
7642 | ENDIF | |
7643 | ||
7644 | C...Find resonances (explicit or implicit in cross-section). | |
7645 | MINT(72)=0 | |
7646 | KFR1=0 | |
7647 | IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN | |
7648 | KFR1=KFPR(ISUB,1) | |
7649 | ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165.OR. | |
7650 | & ISUB.EQ.171.OR.ISUB.EQ.176) THEN | |
7651 | KFR1=23 | |
7652 | ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172.OR. | |
7653 | & ISUB.EQ.177) THEN | |
7654 | KFR1=24 | |
7655 | ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN | |
7656 | KFR1=25 | |
7657 | IF(MSTP(46).EQ.5) THEN | |
7658 | KFR1=89 | |
7659 | PMAS(89,1)=PARP(45) | |
7660 | PMAS(89,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) | |
7661 | ENDIF | |
7662 | ELSEIF(ISUB.EQ.194) THEN | |
7663 | KFR1=KTECHN+113 | |
7664 | ELSEIF(ISUB.EQ.195) THEN | |
7665 | KFR1=KTECHN+213 | |
7666 | ELSEIF(ISUB.GE.361.AND.ISUB.LE.368) THEN | |
7667 | KFR1=KTECHN+113 | |
7668 | ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN | |
7669 | KFR1=KTECHN+213 | |
7670 | ENDIF | |
7671 | CKMX=CKIN(2) | |
7672 | IF(CKMX.LE.0D0) CKMX=VINT(1) | |
7673 | KCR1=PYCOMP(KFR1) | |
7674 | IF(KFR1.NE.0) THEN | |
7675 | IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. | |
7676 | & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 | |
7677 | ENDIF | |
7678 | IF(KFR1.NE.0) THEN | |
7679 | TAUR1=PMAS(KCR1,1)**2/VINT(2) | |
7680 | IF(KFR1.EQ.KTECHN+113) THEN | |
7681 | CALL PYTECM(S1,S2) | |
7682 | TAUR1=S1/VINT(2) | |
7683 | ENDIF | |
7684 | GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) | |
7685 | MINT(72)=1 | |
7686 | MINT(73)=KFR1 | |
7687 | VINT(73)=TAUR1 | |
7688 | VINT(74)=GAMR1 | |
7689 | ENDIF | |
7690 | IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.(ISUB.GE.364.AND.ISUB.LE.368)) | |
7691 | $THEN | |
7692 | KFR2=23 | |
7693 | IF(ISUB.EQ.194) THEN | |
7694 | KFR2=KTECHN+223 | |
7695 | ELSEIF(ISUB.GE.364.AND.ISUB.LE.368) THEN | |
7696 | KFR2=KTECHN+223 | |
7697 | ENDIF | |
7698 | KCR2=PYCOMP(KFR2) | |
7699 | TAUR2=PMAS(KCR2,1)**2/VINT(2) | |
7700 | IF(KFR2.EQ.KTECHN+223) THEN | |
7701 | CALL PYTECM(S1,S2) | |
7702 | TAUR2=S2/VINT(2) | |
7703 | ENDIF | |
7704 | GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) | |
7705 | IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. | |
7706 | & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) KFR2=0 | |
7707 | IF(KFR2.NE.0.AND.KFR1.NE.0) THEN | |
7708 | MINT(72)=2 | |
7709 | MINT(74)=KFR2 | |
7710 | VINT(75)=TAUR2 | |
7711 | VINT(76)=GAMR2 | |
7712 | ELSEIF(KFR2.NE.0) THEN | |
7713 | KFR1=KFR2 | |
7714 | TAUR1=TAUR2 | |
7715 | GAMR1=GAMR2 | |
7716 | MINT(72)=1 | |
7717 | MINT(73)=KFR1 | |
7718 | VINT(73)=TAUR1 | |
7719 | VINT(74)=GAMR1 | |
7720 | ENDIF | |
7721 | ENDIF | |
7722 | ||
7723 | C...Find product masses and minimum pT of process, | |
7724 | C...optionally with broadening according to a truncated Breit-Wigner. | |
7725 | VINT(63)=0D0 | |
7726 | VINT(64)=0D0 | |
7727 | MINT(71)=0 | |
7728 | VINT(71)=CKIN(3) | |
7729 | IF(MINT(82).GE.2) VINT(71)=0D0 | |
7730 | VINT(80)=1D0 | |
7731 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN | |
7732 | NBW=0 | |
7733 | DO 160 I=1,2 | |
7734 | PMMN(I)=0D0 | |
7735 | IF(KFPR(ISUB,I).EQ.0) THEN | |
7736 | ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT. | |
7737 | & PARP(41)) THEN | |
7738 | VINT(62+I)=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 | |
7739 | ELSE | |
7740 | NBW=NBW+1 | |
7741 | C...This prevents SUSY/t particles from becoming too light. | |
7742 | KFLW=KFPR(ISUB,I) | |
7743 | IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN | |
7744 | KCW=PYCOMP(KFLW) | |
7745 | PMMN(I)=PMAS(KCW,1) | |
7746 | DO 150 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 | |
7747 | IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN | |
7748 | PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ | |
7749 | & PMAS(PYCOMP(KFDP(IDC,2)),1) | |
7750 | IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ | |
7751 | & PMAS(PYCOMP(KFDP(IDC,3)),1) | |
7752 | PMMN(I)=MIN(PMMN(I),PMSUM) | |
7753 | ENDIF | |
7754 | 150 CONTINUE | |
7755 | ELSEIF(KFLW.EQ.6) THEN | |
7756 | PMMN(I)=PMAS(24,1)+PMAS(5,1) | |
7757 | ENDIF | |
7758 | ENDIF | |
7759 | 160 CONTINUE | |
7760 | IF(NBW.GE.1) THEN | |
7761 | CKIN41=CKIN(41) | |
7762 | CKIN43=CKIN(43) | |
7763 | CKIN(41)=MAX(PMMN(1),CKIN(41)) | |
7764 | CKIN(43)=MAX(PMMN(2),CKIN(43)) | |
7765 | CALL PYOFSH(4,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) | |
7766 | CKIN(41)=CKIN41 | |
7767 | CKIN(43)=CKIN43 | |
7768 | IF(MINT(51).EQ.1) THEN | |
7769 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
7770 | IF(MFAIL.EQ.1) THEN | |
7771 | MSTI(61)=1 | |
7772 | RETURN | |
7773 | ENDIF | |
7774 | GOTO 100 | |
7775 | ENDIF | |
7776 | VINT(63)=PQM3**2 | |
7777 | VINT(64)=PQM4**2 | |
7778 | ENDIF | |
7779 | IF(MIN(VINT(63),VINT(64)).LT.CKIN(6)**2) MINT(71)=1 | |
7780 | IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) | |
7781 | ENDIF | |
7782 | ||
7783 | C...Prepare for additional variable choices in 2 -> 3. | |
7784 | IF(ISTSB.EQ.5) THEN | |
7785 | VINT(201)=0D0 | |
7786 | IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1) | |
7787 | VINT(206)=VINT(201) | |
7788 | VINT(204)=PMAS(23,1) | |
7789 | IF(ISUB.EQ.124.OR.ISUB.EQ.351) VINT(204)=PMAS(24,1) | |
7790 | IF(ISUB.EQ.352) VINT(204)=PMAS(PYCOMP(9900024),1) | |
7791 | IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182.OR. | |
7792 | & ISUB.EQ.186.OR.ISUB.EQ.187) VINT(204)=VINT(201) | |
7793 | VINT(209)=VINT(204) | |
7794 | ENDIF | |
7795 | ||
7796 | C...Select incoming VDM particle (rho/omega/phi/J/psi). | |
7797 | IF(ISTSB.NE.0.AND.(MINT(101).GE.2.OR.MINT(102).GE.2).AND. | |
7798 | &(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7)) THEN | |
7799 | VRN=PYR(0)*SIGT(0,0,5) | |
7800 | IF(MINT(101).LE.1) THEN | |
7801 | I1MN=0 | |
7802 | I1MX=0 | |
7803 | ELSE | |
7804 | I1MN=1 | |
7805 | I1MX=MINT(101) | |
7806 | ENDIF | |
7807 | IF(MINT(102).LE.1) THEN | |
7808 | I2MN=0 | |
7809 | I2MX=0 | |
7810 | ELSE | |
7811 | I2MN=1 | |
7812 | I2MX=MINT(102) | |
7813 | ENDIF | |
7814 | DO 180 I1=I1MN,I1MX | |
7815 | KFV1=110*I1+3 | |
7816 | DO 170 I2=I2MN,I2MX | |
7817 | KFV2=110*I2+3 | |
7818 | VRN=VRN-SIGT(I1,I2,5) | |
7819 | IF(VRN.LE.0D0) GOTO 190 | |
7820 | 170 CONTINUE | |
7821 | 180 CONTINUE | |
7822 | 190 IF(MINT(101).GE.2) MINT(103)=KFV1 | |
7823 | IF(MINT(102).GE.2) MINT(104)=KFV2 | |
7824 | ENDIF | |
7825 | ||
7826 | IF(ISTSB.EQ.0) THEN | |
7827 | C...Elastic scattering or single or double diffractive scattering. | |
7828 | ||
7829 | C...Select incoming particle (rho/omega/phi/J/psi for VDM) and mass. | |
7830 | MINT(103)=MINT(11) | |
7831 | MINT(104)=MINT(12) | |
7832 | PMM(1)=VINT(3) | |
7833 | PMM(2)=VINT(4) | |
7834 | IF(MINT(101).GE.2.OR.MINT(102).GE.2) THEN | |
7835 | JJ=ISUB-90 | |
7836 | VRN=PYR(0)*SIGT(0,0,JJ) | |
7837 | IF(MINT(101).LE.1) THEN | |
7838 | I1MN=0 | |
7839 | I1MX=0 | |
7840 | ELSE | |
7841 | I1MN=1 | |
7842 | I1MX=MINT(101) | |
7843 | ENDIF | |
7844 | IF(MINT(102).LE.1) THEN | |
7845 | I2MN=0 | |
7846 | I2MX=0 | |
7847 | ELSE | |
7848 | I2MN=1 | |
7849 | I2MX=MINT(102) | |
7850 | ENDIF | |
7851 | DO 210 I1=I1MN,I1MX | |
7852 | KFV1=110*I1+3 | |
7853 | DO 200 I2=I2MN,I2MX | |
7854 | KFV2=110*I2+3 | |
7855 | VRN=VRN-SIGT(I1,I2,JJ) | |
7856 | IF(VRN.LE.0D0) GOTO 220 | |
7857 | 200 CONTINUE | |
7858 | 210 CONTINUE | |
7859 | 220 IF(MINT(101).GE.2) THEN | |
7860 | MINT(103)=KFV1 | |
7861 | PMM(1)=PYMASS(KFV1) | |
7862 | ENDIF | |
7863 | IF(MINT(102).GE.2) THEN | |
7864 | MINT(104)=KFV2 | |
7865 | PMM(2)=PYMASS(KFV2) | |
7866 | ENDIF | |
7867 | ENDIF | |
7868 | VINT(67)=PMM(1) | |
7869 | VINT(68)=PMM(2) | |
7870 | ||
7871 | C...Select mass for GVMD states (rejecting previous assignment). | |
7872 | Q0S=4D0*PARP(15)**2 | |
7873 | Q1S=4D0*VINT(154)**2 | |
7874 | LOOP3=0 | |
7875 | 230 LOOP3=LOOP3+1 | |
7876 | DO 240 JT=1,2 | |
7877 | IF(MINT(106+JT).EQ.3) THEN | |
7878 | PS=VINT(2+JT)**2 | |
7879 | PMM(JT)=(Q0S+PS)*(Q1S+PS)/ | |
7880 | & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS | |
7881 | IF(MINT(102+JT).GE.333) PMM(JT)=PMM(JT)- | |
7882 | & PMAS(PYCOMP(113),1)+PMAS(PYCOMP(MINT(102+JT)),1) | |
7883 | ENDIF | |
7884 | 240 CONTINUE | |
7885 | IF(PMM(1)+PMM(2)+PARP(104).GE.VINT(1)) THEN | |
7886 | IF(LOOP3.LT.100.AND.(MINT(107).EQ.3.OR.MINT(108).EQ.3)) | |
7887 | & GOTO 230 | |
7888 | GOTO 100 | |
7889 | ENDIF | |
7890 | ||
7891 | C...Side/sides of diffractive system. | |
7892 | MINT(17)=0 | |
7893 | MINT(18)=0 | |
7894 | IF(ISUB.EQ.92.OR.ISUB.EQ.94) MINT(17)=1 | |
7895 | IF(ISUB.EQ.93.OR.ISUB.EQ.94) MINT(18)=1 | |
7896 | ||
7897 | C...Find masses of particles and minimal masses of diffractive states. | |
7898 | DO 250 JT=1,2 | |
7899 | PDIF(JT)=PMM(JT) | |
7900 | VINT(68+JT)=PDIF(JT) | |
7901 | IF(MINT(16+JT).EQ.1) PDIF(JT)=PDIF(JT)+PARP(102) | |
7902 | 250 CONTINUE | |
7903 | SH=VINT(2) | |
7904 | SQM1=PMM(1)**2 | |
7905 | SQM2=PMM(2)**2 | |
7906 | SQM3=PDIF(1)**2 | |
7907 | SQM4=PDIF(2)**2 | |
7908 | SMRES1=(PMM(1)+PMRC)**2 | |
7909 | SMRES2=(PMM(2)+PMRC)**2 | |
7910 | ||
7911 | C...Find elastic slope and lower limit diffractive slope. | |
7912 | IHA=MAX(2,IABS(MINT(103))/110) | |
7913 | IF(IHA.GE.5) IHA=1 | |
7914 | IHB=MAX(2,IABS(MINT(104))/110) | |
7915 | IF(IHB.GE.5) IHB=1 | |
7916 | IF(ISUB.EQ.91) THEN | |
7917 | BMN=2D0*BHAD(IHA)+2D0*BHAD(IHB)+4D0*SH**EPS-4.2D0 | |
7918 | ELSEIF(ISUB.EQ.92) THEN | |
7919 | BMN=MAX(2D0,2D0*BHAD(IHB)) | |
7920 | ELSEIF(ISUB.EQ.93) THEN | |
7921 | BMN=MAX(2D0,2D0*BHAD(IHA)) | |
7922 | ELSEIF(ISUB.EQ.94) THEN | |
7923 | BMN=2D0*ALP*4D0 | |
7924 | ENDIF | |
7925 | ||
7926 | C...Determine maximum possible t range and coefficient of generation. | |
7927 | SQLA12=(SH-SQM1-SQM2)**2-4D0*SQM1*SQM2 | |
7928 | SQLA34=(SH-SQM3-SQM4)**2-4D0*SQM3*SQM4 | |
7929 | THA=SH-(SQM1+SQM2+SQM3+SQM4)+(SQM1-SQM2)*(SQM3-SQM4)/SH | |
7930 | THB=SQRT(MAX(0D0,SQLA12))*SQRT(MAX(0D0,SQLA34))/SH | |
7931 | THC=(SQM3-SQM1)*(SQM4-SQM2)+(SQM1+SQM4-SQM2-SQM3)* | |
7932 | & (SQM1*SQM4-SQM2*SQM3)/SH | |
7933 | THL=-0.5D0*(THA+THB) | |
7934 | THU=THC/THL | |
7935 | THRND=EXP(MAX(-50D0,BMN*(THL-THU)))-1D0 | |
7936 | ||
7937 | C...Select diffractive mass/masses according to dm^2/m^2. | |
7938 | LOOP3=0 | |
7939 | 260 LOOP3=LOOP3+1 | |
7940 | DO 270 JT=1,2 | |
7941 | IF(MINT(16+JT).EQ.0) THEN | |
7942 | PDIF(2+JT)=PDIF(JT) | |
7943 | ELSE | |
7944 | PMMIN=PDIF(JT) | |
7945 | PMMAX=MAX(VINT(2+JT),VINT(1)-PDIF(3-JT)) | |
7946 | PDIF(2+JT)=PMMIN*(PMMAX/PMMIN)**PYR(0) | |
7947 | ENDIF | |
7948 | 270 CONTINUE | |
7949 | SQM3=PDIF(3)**2 | |
7950 | SQM4=PDIF(4)**2 | |
7951 | ||
7952 | C..Additional mass factors, including resonance enhancement. | |
7953 | IF(PDIF(3)+PDIF(4).GE.VINT(1)) THEN | |
7954 | IF(LOOP3.LT.100) GOTO 260 | |
7955 | GOTO 100 | |
7956 | ENDIF | |
7957 | IF(ISUB.EQ.92) THEN | |
7958 | FSD=(1D0-SQM3/SH)*(1D0+CRES*SMRES1/(SMRES1+SQM3)) | |
7959 | IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 260 | |
7960 | ELSEIF(ISUB.EQ.93) THEN | |
7961 | FSD=(1D0-SQM4/SH)*(1D0+CRES*SMRES2/(SMRES2+SQM4)) | |
7962 | IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 260 | |
7963 | ELSEIF(ISUB.EQ.94) THEN | |
7964 | FDD=(1D0-(PDIF(3)+PDIF(4))**2/SH)*(SH*SMP/ | |
7965 | & (SH*SMP+SQM3*SQM4))*(1D0+CRES*SMRES1/(SMRES1+SQM3))* | |
7966 | & (1D0+CRES*SMRES2/(SMRES2+SQM4)) | |
7967 | IF(FDD.LT.PYR(0)*(1D0+CRES)**2) GOTO 260 | |
7968 | ENDIF | |
7969 | ||
7970 | C...Select t according to exp(Bmn*t) and correct to right slope. | |
7971 | TH=THU+LOG(1D0+THRND*PYR(0))/BMN | |
7972 | IF(ISUB.GE.92) THEN | |
7973 | IF(ISUB.EQ.92) THEN | |
7974 | BADD=2D0*ALP*LOG(SH/SQM3) | |
7975 | IF(BHAD(IHB).LT.1D0) BADD=MAX(0D0,BADD+2D0*BHAD(IHB)-2D0) | |
7976 | ELSEIF(ISUB.EQ.93) THEN | |
7977 | BADD=2D0*ALP*LOG(SH/SQM4) | |
7978 | IF(BHAD(IHA).LT.1D0) BADD=MAX(0D0,BADD+2D0*BHAD(IHA)-2D0) | |
7979 | ELSEIF(ISUB.EQ.94) THEN | |
7980 | BADD=2D0*ALP*(LOG(EXP(4D0)+SH/(ALP*SQM3*SQM4))-4D0) | |
7981 | ENDIF | |
7982 | IF(EXP(MAX(-50D0,BADD*(TH-THU))).LT.PYR(0)) GOTO 260 | |
7983 | ENDIF | |
7984 | ||
7985 | C...Check whether m^2 and t choices are consistent. | |
7986 | SQLA34=(SH-SQM3-SQM4)**2-4D0*SQM3*SQM4 | |
7987 | THA=SH-(SQM1+SQM2+SQM3+SQM4)+(SQM1-SQM2)*(SQM3-SQM4)/SH | |
7988 | THB=SQRT(MAX(0D0,SQLA12))*SQRT(MAX(0D0,SQLA34))/SH | |
7989 | IF(THB.LE.1D-8) GOTO 260 | |
7990 | THC=(SQM3-SQM1)*(SQM4-SQM2)+(SQM1+SQM4-SQM2-SQM3)* | |
7991 | & (SQM1*SQM4-SQM2*SQM3)/SH | |
7992 | THLM=-0.5D0*(THA+THB) | |
7993 | THUM=THC/THLM | |
7994 | IF(TH.LT.THLM.OR.TH.GT.THUM) GOTO 260 | |
7995 | ||
7996 | C...Information to output. | |
7997 | VINT(21)=1D0 | |
7998 | VINT(22)=0D0 | |
7999 | VINT(23)=MIN(1D0,MAX(-1D0,(THA+2D0*TH)/THB)) | |
8000 | VINT(45)=TH | |
8001 | VINT(59)=2D0*SQRT(MAX(0D0,-(THC+THA*TH+TH**2)))/THB | |
8002 | VINT(63)=PDIF(3)**2 | |
8003 | VINT(64)=PDIF(4)**2 | |
8004 | VINT(283)=PMM(1)**2/4D0 | |
8005 | VINT(284)=PMM(2)**2/4D0 | |
8006 | ||
8007 | C...Note: in the following, by In is meant the integral over the | |
8008 | C...quantity multiplying coefficient cn. | |
8009 | C...Choose tau according to h1(tau)/tau, where | |
8010 | C...h1(tau) = c1 + I1/I2*c2*1/tau + I1/I3*c3*1/(tau+tau_R) + | |
8011 | C...I1/I4*c4*tau/((s*tau-m^2)^2+(m*Gamma)^2) + | |
8012 | C...I1/I5*c5*1/(tau+tau_R') + | |
8013 | C...I1/I6*c6*tau/((s*tau-m'^2)^2+(m'*Gamma')^2) + | |
8014 | C...I1/I7*c7*tau/(1.-tau), and | |
8015 | C...c1 + c2 + c3 + c4 + c5 + c6 + c7 = 1. | |
8016 | ELSEIF(ISTSB.GE.1.AND.ISTSB.LE.5) THEN | |
8017 | CALL PYKLIM(1) | |
8018 | IF(MINT(51).NE.0) THEN | |
8019 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8020 | IF(MFAIL.EQ.1) THEN | |
8021 | MSTI(61)=1 | |
8022 | RETURN | |
8023 | ENDIF | |
8024 | GOTO 100 | |
8025 | ENDIF | |
8026 | RTAU=PYR(0) | |
8027 | MTAU=1 | |
8028 | IF(RTAU.GT.COEF(ISUB,1)) MTAU=2 | |
8029 | IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)) MTAU=3 | |
8030 | IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)) MTAU=4 | |
8031 | IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)) | |
8032 | & MTAU=5 | |
8033 | IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+ | |
8034 | & COEF(ISUB,5)) MTAU=6 | |
8035 | IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+ | |
8036 | & COEF(ISUB,5)+COEF(ISUB,6)) MTAU=7 | |
8037 | CALL PYKMAP(1,MTAU,PYR(0)) | |
8038 | ||
8039 | C...2 -> 3, 4 processes: | |
8040 | C...Choose tau' according to h4(tau,tau')/tau', where | |
8041 | C...h4(tau,tau') = c1 + I1/I2*c2*(1 - tau/tau')^3/tau' + | |
8042 | C...I1/I3*c3*1/(1 - tau'), and c1 + c2 + c3 = 1. | |
8043 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN | |
8044 | CALL PYKLIM(4) | |
8045 | IF(MINT(51).NE.0) THEN | |
8046 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8047 | IF(MFAIL.EQ.1) THEN | |
8048 | MSTI(61)=1 | |
8049 | RETURN | |
8050 | ENDIF | |
8051 | GOTO 100 | |
8052 | ENDIF | |
8053 | RTAUP=PYR(0) | |
8054 | MTAUP=1 | |
8055 | IF(RTAUP.GT.COEF(ISUB,18)) MTAUP=2 | |
8056 | IF(RTAUP.GT.COEF(ISUB,18)+COEF(ISUB,19)) MTAUP=3 | |
8057 | CALL PYKMAP(4,MTAUP,PYR(0)) | |
8058 | ENDIF | |
8059 | ||
8060 | C...Choose y* according to h2(y*), where | |
8061 | C...h2(y*) = I0/I1*c1*(y*-y*min) + I0/I2*c2*(y*max-y*) + | |
8062 | C...I0/I3*c3*1/cosh(y*) + I0/I4*c4*1/(1-exp(y*-y*max)) + | |
8063 | C...I0/I5*c5*1/(1-exp(-y*-y*min)), I0 = y*max-y*min, | |
8064 | C...and c1 + c2 + c3 + c4 + c5 = 1. | |
8065 | CALL PYKLIM(2) | |
8066 | IF(MINT(51).NE.0) THEN | |
8067 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8068 | IF(MFAIL.EQ.1) THEN | |
8069 | MSTI(61)=1 | |
8070 | RETURN | |
8071 | ENDIF | |
8072 | GOTO 100 | |
8073 | ENDIF | |
8074 | RYST=PYR(0) | |
8075 | MYST=1 | |
8076 | IF(RYST.GT.COEF(ISUB,8)) MYST=2 | |
8077 | IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 | |
8078 | IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)) MYST=4 | |
8079 | IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)+ | |
8080 | & COEF(ISUB,11)) MYST=5 | |
8081 | CALL PYKMAP(2,MYST,PYR(0)) | |
8082 | ||
8083 | C...2 -> 2 processes: | |
8084 | C...Choose cos(theta-hat) (cth) according to h3(cth), where | |
8085 | C...h3(cth) = c0 + I0/I1*c1*1/(A - cth) + I0/I2*c2*1/(A + cth) + | |
8086 | C...I0/I3*c3*1/(A - cth)^2 + I0/I4*c4*1/(A + cth)^2, | |
8087 | C...A = 1 + 2*(m3*m4/sh)^2 (= 1 for massless products), | |
8088 | C...and c0 + c1 + c2 + c3 + c4 = 1. | |
8089 | CALL PYKLIM(3) | |
8090 | IF(MINT(51).NE.0) THEN | |
8091 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8092 | IF(MFAIL.EQ.1) THEN | |
8093 | MSTI(61)=1 | |
8094 | RETURN | |
8095 | ENDIF | |
8096 | GOTO 100 | |
8097 | ENDIF | |
8098 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN | |
8099 | RCTH=PYR(0) | |
8100 | MCTH=1 | |
8101 | IF(RCTH.GT.COEF(ISUB,13)) MCTH=2 | |
8102 | IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)) MCTH=3 | |
8103 | IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)) MCTH=4 | |
8104 | IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)+ | |
8105 | & COEF(ISUB,16)) MCTH=5 | |
8106 | CALL PYKMAP(3,MCTH,PYR(0)) | |
8107 | ENDIF | |
8108 | ||
8109 | C...2 -> 3 : select pT1, phi1, pT2, phi2, y3 for 3 outgoing. | |
8110 | IF(ISTSB.EQ.5) THEN | |
8111 | CALL PYKMAP(5,0,0D0) | |
8112 | IF(MINT(51).NE.0) THEN | |
8113 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8114 | IF(MFAIL.EQ.1) THEN | |
8115 | MSTI(61)=1 | |
8116 | RETURN | |
8117 | ENDIF | |
8118 | GOTO 100 | |
8119 | ENDIF | |
8120 | ENDIF | |
8121 | ||
8122 | C...DIS as f + gamma* -> f process: set dummy values. | |
8123 | ELSEIF(ISTSB.EQ.8) THEN | |
8124 | VINT(21)=0.9D0 | |
8125 | VINT(22)=0D0 | |
8126 | VINT(23)=0D0 | |
8127 | VINT(47)=0D0 | |
8128 | VINT(48)=0D0 | |
8129 | ||
8130 | C...Low-pT or multiple interactions (first semihard interaction). | |
8131 | ELSEIF(ISTSB.EQ.9) THEN | |
8132 | CALL PYMULT(3) | |
8133 | ISUB=MINT(1) | |
8134 | ||
8135 | C...Study user-defined process: kinematics plus weight. | |
8136 | ELSEIF(ISTSB.EQ.11) THEN | |
8137 | IF(IDWTUP.GT.0.AND.XWGTUP.LT.0D0) CALL | |
8138 | & PYERRM(26,'(PYRAND:) Negative XWGTUP for user process') | |
8139 | MSTI(51)=0 | |
8140 | IF(NUP.LE.0) THEN | |
8141 | MINT(51)=2 | |
8142 | MSTI(51)=1 | |
8143 | IF(MINT(82).EQ.1) THEN | |
8144 | NGEN(0,1)=NGEN(0,1)-1 | |
8145 | NGEN(ISUB,1)=NGEN(ISUB,1)-1 | |
8146 | ENDIF | |
8147 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8148 | RETURN | |
8149 | ENDIF | |
8150 | ||
8151 | C...Extract cross section event weight. | |
8152 | IF(IABS(IDWTUP).EQ.1.OR.IABS(IDWTUP).EQ.4) THEN | |
8153 | SIGS=1D-9*XWGTUP | |
8154 | ELSE | |
8155 | SIGS=1D-9*XSECUP(KFPR(ISUB,1)) | |
8156 | ENDIF | |
8157 | IF(IABS(IDWTUP).GE.1.AND.IABS(IDWTUP).LE.3) THEN | |
8158 | VINT(97)=SIGN(1D0,XWGTUP) | |
8159 | ELSE | |
8160 | VINT(97)=1D-9*XWGTUP | |
8161 | ENDIF | |
8162 | ||
8163 | C...Construct 'trivial' kinematical variables needed. | |
8164 | KFL1=IDUP(1) | |
8165 | KFL2=IDUP(2) | |
8166 | VINT(41)=PUP(4,1)/EBMUP(1) | |
8167 | VINT(42)=PUP(4,2)/EBMUP(2) | |
8168 | VINT(21)=VINT(41)*VINT(42) | |
8169 | VINT(22)=0.5D0*LOG(VINT(41)/VINT(42)) | |
8170 | VINT(44)=VINT(21)*VINT(2) | |
8171 | VINT(43)=SQRT(MAX(0D0,VINT(44))) | |
8172 | VINT(55)=SCALUP | |
8173 | IF(SCALUP.LE.0D0) VINT(55)=VINT(43) | |
8174 | VINT(56)=VINT(55)**2 | |
8175 | VINT(57)=AQEDUP | |
8176 | VINT(58)=AQCDUP | |
8177 | ||
8178 | C...Construct other kinematical variables needed (approximately). | |
8179 | VINT(23)=0D0 | |
8180 | VINT(26)=VINT(21) | |
8181 | VINT(45)=-0.5D0*VINT(44) | |
8182 | VINT(46)=-0.5D0*VINT(44) | |
8183 | VINT(49)=VINT(43) | |
8184 | VINT(50)=VINT(44) | |
8185 | VINT(51)=VINT(55) | |
8186 | VINT(52)=VINT(56) | |
8187 | VINT(53)=VINT(55) | |
8188 | VINT(54)=VINT(56) | |
8189 | VINT(25)=0D0 | |
8190 | VINT(48)=0D0 | |
8191 | IF(ISTUP(1).NE.-1.OR.ISTUP(2).NE.-1) CALL PYERRM(26, | |
8192 | & '(PYRAND:) unacceptable ISTUP code for incoming particles') | |
8193 | DO 280 IUP=3,NUP | |
8194 | IF(ISTUP(IUP).LT.1.OR.ISTUP(IUP).GT.3) CALL PYERRM(26, | |
8195 | & '(PYRAND:) unacceptable ISTUP code for particles') | |
8196 | IF(ISTUP(IUP).EQ.1) VINT(25)=VINT(25)+2D0*(PUP(5,IUP)**2+ | |
8197 | & PUP(1,IUP)**2+PUP(2,IUP)**2)/VINT(2) | |
8198 | IF(ISTUP(IUP).EQ.1) VINT(48)=VINT(48)+0.5D0*(PUP(1,IUP)**2+ | |
8199 | & PUP(2,IUP)**2) | |
8200 | 280 CONTINUE | |
8201 | VINT(47)=SQRT(VINT(48)) | |
8202 | ENDIF | |
8203 | ||
8204 | C...Choose azimuthal angle. | |
8205 | VINT(24)=0D0 | |
8206 | IF(ISTSB.NE.11) VINT(24)=PARU(2)*PYR(0) | |
8207 | ||
8208 | C...Check against user cuts on kinematics at parton level. | |
8209 | MINT(51)=0 | |
8210 | IF((ISUB.LE.90.OR.ISUB.GT.100).AND.ISTSB.LE.10) CALL PYKLIM(0) | |
8211 | IF(MINT(51).NE.0) THEN | |
8212 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8213 | IF(MFAIL.EQ.1) THEN | |
8214 | MSTI(61)=1 | |
8215 | RETURN | |
8216 | ENDIF | |
8217 | GOTO 100 | |
8218 | ENDIF | |
8219 | IF(MINT(82).EQ.1.AND.MSTP(141).GE.1.AND.ISTSB.LE.10) THEN | |
8220 | MCUT=0 | |
8221 | IF(MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+MSUB(95).EQ.0) | |
8222 | & CALL PYKCUT(MCUT) | |
8223 | IF(MCUT.NE.0) THEN | |
8224 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8225 | IF(MFAIL.EQ.1) THEN | |
8226 | MSTI(61)=1 | |
8227 | RETURN | |
8228 | ENDIF | |
8229 | GOTO 100 | |
8230 | ENDIF | |
8231 | ENDIF | |
8232 | ||
8233 | C...Calculate differential cross-section for different subprocesses. | |
8234 | IF(ISTSB.LE.10) CALL PYSIGH(NCHN,SIGS) | |
8235 | SIGSOR=SIGS | |
8236 | SIGLPT=SIGT(0,0,5)*VINT(315)*VINT(316) | |
8237 | ||
8238 | C...Multiply cross section by lepton -> photon flux factor. | |
8239 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) THEN | |
8240 | SIGS=WTGAGA*SIGS | |
8241 | DO 290 ICHN=1,NCHN | |
8242 | SIGH(ICHN)=WTGAGA*SIGH(ICHN) | |
8243 | 290 CONTINUE | |
8244 | SIGLPT=WTGAGA*SIGLPT | |
8245 | ENDIF | |
8246 | ||
8247 | C...Multiply cross-section by user-defined weights. | |
8248 | IF(MSTP(173).EQ.1) THEN | |
8249 | SIGS=PARP(173)*SIGS | |
8250 | DO 300 ICHN=1,NCHN | |
8251 | SIGH(ICHN)=PARP(173)*SIGH(ICHN) | |
8252 | 300 CONTINUE | |
8253 | SIGLPT=PARP(173)*SIGLPT | |
8254 | ENDIF | |
8255 | WTXS=1D0 | |
8256 | SIGSWT=SIGS | |
8257 | VINT(99)=1D0 | |
8258 | VINT(100)=1D0 | |
8259 | IF(MINT(82).EQ.1.AND.MSTP(142).GE.1) THEN | |
8260 | IF(ISUB.NE.96.AND.MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+ | |
8261 | & MSUB(95).EQ.0) CALL PYEVWT(WTXS) | |
8262 | SIGSWT=WTXS*SIGS | |
8263 | VINT(99)=WTXS | |
8264 | IF(MSTP(142).EQ.1) VINT(100)=1D0/WTXS | |
8265 | ENDIF | |
8266 | ||
8267 | C...Calculations for Monte Carlo estimate of all cross-sections. | |
8268 | IF(MINT(82).EQ.1.AND.ISUB.LE.90.OR.ISUB.GE.96) THEN | |
8269 | IF(MSTP(142).LE.1) THEN | |
8270 | XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS | |
8271 | ELSE | |
8272 | XSEC(ISUB,2)=XSEC(ISUB,2)+SIGSWT | |
8273 | ENDIF | |
8274 | ELSEIF(MINT(82).EQ.1) THEN | |
8275 | XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS | |
8276 | ENDIF | |
8277 | IF((ISUB.EQ.95.OR.ISUB.EQ.96).AND.LOOP2.EQ.1.AND. | |
8278 | &MINT(82).EQ.1) XSEC(97,2)=XSEC(97,2)+SIGLPT | |
8279 | ||
8280 | C...Multiple interactions: store results of cross-section calculation. | |
8281 | IF(MINT(50).EQ.1.AND.MSTP(82).GE.3) THEN | |
8282 | VINT(153)=SIGSOR | |
8283 | CALL PYMULT(4) | |
8284 | ENDIF | |
8285 | ||
8286 | C...Ratio of actual to maximum cross section. | |
8287 | IF(ISTSB.NE.11) THEN | |
8288 | VIOL=SIGSWT/XSEC(ISUB,1) | |
8289 | IF(ISUB.EQ.96.AND.MSTP(173).EQ.1) VIOL=VIOL/PARP(174) | |
8290 | ELSEIF(IDWTUP.EQ.1.OR.IDWTUP.EQ.2) THEN | |
8291 | VIOL=XWGTUP/XMAXUP(KFPR(ISUB,1)) | |
8292 | ELSEIF(IDWTUP.EQ.-1.OR.IDWTUP.EQ.-2) THEN | |
8293 | VIOL=ABS(XWGTUP)/ABS(XMAXUP(KFPR(ISUB,1))) | |
8294 | ELSE | |
8295 | VIOL=1D0 | |
8296 | ENDIF | |
8297 | ||
8298 | C...Check that weight not negative. | |
8299 | IF(MSTP(123).LE.0) THEN | |
8300 | IF(VIOL.LT.-1D-3) THEN | |
8301 | WRITE(MSTU(11),5000) VIOL,NGEN(0,3)+1 | |
8302 | IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21), | |
8303 | & VINT(22),VINT(23),VINT(26) | |
8304 | STOP | |
8305 | ENDIF | |
8306 | ELSE | |
8307 | IF(VIOL.LT.MIN(-1D-3,VINT(109))) THEN | |
8308 | VINT(109)=VIOL | |
8309 | WRITE(MSTU(11),5200) VIOL,NGEN(0,3)+1 | |
8310 | IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21), | |
8311 | & VINT(22),VINT(23),VINT(26) | |
8312 | ENDIF | |
8313 | ENDIF | |
8314 | ||
8315 | C...Weighting using estimate of maximum of differential cross-section. | |
8316 | IF(MFAIL.EQ.0.AND.ISUB.NE.95.AND.ISUB.NE.96) THEN | |
8317 | IF(VIOL.LT.PYR(0)) THEN | |
8318 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8319 | IF(ISUB.GE.91.AND.ISUB.LE.94) ISUB=0 | |
8320 | GOTO 100 | |
8321 | ENDIF | |
8322 | ELSEIF(MFAIL.EQ.0) THEN | |
8323 | RATND=SIGLPT/XSEC(95,1) | |
8324 | VIOL=VIOL/RATND | |
8325 | IF(LOOP2.EQ.1.AND.RATND.LT.PYR(0)) THEN | |
8326 | IF(VIOL.GT.PYR(0).AND.MINT(82).EQ.1.AND.MSUB(95).EQ.1.AND. | |
8327 | & (ISUB.LE.90.OR.ISUB.GE.95)) NGEN(95,1)=NGEN(95,1)+MINT(143) | |
8328 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8329 | ISUB=0 | |
8330 | GOTO 100 | |
8331 | ENDIF | |
8332 | IF(VIOL.LT.PYR(0)) THEN | |
8333 | GOTO 140 | |
8334 | ENDIF | |
8335 | ELSEIF(ISUB.NE.95.AND.ISUB.NE.96) THEN | |
8336 | IF(VIOL.LT.PYR(0)) THEN | |
8337 | MSTI(61)=1 | |
8338 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8339 | RETURN | |
8340 | ENDIF | |
8341 | ELSE | |
8342 | RATND=SIGLPT/XSEC(95,1) | |
8343 | IF(LOOP.EQ.1.AND.RATND.LT.PYR(0)) THEN | |
8344 | MSTI(61)=1 | |
8345 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8346 | RETURN | |
8347 | ENDIF | |
8348 | VIOL=VIOL/RATND | |
8349 | IF(VIOL.LT.PYR(0)) THEN | |
8350 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8351 | GOTO 100 | |
8352 | ENDIF | |
8353 | ENDIF | |
8354 | ||
8355 | C...Check for possible violation of estimated maximum of differential | |
8356 | C...cross-section used in weighting. | |
8357 | IF(MSTP(123).LE.0) THEN | |
8358 | IF(VIOL.GT.1D0) THEN | |
8359 | WRITE(MSTU(11),5300) VIOL,NGEN(0,3)+1 | |
8360 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), | |
8361 | & VINT(22),VINT(23),VINT(26) | |
8362 | STOP | |
8363 | ENDIF | |
8364 | ELSEIF(MSTP(123).EQ.1) THEN | |
8365 | IF(VIOL.GT.VINT(108)) THEN | |
8366 | VINT(108)=VIOL | |
8367 | IF(VIOL.GT.1.0001D0) THEN | |
8368 | MINT(10)=1 | |
8369 | WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 | |
8370 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), | |
8371 | & VINT(22),VINT(23),VINT(26) | |
8372 | ENDIF | |
8373 | ENDIF | |
8374 | ELSEIF(VIOL.GT.VINT(108)) THEN | |
8375 | VINT(108)=VIOL | |
8376 | IF(VIOL.GT.1D0) THEN | |
8377 | MINT(10)=1 | |
8378 | WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 | |
8379 | IF(ISTSB.EQ.11.AND.(IABS(IDWTUP).EQ.1.OR.IABS(IDWTUP).EQ.2)) | |
8380 | & THEN | |
8381 | XMAXUP(KFPR(ISUB,1))=VIOL*XMAXUP(KFPR(ISUB,1)) | |
8382 | IF(KFPR(ISUB,1).LE.9) THEN | |
8383 | WRITE(MSTU(11),5800) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) | |
8384 | ELSEIF(KFPR(ISUB,1).LE.99) THEN | |
8385 | WRITE(MSTU(11),5900) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) | |
8386 | ELSE | |
8387 | WRITE(MSTU(11),6000) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) | |
8388 | ENDIF | |
8389 | ENDIF | |
8390 | IF(ISTSB.NE.11.OR.IABS(IDWTUP).EQ.1) THEN | |
8391 | XDIF=XSEC(ISUB,1)*(VIOL-1D0) | |
8392 | XSEC(ISUB,1)=XSEC(ISUB,1)+XDIF | |
8393 | IF(MSUB(ISUB).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GT.96)) | |
8394 | & XSEC(0,1)=XSEC(0,1)+XDIF | |
8395 | IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), | |
8396 | & VINT(22),VINT(23),VINT(26) | |
8397 | IF(ISUB.LE.9) THEN | |
8398 | WRITE(MSTU(11),5500) ISUB,XSEC(ISUB,1) | |
8399 | ELSEIF(ISUB.LE.99) THEN | |
8400 | WRITE(MSTU(11),5600) ISUB,XSEC(ISUB,1) | |
8401 | ELSE | |
8402 | WRITE(MSTU(11),5700) ISUB,XSEC(ISUB,1) | |
8403 | ENDIF | |
8404 | ENDIF | |
8405 | VINT(108)=1D0 | |
8406 | ENDIF | |
8407 | ENDIF | |
8408 | ||
8409 | C...Multiple interactions: choose impact parameter. | |
8410 | VINT(148)=1D0 | |
8411 | IF(MINT(50).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GE.96).AND. | |
8412 | &MSTP(82).GE.3) THEN | |
8413 | CALL PYMULT(5) | |
8414 | IF(VINT(150).LT.PYR(0)) THEN | |
8415 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8416 | IF(MFAIL.EQ.1) THEN | |
8417 | MSTI(61)=1 | |
8418 | RETURN | |
8419 | ENDIF | |
8420 | GOTO 100 | |
8421 | ENDIF | |
8422 | ENDIF | |
8423 | IF(MINT(82).EQ.1) NGEN(0,2)=NGEN(0,2)+1 | |
8424 | IF(MINT(82).EQ.1.AND.MSUB(95).EQ.1) THEN | |
8425 | IF(ISUB.LE.90.OR.ISUB.GE.95) NGEN(95,1)=NGEN(95,1)+MINT(143) | |
8426 | IF(ISUB.LE.90.OR.ISUB.GE.96) NGEN(96,2)=NGEN(96,2)+1 | |
8427 | ENDIF | |
8428 | IF(ISUB.LE.90.OR.ISUB.GE.96) MINT(31)=MINT(31)+1 | |
8429 | ||
8430 | C...Choose flavour of reacting partons (and subprocess). | |
8431 | IF(ISTSB.GE.11) GOTO 320 | |
8432 | RSIGS=SIGS*PYR(0) | |
8433 | QT2=VINT(48) | |
8434 | RQQBAR=PARP(87)*(1D0-(QT2/(QT2+(PARP(88)*PARP(82)* | |
8435 | &(VINT(1)/PARP(89))**PARP(90))**2))**2) | |
8436 | IF(ISUB.NE.95.AND.(ISUB.NE.96.OR.MSTP(82).LE.1.OR. | |
8437 | &PYR(0).GT.RQQBAR)) THEN | |
8438 | DO 310 ICHN=1,NCHN | |
8439 | KFL1=ISIG(ICHN,1) | |
8440 | KFL2=ISIG(ICHN,2) | |
8441 | MINT(2)=ISIG(ICHN,3) | |
8442 | RSIGS=RSIGS-SIGH(ICHN) | |
8443 | IF(RSIGS.LE.0D0) GOTO 320 | |
8444 | 310 CONTINUE | |
8445 | ||
8446 | C...Multiple interactions: choose qqbar preferentially at small pT. | |
8447 | ELSEIF(ISUB.EQ.96) THEN | |
8448 | MINT(105)=MINT(103) | |
8449 | MINT(109)=MINT(107) | |
8450 | CALL PYSPLI(MINT(11),21,KFL1,KFLDUM) | |
8451 | MINT(105)=MINT(104) | |
8452 | MINT(109)=MINT(108) | |
8453 | CALL PYSPLI(MINT(12),21,KFL2,KFLDUM) | |
8454 | MINT(1)=11 | |
8455 | MINT(2)=1 | |
8456 | IF(KFL1.EQ.KFL2.AND.PYR(0).LT.0.5D0) MINT(2)=2 | |
8457 | ||
8458 | C...Low-pT: choose string drawing configuration. | |
8459 | ELSE | |
8460 | KFL1=21 | |
8461 | KFL2=21 | |
8462 | RSIGS=6D0*PYR(0) | |
8463 | MINT(2)=1 | |
8464 | IF(RSIGS.GT.1D0) MINT(2)=2 | |
8465 | IF(RSIGS.GT.2D0) MINT(2)=3 | |
8466 | ENDIF | |
8467 | ||
8468 | C...Reassign QCD process. Partons before initial state radiation. | |
8469 | 320 IF(MINT(2).GT.10) THEN | |
8470 | MINT(1)=MINT(2)/10 | |
8471 | MINT(2)=MOD(MINT(2),10) | |
8472 | ENDIF | |
8473 | IF(MINT(82).EQ.1.AND.MSTP(111).GE.0) NGEN(MINT(1),2)= | |
8474 | &NGEN(MINT(1),2)+1 | |
8475 | MINT(15)=KFL1 | |
8476 | MINT(16)=KFL2 | |
8477 | MINT(13)=MINT(15) | |
8478 | MINT(14)=MINT(16) | |
8479 | VINT(141)=VINT(41) | |
8480 | VINT(142)=VINT(42) | |
8481 | VINT(151)=0D0 | |
8482 | VINT(152)=0D0 | |
8483 | ||
8484 | C...Calculate x value of photon for parton inside photon inside e. | |
8485 | DO 350 JT=1,2 | |
8486 | MINT(18+JT)=0 | |
8487 | VINT(154+JT)=0D0 | |
8488 | MSPLI=0 | |
8489 | IF(JT.EQ.1.AND.MINT(43).LE.2) MSPLI=1 | |
8490 | IF(JT.EQ.2.AND.MOD(MINT(43),2).EQ.1) MSPLI=1 | |
8491 | IF(IABS(MINT(14+JT)).LE.8.OR.MINT(14+JT).EQ.21) MSPLI=MSPLI+1 | |
8492 | IF(MSPLI.EQ.2) THEN | |
8493 | KFLH=MINT(14+JT) | |
8494 | XHRD=VINT(140+JT) | |
8495 | Q2HRD=VINT(54) | |
8496 | MINT(105)=MINT(102+JT) | |
8497 | MINT(109)=MINT(106+JT) | |
8498 | VINT(120)=VINT(2+JT) | |
8499 | IF(MSTP(57).LE.1) THEN | |
8500 | CALL PYPDFU(22,XHRD,Q2HRD,XPQ) | |
8501 | ELSE | |
8502 | CALL PYPDFL(22,XHRD,Q2HRD,XPQ) | |
8503 | ENDIF | |
8504 | WTMX=4D0*XPQ(KFLH) | |
8505 | IF(MSTP(13).EQ.2) THEN | |
8506 | Q2PMS=Q2HRD/PMAS(11,1)**2 | |
8507 | WTMX=WTMX*LOG(MAX(2D0,Q2PMS*(1D0-XHRD)/XHRD**2)) | |
8508 | ENDIF | |
8509 | 330 XE=XHRD**PYR(0) | |
8510 | XG=MIN(1D0-1D-10,XHRD/XE) | |
8511 | IF(MSTP(57).LE.1) THEN | |
8512 | CALL PYPDFU(22,XG,Q2HRD,XPQ) | |
8513 | ELSE | |
8514 | CALL PYPDFL(22,XG,Q2HRD,XPQ) | |
8515 | ENDIF | |
8516 | WT=(1D0+(1D0-XE)**2)*XPQ(KFLH) | |
8517 | IF(MSTP(13).EQ.2) WT=WT*LOG(MAX(2D0,Q2PMS*(1D0-XE)/XE**2)) | |
8518 | IF(WT.LT.PYR(0)*WTMX) GOTO 330 | |
8519 | MINT(18+JT)=1 | |
8520 | VINT(154+JT)=XE | |
8521 | DO 340 KFLS=-25,25 | |
8522 | XSFX(JT,KFLS)=XPQ(KFLS) | |
8523 | 340 CONTINUE | |
8524 | ENDIF | |
8525 | 350 CONTINUE | |
8526 | ||
8527 | C...Pick scale where photon is resolved. | |
8528 | Q0S=PARP(15)**2 | |
8529 | Q1S=VINT(154)**2 | |
8530 | VINT(283)=0D0 | |
8531 | IF(MINT(107).EQ.3) THEN | |
8532 | IF(MSTP(66).EQ.1) THEN | |
8533 | VINT(283)=Q0S*(VINT(54)/Q0S)**PYR(0) | |
8534 | ELSEIF(MSTP(66).EQ.2) THEN | |
8535 | PS=VINT(3)**2 | |
8536 | Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* | |
8537 | & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) | |
8538 | Q2INT=SQRT(Q0S*Q2EFF) | |
8539 | VINT(283)=Q2INT*(VINT(54)/Q2INT)**PYR(0) | |
8540 | ELSEIF(MSTP(66).EQ.3) THEN | |
8541 | VINT(283)=Q0S*(Q1S/Q0S)**PYR(0) | |
8542 | ELSEIF(MSTP(66).GE.4) THEN | |
8543 | PS=0.25D0*VINT(3)**2 | |
8544 | VINT(283)=(Q0S+PS)*(Q1S+PS)/ | |
8545 | & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS | |
8546 | ENDIF | |
8547 | ENDIF | |
8548 | VINT(284)=0D0 | |
8549 | IF(MINT(108).EQ.3) THEN | |
8550 | IF(MSTP(66).EQ.1) THEN | |
8551 | VINT(284)=Q0S*(VINT(54)/Q0S)**PYR(0) | |
8552 | ELSEIF(MSTP(66).EQ.2) THEN | |
8553 | PS=VINT(4)**2 | |
8554 | Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* | |
8555 | & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) | |
8556 | Q2INT=SQRT(Q0S*Q2EFF) | |
8557 | VINT(284)=Q2INT*(VINT(54)/Q2INT)**PYR(0) | |
8558 | ELSEIF(MSTP(66).EQ.3) THEN | |
8559 | VINT(284)=Q0S*(Q1S/Q0S)**PYR(0) | |
8560 | ELSEIF(MSTP(66).GE.4) THEN | |
8561 | PS=0.25D0*VINT(4)**2 | |
8562 | VINT(284)=(Q0S+PS)*(Q1S+PS)/ | |
8563 | & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS | |
8564 | ENDIF | |
8565 | ENDIF | |
8566 | IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) | |
8567 | ||
8568 | C...Format statements for differential cross-section maximum violations. | |
8569 | 5000 FORMAT(/1X,'Error: negative cross-section fraction',1P,D11.3,1X, | |
8570 | &'in event',1X,I7,'D0'/1X,'Execution stopped!') | |
8571 | 5100 FORMAT(1X,'ISUB = ',I3,'; Point of violation:'/1X,'tau =',1P, | |
8572 | &D11.3,', y* =',D11.3,', cthe = ',0P,F11.7,', tau'' =',1P,D11.3) | |
8573 | 5200 FORMAT(/1X,'Warning: negative cross-section fraction',1P,D11.3,1X, | |
8574 | &'in event',1X,I7) | |
8575 | 5300 FORMAT(/1X,'Error: maximum violated by',1P,D11.3,1X, | |
8576 | &'in event',1X,I7,'D0'/1X,'Execution stopped!') | |
8577 | 5400 FORMAT(/1X,'Advisory warning: maximum violated by',1P,D11.3,1X, | |
8578 | &'in event',1X,I7) | |
8579 | 5500 FORMAT(1X,'XSEC(',I1,',1) increased to',1P,D11.3) | |
8580 | 5600 FORMAT(1X,'XSEC(',I2,',1) increased to',1P,D11.3) | |
8581 | 5700 FORMAT(1X,'XSEC(',I3,',1) increased to',1P,D11.3) | |
8582 | 5800 FORMAT(1X,'XMAXUP(',I1,') increased to',1P,D11.3) | |
8583 | 5900 FORMAT(1X,'XMAXUP(',I2,') increased to',1P,D11.3) | |
8584 | 6000 FORMAT(1X,'XMAXUP(',I3,') increased to',1P,D11.3) | |
8585 | ||
8586 | RETURN | |
8587 | END | |
8588 | ||
8589 | C********************************************************************* | |
8590 | ||
8591 | C...PYSCAT | |
8592 | C...Finds outgoing flavours and event type; sets up the kinematics | |
8593 | C...and colour flow of the hard scattering | |
8594 | ||
8595 | SUBROUTINE PYSCAT | |
8596 | ||
8597 | C...Double precision and integer declarations | |
8598 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
8599 | IMPLICIT INTEGER(I-N) | |
8600 | INTEGER PYK,PYCHGE,PYCOMP | |
8601 | C...Parameter statement to help give large particle numbers. | |
8602 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
8603 | &KEXCIT=4000000,KDIMEN=5000000) | |
8604 | ||
8605 | C...User process event common block. | |
8606 | INTEGER MAXNUP | |
8607 | PARAMETER (MAXNUP=500) | |
8608 | INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP | |
8609 | DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP | |
8610 | COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), | |
8611 | &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), | |
8612 | &VTIMUP(MAXNUP),SPINUP(MAXNUP) | |
8613 | SAVE /HEPEUP/ | |
8614 | ||
8615 | C...Commonblocks | |
8616 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
8617 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
8618 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
8619 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
8620 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
8621 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
8622 | COMMON/PYINT1/MINT(400),VINT(400) | |
8623 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
8624 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
8625 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
8626 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
8627 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
8628 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
8629 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
8630 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, | |
8631 | &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYSSMT/,/PYTCSM/ | |
8632 | C...Local arrays and saved variables | |
8633 | DIMENSION WDTP(0:400),WDTE(0:400,0:5),PMQ(2),Z(2),CTHE(2), | |
8634 | &PHI(2),KUPPO(100),VINTSV(41:66),ILAB(100) | |
8635 | SAVE VINTSV | |
8636 | ||
8637 | C...Read out process | |
8638 | ISUB=MINT(1) | |
8639 | ISUBSV=ISUB | |
8640 | ||
8641 | C...Restore information for low-pT processes | |
8642 | IF(ISUB.EQ.95.AND.MINT(57).GE.1) THEN | |
8643 | DO 100 J=41,66 | |
8644 | 100 VINT(J)=VINTSV(J) | |
8645 | ENDIF | |
8646 | ||
8647 | C...Convert H' or A process into equivalent H one | |
8648 | IHIGG=1 | |
8649 | KFHIGG=25 | |
8650 | IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND. | |
8651 | &ISUB.LE.190)) THEN | |
8652 | IHIGG=2 | |
8653 | IF(MOD(ISUB-1,10).GE.5) IHIGG=3 | |
8654 | KFHIGG=33+IHIGG | |
8655 | IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3 | |
8656 | IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102 | |
8657 | IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103 | |
8658 | IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24 | |
8659 | IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26 | |
8660 | IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123 | |
8661 | IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124 | |
8662 | IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121 | |
8663 | IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122 | |
8664 | IF(ISUB.EQ.183.OR.ISUB.EQ.188) ISUB=111 | |
8665 | IF(ISUB.EQ.184.OR.ISUB.EQ.189) ISUB=112 | |
8666 | IF(ISUB.EQ.185.OR.ISUB.EQ.190) ISUB=113 | |
8667 | ENDIF | |
8668 | ||
8669 | C...Choice of subprocess, number of documentation lines | |
8670 | IDOC=6+ISET(ISUB) | |
8671 | IF(ISUB.EQ.95) IDOC=8 | |
8672 | IF(ISET(ISUB).EQ.5) IDOC=9 | |
8673 | IF(ISET(ISUB).EQ.11) IDOC=4+NUP | |
8674 | MINT(3)=IDOC-6 | |
8675 | IF(IDOC.GE.9.AND.ISET(ISUB).LE.4) IDOC=IDOC+2 | |
8676 | MINT(4)=IDOC | |
8677 | IPU1=MINT(84)+1 | |
8678 | IPU2=MINT(84)+2 | |
8679 | IPU3=MINT(84)+3 | |
8680 | IPU4=MINT(84)+4 | |
8681 | IPU5=MINT(84)+5 | |
8682 | IPU6=MINT(84)+6 | |
8683 | ||
8684 | C...Reset K, P and V vectors. Store incoming particles | |
8685 | DO 120 JT=1,MSTP(126)+100 | |
8686 | I=MINT(83)+JT | |
8687 | IF(I.GT.MSTU(4)) GOTO 120 | |
8688 | DO 110 J=1,5 | |
8689 | K(I,J)=0 | |
8690 | P(I,J)=0D0 | |
8691 | V(I,J)=0D0 | |
8692 | 110 CONTINUE | |
8693 | 120 CONTINUE | |
8694 | DO 140 JT=1,2 | |
8695 | I=MINT(83)+JT | |
8696 | K(I,1)=21 | |
8697 | K(I,2)=MINT(10+JT) | |
8698 | DO 130 J=1,5 | |
8699 | P(I,J)=VINT(285+5*JT+J) | |
8700 | 130 CONTINUE | |
8701 | 140 CONTINUE | |
8702 | MINT(6)=2 | |
8703 | KFRES=0 | |
8704 | ||
8705 | C...Store incoming partons in their CM-frame | |
8706 | SH=VINT(44) | |
8707 | SHR=SQRT(SH) | |
8708 | SHP=VINT(26)*VINT(2) | |
8709 | SHPR=SQRT(SHP) | |
8710 | SHUSER=SHR | |
8711 | IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) SHUSER=SHPR | |
8712 | DO 150 JT=1,2 | |
8713 | I=MINT(84)+JT | |
8714 | K(I,1)=14 | |
8715 | K(I,2)=MINT(14+JT) | |
8716 | K(I,3)=MINT(83)+2+JT | |
8717 | P(I,3)=0.5D0*SHUSER*(-1D0)**(JT-1) | |
8718 | P(I,4)=0.5D0*SHUSER | |
8719 | 150 CONTINUE | |
8720 | ||
8721 | C...Copy incoming partons to documentation lines | |
8722 | DO 170 JT=1,2 | |
8723 | I1=MINT(83)+4+JT | |
8724 | I2=MINT(84)+JT | |
8725 | K(I1,1)=21 | |
8726 | K(I1,2)=K(I2,2) | |
8727 | K(I1,3)=I1-2 | |
8728 | DO 160 J=1,5 | |
8729 | P(I1,J)=P(I2,J) | |
8730 | 160 CONTINUE | |
8731 | 170 CONTINUE | |
8732 | ||
8733 | C...Choose new quark/lepton flavour for relevant annihilation graphs | |
8734 | IF(ISUB.EQ.12.OR.ISUB.EQ.53.OR.ISUB.EQ.54.OR.ISUB.EQ.58.OR. | |
8735 | &(ISUB.GE.135.AND.ISUB.LE.140).OR.ISUB.EQ.382.OR.ISUB.EQ.385) THEN | |
8736 | IGLGA=21 | |
8737 | IF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) IGLGA=22 | |
8738 | CALL PYWIDT(IGLGA,SH,WDTP,WDTE) | |
8739 | 180 RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*PYR(0) | |
8740 | DO 190 I=1,MDCY(IGLGA,3) | |
8741 | KFLF=KFDP(I+MDCY(IGLGA,2)-1,1) | |
8742 | RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4)) | |
8743 | IF(RKFL.LE.0D0) GOTO 200 | |
8744 | 190 CONTINUE | |
8745 | 200 CONTINUE | |
8746 | IF((ISUB.EQ.53.OR.ISUB.EQ.385).AND.MINT(2).LE.2) THEN | |
8747 | IF(KFLF.GE.4) GOTO 180 | |
8748 | ELSEIF((ISUB.EQ.53.OR.ISUB.EQ.385).AND.MINT(2).LE.4) THEN | |
8749 | KFLF=4 | |
8750 | MINT(2)=MINT(2)-2 | |
8751 | ELSEIF(ISUB.EQ.53.OR.ISUB.EQ.385) THEN | |
8752 | KFLF=5 | |
8753 | MINT(2)=MINT(2)-4 | |
8754 | ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.1.AND.IABS(MINT(15)).LE.2 | |
8755 | & .AND.IABS(KFLF).GE.3) THEN | |
8756 | FACQQB=VINT(58)**2*4D0/9D0*(VINT(45)**2+VINT(46)**2)/ | |
8757 | & VINT(44)**2 | |
8758 | FACCIB=VINT(46)**2/RTCM(41)**4 | |
8759 | IF(FACQQB/(FACQQB+FACCIB).LT.PYR(0)) GOTO 180 | |
8760 | ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.2) THEN | |
8761 | KFLF=5 | |
8762 | MINT(2)=1 | |
8763 | ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.1) THEN | |
8764 | IF(KFLF.EQ.5) GOTO 180 | |
8765 | ELSEIF(ISUB.EQ.54.OR.ISUB.EQ.135.OR.ISUB.EQ.136) THEN | |
8766 | IF((KCHG(PYCOMP(KFLF),1)/2D0)**2.LT.PYR(0)) GOTO 180 | |
8767 | ELSEIF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) THEN | |
8768 | IF((KCHG(PYCOMP(KFLF),1)/3D0)**2.LT.PYR(0)) GOTO 180 | |
8769 | ENDIF | |
8770 | ENDIF | |
8771 | ||
8772 | C...Final state flavours and colour flow: default values | |
8773 | JS=1 | |
8774 | MINT(21)=MINT(15) | |
8775 | MINT(22)=MINT(16) | |
8776 | MINT(23)=0 | |
8777 | MINT(24)=0 | |
8778 | KCC=20 | |
8779 | KCS=ISIGN(1,MINT(15)) | |
8780 | ||
8781 | IF(ISET(ISUB).EQ.11) THEN | |
8782 | C...User-defined processes: find products | |
8783 | MINT(3)=0 | |
8784 | DO 210 IUP=3,NUP | |
8785 | IF(ISTUP(IUP).LT.1.OR.ISTUP(IUP).GT.3) THEN | |
8786 | ELSEIF(NUP.EQ.5.AND.IUP.GE.4.AND.MOTHUP(1,4).EQ.3) THEN | |
8787 | MINT(21+IUP)=IDUP(IUP) | |
8788 | ELSEIF(ISTUP(IUP).EQ.1.AND.(ISTUP(MOTHUP(1,IUP)).EQ.2.OR. | |
8789 | & ISTUP(MOTHUP(1,IUP)).EQ.3).AND.IDUP(MOTHUP(1,IUP)).NE.0) THEN | |
8790 | ELSEIF(IDUP(IUP).EQ.0) THEN | |
8791 | ELSE | |
8792 | MINT(3)=MINT(3)+1 | |
8793 | IF(MINT(3).LE.6) MINT(20+MINT(3))=IDUP(IUP) | |
8794 | ENDIF | |
8795 | 210 CONTINUE | |
8796 | ||
8797 | ELSEIF(ISUB.LE.10) THEN | |
8798 | IF(ISUB.EQ.1) THEN | |
8799 | C...f + fbar -> gamma*/Z0 | |
8800 | KFRES=23 | |
8801 | ||
8802 | ELSEIF(ISUB.EQ.2) THEN | |
8803 | C...f + fbar' -> W+/- | |
8804 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
8805 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
8806 | KFRES=ISIGN(24,KCH1+KCH2) | |
8807 | ||
8808 | ELSEIF(ISUB.EQ.3) THEN | |
8809 | C...f + fbar -> h0 (or H0, or A0) | |
8810 | KFRES=KFHIGG | |
8811 | ||
8812 | ELSEIF(ISUB.EQ.4) THEN | |
8813 | C...gamma + W+/- -> W+/- | |
8814 | ||
8815 | ELSEIF(ISUB.EQ.5) THEN | |
8816 | C...Z0 + Z0 -> h0 | |
8817 | XH=SH/SHP | |
8818 | MINT(21)=MINT(15) | |
8819 | MINT(22)=MINT(16) | |
8820 | PMQ(1)=PYMASS(MINT(21)) | |
8821 | PMQ(2)=PYMASS(MINT(22)) | |
8822 | 220 JT=INT(1.5D0+PYR(0)) | |
8823 | ZMIN=2D0*PMQ(JT)/SHPR | |
8824 | ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ | |
8825 | & (SHPR*(SHPR-PMQ(3-JT))) | |
8826 | ZMAX=MIN(1D0-XH,ZMAX) | |
8827 | Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) | |
8828 | IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. | |
8829 | & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 220 | |
8830 | SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) | |
8831 | IF(SQC1.LT.1D-8) GOTO 220 | |
8832 | C1=SQRT(SQC1) | |
8833 | C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
8834 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
8835 | CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) | |
8836 | Z(3-JT)=1D0-XH/(1D0-Z(JT)) | |
8837 | SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
8838 | IF(SQC1.LT.1D-8) GOTO 220 | |
8839 | C1=SQRT(SQC1) | |
8840 | C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
8841 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
8842 | CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) | |
8843 | PHIR=PARU(2)*PYR(0) | |
8844 | CPHI=COS(PHIR) | |
8845 | ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* | |
8846 | & SQRT(1D0-CTHE(2)**2)*CPHI | |
8847 | Z1=2D0-Z(JT) | |
8848 | Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) | |
8849 | Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
8850 | Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
8851 | & PMQ(3-JT)**2/SHP)) | |
8852 | ZMIN=2D0*PMQ(3-JT)/SHPR | |
8853 | ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
8854 | ZMAX=MIN(1D0-XH,ZMAX) | |
8855 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 220 | |
8856 | KCC=22 | |
8857 | KFRES=25 | |
8858 | ||
8859 | ELSEIF(ISUB.EQ.6) THEN | |
8860 | C...Z0 + W+/- -> W+/- | |
8861 | ||
8862 | ELSEIF(ISUB.EQ.7) THEN | |
8863 | C...W+ + W- -> Z0 | |
8864 | ||
8865 | ELSEIF(ISUB.EQ.8) THEN | |
8866 | C...W+ + W- -> h0 | |
8867 | XH=SH/SHP | |
8868 | 230 DO 260 JT=1,2 | |
8869 | I=MINT(14+JT) | |
8870 | IA=IABS(I) | |
8871 | IF(IA.LE.10) THEN | |
8872 | RVCKM=VINT(180+I)*PYR(0) | |
8873 | DO 240 J=1,MSTP(1) | |
8874 | IB=2*J-1+MOD(IA,2) | |
8875 | IPM=(5-ISIGN(1,I))/2 | |
8876 | IDC=J+MDCY(IA,2)+2 | |
8877 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 240 | |
8878 | MINT(20+JT)=ISIGN(IB,I) | |
8879 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
8880 | IF(RVCKM.LE.0D0) GOTO 250 | |
8881 | 240 CONTINUE | |
8882 | ELSE | |
8883 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
8884 | MINT(20+JT)=ISIGN(IB,I) | |
8885 | ENDIF | |
8886 | 250 PMQ(JT)=PYMASS(MINT(20+JT)) | |
8887 | 260 CONTINUE | |
8888 | JT=INT(1.5D0+PYR(0)) | |
8889 | ZMIN=2D0*PMQ(JT)/SHPR | |
8890 | ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ | |
8891 | & (SHPR*(SHPR-PMQ(3-JT))) | |
8892 | ZMAX=MIN(1D0-XH,ZMAX) | |
8893 | IF(ZMIN.GE.ZMAX) GOTO 230 | |
8894 | Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) | |
8895 | IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. | |
8896 | & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 230 | |
8897 | SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) | |
8898 | IF(SQC1.LT.1D-8) GOTO 230 | |
8899 | C1=SQRT(SQC1) | |
8900 | C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
8901 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
8902 | CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) | |
8903 | Z(3-JT)=1D0-XH/(1D0-Z(JT)) | |
8904 | SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
8905 | IF(SQC1.LT.1D-8) GOTO 230 | |
8906 | C1=SQRT(SQC1) | |
8907 | C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
8908 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
8909 | CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) | |
8910 | PHIR=PARU(2)*PYR(0) | |
8911 | CPHI=COS(PHIR) | |
8912 | ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* | |
8913 | & SQRT(1D0-CTHE(2)**2)*CPHI | |
8914 | Z1=2D0-Z(JT) | |
8915 | Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) | |
8916 | Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
8917 | Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
8918 | & PMQ(3-JT)**2/SHP)) | |
8919 | ZMIN=2D0*PMQ(3-JT)/SHPR | |
8920 | ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
8921 | ZMAX=MIN(1D0-XH,ZMAX) | |
8922 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 230 | |
8923 | KCC=22 | |
8924 | KFRES=25 | |
8925 | ||
8926 | ELSEIF(ISUB.EQ.10) THEN | |
8927 | C...f + f' -> f + f' (gamma/Z/W exchange); th = (p(f)-p(f))**2 | |
8928 | IF(MINT(2).EQ.1) THEN | |
8929 | KCC=22 | |
8930 | ELSE | |
8931 | C...W exchange: need to mix flavours according to CKM matrix | |
8932 | DO 280 JT=1,2 | |
8933 | I=MINT(14+JT) | |
8934 | IA=IABS(I) | |
8935 | IF(IA.LE.10) THEN | |
8936 | RVCKM=VINT(180+I)*PYR(0) | |
8937 | DO 270 J=1,MSTP(1) | |
8938 | IB=2*J-1+MOD(IA,2) | |
8939 | IPM=(5-ISIGN(1,I))/2 | |
8940 | IDC=J+MDCY(IA,2)+2 | |
8941 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270 | |
8942 | MINT(20+JT)=ISIGN(IB,I) | |
8943 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
8944 | IF(RVCKM.LE.0D0) GOTO 280 | |
8945 | 270 CONTINUE | |
8946 | ELSE | |
8947 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
8948 | MINT(20+JT)=ISIGN(IB,I) | |
8949 | ENDIF | |
8950 | 280 CONTINUE | |
8951 | KCC=22 | |
8952 | ENDIF | |
8953 | ENDIF | |
8954 | ||
8955 | ELSEIF(ISUB.LE.20) THEN | |
8956 | IF(ISUB.EQ.11) THEN | |
8957 | C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2 | |
8958 | KCC=MINT(2) | |
8959 | IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 | |
8960 | ||
8961 | ELSEIF(ISUB.EQ.12) THEN | |
8962 | C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2 | |
8963 | MINT(21)=ISIGN(KFLF,MINT(15)) | |
8964 | MINT(22)=-MINT(21) | |
8965 | KCC=4 | |
8966 | ||
8967 | ELSEIF(ISUB.EQ.13) THEN | |
8968 | C...f + fbar -> g + g; th arbitrary | |
8969 | MINT(21)=21 | |
8970 | MINT(22)=21 | |
8971 | KCC=MINT(2)+4 | |
8972 | ||
8973 | ELSEIF(ISUB.EQ.14) THEN | |
8974 | C...f + fbar -> g + gamma; th arbitrary | |
8975 | IF(PYR(0).GT.0.5D0) JS=2 | |
8976 | MINT(20+JS)=21 | |
8977 | MINT(23-JS)=22 | |
8978 | KCC=17+JS | |
8979 | ||
8980 | ELSEIF(ISUB.EQ.15) THEN | |
8981 | C...f + fbar -> g + Z0; th arbitrary | |
8982 | IF(PYR(0).GT.0.5D0) JS=2 | |
8983 | MINT(20+JS)=21 | |
8984 | MINT(23-JS)=23 | |
8985 | KCC=17+JS | |
8986 | ||
8987 | ELSEIF(ISUB.EQ.16) THEN | |
8988 | C...f + fbar' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 | |
8989 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
8990 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
8991 | IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 | |
8992 | MINT(20+JS)=21 | |
8993 | MINT(23-JS)=ISIGN(24,KCH1+KCH2) | |
8994 | KCC=17+JS | |
8995 | ||
8996 | ELSEIF(ISUB.EQ.17) THEN | |
8997 | C...f + fbar -> g + h0; th arbitrary | |
8998 | IF(PYR(0).GT.0.5D0) JS=2 | |
8999 | MINT(20+JS)=21 | |
9000 | MINT(23-JS)=25 | |
9001 | KCC=17+JS | |
9002 | ||
9003 | ELSEIF(ISUB.EQ.18) THEN | |
9004 | C...f + fbar -> gamma + gamma; th arbitrary | |
9005 | MINT(21)=22 | |
9006 | MINT(22)=22 | |
9007 | ||
9008 | ELSEIF(ISUB.EQ.19) THEN | |
9009 | C...f + fbar -> gamma + Z0; th arbitrary | |
9010 | IF(PYR(0).GT.0.5D0) JS=2 | |
9011 | MINT(20+JS)=22 | |
9012 | MINT(23-JS)=23 | |
9013 | ||
9014 | ELSEIF(ISUB.EQ.20) THEN | |
9015 | C...f + fbar' -> gamma + W+/-; th = (p(f)-p(W-))**2 or | |
9016 | C...(p(fbar')-p(W+))**2 | |
9017 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
9018 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
9019 | IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 | |
9020 | MINT(20+JS)=22 | |
9021 | MINT(23-JS)=ISIGN(24,KCH1+KCH2) | |
9022 | ENDIF | |
9023 | ||
9024 | ELSEIF(ISUB.LE.30) THEN | |
9025 | IF(ISUB.EQ.21) THEN | |
9026 | C...f + fbar -> gamma + h0; th arbitrary | |
9027 | IF(PYR(0).GT.0.5D0) JS=2 | |
9028 | MINT(20+JS)=22 | |
9029 | MINT(23-JS)=25 | |
9030 | ||
9031 | ELSEIF(ISUB.EQ.22) THEN | |
9032 | C...f + fbar -> Z0 + Z0; th arbitrary | |
9033 | MINT(21)=23 | |
9034 | MINT(22)=23 | |
9035 | ||
9036 | ELSEIF(ISUB.EQ.23) THEN | |
9037 | C...f + fbar' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 | |
9038 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
9039 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
9040 | IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 | |
9041 | MINT(20+JS)=23 | |
9042 | MINT(23-JS)=ISIGN(24,KCH1+KCH2) | |
9043 | ||
9044 | ELSEIF(ISUB.EQ.24) THEN | |
9045 | C...f + fbar -> Z0 + h0 (or H0, or A0); th arbitrary | |
9046 | IF(PYR(0).GT.0.5D0) JS=2 | |
9047 | MINT(20+JS)=23 | |
9048 | MINT(23-JS)=KFHIGG | |
9049 | ||
9050 | ELSEIF(ISUB.EQ.25) THEN | |
9051 | C...f + fbar -> W+ + W-; th = (p(f)-p(W-))**2 | |
9052 | MINT(21)=-ISIGN(24,MINT(15)) | |
9053 | MINT(22)=-MINT(21) | |
9054 | ||
9055 | ELSEIF(ISUB.EQ.26) THEN | |
9056 | C...f + fbar' -> W+/- + h0 (or H0, or A0); | |
9057 | C...th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 | |
9058 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
9059 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
9060 | IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 | |
9061 | MINT(20+JS)=ISIGN(24,KCH1+KCH2) | |
9062 | MINT(23-JS)=KFHIGG | |
9063 | ||
9064 | ELSEIF(ISUB.EQ.27) THEN | |
9065 | C...f + fbar -> h0 + h0 | |
9066 | ||
9067 | ELSEIF(ISUB.EQ.28) THEN | |
9068 | C...f + g -> f + g; th = (p(f)-p(f))**2 | |
9069 | IF(MINT(15).EQ.21) JS=2 | |
9070 | KCC=MINT(2)+6 | |
9071 | IF(MINT(15).EQ.21) KCC=KCC+2 | |
9072 | IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) | |
9073 | IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) | |
9074 | ||
9075 | ELSEIF(ISUB.EQ.29) THEN | |
9076 | C...f + g -> f + gamma; th = (p(f)-p(f))**2 | |
9077 | IF(MINT(15).EQ.21) JS=2 | |
9078 | MINT(23-JS)=22 | |
9079 | KCC=15+JS | |
9080 | KCS=ISIGN(1,MINT(14+JS)) | |
9081 | ||
9082 | ELSEIF(ISUB.EQ.30) THEN | |
9083 | C...f + g -> f + Z0; th = (p(f)-p(f))**2 | |
9084 | IF(MINT(15).EQ.21) JS=2 | |
9085 | MINT(23-JS)=23 | |
9086 | KCC=15+JS | |
9087 | KCS=ISIGN(1,MINT(14+JS)) | |
9088 | ENDIF | |
9089 | ||
9090 | ELSEIF(ISUB.LE.40) THEN | |
9091 | IF(ISUB.EQ.31) THEN | |
9092 | C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f' | |
9093 | IF(MINT(15).EQ.21) JS=2 | |
9094 | I=MINT(14+JS) | |
9095 | IA=IABS(I) | |
9096 | MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I) | |
9097 | RVCKM=VINT(180+I)*PYR(0) | |
9098 | DO 290 J=1,MSTP(1) | |
9099 | IB=2*J-1+MOD(IA,2) | |
9100 | IPM=(5-ISIGN(1,I))/2 | |
9101 | IDC=J+MDCY(IA,2)+2 | |
9102 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 290 | |
9103 | MINT(20+JS)=ISIGN(IB,I) | |
9104 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
9105 | IF(RVCKM.LE.0D0) GOTO 300 | |
9106 | 290 CONTINUE | |
9107 | 300 KCC=15+JS | |
9108 | KCS=ISIGN(1,MINT(14+JS)) | |
9109 | ||
9110 | ELSEIF(ISUB.EQ.32) THEN | |
9111 | C...f + g -> f + h0; th = (p(f)-p(f))**2 | |
9112 | IF(MINT(15).EQ.21) JS=2 | |
9113 | MINT(23-JS)=25 | |
9114 | KCC=15+JS | |
9115 | KCS=ISIGN(1,MINT(14+JS)) | |
9116 | ||
9117 | ELSEIF(ISUB.EQ.33) THEN | |
9118 | C...f + gamma -> f + g; th=(p(f)-p(f))**2 | |
9119 | IF(MINT(15).EQ.22) JS=2 | |
9120 | MINT(23-JS)=21 | |
9121 | KCC=24+JS | |
9122 | KCS=ISIGN(1,MINT(14+JS)) | |
9123 | ||
9124 | ELSEIF(ISUB.EQ.34) THEN | |
9125 | C...f + gamma -> f + gamma; th=(p(f)-p(f))**2 | |
9126 | IF(MINT(15).EQ.22) JS=2 | |
9127 | KCC=22 | |
9128 | KCS=ISIGN(1,MINT(14+JS)) | |
9129 | ||
9130 | ELSEIF(ISUB.EQ.35) THEN | |
9131 | C...f + gamma -> f + Z0; th=(p(f)-p(f))**2 | |
9132 | IF(MINT(15).EQ.22) JS=2 | |
9133 | MINT(23-JS)=23 | |
9134 | KCC=22 | |
9135 | ||
9136 | ELSEIF(ISUB.EQ.36) THEN | |
9137 | C...f + gamma -> f' + W+/-; th=(p(f)-p(f'))**2 | |
9138 | IF(MINT(15).EQ.22) JS=2 | |
9139 | I=MINT(14+JS) | |
9140 | IA=IABS(I) | |
9141 | MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I) | |
9142 | IF(IA.LE.10) THEN | |
9143 | RVCKM=VINT(180+I)*PYR(0) | |
9144 | DO 310 J=1,MSTP(1) | |
9145 | IB=2*J-1+MOD(IA,2) | |
9146 | IPM=(5-ISIGN(1,I))/2 | |
9147 | IDC=J+MDCY(IA,2)+2 | |
9148 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 310 | |
9149 | MINT(20+JS)=ISIGN(IB,I) | |
9150 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
9151 | IF(RVCKM.LE.0D0) GOTO 320 | |
9152 | 310 CONTINUE | |
9153 | ELSE | |
9154 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
9155 | MINT(20+JS)=ISIGN(IB,I) | |
9156 | ENDIF | |
9157 | 320 KCC=22 | |
9158 | ||
9159 | ELSEIF(ISUB.EQ.37) THEN | |
9160 | C...f + gamma -> f + h0 | |
9161 | ||
9162 | ELSEIF(ISUB.EQ.38) THEN | |
9163 | C...f + Z0 -> f + g | |
9164 | ||
9165 | ELSEIF(ISUB.EQ.39) THEN | |
9166 | C...f + Z0 -> f + gamma | |
9167 | ||
9168 | ELSEIF(ISUB.EQ.40) THEN | |
9169 | C...f + Z0 -> f + Z0 | |
9170 | ENDIF | |
9171 | ||
9172 | ELSEIF(ISUB.LE.50) THEN | |
9173 | IF(ISUB.EQ.41) THEN | |
9174 | C...f + Z0 -> f' + W+/- | |
9175 | ||
9176 | ELSEIF(ISUB.EQ.42) THEN | |
9177 | C...f + Z0 -> f + h0 | |
9178 | ||
9179 | ELSEIF(ISUB.EQ.43) THEN | |
9180 | C...f + W+/- -> f' + g | |
9181 | ||
9182 | ELSEIF(ISUB.EQ.44) THEN | |
9183 | C...f + W+/- -> f' + gamma | |
9184 | ||
9185 | ELSEIF(ISUB.EQ.45) THEN | |
9186 | C...f + W+/- -> f' + Z0 | |
9187 | ||
9188 | ELSEIF(ISUB.EQ.46) THEN | |
9189 | C...f + W+/- -> f' + W+/- | |
9190 | ||
9191 | ELSEIF(ISUB.EQ.47) THEN | |
9192 | C...f + W+/- -> f' + h0 | |
9193 | ||
9194 | ELSEIF(ISUB.EQ.48) THEN | |
9195 | C...f + h0 -> f + g | |
9196 | ||
9197 | ELSEIF(ISUB.EQ.49) THEN | |
9198 | C...f + h0 -> f + gamma | |
9199 | ||
9200 | ELSEIF(ISUB.EQ.50) THEN | |
9201 | C...f + h0 -> f + Z0 | |
9202 | ENDIF | |
9203 | ||
9204 | ELSEIF(ISUB.LE.60) THEN | |
9205 | IF(ISUB.EQ.51) THEN | |
9206 | C...f + h0 -> f' + W+/- | |
9207 | ||
9208 | ELSEIF(ISUB.EQ.52) THEN | |
9209 | C...f + h0 -> f + h0 | |
9210 | ||
9211 | ELSEIF(ISUB.EQ.53) THEN | |
9212 | C...g + g -> f + fbar; th arbitrary | |
9213 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9214 | MINT(21)=ISIGN(KFLF,KCS) | |
9215 | MINT(22)=-MINT(21) | |
9216 | KCC=MINT(2)+10 | |
9217 | ||
9218 | ELSEIF(ISUB.EQ.54) THEN | |
9219 | C...g + gamma -> f + fbar; th arbitrary | |
9220 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9221 | MINT(21)=ISIGN(KFLF,KCS) | |
9222 | MINT(22)=-MINT(21) | |
9223 | KCC=27 | |
9224 | IF(MINT(16).EQ.21) KCC=28 | |
9225 | ||
9226 | ELSEIF(ISUB.EQ.55) THEN | |
9227 | C...g + Z0 -> f + fbar | |
9228 | ||
9229 | ELSEIF(ISUB.EQ.56) THEN | |
9230 | C...g + W+/- -> f + fbar' | |
9231 | ||
9232 | ELSEIF(ISUB.EQ.57) THEN | |
9233 | C...g + h0 -> f + fbar | |
9234 | ||
9235 | ELSEIF(ISUB.EQ.58) THEN | |
9236 | C...gamma + gamma -> f + fbar; th arbitrary | |
9237 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9238 | MINT(21)=ISIGN(KFLF,KCS) | |
9239 | MINT(22)=-MINT(21) | |
9240 | KCC=21 | |
9241 | ||
9242 | ELSEIF(ISUB.EQ.59) THEN | |
9243 | C...gamma + Z0 -> f + fbar | |
9244 | ||
9245 | ELSEIF(ISUB.EQ.60) THEN | |
9246 | C...gamma + W+/- -> f + fbar' | |
9247 | ENDIF | |
9248 | ||
9249 | ELSEIF(ISUB.LE.70) THEN | |
9250 | IF(ISUB.EQ.61) THEN | |
9251 | C...gamma + h0 -> f + fbar | |
9252 | ||
9253 | ELSEIF(ISUB.EQ.62) THEN | |
9254 | C...Z0 + Z0 -> f + fbar | |
9255 | ||
9256 | ELSEIF(ISUB.EQ.63) THEN | |
9257 | C...Z0 + W+/- -> f + fbar' | |
9258 | ||
9259 | ELSEIF(ISUB.EQ.64) THEN | |
9260 | C...Z0 + h0 -> f + fbar | |
9261 | ||
9262 | ELSEIF(ISUB.EQ.65) THEN | |
9263 | C...W+ + W- -> f + fbar | |
9264 | ||
9265 | ELSEIF(ISUB.EQ.66) THEN | |
9266 | C...W+/- + h0 -> f + fbar' | |
9267 | ||
9268 | ELSEIF(ISUB.EQ.67) THEN | |
9269 | C...h0 + h0 -> f + fbar | |
9270 | ||
9271 | ELSEIF(ISUB.EQ.68) THEN | |
9272 | C...g + g -> g + g; th arbitrary | |
9273 | KCC=MINT(2)+12 | |
9274 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9275 | ||
9276 | ELSEIF(ISUB.EQ.69) THEN | |
9277 | C...gamma + gamma -> W+ + W-; th arbitrary | |
9278 | MINT(21)=24 | |
9279 | MINT(22)=-24 | |
9280 | KCC=21 | |
9281 | ||
9282 | ELSEIF(ISUB.EQ.70) THEN | |
9283 | C...gamma + W+/- -> Z0 + W+/-; th=(p(W)-p(W))**2 | |
9284 | IF(MINT(15).EQ.22) MINT(21)=23 | |
9285 | IF(MINT(16).EQ.22) MINT(22)=23 | |
9286 | KCC=21 | |
9287 | ENDIF | |
9288 | ||
9289 | ELSEIF(ISUB.LE.80) THEN | |
9290 | IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN | |
9291 | C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W- | |
9292 | XH=SH/SHP | |
9293 | MINT(21)=MINT(15) | |
9294 | MINT(22)=MINT(16) | |
9295 | PMQ(1)=PYMASS(MINT(21)) | |
9296 | PMQ(2)=PYMASS(MINT(22)) | |
9297 | 330 JT=INT(1.5D0+PYR(0)) | |
9298 | ZMIN=2D0*PMQ(JT)/SHPR | |
9299 | ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ | |
9300 | & (SHPR*(SHPR-PMQ(3-JT))) | |
9301 | ZMAX=MIN(1D0-XH,ZMAX) | |
9302 | Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) | |
9303 | IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. | |
9304 | & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 330 | |
9305 | SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) | |
9306 | IF(SQC1.LT.1D-8) GOTO 330 | |
9307 | C1=SQRT(SQC1) | |
9308 | C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
9309 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
9310 | CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) | |
9311 | Z(3-JT)=1D0-XH/(1D0-Z(JT)) | |
9312 | SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
9313 | IF(SQC1.LT.1D-8) GOTO 330 | |
9314 | C1=SQRT(SQC1) | |
9315 | C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
9316 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
9317 | CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) | |
9318 | PHIR=PARU(2)*PYR(0) | |
9319 | CPHI=COS(PHIR) | |
9320 | ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* | |
9321 | & SQRT(1D0-CTHE(2)**2)*CPHI | |
9322 | Z1=2D0-Z(JT) | |
9323 | Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) | |
9324 | Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
9325 | Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
9326 | & PMQ(3-JT)**2/SHP)) | |
9327 | ZMIN=2D0*PMQ(3-JT)/SHPR | |
9328 | ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
9329 | ZMAX=MIN(1D0-XH,ZMAX) | |
9330 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 330 | |
9331 | KCC=22 | |
9332 | ||
9333 | ELSEIF(ISUB.EQ.73) THEN | |
9334 | C...Z0 + W+/- -> Z0 + W+/- | |
9335 | JS=MINT(2) | |
9336 | XH=SH/SHP | |
9337 | 340 JT=3-MINT(2) | |
9338 | I=MINT(14+JT) | |
9339 | IA=IABS(I) | |
9340 | IF(IA.LE.10) THEN | |
9341 | RVCKM=VINT(180+I)*PYR(0) | |
9342 | DO 350 J=1,MSTP(1) | |
9343 | IB=2*J-1+MOD(IA,2) | |
9344 | IPM=(5-ISIGN(1,I))/2 | |
9345 | IDC=J+MDCY(IA,2)+2 | |
9346 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 350 | |
9347 | MINT(20+JT)=ISIGN(IB,I) | |
9348 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
9349 | IF(RVCKM.LE.0D0) GOTO 360 | |
9350 | 350 CONTINUE | |
9351 | ELSE | |
9352 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
9353 | MINT(20+JT)=ISIGN(IB,I) | |
9354 | ENDIF | |
9355 | 360 PMQ(JT)=PYMASS(MINT(20+JT)) | |
9356 | MINT(23-JT)=MINT(17-JT) | |
9357 | PMQ(3-JT)=PYMASS(MINT(23-JT)) | |
9358 | JT=INT(1.5D0+PYR(0)) | |
9359 | ZMIN=2D0*PMQ(JT)/SHPR | |
9360 | ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ | |
9361 | & (SHPR*(SHPR-PMQ(3-JT))) | |
9362 | ZMAX=MIN(1D0-XH,ZMAX) | |
9363 | IF(ZMIN.GE.ZMAX) GOTO 340 | |
9364 | Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) | |
9365 | IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. | |
9366 | & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 340 | |
9367 | SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) | |
9368 | IF(SQC1.LT.1D-8) GOTO 340 | |
9369 | C1=SQRT(SQC1) | |
9370 | C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
9371 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
9372 | CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) | |
9373 | Z(3-JT)=1D0-XH/(1D0-Z(JT)) | |
9374 | SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
9375 | IF(SQC1.LT.1D-8) GOTO 340 | |
9376 | C1=SQRT(SQC1) | |
9377 | C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
9378 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
9379 | CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) | |
9380 | PHIR=PARU(2)*PYR(0) | |
9381 | CPHI=COS(PHIR) | |
9382 | ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* | |
9383 | & SQRT(1D0-CTHE(2)**2)*CPHI | |
9384 | Z1=2D0-Z(JT) | |
9385 | Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) | |
9386 | Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
9387 | Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
9388 | & PMQ(3-JT)**2/SHP)) | |
9389 | ZMIN=2D0*PMQ(3-JT)/SHPR | |
9390 | ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
9391 | ZMAX=MIN(1D0-XH,ZMAX) | |
9392 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340 | |
9393 | KCC=22 | |
9394 | ||
9395 | ELSEIF(ISUB.EQ.74) THEN | |
9396 | C...Z0 + h0 -> Z0 + h0 | |
9397 | ||
9398 | ELSEIF(ISUB.EQ.75) THEN | |
9399 | C...W+ + W- -> gamma + gamma | |
9400 | ||
9401 | ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN | |
9402 | C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W- | |
9403 | XH=SH/SHP | |
9404 | 370 DO 400 JT=1,2 | |
9405 | I=MINT(14+JT) | |
9406 | IA=IABS(I) | |
9407 | IF(IA.LE.10) THEN | |
9408 | RVCKM=VINT(180+I)*PYR(0) | |
9409 | DO 380 J=1,MSTP(1) | |
9410 | IB=2*J-1+MOD(IA,2) | |
9411 | IPM=(5-ISIGN(1,I))/2 | |
9412 | IDC=J+MDCY(IA,2)+2 | |
9413 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 380 | |
9414 | MINT(20+JT)=ISIGN(IB,I) | |
9415 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
9416 | IF(RVCKM.LE.0D0) GOTO 390 | |
9417 | 380 CONTINUE | |
9418 | ELSE | |
9419 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
9420 | MINT(20+JT)=ISIGN(IB,I) | |
9421 | ENDIF | |
9422 | 390 PMQ(JT)=PYMASS(MINT(20+JT)) | |
9423 | 400 CONTINUE | |
9424 | JT=INT(1.5D0+PYR(0)) | |
9425 | ZMIN=2D0*PMQ(JT)/SHPR | |
9426 | ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ | |
9427 | & (SHPR*(SHPR-PMQ(3-JT))) | |
9428 | ZMAX=MIN(1D0-XH,ZMAX) | |
9429 | IF(ZMIN.GE.ZMAX) GOTO 370 | |
9430 | Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) | |
9431 | IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. | |
9432 | & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 370 | |
9433 | SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) | |
9434 | IF(SQC1.LT.1D-8) GOTO 370 | |
9435 | C1=SQRT(SQC1) | |
9436 | C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
9437 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
9438 | CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) | |
9439 | Z(3-JT)=1D0-XH/(1D0-Z(JT)) | |
9440 | SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
9441 | IF(SQC1.LT.1D-8) GOTO 370 | |
9442 | C1=SQRT(SQC1) | |
9443 | C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
9444 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 | |
9445 | CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) | |
9446 | PHIR=PARU(2)*PYR(0) | |
9447 | CPHI=COS(PHIR) | |
9448 | ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* | |
9449 | & SQRT(1D0-CTHE(2)**2)*CPHI | |
9450 | Z1=2D0-Z(JT) | |
9451 | Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) | |
9452 | Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
9453 | Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
9454 | & PMQ(3-JT)**2/SHP)) | |
9455 | ZMIN=2D0*PMQ(3-JT)/SHPR | |
9456 | ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
9457 | ZMAX=MIN(1D0-XH,ZMAX) | |
9458 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 370 | |
9459 | KCC=22 | |
9460 | ||
9461 | ELSEIF(ISUB.EQ.78) THEN | |
9462 | C...W+/- + h0 -> W+/- + h0 | |
9463 | ||
9464 | ELSEIF(ISUB.EQ.79) THEN | |
9465 | C...h0 + h0 -> h0 + h0 | |
9466 | ||
9467 | ELSEIF(ISUB.EQ.80) THEN | |
9468 | C...q + gamma -> q' + pi+/-; th=(p(q)-p(q'))**2 | |
9469 | IF(MINT(15).EQ.22) JS=2 | |
9470 | I=MINT(14+JS) | |
9471 | IA=IABS(I) | |
9472 | MINT(23-JS)=ISIGN(211,KCHG(IA,1)*I) | |
9473 | IB=3-IA | |
9474 | MINT(20+JS)=ISIGN(IB,I) | |
9475 | KCC=22 | |
9476 | ENDIF | |
9477 | ||
9478 | ELSEIF(ISUB.LE.90) THEN | |
9479 | IF(ISUB.EQ.81) THEN | |
9480 | C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2 | |
9481 | MINT(21)=ISIGN(MINT(55),MINT(15)) | |
9482 | MINT(22)=-MINT(21) | |
9483 | KCC=4 | |
9484 | ||
9485 | ELSEIF(ISUB.EQ.82) THEN | |
9486 | C...g + g -> Q + Qbar; th arbitrary | |
9487 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9488 | MINT(21)=ISIGN(MINT(55),KCS) | |
9489 | MINT(22)=-MINT(21) | |
9490 | KCC=MINT(2)+10 | |
9491 | ||
9492 | ELSEIF(ISUB.EQ.83) THEN | |
9493 | C...f + q -> f' + Q; th = (p(f) - p(f'))**2 | |
9494 | KFOLD=MINT(16) | |
9495 | IF(MINT(2).EQ.2) KFOLD=MINT(15) | |
9496 | KFAOLD=IABS(KFOLD) | |
9497 | IF(KFAOLD.GT.10) THEN | |
9498 | KFANEW=KFAOLD+2*MOD(KFAOLD,2)-1 | |
9499 | ELSE | |
9500 | RCKM=VINT(180+KFOLD)*PYR(0) | |
9501 | IPM=(5-ISIGN(1,KFOLD))/2 | |
9502 | KFANEW=-MOD(KFAOLD+1,2) | |
9503 | 410 KFANEW=KFANEW+2 | |
9504 | IDC=MDCY(KFAOLD,2)+(KFANEW+1)/2+2 | |
9505 | IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) THEN | |
9506 | IF(MOD(KFAOLD,2).EQ.0) RCKM=RCKM- | |
9507 | & VCKM(KFAOLD/2,(KFANEW+1)/2) | |
9508 | IF(MOD(KFAOLD,2).EQ.1) RCKM=RCKM- | |
9509 | & VCKM(KFANEW/2,(KFAOLD+1)/2) | |
9510 | ENDIF | |
9511 | IF(KFANEW.LE.6.AND.RCKM.GT.0D0) GOTO 410 | |
9512 | ENDIF | |
9513 | IF(MINT(2).EQ.1) THEN | |
9514 | MINT(21)=ISIGN(MINT(55),MINT(15)) | |
9515 | MINT(22)=ISIGN(KFANEW,MINT(16)) | |
9516 | ELSE | |
9517 | MINT(21)=ISIGN(KFANEW,MINT(15)) | |
9518 | MINT(22)=ISIGN(MINT(55),MINT(16)) | |
9519 | JS=2 | |
9520 | ENDIF | |
9521 | KCC=22 | |
9522 | ||
9523 | ELSEIF(ISUB.EQ.84) THEN | |
9524 | C...g + gamma -> Q + Qbar; th arbitary | |
9525 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9526 | MINT(21)=ISIGN(MINT(55),KCS) | |
9527 | MINT(22)=-MINT(21) | |
9528 | KCC=27 | |
9529 | IF(MINT(16).EQ.21) KCC=28 | |
9530 | ||
9531 | ELSEIF(ISUB.EQ.85) THEN | |
9532 | C...gamma + gamma -> F + Fbar; th arbitary | |
9533 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9534 | MINT(21)=ISIGN(MINT(56),KCS) | |
9535 | MINT(22)=-MINT(21) | |
9536 | KCC=21 | |
9537 | ||
9538 | ELSEIF(ISUB.GE.86.AND.ISUB.LE.89) THEN | |
9539 | C...g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g | |
9540 | MINT(21)=KFPR(ISUB,1) | |
9541 | MINT(22)=KFPR(ISUB,2) | |
9542 | KCC=24 | |
9543 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9544 | ENDIF | |
9545 | ||
9546 | ELSEIF(ISUB.LE.100) THEN | |
9547 | IF(ISUB.EQ.95) THEN | |
9548 | C...Low-pT ( = energyless g + g -> g + g) | |
9549 | KCC=MINT(2)+12 | |
9550 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9551 | ||
9552 | ELSEIF(ISUB.EQ.96) THEN | |
9553 | C...Multiple interactions (should be reassigned to QCD process) | |
9554 | ENDIF | |
9555 | ||
9556 | ELSEIF(ISUB.LE.110) THEN | |
9557 | IF(ISUB.EQ.101) THEN | |
9558 | C...g + g -> gamma*/Z0 | |
9559 | KCC=21 | |
9560 | KFRES=22 | |
9561 | ||
9562 | ELSEIF(ISUB.EQ.102) THEN | |
9563 | C...g + g -> h0 (or H0, or A0) | |
9564 | KCC=21 | |
9565 | KFRES=KFHIGG | |
9566 | ||
9567 | ELSEIF(ISUB.EQ.103) THEN | |
9568 | C...gamma + gamma -> h0 (or H0, or A0) | |
9569 | KCC=21 | |
9570 | KFRES=KFHIGG | |
9571 | ||
9572 | ELSEIF(ISUB.EQ.104.OR.ISUB.EQ.105) THEN | |
9573 | C...g + g -> chi_0c or chi_2c. | |
9574 | KCC=21 | |
9575 | KFRES=KFPR(ISUB,1) | |
9576 | ||
9577 | ELSEIF(ISUB.EQ.106) THEN | |
9578 | C...g + g -> J/Psi + gamma | |
9579 | MINT(21)=KFPR(ISUB,1) | |
9580 | MINT(22)=KFPR(ISUB,2) | |
9581 | KCC=21 | |
9582 | ||
9583 | ELSEIF(ISUB.EQ.107) THEN | |
9584 | C...g + gamma -> J/Psi + g | |
9585 | MINT(21)=KFPR(ISUB,1) | |
9586 | MINT(22)=KFPR(ISUB,2) | |
9587 | KCC=22 | |
9588 | IF(MINT(16).EQ.22) KCC=33 | |
9589 | ||
9590 | ELSEIF(ISUB.EQ.108) THEN | |
9591 | C...gamma + gamma -> J/Psi + gamma | |
9592 | MINT(21)=KFPR(ISUB,1) | |
9593 | MINT(22)=KFPR(ISUB,2) | |
9594 | ||
9595 | ELSEIF(ISUB.EQ.110) THEN | |
9596 | C...f + fbar -> gamma + h0; th arbitrary | |
9597 | IF(PYR(0).GT.0.5D0) JS=2 | |
9598 | MINT(20+JS)=22 | |
9599 | MINT(23-JS)=KFHIGG | |
9600 | ENDIF | |
9601 | ||
9602 | ELSEIF(ISUB.LE.120) THEN | |
9603 | IF(ISUB.EQ.111) THEN | |
9604 | C...f + fbar -> g + h0; th arbitrary | |
9605 | IF(PYR(0).GT.0.5D0) JS=2 | |
9606 | MINT(20+JS)=21 | |
9607 | MINT(23-JS)=KFHIGG | |
9608 | KCC=17+JS | |
9609 | ||
9610 | ELSEIF(ISUB.EQ.112) THEN | |
9611 | C...f + g -> f + h0; th = (p(f) - p(f))**2 | |
9612 | IF(MINT(15).EQ.21) JS=2 | |
9613 | MINT(23-JS)=KFHIGG | |
9614 | KCC=15+JS | |
9615 | KCS=ISIGN(1,MINT(14+JS)) | |
9616 | ||
9617 | ELSEIF(ISUB.EQ.113) THEN | |
9618 | C...g + g -> g + h0; th arbitrary | |
9619 | IF(PYR(0).GT.0.5D0) JS=2 | |
9620 | MINT(23-JS)=KFHIGG | |
9621 | KCC=22+JS | |
9622 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9623 | ||
9624 | ELSEIF(ISUB.EQ.114) THEN | |
9625 | C...g + g -> gamma + gamma; th arbitrary | |
9626 | IF(PYR(0).GT.0.5D0) JS=2 | |
9627 | MINT(21)=22 | |
9628 | MINT(22)=22 | |
9629 | KCC=21 | |
9630 | ||
9631 | ELSEIF(ISUB.EQ.115) THEN | |
9632 | C...g + g -> g + gamma; th arbitrary | |
9633 | IF(PYR(0).GT.0.5D0) JS=2 | |
9634 | MINT(23-JS)=22 | |
9635 | KCC=22+JS | |
9636 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9637 | ||
9638 | ELSEIF(ISUB.EQ.116) THEN | |
9639 | C...g + g -> gamma + Z0 | |
9640 | ||
9641 | ELSEIF(ISUB.EQ.117) THEN | |
9642 | C...g + g -> Z0 + Z0 | |
9643 | ||
9644 | ELSEIF(ISUB.EQ.118) THEN | |
9645 | C...g + g -> W+ + W- | |
9646 | ENDIF | |
9647 | ||
9648 | ELSEIF(ISUB.LE.140) THEN | |
9649 | IF(ISUB.EQ.121) THEN | |
9650 | C...g + g -> Q + Qbar + h0 | |
9651 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9652 | MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS) | |
9653 | MINT(22)=-MINT(21) | |
9654 | KCC=11+INT(0.5D0+PYR(0)) | |
9655 | KFRES=KFHIGG | |
9656 | ||
9657 | ELSEIF(ISUB.EQ.122) THEN | |
9658 | C...q + qbar -> Q + Qbar + h0 | |
9659 | MINT(21)=ISIGN(KFPR(ISUBSV,2),MINT(15)) | |
9660 | MINT(22)=-MINT(21) | |
9661 | KCC=4 | |
9662 | KFRES=KFHIGG | |
9663 | ||
9664 | ELSEIF(ISUB.EQ.123) THEN | |
9665 | C...f + f' -> f + f' + h0 (or H0, or A0) (Z0 + Z0 -> h0 as | |
9666 | C...inner process) | |
9667 | KCC=22 | |
9668 | KFRES=KFHIGG | |
9669 | ||
9670 | ELSEIF(ISUB.EQ.124) THEN | |
9671 | C...f + f' -> f" + f"' + h0 (or H0, or A) (W+ + W- -> h0 as | |
9672 | C...inner process) | |
9673 | DO 430 JT=1,2 | |
9674 | I=MINT(14+JT) | |
9675 | IA=IABS(I) | |
9676 | IF(IA.LE.10) THEN | |
9677 | RVCKM=VINT(180+I)*PYR(0) | |
9678 | DO 420 J=1,MSTP(1) | |
9679 | IB=2*J-1+MOD(IA,2) | |
9680 | IPM=(5-ISIGN(1,I))/2 | |
9681 | IDC=J+MDCY(IA,2)+2 | |
9682 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 420 | |
9683 | MINT(20+JT)=ISIGN(IB,I) | |
9684 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
9685 | IF(RVCKM.LE.0D0) GOTO 430 | |
9686 | 420 CONTINUE | |
9687 | ELSE | |
9688 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
9689 | MINT(20+JT)=ISIGN(IB,I) | |
9690 | ENDIF | |
9691 | 430 CONTINUE | |
9692 | KCC=22 | |
9693 | KFRES=KFHIGG | |
9694 | ||
9695 | ELSEIF(ISUB.EQ.131.OR.ISUB.EQ.132) THEN | |
9696 | C...f + gamma*_(T,L) -> f + g; th=(p(f)-p(f))**2 | |
9697 | IF(MINT(15).EQ.22) JS=2 | |
9698 | MINT(23-JS)=21 | |
9699 | KCC=24+JS | |
9700 | KCS=ISIGN(1,MINT(14+JS)) | |
9701 | ||
9702 | ELSEIF(ISUB.EQ.133.OR.ISUB.EQ.134) THEN | |
9703 | C...f + gamma*_(T,L) -> f + gamma; th=(p(f)-p(f))**2 | |
9704 | IF(MINT(15).EQ.22) JS=2 | |
9705 | KCC=22 | |
9706 | KCS=ISIGN(1,MINT(14+JS)) | |
9707 | ||
9708 | ELSEIF(ISUB.EQ.135.OR.ISUB.EQ.136) THEN | |
9709 | C...g + gamma*_(T,L) -> f + fbar; th arbitrary | |
9710 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9711 | MINT(21)=ISIGN(KFLF,KCS) | |
9712 | MINT(22)=-MINT(21) | |
9713 | KCC=27 | |
9714 | IF(MINT(16).EQ.21) KCC=28 | |
9715 | ||
9716 | ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN | |
9717 | C...gamma*_(T,L) + gamma*_(T,L) -> f + fbar; th arbitrary | |
9718 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9719 | MINT(21)=ISIGN(KFLF,KCS) | |
9720 | MINT(22)=-MINT(21) | |
9721 | KCC=21 | |
9722 | ||
9723 | ENDIF | |
9724 | ||
9725 | ELSEIF(ISUB.LE.160) THEN | |
9726 | IF(ISUB.EQ.141) THEN | |
9727 | C...f + fbar -> gamma*/Z0/Z'0 | |
9728 | KFRES=32 | |
9729 | ||
9730 | ELSEIF(ISUB.EQ.142) THEN | |
9731 | C...f + fbar' -> W'+/- | |
9732 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
9733 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
9734 | KFRES=ISIGN(34,KCH1+KCH2) | |
9735 | ||
9736 | ELSEIF(ISUB.EQ.143) THEN | |
9737 | C...f + fbar' -> H+/- | |
9738 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
9739 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
9740 | KFRES=ISIGN(37,KCH1+KCH2) | |
9741 | ||
9742 | ELSEIF(ISUB.EQ.144) THEN | |
9743 | C...f + fbar' -> R | |
9744 | KFRES=ISIGN(41,MINT(15)+MINT(16)) | |
9745 | ||
9746 | ELSEIF(ISUB.EQ.145) THEN | |
9747 | C...q + l -> LQ (leptoquark) | |
9748 | IF(IABS(MINT(16)).LE.8) JS=2 | |
9749 | KFRES=ISIGN(42,MINT(14+JS)) | |
9750 | KCC=28+JS | |
9751 | KCS=ISIGN(1,MINT(14+JS)) | |
9752 | ||
9753 | ELSEIF(ISUB.EQ.146) THEN | |
9754 | C...e + gamma -> e* (excited lepton) | |
9755 | IF(MINT(15).EQ.22) JS=2 | |
9756 | KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS)) | |
9757 | KCC=22 | |
9758 | ||
9759 | ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN | |
9760 | C...q + g -> q* (excited quark) | |
9761 | IF(MINT(15).EQ.21) JS=2 | |
9762 | KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS)) | |
9763 | KCC=30+JS | |
9764 | KCS=ISIGN(1,MINT(14+JS)) | |
9765 | ||
9766 | ELSEIF(ISUB.EQ.149) THEN | |
9767 | C...g + g -> eta_tc | |
9768 | KFRES=KTECHN+331 | |
9769 | KCC=23 | |
9770 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9771 | ENDIF | |
9772 | ||
9773 | ELSEIF(ISUB.LE.200) THEN | |
9774 | IF(ISUB.EQ.161) THEN | |
9775 | C...f + g -> f' + H+/-; th = (p(f)-p(f'))**2 | |
9776 | IF(MINT(15).EQ.21) JS=2 | |
9777 | I=MINT(14+JS) | |
9778 | IA=IABS(I) | |
9779 | MINT(23-JS)=ISIGN(37,KCHG(IA,1)*I) | |
9780 | IB=IA+MOD(IA,2)-MOD(IA+1,2) | |
9781 | MINT(20+JS)=ISIGN(IB,I) | |
9782 | KCC=15+JS | |
9783 | KCS=ISIGN(1,MINT(14+JS)) | |
9784 | ||
9785 | ELSEIF(ISUB.EQ.162) THEN | |
9786 | C...q + g -> LQ + lbar; LQ=leptoquark; th=(p(q)-p(LQ))^2 | |
9787 | IF(MINT(15).EQ.21) JS=2 | |
9788 | MINT(20+JS)=ISIGN(42,MINT(14+JS)) | |
9789 | KFLQL=KFDP(MDCY(42,2),2) | |
9790 | MINT(23-JS)=-ISIGN(KFLQL,MINT(14+JS)) | |
9791 | KCC=15+JS | |
9792 | KCS=ISIGN(1,MINT(14+JS)) | |
9793 | ||
9794 | ELSEIF(ISUB.EQ.163) THEN | |
9795 | C...g + g -> LQ + LQbar; LQ=leptoquark; th arbitrary | |
9796 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
9797 | MINT(21)=ISIGN(42,KCS) | |
9798 | MINT(22)=-MINT(21) | |
9799 | KCC=MINT(2)+10 | |
9800 | ||
9801 | ELSEIF(ISUB.EQ.164) THEN | |
9802 | C...q + qbar -> LQ + LQbar; LQ=leptoquark; th=(p(q)-p(LQ))**2 | |
9803 | MINT(21)=ISIGN(42,MINT(15)) | |
9804 | MINT(22)=-MINT(21) | |
9805 | KCC=4 | |
9806 | ||
9807 | ELSEIF(ISUB.EQ.165) THEN | |
9808 | C...q + qbar -> l- + l+; th=(p(q)-p(l-))**2 | |
9809 | MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) | |
9810 | MINT(22)=-MINT(21) | |
9811 | ||
9812 | ELSEIF(ISUB.EQ.166) THEN | |
9813 | C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2 | |
9814 | IF(MOD(MINT(15),2).EQ.0) THEN | |
9815 | MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15)) | |
9816 | MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16)) | |
9817 | ELSE | |
9818 | MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) | |
9819 | MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16)) | |
9820 | ENDIF | |
9821 | ||
9822 | ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN | |
9823 | C...q + q' -> q" + q* (excited quark) | |
9824 | KFQSTR=KFPR(ISUB,2) | |
9825 | KFQEXC=MOD(KFQSTR,KEXCIT) | |
9826 | JS=MINT(2) | |
9827 | MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS)) | |
9828 | IF(IABS(MINT(15)).NE.KFQEXC.AND.IABS(MINT(16)).NE.KFQEXC) | |
9829 | & MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS)) | |
9830 | KCC=22 | |
9831 | JS=3-JS | |
9832 | ||
9833 | ELSEIF(ISUB.EQ.169) THEN | |
9834 | C...q + qbar -> e + e* (excited lepton) | |
9835 | KFQSTR=KFPR(ISUB,2) | |
9836 | KFQEXC=MOD(KFQSTR,KEXCIT) | |
9837 | JS=MINT(2) | |
9838 | MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS)) | |
9839 | MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS)) | |
9840 | JS=3-JS | |
9841 | ||
9842 | ELSEIF(ISUB.EQ.191) THEN | |
9843 | C...f + fbar -> rho_tc0. | |
9844 | KFRES=KTECHN+113 | |
9845 | ||
9846 | ELSEIF(ISUB.EQ.192) THEN | |
9847 | C...f + fbar' -> rho_tc+/- | |
9848 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
9849 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
9850 | KFRES=ISIGN(KTECHN+213,KCH1+KCH2) | |
9851 | ||
9852 | ELSEIF(ISUB.EQ.193) THEN | |
9853 | C...f + fbar -> omega_tc0. | |
9854 | KFRES=KTECHN+223 | |
9855 | ||
9856 | ELSEIF(ISUB.EQ.194) THEN | |
9857 | C...f + fbar -> f' + fbar' via mixture of s-channel | |
9858 | C...rho_tc and omega_tc; th=(p(f)-p(f'))**2 | |
9859 | MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) | |
9860 | MINT(22)=-MINT(21) | |
9861 | ||
9862 | ELSEIF(ISUB.EQ.195) THEN | |
9863 | C...f + fbar' -> f'' + fbar''' via s-channel | |
9864 | C...rho_tc+ th=(p(f)-p(f'))**2 | |
9865 | C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2 | |
9866 | IF(MOD(MINT(15),2).EQ.0) THEN | |
9867 | MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15)) | |
9868 | MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16)) | |
9869 | ELSE | |
9870 | MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) | |
9871 | MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16)) | |
9872 | ENDIF | |
9873 | ENDIF | |
9874 | ||
9875 | CMRENNA++ | |
9876 | ELSEIF(ISUB.LE.215) THEN | |
9877 | IF(ISUB.EQ.201) THEN | |
9878 | C...f + fbar -> ~e_L + ~e_Lbar | |
9879 | MINT(21)=ISIGN(KSUSY1+11,KCS) | |
9880 | MINT(22)=-MINT(21) | |
9881 | ||
9882 | ELSEIF(ISUB.EQ.202) THEN | |
9883 | C...f + fbar -> ~e_R + ~e_Rbar | |
9884 | MINT(21)=ISIGN(KSUSY2+11,KCS) | |
9885 | MINT(22)=-MINT(21) | |
9886 | ||
9887 | ELSEIF(ISUB.EQ.203) THEN | |
9888 | C...f + fbar -> ~e_L + ~e_Rbar | |
9889 | IF(MINT(15).LT.0) JS=2 | |
9890 | IF(MINT(2).EQ.1) THEN | |
9891 | MINT(20+JS)=KFPR(ISUB,1) | |
9892 | MINT(23-JS)=-KFPR(ISUB,2) | |
9893 | ELSE | |
9894 | MINT(20+JS)=-KFPR(ISUB,1) | |
9895 | MINT(23-JS)=KFPR(ISUB,2) | |
9896 | ENDIF | |
9897 | ||
9898 | ELSEIF(ISUB.EQ.204) THEN | |
9899 | C...f + fbar -> ~mu_L + ~mu_Lbar | |
9900 | MINT(21)=ISIGN(KSUSY1+13,KCS) | |
9901 | MINT(22)=-MINT(21) | |
9902 | ||
9903 | ELSEIF(ISUB.EQ.205) THEN | |
9904 | C...f + fbar -> ~mu_R + ~mu_Rbar | |
9905 | MINT(21)=ISIGN(KSUSY2+13,KCS) | |
9906 | MINT(22)=-MINT(21) | |
9907 | ||
9908 | ELSEIF(ISUB.EQ.206) THEN | |
9909 | C...f + fbar -> ~mu_L + ~mu_Rbar | |
9910 | IF(MINT(15).LT.0) JS=2 | |
9911 | IF(MINT(2).EQ.1) THEN | |
9912 | MINT(20+JS)=KFPR(ISUB,1) | |
9913 | MINT(23-JS)=-KFPR(ISUB,2) | |
9914 | ELSE | |
9915 | MINT(20+JS)=-KFPR(ISUB,1) | |
9916 | MINT(23-JS)=KFPR(ISUB,2) | |
9917 | ENDIF | |
9918 | ||
9919 | ELSEIF(ISUB.EQ.207) THEN | |
9920 | C...f + fbar -> ~tau_1 + ~tau_1bar | |
9921 | MINT(21)=ISIGN(KSUSY1+15,KCS) | |
9922 | MINT(22)=-MINT(21) | |
9923 | ||
9924 | ELSEIF(ISUB.EQ.208) THEN | |
9925 | C...f + fbar -> ~tau_2 + ~tau_2bar | |
9926 | MINT(21)=ISIGN(KSUSY2+15,KCS) | |
9927 | MINT(22)=-MINT(21) | |
9928 | ||
9929 | ELSEIF(ISUB.EQ.209) THEN | |
9930 | C...f + fbar -> ~tau_1 + ~tau_2bar | |
9931 | IF(MINT(15).LT.0) JS=2 | |
9932 | IF(MINT(2).EQ.1) THEN | |
9933 | MINT(20+JS)=KFPR(ISUB,1) | |
9934 | MINT(23-JS)=-KFPR(ISUB,2) | |
9935 | ELSE | |
9936 | MINT(20+JS)=-KFPR(ISUB,1) | |
9937 | MINT(23-JS)=KFPR(ISUB,2) | |
9938 | ENDIF | |
9939 | ||
9940 | ELSEIF(ISUB.EQ.210) THEN | |
9941 | C...q + qbar' -> ~l_L + ~nulbar; th arbitrary | |
9942 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
9943 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
9944 | MINT(21)=-ISIGN(KFPR(ISUB,1),KCH1+KCH2) | |
9945 | MINT(22)=ISIGN(KFPR(ISUB,2),KCH1+KCH2) | |
9946 | ||
9947 | ELSEIF(ISUB.EQ.211) THEN | |
9948 | C...q + qbar'-> ~tau_1 + ~nutaubar; th arbitrary | |
9949 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
9950 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
9951 | MINT(21)=-ISIGN(KSUSY1+15,KCH1+KCH2) | |
9952 | MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2) | |
9953 | ||
9954 | ELSEIF(ISUB.EQ.212) THEN | |
9955 | C...q + qbar'-> ~tau_2 + ~nutaubar; th arbitrary | |
9956 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
9957 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
9958 | MINT(21)=-ISIGN(KSUSY2+15,KCH1+KCH2) | |
9959 | MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2) | |
9960 | ||
9961 | ELSEIF(ISUB.EQ.213) THEN | |
9962 | C...f + fbar -> ~nul + ~nulbar | |
9963 | MINT(21)=ISIGN(KFPR(ISUB,1),KCS) | |
9964 | MINT(22)=-MINT(21) | |
9965 | ||
9966 | ELSEIF(ISUB.EQ.214) THEN | |
9967 | C...f + fbar -> ~nutau + ~nutaubar | |
9968 | MINT(21)=ISIGN(KSUSY1+16,KCS) | |
9969 | MINT(22)=-MINT(21) | |
9970 | ENDIF | |
9971 | ||
9972 | ELSEIF(ISUB.LE.225) THEN | |
9973 | IF(ISUB.EQ.216) THEN | |
9974 | C...f + fbar -> ~chi01 + ~chi01 | |
9975 | MINT(21)=KSUSY1+22 | |
9976 | MINT(22)=KSUSY1+22 | |
9977 | ||
9978 | ELSEIF(ISUB.EQ.217) THEN | |
9979 | C...f + fbar -> ~chi02 + ~chi02 | |
9980 | MINT(21)=KSUSY1+23 | |
9981 | MINT(22)=KSUSY1+23 | |
9982 | ||
9983 | ELSEIF(ISUB.EQ.218 ) THEN | |
9984 | C...f + fbar -> ~chi03 + ~chi03 | |
9985 | MINT(21)=KSUSY1+25 | |
9986 | MINT(22)=KSUSY1+25 | |
9987 | ||
9988 | ELSEIF(ISUB.EQ.219 ) THEN | |
9989 | C...f + fbar -> ~chi04 + ~chi04 | |
9990 | MINT(21)=KSUSY1+35 | |
9991 | MINT(22)=KSUSY1+35 | |
9992 | ||
9993 | ELSEIF(ISUB.EQ.220 ) THEN | |
9994 | C...f + fbar -> ~chi01 + ~chi02 | |
9995 | IF(MINT(15).LT.0) JS=2 | |
9996 | C IF(PYR(0).GT.0.5D0) JS=2 | |
9997 | MINT(20+JS)=KSUSY1+22 | |
9998 | MINT(23-JS)=KSUSY1+23 | |
9999 | ||
10000 | ELSEIF(ISUB.EQ.221 ) THEN | |
10001 | C...f + fbar -> ~chi01 + ~chi03 | |
10002 | IF(MINT(15).LT.0) JS=2 | |
10003 | C IF(PYR(0).GT.0.5D0) JS=2 | |
10004 | MINT(20+JS)=KSUSY1+22 | |
10005 | MINT(23-JS)=KSUSY1+25 | |
10006 | ||
10007 | ELSEIF(ISUB.EQ.222) THEN | |
10008 | C...f + fbar -> ~chi01 + ~chi04 | |
10009 | IF(MINT(15).LT.0) JS=2 | |
10010 | C IF(PYR(0).GT.0.5D0) JS=2 | |
10011 | MINT(20+JS)=KSUSY1+22 | |
10012 | MINT(23-JS)=KSUSY1+35 | |
10013 | ||
10014 | ELSEIF(ISUB.EQ.223) THEN | |
10015 | C...f + fbar -> ~chi02 + ~chi03 | |
10016 | IF(MINT(15).LT.0) JS=2 | |
10017 | C IF(PYR(0).GT.0.5D0) JS=2 | |
10018 | MINT(20+JS)=KSUSY1+23 | |
10019 | MINT(23-JS)=KSUSY1+25 | |
10020 | ||
10021 | ELSEIF(ISUB.EQ.224) THEN | |
10022 | C...f + fbar -> ~chi02 + ~chi04 | |
10023 | IF(MINT(15).LT.0) JS=2 | |
10024 | C IF(PYR(0).GT.0.5D0) JS=2 | |
10025 | MINT(20+JS)=KSUSY1+23 | |
10026 | MINT(23-JS)=KSUSY1+35 | |
10027 | ||
10028 | ELSEIF(ISUB.EQ.225) THEN | |
10029 | C...f + fbar -> ~chi03 + ~chi04 | |
10030 | IF(MINT(15).LT.0) JS=2 | |
10031 | C IF(PYR(0).GT.0.5D0) JS=2 | |
10032 | MINT(20+JS)=KSUSY1+25 | |
10033 | MINT(23-JS)=KSUSY1+35 | |
10034 | ENDIF | |
10035 | ||
10036 | ELSEIF(ISUB.LE.236) THEN | |
10037 | IF(ISUB.EQ.226) THEN | |
10038 | C...f + fbar -> ~chi+-1 + ~chi-+1 | |
10039 | C...th=(p(q)-p(chi+))**2 or (p(qbar)-p(chi-))**2 | |
10040 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10041 | MINT(21)=ISIGN(KSUSY1+24,KCH1) | |
10042 | MINT(22)=-MINT(21) | |
10043 | ||
10044 | ELSEIF(ISUB.EQ.227) THEN | |
10045 | C...f + fbar -> ~chi+-2 + ~chi-+2 | |
10046 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10047 | MINT(21)=ISIGN(KSUSY1+37,KCH1) | |
10048 | MINT(22)=-MINT(21) | |
10049 | ||
10050 | ELSEIF(ISUB.EQ.228) THEN | |
10051 | C...f + fbar -> ~chi+-1 + ~chi-+2 | |
10052 | C...th=(p(q)-p(chi1+))**2 or th=(p(qbar)-p(chi1-))**2 | |
10053 | C...js=1 if pyr<.5, js=2 if pyr>.5 | |
10054 | C...if 15=q, 16=qbar and js=1, chi1+ + chi2-, th=(q-chi1+)**2 | |
10055 | C...if 15=qbar, 16=q and js=1, chi2- + chi1+, th=(q-chi1+)**2 | |
10056 | C...if 15=q, 16=qbar and js=2, chi1- + chi2+, th=(qbar-chi1-)**2 | |
10057 | C...if 15=qbar, 16=q and js=2, chi2+ + chi1-, th=(q-chi1-)**2 | |
10058 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10059 | KCH2=INT(1-KCH1)/2 | |
10060 | IF(MINT(2).EQ.1) THEN | |
10061 | MINT(21)= ISIGN(KSUSY1+24,KCH1) | |
10062 | MINT(22)= -ISIGN(KSUSY1+37,KCH1) | |
10063 | c IF(KCH2.EQ.0) JS=2 | |
10064 | ELSE | |
10065 | MINT(21)= ISIGN(KSUSY1+37,KCH1) | |
10066 | MINT(22)= -ISIGN(KSUSY1+24,KCH1) | |
10067 | JS=2 | |
10068 | c IF(KCH2.EQ.1) JS=2 | |
10069 | ENDIF | |
10070 | ||
10071 | ELSEIF(ISUB.EQ.229) THEN | |
10072 | C...q + qbar' -> ~chi01 + ~chi+-1 | |
10073 | C...th=(p(u)-p(chi+))**2 or (p(ubar)-p(chi-))**2 | |
10074 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10075 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10076 | C...CHECK THIS | |
10077 | IF(MOD(MINT(15),2).EQ.0) JS=2 | |
10078 | MINT(20+JS)=KSUSY1+22 | |
10079 | MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) | |
10080 | ||
10081 | ELSEIF(ISUB.EQ.230) THEN | |
10082 | C...q + qbar' -> ~chi02 + ~chi+-1 | |
10083 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10084 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10085 | IF(MOD(MINT(15),2).EQ.0) JS=2 | |
10086 | MINT(20+JS)=KSUSY1+23 | |
10087 | MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) | |
10088 | ||
10089 | ELSEIF(ISUB.EQ.231) THEN | |
10090 | C...q + qbar' -> ~chi03 + ~chi+-1 | |
10091 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10092 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10093 | IF(MOD(MINT(15),2).EQ.0) JS=2 | |
10094 | MINT(20+JS)=KSUSY1+25 | |
10095 | MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) | |
10096 | ||
10097 | ELSEIF(ISUB.EQ.232) THEN | |
10098 | C...q + qbar' -> ~chi04 + ~chi+-1 | |
10099 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10100 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10101 | IF(MOD(MINT(15),2).EQ.0) JS=2 | |
10102 | MINT(20+JS)=KSUSY1+35 | |
10103 | MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) | |
10104 | ||
10105 | ELSEIF(ISUB.EQ.233) THEN | |
10106 | C...q + qbar' -> ~chi01 + ~chi+-2 | |
10107 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10108 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10109 | IF(MOD(MINT(15),2).EQ.0) JS=2 | |
10110 | MINT(20+JS)=KSUSY1+22 | |
10111 | MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) | |
10112 | ||
10113 | ELSEIF(ISUB.EQ.234) THEN | |
10114 | C...q + qbar' -> ~chi02 + ~chi+-2 | |
10115 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10116 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10117 | IF(MOD(MINT(15),2).EQ.0) JS=2 | |
10118 | MINT(20+JS)=KSUSY1+23 | |
10119 | MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) | |
10120 | ||
10121 | ELSEIF(ISUB.EQ.235) THEN | |
10122 | C...q + qbar' -> ~chi03 + ~chi+-2 | |
10123 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10124 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10125 | IF(MOD(MINT(15),2).EQ.0) JS=2 | |
10126 | MINT(20+JS)=KSUSY1+25 | |
10127 | MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) | |
10128 | ||
10129 | ELSEIF(ISUB.EQ.236) THEN | |
10130 | C...q + qbar' -> ~chi04 + ~chi+-2 | |
10131 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10132 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10133 | IF(MOD(MINT(15),2).EQ.0) JS=2 | |
10134 | MINT(20+JS)=KSUSY1+35 | |
10135 | MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) | |
10136 | ENDIF | |
10137 | ||
10138 | ELSEIF(ISUB.LE.245) THEN | |
10139 | IF(ISUB.EQ.237) THEN | |
10140 | C...q + qbar -> ~chi01 + ~g | |
10141 | C...th arbitrary | |
10142 | IF(PYR(0).GT.0.5D0) JS=2 | |
10143 | MINT(20+JS)=KSUSY1+21 | |
10144 | MINT(23-JS)=KSUSY1+22 | |
10145 | KCC=17+JS | |
10146 | ||
10147 | ELSEIF(ISUB.EQ.238) THEN | |
10148 | C...q + qbar -> ~chi02 + ~g | |
10149 | C...th arbitrary | |
10150 | IF(PYR(0).GT.0.5D0) JS=2 | |
10151 | MINT(20+JS)=KSUSY1+21 | |
10152 | MINT(23-JS)=KSUSY1+23 | |
10153 | KCC=17+JS | |
10154 | ||
10155 | ELSEIF(ISUB.EQ.239) THEN | |
10156 | C...q + qbar -> ~chi03 + ~g | |
10157 | C...th arbitrary | |
10158 | IF(PYR(0).GT.0.5D0) JS=2 | |
10159 | MINT(20+JS)=KSUSY1+21 | |
10160 | MINT(23-JS)=KSUSY1+25 | |
10161 | KCC=17+JS | |
10162 | ||
10163 | ELSEIF(ISUB.EQ.240) THEN | |
10164 | C...q + qbar -> ~chi04 + ~g | |
10165 | C...th arbitrary | |
10166 | IF(PYR(0).GT.0.5D0) JS=2 | |
10167 | MINT(20+JS)=KSUSY1+21 | |
10168 | MINT(23-JS)=KSUSY1+35 | |
10169 | KCC=17+JS | |
10170 | ||
10171 | ELSEIF(ISUB.EQ.241) THEN | |
10172 | C...q + qbar' -> ~chi+-1 + ~g | |
10173 | C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+ | |
10174 | C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi- | |
10175 | C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi- | |
10176 | C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+ | |
10177 | C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2 | |
10178 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10179 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10180 | JS=1 | |
10181 | IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 | |
10182 | MINT(20+JS)=KSUSY1+21 | |
10183 | MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) | |
10184 | KCC=17+JS | |
10185 | ||
10186 | ELSEIF(ISUB.EQ.242) THEN | |
10187 | C...q + qbar' -> ~chi+-2 + ~g | |
10188 | C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+ | |
10189 | C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi- | |
10190 | C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi- | |
10191 | C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+ | |
10192 | C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2 | |
10193 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10194 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10195 | JS=1 | |
10196 | IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 | |
10197 | MINT(20+JS)=KSUSY1+21 | |
10198 | MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) | |
10199 | KCC=17+JS | |
10200 | ||
10201 | ELSEIF(ISUB.EQ.243) THEN | |
10202 | C...q + qbar -> ~g + ~g ; th arbitrary | |
10203 | MINT(21)=KSUSY1+21 | |
10204 | MINT(22)=KSUSY1+21 | |
10205 | KCC=MINT(2)+4 | |
10206 | ||
10207 | ELSEIF(ISUB.EQ.244) THEN | |
10208 | C...g + g -> ~g + ~g ; th arbitrary | |
10209 | KCC=MINT(2)+12 | |
10210 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
10211 | MINT(21)=KSUSY1+21 | |
10212 | MINT(22)=KSUSY1+21 | |
10213 | ENDIF | |
10214 | ||
10215 | ELSEIF(ISUB.LE.260) THEN | |
10216 | IF(ISUB.EQ.246) THEN | |
10217 | C...qj + g -> ~qj_L + ~chi01 | |
10218 | IF(MINT(15).EQ.21) JS=2 | |
10219 | I=MINT(14+JS) | |
10220 | IA=IABS(I) | |
10221 | MINT(20+JS)=ISIGN(KSUSY1+IA,I) | |
10222 | MINT(23-JS)=KSUSY1+22 | |
10223 | KCC=15+JS | |
10224 | KCS=ISIGN(1,MINT(14+JS)) | |
10225 | ||
10226 | ELSEIF(ISUB.EQ.247) THEN | |
10227 | C...qj + g -> ~qj_R + ~chi01 | |
10228 | IF(MINT(15).EQ.21) JS=2 | |
10229 | I=MINT(14+JS) | |
10230 | IA=IABS(I) | |
10231 | MINT(20+JS)=ISIGN(KSUSY2+IA,I) | |
10232 | MINT(23-JS)=KSUSY1+22 | |
10233 | KCC=15+JS | |
10234 | KCS=ISIGN(1,MINT(14+JS)) | |
10235 | ||
10236 | ELSEIF(ISUB.EQ.248) THEN | |
10237 | C...qj + g -> ~qj_L + ~chi02 | |
10238 | IF(MINT(15).EQ.21) JS=2 | |
10239 | I=MINT(14+JS) | |
10240 | IA=IABS(I) | |
10241 | MINT(20+JS)=ISIGN(KSUSY1+IA,I) | |
10242 | MINT(23-JS)=KSUSY1+23 | |
10243 | KCC=15+JS | |
10244 | KCS=ISIGN(1,MINT(14+JS)) | |
10245 | ||
10246 | ELSEIF(ISUB.EQ.249) THEN | |
10247 | C...qj + g -> ~qj_R + ~chi02 | |
10248 | IF(MINT(15).EQ.21) JS=2 | |
10249 | I=MINT(14+JS) | |
10250 | IA=IABS(I) | |
10251 | MINT(20+JS)=ISIGN(KSUSY2+IA,I) | |
10252 | MINT(23-JS)=KSUSY1+23 | |
10253 | KCC=15+JS | |
10254 | KCS=ISIGN(1,MINT(14+JS)) | |
10255 | ||
10256 | ELSEIF(ISUB.EQ.250) THEN | |
10257 | C...qj + g -> ~qj_L + ~chi03 | |
10258 | IF(MINT(15).EQ.21) JS=2 | |
10259 | I=MINT(14+JS) | |
10260 | IA=IABS(I) | |
10261 | MINT(20+JS)=ISIGN(KSUSY1+IA,I) | |
10262 | MINT(23-JS)=KSUSY1+25 | |
10263 | KCC=15+JS | |
10264 | KCS=ISIGN(1,MINT(14+JS)) | |
10265 | ||
10266 | ELSEIF(ISUB.EQ.251) THEN | |
10267 | C...qj + g -> ~qj_R + ~chi03 | |
10268 | IF(MINT(15).EQ.21) JS=2 | |
10269 | I=MINT(14+JS) | |
10270 | IA=IABS(I) | |
10271 | MINT(20+JS)=ISIGN(KSUSY2+IA,I) | |
10272 | MINT(23-JS)=KSUSY1+25 | |
10273 | KCC=15+JS | |
10274 | KCS=ISIGN(1,MINT(14+JS)) | |
10275 | ||
10276 | ELSEIF(ISUB.EQ.252) THEN | |
10277 | C...qj + g -> ~qj_L + ~chi04 | |
10278 | IF(MINT(15).EQ.21) JS=2 | |
10279 | I=MINT(14+JS) | |
10280 | IA=IABS(I) | |
10281 | MINT(20+JS)=ISIGN(KSUSY1+IA,I) | |
10282 | MINT(23-JS)=KSUSY1+35 | |
10283 | KCC=15+JS | |
10284 | KCS=ISIGN(1,MINT(14+JS)) | |
10285 | ||
10286 | ELSEIF(ISUB.EQ.253) THEN | |
10287 | C...qj + g -> ~qj_R + ~chi04 | |
10288 | IF(MINT(15).EQ.21) JS=2 | |
10289 | I=MINT(14+JS) | |
10290 | IA=IABS(I) | |
10291 | MINT(20+JS)=ISIGN(KSUSY2+IA,I) | |
10292 | MINT(23-JS)=KSUSY1+35 | |
10293 | KCC=15+JS | |
10294 | KCS=ISIGN(1,MINT(14+JS)) | |
10295 | ||
10296 | ELSEIF(ISUB.EQ.254) THEN | |
10297 | C...qj + g -> ~qk_L + ~chi+-1 | |
10298 | IF(MINT(15).EQ.21) JS=2 | |
10299 | I=MINT(14+JS) | |
10300 | IA=IABS(I) | |
10301 | MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I) | |
10302 | IB=-IA+INT((IA+1)/2)*4-1 | |
10303 | MINT(20+JS)=ISIGN(KSUSY1+IB,I) | |
10304 | KCC=15+JS | |
10305 | KCS=ISIGN(1,MINT(14+JS)) | |
10306 | ||
10307 | ELSEIF(ISUB.EQ.255) THEN | |
10308 | C...qj + g -> ~qk_L + ~chi+-1 | |
10309 | IF(MINT(15).EQ.21) JS=2 | |
10310 | I=MINT(14+JS) | |
10311 | IA=IABS(I) | |
10312 | MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I) | |
10313 | IB=-IA+INT((IA+1)/2)*4-1 | |
10314 | MINT(20+JS)=ISIGN(KSUSY2+IB,I) | |
10315 | KCC=15+JS | |
10316 | KCS=ISIGN(1,MINT(14+JS)) | |
10317 | ||
10318 | ELSEIF(ISUB.EQ.256) THEN | |
10319 | C...qj + g -> ~qk_L + ~chi+-2 | |
10320 | IF(MINT(15).EQ.21) JS=2 | |
10321 | I=MINT(14+JS) | |
10322 | IA=IABS(I) | |
10323 | IB=-IA+INT((IA+1)/2)*4-1 | |
10324 | MINT(20+JS)=ISIGN(KSUSY1+IB,I) | |
10325 | MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I) | |
10326 | KCC=15+JS | |
10327 | KCS=ISIGN(1,MINT(14+JS)) | |
10328 | ||
10329 | ELSEIF(ISUB.EQ.257) THEN | |
10330 | C...qj + g -> ~qk_R + ~chi+-2 | |
10331 | IF(MINT(15).EQ.21) JS=2 | |
10332 | I=MINT(14+JS) | |
10333 | IA=IABS(I) | |
10334 | IB=-IA+INT((IA+1)/2)*4-1 | |
10335 | MINT(20+JS)=ISIGN(KSUSY2+IB,I) | |
10336 | MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I) | |
10337 | KCC=15+JS | |
10338 | KCS=ISIGN(1,MINT(14+JS)) | |
10339 | ||
10340 | ELSEIF(ISUB.EQ.258) THEN | |
10341 | C...qj + g -> ~qj_L + ~g | |
10342 | IF(MINT(15).EQ.21) JS=2 | |
10343 | I=MINT(14+JS) | |
10344 | IA=IABS(I) | |
10345 | MINT(20+JS)=ISIGN(KSUSY1+IA,I) | |
10346 | MINT(23-JS)=KSUSY1+21 | |
10347 | KCC=MINT(2)+6 | |
10348 | IF(JS.EQ.2) KCC=KCC+2 | |
10349 | KCS=ISIGN(1,I) | |
10350 | ||
10351 | ELSEIF(ISUB.EQ.259) THEN | |
10352 | C...qj + g -> ~qj_R + ~g | |
10353 | IF(MINT(15).EQ.21) JS=2 | |
10354 | I=MINT(14+JS) | |
10355 | IA=IABS(I) | |
10356 | MINT(20+JS)=ISIGN(KSUSY2+IA,I) | |
10357 | MINT(23-JS)=KSUSY1+21 | |
10358 | KCC=MINT(2)+6 | |
10359 | IF(JS.EQ.2) KCC=KCC+2 | |
10360 | KCS=ISIGN(1,I) | |
10361 | ENDIF | |
10362 | ||
10363 | ELSEIF(ISUB.LE.270) THEN | |
10364 | IF(ISUB.EQ.261) THEN | |
10365 | C...f + fbar -> ~t_1 + ~t_1bar; th = (p(q)-p(sq))**2 | |
10366 | ISGN=1 | |
10367 | IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 | |
10368 | MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) | |
10369 | MINT(22)=-MINT(21) | |
10370 | C...Correct color combination | |
10371 | IF(MINT(43).EQ.4) KCC=4 | |
10372 | ||
10373 | ELSEIF(ISUB.EQ.262) THEN | |
10374 | C...f + fbar -> ~t_2 + ~t_2bar; th = (p(q)-p(sq))**2 | |
10375 | ISGN=1 | |
10376 | IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 | |
10377 | MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) | |
10378 | MINT(22)=-MINT(21) | |
10379 | C...Correct color combination | |
10380 | IF(MINT(43).EQ.4) KCC=4 | |
10381 | ||
10382 | ELSEIF(ISUB.EQ.263) THEN | |
10383 | C...f + fbar -> ~t_1 + ~t_2bar; th = (p(q)-p(sq))**2 | |
10384 | IF((KCS.GT.0.AND.MINT(2).EQ.1).OR. | |
10385 | & (KCS.LT.0.AND.MINT(2).EQ.2)) THEN | |
10386 | MINT(21)=ISIGN(KFPR(ISUB,1),KCS) | |
10387 | MINT(22)=-ISIGN(KFPR(ISUB,2),KCS) | |
10388 | ELSE | |
10389 | JS=2 | |
10390 | MINT(21)=ISIGN(KFPR(ISUB,2),KCS) | |
10391 | MINT(22)=-ISIGN(KFPR(ISUB,1),KCS) | |
10392 | ENDIF | |
10393 | C...Correct color combination | |
10394 | IF(MINT(43).EQ.4) KCC=4 | |
10395 | ||
10396 | ELSEIF(ISUB.EQ.264) THEN | |
10397 | C...g + g -> ~t_1 + ~t_1bar; th arbitrary | |
10398 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
10399 | MINT(21)=ISIGN(KFPR(ISUB,1),KCS) | |
10400 | MINT(22)=-MINT(21) | |
10401 | KCC=MINT(2)+10 | |
10402 | ||
10403 | ELSEIF(ISUB.EQ.265) THEN | |
10404 | C...g + g -> ~t_2 + ~t_2bar; th arbitrary | |
10405 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
10406 | MINT(21)=ISIGN(KFPR(ISUB,1),KCS) | |
10407 | MINT(22)=-MINT(21) | |
10408 | KCC=MINT(2)+10 | |
10409 | ENDIF | |
10410 | ||
10411 | ELSEIF(ISUB.LE.296) THEN | |
10412 | IF(ISUB.EQ.271.OR.ISUB.EQ.281.OR.ISUB.EQ.291) THEN | |
10413 | C...qi + qj -> ~qi_L + ~qj_L | |
10414 | KCC=MINT(2) | |
10415 | IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 | |
10416 | MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15)) | |
10417 | MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16)) | |
10418 | ||
10419 | ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.282.OR.ISUB.EQ.292) THEN | |
10420 | C...qi + qj -> ~qi_R + ~qj_R | |
10421 | KCC=MINT(2) | |
10422 | IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 | |
10423 | MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15)) | |
10424 | MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16)) | |
10425 | ||
10426 | ELSEIF(ISUB.EQ.273.OR.ISUB.EQ.283.OR.ISUB.EQ.293) THEN | |
10427 | C...qi + qj -> ~qi_L + ~qj_R | |
10428 | MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) | |
10429 | MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16)) | |
10430 | KCC=MINT(2) | |
10431 | IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 | |
10432 | ||
10433 | ELSEIF(ISUB.EQ.274.OR.ISUB.EQ.284) THEN | |
10434 | C...qi + qjbar -> ~qi_L + ~qj_Lbar; th = (p(f)-p(sf'))**2 | |
10435 | MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15)) | |
10436 | MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16)) | |
10437 | KCC=MINT(2) | |
10438 | IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 | |
10439 | ||
10440 | ELSEIF(ISUB.EQ.275.OR.ISUB.EQ.285) THEN | |
10441 | C...qi + qjbar -> ~qi_R + ~qj_Rbar ; th = (p(f)-p(sf'))**2 | |
10442 | MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15)) | |
10443 | MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16)) | |
10444 | KCC=MINT(2) | |
10445 | IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 | |
10446 | ||
10447 | ELSEIF(ISUB.EQ.276.OR.ISUB.EQ.286.OR.ISUB.EQ.296) THEN | |
10448 | C...qi + qjbar -> ~qi_L + ~qj_Rbar ; th = (p(f)-p(sf'))**2 | |
10449 | MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) | |
10450 | MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16)) | |
10451 | KCC=MINT(2) | |
10452 | IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 | |
10453 | ||
10454 | ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.287) THEN | |
10455 | C...f + fbar -> ~qi_L + ~qi_Lbar ; th = (p(q)-p(sq))**2 | |
10456 | ISGN=1 | |
10457 | IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 | |
10458 | MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) | |
10459 | MINT(22)=-MINT(21) | |
10460 | IF(MINT(43).EQ.4) KCC=4 | |
10461 | ||
10462 | ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.288) THEN | |
10463 | C...f + fbar -> ~qi_R + ~qi_Rbar; th = (p(q)-p(sq))**2 | |
10464 | ISGN=1 | |
10465 | IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 | |
10466 | MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) | |
10467 | MINT(22)=-MINT(21) | |
10468 | IF(MINT(43).EQ.4) KCC=4 | |
10469 | ||
10470 | ELSEIF(ISUB.EQ.279.OR.ISUB.EQ.289) THEN | |
10471 | C...g + g -> ~qi_L + ~qi_Lbar ; th arbitrary | |
10472 | C...pure LL + RR | |
10473 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
10474 | MINT(21)=ISIGN(KFPR(ISUB,1),KCS) | |
10475 | MINT(22)=-MINT(21) | |
10476 | KCC=MINT(2)+10 | |
10477 | ||
10478 | ELSEIF(ISUB.EQ.280.OR.ISUB.EQ.290) THEN | |
10479 | C...g + g -> ~qi_R + ~qi_Rbar ; th arbitrary | |
10480 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
10481 | MINT(21)=ISIGN(KFPR(ISUB,1),KCS) | |
10482 | MINT(22)=-MINT(21) | |
10483 | KCC=MINT(2)+10 | |
10484 | ||
10485 | ELSEIF(ISUB.EQ.294) THEN | |
10486 | C...qj + g -> ~qj_L + ~g | |
10487 | IF(MINT(15).EQ.21) JS=2 | |
10488 | I=MINT(14+JS) | |
10489 | IA=IABS(I) | |
10490 | MINT(20+JS)=ISIGN(KSUSY1+IA,I) | |
10491 | MINT(23-JS)=KSUSY1+21 | |
10492 | KCC=MINT(2)+6 | |
10493 | IF(JS.EQ.2) KCC=KCC+2 | |
10494 | KCS=ISIGN(1,I) | |
10495 | ||
10496 | ELSEIF(ISUB.EQ.295) THEN | |
10497 | C...qj + g -> ~qj_R + ~g | |
10498 | IF(MINT(15).EQ.21) JS=2 | |
10499 | I=MINT(14+JS) | |
10500 | IA=IABS(I) | |
10501 | MINT(20+JS)=ISIGN(KSUSY2+IA,I) | |
10502 | MINT(23-JS)=KSUSY1+21 | |
10503 | KCC=MINT(2)+6 | |
10504 | IF(JS.EQ.2) KCC=KCC+2 | |
10505 | KCS=ISIGN(1,I) | |
10506 | ENDIF | |
10507 | ||
10508 | ELSEIF(ISUB.LE.340) THEN | |
10509 | ||
10510 | IF(ISUB.EQ.297.OR.ISUB.EQ.298) THEN | |
10511 | C...q + qbar' -> H+ + H0 | |
10512 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10513 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10514 | IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 | |
10515 | MINT(20+JS)=ISIGN(37,KCH1+KCH2) | |
10516 | MINT(23-JS)=KFPR(ISUB,2) | |
10517 | ELSEIF(ISUB.EQ.299.OR.ISUB.EQ.300) THEN | |
10518 | C...f + fbar -> A0 + H0; th arbitrary | |
10519 | IF(PYR(0).GT.0.5D0) JS=2 | |
10520 | MINT(20+JS)=KFPR(ISUB,1) | |
10521 | MINT(23-JS)=KFPR(ISUB,2) | |
10522 | ELSEIF(ISUB.EQ.301) THEN | |
10523 | C...f + fbar -> H+ H- | |
10524 | MINT(21)=ISIGN(KFPR(ISUB,1),KCS) | |
10525 | MINT(22)=-MINT(21) | |
10526 | ENDIF | |
10527 | CMRENNA-- | |
10528 | ||
10529 | ELSEIF(ISUB.LE.360) THEN | |
10530 | ||
10531 | IF(ISUB.EQ.341.OR.ISUB.EQ.342) THEN | |
10532 | C...l + l -> H_L++/--, H_R++/-- | |
10533 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10534 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10535 | KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2) | |
10536 | ||
10537 | ELSEIF(ISUB.GE.343.AND.ISUB.LE.348) THEN | |
10538 | C...l + gamma -> l' + H++/--; th=(p(l)-p(H))**2 | |
10539 | IF(MINT(15).EQ.22) JS=2 | |
10540 | MINT(20+JS)=ISIGN(KFPR(ISUB,1),-MINT(14+JS)) | |
10541 | MINT(23-JS)=ISIGN(KFPR(ISUB,2),-MINT(14+JS)) | |
10542 | KCC=22 | |
10543 | ||
10544 | ELSEIF(ISUB.EQ.349.OR.ISUB.EQ.350) THEN | |
10545 | C...f + fbar -> H++ + H--; th = (p(f)-p(H--))**2 | |
10546 | MINT(21)=-ISIGN(KFPR(ISUB,1),MINT(15)) | |
10547 | MINT(22)=-MINT(21) | |
10548 | ||
10549 | ELSEIF(ISUB.EQ.351.OR.ISUB.EQ.352) THEN | |
10550 | C...f + f' -> f" + f"' + H++/-- (W+/- + W+/- -> H++/-- | |
10551 | C...as inner process). | |
10552 | DO 450 JT=1,2 | |
10553 | I=MINT(14+JT) | |
10554 | IA=IABS(I) | |
10555 | IF(IA.LE.10) THEN | |
10556 | RVCKM=VINT(180+I)*PYR(0) | |
10557 | DO 440 J=1,MSTP(1) | |
10558 | IB=2*J-1+MOD(IA,2) | |
10559 | IPM=(5-ISIGN(1,I))/2 | |
10560 | IDC=J+MDCY(IA,2)+2 | |
10561 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 440 | |
10562 | MINT(20+JT)=ISIGN(IB,I) | |
10563 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
10564 | IF(RVCKM.LE.0D0) GOTO 450 | |
10565 | 440 CONTINUE | |
10566 | ELSE | |
10567 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
10568 | MINT(20+JT)=ISIGN(IB,I) | |
10569 | ENDIF | |
10570 | 450 CONTINUE | |
10571 | KCC=22 | |
10572 | KFRES=ISIGN(KFPR(ISUB,1),MINT(15)) | |
10573 | IF(MOD(MINT(15),2).EQ.1) KFRES=-KFRES | |
10574 | ||
10575 | ELSEIF(ISUB.EQ.353) THEN | |
10576 | C...f + fbar -> Z_R0 | |
10577 | KFRES=KFPR(ISUB,1) | |
10578 | ||
10579 | ELSEIF(ISUB.EQ.354) THEN | |
10580 | C...f + fbar' -> W+/- | |
10581 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10582 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10583 | KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2) | |
10584 | ||
10585 | ENDIF | |
10586 | ||
10587 | ELSEIF(ISUB.LE.380) THEN | |
10588 | ||
10589 | IF(ISUB.LE.363.OR.ISUB.EQ.368) THEN | |
10590 | C...f + fbar -> charged+ charged- technicolor | |
10591 | KSW=(-1)**INT(1.5D0+PYR(0)) | |
10592 | MINT(21)=ISIGN(KFPR(ISUB,1),KSW) | |
10593 | MINT(22)=-ISIGN(KFPR(ISUB,2),KSW) | |
10594 | ||
10595 | ELSEIF(ISUB.LE.367) THEN | |
10596 | C...f + fbar -> neutral neutral technicolor | |
10597 | MINT(21)=KFPR(ISUB,1) | |
10598 | MINT(22)=KFPR(ISUB,2) | |
10599 | ||
10600 | ELSEIF(ISUB.EQ.374.OR.ISUB.EQ.375) THEN | |
10601 | C...f + fbar' -> neutral charged technicolor | |
10602 | IN=1 | |
10603 | IC=2 | |
10604 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10605 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10606 | IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 | |
10607 | MINT(23-JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2) | |
10608 | MINT(20+JS)=KFPR(ISUB,IN) | |
10609 | ||
10610 | ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN | |
10611 | C...f + fbar' -> charged neutral technicolor | |
10612 | IN=2 | |
10613 | IC=1 | |
10614 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
10615 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
10616 | IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 | |
10617 | MINT(20+JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2) | |
10618 | MINT(23-JS)=KFPR(ISUB,IN) | |
10619 | ENDIF | |
10620 | ||
10621 | ELSEIF(ISUB.LE.400) THEN | |
10622 | IF(ISUB.EQ.381) THEN | |
10623 | C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2, TC extensions | |
10624 | KCC=MINT(2) | |
10625 | IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 | |
10626 | ||
10627 | ELSEIF(ISUB.EQ.382) THEN | |
10628 | C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2, TC extensions | |
10629 | MINT(21)=ISIGN(KFLF,MINT(15)) | |
10630 | MINT(22)=-MINT(21) | |
10631 | KCC=4 | |
10632 | ||
10633 | ELSEIF(ISUB.EQ.383) THEN | |
10634 | C...f + fbar -> g + g; th arbitrary, TC extensions | |
10635 | MINT(21)=21 | |
10636 | MINT(22)=21 | |
10637 | KCC=MINT(2)+4 | |
10638 | ||
10639 | ELSEIF(ISUB.EQ.384) THEN | |
10640 | C...f + g -> f + g; th = (p(f)-p(f))**2, TC extensions | |
10641 | IF(MINT(15).EQ.21) JS=2 | |
10642 | KCC=MINT(2)+6 | |
10643 | IF(MINT(15).EQ.21) KCC=KCC+2 | |
10644 | IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) | |
10645 | IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) | |
10646 | ||
10647 | ELSEIF(ISUB.EQ.385) THEN | |
10648 | C...g + g -> f + fbar; th arbitrary, TC extensions | |
10649 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
10650 | MINT(21)=ISIGN(KFLF,KCS) | |
10651 | MINT(22)=-MINT(21) | |
10652 | KCC=MINT(2)+10 | |
10653 | ||
10654 | ELSEIF(ISUB.EQ.386) THEN | |
10655 | C...g + g -> g + g; th arbitrary, TC extensions | |
10656 | KCC=MINT(2)+12 | |
10657 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
10658 | ||
10659 | ELSEIF(ISUB.EQ.387) THEN | |
10660 | C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2, TC extensions | |
10661 | MINT(21)=ISIGN(MINT(55),MINT(15)) | |
10662 | MINT(22)=-MINT(21) | |
10663 | KCC=4 | |
10664 | ||
10665 | ELSEIF(ISUB.EQ.388) THEN | |
10666 | C...g + g -> Q + Qbar; th arbitrary, TC extensions | |
10667 | KCS=(-1)**INT(1.5D0+PYR(0)) | |
10668 | MINT(21)=ISIGN(MINT(55),KCS) | |
10669 | MINT(22)=-MINT(21) | |
10670 | KCC=MINT(2)+10 | |
10671 | ||
10672 | ELSEIF(ISUB.EQ.391) THEN | |
10673 | C...f + fbar -> G*. | |
10674 | KFRES=KFPR(ISUB,1) | |
10675 | ||
10676 | ELSEIF(ISUB.EQ.392) THEN | |
10677 | C...g + g -> G*. | |
10678 | KCC=21 | |
10679 | KFRES=KFPR(ISUB,1) | |
10680 | ||
10681 | ELSEIF(ISUB.EQ.393) THEN | |
10682 | C...q + qbar -> g + G*; th arbitrary. | |
10683 | IF(PYR(0).GT.0.5D0) JS=2 | |
10684 | MINT(20+JS)=KFPR(ISUB,1) | |
10685 | MINT(23-JS)=KFPR(ISUB,2) | |
10686 | KCC=17+JS | |
10687 | ||
10688 | ELSEIF(ISUB.EQ.394) THEN | |
10689 | C...q + g -> q + G*; th = (p(f) - p(f))**2 | |
10690 | IF(MINT(15).EQ.21) JS=2 | |
10691 | MINT(23-JS)=KFPR(ISUB,2) | |
10692 | KCC=15+JS | |
10693 | KCS=ISIGN(1,MINT(14+JS)) | |
10694 | ||
10695 | ELSEIF(ISUB.EQ.395) THEN | |
10696 | C...g + g -> G* + g; th arbitrary. | |
10697 | IF(PYR(0).GT.0.5D0) JS=2 | |
10698 | MINT(23-JS)=KFPR(ISUB,2) | |
10699 | KCC=22+JS | |
10700 | ENDIF | |
10701 | ENDIF | |
10702 | ||
10703 | IF(ISET(ISUB).EQ.11) THEN | |
10704 | C...Store documentation for user-defined processes | |
10705 | BEZUP=(PUP(3,1)+PUP(3,2))/(PUP(4,1)+PUP(4,2)) | |
10706 | KUPPO(1)=MINT(83)+5 | |
10707 | KUPPO(2)=MINT(83)+6 | |
10708 | I=MINT(83)+6 | |
10709 | DO 470 IUP=3,NUP | |
10710 | KUPPO(IUP)=0 | |
10711 | IF(MSTP(128).GE.2.AND.MOTHUP(1,IUP).GE.3) THEN | |
10712 | IDOC=IDOC-1 | |
10713 | MINT(4)=MINT(4)-1 | |
10714 | GOTO 470 | |
10715 | ENDIF | |
10716 | I=I+1 | |
10717 | KUPPO(IUP)=I | |
10718 | K(I,1)=21 | |
10719 | K(I,2)=IDUP(IUP) | |
10720 | IF(IDUP(IUP).EQ.0) K(I,2)=90 | |
10721 | K(I,3)=0 | |
10722 | IF(MOTHUP(1,IUP).GE.3) K(I,3)=KUPPO(MOTHUP(1,IUP)) | |
10723 | K(I,4)=0 | |
10724 | K(I,5)=0 | |
10725 | DO 460 J=1,5 | |
10726 | P(I,J)=PUP(J,IUP) | |
10727 | 460 CONTINUE | |
10728 | V(I,5)=VTIMUP(IUP) | |
10729 | 470 CONTINUE | |
10730 | CALL PYROBO(MINT(83)+7,MINT(83)+4+NUP,0D0,VINT(24),0D0,0D0, | |
10731 | & -BEZUP) | |
10732 | ||
10733 | C...Store final state partons for user-defined processes | |
10734 | N=IPU2 | |
10735 | DO 490 IUP=3,NUP | |
10736 | N=N+1 | |
10737 | K(N,1)=1 | |
10738 | IF(ISTUP(IUP).EQ.2.OR.ISTUP(IUP).EQ.3) K(N,1)=11 | |
10739 | K(N,2)=IDUP(IUP) | |
10740 | IF(IDUP(IUP).EQ.0) K(N,2)=90 | |
10741 | IF(MSTP(128).LE.0.OR.MOTHUP(1,IUP).EQ.0) THEN | |
10742 | K(N,3)=KUPPO(IUP) | |
10743 | ELSE | |
10744 | K(N,3)=MINT(84)+MOTHUP(1,IUP) | |
10745 | ENDIF | |
10746 | K(N,4)=0 | |
10747 | K(N,5)=0 | |
10748 | DO 480 J=1,5 | |
10749 | P(N,J)=PUP(J,IUP) | |
10750 | 480 CONTINUE | |
10751 | V(N,5)=VTIMUP(IUP) | |
10752 | 490 CONTINUE | |
10753 | CALL PYROBO(IPU3,N,0D0,VINT(24),0D0,0D0,-BEZUP) | |
10754 | ||
10755 | C...Arrange colour flow for user-defined processes | |
10756 | NLBL=0 | |
10757 | DO 540 IUP1=1,NUP | |
10758 | I1=MINT(84)+IUP1 | |
10759 | IF(KCHG(PYCOMP(K(I1,2)),2).EQ.0) GOTO 540 | |
10760 | IF(K(I1,1).EQ.1) K(I1,1)=3 | |
10761 | IF(K(I1,1).EQ.11) K(I1,1)=14 | |
10762 | C...Find a not yet considered colour/anticolour line. | |
10763 | DO 530 ISDE1=1,2 | |
10764 | IF(ICOLUP(ISDE1,IUP1).EQ.0) GOTO 530 | |
10765 | NMAT=0 | |
10766 | DO 500 ILBL=1,NLBL | |
10767 | IF(ICOLUP(ISDE1,IUP1).EQ.ILAB(ILBL)) NMAT=1 | |
10768 | 500 CONTINUE | |
10769 | IF(NMAT.EQ.0) THEN | |
10770 | NLBL=NLBL+1 | |
10771 | ILAB(NLBL)=ICOLUP(ISDE1,IUP1) | |
10772 | C...Find all others belonging to same line. | |
10773 | I3=I1 | |
10774 | I4=0 | |
10775 | DO 520 IUP2=IUP1+1,NUP | |
10776 | I2=MINT(84)+IUP2 | |
10777 | DO 510 ISDE2=1,2 | |
10778 | IF(ICOLUP(ISDE2,IUP2).EQ.ICOLUP(ISDE1,IUP1)) THEN | |
10779 | IF(ISDE2.EQ.ISDE1) THEN | |
10780 | K(I3,3+ISDE2)=K(I3,3+ISDE2)+I2 | |
10781 | K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I3 | |
10782 | I3=I2 | |
10783 | ELSEIF(I4.NE.0) THEN | |
10784 | K(I4,3+ISDE2)=K(I4,3+ISDE2)+I2 | |
10785 | K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I4 | |
10786 | I4=I2 | |
10787 | ELSEIF(IUP2.LE.2) THEN | |
10788 | K(I1,3+ISDE1)=K(I1,3+ISDE1)+I2 | |
10789 | K(I2,3+ISDE2)=K(I2,3+ISDE2)+I1 | |
10790 | I4=I2 | |
10791 | ELSE | |
10792 | K(I1,3+ISDE1)=K(I1,3+ISDE1)+MSTU(5)*I2 | |
10793 | K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I1 | |
10794 | I4=I2 | |
10795 | ENDIF | |
10796 | ENDIF | |
10797 | 510 CONTINUE | |
10798 | 520 CONTINUE | |
10799 | ENDIF | |
10800 | 530 CONTINUE | |
10801 | 540 CONTINUE | |
10802 | ||
10803 | ELSEIF(IDOC.EQ.7) THEN | |
10804 | C...Resonance not decaying; store kinematics | |
10805 | I=MINT(83)+7 | |
10806 | K(IPU3,1)=1 | |
10807 | K(IPU3,2)=KFRES | |
10808 | K(IPU3,3)=I | |
10809 | P(IPU3,4)=SHUSER | |
10810 | P(IPU3,5)=SHUSER | |
10811 | K(I,1)=21 | |
10812 | K(I,2)=KFRES | |
10813 | P(I,4)=SHUSER | |
10814 | P(I,5)=SHUSER | |
10815 | N=IPU3 | |
10816 | MINT(21)=KFRES | |
10817 | MINT(22)=0 | |
10818 | ||
10819 | C...Special cases: colour flow in coloured resonances | |
10820 | KCRES=PYCOMP(KFRES) | |
10821 | IF(KCHG(KCRES,2).NE.0) THEN | |
10822 | K(IPU3,1)=3 | |
10823 | DO 550 J=1,2 | |
10824 | JC=J | |
10825 | IF(KCS.EQ.-1) JC=3-J | |
10826 | IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= | |
10827 | & MINT(84)+ICOL(KCC,1,JC) | |
10828 | IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= | |
10829 | & MINT(84)+ICOL(KCC,2,JC) | |
10830 | IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)= | |
10831 | & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) | |
10832 | 550 CONTINUE | |
10833 | ELSE | |
10834 | K(IPU1,4)=IPU2 | |
10835 | K(IPU1,5)=IPU2 | |
10836 | K(IPU2,4)=IPU1 | |
10837 | K(IPU2,5)=IPU1 | |
10838 | ENDIF | |
10839 | ||
10840 | ELSEIF(IDOC.EQ.8) THEN | |
10841 | C...2 -> 2 processes: store outgoing partons in their CM-frame | |
10842 | DO 560 JT=1,2 | |
10843 | I=MINT(84)+2+JT | |
10844 | KCA=PYCOMP(MINT(20+JT)) | |
10845 | K(I,1)=1 | |
10846 | IF(KCHG(KCA,2).NE.0) K(I,1)=3 | |
10847 | K(I,2)=MINT(20+JT) | |
10848 | K(I,3)=MINT(83)+IDOC+JT-2 | |
10849 | KFAA=IABS(K(I,2)) | |
10850 | IF(KFPR(ISUBSV,1+MOD(JS+JT,2)).NE.0) THEN | |
10851 | P(I,5)=SQRT(VINT(63+MOD(JS+JT,2))) | |
10852 | ELSE | |
10853 | P(I,5)=PYMASS(K(I,2)) | |
10854 | ENDIF | |
10855 | IF((KFAA.EQ.6.OR.KFAA.EQ.7.OR.KFAA.EQ.8).AND. | |
10856 | & P(I,5).LT.PARP(42)) P(I,5)=PYMASS(K(I,2)) | |
10857 | 560 CONTINUE | |
10858 | IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN | |
10859 | KFA1=IABS(MINT(21)) | |
10860 | KFA2=IABS(MINT(22)) | |
10861 | IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21)) | |
10862 | & THEN | |
10863 | MINT(51)=1 | |
10864 | RETURN | |
10865 | ENDIF | |
10866 | P(IPU3,5)=0D0 | |
10867 | P(IPU4,5)=0D0 | |
10868 | ENDIF | |
10869 | P(IPU3,4)=0.5D0*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR) | |
10870 | P(IPU3,3)=SQRT(MAX(0D0,P(IPU3,4)**2-P(IPU3,5)**2)) | |
10871 | P(IPU4,4)=SHR-P(IPU3,4) | |
10872 | P(IPU4,3)=-P(IPU3,3) | |
10873 | N=IPU4 | |
10874 | MINT(7)=MINT(83)+7 | |
10875 | MINT(8)=MINT(83)+8 | |
10876 | ||
10877 | C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4) | |
10878 | CALL PYROBO(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) | |
10879 | ||
10880 | ELSEIF(IDOC.EQ.9) THEN | |
10881 | C...2 -> 3 processes: store outgoing partons in their CM frame | |
10882 | DO 570 JT=1,2 | |
10883 | I=MINT(84)+2+JT | |
10884 | KCA=PYCOMP(MINT(20+JT)) | |
10885 | K(I,1)=1 | |
10886 | IF(KCHG(KCA,2).NE.0) K(I,1)=3 | |
10887 | K(I,2)=MINT(20+JT) | |
10888 | K(I,3)=MINT(83)+IDOC+JT-3 | |
10889 | IF(IABS(K(I,2)).LE.22) THEN | |
10890 | P(I,5)=PYMASS(K(I,2)) | |
10891 | ELSE | |
10892 | P(I,5)=SQRT(VINT(63+MOD(JS+JT,2))) | |
10893 | ENDIF | |
10894 | PT=SQRT(MAX(0D0,VINT(197+5*JT)-P(I,5)**2+VINT(196+5*JT)**2)) | |
10895 | P(I,1)=PT*COS(VINT(198+5*JT)) | |
10896 | P(I,2)=PT*SIN(VINT(198+5*JT)) | |
10897 | 570 CONTINUE | |
10898 | K(IPU5,1)=1 | |
10899 | K(IPU5,2)=KFRES | |
10900 | K(IPU5,3)=MINT(83)+IDOC | |
10901 | P(IPU5,5)=SHR | |
10902 | P(IPU5,1)=-P(IPU3,1)-P(IPU4,1) | |
10903 | P(IPU5,2)=-P(IPU3,2)-P(IPU4,2) | |
10904 | PMS1=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2 | |
10905 | PMS2=P(IPU4,5)**2+P(IPU4,1)**2+P(IPU4,2)**2 | |
10906 | PMS3=P(IPU5,5)**2+P(IPU5,1)**2+P(IPU5,2)**2 | |
10907 | PMT3=SQRT(PMS3) | |
10908 | P(IPU5,3)=PMT3*SINH(VINT(211)) | |
10909 | P(IPU5,4)=PMT3*COSH(VINT(211)) | |
10910 | PMS12=(SHPR-P(IPU5,4))**2-P(IPU5,3)**2 | |
10911 | SQL12=(PMS12-PMS1-PMS2)**2-4D0*PMS1*PMS2 | |
10912 | IF(SQL12.LE.0D0) THEN | |
10913 | MINT(51)=1 | |
10914 | RETURN | |
10915 | ENDIF | |
10916 | P(IPU3,3)=(-P(IPU5,3)*(PMS12+PMS1-PMS2)+ | |
10917 | & VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2D0*PMS12) | |
10918 | P(IPU4,3)=-P(IPU3,3)-P(IPU5,3) | |
10919 | P(IPU3,4)=SQRT(PMS1+P(IPU3,3)**2) | |
10920 | P(IPU4,4)=SQRT(PMS2+P(IPU4,3)**2) | |
10921 | MINT(23)=KFRES | |
10922 | N=IPU5 | |
10923 | MINT(7)=MINT(83)+7 | |
10924 | MINT(8)=MINT(83)+8 | |
10925 | ||
10926 | ELSEIF(IDOC.EQ.11) THEN | |
10927 | C...Z0 + Z0 -> h0, W+ + W- -> h0: store Higgs and outgoing partons | |
10928 | PHI(1)=PARU(2)*PYR(0) | |
10929 | PHI(2)=PHI(1)-PHIR | |
10930 | DO 580 JT=1,2 | |
10931 | I=MINT(84)+2+JT | |
10932 | K(I,1)=1 | |
10933 | IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3 | |
10934 | K(I,2)=MINT(20+JT) | |
10935 | K(I,3)=MINT(83)+IDOC+JT-2 | |
10936 | P(I,5)=PYMASS(K(I,2)) | |
10937 | IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) THEN | |
10938 | MINT(51)=1 | |
10939 | RETURN | |
10940 | ENDIF | |
10941 | PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2)) | |
10942 | PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2)) | |
10943 | P(I,1)=PTABS*COS(PHI(JT)) | |
10944 | P(I,2)=PTABS*SIN(PHI(JT)) | |
10945 | P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) | |
10946 | P(I,4)=0.5D0*SHPR*Z(JT) | |
10947 | IZW=MINT(83)+6+JT | |
10948 | K(IZW,1)=21 | |
10949 | K(IZW,2)=23 | |
10950 | IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT))) | |
10951 | K(IZW,3)=IZW-2 | |
10952 | P(IZW,1)=-P(I,1) | |
10953 | P(IZW,2)=-P(I,2) | |
10954 | P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) | |
10955 | P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT)) | |
10956 | P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) | |
10957 | 580 CONTINUE | |
10958 | I=MINT(83)+9 | |
10959 | K(IPU5,1)=1 | |
10960 | K(IPU5,2)=KFRES | |
10961 | K(IPU5,3)=I | |
10962 | P(IPU5,5)=SHR | |
10963 | P(IPU5,1)=-P(IPU3,1)-P(IPU4,1) | |
10964 | P(IPU5,2)=-P(IPU3,2)-P(IPU4,2) | |
10965 | P(IPU5,3)=-P(IPU3,3)-P(IPU4,3) | |
10966 | P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4) | |
10967 | K(I,1)=21 | |
10968 | K(I,2)=KFRES | |
10969 | DO 590 J=1,5 | |
10970 | P(I,J)=P(IPU5,J) | |
10971 | 590 CONTINUE | |
10972 | N=IPU5 | |
10973 | MINT(23)=KFRES | |
10974 | ||
10975 | ELSEIF(IDOC.EQ.12) THEN | |
10976 | C...Z0 and W+/- scattering: store bosons and outgoing partons | |
10977 | PHI(1)=PARU(2)*PYR(0) | |
10978 | PHI(2)=PHI(1)-PHIR | |
10979 | JTRAN=INT(1.5D0+PYR(0)) | |
10980 | DO 600 JT=1,2 | |
10981 | I=MINT(84)+2+JT | |
10982 | K(I,1)=1 | |
10983 | IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3 | |
10984 | K(I,2)=MINT(20+JT) | |
10985 | K(I,3)=MINT(83)+IDOC+JT-2 | |
10986 | P(I,5)=PYMASS(K(I,2)) | |
10987 | IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0D0 | |
10988 | PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2)) | |
10989 | PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2)) | |
10990 | P(I,1)=PTABS*COS(PHI(JT)) | |
10991 | P(I,2)=PTABS*SIN(PHI(JT)) | |
10992 | P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) | |
10993 | P(I,4)=0.5D0*SHPR*Z(JT) | |
10994 | IZW=MINT(83)+6+JT | |
10995 | K(IZW,1)=21 | |
10996 | IF(MINT(14+JT).EQ.MINT(20+JT)) THEN | |
10997 | K(IZW,2)=23 | |
10998 | ELSE | |
10999 | K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT))-PYCHGE(MINT(20+JT))) | |
11000 | ENDIF | |
11001 | K(IZW,3)=IZW-2 | |
11002 | P(IZW,1)=-P(I,1) | |
11003 | P(IZW,2)=-P(I,2) | |
11004 | P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) | |
11005 | P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT)) | |
11006 | P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) | |
11007 | IPU=MINT(84)+4+JT | |
11008 | K(IPU,1)=3 | |
11009 | K(IPU,2)=KFPR(ISUB,JT) | |
11010 | IF(ISUB.EQ.72.AND.JT.EQ.JTRAN) K(IPU,2)=-K(IPU,2) | |
11011 | IF(ISUB.EQ.73.OR.ISUB.EQ.77) K(IPU,2)=K(IZW,2) | |
11012 | K(IPU,3)=MINT(83)+8+JT | |
11013 | IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN | |
11014 | P(IPU,5)=PYMASS(K(IPU,2)) | |
11015 | ELSE | |
11016 | P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2))) | |
11017 | ENDIF | |
11018 | MINT(22+JT)=K(IPU,2) | |
11019 | 600 CONTINUE | |
11020 | C...Find rotation and boost for hard scattering subsystem | |
11021 | I1=MINT(83)+7 | |
11022 | I2=MINT(83)+8 | |
11023 | BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4)) | |
11024 | BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4)) | |
11025 | BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4)) | |
11026 | GAMCM=(P(I1,4)+P(I2,4))/SHR | |
11027 | BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3) | |
11028 | PX=P(I1,1)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEXCM | |
11029 | PY=P(I1,2)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEYCM | |
11030 | PZ=P(I1,3)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEZCM | |
11031 | THECM=PYANGL(PZ,SQRT(PX**2+PY**2)) | |
11032 | PHICM=PYANGL(PX,PY) | |
11033 | C...Store hard scattering subsystem. Rotate and boost it | |
11034 | SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4D0*P(IPU5,5)**2* | |
11035 | & P(IPU6,5)**2 | |
11036 | PABS=SQRT(MAX(0D0,SQLAM/(4D0*SH))) | |
11037 | CTHWZ=VINT(23) | |
11038 | STHWZ=SQRT(MAX(0D0,1D0-CTHWZ**2)) | |
11039 | PHIWZ=VINT(24)-PHICM | |
11040 | P(IPU5,1)=PABS*STHWZ*COS(PHIWZ) | |
11041 | P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ) | |
11042 | P(IPU5,3)=PABS*CTHWZ | |
11043 | P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2) | |
11044 | P(IPU6,1)=-P(IPU5,1) | |
11045 | P(IPU6,2)=-P(IPU5,2) | |
11046 | P(IPU6,3)=-P(IPU5,3) | |
11047 | P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2) | |
11048 | CALL PYROBO(IPU5,IPU6,THECM,PHICM,BEXCM,BEYCM,BEZCM) | |
11049 | DO 620 JT=1,2 | |
11050 | I1=MINT(83)+8+JT | |
11051 | I2=MINT(84)+4+JT | |
11052 | K(I1,1)=21 | |
11053 | K(I1,2)=K(I2,2) | |
11054 | DO 610 J=1,5 | |
11055 | P(I1,J)=P(I2,J) | |
11056 | 610 CONTINUE | |
11057 | 620 CONTINUE | |
11058 | N=IPU6 | |
11059 | MINT(7)=MINT(83)+9 | |
11060 | MINT(8)=MINT(83)+10 | |
11061 | ENDIF | |
11062 | ||
11063 | IF(ISET(ISUB).EQ.11) THEN | |
11064 | ELSEIF(IDOC.GE.8) THEN | |
11065 | C...Store colour connection indices | |
11066 | DO 630 J=1,2 | |
11067 | JC=J | |
11068 | IF(KCS.EQ.-1) JC=3-J | |
11069 | IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= | |
11070 | & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC) | |
11071 | IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= | |
11072 | & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC) | |
11073 | IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)= | |
11074 | & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) | |
11075 | IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)= | |
11076 | & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC)) | |
11077 | 630 CONTINUE | |
11078 | ||
11079 | C...Copy outgoing partons to documentation lines | |
11080 | IMAX=2 | |
11081 | IF(IDOC.EQ.9) IMAX=3 | |
11082 | DO 650 I=1,IMAX | |
11083 | I1=MINT(83)+IDOC-IMAX+I | |
11084 | I2=MINT(84)+2+I | |
11085 | K(I1,1)=21 | |
11086 | K(I1,2)=K(I2,2) | |
11087 | IF(IDOC.LE.9) K(I1,3)=0 | |
11088 | IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I | |
11089 | DO 640 J=1,5 | |
11090 | P(I1,J)=P(I2,J) | |
11091 | 640 CONTINUE | |
11092 | 650 CONTINUE | |
11093 | ||
11094 | ELSEIF(IDOC.EQ.9) THEN | |
11095 | C...Store colour connection indices | |
11096 | DO 660 J=1,2 | |
11097 | JC=J | |
11098 | IF(KCS.EQ.-1) JC=3-J | |
11099 | IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= | |
11100 | & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)+ | |
11101 | & MAX(0,MIN(1,ICOL(KCC,1,JC)-2)) | |
11102 | IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= | |
11103 | & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)+ | |
11104 | & MAX(0,MIN(1,ICOL(KCC,2,JC)-2)) | |
11105 | IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)= | |
11106 | & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) | |
11107 | IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU5,1).EQ.3) K(IPU5,J+3)= | |
11108 | & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC)) | |
11109 | 660 CONTINUE | |
11110 | ||
11111 | C...Copy outgoing partons to documentation lines | |
11112 | DO 680 I=1,3 | |
11113 | I1=MINT(83)+IDOC-3+I | |
11114 | I2=MINT(84)+2+I | |
11115 | K(I1,1)=21 | |
11116 | K(I1,2)=K(I2,2) | |
11117 | K(I1,3)=0 | |
11118 | DO 670 J=1,5 | |
11119 | P(I1,J)=P(I2,J) | |
11120 | 670 CONTINUE | |
11121 | 680 CONTINUE | |
11122 | ENDIF | |
11123 | ||
11124 | C...Low-pT events: remove gluons used for string drawing purposes | |
11125 | IF(ISUB.EQ.95) THEN | |
11126 | K(IPU3,1)=K(IPU3,1)+10 | |
11127 | K(IPU4,1)=K(IPU4,1)+10 | |
11128 | DO 690 J=41,66 | |
11129 | VINTSV(J)=VINT(J) | |
11130 | VINT(J)=0D0 | |
11131 | 690 CONTINUE | |
11132 | DO 710 I=MINT(83)+5,MINT(83)+8 | |
11133 | DO 700 J=1,5 | |
11134 | P(I,J)=0D0 | |
11135 | 700 CONTINUE | |
11136 | 710 CONTINUE | |
11137 | ENDIF | |
11138 | ||
11139 | RETURN | |
11140 | END | |
11141 | ||
11142 | C********************************************************************* | |
11143 | ||
11144 | C...PYSSPA | |
11145 | C...Generates spacelike parton showers. | |
11146 | ||
11147 | SUBROUTINE PYSSPA(IPU1,IPU2) | |
11148 | ||
11149 | C...Double precision and integer declarations. | |
11150 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
11151 | IMPLICIT INTEGER(I-N) | |
11152 | INTEGER PYK,PYCHGE,PYCOMP | |
11153 | C...Commonblocks. | |
11154 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
11155 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
11156 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
11157 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
11158 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
11159 | COMMON/PYINT1/MINT(400),VINT(400) | |
11160 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
11161 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
11162 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
11163 | &/PYINT2/,/PYINT3/ | |
11164 | C...Local arrays and data. | |
11165 | DIMENSION KFLS(4),IS(2),XS(2),ZS(2),Q2S(2),TEVCSV(2),TEVESV(2), | |
11166 | &XFS(2,-25:25),XFA(-25:25),XFB(-25:25),XFN(-25:25),WTAPC(-25:25), | |
11167 | &WTAPE(-25:25),WTSF(-25:25),THE2(2),ALAM(2),DQ2(3),DPC(3),DPD(4), | |
11168 | &DPB(4),ROBO(5),MORE(2),KFBEAM(2),Q2MNCS(2),KCFI(2),NFIS(2), | |
11169 | &THEFIS(2,2),ISFI(2),DPHI(2),MCESV(2) | |
11170 | DATA IS/2*0/ | |
11171 | ||
11172 | C...Read out basic information; set global Q^2 scale. | |
11173 | IPUS1=IPU1 | |
11174 | IPUS2=IPU2 | |
11175 | ISUB=MINT(1) | |
11176 | Q2MX=VINT(56) | |
11177 | IF(ISET(ISUB).EQ.2) Q2MX=MIN(VINT(2),PARP(67)*VINT(56)) | |
11178 | FCQ2MX=1D0 | |
11179 | ||
11180 | C...Define which processes ME corrections have been implemented for. | |
11181 | MECOR=0 | |
11182 | IF(MSTP(68).EQ.1) THEN | |
11183 | IF(ISUB.EQ.1.OR.ISUB.EQ.2.OR.ISUB.EQ.141.OR.ISUB.EQ.142.OR. | |
11184 | & ISUB.EQ.144) MECOR=1 | |
11185 | IF(ISUB.EQ.102.OR.ISUB.EQ.152.OR.ISUB.EQ.157) MECOR=2 | |
11186 | ENDIF | |
11187 | ||
11188 | C...Initialize QCD evolution and check phase space. | |
11189 | Q2MNC=PARP(62)**2 | |
11190 | Q2MNCS(1)=Q2MNC | |
11191 | Q2MNCS(2)=Q2MNC | |
11192 | IF(MINT(107).EQ.2.AND.MSTP(66).EQ.2) THEN | |
11193 | Q0S=PARP(15)**2 | |
11194 | PS=VINT(3)**2 | |
11195 | Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* | |
11196 | & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) | |
11197 | Q2INT=SQRT(Q0S*Q2EFF) | |
11198 | Q2MNCS(1)=MAX(Q2MNC,Q2INT) | |
11199 | ELSEIF(MINT(107).EQ.3.AND.MSTP(66).GE.1) THEN | |
11200 | Q2MNCS(1)=MAX(Q2MNC,VINT(283)) | |
11201 | ENDIF | |
11202 | IF(MINT(108).EQ.2.AND.MSTP(66).EQ.2) THEN | |
11203 | Q0S=PARP(15)**2 | |
11204 | PS=VINT(4)**2 | |
11205 | Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* | |
11206 | & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) | |
11207 | Q2INT=SQRT(Q0S*Q2EFF) | |
11208 | Q2MNCS(2)=MAX(Q2MNC,Q2INT) | |
11209 | ELSEIF(MINT(108).EQ.3.AND.MSTP(66).GE.1) THEN | |
11210 | Q2MNCS(2)=MAX(Q2MNC,VINT(284)) | |
11211 | ENDIF | |
11212 | MCEV=0 | |
11213 | ALAMS=PARU(112) | |
11214 | PARU(112)=PARP(61) | |
11215 | FQ2C=1D0 | |
11216 | TCMX=0D0 | |
11217 | IF(MINT(47).GE.2.AND.(MINT(47).LT.5.OR.MSTP(12).GE.1)) THEN | |
11218 | MCEV=1 | |
11219 | IF(MSTP(64).EQ.1) FQ2C=PARP(63) | |
11220 | IF(MSTP(64).EQ.2) FQ2C=PARP(64) | |
11221 | TCMX=LOG(FQ2C*Q2MX/PARP(61)**2) | |
11222 | IF(Q2MX.LT.MAX(Q2MNC,2D0*PARP(61)**2).OR.TCMX.LT.0.2D0) | |
11223 | & MCEV=0 | |
11224 | ENDIF | |
11225 | ||
11226 | C...Initialize QED evolution and check phase space. | |
11227 | MEEV=0 | |
11228 | XEE=1D-10 | |
11229 | SPME=PMAS(11,1)**2 | |
11230 | IF(IABS(MINT(11)).EQ.13.OR.IABS(MINT(12)).EQ.13) | |
11231 | &SPME=PMAS(13,1)**2 | |
11232 | IF(IABS(MINT(11)).EQ.15.OR.IABS(MINT(12)).EQ.15) | |
11233 | &SPME=PMAS(15,1)**2 | |
11234 | Q2MNE=MAX(PARP(68)**2,2D0*SPME) | |
11235 | TEMX=0D0 | |
11236 | FWTE=10D0 | |
11237 | IF(MINT(45).EQ.3.OR.MINT(46).EQ.3) THEN | |
11238 | MEEV=1 | |
11239 | TEMX=LOG(Q2MX/SPME) | |
11240 | IF(Q2MX.LE.Q2MNE.OR.TEMX.LT.0.2D0) MEEV=0 | |
11241 | ENDIF | |
11242 | IF(MSTP(61).GE.2.AND.MCEV.EQ.1.AND.MEEV.EQ.0) THEN | |
11243 | MEEV=2 | |
11244 | TEMX=TCMX | |
11245 | FWTE=1D0 | |
11246 | ENDIF | |
11247 | IF(MCEV.EQ.0.AND.MEEV.EQ.0) RETURN | |
11248 | ||
11249 | C...Loopback point in case of failure to reconstruct kinematics. | |
11250 | NS=N | |
11251 | LOOP=0 | |
11252 | 100 LOOP=LOOP+1 | |
11253 | IF(LOOP.GT.100) THEN | |
11254 | MINT(51)=1 | |
11255 | RETURN | |
11256 | ENDIF | |
11257 | N=NS | |
11258 | ||
11259 | C...Initial values: flavours, momenta, virtualities. | |
11260 | DO 120 JT=1,2 | |
11261 | MORE(JT)=1 | |
11262 | KFBEAM(JT)=MINT(10+JT) | |
11263 | IF(MINT(18+JT).EQ.1)KFBEAM(JT)=22 | |
11264 | KFLS(JT)=MINT(14+JT) | |
11265 | KFLS(JT+2)=KFLS(JT) | |
11266 | XS(JT)=VINT(40+JT) | |
11267 | IF(MINT(18+JT).EQ.1) XS(JT)=VINT(40+JT)/VINT(154+JT) | |
11268 | ZS(JT)=1D0 | |
11269 | Q2S(JT)=FCQ2MX*Q2MX | |
11270 | DQ2(JT)=0D0 | |
11271 | TEVCSV(JT)=TCMX | |
11272 | ALAM(JT)=PARP(61) | |
11273 | THE2(JT)=1D0 | |
11274 | TEVESV(JT)=TEMX | |
11275 | MCESV(JT)=0 | |
11276 | C...Calculate initial parton distribution weights. | |
11277 | MINT(105)=MINT(102+JT) | |
11278 | MINT(109)=MINT(106+JT) | |
11279 | VINT(120)=VINT(2+JT) | |
11280 | C.... ALICE | |
11281 | C.... Store side in MINT(124) | |
11282 | MINT(124) = JT | |
11283 | C.... | |
11284 | IF(XS(JT).LT.1D0-XEE) THEN | |
11285 | IF(MSTP(57).LE.1) THEN | |
11286 | CALL PYPDFU(KFBEAM(JT),XS(JT),Q2S(JT),XFB) | |
11287 | ELSE | |
11288 | CALL PYPDFL(KFBEAM(JT),XS(JT),Q2S(JT),XFB) | |
11289 | ENDIF | |
11290 | ENDIF | |
11291 | DO 110 KFL=-25,25 | |
11292 | XFS(JT,KFL)=XFB(KFL) | |
11293 | 110 CONTINUE | |
11294 | C...Special kinematics check for c/b quarks (that g -> c cbar or | |
11295 | C...b bbar kinematically possible). | |
11296 | KFLCB=IABS(KFLS(JT)) | |
11297 | IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5)) THEN | |
11298 | IF(XS(JT).GT.0.9D0*Q2S(JT)/(PMAS(KFLCB,1)**2+Q2S(JT))) THEN | |
11299 | MINT(51)=1 | |
11300 | RETURN | |
11301 | ENDIF | |
11302 | ENDIF | |
11303 | 120 CONTINUE | |
11304 | DSH=VINT(44) | |
11305 | IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) DSH=VINT(26)*VINT(2) | |
11306 | ||
11307 | C...Find if interference with final state partons. | |
11308 | MFIS=0 | |
11309 | IF(MSTP(67).GE.1.AND.MSTP(67).LE.3) MFIS=MSTP(67) | |
11310 | IF(MFIS.NE.0) THEN | |
11311 | DO 140 I=1,2 | |
11312 | KCFI(I)=0 | |
11313 | KCA=PYCOMP(IABS(KFLS(I))) | |
11314 | IF(KCA.NE.0) KCFI(I)=KCHG(KCA,2)*ISIGN(1,KFLS(I)) | |
11315 | NFIS(I)=0 | |
11316 | IF(KCFI(I).NE.0) THEN | |
11317 | IF(I.EQ.1) IPFS=IPUS1 | |
11318 | IF(I.EQ.2) IPFS=IPUS2 | |
11319 | DO 130 J=1,2 | |
11320 | ICSI=MOD(K(IPFS,3+J),MSTU(5)) | |
11321 | IF(ICSI.GT.0.AND.ICSI.NE.IPUS1.AND.ICSI.NE.IPUS2.AND. | |
11322 | & (KCFI(I).EQ.(-1)**(J+1).OR.KCFI(I).EQ.2)) THEN | |
11323 | NFIS(I)=NFIS(I)+1 | |
11324 | THEFIS(I,NFIS(I))=PYANGL(P(ICSI,3),SQRT(P(ICSI,1)**2+ | |
11325 | & P(ICSI,2)**2)) | |
11326 | IF(I.EQ.2) THEFIS(I,NFIS(I))=PARU(1)-THEFIS(I,NFIS(I)) | |
11327 | ENDIF | |
11328 | 130 CONTINUE | |
11329 | ENDIF | |
11330 | 140 CONTINUE | |
11331 | IF(NFIS(1)+NFIS(2).EQ.0) MFIS=0 | |
11332 | ENDIF | |
11333 | ||
11334 | C...Pick up leg with highest virtuality. | |
11335 | JTOLD=1 | |
11336 | 150 N=N+1 | |
11337 | JT=1 | |
11338 | IF(N.GT.NS+1.AND.Q2S(2).GT.Q2S(1)) JT=2 | |
11339 | IF(N.EQ.NS+2.AND.JT.EQ.JTOLD) JT=3-JT | |
11340 | IF(MORE(JT).EQ.0) JT=3-JT | |
11341 | JTOLD=JT | |
11342 | KFLB=KFLS(JT) | |
11343 | XB=XS(JT) | |
11344 | DO 160 KFL=-25,25 | |
11345 | XFB(KFL)=XFS(JT,KFL) | |
11346 | 160 CONTINUE | |
11347 | DSHR=2D0*SQRT(DSH) | |
11348 | DSHZ=DSH/ZS(JT) | |
11349 | ||
11350 | C...Check if allowed to branch. | |
11351 | MCEV=0 | |
11352 | IF(IABS(KFLB).LE.10.OR.KFLB.EQ.21) THEN | |
11353 | MCEV=1 | |
11354 | XEC=MAX(PARP(65)*DSHR/VINT(2),XB*(1D0/(1D0-PARP(66))-1D0)) | |
11355 | IF(XB.GE.1D0-2D0*XEC) MCEV=0 | |
11356 | ENDIF | |
11357 | MEEV=0 | |
11358 | IF(MINT(44+JT).EQ.3) THEN | |
11359 | MEEV=1 | |
11360 | IF(XB.GE.1D0-2D0*XEE) MEEV=0 | |
11361 | IF((IABS(KFLB).LE.10.OR.KFLB.EQ.21).AND.XB.GE.1D0-2D0*XEC) | |
11362 | & MEEV=0 | |
11363 | C***Currently kill QED shower for resolved photoproduction. | |
11364 | IF(MINT(18+JT).EQ.1) MEEV=0 | |
11365 | C***Currently kill shower for W inside electron. | |
11366 | IF(IABS(KFLB).EQ.24) THEN | |
11367 | MCEV=0 | |
11368 | MEEV=0 | |
11369 | ENDIF | |
11370 | ENDIF | |
11371 | IF(MSTP(61).GE.2.AND.MCEV.EQ.1.AND.MEEV.EQ.0.AND.IABS(KFLB).LE.10) | |
11372 | &MEEV=2 | |
11373 | IF(MCEV.EQ.0.AND.MEEV.EQ.0) THEN | |
11374 | Q2B=0D0 | |
11375 | GOTO 260 | |
11376 | ENDIF | |
11377 | ||
11378 | C...Maximum Q2 with or without Q2 ordering. Effective Lambda and n_f. | |
11379 | Q2B=Q2S(JT) | |
11380 | TEVCB=TEVCSV(JT) | |
11381 | TEVEB=TEVESV(JT) | |
11382 | IF(MSTP(62).LE.1) THEN | |
11383 | IF(ZS(JT).GT.0.99999D0) THEN | |
11384 | Q2B=Q2S(JT) | |
11385 | ELSE | |
11386 | Q2B=0.5D0*(1D0/ZS(JT)+1D0)*Q2S(JT)+0.5D0*(1D0/ZS(JT)-1D0)* | |
11387 | & (Q2S(3-JT)-DSH+SQRT((DSH+Q2S(1)+Q2S(2))**2+ | |
11388 | & 8D0*Q2S(1)*Q2S(2)*ZS(JT)/(1D0-ZS(JT)))) | |
11389 | ENDIF | |
11390 | IF(MCEV.EQ.1) TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) | |
11391 | IF(MEEV.EQ.1) TEVEB=LOG(Q2B/SPME) | |
11392 | ENDIF | |
11393 | IF(MCEV.EQ.1) THEN | |
11394 | ALSDUM=PYALPS(FQ2C*Q2B) | |
11395 | TEVCB=TEVCB+2D0*LOG(ALAM(JT)/PARU(117)) | |
11396 | ALAM(JT)=PARU(117) | |
11397 | B0=(33D0-2D0*MSTU(118))/6D0 | |
11398 | ENDIF | |
11399 | IF(MEEV.EQ.2) TEVEB=TEVCB | |
11400 | TEVCBS=TEVCB | |
11401 | TEVEBS=TEVEB | |
11402 | ||
11403 | C...Select side for interference with final state partons. | |
11404 | IF(MFIS.GE.1.AND.N.LE.NS+2) THEN | |
11405 | IFI=N-NS | |
11406 | ISFI(IFI)=0 | |
11407 | IF(IABS(KCFI(IFI)).EQ.1.AND.NFIS(IFI).EQ.1) THEN | |
11408 | ISFI(IFI)=1 | |
11409 | ELSEIF(KCFI(IFI).EQ.2.AND.NFIS(IFI).EQ.1) THEN | |
11410 | IF(PYR(0).GT.0.5D0) ISFI(IFI)=1 | |
11411 | ELSEIF(KCFI(IFI).EQ.2.AND.NFIS(IFI).EQ.2) THEN | |
11412 | ISFI(IFI)=1 | |
11413 | IF(PYR(0).GT.0.5D0) ISFI(IFI)=2 | |
11414 | ENDIF | |
11415 | ENDIF | |
11416 | ||
11417 | C...Calculate preweighting factor for ME-corrected processes. | |
11418 | IF(MECOR.GE.1) CALL PYMEMX(MECOR,WTFF,WTGF,WTFG,WTGG) | |
11419 | ||
11420 | C...Calculate Altarelli-Parisi weights. | |
11421 | DO 170 KFL=-25,25 | |
11422 | WTAPC(KFL)=0D0 | |
11423 | WTAPE(KFL)=0D0 | |
11424 | WTSF(KFL)=0D0 | |
11425 | 170 CONTINUE | |
11426 | C...q -> q (g or gamma emission), g -> q. | |
11427 | IF(IABS(KFLB).LE.10) THEN | |
11428 | WTAPC(KFLB)=(8D0/3D0)*LOG((1D0-XEC-XB)*(XB+XEC)/(XEC*(1D0-XEC))) | |
11429 | WTAPC(21)=0.5D0*(XB/(XB+XEC)-XB/(1D0-XEC)) | |
11430 | EQ2=1D0/9D0 | |
11431 | IF(MOD(IABS(KFLB),2).EQ.0) EQ2=4D0*EQ2 | |
11432 | IF(MEEV.EQ.2) WTAPE(KFLB)=2.*EQ2*LOG((1D0-XEC-XB)*(XB+XEC)/ | |
11433 | & (XEC*(1D0-XEC))) | |
11434 | IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN | |
11435 | WTAPC(KFLB)=WTFF*WTAPC(KFLB) | |
11436 | WTAPC(21)=WTGF*WTAPC(21) | |
11437 | WTAPE(KFLB)=WTFF*WTAPE(KFLB) | |
11438 | ENDIF | |
11439 | C...f -> f, gamma -> f. | |
11440 | ELSEIF(IABS(KFLB).LE.20) THEN | |
11441 | WTAPF1=LOG((1D0-XEE-XB)*(XB+XEE)/(XEE*(1D0-XEE))) | |
11442 | WTAPF2=LOG((1D0-XEE-XB)*(1D0-XEE)/(XEE*(XB+XEE))) | |
11443 | WTAPE(KFLB)=2D0*(WTAPF1+WTAPF2) | |
11444 | IF(MSTP(12).GE.1) WTAPE(22)=XB/(XB+XEE)-XB/(1D0-XEE) | |
11445 | IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN | |
11446 | WTAPE(KFLB)=WTFF*WTAPE(KFLB) | |
11447 | WTAPE(22)=WTGF*WTAPE(22) | |
11448 | ENDIF | |
11449 | C...f -> g, g -> g. | |
11450 | ELSEIF(KFLB.EQ.21) THEN | |
11451 | WTAPQ=(16D0/3D0)*(SQRT((1D0-XEC)/XB)-SQRT((XB+XEC)/XB)) | |
11452 | DO 180 KFL=1,MSTP(58) | |
11453 | WTAPC(KFL)=WTAPQ | |
11454 | WTAPC(-KFL)=WTAPQ | |
11455 | 180 CONTINUE | |
11456 | WTAPC(21)=6D0*LOG((1D0-XEC-XB)/XEC) | |
11457 | IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN | |
11458 | DO 190 KFL=1,MSTP(58) | |
11459 | WTAPC(KFL)=WTFG*WTAPC(KFL) | |
11460 | WTAPC(-KFL)=WTFG*WTAPC(-KFL) | |
11461 | 190 CONTINUE | |
11462 | WTAPC(21)=WTGG*WTAPC(21) | |
11463 | ENDIF | |
11464 | C...f -> gamma, W+, W-. | |
11465 | ELSEIF(KFLB.EQ.22) THEN | |
11466 | WTAPF=LOG((1D0-XEE-XB)*(1D0-XEE)/(XEE*(XB+XEE)))/XB | |
11467 | WTAPE(11)=WTAPF | |
11468 | WTAPE(-11)=WTAPF | |
11469 | IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN | |
11470 | WTAPE(11)=WTFG*WTAPE(11) | |
11471 | WTAPE(-11)=WTFG*WTAPE(-11) | |
11472 | ENDIF | |
11473 | ELSEIF(KFLB.EQ.24) THEN | |
11474 | WTAPE(-11)=1D0/(4D0*PARU(102))*LOG((1D0-XEE-XB)*(1D0-XEE)/ | |
11475 | & (XEE*(XB+XEE)))/XB | |
11476 | ELSEIF(KFLB.EQ.-24) THEN | |
11477 | WTAPE(11)=1D0/(4D0*PARU(102))*LOG((1D0-XEE-XB)*(1D0-XEE)/ | |
11478 | & (XEE*(XB+XEE)))/XB | |
11479 | ENDIF | |
11480 | ||
11481 | C...Calculate parton distribution weights and sum. | |
11482 | NTRY=0 | |
11483 | 200 NTRY=NTRY+1 | |
11484 | IF(NTRY.GT.500) THEN | |
11485 | MINT(51)=1 | |
11486 | RETURN | |
11487 | ENDIF | |
11488 | WTSUMC=0D0 | |
11489 | WTSUME=0D0 | |
11490 | XFBO=MAX(1D-10,XFB(KFLB)) | |
11491 | DO 210 KFL=-25,25 | |
11492 | WTSF(KFL)=XFB(KFL)/XFBO | |
11493 | WTSUMC=WTSUMC+WTAPC(KFL)*WTSF(KFL) | |
11494 | WTSUME=WTSUME+WTAPE(KFL)*WTSF(KFL) | |
11495 | 210 CONTINUE | |
11496 | WTSUMC=MAX(0.0001D0,WTSUMC) | |
11497 | WTSUME=MAX(0.0001D0/FWTE,WTSUME) | |
11498 | ||
11499 | C...Choose new t: fix alpha_s, alpha_s(Q^2), alpha_s(k_T^2). | |
11500 | NTRY2=0 | |
11501 | 220 NTRY2=NTRY2+1 | |
11502 | IF(NTRY2.GT.500) THEN | |
11503 | MINT(51)=1 | |
11504 | RETURN | |
11505 | ENDIF | |
11506 | IF(MCEV.EQ.1) THEN | |
11507 | IF(MSTP(64).LE.0) THEN | |
11508 | TEVCB=TEVCB+LOG(PYR(0))*PARU(2)/(PARU(111)*WTSUMC) | |
11509 | ELSEIF(MSTP(64).EQ.1) THEN | |
11510 | TEVCB=TEVCB*EXP(MAX(-50D0,LOG(PYR(0))*B0/WTSUMC)) | |
11511 | ELSE | |
11512 | TEVCB=TEVCB*EXP(MAX(-50D0,LOG(PYR(0))*B0/(5D0*WTSUMC))) | |
11513 | ENDIF | |
11514 | ENDIF | |
11515 | IF(MEEV.EQ.1) THEN | |
11516 | TEVEB=TEVEB*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/ | |
11517 | & (PARU(101)*FWTE*WTSUME*TEMX))) | |
11518 | ELSEIF(MEEV.EQ.2) THEN | |
11519 | TEVEB=TEVEB+LOG(PYR(0))*PARU(2)/(PARU(101)*WTSUME) | |
11520 | ENDIF | |
11521 | ||
11522 | C...Translate t into Q2 scale; choose between QCD and QED evolution. | |
11523 | 230 IF(MCEV.EQ.1) Q2CB=ALAM(JT)**2*EXP(MAX(-50D0,TEVCB))/FQ2C | |
11524 | IF(MEEV.EQ.1) Q2EB=SPME*EXP(MAX(-50D0,TEVEB)) | |
11525 | IF(MEEV.EQ.2) Q2EB=ALAM(JT)**2*EXP(MAX(-50D0,TEVEB))/FQ2C | |
11526 | C...Ensure that Q2 is above threshold for charm/bottom. | |
11527 | KFLCB=IABS(KFLB) | |
11528 | IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5).AND. | |
11529 | &MCEV.EQ.1) THEN | |
11530 | IF(Q2CB.LT.PMAS(KFLCB,1)**2) THEN | |
11531 | Q2CB=1.1D0*PMAS(KFLCB,1)**2 | |
11532 | TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) | |
11533 | FCQ2MX=MIN(2D0,1.05D0*FCQ2MX) | |
11534 | ENDIF | |
11535 | ENDIF | |
11536 | IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5).AND. | |
11537 | &MEEV.EQ.2) THEN | |
11538 | IF(Q2EB.LT.PMAS(KFLCB,1)**2) MEEV=0 | |
11539 | ENDIF | |
11540 | MCE=0 | |
11541 | IF(MCEV.EQ.0.AND.MEEV.EQ.0) THEN | |
11542 | ELSEIF(MCEV.EQ.1.AND.MEEV.EQ.0) THEN | |
11543 | IF(Q2CB.GT.Q2MNCS(JT)) MCE=1 | |
11544 | ELSEIF(MCEV.EQ.0.AND.MEEV.EQ.1) THEN | |
11545 | IF(Q2EB.GT.Q2MNE) MCE=2 | |
11546 | ELSEIF(MCEV.EQ.0.AND.MEEV.EQ.2) THEN | |
11547 | IF(Q2EB.GT.Q2MNCS(JT)) MCE=2 | |
11548 | ELSEIF(MCEV.EQ.1.AND.MEEV.EQ.2) THEN | |
11549 | IF(Q2CB.GT.Q2EB.AND.Q2CB.GT.Q2MNCS(JT)) MCE=1 | |
11550 | IF(Q2EB.GT.Q2CB.AND.Q2EB.GT.Q2MNCS(JT)) MCE=2 | |
11551 | ELSEIF(Q2MNCS(JT).GT.Q2MNE) THEN | |
11552 | MCE=1 | |
11553 | IF(Q2EB.GT.Q2CB.OR.Q2CB.LE.Q2MNCS(JT)) MCE=2 | |
11554 | IF(MCE.EQ.2.AND.Q2EB.LE.Q2MNE) MCE=0 | |
11555 | ELSE | |
11556 | MCE=2 | |
11557 | IF(Q2CB.GT.Q2EB.OR.Q2EB.LE.Q2MNE) MCE=1 | |
11558 | IF(MCE.EQ.1.AND.Q2CB.LE.Q2MNCS(JT)) MCE=0 | |
11559 | ENDIF | |
11560 | ||
11561 | C...Evolution possibly ended. Update t values. | |
11562 | IF(MCE.EQ.0) THEN | |
11563 | Q2B=0D0 | |
11564 | GOTO 260 | |
11565 | ELSEIF(MCE.EQ.1) THEN | |
11566 | Q2B=Q2CB | |
11567 | Q2REF=FQ2C*Q2B | |
11568 | IF(MEEV.EQ.1) TEVEB=LOG(Q2B/SPME) | |
11569 | IF(MEEV.EQ.2) TEVEB=LOG(FQ2C*Q2B/ALAM(JT)**2) | |
11570 | ELSE | |
11571 | Q2B=Q2EB | |
11572 | Q2REF=Q2B | |
11573 | IF(MCEV.EQ.1) TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) | |
11574 | ENDIF | |
11575 | ||
11576 | C...Select flavour for branching parton. | |
11577 | IF(MCE.EQ.1) WTRAN=PYR(0)*WTSUMC | |
11578 | IF(MCE.EQ.2) WTRAN=PYR(0)*WTSUME | |
11579 | KFLA=-25 | |
11580 | 240 KFLA=KFLA+1 | |
11581 | IF(MCE.EQ.1) WTRAN=WTRAN-WTAPC(KFLA)*WTSF(KFLA) | |
11582 | IF(MCE.EQ.2) WTRAN=WTRAN-WTAPE(KFLA)*WTSF(KFLA) | |
11583 | IF(KFLA.LE.24.AND.WTRAN.GT.0D0) GOTO 240 | |
11584 | IF(KFLA.EQ.25) THEN | |
11585 | Q2B=0D0 | |
11586 | GOTO 260 | |
11587 | ENDIF | |
11588 | ||
11589 | C...Choose z value and corrective weight. | |
11590 | WTZ=0D0 | |
11591 | C...q -> q + g or q -> q + gamma. | |
11592 | IF(IABS(KFLA).LE.10.AND.IABS(KFLB).LE.10) THEN | |
11593 | Z=1D0-((1D0-XB-XEC)/(1D0-XEC))* | |
11594 | & (XEC*(1D0-XEC)/((XB+XEC)*(1D0-XB-XEC)))**PYR(0) | |
11595 | WTZ=0.5D0*(1D0+Z**2) | |
11596 | C...q -> g + q. | |
11597 | ELSEIF(IABS(KFLA).LE.10.AND.KFLB.EQ.21) THEN | |
11598 | Z=XB/(SQRT(XB+XEC)+PYR(0)*(SQRT(1D0-XEC)-SQRT(XB+XEC)))**2 | |
11599 | WTZ=0.5D0*(1D0+(1D0-Z)**2)*SQRT(Z) | |
11600 | C...f -> f + gamma. | |
11601 | ELSEIF(IABS(KFLA).LE.20.AND.IABS(KFLB).LE.20) THEN | |
11602 | IF(WTAPF1.GT.PYR(0)*(WTAPF1+WTAPF2)) THEN | |
11603 | Z=1D0-((1D0-XB-XEE)/(1D0-XEE))* | |
11604 | & (XEE*(1D0-XEE)/((XB+XEE)*(1D0-XB-XEE)))**PYR(0) | |
11605 | ELSE | |
11606 | Z=XB+XB*(XEE/(1D0-XEE))* | |
11607 | & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) | |
11608 | ENDIF | |
11609 | WTZ=0.5D0*(1D0+Z**2)*(Z-XB)/(1D0-XB) | |
11610 | C...f -> gamma + f. | |
11611 | ELSEIF(IABS(KFLA).LE.20.AND.KFLB.EQ.22) THEN | |
11612 | Z=XB+XB*(XEE/(1D0-XEE))* | |
11613 | & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) | |
11614 | WTZ=0.5D0*(1D0+(1D0-Z)**2)*XB*(Z-XB)/Z | |
11615 | C...f -> W+- + f. | |
11616 | ELSEIF(IABS(KFLA).LE.20.AND.IABS(KFLB).EQ.24) THEN | |
11617 | Z=XB+XB*(XEE/(1D0-XEE))* | |
11618 | & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) | |
11619 | WTZ=0.5D0*(1D0+(1D0-Z)**2)*(XB*(Z-XB)/Z)* | |
11620 | & (Q2B/(Q2B+PMAS(24,1)**2)) | |
11621 | C...g -> q + qbar. | |
11622 | ELSEIF(KFLA.EQ.21.AND.IABS(KFLB).LE.10) THEN | |
11623 | Z=XB/(1D0-XEC)+PYR(0)*(XB/(XB+XEC)-XB/(1D0-XEC)) | |
11624 | WTZ=1D0-2D0*Z*(1D0-Z) | |
11625 | C...g -> g + g. | |
11626 | ELSEIF(KFLA.EQ.21.AND.KFLB.EQ.21) THEN | |
11627 | Z=1D0/(1D0+((1D0-XEC-XB)/XB)*(XEC/(1D0-XEC-XB))**PYR(0)) | |
11628 | WTZ=(1D0-Z*(1D0-Z))**2 | |
11629 | C...gamma -> f + fbar. | |
11630 | ELSEIF(KFLA.EQ.22.AND.IABS(KFLB).LE.20) THEN | |
11631 | Z=XB/(1D0-XEE)+PYR(0)*(XB/(XB+XEE)-XB/(1D0-XEE)) | |
11632 | WTZ=1D0-2D0*Z*(1D0-Z) | |
11633 | ENDIF | |
11634 | IF(MCE.EQ.2.AND.MEEV.EQ.1) WTZ=(WTZ/FWTE)*(TEVEB/TEMX) | |
11635 | ||
11636 | C...Option with resummation of soft gluon emission as effective z shift. | |
11637 | IF(MCE.EQ.1) THEN | |
11638 | IF(MSTP(65).GE.1) THEN | |
11639 | RSOFT=6D0 | |
11640 | IF(KFLB.NE.21) RSOFT=8D0/3D0 | |
11641 | Z=Z*(TEVCB/TEVCSV(JT))**(RSOFT*XEC/((XB+XEC)*B0)) | |
11642 | IF(Z.LE.XB) GOTO 220 | |
11643 | ENDIF | |
11644 | ||
11645 | C...Option with alpha_s(k_T^2): demand k_T^2 > cutoff, reweight. | |
11646 | IF(MSTP(64).GE.2) THEN | |
11647 | IF((1D0-Z)*Q2B.LT.Q2MNCS(JT)) GOTO 220 | |
11648 | ALPRAT=TEVCB/(TEVCB+LOG(1D0-Z)) | |
11649 | IF(ALPRAT.LT.5D0*PYR(0)) GOTO 220 | |
11650 | IF(ALPRAT.GT.5D0) WTZ=WTZ*ALPRAT/5D0 | |
11651 | ENDIF | |
11652 | ENDIF | |
11653 | ||
11654 | C...Remove kinematically impossible branchings. | |
11655 | UHAT=Q2B-DSH*(1D0-Z)/Z | |
11656 | IF(MSTP(68).GE.0.AND.UHAT.GT.0D0) GOTO 220 | |
11657 | ||
11658 | C...Select phi angle of branching at random. | |
11659 | PHIBR=PARU(2)*PYR(0) | |
11660 | ||
11661 | C...Matrix-element corrections for some processes. | |
11662 | IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN | |
11663 | IF(IABS(KFLA).LE.20.AND.IABS(KFLB).LE.20) THEN | |
11664 | CALL PYMEWT(MECOR,1,Q2B,Z,PHIBR,WTME) | |
11665 | WTZ=WTZ*WTME/WTFF | |
11666 | ELSEIF((KFLA.EQ.21.OR.KFLA.EQ.22).AND.IABS(KFLB).LE.20) THEN | |
11667 | CALL PYMEWT(MECOR,2,Q2B,Z,PHIBR,WTME) | |
11668 | WTZ=WTZ*WTME/WTGF | |
11669 | ELSEIF(IABS(KFLA).LE.20.AND.(KFLB.EQ.21.OR.KFLB.EQ.22)) THEN | |
11670 | CALL PYMEWT(MECOR,3,Q2B,Z,PHIBR,WTME) | |
11671 | WTZ=WTZ*WTME/WTFG | |
11672 | ELSEIF(KFLA.EQ.21.AND.KFLB.EQ.21) THEN | |
11673 | CALL PYMEWT(MECOR,4,Q2B,Z,PHIBR,WTME) | |
11674 | WTZ=WTZ*WTME/WTGG | |
11675 | ENDIF | |
11676 | ENDIF | |
11677 | ||
11678 | C...Impose angular constraint in first branching from interference | |
11679 | C...with final state partons. | |
11680 | IF(MCE.EQ.1) THEN | |
11681 | IF(MFIS.GE.1.AND.N.LE.NS+2.AND.NTRY2.LT.200) THEN | |
11682 | THE2D=(4D0*Q2B)/(DSH*(1D0-Z)) | |
11683 | IF(N.EQ.NS+1.AND.ISFI(1).GE.1) THEN | |
11684 | IF(THE2D.GT.THEFIS(1,ISFI(1))**2) GOTO 220 | |
11685 | ELSEIF(N.EQ.NS+2.AND.ISFI(2).GE.1) THEN | |
11686 | IF(THE2D.GT.THEFIS(2,ISFI(2))**2) GOTO 220 | |
11687 | ENDIF | |
11688 | ENDIF | |
11689 | ||
11690 | C...Option with angular ordering requirement. | |
11691 | IF(MSTP(62).GE.3.AND.NTRY2.LT.200) THEN | |
11692 | THE2T=(4D0*Z**2*Q2B)/(4D0*Z**2*Q2B+(1D0-Z)*XB**2*VINT(2)) | |
11693 | IF(THE2T.GT.THE2(JT)) GOTO 220 | |
11694 | ENDIF | |
11695 | ENDIF | |
11696 | ||
11697 | C...Weighting with new parton distributions. | |
11698 | MINT(105)=MINT(102+JT) | |
11699 | MINT(109)=MINT(106+JT) | |
11700 | VINT(120)=VINT(2+JT) | |
11701 | C.... ALICE | |
11702 | C.... Store side in MINT(124) | |
11703 | MINT(124)=JT | |
11704 | C.... | |
11705 | IF(MSTP(57).LE.1) THEN | |
11706 | CALL PYPDFU(KFBEAM(JT),XB,Q2REF,XFN) | |
11707 | ELSE | |
11708 | CALL PYPDFL(KFBEAM(JT),XB,Q2REF,XFN) | |
11709 | ENDIF | |
11710 | XFBN=XFN(KFLB) | |
11711 | IF(XFBN.LT.1D-20) THEN | |
11712 | IF(KFLA.EQ.KFLB) THEN | |
11713 | TEVCB=TEVCBS | |
11714 | TEVEB=TEVEBS | |
11715 | WTAPC(KFLB)=0D0 | |
11716 | WTAPE(KFLB)=0D0 | |
11717 | GOTO 200 | |
11718 | ELSEIF(MCE.EQ.1.AND.TEVCBS-TEVCB.GT.0.2D0) THEN | |
11719 | TEVCB=0.5D0*(TEVCBS+TEVCB) | |
11720 | GOTO 230 | |
11721 | ELSEIF(MCE.EQ.2.AND.TEVEBS-TEVEB.GT.0.2D0) THEN | |
11722 | TEVEB=0.5D0*(TEVEBS+TEVEB) | |
11723 | GOTO 230 | |
11724 | ELSE | |
11725 | XFBN=1D-10 | |
11726 | XFN(KFLB)=XFBN | |
11727 | ENDIF | |
11728 | ENDIF | |
11729 | DO 250 KFL=-25,25 | |
11730 | XFB(KFL)=XFN(KFL) | |
11731 | 250 CONTINUE | |
11732 | XA=XB/Z | |
11733 | C.... ALICE | |
11734 | C.... Store side in MINT(124) | |
11735 | MINT(124) = JT | |
11736 | C.... | |
11737 | IF(MSTP(57).LE.1) THEN | |
11738 | CALL PYPDFU(KFBEAM(JT),XA,Q2REF,XFA) | |
11739 | ELSE | |
11740 | CALL PYPDFL(KFBEAM(JT),XA,Q2REF,XFA) | |
11741 | ENDIF | |
11742 | XFAN=XFA(KFLA) | |
11743 | IF(XFAN.LT.1D-20) GOTO 200 | |
11744 | WTSFA=WTSF(KFLA) | |
11745 | IF(WTZ*XFAN/XFBN.LT.PYR(0)*WTSFA) GOTO 200 | |
11746 | ||
11747 | C...Define two hard scatterers in their CM-frame. | |
11748 | 260 IF(N.EQ.NS+2) THEN | |
11749 | DQ2(JT)=Q2B | |
11750 | DPLCM=SQRT((DSH+DQ2(1)+DQ2(2))**2-4D0*DQ2(1)*DQ2(2))/DSHR | |
11751 | DO 280 JR=1,2 | |
11752 | I=NS+JR | |
11753 | IF(JR.EQ.1) IPO=IPUS1 | |
11754 | IF(JR.EQ.2) IPO=IPUS2 | |
11755 | DO 270 J=1,5 | |
11756 | K(I,J)=0 | |
11757 | P(I,J)=0D0 | |
11758 | V(I,J)=0D0 | |
11759 | 270 CONTINUE | |
11760 | K(I,1)=14 | |
11761 | K(I,2)=KFLS(JR+2) | |
11762 | K(I,4)=IPO | |
11763 | K(I,5)=IPO | |
11764 | P(I,3)=DPLCM*(-1)**(JR+1) | |
11765 | P(I,4)=(DSH+DQ2(3-JR)-DQ2(JR))/DSHR | |
11766 | P(I,5)=-SQRT(DQ2(JR)) | |
11767 | K(IPO,1)=14 | |
11768 | K(IPO,3)=I | |
11769 | K(IPO,4)=MOD(K(IPO,4),MSTU(5))+MSTU(5)*I | |
11770 | K(IPO,5)=MOD(K(IPO,5),MSTU(5))+MSTU(5)*I | |
11771 | 280 CONTINUE | |
11772 | ||
11773 | C...Find maximum allowed mass of timelike parton. | |
11774 | ELSEIF(N.GT.NS+2) THEN | |
11775 | JR=3-JT | |
11776 | DQ2(3)=Q2B | |
11777 | DPC(1)=P(IS(1),4) | |
11778 | DPC(2)=P(IS(2),4) | |
11779 | DPC(3)=0.5D0*(ABS(P(IS(1),3))+ABS(P(IS(2),3))) | |
11780 | DPD(1)=DSH+DQ2(JR)+DQ2(JT) | |
11781 | DPD(2)=DSHZ+DQ2(JR)+DQ2(3) | |
11782 | DPD(3)=SQRT(DPD(1)**2-4D0*DQ2(JR)*DQ2(JT)) | |
11783 | DPD(4)=SQRT(DPD(2)**2-4D0*DQ2(JR)*DQ2(3)) | |
11784 | IKIN=0 | |
11785 | IF(Q2S(JR).GE.0.25D0*Q2MNC.AND.DPD(1)-DPD(3).GE. | |
11786 | & 1D-10*DPD(1)) IKIN=1 | |
11787 | IF(IKIN.EQ.0) DMSMA=(DQ2(JT)/ZS(JT)-DQ2(3))* | |
11788 | & (DSH/(DSH+DQ2(JT))-DSH/(DSHZ+DQ2(3))) | |
11789 | IF(IKIN.EQ.1) DMSMA=(DPD(1)*DPD(2)-DPD(3)*DPD(4))/ | |
11790 | & (2D0*DQ2(JR))-DQ2(JT)-DQ2(3) | |
11791 | ||
11792 | C...Generate timelike parton shower (if required). | |
11793 | IT=N | |
11794 | DO 290 J=1,5 | |
11795 | K(IT,J)=0 | |
11796 | P(IT,J)=0D0 | |
11797 | V(IT,J)=0D0 | |
11798 | 290 CONTINUE | |
11799 | C...f -> f + g (gamma). | |
11800 | IF(IABS(KFLB).LE.20.AND.IABS(KFLS(JT+2)).LE.20) THEN | |
11801 | K(IT,2)=21 | |
11802 | IF(MCESV(JT).EQ.2.OR.IABS(KFLB).GE.11) K(IT,2)=22 | |
11803 | C...f -> g (gamma, W+-) + f. | |
11804 | ELSEIF(IABS(KFLB).LE.20.AND.IABS(KFLS(JT+2)).GT.20) THEN | |
11805 | K(IT,2)=KFLB | |
11806 | IF(KFLS(JT+2).EQ.24) THEN | |
11807 | K(IT,2)=-12 | |
11808 | ELSEIF(KFLS(JT+2).EQ.-24) THEN | |
11809 | K(IT,2)=12 | |
11810 | ENDIF | |
11811 | C...g (gamma) -> f + fbar, g + g. | |
11812 | ELSE | |
11813 | K(IT,2)=-KFLS(JT+2) | |
11814 | IF(KFLS(JT+2).GT.20) K(IT,2)=KFLS(JT+2) | |
11815 | ENDIF | |
11816 | K(IT,1)=3 | |
11817 | IF((IABS(K(IT,2)).GE.11.AND.IABS(K(IT,2)).LE.18).OR. | |
11818 | & IABS(K(IT,2)).EQ.22) K(IT,1)=1 | |
11819 | P(IT,5)=PYMASS(K(IT,2)) | |
11820 | IF(DMSMA.LE.P(IT,5)**2) GOTO 100 | |
11821 | IF(MSTP(63).GE.1.AND.MCESV(JT).EQ.1) THEN | |
11822 | MSTJ48=MSTJ(48) | |
11823 | PARJ85=PARJ(85) | |
11824 | P(IT,4)=(DSHZ-DSH-P(IT,5)**2)/DSHR | |
11825 | P(IT,3)=SQRT(P(IT,4)**2-P(IT,5)**2) | |
11826 | IF(MSTP(63).EQ.1) THEN | |
11827 | Q2TIM=DMSMA | |
11828 | ELSEIF(MSTP(63).EQ.2) THEN | |
11829 | Q2TIM=MIN(DMSMA,PARP(71)*Q2S(JT)) | |
11830 | ELSE | |
11831 | Q2TIM=DMSMA | |
11832 | MSTJ(48)=1 | |
11833 | IF(IKIN.EQ.0) DPT2=DMSMA*(DSHZ+DQ2(3))/(DSH+DQ2(JT)) | |
11834 | IF(IKIN.EQ.1) DPT2=DMSMA*(0.5D0*DPD(1)*DPD(2)+0.5D0*DPD(3)* | |
11835 | & DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)))/(4D0*DSH*DPC(3)**2) | |
11836 | PARJ(85)=SQRT(MAX(0D0,DPT2))* | |
11837 | & (1D0/P(IT,4)+1D0/P(IS(JT),4)) | |
11838 | ENDIF | |
11839 | CALL PYSHOW(IT,0,SQRT(Q2TIM)) | |
11840 | MSTJ(48)=MSTJ48 | |
11841 | PARJ(85)=PARJ85 | |
11842 | IF(N.GE.IT+1) P(IT,5)=P(IT+1,5) | |
11843 | ENDIF | |
11844 | ||
11845 | C...Reconstruct kinematics of branching: timelike parton shower. | |
11846 | DMS=P(IT,5)**2 | |
11847 | IF(IKIN.EQ.0) DPT2=(DMSMA-DMS)*(DSHZ+DQ2(3))/(DSH+DQ2(JT)) | |
11848 | IF(IKIN.EQ.1) DPT2=(DMSMA-DMS)*(0.5D0*DPD(1)*DPD(2)+ | |
11849 | & 0.5D0*DPD(3)*DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)+DMS))/ | |
11850 | & (4D0*DSH*DPC(3)**2) | |
11851 | IF(DPT2.LT.0D0) GOTO 100 | |
11852 | DPB(1)=(0.5D0*DPD(2)-DPC(JR)*(DSHZ+DQ2(JR)-DQ2(JT)-DMS)/ | |
11853 | & DSHR)/DPC(3)-DPC(3) | |
11854 | P(IT,1)=SQRT(DPT2) | |
11855 | P(IT,3)=DPB(1)*(-1)**(JT+1) | |
11856 | P(IT,4)=SQRT(DPT2+DPB(1)**2+DMS) | |
11857 | IF(N.GE.IT+1) THEN | |
11858 | DPB(1)=SQRT(DPB(1)**2+DPT2) | |
11859 | DPB(2)=SQRT(DPB(1)**2+DMS) | |
11860 | DPB(3)=P(IT+1,3) | |
11861 | DPB(4)=SQRT(DPB(3)**2+DMS) | |
11862 | DBEZ=(DPB(4)*DPB(1)-DPB(3)*DPB(2))/(DPB(4)*DPB(2)-DPB(3)* | |
11863 | & DPB(1)) | |
11864 | CALL PYROBO(IT+1,N,0D0,0D0,0D0,0D0,DBEZ) | |
11865 | THE=PYANGL(P(IT,3),P(IT,1)) | |
11866 | CALL PYROBO(IT+1,N,THE,0D0,0D0,0D0,0D0) | |
11867 | ENDIF | |
11868 | ||
11869 | C...Reconstruct kinematics of branching: spacelike parton. | |
11870 | DO 300 J=1,5 | |
11871 | K(N+1,J)=0 | |
11872 | P(N+1,J)=0D0 | |
11873 | V(N+1,J)=0D0 | |
11874 | 300 CONTINUE | |
11875 | K(N+1,1)=14 | |
11876 | K(N+1,2)=KFLB | |
11877 | P(N+1,1)=P(IT,1) | |
11878 | P(N+1,3)=P(IT,3)+P(IS(JT),3) | |
11879 | P(N+1,4)=P(IT,4)+P(IS(JT),4) | |
11880 | P(N+1,5)=-SQRT(DQ2(3)) | |
11881 | ||
11882 | C...Define colour flow of branching. | |
11883 | K(IS(JT),3)=N+1 | |
11884 | K(IT,3)=N+1 | |
11885 | IM1=N+1 | |
11886 | IM2=N+1 | |
11887 | C...f -> f + gamma (Z, W). | |
11888 | IF(IABS(K(IT,2)).GE.22) THEN | |
11889 | K(IT,1)=1 | |
11890 | ID1=IS(JT) | |
11891 | ID2=IS(JT) | |
11892 | C...f -> gamma (Z, W) + f. | |
11893 | ELSEIF(IABS(K(IS(JT),2)).GE.22) THEN | |
11894 | ID1=IT | |
11895 | ID2=IT | |
11896 | C...gamma -> q + qbar, g + g. | |
11897 | ELSEIF(K(N+1,2).EQ.22) THEN | |
11898 | ID1=IS(JT) | |
11899 | ID2=IT | |
11900 | IM1=ID2 | |
11901 | IM2=ID1 | |
11902 | C...q -> q + g. | |
11903 | ELSEIF(K(N+1,2).GT.0.AND.K(N+1,2).NE.21.AND.K(IT,2).EQ.21) THEN | |
11904 | ID1=IT | |
11905 | ID2=IS(JT) | |
11906 | C...q -> g + q. | |
11907 | ELSEIF(K(N+1,2).GT.0.AND.K(N+1,2).NE.21) THEN | |
11908 | ID1=IS(JT) | |
11909 | ID2=IT | |
11910 | C...qbar -> qbar + g. | |
11911 | ELSEIF(K(N+1,2).LT.0.AND.K(IT,2).EQ.21) THEN | |
11912 | ID1=IS(JT) | |
11913 | ID2=IT | |
11914 | C...qbar -> g + qbar. | |
11915 | ELSEIF(K(N+1,2).LT.0) THEN | |
11916 | ID1=IT | |
11917 | ID2=IS(JT) | |
11918 | C...g -> g + g; g -> q + qbar. | |
11919 | ELSEIF((K(IT,2).EQ.21.AND.PYR(0).GT.0.5D0).OR.K(IT,2).LT.0) THEN | |
11920 | ID1=IS(JT) | |
11921 | ID2=IT | |
11922 | ELSE | |
11923 | ID1=IT | |
11924 | ID2=IS(JT) | |
11925 | ENDIF | |
11926 | IF(IM1.EQ.N+1) K(IM1,4)=K(IM1,4)+ID1 | |
11927 | IF(IM2.EQ.N+1) K(IM2,5)=K(IM2,5)+ID2 | |
11928 | K(ID1,4)=K(ID1,4)+MSTU(5)*IM1 | |
11929 | K(ID2,5)=K(ID2,5)+MSTU(5)*IM2 | |
11930 | IF(ID1.NE.ID2) THEN | |
11931 | K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 | |
11932 | K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 | |
11933 | ENDIF | |
11934 | N=N+1 | |
11935 | IF(K(IT,1).EQ.1) THEN | |
11936 | K(IT,4)=0 | |
11937 | K(IT,5)=0 | |
11938 | ENDIF | |
11939 | ||
11940 | C...Boost to new CM-frame. | |
11941 | DBSVX=(P(N,1)+P(IS(JR),1))/(P(N,4)+P(IS(JR),4)) | |
11942 | DBSVZ=(P(N,3)+P(IS(JR),3))/(P(N,4)+P(IS(JR),4)) | |
11943 | IF(DBSVX**2+DBSVZ**2.GE.1D0) GOTO 100 | |
11944 | CALL PYROBO(NS+1,N,0D0,0D0,-DBSVX,0D0,-DBSVZ) | |
11945 | IR=N+(JT-1)*(IS(1)-N) | |
11946 | CALL PYROBO(NS+1,N,-PYANGL(P(IR,3),P(IR,1)),DPHI(JT), | |
11947 | & 0D0,0D0,0D0) | |
11948 | ENDIF | |
11949 | ||
11950 | C...Update kinematics variables. | |
11951 | IS(JT)=N | |
11952 | DQ2(JT)=Q2B | |
11953 | IF(MSTP(62).GE.3.AND.NTRY2.LT.200) THE2(JT)=THE2T | |
11954 | DSH=DSHZ | |
11955 | ||
11956 | C...Save quantities; loop back. | |
11957 | Q2S(JT)=Q2B | |
11958 | DPHI(JT)=PHIBR | |
11959 | MCESV(JT)=MCE | |
11960 | IF((MCEV.EQ.1.AND.Q2B.GE.0.25D0*Q2MNC).OR. | |
11961 | &(MEEV.EQ.1.AND.Q2B.GE.Q2MNE)) THEN | |
11962 | KFLS(JT+2)=KFLS(JT) | |
11963 | KFLS(JT)=KFLA | |
11964 | XS(JT)=XA | |
11965 | ZS(JT)=Z | |
11966 | DO 310 KFL=-25,25 | |
11967 | XFS(JT,KFL)=XFA(KFL) | |
11968 | 310 CONTINUE | |
11969 | TEVCSV(JT)=TEVCB | |
11970 | TEVESV(JT)=TEVEB | |
11971 | ELSE | |
11972 | MORE(JT)=0 | |
11973 | IF(JT.EQ.1) IPU1=N | |
11974 | IF(JT.EQ.2) IPU2=N | |
11975 | ENDIF | |
11976 | IF(N.GT.MSTU(4)-MSTU(32)-10) THEN | |
11977 | CALL PYERRM(11,'(PYSSPA:) no more memory left in PYJETS') | |
11978 | IF(MSTU(21).GE.1) N=NS | |
11979 | IF(MSTU(21).GE.1) RETURN | |
11980 | ENDIF | |
11981 | IF(MORE(1).EQ.1.OR.MORE(2).EQ.1) GOTO 150 | |
11982 | ||
11983 | C...Boost hard scattering partons to frame of shower initiators. | |
11984 | DO 320 J=1,3 | |
11985 | ROBO(J+2)=(P(NS+1,J)+P(NS+2,J))/(P(NS+1,4)+P(NS+2,4)) | |
11986 | 320 CONTINUE | |
11987 | K(N+2,1)=1 | |
11988 | DO 330 J=1,5 | |
11989 | P(N+2,J)=P(NS+1,J) | |
11990 | 330 CONTINUE | |
11991 | CALL PYROBO(N+2,N+2,0D0,0D0,-ROBO(3),-ROBO(4),-ROBO(5)) | |
11992 | ROBO(2)=PYANGL(P(N+2,1),P(N+2,2)) | |
11993 | ROBO(1)=PYANGL(P(N+2,3),SQRT(P(N+2,1)**2+P(N+2,2)**2)) | |
11994 | CALL PYROBO(MINT(83)+5,NS,0D0,-ROBO(2),0D0,0D0,0D0) | |
11995 | CALL PYROBO(MINT(83)+5,NS,ROBO(1),ROBO(2),ROBO(3),ROBO(4), | |
11996 | &ROBO(5)) | |
11997 | ||
11998 | C...Store user information. Reset Lambda value. | |
11999 | K(IPU1,3)=MINT(83)+3 | |
12000 | K(IPU2,3)=MINT(83)+4 | |
12001 | DO 340 JT=1,2 | |
12002 | MINT(12+JT)=KFLS(JT) | |
12003 | VINT(140+JT)=XS(JT) | |
12004 | IF(MINT(18+JT).EQ.1) VINT(140+JT)=VINT(154+JT)*XS(JT) | |
12005 | 340 CONTINUE | |
12006 | PARU(112)=ALAMS | |
12007 | ||
12008 | RETURN | |
12009 | END | |
12010 | ||
12011 | C********************************************************************* | |
12012 | ||
12013 | C...PYMEMX | |
12014 | C...Generates maximum ME weight in some initial-state showers. | |
12015 | C...Inparameter MECOR: kind of hard scattering process | |
12016 | C...Outparameter WTFF: maximum weight for fermion -> fermion | |
12017 | C... WTGF: maximum weight for gluon/photon -> fermion | |
12018 | C... WTFG: maximum weight for fermion -> gluon/photon | |
12019 | C... WTGG: maximum weight for gluon -> gluon | |
12020 | ||
12021 | SUBROUTINE PYMEMX(MECOR,WTFF,WTGF,WTFG,WTGG) | |
12022 | ||
12023 | C...Double precision and integer declarations. | |
12024 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
12025 | IMPLICIT INTEGER(I-N) | |
12026 | INTEGER PYK,PYCHGE,PYCOMP | |
12027 | C...Commonblocks. | |
12028 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
12029 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
12030 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
12031 | COMMON/PYINT1/MINT(400),VINT(400) | |
12032 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
12033 | SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/,/PYINT2/ | |
12034 | ||
12035 | C...Default maximum weight. | |
12036 | WTFF=1D0 | |
12037 | WTGF=1D0 | |
12038 | WTFG=1D0 | |
12039 | WTGG=1D0 | |
12040 | ||
12041 | C...Select maximum weight by process. | |
12042 | IF(MECOR.EQ.1) THEN | |
12043 | WTFF=1D0 | |
12044 | WTGF=3D0 | |
12045 | ELSEIF(MECOR.EQ.2) THEN | |
12046 | WTFG=1D0 | |
12047 | WTGG=1D0 | |
12048 | ENDIF | |
12049 | ||
12050 | RETURN | |
12051 | END | |
12052 | ||
12053 | C********************************************************************* | |
12054 | ||
12055 | C...PYMEWT | |
12056 | C...Calculates actual ME weight in some initial-state showers. | |
12057 | C...Inparameter MECOR: kind of hard scattering process | |
12058 | C... IFLCB: flavour combination of branching, | |
12059 | C... 1 for fermion -> fermion, | |
12060 | C... 2 for gluon/photon -> fermion | |
12061 | C... 3 for fermion -> gluon/photon, | |
12062 | C... 4 for gluon -> gluon | |
12063 | C... Q2: Q2 value of shower branching | |
12064 | C... Z: Z value of branching | |
12065 | C...In+outparameter PHIBR: azimuthal angle of branching | |
12066 | C...Outparameter WTME: actual ME weight | |
12067 | ||
12068 | SUBROUTINE PYMEWT(MECOR,IFLCB,Q2,Z,PHIBR,WTME) | |
12069 | ||
12070 | C...Double precision and integer declarations. | |
12071 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
12072 | IMPLICIT INTEGER(I-N) | |
12073 | INTEGER PYK,PYCHGE,PYCOMP | |
12074 | C...Commonblocks. | |
12075 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
12076 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
12077 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
12078 | COMMON/PYINT1/MINT(400),VINT(400) | |
12079 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
12080 | SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/,/PYINT2/ | |
12081 | ||
12082 | C...Default output. | |
12083 | WTME=1D0 | |
12084 | ||
12085 | C...Define kinematics of shower branching in Mandelstam variables. | |
12086 | SQM=VINT(44) | |
12087 | SH=SQM/Z | |
12088 | TH=-Q2 | |
12089 | UH=Q2-SQM*(1D0-Z)/Z | |
12090 | ||
12091 | C...Matrix-element corrections for f + fbar -> s-channel vector boson. | |
12092 | IF(MECOR.EQ.1) THEN | |
12093 | IF(IFLCB.EQ.1) THEN | |
12094 | WTME=(TH**2+UH**2+2D0*SQM*SH)/(SH**2+SQM**2) | |
12095 | ELSEIF(IFLCB.EQ.2) THEN | |
12096 | WTME=(SH**2+UH**2+2D0*SQM*TH)/((SH-SQM)**2+SQM**2) | |
12097 | ENDIF | |
12098 | ||
12099 | C...Matrix-element corrections for g + g -> Higgs (h0, H0, A0). | |
12100 | ELSEIF(MECOR.EQ.2) THEN | |
12101 | IF(IFLCB.EQ.3) THEN | |
12102 | WTME=(SH**2+UH**2)/(SH**2+(SH-SQM)**2) | |
12103 | ELSEIF(IFLCB.EQ.4) THEN | |
12104 | WTME=0.5D0*(SH**4+UH**4+TH**4+SQM**4)/(SH**2-SQM*(SH-SQM))**2 | |
12105 | ENDIF | |
12106 | ENDIF | |
12107 | ||
12108 | RETURN | |
12109 | END | |
12110 | ||
12111 | C********************************************************************* | |
12112 | ||
12113 | C...PYADSH | |
12114 | C...Administers the generation of successive final-state showers | |
12115 | C...in external processes. | |
12116 | ||
12117 | SUBROUTINE PYADSH(NFIN) | |
12118 | ||
12119 | C...Double precision and integer declarations. | |
12120 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
12121 | IMPLICIT INTEGER(I-N) | |
12122 | INTEGER PYK,PYCHGE,PYCOMP | |
12123 | C...Commonblocks. | |
12124 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
12125 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
12126 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
12127 | COMMON/PYINT1/MINT(400),VINT(400) | |
12128 | SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ | |
12129 | C...Local array. | |
12130 | DIMENSION IBEG(100),KSAV(10,5),IORD(10),PSUM(4),BETA(3) | |
12131 | ||
12132 | C...Set primary vertex. | |
12133 | DO 100 J=1,5 | |
12134 | V(MINT(83)+5,J)=0D0 | |
12135 | V(MINT(83)+6,J)=0D0 | |
12136 | V(MINT(84)+1,J)=0D0 | |
12137 | V(MINT(84)+2,J)=0D0 | |
12138 | 100 CONTINUE | |
12139 | ||
12140 | C...Isolate systems of particles with the same mother. | |
12141 | NSYS=0 | |
12142 | IMS=-1 | |
12143 | DO 140 I=MINT(84)+3,NFIN | |
12144 | IM=K(I,3) | |
12145 | IF(IM.GT.0.AND.IM.LE.MINT(84)) IM=K(IM,3) | |
12146 | IF(IM.NE.IMS) THEN | |
12147 | NSYS=NSYS+1 | |
12148 | IBEG(NSYS)=I | |
12149 | IMS=IM | |
12150 | ENDIF | |
12151 | ||
12152 | C...Set production vertices. | |
12153 | IF(IM.LE.MINT(83)+6.OR.(IM.GT.MINT(84).AND.IM.LE.MINT(84)+2)) | |
12154 | & THEN | |
12155 | DO 110 J=1,4 | |
12156 | V(I,J)=0D0 | |
12157 | 110 CONTINUE | |
12158 | ELSE | |
12159 | DO 120 J=1,4 | |
12160 | V(I,J)=V(IM,J)+V(IM,5)*P(IM,J)/P(IM,5) | |
12161 | 120 CONTINUE | |
12162 | ENDIF | |
12163 | IF(MSTP(125).GE.1) THEN | |
12164 | IDOC=I-MSTP(126)+4 | |
12165 | DO 130 J=1,5 | |
12166 | V(IDOC,J)=V(I,J) | |
12167 | 130 CONTINUE | |
12168 | ENDIF | |
12169 | 140 CONTINUE | |
12170 | ||
12171 | C...End loop over systems. Return if no showers to be performed. | |
12172 | IBEG(NSYS+1)=NFIN+1 | |
12173 | IF(MSTP(71).LE.0) RETURN | |
12174 | ||
12175 | C...Loop through systems of particles; check that sensible size. | |
12176 | DO 260 ISYS=1,NSYS | |
12177 | NSIZ=IBEG(ISYS+1)-IBEG(ISYS) | |
12178 | IF(NSIZ.EQ.1.AND.ISYS.EQ.1) THEN | |
12179 | ELSEIF(NSIZ.LE.1) THEN | |
12180 | CALL PYERRM(2,'(PYADSH:) only one particle in system') | |
12181 | ELSEIF(NSIZ.GT.7) THEN | |
12182 | CALL PYERRM(2,'(PYADSH:) more than seven particles in system') | |
12183 | ELSE | |
12184 | ||
12185 | C...Save status codes and daughters of showering pair; reset them. | |
12186 | DO 150 J=1,4 | |
12187 | PSUM(J)=0D0 | |
12188 | 150 CONTINUE | |
12189 | DO 170 II=1,NSIZ | |
12190 | I=IBEG(ISYS)-1+II | |
12191 | KSAV(II,1)=K(I,1) | |
12192 | IF(K(I,1).GT.10) THEN | |
12193 | K(I,1)=1 | |
12194 | IF(KSAV(II,1).EQ.14) K(I,1)=3 | |
12195 | ENDIF | |
12196 | IF(KSAV(II,1).LE.10) THEN | |
12197 | ELSEIF(K(I,1).EQ.1) THEN | |
12198 | KSAV(II,4)=K(I,4) | |
12199 | KSAV(II,5)=K(I,5) | |
12200 | K(I,4)=0 | |
12201 | K(I,5)=0 | |
12202 | ELSE | |
12203 | KSAV(II,4)=MOD(K(I,4),MSTU(5)) | |
12204 | KSAV(II,5)=MOD(K(I,5),MSTU(5)) | |
12205 | K(I,4)=K(I,4)-KSAV(II,4) | |
12206 | K(I,5)=K(I,5)-KSAV(II,5) | |
12207 | ENDIF | |
12208 | DO 160 J=1,4 | |
12209 | PSUM(J)=PSUM(J)+P(I,J) | |
12210 | 160 CONTINUE | |
12211 | 170 CONTINUE | |
12212 | ||
12213 | C...Perform shower. | |
12214 | QMAX=SQRT(MAX(0D0,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2- | |
12215 | & PSUM(3)**2)) | |
12216 | IF(ISYS.EQ.1) QMAX=MIN(QMAX,SQRT(PARP(71))*VINT(55)) | |
12217 | NSAV=N | |
12218 | IF(NSIZ.EQ.2) THEN | |
12219 | CALL PYSHOW(IBEG(ISYS),IBEG(ISYS)+1,QMAX) | |
12220 | ELSE | |
12221 | CALL PYSHOW(IBEG(ISYS),-NSIZ,QMAX) | |
12222 | ENDIF | |
12223 | ||
12224 | C...Look up showered copies of original showering particles. | |
12225 | DO 250 II=1,NSIZ | |
12226 | I=IBEG(ISYS)-1+II | |
12227 | IMV=I | |
12228 | IF(N.EQ.NSAV.OR.K(I,1).LE.10) THEN | |
12229 | ELSEIF(K(I,1).EQ.11) THEN | |
12230 | 180 IMV=MOD(K(IMV,4),MSTU(5)) | |
12231 | IF(K(IMV,1).EQ.11) GOTO 180 | |
12232 | ELSE | |
12233 | KDA1=MOD(K(I,4),MSTU(5)) | |
12234 | KDA2=MOD(K(I,5),MSTU(5)) | |
12235 | DO 190 I3=I+1,N | |
12236 | IF(K(I3,2).EQ.K(I,2).AND.(I3.EQ.KDA1.OR.I3.EQ.KDA2)) | |
12237 | & THEN | |
12238 | IMV=I3 | |
12239 | KDA1=MOD(K(I3,4),MSTU(5)) | |
12240 | KDA2=MOD(K(I3,5),MSTU(5)) | |
12241 | ENDIF | |
12242 | 190 CONTINUE | |
12243 | ENDIF | |
12244 | ||
12245 | C...Restore daughter info of original partons to showered copies. | |
12246 | IF(KSAV(II,1).GT.10) K(IMV,1)=KSAV(II,1) | |
12247 | IF(KSAV(II,1).LE.10) THEN | |
12248 | ELSEIF(K(I,1).EQ.1) THEN | |
12249 | K(IMV,4)=KSAV(II,4) | |
12250 | K(IMV,5)=KSAV(II,5) | |
12251 | ELSE | |
12252 | K(IMV,4)=K(IMV,4)+KSAV(II,4) | |
12253 | K(IMV,5)=K(IMV,5)+KSAV(II,5) | |
12254 | ENDIF | |
12255 | ||
12256 | C...Reset mother info of existing daughters to showered copies. | |
12257 | DO 200 I3=IBEG(ISYS+1),NFIN | |
12258 | IF(K(I3,3).EQ.I) K(I3,3)=IMV | |
12259 | IF(K(I3,1).EQ.3.OR.K(I3,1).EQ.14) THEN | |
12260 | IF(K(I3,4)/MSTU(5).EQ.I) K(I3,4)=K(I3,4)+MSTU(5)*(IMV-I) | |
12261 | IF(K(I3,5)/MSTU(5).EQ.I) K(I3,5)=K(I3,5)+MSTU(5)*(IMV-I) | |
12262 | ENDIF | |
12263 | 200 CONTINUE | |
12264 | ||
12265 | C...Boost all original daughters to new frame of showered copy. | |
12266 | IF(IMV.NE.I) THEN | |
12267 | DO 210 J=1,3 | |
12268 | BETA(J)=(P(IMV,J)-P(I,J))/(P(IMV,4)+P(I,4)) | |
12269 | 210 CONTINUE | |
12270 | FAC=2D0/(1D0+BETA(1)**2+BETA(2)**2+BETA(3)**2) | |
12271 | DO 220 J=1,3 | |
12272 | BETA(J)=FAC*BETA(J) | |
12273 | 220 CONTINUE | |
12274 | DO 240 I3=IBEG(ISYS+1),NFIN | |
12275 | IMO=I3 | |
12276 | 230 IMO=K(IMO,3) | |
12277 | IF(MSTP(128).LE.0) THEN | |
12278 | IF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) GOTO 230 | |
12279 | IF(IMO.EQ.I.OR.(K(I,3).LE.MINT(84).AND.IMO.EQ.K(I,3))) | |
12280 | & CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) | |
12281 | ELSE | |
12282 | IF(IMO.EQ.IMV) THEN | |
12283 | CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) | |
12284 | ELSEIF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) THEN | |
12285 | GOTO 230 | |
12286 | ENDIF | |
12287 | ENDIF | |
12288 | 240 CONTINUE | |
12289 | ENDIF | |
12290 | 250 CONTINUE | |
12291 | ||
12292 | C...End of loop over showering systems | |
12293 | ENDIF | |
12294 | 260 CONTINUE | |
12295 | ||
12296 | RETURN | |
12297 | END | |
12298 | ||
12299 | C********************************************************************* | |
12300 | ||
12301 | C...PYRESD | |
12302 | C...Allows resonances to decay (including parton showers for hadronic | |
12303 | C...channels). | |
12304 | ||
12305 | SUBROUTINE PYRESD(IRES) | |
12306 | ||
12307 | C...Double precision and integer declarations. | |
12308 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
12309 | IMPLICIT INTEGER(I-N) | |
12310 | INTEGER PYK,PYCHGE,PYCOMP | |
12311 | C...Parameter statement to help give large particle numbers. | |
12312 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
12313 | &KEXCIT=4000000,KDIMEN=5000000) | |
12314 | C...Commonblocks. | |
12315 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
12316 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
12317 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
12318 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
12319 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
12320 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
12321 | COMMON/PYINT1/MINT(400),VINT(400) | |
12322 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
12323 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
12324 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, | |
12325 | &/PYINT1/,/PYINT2/,/PYINT4/ | |
12326 | C...Local arrays and complex and character variables. | |
12327 | DIMENSION IREF(50,8),KDCY(3),KFL1(3),KFL2(3),KFL3(3),KEQL(3), | |
12328 | &KCQM(3),KCQ1(3),KCQ2(3),KCQ3(3),NSD(3),PMMN(3),ILIN(6), | |
12329 | &HGZ(3,3),COUP(6,4),CORL(2,2,2),PK(6,4),PKK(6,6),CTHE(3), | |
12330 | &PHI(3),WDTP(0:400),WDTE(0:400,0:5),DPMO(5),XM(5),VDCY(4), | |
12331 | &ITJUNC(3),CTM2(3) | |
12332 | COMPLEX FGK,HA(6,6),HC(6,6) | |
12333 | REAL TIR,UIR | |
12334 | CHARACTER CODE*9,MASS*9 | |
12335 | ||
12336 | C...The F, Xi and Xj functions of Gunion and Kunszt | |
12337 | C...(Phys. Rev. D33, 665, plus errata from the authors). | |
12338 | FGK(I1,I2,I3,I4,I5,I6)=4.*HA(I1,I3)*HC(I2,I6)*(HA(I1,I5)* | |
12339 | &HC(I1,I4)+HA(I3,I5)*HC(I3,I4)) | |
12340 | DIGK(DT,DU)=-4D0*D34*D56+DT*(3D0*DT+4D0*DU)+DT**2*(DT*DU/ | |
12341 | &(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+2D0*(D34/D56+D56/D34)) | |
12342 | DJGK(DT,DU)=8D0*(D34+D56)**2-8D0*(D34+D56)*(DT+DU)-6D0*DT*DU- | |
12343 | &2D0*DT*DU*(DT*DU/(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+ | |
12344 | &2D0*(D34/D56+D56/D34)) | |
12345 | ||
12346 | C...Some general constants. | |
12347 | XW=PARU(102) | |
12348 | XWV=XW | |
12349 | IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 | |
12350 | XW1=1D0-XW | |
12351 | SQMZ=PMAS(23,1)**2 | |
12352 | ||
12353 | GMMZ=PMAS(23,1)*PMAS(23,2) | |
12354 | SQMW=PMAS(24,1)**2 | |
12355 | GMMW=PMAS(24,1)*PMAS(24,2) | |
12356 | SH=VINT(44) | |
12357 | ||
12358 | C...Boost and rotate to rest frame of incoming partons, | |
12359 | C...to get proper amount of smearing of decay angles. | |
12360 | IBST=0 | |
12361 | IF(IRES.EQ.0) THEN | |
12362 | IBST=1 | |
12363 | ETOTIN=P(MINT(84)+1,4)+P(MINT(84)+2,4) | |
12364 | BEXIN=(P(MINT(84)+1,1)+P(MINT(84)+2,1))/ETOTIN | |
12365 | BEYIN=(P(MINT(84)+1,2)+P(MINT(84)+2,2))/ETOTIN | |
12366 | BEZIN=(P(MINT(84)+1,3)+P(MINT(84)+2,3))/ETOTIN | |
12367 | CALL PYROBO(MINT(83)+7,N,0D0,0D0,-BEXIN,-BEYIN,-BEZIN) | |
12368 | PHIIN=PYANGL(P(MINT(84)+1,1),P(MINT(84)+1,2)) | |
12369 | CALL PYROBO(MINT(83)+7,N,0D0,-PHIIN,0D0,0D0,0D0) | |
12370 | THEIN=PYANGL(P(MINT(84)+1,3),P(MINT(84)+1,1)) | |
12371 | CALL PYROBO(MINT(83)+7,N,-THEIN,0D0,0D0,0D0,0D0) | |
12372 | ENDIF | |
12373 | ||
12374 | C...Reset original resonance configuration. | |
12375 | DO 100 JT=1,8 | |
12376 | IREF(1,JT)=0 | |
12377 | 100 CONTINUE | |
12378 | ||
12379 | C...Define initial one, two or three objects for subprocess. | |
12380 | IHDEC=0 | |
12381 | IF(IRES.EQ.0) THEN | |
12382 | ISUB=MINT(1) | |
12383 | IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN | |
12384 | IREF(1,1)=MINT(84)+2+ISET(ISUB) | |
12385 | IREF(1,4)=MINT(83)+6+ISET(ISUB) | |
12386 | JTMAX=1 | |
12387 | ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN | |
12388 | IREF(1,1)=MINT(84)+1+ISET(ISUB) | |
12389 | IREF(1,2)=MINT(84)+2+ISET(ISUB) | |
12390 | IREF(1,4)=MINT(83)+5+ISET(ISUB) | |
12391 | IREF(1,5)=MINT(83)+6+ISET(ISUB) | |
12392 | JTMAX=2 | |
12393 | ELSEIF(ISET(ISUB).EQ.5) THEN | |
12394 | IREF(1,1)=MINT(84)+3 | |
12395 | IREF(1,2)=MINT(84)+4 | |
12396 | IREF(1,3)=MINT(84)+5 | |
12397 | IREF(1,4)=MINT(83)+7 | |
12398 | IREF(1,5)=MINT(83)+8 | |
12399 | IREF(1,6)=MINT(83)+9 | |
12400 | JTMAX=3 | |
12401 | ENDIF | |
12402 | ||
12403 | C...Define original resonance for odd cases. | |
12404 | ELSE | |
12405 | ISUB=0 | |
12406 | IF(K(IRES,2).EQ.25.OR.K(IRES,2).EQ.35.OR.K(IRES,2).EQ.36) | |
12407 | & IHDEC=1 | |
12408 | IF(IHDEC.EQ.1) ISUB=3 | |
12409 | IREF(1,1)=IRES | |
12410 | IREF(1,4)=K(IRES,3) | |
12411 | JTMAX=1 | |
12412 | ENDIF | |
12413 | ||
12414 | C...Check if initial resonance has been moved (in resonance + jet). | |
12415 | DO 120 JT=1,3 | |
12416 | IF(IREF(1,JT).GT.0) THEN | |
12417 | IF(K(IREF(1,JT),1).GT.10) THEN | |
12418 | KFA=IABS(K(IREF(1,JT),2)) | |
12419 | IF(KFA.GE.6.AND.KCHG(PYCOMP(KFA),2).NE.0) THEN | |
12420 | KDA1=MOD(K(IREF(1,JT),4),MSTU(5)) | |
12421 | KDA2=MOD(K(IREF(1,JT),5),MSTU(5)) | |
12422 | DO 110 I=IREF(1,JT)+1,N | |
12423 | IF(K(I,2).EQ.K(IREF(1,JT),2).AND.(I.EQ.KDA1.OR. | |
12424 | & I.EQ.KDA2)) THEN | |
12425 | IREF(1,JT)=I | |
12426 | KDA1=MOD(K(IREF(1,JT),4),MSTU(5)) | |
12427 | KDA2=MOD(K(IREF(1,JT),5),MSTU(5)) | |
12428 | ENDIF | |
12429 | 110 CONTINUE | |
12430 | ELSE | |
12431 | KDA=MOD(K(IREF(1,JT),4),MSTU(5)) | |
12432 | IF(MWID(PYCOMP(KFA)).NE.0.AND.KDA.GT.1) IREF(1,JT)=KDA | |
12433 | ENDIF | |
12434 | ENDIF | |
12435 | ENDIF | |
12436 | 120 CONTINUE | |
12437 | ||
12438 | C.....Set decay vertex for initial resonances | |
12439 | DO 140 JT=1,JTMAX | |
12440 | DO 130 I=1,4 | |
12441 | V(IREF(1,JT),I)=0D0 | |
12442 | 130 CONTINUE | |
12443 | 140 CONTINUE | |
12444 | ||
12445 | C...Loop over decay history. | |
12446 | NP=1 | |
12447 | IP=0 | |
12448 | 150 IP=IP+1 | |
12449 | NINH=0 | |
12450 | JTMAX=2 | |
12451 | IF(IREF(IP,2).EQ.0) JTMAX=1 | |
12452 | IF(IREF(IP,3).NE.0) JTMAX=3 | |
12453 | IT4=0 | |
12454 | NSAV=N | |
12455 | ||
12456 | C...Check for Higgs which appears as decay product of user-process. | |
12457 | IF(ISUB.EQ.0) THEN | |
12458 | IHDEC=0 | |
12459 | IF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR.IREF(IP,7) | |
12460 | & .EQ.36) IHDEC=1 | |
12461 | IF(IHDEC.EQ.1) ISUB=3 | |
12462 | ENDIF | |
12463 | ||
12464 | C...Start treatment of one, two or three resonances in parallel. | |
12465 | 160 N=NSAV | |
12466 | DO 320 JT=1,JTMAX | |
12467 | ID=IREF(IP,JT) | |
12468 | KDCY(JT)=0 | |
12469 | KFL1(JT)=0 | |
12470 | KFL2(JT)=0 | |
12471 | KFL3(JT)=0 | |
12472 | KEQL(JT)=0 | |
12473 | NSD(JT)=ID | |
12474 | ITJUNC(JT)=0 | |
12475 | ||
12476 | C...Check whether particle can/is allowed to decay. | |
12477 | IF(ID.EQ.0) GOTO 310 | |
12478 | KFA=IABS(K(ID,2)) | |
12479 | KCA=PYCOMP(KFA) | |
12480 | IF(MWID(KCA).EQ.0) GOTO 310 | |
12481 | IF(K(ID,1).GT.10.OR.MDCY(KCA,1).EQ.0) GOTO 310 | |
12482 | IF(KFA.EQ.6.OR.KFA.EQ.7.OR.KFA.EQ.8.OR.KFA.EQ.17.OR. | |
12483 | & KFA.EQ.18) IT4=IT4+1 | |
12484 | K(ID,4)=MSTU(5)*(K(ID,4)/MSTU(5)) | |
12485 | K(ID,5)=MSTU(5)*(K(ID,5)/MSTU(5)) | |
12486 | ||
12487 | C...Choose lifetime and determine decay vertex. | |
12488 | IF(K(ID,1).EQ.5) THEN | |
12489 | V(ID,5)=0D0 | |
12490 | ELSEIF(K(ID,1).NE.4) THEN | |
12491 | V(ID,5)=-PMAS(KCA,4)*LOG(PYR(0)) | |
12492 | ENDIF | |
12493 | DO 170 J=1,4 | |
12494 | VDCY(J)=V(ID,J)+V(ID,5)*P(ID,J)/P(ID,5) | |
12495 | 170 CONTINUE | |
12496 | ||
12497 | C...Determine whether decay allowed or not. | |
12498 | MOUT=0 | |
12499 | IF(MSTJ(22).EQ.2) THEN | |
12500 | IF(PMAS(KCA,4).GT.PARJ(71)) MOUT=1 | |
12501 | ELSEIF(MSTJ(22).EQ.3) THEN | |
12502 | IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1 | |
12503 | ELSEIF(MSTJ(22).EQ.4) THEN | |
12504 | IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1 | |
12505 | IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1 | |
12506 | ENDIF | |
12507 | IF(MOUT.EQ.1.AND.K(ID,1).NE.5) THEN | |
12508 | K(ID,1)=4 | |
12509 | GOTO 310 | |
12510 | ENDIF | |
12511 | ||
12512 | C...Info for selection of decay channel: sign, pairings. | |
12513 | IF(KCHG(KCA,3).EQ.0) THEN | |
12514 | IPM=2 | |
12515 | ELSE | |
12516 | IPM=(5-ISIGN(1,K(ID,2)))/2 | |
12517 | ENDIF | |
12518 | KFB=0 | |
12519 | IF(JTMAX.EQ.2) THEN | |
12520 | KFB=IABS(K(IREF(IP,3-JT),2)) | |
12521 | ELSEIF(JTMAX.EQ.3) THEN | |
12522 | JT2=JT+1-3*(JT/3) | |
12523 | KFB=IABS(K(IREF(IP,JT2),2)) | |
12524 | IF(KFB.NE.KFA) THEN | |
12525 | JT2=JT+2-3*((JT+1)/3) | |
12526 | KFB=IABS(K(IREF(IP,JT2),2)) | |
12527 | ENDIF | |
12528 | ENDIF | |
12529 | ||
12530 | C...Select decay channel. | |
12531 | IF(ISUB.EQ.1.OR.ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR. | |
12532 | & ISUB.EQ.30.OR.ISUB.EQ.35.OR.ISUB.EQ.141) MINT(61)=1 | |
12533 | CALL PYWIDT(KFA,P(ID,5)**2,WDTP,WDTE) | |
12534 | WDTE0S=WDTE(0,1)+WDTE(0,IPM)+WDTE(0,4) | |
12535 | IF(KFB.EQ.KFA) WDTE0S=WDTE0S+WDTE(0,5) | |
12536 | IF(WDTE0S.LE.0D0) GOTO 310 | |
12537 | RKFL=WDTE0S*PYR(0) | |
12538 | IDL=0 | |
12539 | 180 IDL=IDL+1 | |
12540 | IDC=IDL+MDCY(KCA,2)-1 | |
12541 | RKFL=RKFL-(WDTE(IDL,1)+WDTE(IDL,IPM)+WDTE(IDL,4)) | |
12542 | IF(KFB.EQ.KFA) RKFL=RKFL-WDTE(IDL,5) | |
12543 | IF(IDL.LT.MDCY(KCA,3).AND.RKFL.GT.0D0) GOTO 180 | |
12544 | ||
12545 | C...Read out flavours and colour charges of decay channel chosen. | |
12546 | KCQM(JT)=KCHG(KCA,2)*ISIGN(1,K(ID,2)) | |
12547 | IF(KCQM(JT).EQ.-2) KCQM(JT)=2 | |
12548 | KFL1(JT)=KFDP(IDC,1)*ISIGN(1,K(ID,2)) | |
12549 | KFC1A=PYCOMP(IABS(KFL1(JT))) | |
12550 | IF(KCHG(KFC1A,3).EQ.0) KFL1(JT)=IABS(KFL1(JT)) | |
12551 | KCQ1(JT)=KCHG(KFC1A,2)*ISIGN(1,KFL1(JT)) | |
12552 | IF(KCQ1(JT).EQ.-2) KCQ1(JT)=2 | |
12553 | KFL2(JT)=KFDP(IDC,2)*ISIGN(1,K(ID,2)) | |
12554 | KFC2A=PYCOMP(IABS(KFL2(JT))) | |
12555 | IF(KCHG(KFC2A,3).EQ.0) KFL2(JT)=IABS(KFL2(JT)) | |
12556 | KCQ2(JT)=KCHG(KFC2A,2)*ISIGN(1,KFL2(JT)) | |
12557 | IF(KCQ2(JT).EQ.-2) KCQ2(JT)=2 | |
12558 | KFL3(JT)=KFDP(IDC,3)*ISIGN(1,K(ID,2)) | |
12559 | KCQ3(JT)=0 | |
12560 | IF(KFL3(JT).NE.0) THEN | |
12561 | KFC3A=PYCOMP(IABS(KFL3(JT))) | |
12562 | IF(KCHG(KFC3A,3).EQ.0) KFL3(JT)=IABS(KFL3(JT)) | |
12563 | KCQ3(JT)=KCHG(KFC3A,2)*ISIGN(1,KFL3(JT)) | |
12564 | IF(KCQ3(JT).EQ.-2) KCQ3(JT)=2 | |
12565 | ENDIF | |
12566 | ||
12567 | C...Set/save further info on channel. | |
12568 | KDCY(JT)=1 | |
12569 | IF(KFB.EQ.KFA) KEQL(JT)=MDME(IDC,1) | |
12570 | NSD(JT)=N | |
12571 | HGZ(JT,1)=VINT(111) | |
12572 | HGZ(JT,2)=VINT(112) | |
12573 | HGZ(JT,3)=VINT(114) | |
12574 | JTZ=JT | |
12575 | ||
12576 | C...Select masses; to begin with assume resonances narrow. | |
12577 | DO 200 I=1,3 | |
12578 | P(N+I,5)=0D0 | |
12579 | PMMN(I)=0D0 | |
12580 | IF(I.EQ.1) THEN | |
12581 | KFLW=IABS(KFL1(JT)) | |
12582 | KCW=KFC1A | |
12583 | ELSEIF(I.EQ.2) THEN | |
12584 | KFLW=IABS(KFL2(JT)) | |
12585 | KCW=KFC2A | |
12586 | ELSEIF(I.EQ.3) THEN | |
12587 | IF(KFL3(JT).EQ.0) GOTO 200 | |
12588 | KFLW=IABS(KFL3(JT)) | |
12589 | KCW=KFC3A | |
12590 | ENDIF | |
12591 | P(N+I,5)=PMAS(KCW,1) | |
12592 | CMRENNA++ | |
12593 | C...This prevents SUSY/t particles from becoming too light. | |
12594 | IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN | |
12595 | PMMN(I)=PMAS(KCW,1) | |
12596 | DO 190 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 | |
12597 | IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN | |
12598 | PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ | |
12599 | & PMAS(PYCOMP(KFDP(IDC,2)),1) | |
12600 | IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ | |
12601 | & PMAS(PYCOMP(KFDP(IDC,3)),1) | |
12602 | PMMN(I)=MIN(PMMN(I),PMSUM) | |
12603 | ENDIF | |
12604 | 190 CONTINUE | |
12605 | CMRENNA-- | |
12606 | ELSEIF(KFLW.EQ.6) THEN | |
12607 | PMMN(I)=PMAS(24,1)+PMAS(5,1) | |
12608 | ENDIF | |
12609 | 200 CONTINUE | |
12610 | ||
12611 | C...Check which two out of three are widest. | |
12612 | IWID1=1 | |
12613 | IWID2=2 | |
12614 | PWID1=PMAS(KFC1A,2) | |
12615 | PWID2=PMAS(KFC2A,2) | |
12616 | KFLW1=IABS(KFL1(JT)) | |
12617 | KFLW2=IABS(KFL2(JT)) | |
12618 | IF(KFL3(JT).NE.0) THEN | |
12619 | PWID3=PMAS(KFC3A,2) | |
12620 | IF(PWID3.GT.PWID1.AND.PWID2.GE.PWID1) THEN | |
12621 | IWID1=3 | |
12622 | PWID1=PWID3 | |
12623 | KFLW1=IABS(KFL3(JT)) | |
12624 | ELSEIF(PWID3.GT.PWID2) THEN | |
12625 | IWID2=3 | |
12626 | PWID2=PWID3 | |
12627 | KFLW2=IABS(KFL3(JT)) | |
12628 | ENDIF | |
12629 | ENDIF | |
12630 | ||
12631 | C...If all narrow then only check that masses consistent. | |
12632 | IF(MSTP(42).LE.0.OR.(PWID1.LT.PARP(41).AND. | |
12633 | & PWID2.LT.PARP(41))) THEN | |
12634 | CMRENNA++ | |
12635 | C....Handle near degeneracy cases. | |
12636 | IF(KFA/KSUSY1.EQ.1.OR.KFA/KSUSY1.EQ.2) THEN | |
12637 | IF(P(N+1,5)+P(N+2,5)+P(N+3,5).GT.P(ID,5)) THEN | |
12638 | P(N+1,5)=P(ID,5)-P(N+2,5)-0.5D0 | |
12639 | IF(P(N+1,5).LT.0D0) P(N+1,5)=0D0 | |
12640 | ENDIF | |
12641 | ENDIF | |
12642 | CMRENNA-- | |
12643 | IF(P(N+1,5)+P(N+2,5)+P(N+3,5).GT.P(ID,5)) THEN | |
12644 | CALL PYERRM(13,'(PYRESD:) daughter masses too large') | |
12645 | MINT(51)=1 | |
12646 | GOTO 700 | |
12647 | ELSEIF(P(N+1,5)+P(N+2,5)+P(N+3,5)+PARJ(64).GT.P(ID,5)) THEN | |
12648 | CALL PYERRM(3,'(PYRESD:) daughter masses too large') | |
12649 | MINT(51)=1 | |
12650 | GOTO 700 | |
12651 | ENDIF | |
12652 | ||
12653 | C...For three wide resonances select narrower of three | |
12654 | C...according to BW decoupled from rest. | |
12655 | ELSE | |
12656 | PMTOT=P(ID,5) | |
12657 | IF(KFL3(JT).NE.0) THEN | |
12658 | IWID3=6-IWID1-IWID2 | |
12659 | KFLW3=IABS(KFL1(JT))+IABS(KFL2(JT))+IABS(KFL3(JT))- | |
12660 | & KFLW1-KFLW2 | |
12661 | LOOP=0 | |
12662 | 210 LOOP=LOOP+1 | |
12663 | P(N+IWID3,5)=PYMASS(KFLW3) | |
12664 | IF(LOOP.LE.10.AND. P(N+IWID3,5).LE.PMMN(IWID3)) GOTO 210 | |
12665 | PMTOT=PMTOT-P(N+IWID3,5) | |
12666 | ENDIF | |
12667 | C...Select other two correlated within remaining phase space. | |
12668 | IF(IP.EQ.1) THEN | |
12669 | CKIN45=CKIN(45) | |
12670 | CKIN47=CKIN(47) | |
12671 | CKIN(45)=MAX(PMMN(IWID1),CKIN(45)) | |
12672 | CKIN(47)=MAX(PMMN(IWID2),CKIN(47)) | |
12673 | CALL PYOFSH(2,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5), | |
12674 | & P(N+IWID2,5)) | |
12675 | CKIN(45)=CKIN45 | |
12676 | CKIN(47)=CKIN47 | |
12677 | ELSE | |
12678 | CKIN(49)=PMMN(IWID1) | |
12679 | CKIN(50)=PMMN(IWID2) | |
12680 | CALL PYOFSH(5,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5), | |
12681 | & P(N+IWID2,5)) | |
12682 | CKIN(49)=0D0 | |
12683 | CKIN(50)=0D0 | |
12684 | ENDIF | |
12685 | IF(MINT(51).EQ.1) GOTO 700 | |
12686 | ENDIF | |
12687 | ||
12688 | C...Begin fill decay products, with colour flow for coloured objects. | |
12689 | MSTU10=MSTU(10) | |
12690 | MSTU(10)=1 | |
12691 | MSTU(19)=1 | |
12692 | ||
12693 | CMRENNA++ | |
12694 | C...1) Three-body decays of SUSY particles (plus special case top). | |
12695 | IF(KFL3(JT).NE.0) THEN | |
12696 | DO 230 I=N+1,N+3 | |
12697 | DO 220 J=1,5 | |
12698 | K(I,J)=0 | |
12699 | V(I,J)=0D0 | |
12700 | 220 CONTINUE | |
12701 | 230 CONTINUE | |
12702 | K(N+1,1)=1 | |
12703 | K(N+1,2)=KFL1(JT) | |
12704 | K(N+2,1)=1 | |
12705 | K(N+2,2)=KFL2(JT) | |
12706 | K(N+3,1)=1 | |
12707 | K(N+3,2)=KFL3(JT) | |
12708 | IDIN=ID | |
12709 | CALL PYTBDY(IDIN) | |
12710 | ||
12711 | C...Set colour flow for t -> W + b + Z. | |
12712 | IF(KFA.EQ.6) THEN | |
12713 | K(N+2,1)=3 | |
12714 | ISID=4 | |
12715 | IF(KCQM(JT).EQ.-1) ISID=5 | |
12716 | IDAU=N+2 | |
12717 | K(ID,ISID)=K(ID,ISID)+IDAU | |
12718 | K(IDAU,ISID)=MSTU(5)*ID | |
12719 | ||
12720 | C...Set colour flow in three-body decays - programmed as special cases. | |
12721 | ELSEIF(KFC2A.LE.6) THEN | |
12722 | K(N+2,1)=3 | |
12723 | K(N+3,1)=3 | |
12724 | ISID=4 | |
12725 | IF(KFL2(JT).LT.0) ISID=5 | |
12726 | K(N+2,ISID)=MSTU(5)*(N+3) | |
12727 | K(N+3,9-ISID)=MSTU(5)*(N+2) | |
12728 | ENDIF | |
12729 | IF(KFL1(JT).EQ.KSUSY1+21) THEN | |
12730 | K(N+1,1)=3 | |
12731 | K(N+2,1)=3 | |
12732 | K(N+3,1)=3 | |
12733 | ISID=4 | |
12734 | IF(KFL2(JT).LT.0) ISID=5 | |
12735 | K(N+1,ISID)=MSTU(5)*(N+2) | |
12736 | K(N+1,9-ISID)=MSTU(5)*(N+3) | |
12737 | K(N+2,ISID)=MSTU(5)*(N+1) | |
12738 | K(N+3,9-ISID)=MSTU(5)*(N+1) | |
12739 | ENDIF | |
12740 | IF(KFA.EQ.KSUSY1+21) THEN | |
12741 | K(N+2,1)=3 | |
12742 | K(N+3,1)=3 | |
12743 | ISID=4 | |
12744 | IF(KFL2(JT).LT.0) ISID=5 | |
12745 | K(ID,ISID)=K(ID,ISID)+(N+2) | |
12746 | K(ID,9-ISID)=K(ID,9-ISID)+(N+3) | |
12747 | K(N+2,ISID)=MSTU(5)*ID | |
12748 | K(N+3,9-ISID)=MSTU(5)*ID | |
12749 | ENDIF | |
12750 | CMRENNA-- | |
12751 | ||
12752 | IF(KFA.GE.KSUSY1+22.AND.KFA.LE.KSUSY1+37.AND. | |
12753 | & IABS(KCQ2(JT)).EQ.1) THEN | |
12754 | K(N+2,1)=3 | |
12755 | K(N+3,1)=3 | |
12756 | ISID=4 | |
12757 | IF(KFL2(JT).LT.0) ISID=5 | |
12758 | K(N+2,ISID)=MSTU(5)*(N+3) | |
12759 | K(N+3,9-ISID)=MSTU(5)*(N+2) | |
12760 | ENDIF | |
12761 | ||
12762 | C...Set colour flow in three-body decays with baryon number violation. | |
12763 | C...Neutralino and chargino decays first. | |
12764 | KCQSUM=KCQ1(JT)+KCQ2(JT)+KCQ3(JT) | |
12765 | IF(KCQM(JT).EQ.0.AND.IABS(KCQSUM).EQ.3) THEN | |
12766 | ITJUNC(JT)=(1+(1-KCQ1(JT))/2) | |
12767 | K(N+4,4)=ITJUNC(JT)*MSTU(5) | |
12768 | C...Insert junction to keep track of colours. | |
12769 | IF(KCQ1(JT).NE.0) K(N+1,1)=3 | |
12770 | IF(KCQ2(JT).NE.0) K(N+2,1)=3 | |
12771 | IF(KCQ3(JT).NE.0) K(N+3,1)=3 | |
12772 | C...Set special junction codes: | |
12773 | K(N+4,1)=42 | |
12774 | K(N+4,2)=88 | |
12775 | ||
12776 | C...Order decay products by invariant mass. (will be used in PYSTRF). | |
12777 | PM12=P(N+1,4)*P(N+2,4)-P(N+1,1)*P(N+2,1)-P(N+1,2)*P(N+2,2)- | |
12778 | & P(N+1,3)*P(N+2,3) | |
12779 | PM13=P(N+1,4)*P(N+3,4)-P(N+1,1)*P(N+3,1)-P(N+1,2)*P(N+3,2)- | |
12780 | & P(N+1,3)*P(N+3,3) | |
12781 | PM23=P(N+2,4)*P(N+3,4)-P(N+2,1)*P(N+3,1)-P(N+2,2)*P(N+3,2)- | |
12782 | & P(N+2,3)*P(N+3,3) | |
12783 | IF(PM12.LT.PM13.AND.PM12.LT.PM23) THEN | |
12784 | K(N+4,4)=N+3+K(N+4,4) | |
12785 | K(N+4,5)=N+1+MSTU(5)*(N+2) | |
12786 | ELSEIF(PM13.LT.PM23) THEN | |
12787 | K(N+4,4)=N+2+K(N+4,4) | |
12788 | K(N+4,5)=N+1+MSTU(5)*(N+3) | |
12789 | ELSE | |
12790 | K(N+4,4)=N+1+K(N+4,4) | |
12791 | K(N+4,5)=N+2+MSTU(5)*(N+3) | |
12792 | ENDIF | |
12793 | DO 240 J=1,5 | |
12794 | P(N+4,J)=0D0 | |
12795 | V(N+4,J)=0D0 | |
12796 | 240 CONTINUE | |
12797 | C...Connect daughters to junction. | |
12798 | DO 250 II=N+1,N+3 | |
12799 | K(II,4)=0 | |
12800 | K(II,5)=0 | |
12801 | K(II,ITJUNC(JT)+3)=MSTU(5)*(N+4) | |
12802 | 250 CONTINUE | |
12803 | C...Particle counter should be stepped up one extra for junction. | |
12804 | N=N+1 | |
12805 | ||
12806 | C...Gluino decays. | |
12807 | ELSEIF (KCQM(JT).EQ.2.AND.IABS(KCQSUM).EQ.3) THEN | |
12808 | ITJUNC(JT)=(5+(1-KCQ1(JT))/2) | |
12809 | K(N+4,4)=ITJUNC(JT)*MSTU(5) | |
12810 | C...Insert junction to keep track of colours. | |
12811 | IF(KCQ1(JT).NE.0) K(N+1,1)=3 | |
12812 | IF(KCQ2(JT).NE.0) K(N+2,1)=3 | |
12813 | IF(KCQ3(JT).NE.0) K(N+3,1)=3 | |
12814 | K(N+4,1)=42 | |
12815 | K(N+4,2)=88 | |
12816 | DO 260 J=1,5 | |
12817 | P(N+4,J)=0D0 | |
12818 | V(N+4,J)=0D0 | |
12819 | 260 CONTINUE | |
12820 | CTMSUM=0D0 | |
12821 | DO 270 II=N+1,N+3 | |
12822 | K(II,4)=0 | |
12823 | K(II,5)=0 | |
12824 | C...Start by connecting all daughters to junction. | |
12825 | K(II,ITJUNC(JT)-1)=MSTU(5)*(N+4) | |
12826 | C...Only consider colour topologies with off shell resonances. | |
12827 | RMQ1=PMAS(PYCOMP(K(II,2)),1) | |
12828 | RMRES=PMAS(PYCOMP(KSUSY1+IABS(K(II,2))),1) | |
12829 | RMGLU=PMAS(PYCOMP(KSUSY1+21),1) | |
12830 | IF (RMGLU-RMQ1.LT.RMRES) THEN | |
12831 | C...Calculate propagators for each colour topology. | |
12832 | RM2Q23=RMGLU**2+RMQ1**2-2D0*(P(II,4)*P(ID,4)+P(II,1) | |
12833 | & *P(ID,1)+P(II,2)*P(ID,2)+P(II,3)*P(ID,3)) | |
12834 | CTM2(II-N)=1D0/(RM2Q23-RMRES**2)**2 | |
12835 | ELSE | |
12836 | CTM2(II-N)=0D0 | |
12837 | ENDIF | |
12838 | CTMSUM=CTMSUM+CTM2(II-N) | |
12839 | 270 CONTINUE | |
12840 | CTMSUM=PYR(0)*CTMSUM | |
12841 | C...Select colour topology J, with most off shell least likely. | |
12842 | J=0 | |
12843 | 280 J=J+1 | |
12844 | CTMSUM=CTMSUM-CTM2(J) | |
12845 | IF (CTMSUM.GT.0D0) GOTO 280 | |
12846 | C...The lucky winner gets its colour (anti-colour) directly from gluino. | |
12847 | K(N+J,ITJUNC(JT)-1)=MSTU(5)*ID | |
12848 | K(ID,ITJUNC(JT)-1)=N+J+(K(ID,ITJUNC(JT)-1)/MSTU(5))*MSTU(5) | |
12849 | C...The other gluino colour is connected to junction | |
12850 | K(ID,10-ITJUNC(JT))=N+4+(K(ID,10-ITJUNC(JT))/MSTU(5))* | |
12851 | & MSTU(5) | |
12852 | K(N+4,4)=K(N+4,4)+ID | |
12853 | C...Lastly, connect junction to remaining daughters. | |
12854 | K(N+4,5)=N+1+MOD(J,3)+MSTU(5)*(N+1+MOD(J+1,3)) | |
12855 | C...Particle counter should be stepped up one extra for junction. | |
12856 | N=N+1 | |
12857 | ENDIF | |
12858 | ||
12859 | C...Update particle counter. | |
12860 | N=N+3 | |
12861 | ||
12862 | C...2) Everything else two-body decay. | |
12863 | ELSE | |
12864 | CALL PY2ENT(N+1,KFL1(JT),KFL2(JT),P(ID,5)) | |
12865 | C...First set colour flow as if mother colour singlet. | |
12866 | IF(KCQ1(JT).NE.0) THEN | |
12867 | K(N-1,1)=3 | |
12868 | IF(KCQ1(JT).NE.-1) K(N-1,4)=MSTU(5)*N | |
12869 | IF(KCQ1(JT).NE.1) K(N-1,5)=MSTU(5)*N | |
12870 | ENDIF | |
12871 | IF(KCQ2(JT).NE.0) THEN | |
12872 | K(N,1)=3 | |
12873 | IF(KCQ2(JT).NE.-1) K(N,4)=MSTU(5)*(N-1) | |
12874 | IF(KCQ2(JT).NE.1) K(N,5)=MSTU(5)*(N-1) | |
12875 | ENDIF | |
12876 | C...Then redirect colour flow if mother (anti)triplet. | |
12877 | IF(KCQM(JT).EQ.0) THEN | |
12878 | ELSEIF(KCQM(JT).NE.2) THEN | |
12879 | ISID=4 | |
12880 | IF(KCQM(JT).EQ.-1) ISID=5 | |
12881 | IDAU=N-1 | |
12882 | IF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.2) IDAU=N | |
12883 | K(ID,ISID)=K(ID,ISID)+IDAU | |
12884 | K(IDAU,ISID)=MSTU(5)*ID | |
12885 | C...Then redirect colour flow if mother octet. | |
12886 | ELSEIF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.0) THEN | |
12887 | IDAU=N-1 | |
12888 | IF(KCQ1(JT).EQ.0) IDAU=N | |
12889 | K(ID,4)=K(ID,4)+IDAU | |
12890 | K(ID,5)=K(ID,5)+IDAU | |
12891 | K(IDAU,4)=MSTU(5)*ID | |
12892 | K(IDAU,5)=MSTU(5)*ID | |
12893 | ELSE | |
12894 | ISID=4 | |
12895 | IF(KCQ1(JT).EQ.-1) ISID=5 | |
12896 | IF(KCQ1(JT).EQ.2) ISID=INT(4.5D0+PYR(0)) | |
12897 | K(ID,ISID)=K(ID,ISID)+(N-1) | |
12898 | K(ID,9-ISID)=K(ID,9-ISID)+N | |
12899 | K(N-1,ISID)=MSTU(5)*ID | |
12900 | K(N,9-ISID)=MSTU(5)*ID | |
12901 | ENDIF | |
12902 | ||
12903 | C...Insert junction | |
12904 | IF(IABS(KCQ1(JT)+KCQ2(JT)-KCQM(JT)).EQ.3) THEN | |
12905 | N=N+1 | |
12906 | C...~q* mother: type 3 junction. ~q mother: type 4. | |
12907 | ITJUNC(JT)=(7+KCQM(JT))/2 | |
12908 | C...Specify junction KF and set colour flow from junction | |
12909 | K(N,1)=42 | |
12910 | K(N,2)=88 | |
12911 | K(N,3)=ID | |
12912 | C...Junction type encoded together with mother: | |
12913 | K(N,4)=ID+ITJUNC(JT)*MSTU(5) | |
12914 | K(N,5)=N-1+MSTU(5)*(N-2) | |
12915 | C...Zero P and V for junction (V filled later) | |
12916 | DO 290 J=1,5 | |
12917 | P(N,J)=0D0 | |
12918 | V(N,J)=0D0 | |
12919 | 290 CONTINUE | |
12920 | C...Set colour flow from mother to junction | |
12921 | K(ID,8-ITJUNC(JT))= N + MSTU(5)*(K(ID,8-ITJUNC(JT))/MSTU(5)) | |
12922 | C...Set colour flow from daughters to junction | |
12923 | DO 300 II=N-2,N-1 | |
12924 | K(II,4) = 0 | |
12925 | K(II,5) = 0 | |
12926 | C...(Anti-)colour mother is junction. | |
12927 | K(II,1+ITJUNC(JT)) = MSTU(5)*(N) | |
12928 | 300 CONTINUE | |
12929 | ENDIF | |
12930 | ENDIF | |
12931 | ||
12932 | C...End loop over resonances for daughter flavour and mass selection. | |
12933 | MSTU(10)=MSTU10 | |
12934 | 310 IF(MWID(KCA).NE.0.AND.(KFL1(JT).EQ.0.OR.KFL3(JT).NE.0)) | |
12935 | & NINH=NINH+1 | |
12936 | IF(IRES.GT.0.AND.MWID(KCA).NE.0.AND.MDCY(KCA,1).NE.0.AND. | |
12937 | & KFL1(JT).EQ.0) THEN | |
12938 | WRITE(CODE,'(I9)') K(ID,2) | |
12939 | WRITE(MASS,'(F9.3)') P(ID,5) | |
12940 | CALL PYERRM(3,'(PYRESD:) Failed to decay particle'// | |
12941 | & CODE//' with mass'//MASS) | |
12942 | MINT(51)=1 | |
12943 | GOTO 700 | |
12944 | ENDIF | |
12945 | 320 CONTINUE | |
12946 | ||
12947 | C...Check for allowed combinations. Skip if no decays. | |
12948 | IF(JTMAX.EQ.1) THEN | |
12949 | IF(KDCY(1).EQ.0) GOTO 690 | |
12950 | ELSEIF(JTMAX.EQ.2) THEN | |
12951 | IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0) GOTO 690 | |
12952 | IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 160 | |
12953 | IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 160 | |
12954 | ELSEIF(JTMAX.EQ.3) THEN | |
12955 | IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0.AND.KDCY(3).EQ.0) GOTO 690 | |
12956 | IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 160 | |
12957 | IF(KEQL(1).EQ.4.AND.KEQL(3).EQ.4) GOTO 160 | |
12958 | IF(KEQL(2).EQ.4.AND.KEQL(3).EQ.4) GOTO 160 | |
12959 | IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 160 | |
12960 | IF(KEQL(1).EQ.5.AND.KEQL(3).EQ.5) GOTO 160 | |
12961 | IF(KEQL(2).EQ.5.AND.KEQL(3).EQ.5) GOTO 160 | |
12962 | ENDIF | |
12963 | ||
12964 | C...Special case: matrix element option for Z0 decay to quarks. | |
12965 | IF(MSTP(48).EQ.1.AND.ISUB.EQ.1.AND.JTMAX.EQ.1.AND. | |
12966 | &IABS(MINT(11)).EQ.11.AND.IABS(KFL1(1)).LE.5) THEN | |
12967 | ||
12968 | C...Check consistency of MSTJ options set. | |
12969 | IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN | |
12970 | CALL PYERRM(6, | |
12971 | & '(PYRESD:) MSTJ(109) value requires MSTJ(110) = 1') | |
12972 | MSTJ(110)=1 | |
12973 | ENDIF | |
12974 | IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN | |
12975 | CALL PYERRM(6, | |
12976 | & '(PYRESD:) MSTJ(109) value requires MSTJ(111) = 0') | |
12977 | ||
12978 | MSTJ(111)=0 | |
12979 | ENDIF | |
12980 | ||
12981 | C...Select alpha_strong behaviour. | |
12982 | MST111=MSTU(111) | |
12983 | PAR112=PARU(112) | |
12984 | MSTU(111)=MSTJ(108) | |
12985 | IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) | |
12986 | & MSTU(111)=1 | |
12987 | PARU(112)=PARJ(121) | |
12988 | IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) | |
12989 | ||
12990 | C...Find axial fraction in total cross section for scalar gluon model. | |
12991 | PARJ(171)=0D0 | |
12992 | IF((IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.1).OR. | |
12993 | & (MSTJ(101).EQ.5.AND.MSTJ(49).EQ.1)) THEN | |
12994 | POLL=1D0-PARJ(131)*PARJ(132) | |
12995 | SFF=1D0/(16D0*XW*XW1) | |
12996 | SFW=P(ID,5)**4/((P(ID,5)**2-PARJ(123)**2)**2+ | |
12997 | & (PARJ(123)*PARJ(124))**2) | |
12998 | SFI=SFW*(1D0-(PARJ(123)/P(ID,5))**2) | |
12999 | VE=4D0*XW-1D0 | |
13000 | HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) | |
13001 | HF1W=SFW*SFF**2*((VE**2+1D0)*POLL+2D0*VE* | |
13002 | & (PARJ(132)-PARJ(131))) | |
13003 | KFLC=IABS(KFL1(1)) | |
13004 | PMQ=PYMASS(KFLC) | |
13005 | QF=KCHG(KFLC,1)/3D0 | |
13006 | VQ=1D0 | |
13007 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0, | |
13008 | & 1D0-(2D0*PMQ/P(ID,5))**2)) | |
13009 | VF=SIGN(1D0,QF)-4D0*QF*XW | |
13010 | RFV=0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-2D0*QF*VF*HF1I+ | |
13011 | & VF**2*HF1W)+VQ**3*HF1W | |
13012 | IF(RFV.GT.0D0) PARJ(171)=MIN(1D0,VQ**3*HF1W/RFV) | |
13013 | ENDIF | |
13014 | ||
13015 | C...Choice of jet configuration. | |
13016 | CALL PYXJET(P(ID,5),NJET,CUT) | |
13017 | KFLC=IABS(KFL1(1)) | |
13018 | KFLN=21 | |
13019 | ||
13020 | IF(NJET.EQ.4) THEN | |
13021 | CALL PYX4JT(NJET,CUT,KFLC,P(ID,5),KFLN,X1,X2,X4,X12,X14) | |
13022 | ELSEIF(NJET.EQ.3) THEN | |
13023 | CALL PYX3JT(NJET,CUT,KFLC,P(ID,5),X1,X3) | |
13024 | ELSE | |
13025 | MSTJ(120)=1 | |
13026 | ENDIF | |
13027 | ||
13028 | C...Fill jet configuration; return if incorrect kinematics. | |
13029 | NC=N-2 | |
13030 | IF(NJET.EQ.2.AND.MSTJ(101).NE.5) THEN | |
13031 | CALL PY2ENT(NC+1,KFLC,-KFLC,P(ID,5)) | |
13032 | ELSEIF(NJET.EQ.2) THEN | |
13033 | CALL PY2ENT(-(NC+1),KFLC,-KFLC,P(ID,5)) | |
13034 | ELSEIF(NJET.EQ.3) THEN | |
13035 | CALL PY3ENT(NC+1,KFLC,21,-KFLC,P(ID,5),X1,X3) | |
13036 | ELSEIF(KFLN.EQ.21) THEN | |
13037 | CALL PY4ENT(NC+1,KFLC,KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4, | |
13038 | & X12,X14) | |
13039 | ELSE | |
13040 | CALL PY4ENT(NC+1,KFLC,-KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4, | |
13041 | & X12,X14) | |
13042 | ENDIF | |
13043 | IF(MSTU(24).NE.0) THEN | |
13044 | MINT(51)=1 | |
13045 | MSTU(111)=MST111 | |
13046 | PARU(112)=PAR112 | |
13047 | GOTO 700 | |
13048 | ENDIF | |
13049 | ||
13050 | C...Angular orientation according to matrix element. | |
13051 | IF(MSTJ(106).EQ.1) THEN | |
13052 | CALL PYXDIF(NC,NJET,KFLC,P(ID,5),CHIZ,THEZ,PHIZ) | |
13053 | IF(MINT(11).LT.0) THEZ=PARU(1)-THEZ | |
13054 | CTHE(1)=COS(THEZ) | |
13055 | CALL PYROBO(NC+1,N,0D0,CHIZ,0D0,0D0,0D0) | |
13056 | CALL PYROBO(NC+1,N,THEZ,PHIZ,0D0,0D0,0D0) | |
13057 | ENDIF | |
13058 | ||
13059 | C...Boost partons to Z0 rest frame. | |
13060 | CALL PYROBO(NC+1,N,0D0,0D0,P(ID,1)/P(ID,4), | |
13061 | & P(ID,2)/P(ID,4),P(ID,3)/P(ID,4)) | |
13062 | ||
13063 | C...Mark decayed resonance and add documentation lines, | |
13064 | K(ID,1)=K(ID,1)+10 | |
13065 | IDOC=MINT(83)+MINT(4) | |
13066 | DO 340 I=NC+1,N | |
13067 | I1=MINT(83)+MINT(4)+1 | |
13068 | K(I,3)=I1 | |
13069 | IF(MSTP(128).GE.1) K(I,3)=ID | |
13070 | IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN | |
13071 | MINT(4)=MINT(4)+1 | |
13072 | K(I1,1)=21 | |
13073 | K(I1,2)=K(I,2) | |
13074 | K(I1,3)=IREF(IP,4) | |
13075 | DO 330 J=1,5 | |
13076 | P(I1,J)=P(I,J) | |
13077 | 330 CONTINUE | |
13078 | ENDIF | |
13079 | 340 CONTINUE | |
13080 | ||
13081 | C...Generate parton shower. | |
13082 | IF(MSTJ(101).EQ.5) CALL PYSHOW(N-1,N,P(ID,5)) | |
13083 | ||
13084 | C... End special case for Z0: skip ahead. | |
13085 | MSTU(111)=MST111 | |
13086 | PARU(112)=PAR112 | |
13087 | GOTO 680 | |
13088 | ENDIF | |
13089 | ||
13090 | C...Order incoming partons and outgoing resonances. | |
13091 | IF(JTMAX.EQ.2.AND.ISUB.NE.0.AND.MSTP(47).GE.1.AND. | |
13092 | &NINH.EQ.0) THEN | |
13093 | ILIN(1)=MINT(84)+1 | |
13094 | IF(K(MINT(84)+1,2).GT.0) ILIN(1)=MINT(84)+2 | |
13095 | IF(K(ILIN(1),2).EQ.21.OR.K(ILIN(1),2).EQ.22) | |
13096 | & ILIN(1)=2*MINT(84)+3-ILIN(1) | |
13097 | ILIN(2)=2*MINT(84)+3-ILIN(1) | |
13098 | IMIN=1 | |
13099 | IF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR.IREF(IP,7) | |
13100 | & .EQ.36) IMIN=3 | |
13101 | IMAX=2 | |
13102 | IORD=1 | |
13103 | IF(K(IREF(IP,1),2).EQ.23) IORD=2 | |
13104 | IF(K(IREF(IP,1),2).EQ.24.AND.K(IREF(IP,2),2).EQ.-24) IORD=2 | |
13105 | IAKIPD=IABS(K(IREF(IP,IORD),2)) | |
13106 | IF(IAKIPD.EQ.25.OR.IAKIPD.EQ.35.OR.IAKIPD.EQ.36) IORD=3-IORD | |
13107 | IF(KDCY(IORD).EQ.0) IORD=3-IORD | |
13108 | ||
13109 | C...Order decay products of resonances. | |
13110 | DO 350 JT=IORD,3-IORD,3-2*IORD | |
13111 | IF(KDCY(JT).EQ.0) THEN | |
13112 | ILIN(IMAX+1)=NSD(JT) | |
13113 | IMAX=IMAX+1 | |
13114 | ELSEIF(K(NSD(JT)+1,2).GT.0) THEN | |
13115 | ILIN(IMAX+1)=N+2*JT-1 | |
13116 | ILIN(IMAX+2)=N+2*JT | |
13117 | IMAX=IMAX+2 | |
13118 | K(N+2*JT-1,2)=K(NSD(JT)+1,2) | |
13119 | K(N+2*JT,2)=K(NSD(JT)+2,2) | |
13120 | ELSE | |
13121 | ILIN(IMAX+1)=N+2*JT | |
13122 | ||
13123 | ILIN(IMAX+2)=N+2*JT-1 | |
13124 | IMAX=IMAX+2 | |
13125 | K(N+2*JT-1,2)=K(NSD(JT)+1,2) | |
13126 | K(N+2*JT,2)=K(NSD(JT)+2,2) | |
13127 | ENDIF | |
13128 | 350 CONTINUE | |
13129 | ||
13130 | C...Find charge, isospin, left- and righthanded couplings. | |
13131 | DO 370 I=IMIN,IMAX | |
13132 | DO 360 J=1,4 | |
13133 | COUP(I,J)=0D0 | |
13134 | 360 CONTINUE | |
13135 | KFA=IABS(K(ILIN(I),2)) | |
13136 | IF(KFA.EQ.0.OR.KFA.GT.20) GOTO 370 | |
13137 | COUP(I,1)=KCHG(KFA,1)/3D0 | |
13138 | COUP(I,2)=(-1)**MOD(KFA,2) | |
13139 | COUP(I,4)=-2D0*COUP(I,1)*XWV | |
13140 | COUP(I,3)=COUP(I,2)+COUP(I,4) | |
13141 | 370 CONTINUE | |
13142 | ||
13143 | C...Full propagator dependence and flavour correlations for 2 gamma*/Z. | |
13144 | IF(ISUB.EQ.22) THEN | |
13145 | DO 400 I=3,5,2 | |
13146 | I1=IORD | |
13147 | IF(I.EQ.5) I1=3-IORD | |
13148 | DO 390 J1=1,2 | |
13149 | DO 380 J2=1,2 | |
13150 | CORL(I/2,J1,J2)=COUP(1,1)**2*HGZ(I1,1)*COUP(I,1)**2/ | |
13151 | & 16D0+COUP(1,1)*COUP(1,J1+2)*HGZ(I1,2)*COUP(I,1)* | |
13152 | & COUP(I,J2+2)/4D0+COUP(1,J1+2)**2*HGZ(I1,3)* | |
13153 | & COUP(I,J2+2)**2 | |
13154 | 380 CONTINUE | |
13155 | 390 CONTINUE | |
13156 | 400 CONTINUE | |
13157 | COWT12=(CORL(1,1,1)+CORL(1,1,2))*(CORL(2,1,1)+CORL(2,1,2))+ | |
13158 | & (CORL(1,2,1)+CORL(1,2,2))*(CORL(2,2,1)+CORL(2,2,2)) | |
13159 | COMX12=(CORL(1,1,1)+CORL(1,1,2)+CORL(1,2,1)+CORL(1,2,2))* | |
13160 | & (CORL(2,1,1)+CORL(2,1,2)+CORL(2,2,1)+CORL(2,2,2)) | |
13161 | ||
13162 | IF(COWT12.LT.PYR(0)*COMX12) GOTO 160 | |
13163 | ENDIF | |
13164 | ENDIF | |
13165 | ||
13166 | C...Select angular orientation type - Z'/W' only. | |
13167 | MZPWP=0 | |
13168 | IF(ISUB.EQ.141) THEN | |
13169 | IF(PYR(0).LT.PARU(130)) MZPWP=1 | |
13170 | IF(IP.EQ.2) THEN | |
13171 | IF(IABS(K(IREF(2,1),2)).EQ.37) MZPWP=2 | |
13172 | IAKIR=IABS(K(IREF(2,2),2)) | |
13173 | IF(IAKIR.EQ.25.OR.IAKIR.EQ.35.OR.IAKIR.EQ.36) MZPWP=2 | |
13174 | IF(IAKIR.LE.20) MZPWP=2 | |
13175 | ENDIF | |
13176 | IF(IP.GE.3) MZPWP=2 | |
13177 | ELSEIF(ISUB.EQ.142) THEN | |
13178 | IF(PYR(0).LT.PARU(136)) MZPWP=1 | |
13179 | IF(IP.EQ.2) THEN | |
13180 | IAKIR=IABS(K(IREF(2,2),2)) | |
13181 | IF(IAKIR.EQ.25.OR.IAKIR.EQ.35.OR.IAKIR.EQ.36) MZPWP=2 | |
13182 | IF(IAKIR.LE.20) MZPWP=2 | |
13183 | ENDIF | |
13184 | IF(IP.GE.3) MZPWP=2 | |
13185 | ENDIF | |
13186 | ||
13187 | C...Select random angles (begin of weighting procedure). | |
13188 | 410 DO 420 JT=1,JTMAX | |
13189 | IF(KDCY(JT).EQ.0) GOTO 420 | |
13190 | IF(JTMAX.EQ.1.AND.ISUB.NE.0.AND.IHDEC.EQ.0) THEN | |
13191 | CTHE(JT)=VINT(13)+(VINT(33)-VINT(13)+VINT(34)-VINT(14))*PYR(0) | |
13192 | IF(CTHE(JT).GT.VINT(33)) CTHE(JT)=CTHE(JT)+VINT(14)-VINT(33) | |
13193 | PHI(JT)=VINT(24) | |
13194 | ELSE | |
13195 | CTHE(JT)=2D0*PYR(0)-1D0 | |
13196 | PHI(JT)=PARU(2)*PYR(0) | |
13197 | ENDIF | |
13198 | 420 CONTINUE | |
13199 | ||
13200 | IF(JTMAX.EQ.2.AND.MSTP(47).GE.1.AND.NINH.EQ.0) THEN | |
13201 | C...Construct massless four-vectors. | |
13202 | DO 440 I=N+1,N+4 | |
13203 | K(I,1)=1 | |
13204 | DO 430 J=1,5 | |
13205 | P(I,J)=0D0 | |
13206 | V(I,J)=0D0 | |
13207 | 430 CONTINUE | |
13208 | 440 CONTINUE | |
13209 | DO 450 JT=1,JTMAX | |
13210 | IF(KDCY(JT).EQ.0) GOTO 450 | |
13211 | ID=IREF(IP,JT) | |
13212 | P(N+2*JT-1,3)=0.5D0*P(ID,5) | |
13213 | P(N+2*JT-1,4)=0.5D0*P(ID,5) | |
13214 | P(N+2*JT,3)=-0.5D0*P(ID,5) | |
13215 | P(N+2*JT,4)=0.5D0*P(ID,5) | |
13216 | CALL PYROBO(N+2*JT-1,N+2*JT,ACOS(CTHE(JT)),PHI(JT), | |
13217 | & P(ID,1)/P(ID,4),P(ID,2)/P(ID,4),P(ID,3)/P(ID,4)) | |
13218 | 450 CONTINUE | |
13219 | ||
13220 | C...Store incoming and outgoing momenta, with random rotation to | |
13221 | C...avoid accidental zeroes in HA expressions. | |
13222 | IF(ISUB.NE.0) THEN | |
13223 | DO 470 I=IMIN,IMAX | |
13224 | K(N+4+I,1)=1 | |
13225 | P(N+4+I,4)=SQRT(P(ILIN(I),1)**2+P(ILIN(I),2)**2+ | |
13226 | & P(ILIN(I),3)**2+P(ILIN(I),5)**2) | |
13227 | P(N+4+I,5)=P(ILIN(I),5) | |
13228 | DO 460 J=1,3 | |
13229 | P(N+4+I,J)=P(ILIN(I),J) | |
13230 | 460 CONTINUE | |
13231 | 470 CONTINUE | |
13232 | 480 THERR=ACOS(2D0*PYR(0)-1D0) | |
13233 | PHIRR=PARU(2)*PYR(0) | |
13234 | CALL PYROBO(N+4+IMIN,N+4+IMAX,THERR,PHIRR,0D0,0D0,0D0) | |
13235 | DO 500 I=IMIN,IMAX | |
13236 | IF(P(N+4+I,1)**2+P(N+4+I,2)**2.LT.1D-4*P(N+4+I,4)**2) | |
13237 | & GOTO 480 | |
13238 | DO 490 J=1,4 | |
13239 | PK(I,J)=P(N+4+I,J) | |
13240 | 490 CONTINUE | |
13241 | 500 CONTINUE | |
13242 | ENDIF | |
13243 | ||
13244 | C...Calculate internal products. | |
13245 | IF(ISUB.EQ.22.OR.ISUB.EQ.23.OR.ISUB.EQ.25.OR.ISUB.EQ.141.OR. | |
13246 | & ISUB.EQ.142) THEN | |
13247 | DO 520 I1=IMIN,IMAX-1 | |
13248 | DO 510 I2=I1+1,IMAX | |
13249 | HA(I1,I2)=SNGL(SQRT((PK(I1,4)-PK(I1,3))*(PK(I2,4)+ | |
13250 | & PK(I2,3))/(1D-20+PK(I1,1)**2+PK(I1,2)**2)))* | |
13251 | & CMPLX(SNGL(PK(I1,1)),SNGL(PK(I1,2)))- | |
13252 | & SNGL(SQRT((PK(I1,4)+PK(I1,3))*(PK(I2,4)-PK(I2,3))/ | |
13253 | & (1D-20+PK(I2,1)**2+PK(I2,2)**2)))* | |
13254 | & CMPLX(SNGL(PK(I2,1)),SNGL(PK(I2,2))) | |
13255 | HC(I1,I2)=CONJG(HA(I1,I2)) | |
13256 | IF(I1.LE.2) HA(I1,I2)=CMPLX(0.,1.)*HA(I1,I2) | |
13257 | IF(I1.LE.2) HC(I1,I2)=CMPLX(0.,1.)*HC(I1,I2) | |
13258 | HA(I2,I1)=-HA(I1,I2) | |
13259 | HC(I2,I1)=-HC(I1,I2) | |
13260 | 510 CONTINUE | |
13261 | 520 CONTINUE | |
13262 | ENDIF | |
13263 | ||
13264 | C...Calculate four-products. | |
13265 | IF(ISUB.NE.0) THEN | |
13266 | DO 540 I=1,2 | |
13267 | DO 530 J=1,4 | |
13268 | PK(I,J)=-PK(I,J) | |
13269 | 530 CONTINUE | |
13270 | 540 CONTINUE | |
13271 | DO 560 I1=IMIN,IMAX-1 | |
13272 | DO 550 I2=I1+1,IMAX | |
13273 | PKK(I1,I2)=2D0*(PK(I1,4)*PK(I2,4)-PK(I1,1)*PK(I2,1)- | |
13274 | & PK(I1,2)*PK(I2,2)-PK(I1,3)*PK(I2,3)) | |
13275 | PKK(I2,I1)=PKK(I1,I2) | |
13276 | 550 CONTINUE | |
13277 | 560 CONTINUE | |
13278 | ENDIF | |
13279 | ENDIF | |
13280 | ||
13281 | KFAGM=IABS(IREF(IP,7)) | |
13282 | IF(MSTP(47).LE.0.OR.NINH.NE.0) THEN | |
13283 | C...Isotropic decay selected by user. | |
13284 | WT=1D0 | |
13285 | WTMAX=1D0 | |
13286 | ||
13287 | ELSEIF(JTMAX.EQ.3) THEN | |
13288 | C...Isotropic decay when three mother particles. | |
13289 | WT=1D0 | |
13290 | WTMAX=1D0 | |
13291 | ||
13292 | ELSEIF(IT4.GE.1) THEN | |
13293 | C... Isotropic decay t -> b + W etc for 4th generation q and l. | |
13294 | WT=1D0 | |
13295 | WTMAX=1D0 | |
13296 | ||
13297 | ELSEIF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR. | |
13298 | & IREF(IP,7).EQ.36) THEN | |
13299 | C...Angular weight for h0/A0 -> Z0 + Z0 or W+ + W- -> 4 quarks/leptons. | |
13300 | C...CP-odd case added by Kari Ertresvag Myklevoll. | |
13301 | IF(IP.EQ.1) WTMAX=SH**2 | |
13302 | IF(IP.GE.2) WTMAX=P(IREF(IP,8),5)**4 | |
13303 | KFA=IABS(K(IREF(IP,1),2)) | |
13304 | IF(KFA.EQ.23) THEN | |
13305 | KFLF1A=IABS(KFL1(1)) | |
13306 | EF1=KCHG(KFLF1A,1)/3D0 | |
13307 | AF1=SIGN(1D0,EF1+0.1D0) | |
13308 | VF1=AF1-4D0*EF1*XWV | |
13309 | KFLF2A=IABS(KFL1(2)) | |
13310 | EF2=KCHG(KFLF2A,1)/3D0 | |
13311 | AF2=SIGN(1D0,EF2+0.1D0) | |
13312 | VF2=AF2-4D0*EF2*XWV | |
13313 | VA12AS=4D0*VF1*AF1*VF2*AF2/((VF1**2+AF1**2) | |
13314 | & *(VF2**2+AF2**2)) | |
13315 | IF((MSTP(25).EQ.0.AND.IREF(IP,7).NE.36).OR.MSTP(25).EQ.1) | |
13316 | & THEN | |
13317 | C...CP-even decay | |
13318 | WT=8D0*(1D0+VA12AS)*PKK(3,5)*PKK(4,6)+ | |
13319 | & 8D0*(1D0-VA12AS)*PKK(3,6)*PKK(4,5) | |
13320 | ELSE | |
13321 | C...CP-odd decay | |
13322 | WT=((PKK(3,5)+PKK(4,6))**2 +(PKK(3,6)+PKK(4,5))**2 | |
13323 | & -2*PKK(3,4)*PKK(5,6) | |
13324 | & -2*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2/ | |
13325 | & (PKK(3,4)*PKK(5,6)) | |
13326 | & +VA12AS*(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6))* | |
13327 | & (PKK(3,5)+PKK(4,5)-PKK(3,6)-PKK(4,6)))/(1+VA12AS) | |
13328 | ENDIF | |
13329 | ELSEIF(KFA.EQ.24) THEN | |
13330 | IF((MSTP(25).EQ.0.AND.IREF(IP,7).NE.36).OR.MSTP(25).EQ.1) | |
13331 | & THEN | |
13332 | C...CP-even decay | |
13333 | WT=16D0*PKK(3,5)*PKK(4,6) | |
13334 | ELSE | |
13335 | C...CP-odd decay | |
13336 | WT=0.5D0*((PKK(3,5)+PKK(4,6))**2 +(PKK(3,6)+PKK(4,5))**2 | |
13337 | & -2*PKK(3,4)*PKK(5,6) | |
13338 | & -2*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2/ | |
13339 | & (PKK(3,4)*PKK(5,6)) | |
13340 | & +(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6))* | |
13341 | & (PKK(3,5)+PKK(4,5)-PKK(3,6)-PKK(4,6))) | |
13342 | ENDIF | |
13343 | ELSE | |
13344 | WT=WTMAX | |
13345 | ENDIF | |
13346 | ||
13347 | ELSEIF((KFAGM.EQ.6.OR.KFAGM.EQ.7.OR.KFAGM.EQ.8.OR. | |
13348 | & KFAGM.EQ.17.OR.KFAGM.EQ.18).AND.IABS(K(IREF(IP,1),2)).EQ.24) | |
13349 | & THEN | |
13350 | C...Angular correlation in f -> f' + W -> f' + 2 quarks/leptons. | |
13351 | I1=IREF(IP,8) | |
13352 | IF(MOD(KFAGM,2).EQ.0) THEN | |
13353 | I2=N+1 | |
13354 | I3=N+2 | |
13355 | ELSE | |
13356 | I2=N+2 | |
13357 | I3=N+1 | |
13358 | ENDIF | |
13359 | I4=IREF(IP,2) | |
13360 | WT=(P(I1,4)*P(I2,4)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)- | |
13361 | & P(I1,3)*P(I2,3))*(P(I3,4)*P(I4,4)-P(I3,1)*P(I4,1)- | |
13362 | & P(I3,2)*P(I4,2)-P(I3,3)*P(I4,3)) | |
13363 | WTMAX=(P(I1,5)**4-P(IREF(IP,1),5)**4)/8D0 | |
13364 | ||
13365 | ELSEIF(ISUB.EQ.1) THEN | |
13366 | C...Angular weight for gamma*/Z0 -> 2 quarks/leptons. | |
13367 | EI=KCHG(IABS(MINT(15)),1)/3D0 | |
13368 | AI=SIGN(1D0,EI+0.1D0) | |
13369 | VI=AI-4D0*EI*XWV | |
13370 | EF=KCHG(IABS(KFL1(1)),1)/3D0 | |
13371 | AF=SIGN(1D0,EF+0.1D0) | |
13372 | ||
13373 | VF=AF-4D0*EF*XWV | |
13374 | RMF=MIN(1D0,4D0*PMAS(IABS(KFL1(1)),1)**2/SH) | |
13375 | WT1=EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ | |
13376 | & (VI**2+AI**2)*VINT(114)*(VF**2+(1D0-RMF)*AF**2) | |
13377 | WT2=RMF*(EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ | |
13378 | & (VI**2+AI**2)*VINT(114)*VF**2) | |
13379 | WT3=SQRT(1D0-RMF)*(EI*AI*VINT(112)*EF*AF+ | |
13380 | & 4D0*VI*AI*VINT(114)*VF*AF) | |
13381 | WT=WT1*(1D0+CTHE(1)**2)+WT2*(1D0-CTHE(1)**2)+ | |
13382 | & 2D0*WT3*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)) | |
13383 | WTMAX=2D0*(WT1+ABS(WT3)) | |
13384 | ||
13385 | ELSEIF(ISUB.EQ.2) THEN | |
13386 | C...Angular weight for W+/- -> 2 quarks/leptons. | |
13387 | RM3=PMAS(IABS(KFL1(1)),1)**2/SH | |
13388 | RM4=PMAS(IABS(KFL2(1)),1)**2/SH | |
13389 | BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) | |
13390 | WT=(1D0+BE34*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)))**2-(RM3-RM4)**2 | |
13391 | WTMAX=4D0 | |
13392 | ||
13393 | ELSEIF(ISUB.EQ.15.OR.ISUB.EQ.19) THEN | |
13394 | C...Angular weight for f + fbar -> gluon/gamma + (gamma*/Z0) -> | |
13395 | C...-> gluon/gamma + 2 quarks/leptons. | |
13396 | CLILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ | |
13397 | & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ | |
13398 | & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,3)**2 | |
13399 | CLIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ | |
13400 | & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ | |
13401 | & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,4)**2 | |
13402 | CRILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ | |
13403 | & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ | |
13404 | & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,3)**2 | |
13405 | CRIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ | |
13406 | & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ | |
13407 | & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,4)**2 | |
13408 | WT=(CLILF+CRIRF)*(PKK(1,3)**2+PKK(2,4)**2)+ | |
13409 | & (CLIRF+CRILF)*(PKK(1,4)**2+PKK(2,3)**2) | |
13410 | WTMAX=(CLILF+CLIRF+CRILF+CRIRF)* | |
13411 | & ((PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2) | |
13412 | ||
13413 | ELSEIF(ISUB.EQ.16.OR.ISUB.EQ.20) THEN | |
13414 | C...Angular weight for f + fbar' -> gluon/gamma + W+/- -> | |
13415 | C...-> gluon/gamma + 2 quarks/leptons. | |
13416 | WT=PKK(1,3)**2+PKK(2,4)**2 | |
13417 | WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2 | |
13418 | ||
13419 | ELSEIF(ISUB.EQ.22) THEN | |
13420 | C...Angular weight for f + fbar -> Z0 + Z0 -> 4 quarks/leptons. | |
13421 | S34=P(IREF(IP,IORD),5)**2 | |
13422 | S56=P(IREF(IP,3-IORD),5)**2 | |
13423 | TI=PKK(1,3)+PKK(1,4)+S34 | |
13424 | UI=PKK(1,5)+PKK(1,6)+S56 | |
13425 | TIR=REAL(TI) | |
13426 | UIR=REAL(UI) | |
13427 | FGK135=ABS(FGK(1,2,3,4,5,6)/TIR+FGK(1,2,5,6,3,4)/UIR)**2 | |
13428 | FGK145=ABS(FGK(1,2,4,3,5,6)/TIR+FGK(1,2,5,6,4,3)/UIR)**2 | |
13429 | FGK136=ABS(FGK(1,2,3,4,6,5)/TIR+FGK(1,2,6,5,3,4)/UIR)**2 | |
13430 | FGK146=ABS(FGK(1,2,4,3,6,5)/TIR+FGK(1,2,6,5,4,3)/UIR)**2 | |
13431 | FGK253=ABS(FGK(2,1,5,6,3,4)/TIR+FGK(2,1,3,4,5,6)/UIR)**2 | |
13432 | FGK263=ABS(FGK(2,1,6,5,3,4)/TIR+FGK(2,1,3,4,6,5)/UIR)**2 | |
13433 | FGK254=ABS(FGK(2,1,5,6,4,3)/TIR+FGK(2,1,4,3,5,6)/UIR)**2 | |
13434 | FGK264=ABS(FGK(2,1,6,5,4,3)/TIR+FGK(2,1,4,3,6,5)/UIR)**2 | |
13435 | ||
13436 | WT= | |
13437 | & CORL(1,1,1)*CORL(2,1,1)*FGK135+CORL(1,1,2)*CORL(2,1,1)*FGK145+ | |
13438 | & CORL(1,1,1)*CORL(2,1,2)*FGK136+CORL(1,1,2)*CORL(2,1,2)*FGK146+ | |
13439 | & CORL(1,2,1)*CORL(2,2,1)*FGK253+CORL(1,2,2)*CORL(2,2,1)*FGK263+ | |
13440 | & CORL(1,2,1)*CORL(2,2,2)*FGK254+CORL(1,2,2)*CORL(2,2,2)*FGK264 | |
13441 | WTMAX=16D0*((CORL(1,1,1)+CORL(1,1,2))*(CORL(2,1,1)+CORL(2,1,2))+ | |
13442 | & (CORL(1,2,1)+CORL(1,2,2))*(CORL(2,2,1)+CORL(2,2,2)))*S34*S56* | |
13443 | & ((TI**2+UI**2+2D0*SH*(S34+S56))/(TI*UI)-S34*S56*(1D0/TI**2+ | |
13444 | & 1D0/UI**2)) | |
13445 | ||
13446 | ELSEIF(ISUB.EQ.23) THEN | |
13447 | C...Angular weight for f + fbar' -> Z0 + W+/- -> 4 quarks/leptons. | |
13448 | D34=P(IREF(IP,IORD),5)**2 | |
13449 | D56=P(IREF(IP,3-IORD),5)**2 | |
13450 | DT=PKK(1,3)+PKK(1,4)+D34 | |
13451 | DU=PKK(1,5)+PKK(1,6)+D56 | |
13452 | FACBW=1D0/((SH-SQMW)**2+GMMW**2) | |
13453 | CAWZ=COUP(2,3)/DT-2D0*XW1*COUP(1,2)*(SH-SQMW)*FACBW | |
13454 | CBWZ=COUP(1,3)/DU+2D0*XW1*COUP(1,2)*(SH-SQMW)*FACBW | |
13455 | FGK135=ABS(REAL(CAWZ)*FGK(1,2,3,4,5,6)+ | |
13456 | ||
13457 | & REAL(CBWZ)*FGK(1,2,5,6,3,4)) | |
13458 | FGK136=ABS(REAL(CAWZ)*FGK(1,2,3,4,6,5)+ | |
13459 | & REAL(CBWZ)*FGK(1,2,6,5,3,4)) | |
13460 | WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2 | |
13461 | WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)*(CAWZ**2* | |
13462 | & DIGK(DT,DU)+CBWZ**2*DIGK(DU,DT)+CAWZ*CBWZ*DJGK(DT,DU)) | |
13463 | ||
13464 | ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN | |
13465 | C...Angular weight for f + fbar -> Z0 + h0 -> 2 quarks/leptons + h0 | |
13466 | C...(or H0, or A0). | |
13467 | WT=((COUP(1,3)*COUP(3,3))**2+(COUP(1,4)*COUP(3,4))**2)* | |
13468 | & PKK(1,3)*PKK(2,4)+((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)* | |
13469 | & COUP(3,3))**2)*PKK(1,4)*PKK(2,3) | |
13470 | WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)* | |
13471 | & (PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) | |
13472 | ||
13473 | ELSEIF(ISUB.EQ.25) THEN | |
13474 | C...Angular weight for f + fbar -> W+ + W- -> 4 quarks/leptons. | |
13475 | POLR=(1D0+PARJ(132))*(1D0-PARJ(131)) | |
13476 | POLL=(1D0-PARJ(132))*(1D0+PARJ(131)) | |
13477 | D34=P(IREF(IP,IORD),5)**2 | |
13478 | D56=P(IREF(IP,3-IORD),5)**2 | |
13479 | DT=PKK(1,3)+PKK(1,4)+D34 | |
13480 | DU=PKK(1,5)+PKK(1,6)+D56 | |
13481 | FACBW=1D0/((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2) | |
13482 | CDWW=(COUP(1,3)*SQMZ*(SH-SQMZ)*FACBW+COUP(1,2))/SH | |
13483 | CAWW=CDWW+0.5D0*(COUP(1,2)+1D0)/DT | |
13484 | CBWW=CDWW+0.5D0*(COUP(1,2)-1D0)/DU | |
13485 | CCWW=COUP(1,4)*SQMZ*(SH-SQMZ)*FACBW/SH | |
13486 | FGK135=ABS(REAL(CAWW)*FGK(1,2,3,4,5,6)- | |
13487 | & REAL(CBWW)*FGK(1,2,5,6,3,4)) | |
13488 | FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) | |
13489 | IF(MSTP(50).LE.0) THEN | |
13490 | WT=FGK135**2+(CCWW*FGK253)**2 | |
13491 | WTMAX=4D0*D34*D56*(CAWW**2*DIGK(DT,DU)+CBWW**2*DIGK(DU,DT)- | |
13492 | & CAWW*CBWW*DJGK(DT,DU)+CCWW**2*(DIGK(DT,DU)+DIGK(DU,DT)- | |
13493 | & DJGK(DT,DU))) | |
13494 | ELSE | |
13495 | WT=POLL*FGK135**2+POLR*(CCWW*FGK253)**2 | |
13496 | WTMAX=4D0*D34*D56*(POLL*(CAWW**2*DIGK(DT,DU)+ | |
13497 | & CBWW**2*DIGK(DU,DT)-CAWW*CBWW*DJGK(DT,DU))+ | |
13498 | & POLR*CCWW**2*(DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU))) | |
13499 | ENDIF | |
13500 | ||
13501 | ELSEIF(ISUB.EQ.26.OR.ISUB.EQ.172.OR.ISUB.EQ.177) THEN | |
13502 | C...Angular weight for f + fbar' -> W+/- + h0 -> 2 quarks/leptons + h0 | |
13503 | C...(or H0, or A0). | |
13504 | WT=PKK(1,3)*PKK(2,4) | |
13505 | WTMAX=(PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) | |
13506 | ||
13507 | ELSEIF(ISUB.EQ.30.OR.ISUB.EQ.35) THEN | |
13508 | C...Angular weight for f + g/gamma -> f + (gamma*/Z0) | |
13509 | C...-> f + 2 quarks/leptons. | |
13510 | CLILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ | |
13511 | & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ | |
13512 | & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,3)**2 | |
13513 | CLIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ | |
13514 | & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ | |
13515 | & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,4)**2 | |
13516 | CRILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ | |
13517 | & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ | |
13518 | & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,3)**2 | |
13519 | CRIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ | |
13520 | & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ | |
13521 | & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,4)**2 | |
13522 | IF(K(ILIN(1),2).GT.0) WT=(CLILF+CRIRF)*(PKK(1,4)**2+ | |
13523 | & PKK(3,5)**2)+(CLIRF+CRILF)*(PKK(1,3)**2+PKK(4,5)**2) | |
13524 | IF(K(ILIN(1),2).LT.0) WT=(CLILF+CRIRF)*(PKK(1,3)**2+ | |
13525 | & PKK(4,5)**2)+(CLIRF+CRILF)*(PKK(1,4)**2+PKK(3,5)**2) | |
13526 | WTMAX=(CLILF+CLIRF+CRILF+CRIRF)* | |
13527 | & ((PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2) | |
13528 | ||
13529 | ELSEIF(ISUB.EQ.31.OR.ISUB.EQ.36) THEN | |
13530 | C...Angular weight for f + g/gamma -> f' + W+/- -> f' + 2 fermions. | |
13531 | IF(K(ILIN(1),2).GT.0) WT=PKK(1,4)**2+PKK(3,5)**2 | |
13532 | IF(K(ILIN(1),2).LT.0) WT=PKK(1,3)**2+PKK(4,5)**2 | |
13533 | WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2 | |
13534 | ||
13535 | ELSEIF(ISUB.EQ.71.OR.ISUB.EQ.72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR. | |
13536 | & ISUB.EQ.77) THEN | |
13537 | C...Angular weight for V_L1 + V_L2 -> V_L3 + V_L4 (V = Z/W). | |
13538 | WT=16D0*PKK(3,5)*PKK(4,6) | |
13539 | WTMAX=SH**2 | |
13540 | ||
13541 | ELSEIF(ISUB.EQ.110) THEN | |
13542 | C...Angular weight for f + fbar -> gamma + h0 -> gamma + X is isotropic. | |
13543 | WT=1D0 | |
13544 | WTMAX=1D0 | |
13545 | ||
13546 | ELSEIF(ISUB.EQ.141) THEN | |
13547 | IF(IP.EQ.1.AND.IABS(KFL1(1)).LT.20) THEN | |
13548 | C...Angular weight for f + fbar -> gamma*/Z0/Z'0 -> 2 quarks/leptons. | |
13549 | C...Couplings of incoming flavour. | |
13550 | KFAI=IABS(MINT(15)) | |
13551 | EI=KCHG(KFAI,1)/3D0 | |
13552 | AI=SIGN(1D0,EI+0.1D0) | |
13553 | VI=AI-4D0*EI*XWV | |
13554 | KFAIC=1 | |
13555 | IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2 | |
13556 | IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3 | |
13557 | IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4 | |
13558 | IF(KFAI.LE.2.OR.KFAI.EQ.11.OR.KFAI.EQ.12) THEN | |
13559 | VPI=PARU(119+2*KFAIC) | |
13560 | API=PARU(120+2*KFAIC) | |
13561 | ELSEIF(KFAI.LE.4.OR.KFAI.EQ.13.OR.KFAI.EQ.14) THEN | |
13562 | VPI=PARJ(178+2*KFAIC) | |
13563 | API=PARJ(179+2*KFAIC) | |
13564 | ELSE | |
13565 | VPI=PARJ(186+2*KFAIC) | |
13566 | API=PARJ(187+2*KFAIC) | |
13567 | ENDIF | |
13568 | C...Couplings of final flavour. | |
13569 | KFAF=IABS(KFL1(1)) | |
13570 | EF=KCHG(KFAF,1)/3D0 | |
13571 | AF=SIGN(1D0,EF+0.1D0) | |
13572 | VF=AF-4D0*EF*XWV | |
13573 | KFAFC=1 | |
13574 | IF(KFAF.LE.10.AND.MOD(KFAF,2).EQ.0) KFAFC=2 | |
13575 | IF(KFAF.GT.10.AND.MOD(KFAF,2).NE.0) KFAFC=3 | |
13576 | IF(KFAF.GT.10.AND.MOD(KFAF,2).EQ.0) KFAFC=4 | |
13577 | IF(KFAF.LE.2.OR.KFAF.EQ.11.OR.KFAF.EQ.12) THEN | |
13578 | VPF=PARU(119+2*KFAFC) | |
13579 | APF=PARU(120+2*KFAFC) | |
13580 | ELSEIF(KFAF.LE.4.OR.KFAF.EQ.13.OR.KFAF.EQ.14) THEN | |
13581 | VPF=PARJ(178+2*KFAFC) | |
13582 | APF=PARJ(179+2*KFAFC) | |
13583 | ELSE | |
13584 | VPF=PARJ(186+2*KFAFC) | |
13585 | APF=PARJ(187+2*KFAFC) | |
13586 | ENDIF | |
13587 | C...Asymmetry and weight. | |
13588 | ASYM=2D0*(EI*AI*VINT(112)*EF*AF+EI*API*VINT(113)*EF*APF+ | |
13589 | & 4D0*VI*AI*VINT(114)*VF*AF+(VI*API+VPI*AI)*VINT(115)* | |
13590 | & (VF*APF+VPF*AF)+4D0*VPI*API*VINT(116)*VPF*APF)/ | |
13591 | & (EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ | |
13592 | & EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* | |
13593 | & (VF**2+AF**2)+(VI*VPI+AI*API)*VINT(115)*(VF*VPF+AF*APF)+ | |
13594 | & (VPI**2+API**2)*VINT(116)*(VPF**2+APF**2)) | |
13595 | WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 | |
13596 | WTMAX=2D0+ABS(ASYM) | |
13597 | ELSEIF(IP.EQ.1.AND.IABS(KFL1(1)).EQ.24) THEN | |
13598 | C...Angular weight for f + fbar -> Z' -> W+ + W-. | |
13599 | RM1=P(NSD(1)+1,5)**2/SH | |
13600 | RM2=P(NSD(1)+2,5)**2/SH | |
13601 | CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* | |
13602 | & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) | |
13603 | CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ | |
13604 | & (RM2-RM1)**2) | |
13605 | WT=CFLAT+CCOS2*CTHE(1)**2 | |
13606 | WTMAX=CFLAT+MAX(0D0,CCOS2) | |
13607 | ELSEIF(IP.EQ.1.AND.(KFL1(1).EQ.25.OR.KFL1(1).EQ.35.OR. | |
13608 | & IABS(KFL1(1)).EQ.37)) THEN | |
13609 | C...Angular weight for f + fbar -> Z' -> h0 + A0, H0 + A0, H+ + H-. | |
13610 | WT=1D0-CTHE(1)**2 | |
13611 | WTMAX=1D0 | |
13612 | ELSEIF(IP.EQ.1.AND.KFL2(1).EQ.25) THEN | |
13613 | C...Angular weight for f + fbar -> Z' -> Z0 + h0. | |
13614 | RM1=P(NSD(1)+1,5)**2/SH | |
13615 | RM2=P(NSD(1)+2,5)**2/SH | |
13616 | FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) | |
13617 | WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) | |
13618 | WTMAX=1D0+FLAM2/(8D0*RM1) | |
13619 | ELSEIF(MZPWP.EQ.0) THEN | |
13620 | C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons | |
13621 | C...(W:s like if intermediate Z). | |
13622 | D34=P(IREF(IP,IORD),5)**2 | |
13623 | D56=P(IREF(IP,3-IORD),5)**2 | |
13624 | DT=PKK(1,3)+PKK(1,4)+D34 | |
13625 | DU=PKK(1,5)+PKK(1,6)+D56 | |
13626 | FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) | |
13627 | FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) | |
13628 | WT=(COUP(1,3)*FGK135)**2+(COUP(1,4)*FGK253)**2 | |
13629 | WTMAX=4D0*D34*D56*(COUP(1,3)**2+COUP(1,4)**2)* | |
13630 | & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) | |
13631 | ELSEIF(MZPWP.EQ.1) THEN | |
13632 | C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons | |
13633 | C...(W:s approximately longitudinal, like if intermediate H). | |
13634 | WT=16D0*PKK(3,5)*PKK(4,6) | |
13635 | WTMAX=SH**2 | |
13636 | ELSE | |
13637 | C...Angular weight for f + fbar -> Z' -> H+ + H-, Z0 + h0, h0 + A0, | |
13638 | C...H0 + A0 -> 4 quarks/leptons, t + tbar -> b + W+ + bbar + W- . | |
13639 | WT=1D0 | |
13640 | WTMAX=1D0 | |
13641 | ENDIF | |
13642 | ||
13643 | ELSEIF(ISUB.EQ.142) THEN | |
13644 | IF(IP.EQ.1.AND.IABS(KFL1(1)).LT.20) THEN | |
13645 | C...Angular weight for f + fbar' -> W'+/- -> 2 quarks/leptons. | |
13646 | KFAI=IABS(MINT(15)) | |
13647 | KFAIC=1 | |
13648 | IF(KFAI.GT.10) KFAIC=2 | |
13649 | VI=PARU(129+2*KFAIC) | |
13650 | AI=PARU(130+2*KFAIC) | |
13651 | KFAF=IABS(KFL1(1)) | |
13652 | KFAFC=1 | |
13653 | IF(KFAF.GT.10) KFAFC=2 | |
13654 | VF=PARU(129+2*KFAFC) | |
13655 | AF=PARU(130+2*KFAFC) | |
13656 | ASYM=8D0*VI*AI*VF*AF/((VI**2+AI**2)*(VF**2+AF**2)) | |
13657 | WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 | |
13658 | WTMAX=2D0+ABS(ASYM) | |
13659 | ELSEIF(IP.EQ.1.AND.IABS(KFL2(1)).EQ.23) THEN | |
13660 | C...Angular weight for f + fbar' -> W'+/- -> W+/- + Z0. | |
13661 | RM1=P(NSD(1)+1,5)**2/SH | |
13662 | RM2=P(NSD(1)+2,5)**2/SH | |
13663 | CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* | |
13664 | & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) | |
13665 | CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ | |
13666 | & (RM2-RM1)**2) | |
13667 | WT=CFLAT+CCOS2*CTHE(1)**2 | |
13668 | WTMAX=CFLAT+MAX(0D0,CCOS2) | |
13669 | ELSEIF(IP.EQ.1.AND.KFL2(1).EQ.25) THEN | |
13670 | C...Angular weight for f + fbar -> W'+/- -> W+/- + h0. | |
13671 | RM1=P(NSD(1)+1,5)**2/SH | |
13672 | RM2=P(NSD(1)+2,5)**2/SH | |
13673 | FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) | |
13674 | WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) | |
13675 | WTMAX=1D0+FLAM2/(8D0*RM1) | |
13676 | ELSEIF(MZPWP.EQ.0) THEN | |
13677 | C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons | |
13678 | C...(W/Z like if intermediate W). | |
13679 | D34=P(IREF(IP,IORD),5)**2 | |
13680 | D56=P(IREF(IP,3-IORD),5)**2 | |
13681 | DT=PKK(1,3)+PKK(1,4)+D34 | |
13682 | DU=PKK(1,5)+PKK(1,6)+D56 | |
13683 | FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) | |
13684 | FGK136=ABS(FGK(1,2,3,4,6,5)-FGK(1,2,6,5,3,4)) | |
13685 | WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2 | |
13686 | WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)* | |
13687 | & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) | |
13688 | ELSEIF(MZPWP.EQ.1) THEN | |
13689 | C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons | |
13690 | C...(W/Z approximately longitudinal, like if intermediate H). | |
13691 | WT=16D0*PKK(3,5)*PKK(4,6) | |
13692 | WTMAX=SH**2 | |
13693 | ELSE | |
13694 | C...Angular weight for f + fbar -> W' -> W + h0 -> whatever, | |
13695 | C...t + bbar -> t + W + bbar. | |
13696 | WT=1D0 | |
13697 | WTMAX=1D0 | |
13698 | ENDIF | |
13699 | ||
13700 | ELSEIF(ISUB.EQ.145.OR.ISUB.EQ.162.OR.ISUB.EQ.163.OR.ISUB.EQ.164) | |
13701 | & THEN | |
13702 | C...Isotropic decay of leptoquarks (assumed spin 0). | |
13703 | WT=1D0 | |
13704 | WTMAX=1D0 | |
13705 | ||
13706 | ELSEIF(ISUB.GE.146.AND.ISUB.LE.148) THEN | |
13707 | C...Decays of (spin 1/2) q*/e* -> q/e + (g,gamma) or (Z0,W+-). | |
13708 | SIDE=1D0 | |
13709 | IF(MINT(16).EQ.21.OR.MINT(16).EQ.22) SIDE=-1D0 | |
13710 | IF(IP.EQ.1.AND.(KFL1(1).EQ.21.OR.KFL1(1).EQ.22)) THEN | |
13711 | WT=1D0+SIDE*CTHE(1) | |
13712 | WTMAX=2D0 | |
13713 | ELSEIF(IP.EQ.1) THEN | |
13714 | ||
13715 | RM1=P(NSD(1)+1,5)**2/SH | |
13716 | WT=1D0+SIDE*CTHE(1)*(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) | |
13717 | WTMAX=1D0+(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) | |
13718 | ELSE | |
13719 | C...W/Z decay assumed isotropic, since not known. | |
13720 | WT=1D0 | |
13721 | WTMAX=1D0 | |
13722 | ENDIF | |
13723 | ||
13724 | ELSEIF(ISUB.EQ.149) THEN | |
13725 | C...Isotropic decay of techni-eta. | |
13726 | WT=1D0 | |
13727 | WTMAX=1D0 | |
13728 | ||
13729 | ELSEIF(ISUB.EQ.191) THEN | |
13730 | IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN | |
13731 | C...Angular weight for f + fbar -> rho_tc0 -> W+ W-, | |
13732 | C...W+ pi_tc-, pi_tc+ W- or pi_tc+ pi_tc-. | |
13733 | WT=1D0-CTHE(1)**2 | |
13734 | WTMAX=1D0 | |
13735 | ELSEIF(IP.EQ.1) THEN | |
13736 | C...Angular weight for f + fbar -> rho_tc0 -> f fbar. | |
13737 | CTHESG=CTHE(1)*ISIGN(1,MINT(15)) | |
13738 | XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) | |
13739 | BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) | |
13740 | BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) | |
13741 | KFAI=IABS(MINT(15)) | |
13742 | EI=KCHG(KFAI,1)/3D0 | |
13743 | AI=SIGN(1D0,EI+0.1D0) | |
13744 | VI=AI-4D0*EI*XWV | |
13745 | VALI=0.5D0*(VI+AI) | |
13746 | VARI=0.5D0*(VI-AI) | |
13747 | ALEFTI=(EI+VALI*BWZR)**2+(VALI*BWZI)**2 | |
13748 | ARIGHI=(EI+VARI*BWZR)**2+(VARI*BWZI)**2 | |
13749 | KFAF=IABS(KFL1(1)) | |
13750 | EF=KCHG(KFAF,1)/3D0 | |
13751 | AF=SIGN(1D0,EF+0.1D0) | |
13752 | VF=AF-4D0*EF*XWV | |
13753 | VALF=0.5D0*(VF+AF) | |
13754 | VARF=0.5D0*(VF-AF) | |
13755 | ALEFTF=(EF+VALF*BWZR)**2+(VALF*BWZI)**2 | |
13756 | ARIGHF=(EF+VARF*BWZR)**2+(VARF*BWZI)**2 | |
13757 | ASAME=ALEFTI*ALEFTF+ARIGHI*ARIGHF | |
13758 | AFLIP=ALEFTI*ARIGHF+ARIGHI*ALEFTF | |
13759 | WT=ASAME*(1D0+CTHESG)**2+AFLIP*(1D0-CTHESG)**2 | |
13760 | WTMAX=4D0*MAX(ASAME,AFLIP) | |
13761 | ELSE | |
13762 | C...Isotropic decay of W/pi_tc produced in rho_tc decay. | |
13763 | WT=1D0 | |
13764 | WTMAX=1D0 | |
13765 | ENDIF | |
13766 | ||
13767 | ELSEIF(ISUB.EQ.192) THEN | |
13768 | IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN | |
13769 | C...Angular weight for f + fbar' -> rho_tc+ -> W+ Z0, | |
13770 | C...W+ pi_tc0, pi_tc+ Z0 or pi_tc+ pi_tc0. | |
13771 | WT=1D0-CTHE(1)**2 | |
13772 | WTMAX=1D0 | |
13773 | ELSEIF(IP.EQ.1) THEN | |
13774 | C...Angular weight for f + fbar' -> rho_tc+ -> f fbar'. | |
13775 | CTHESG=CTHE(1)*ISIGN(1,MINT(15)) | |
13776 | WT=(1D0+CTHESG)**2 | |
13777 | WTMAX=4D0 | |
13778 | ELSE | |
13779 | C...Isotropic decay of W/Z/pi_tc produced in rho_tc+ decay. | |
13780 | WT=1D0 | |
13781 | WTMAX=1D0 | |
13782 | ENDIF | |
13783 | ||
13784 | ELSEIF(ISUB.EQ.193) THEN | |
13785 | IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN | |
13786 | C...Angular weight for f + fbar -> omega_tc0 -> | |
13787 | C...gamma pi_tc0 or Z0 pi_tc0. | |
13788 | WT=1D0+CTHE(1)**2 | |
13789 | WTMAX=2D0 | |
13790 | ELSEIF(IP.EQ.1) THEN | |
13791 | C...Angular weight for f + fbar -> omega_tc0 -> f fbar. | |
13792 | CTHESG=CTHE(1)*ISIGN(1,MINT(15)) | |
13793 | BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) | |
13794 | BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) | |
13795 | KFAI=IABS(MINT(15)) | |
13796 | EI=KCHG(KFAI,1)/3D0 | |
13797 | AI=SIGN(1D0,EI+0.1D0) | |
13798 | VI=AI-4D0*EI*XWV | |
13799 | VALI=0.5D0*(VI+AI) | |
13800 | VARI=0.5D0*(VI-AI) | |
13801 | BLEFTI=(EI-VALI*BWZR)**2+(VALI*BWZI)**2 | |
13802 | BRIGHI=(EI-VARI*BWZR)**2+(VARI*BWZI)**2 | |
13803 | KFAF=IABS(KFL1(1)) | |
13804 | EF=KCHG(KFAF,1)/3D0 | |
13805 | AF=SIGN(1D0,EF+0.1D0) | |
13806 | VF=AF-4D0*EF*XWV | |
13807 | VALF=0.5D0*(VF+AF) | |
13808 | VARF=0.5D0*(VF-AF) | |
13809 | BLEFTF=(EF-VALF*BWZR)**2+(VALF*BWZI)**2 | |
13810 | BRIGHF=(EF-VARF*BWZR)**2+(VARF*BWZI)**2 | |
13811 | BSAME=BLEFTI*BLEFTF+BRIGHI*BRIGHF | |
13812 | BFLIP=BLEFTI*BRIGHF+BRIGHI*BLEFTF | |
13813 | WT=BSAME*(1D0+CTHESG)**2+BFLIP*(1D0-CTHESG)**2 | |
13814 | WTMAX=4D0*MAX(BSAME,BFLIP) | |
13815 | ELSE | |
13816 | C...Isotropic decay of Z/pi_tc produced in omega_tc decay. | |
13817 | WT=1D0 | |
13818 | WTMAX=1D0 | |
13819 | ENDIF | |
13820 | ||
13821 | ELSEIF(ISUB.EQ.353) THEN | |
13822 | C...Angular weight for Z_R0 -> 2 quarks/leptons. | |
13823 | EI=KCHG(IABS(MINT(15)),1)/3D0 | |
13824 | AI=SIGN(1D0,EI+0.1D0) | |
13825 | VI=AI-4D0*EI*XWV | |
13826 | EF=KCHG(PYCOMP(KFL1(1)),1)/3D0 | |
13827 | AF=SIGN(1D0,EF+0.1D0) | |
13828 | VF=AF-4D0*EF*XWV | |
13829 | RMF=MIN(1D0,4D0*PMAS(PYCOMP(KFL1(1)),1)**2/SH) | |
13830 | WT1=(VI**2+AI**2)*(VF**2+(1D0-RMF)*AF**2) | |
13831 | WT2=RMF*(VI**2+AI**2)*VF**2 | |
13832 | WT3=SQRT(1D0-RMF)*4D0*VI*AI*VF*AF | |
13833 | WT=WT1*(1D0+CTHE(1)**2)+WT2*(1D0-CTHE(1)**2)+ | |
13834 | & 2D0*WT3*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)) | |
13835 | WTMAX=2D0*(WT1+ABS(WT3)) | |
13836 | ||
13837 | ELSEIF(ISUB.EQ.354) THEN | |
13838 | C...Angular weight for W_R+/- -> 2 quarks/leptons. | |
13839 | RM3=PMAS(PYCOMP(KFL1(1)),1)**2/SH | |
13840 | RM4=PMAS(PYCOMP(KFL2(1)),1)**2/SH | |
13841 | BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) | |
13842 | WT=(1D0+BE34*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)))**2-(RM3-RM4)**2 | |
13843 | WTMAX=4D0 | |
13844 | ||
13845 | ELSEIF(ISUB.EQ.391) THEN | |
13846 | C...Angular weight for f + fbar -> G* -> f + fbar | |
13847 | IF(IP.EQ.1.AND.IABS(KFL1(1)).LE.18) THEN | |
13848 | WT=1D0-3D0*CTHE(1)**2+4D0*CTHE(1)**4 | |
13849 | WTMAX=2D0 | |
13850 | C...Other G* decays not yet implemented angular distributions. | |
13851 | ELSE | |
13852 | WT=1D0 | |
13853 | WTMAX=1D0 | |
13854 | ENDIF | |
13855 | ||
13856 | ELSEIF(ISUB.EQ.392) THEN | |
13857 | C...Angular weight for g + g -> G* -> f + fbar | |
13858 | IF(IP.EQ.1.AND.IABS(KFL1(1)).LE.18) THEN | |
13859 | WT=1D0-CTHE(1)**4 | |
13860 | WTMAX=1D0 | |
13861 | C...Other G* decays not yet implemented angular distributions. | |
13862 | ELSE | |
13863 | WT=1D0 | |
13864 | WTMAX=1D0 | |
13865 | ENDIF | |
13866 | ||
13867 | C...Obtain correct angular distribution by rejection techniques. | |
13868 | ELSE | |
13869 | WT=1D0 | |
13870 | WTMAX=1D0 | |
13871 | ENDIF | |
13872 | IF(WT.LT.PYR(0)*WTMAX) GOTO 410 | |
13873 | ||
13874 | C...Construct massive four-vectors using angles chosen. | |
13875 | 570 DO 670 JT=1,JTMAX | |
13876 | IF(KDCY(JT).EQ.0) GOTO 670 | |
13877 | ID=IREF(IP,JT) | |
13878 | DO 580 J=1,5 | |
13879 | DPMO(J)=P(ID,J) | |
13880 | 580 CONTINUE | |
13881 | DPMO(4)=SQRT(DPMO(1)**2+DPMO(2)**2+DPMO(3)**2+DPMO(5)**2) | |
13882 | CMRENNA++ | |
13883 | IF(KFL3(JT).EQ.0) THEN | |
13884 | CALL PYROBO(NSD(JT)+1,NSD(JT)+2,ACOS(CTHE(JT)),PHI(JT), | |
13885 | & DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4)) | |
13886 | N0=NSD(JT)+2 | |
13887 | ELSE | |
13888 | CALL PYROBO(NSD(JT)+1,NSD(JT)+3,ACOS(CTHE(JT)),PHI(JT), | |
13889 | & DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4)) | |
13890 | N0=NSD(JT)+3 | |
13891 | ENDIF | |
13892 | ||
13893 | DO 590 J=1,4 | |
13894 | VDCY(J)=V(ID,J)+V(ID,5)*P(ID,J)/P(ID,5) | |
13895 | 590 CONTINUE | |
13896 | C...Fill in position of decay vertex. | |
13897 | DO 610 I=NSD(JT)+1,N0 | |
13898 | DO 600 J=1,4 | |
13899 | V(I,J)=VDCY(J) | |
13900 | 600 CONTINUE | |
13901 | V(I,5)=0D0 | |
13902 | ||
13903 | 610 CONTINUE | |
13904 | CMRENNA-- | |
13905 | ||
13906 | C...Mark decayed resonances; trace history. | |
13907 | K(ID,1)=K(ID,1)+10 | |
13908 | KFA=IABS(K(ID,2)) | |
13909 | KCA=PYCOMP(KFA) | |
13910 | IF(KCQM(JT).NE.0) THEN | |
13911 | C...Do not kill colour flow through coloured resonance! | |
13912 | ELSE | |
13913 | K(ID,4)=NSD(JT)+1 | |
13914 | K(ID,5)=NSD(JT)+2 | |
13915 | C...If 3-body or 2-body with junction: | |
13916 | IF(KFL3(JT).NE.0.OR.ITJUNC(JT).NE.0) K(ID,5)=NSD(JT)+3 | |
13917 | C...If 3-body with junction: | |
13918 | IF(ITJUNC(JT).NE.0.AND.KFL3(JT).NE.0) K(ID,5)=NSD(JT)+4 | |
13919 | ENDIF | |
13920 | ||
13921 | C...Add documentation lines. | |
13922 | ISUBRG=MAX(1,MIN(500,MINT(1))) | |
13923 | IF(IRES.EQ.0.OR.ISET(ISUBRG).EQ.11) THEN | |
13924 | IDOC=MINT(83)+MINT(4) | |
13925 | CMRENNA+++ | |
13926 | IHI=NSD(JT)+2 | |
13927 | IF(KFL3(JT).NE.0) IHI=IHI+1 | |
13928 | DO 630 I=NSD(JT)+1,IHI | |
13929 | CMRENNA--- | |
13930 | I1=MINT(83)+MINT(4)+1 | |
13931 | K(I,3)=I1 | |
13932 | IF(MSTP(128).GE.1) K(I,3)=ID | |
13933 | IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN | |
13934 | MINT(4)=MINT(4)+1 | |
13935 | K(I1,1)=21 | |
13936 | K(I1,2)=K(I,2) | |
13937 | K(I1,3)=IREF(IP,JT+3) | |
13938 | DO 620 J=1,5 | |
13939 | P(I1,J)=P(I,J) | |
13940 | 620 CONTINUE | |
13941 | ENDIF | |
13942 | 630 CONTINUE | |
13943 | ELSE | |
13944 | K(NSD(JT)+1,3)=ID | |
13945 | K(NSD(JT)+2,3)=ID | |
13946 | C...If 3-body or 2-body with junction: | |
13947 | IF(KFL3(JT).NE.0.OR.ITJUNC(JT).GT.0) K(NSD(JT)+3,3)=ID | |
13948 | C...If 3-body with junction: | |
13949 | IF(KFL3(JT).NE.0.AND.ITJUNC(JT).GT.0) K(NSD(JT)+4,3)=ID | |
13950 | ENDIF | |
13951 | ||
13952 | C...Do showering of two or three objects. | |
13953 | NSHBEF=N | |
13954 | IF(MSTP(71).GE.1) THEN | |
13955 | IF(KFL3(JT).EQ.0) THEN | |
13956 | CALL PYSHOW(NSD(JT)+1,NSD(JT)+2,P(ID,5)) | |
13957 | ELSE | |
13958 | CALL PYSHOW(NSD(JT)+1,-3,P(ID,5)) | |
13959 | ENDIF | |
13960 | ENDIF | |
13961 | NSHAFT=N | |
13962 | IF(JT.EQ.1) NAFT1=N | |
13963 | ||
13964 | C...Check if decay products moved by shower. | |
13965 | NSD1=NSD(JT)+1 | |
13966 | NSD2=NSD(JT)+2 | |
13967 | NSD3=NSD(JT)+3 | |
13968 | IF(NSHAFT.GT.NSHBEF) THEN | |
13969 | IF(K(NSD1,1).GT.10) THEN | |
13970 | DO 640 I=NSHBEF+1,NSHAFT | |
13971 | IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD1,2)) NSD1=I | |
13972 | 640 CONTINUE | |
13973 | ENDIF | |
13974 | IF(K(NSD2,1).GT.10) THEN | |
13975 | DO 650 I=NSHBEF+1,NSHAFT | |
13976 | IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD2,2).AND. | |
13977 | & I.NE.NSD1) NSD2=I | |
13978 | 650 CONTINUE | |
13979 | ENDIF | |
13980 | IF(KFL3(JT).NE.0.AND.K(NSD3,1).GT.10) THEN | |
13981 | DO 660 I=NSHBEF+1,NSHAFT | |
13982 | IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD3,2).AND. | |
13983 | & I.NE.NSD1.AND.I.NE.NSD2) NSD3=I | |
13984 | 660 CONTINUE | |
13985 | ENDIF | |
13986 | ENDIF | |
13987 | ||
13988 | C...Store decay products for further treatment. | |
13989 | NP=NP+1 | |
13990 | IREF(NP,1)=NSD1 | |
13991 | IREF(NP,2)=NSD2 | |
13992 | IREF(NP,3)=0 | |
13993 | IF(KFL3(JT).NE.0) IREF(NP,3)=NSD3 | |
13994 | IREF(NP,4)=IDOC+1 | |
13995 | IREF(NP,5)=IDOC+2 | |
13996 | IREF(NP,6)=0 | |
13997 | IF(KFL3(JT).NE.0) IREF(NP,6)=IDOC+3 | |
13998 | IREF(NP,7)=K(IREF(IP,JT),2) | |
13999 | IREF(NP,8)=IREF(IP,JT) | |
14000 | 670 CONTINUE | |
14001 | ||
14002 | C...Fill information for 2 -> 1 -> 2. | |
14003 | 680 IF(JTMAX.EQ.1.AND.KDCY(1).NE.0.AND.ISUB.NE.0) THEN | |
14004 | MINT(7)=MINT(83)+6+2*ISET(ISUB) | |
14005 | MINT(8)=MINT(83)+7+2*ISET(ISUB) | |
14006 | MINT(25)=KFL1(1) | |
14007 | MINT(26)=KFL2(1) | |
14008 | VINT(23)=CTHE(1) | |
14009 | RM3=P(N-1,5)**2/SH | |
14010 | RM4=P(N,5)**2/SH | |
14011 | BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) | |
14012 | VINT(45)=-0.5D0*SH*(1D0-RM3-RM4-BE34*CTHE(1)) | |
14013 | VINT(46)=-0.5D0*SH*(1D0-RM3-RM4+BE34*CTHE(1)) | |
14014 | VINT(48)=0.25D0*SH*BE34**2*MAX(0D0,1D0-CTHE(1)**2) | |
14015 | VINT(47)=SQRT(VINT(48)) | |
14016 | ENDIF | |
14017 | ||
14018 | C...Possibility of colour rearrangement in W+W- events. | |
14019 | IF((ISUB.EQ.25.OR.ISUB.EQ.22).AND.MSTP(115).GE.1) THEN | |
14020 | IAKF1=IABS(KFL1(1)) | |
14021 | IAKF2=IABS(KFL1(2)) | |
14022 | IAKF3=IABS(KFL2(1)) | |
14023 | IAKF4=IABS(KFL2(2)) | |
14024 | IF(MIN(IAKF1,IAKF2,IAKF3,IAKF4).GE.1.AND. | |
14025 | & MAX(IAKF1,IAKF2,IAKF3,IAKF4).LE.5) CALL | |
14026 | & PYRECO(IREF(1,1),IREF(1,2),NSD(1),NAFT1) | |
14027 | ENDIF | |
14028 | ||
14029 | C...Loop back if needed. | |
14030 | 690 IF(IP.LT.NP) GOTO 150 | |
14031 | ||
14032 | C...Boost back to standard frame. | |
14033 | 700 IF(IBST.EQ.1) CALL PYROBO(MINT(83)+7,N,THEIN,PHIIN,BEXIN,BEYIN, | |
14034 | &BEZIN) | |
14035 | ||
14036 | RETURN | |
14037 | END | |
14038 | ||
14039 | C********************************************************************* | |
14040 | ||
14041 | C...PYMULT | |
14042 | C...Initializes treatment of multiple interactions, selects kinematics | |
14043 | C...of hardest interaction if low-pT physics included in run, and | |
14044 | C...generates all non-hardest interactions. | |
14045 | ||
14046 | SUBROUTINE PYMULT(MMUL) | |
14047 | ||
14048 | C...Double precision and integer declarations. | |
14049 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
14050 | IMPLICIT INTEGER(I-N) | |
14051 | INTEGER PYK,PYCHGE,PYCOMP | |
14052 | C...Commonblocks. | |
14053 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
14054 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
14055 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
14056 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
14057 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
14058 | COMMON/PYINT1/MINT(400),VINT(400) | |
14059 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
14060 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
14061 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
14062 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
14063 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
14064 | &/PYINT2/,/PYINT3/,/PYINT5/,/PYINT7/ | |
14065 | C...Local arrays and saved variables. | |
14066 | DIMENSION NMUL(20),SIGM(20),KSTR(500,2),VINTSV(80) | |
14067 | SAVE XT2,XT2FAC,XC2,XTS,IRBIN,RBIN,NMUL,SIGM | |
14068 | ||
14069 | C...Initialization of multiple interaction treatment. | |
14070 | IF(MMUL.EQ.1) THEN | |
14071 | IF(MSTP(122).GE.1) WRITE(MSTU(11),5000) MSTP(82) | |
14072 | ISUB=96 | |
14073 | MINT(1)=96 | |
14074 | VINT(63)=0D0 | |
14075 | VINT(64)=0D0 | |
14076 | VINT(143)=1D0 | |
14077 | VINT(144)=1D0 | |
14078 | ||
14079 | C...Loop over phase space points: xT2 choice in 20 bins. | |
14080 | 100 SIGSUM=0D0 | |
14081 | DO 120 IXT2=1,20 | |
14082 | NMUL(IXT2)=MSTP(83) | |
14083 | SIGM(IXT2)=0D0 | |
14084 | DO 110 ITRY=1,MSTP(83) | |
14085 | RSCA=0.05D0*((21-IXT2)-PYR(0)) | |
14086 | XT2=VINT(149)*(1D0+VINT(149))/(VINT(149)+RSCA)-VINT(149) | |
14087 | XT2=MAX(0.01D0*VINT(149),XT2) | |
14088 | VINT(25)=XT2 | |
14089 | ||
14090 | C...Choose tau and y*. Calculate cos(theta-hat). | |
14091 | IF(PYR(0).LE.COEF(ISUB,1)) THEN | |
14092 | TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) | |
14093 | TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) | |
14094 | ELSE | |
14095 | TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) | |
14096 | ENDIF | |
14097 | VINT(21)=TAU | |
14098 | CALL PYKLIM(2) | |
14099 | RYST=PYR(0) | |
14100 | MYST=1 | |
14101 | IF(RYST.GT.COEF(ISUB,8)) MYST=2 | |
14102 | IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 | |
14103 | CALL PYKMAP(2,MYST,PYR(0)) | |
14104 | VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) | |
14105 | ||
14106 | C...Calculate differential cross-section. | |
14107 | VINT(71)=0.5D0*VINT(1)*SQRT(XT2) | |
14108 | CALL PYSIGH(NCHN,SIGS) | |
14109 | SIGM(IXT2)=SIGM(IXT2)+SIGS | |
14110 | 110 CONTINUE | |
14111 | SIGSUM=SIGSUM+SIGM(IXT2) | |
14112 | 120 CONTINUE | |
14113 | SIGSUM=SIGSUM/(20D0*MSTP(83)) | |
14114 | ||
14115 | C...Reject result if sigma(parton-parton) is smaller than hadronic one. | |
14116 | IF(SIGSUM.LT.1.1D0*SIGT(0,0,5)) THEN | |
14117 | IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) | |
14118 | & PARP(82)*(VINT(1)/PARP(89))**PARP(90),SIGSUM | |
14119 | PARP(82)=0.9D0*PARP(82) | |
14120 | VINT(149)=4D0*(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/ | |
14121 | & VINT(2) | |
14122 | GOTO 100 | |
14123 | ENDIF | |
14124 | IF(MSTP(122).GE.1) WRITE(MSTU(11),5200) | |
14125 | & PARP(82)*(VINT(1)/PARP(89))**PARP(90), SIGSUM | |
14126 | ||
14127 | C...Start iteration to find k factor. | |
14128 | YKE=SIGSUM/MAX(1D-10,SIGT(0,0,5)) | |
14129 | SO=0.5D0 | |
14130 | XI=0D0 | |
14131 | YI=0D0 | |
14132 | XF=0D0 | |
14133 | YF=0D0 | |
14134 | XK=0.5D0 | |
14135 | IIT=0 | |
14136 | 130 IF(IIT.EQ.0) THEN | |
14137 | XK=2D0*XK | |
14138 | ELSEIF(IIT.EQ.1) THEN | |
14139 | XK=0.5D0*XK | |
14140 | ELSE | |
14141 | XK=XI+(YKE-YI)*(XF-XI)/(YF-YI) | |
14142 | ENDIF | |
14143 | ||
14144 | C...Evaluate overlap integrals. | |
14145 | IF(MSTP(82).EQ.2) THEN | |
14146 | SP=0.5D0*PARU(1)*(1D0-EXP(-XK)) | |
14147 | SOP=SP/PARU(1) | |
14148 | ELSE | |
14149 | IF(MSTP(82).EQ.3) DELTAB=0.02D0 | |
14150 | IF(MSTP(82).EQ.4) DELTAB=MIN(0.01D0,0.05D0*PARP(84)) | |
14151 | SP=0D0 | |
14152 | SOP=0D0 | |
14153 | B=-0.5D0*DELTAB | |
14154 | 140 B=B+DELTAB | |
14155 | IF(MSTP(82).EQ.3) THEN | |
14156 | OV=EXP(-B**2)/PARU(2) | |
14157 | ELSE | |
14158 | CQ2=PARP(84)**2 | |
14159 | OV=((1D0-PARP(83))**2*EXP(-MIN(50D0,B**2))+ | |
14160 | & 2D0*PARP(83)*(1D0-PARP(83))*2D0/(1D0+CQ2)* | |
14161 | & EXP(-MIN(50D0,B**2*2D0/(1D0+CQ2)))+ | |
14162 | & PARP(83)**2/CQ2*EXP(-MIN(50D0,B**2/CQ2)))/PARU(2) | |
14163 | ENDIF | |
14164 | PACC=1D0-EXP(-MIN(50D0,PARU(1)*XK*OV)) | |
14165 | SP=SP+PARU(2)*B*DELTAB*PACC | |
14166 | SOP=SOP+PARU(2)*B*DELTAB*OV*PACC | |
14167 | IF(B.LT.1D0.OR.B*PACC.GT.1D-6) GOTO 140 | |
14168 | ENDIF | |
14169 | YK=PARU(1)*XK*SO/SP | |
14170 | ||
14171 | C...Continue iteration until convergence. | |
14172 | IF(YK.LT.YKE) THEN | |
14173 | XI=XK | |
14174 | YI=YK | |
14175 | IF(IIT.EQ.1) IIT=2 | |
14176 | ELSE | |
14177 | XF=XK | |
14178 | YF=YK | |
14179 | IF(IIT.EQ.0) IIT=1 | |
14180 | ENDIF | |
14181 | IF(ABS(YK-YKE).GE.1D-5*YKE) GOTO 130 | |
14182 | ||
14183 | C...Store some results for subsequent use. | |
14184 | VINT(145)=SIGSUM | |
14185 | VINT(146)=SOP/SO | |
14186 | VINT(147)=SOP/SP | |
14187 | ||
14188 | C...Initialize iteration in xT2 for hardest interaction. | |
14189 | ELSEIF(MMUL.EQ.2) THEN | |
14190 | IF(MSTP(82).LE.0) THEN | |
14191 | ELSEIF(MSTP(82).EQ.1) THEN | |
14192 | XT2=1D0 | |
14193 | SIGRAT=XSEC(96,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) | |
14194 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* | |
14195 | & VINT(317)/(VINT(318)*VINT(320)) | |
14196 | XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) | |
14197 | ELSEIF(MSTP(82).EQ.2) THEN | |
14198 | XT2=1D0 | |
14199 | XT2FAC=VINT(146)*XSEC(96,1)/MAX(1D-10,SIGT(0,0,5))* | |
14200 | & VINT(149)*(1D0+VINT(149)) | |
14201 | ELSE | |
14202 | XC2=4D0*CKIN(3)**2/VINT(2) | |
14203 | IF(CKIN(3).LE.CKIN(5).OR.MINT(82).GE.2) XC2=0D0 | |
14204 | ENDIF | |
14205 | ||
14206 | ELSEIF(MMUL.EQ.3) THEN | |
14207 | C...Low-pT or multiple interactions (first semihard interaction): | |
14208 | C...choose xT2 according to dpT2/pT2**2*exp(-(sigma above pT2)/norm) | |
14209 | C...or (MSTP(82)>=2) dpT2/(pT2+pT0**2)**2*exp(-....). | |
14210 | ISUB=MINT(1) | |
14211 | IF(MSTP(82).LE.0) THEN | |
14212 | XT2=0D0 | |
14213 | ELSEIF(MSTP(82).EQ.1) THEN | |
14214 | XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) | |
14215 | ELSEIF(MSTP(82).EQ.2) THEN | |
14216 | IF(XT2.LT.1D0.AND.EXP(-XT2FAC*XT2/(VINT(149)*(XT2+ | |
14217 | & VINT(149)))).GT.PYR(0)) XT2=1D0 | |
14218 | IF(XT2.GE.1D0) THEN | |
14219 | XT2=(1D0+VINT(149))*XT2FAC/(XT2FAC-(1D0+VINT(149))*LOG(1D0- | |
14220 | & PYR(0)*(1D0-EXP(-XT2FAC/(VINT(149)*(1D0+VINT(149)))))))- | |
14221 | & VINT(149) | |
14222 | ELSE | |
14223 | XT2=-XT2FAC/LOG(EXP(-XT2FAC/(XT2+VINT(149)))+PYR(0)* | |
14224 | & (EXP(-XT2FAC/VINT(149))-EXP(-XT2FAC/(XT2+VINT(149)))))- | |
14225 | & VINT(149) | |
14226 | ENDIF | |
14227 | XT2=MAX(0.01D0*VINT(149),XT2) | |
14228 | ELSE | |
14229 | XT2=(XC2+VINT(149))*(1D0+VINT(149))/(1D0+VINT(149)- | |
14230 | & PYR(0)*(1D0-XC2))-VINT(149) | |
14231 | XT2=MAX(0.01D0*VINT(149),XT2) | |
14232 | ENDIF | |
14233 | VINT(25)=XT2 | |
14234 | ||
14235 | C...Low-pT: choose xT2, tau, y* and cos(theta-hat) fixed. | |
14236 | IF(MSTP(82).LE.1.AND.XT2.LT.VINT(149)) THEN | |
14237 | IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)-MINT(143) | |
14238 | IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)-MINT(143) | |
14239 | ISUB=95 | |
14240 | MINT(1)=ISUB | |
14241 | VINT(21)=0.01D0*VINT(149) | |
14242 | VINT(22)=0D0 | |
14243 | VINT(23)=0D0 | |
14244 | VINT(25)=0.01D0*VINT(149) | |
14245 | ||
14246 | ELSE | |
14247 | C...Multiple interactions (first semihard interaction). | |
14248 | C...Choose tau and y*. Calculate cos(theta-hat). | |
14249 | IF(PYR(0).LE.COEF(ISUB,1)) THEN | |
14250 | TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) | |
14251 | TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) | |
14252 | ELSE | |
14253 | TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) | |
14254 | ENDIF | |
14255 | VINT(21)=TAU | |
14256 | CALL PYKLIM(2) | |
14257 | RYST=PYR(0) | |
14258 | MYST=1 | |
14259 | IF(RYST.GT.COEF(ISUB,8)) MYST=2 | |
14260 | IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 | |
14261 | CALL PYKMAP(2,MYST,PYR(0)) | |
14262 | VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) | |
14263 | ENDIF | |
14264 | VINT(71)=0.5D0*VINT(1)*SQRT(VINT(25)) | |
14265 | ||
14266 | C...Store results of cross-section calculation. | |
14267 | ELSEIF(MMUL.EQ.4) THEN | |
14268 | ISUB=MINT(1) | |
14269 | XTS=VINT(25) | |
14270 | IF(ISET(ISUB).EQ.1) XTS=VINT(21) | |
14271 | IF(ISET(ISUB).EQ.2) | |
14272 | & XTS=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) | |
14273 | IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) XTS=VINT(26) | |
14274 | RBIN=MAX(0.000001D0,MIN(0.999999D0,XTS*(1D0+VINT(149))/ | |
14275 | & (XTS+VINT(149)))) | |
14276 | IRBIN=INT(1D0+20D0*RBIN) | |
14277 | IF(ISUB.EQ.96.AND.MSTP(171).EQ.0) THEN | |
14278 | NMUL(IRBIN)=NMUL(IRBIN)+1 | |
14279 | SIGM(IRBIN)=SIGM(IRBIN)+VINT(153) | |
14280 | ENDIF | |
14281 | ||
14282 | C...Choose impact parameter. | |
14283 | ELSEIF(MMUL.EQ.5) THEN | |
14284 | ISUB=MINT(1) | |
14285 | 150 IF(MSTP(82).EQ.3) THEN | |
14286 | VINT(148)=PYR(0)/(PARU(2)*VINT(147)) | |
14287 | ELSE | |
14288 | RTYPE=PYR(0) | |
14289 | CQ2=PARP(84)**2 | |
14290 | IF(RTYPE.LT.(1D0-PARP(83))**2) THEN | |
14291 | B2=-LOG(PYR(0)) | |
14292 | ELSEIF(RTYPE.LT.1D0-PARP(83)**2) THEN | |
14293 | B2=-0.5D0*(1D0+CQ2)*LOG(PYR(0)) | |
14294 | ELSE | |
14295 | B2=-CQ2*LOG(PYR(0)) | |
14296 | ENDIF | |
14297 | VINT(148)=((1D0-PARP(83))**2*EXP(-MIN(50D0,B2))+2D0*PARP(83)* | |
14298 | & (1D0-PARP(83))*2D0/(1D0+CQ2)*EXP(-MIN(50D0,B2*2D0/(1D0+CQ2)))+ | |
14299 | & PARP(83)**2/CQ2*EXP(-MIN(50D0,B2/CQ2)))/(PARU(2)*VINT(147)) | |
14300 | ENDIF | |
14301 | ||
14302 | C...Multiple interactions (variable impact parameter) : reject with | |
14303 | C...probability exp(-overlap*cross-section above pT/normalization). | |
14304 | RNCOR=(IRBIN-20D0*RBIN)*NMUL(IRBIN) | |
14305 | SIGCOR=(IRBIN-20D0*RBIN)*SIGM(IRBIN) | |
14306 | DO 160 IBIN=IRBIN+1,20 | |
14307 | RNCOR=RNCOR+NMUL(IBIN) | |
14308 | SIGCOR=SIGCOR+SIGM(IBIN) | |
14309 | 160 CONTINUE | |
14310 | SIGABV=(SIGCOR/RNCOR)*VINT(149)*(1D0-XTS)/(XTS+VINT(149)) | |
14311 | IF(MSTP(171).EQ.1) SIGABV=SIGABV*VINT(2)/VINT(289) | |
14312 | VINT(150)=EXP(-MIN(50D0,VINT(146)*VINT(148)* | |
14313 | & SIGABV/MAX(1D-10,SIGT(0,0,5)))) | |
14314 | IF(MSTP(86).EQ.3.OR.(MSTP(86).EQ.2.AND.ISUB.NE.11.AND. | |
14315 | & ISUB.NE.12.AND.ISUB.NE.13.AND.ISUB.NE.28.AND.ISUB.NE.53 | |
14316 | & .AND.ISUB.NE.68.AND.ISUB.NE.95.AND.ISUB.NE.96)) THEN | |
14317 | IF(VINT(150).LT.PYR(0)) GOTO 150 | |
14318 | VINT(150)=1D0 | |
14319 | ENDIF | |
14320 | ||
14321 | C...Generate additional multiple semihard interactions. | |
14322 | ELSEIF(MMUL.EQ.6) THEN | |
14323 | ISUBSV=MINT(1) | |
14324 | DO 170 J=11,80 | |
14325 | VINTSV(J)=VINT(J) | |
14326 | 170 CONTINUE | |
14327 | ISUB=96 | |
14328 | MINT(1)=96 | |
14329 | VINT(151)=0D0 | |
14330 | VINT(152)=0D0 | |
14331 | ||
14332 | C...Reconstruct strings in hard scattering. | |
14333 | NMAX=MINT(84)+4 | |
14334 | IF(ISET(ISUBSV).EQ.1) NMAX=MINT(84)+2 | |
14335 | IF(ISET(ISUBSV).EQ.11) NMAX=MINT(84)+2+MINT(3) | |
14336 | NSTR=0 | |
14337 | DO 190 I=MINT(84)+1,NMAX | |
14338 | KCS=KCHG(PYCOMP(K(I,2)),2)*ISIGN(1,K(I,2)) | |
14339 | IF(KCS.EQ.0) GOTO 190 | |
14340 | DO 180 J=1,4 | |
14341 | IF(KCS.EQ.1.AND.(J.EQ.2.OR.J.EQ.4)) GOTO 180 | |
14342 | IF(KCS.EQ.-1.AND.(J.EQ.1.OR.J.EQ.3)) GOTO 180 | |
14343 | IF(J.LE.2) THEN | |
14344 | IST=MOD(K(I,J+3)/MSTU(5),MSTU(5)) | |
14345 | ELSE | |
14346 | IST=MOD(K(I,J+1),MSTU(5)) | |
14347 | ENDIF | |
14348 | IF(IST.LT.MINT(84).OR.IST.GT.I) GOTO 180 | |
14349 | IF(KCHG(PYCOMP(K(IST,2)),2).EQ.0) GOTO 180 | |
14350 | NSTR=NSTR+1 | |
14351 | IF(J.EQ.1.OR.J.EQ.4) THEN | |
14352 | KSTR(NSTR,1)=I | |
14353 | KSTR(NSTR,2)=IST | |
14354 | ELSE | |
14355 | KSTR(NSTR,1)=IST | |
14356 | KSTR(NSTR,2)=I | |
14357 | ENDIF | |
14358 | 180 CONTINUE | |
14359 | 190 CONTINUE | |
14360 | ||
14361 | C...Set up starting values for iteration in xT2. | |
14362 | IF(MSTP(86).EQ.3.OR.(MSTP(86).EQ.2.AND.ISUBSV.NE.11.AND. | |
14363 | & ISUBSV.NE.12.AND.ISUBSV.NE.13.AND.ISUBSV.NE.28.AND. | |
14364 | & ISUBSV.NE.53.AND.ISUBSV.NE.68.AND.ISUBSV.NE.95.AND. | |
14365 | & ISUBSV.NE.96)) THEN | |
14366 | XT2=(1D0-VINT(141))*(1D0-VINT(142)) | |
14367 | ELSE | |
14368 | XT2=VINT(25) | |
14369 | IF(ISET(ISUBSV).EQ.1) XT2=VINT(21) | |
14370 | IF(ISET(ISUBSV).EQ.2) | |
14371 | & XT2=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) | |
14372 | IF(ISET(ISUBSV).GE.3.AND.ISET(ISUBSV).LE.5) XT2=VINT(26) | |
14373 | ENDIF | |
14374 | IF(MSTP(82).LE.1) THEN | |
14375 | SIGRAT=XSEC(ISUB,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) | |
14376 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* | |
14377 | & VINT(317)/(VINT(318)*VINT(320)) | |
14378 | XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) | |
14379 | ELSE | |
14380 | XT2FAC=VINT(146)*VINT(148)*XSEC(ISUB,1)/ | |
14381 | & MAX(1D-10,SIGT(0,0,5))*VINT(149)*(1D0+VINT(149)) | |
14382 | ENDIF | |
14383 | VINT(63)=0D0 | |
14384 | VINT(64)=0D0 | |
14385 | VINT(143)=1D0-VINT(141) | |
14386 | VINT(144)=1D0-VINT(142) | |
14387 | ||
14388 | C...Iterate downwards in xT2. | |
14389 | 200 IF(MSTP(82).LE.1) THEN | |
14390 | XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) | |
14391 | IF(XT2.LT.VINT(149)) GOTO 250 | |
14392 | ELSE | |
14393 | IF(XT2.LE.0.01001D0*VINT(149)) GOTO 250 | |
14394 | XT2=XT2FAC*(XT2+VINT(149))/(XT2FAC-(XT2+VINT(149))* | |
14395 | & LOG(PYR(0)))-VINT(149) | |
14396 | IF(XT2.LE.0D0) GOTO 250 | |
14397 | XT2=MAX(0.01D0*VINT(149),XT2) | |
14398 | ENDIF | |
14399 | VINT(25)=XT2 | |
14400 | ||
14401 | C...Choose tau and y*. Calculate cos(theta-hat). | |
14402 | IF(PYR(0).LE.COEF(ISUB,1)) THEN | |
14403 | TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) | |
14404 | TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) | |
14405 | ELSE | |
14406 | TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) | |
14407 | ENDIF | |
14408 | VINT(21)=TAU | |
14409 | CALL PYKLIM(2) | |
14410 | RYST=PYR(0) | |
14411 | MYST=1 | |
14412 | IF(RYST.GT.COEF(ISUB,8)) MYST=2 | |
14413 | IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 | |
14414 | CALL PYKMAP(2,MYST,PYR(0)) | |
14415 | VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) | |
14416 | ||
14417 | C...Check that x not used up. Accept or reject kinematical variables. | |
14418 | X1M=SQRT(TAU)*EXP(VINT(22)) | |
14419 | X2M=SQRT(TAU)*EXP(-VINT(22)) | |
14420 | IF(VINT(143)-X1M.LT.0.01D0.OR.VINT(144)-X2M.LT.0.01D0) GOTO 200 | |
14421 | VINT(71)=0.5D0*VINT(1)*SQRT(XT2) | |
14422 | CALL PYSIGH(NCHN,SIGS) | |
14423 | IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGS=SIGS*VINT(320) | |
14424 | IF(SIGS.LT.XSEC(ISUB,1)*PYR(0)) GOTO 200 | |
14425 | ||
14426 | C...Reset K, P and V vectors. Select some variables. | |
14427 | DO 220 I=N+1,N+2 | |
14428 | DO 210 J=1,5 | |
14429 | K(I,J)=0 | |
14430 | P(I,J)=0D0 | |
14431 | V(I,J)=0D0 | |
14432 | 210 CONTINUE | |
14433 | 220 CONTINUE | |
14434 | RFLAV=PYR(0) | |
14435 | PT=0.5D0*VINT(1)*SQRT(XT2) | |
14436 | PHI=PARU(2)*PYR(0) | |
14437 | CTH=VINT(23) | |
14438 | ||
14439 | C...Add first parton to event record. | |
14440 | K(N+1,1)=3 | |
14441 | K(N+1,2)=21 | |
14442 | IF(RFLAV.GE.MAX(PARP(85),PARP(86))) K(N+1,2)= | |
14443 | & 1+INT((2D0+PARJ(2))*PYR(0)) | |
14444 | P(N+1,1)=PT*COS(PHI) | |
14445 | P(N+1,2)=PT*SIN(PHI) | |
14446 | P(N+1,3)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)-VINT(42)*(1D0-CTH)) | |
14447 | P(N+1,4)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)+VINT(42)*(1D0-CTH)) | |
14448 | P(N+1,5)=0D0 | |
14449 | ||
14450 | C...Add second parton to event record. | |
14451 | K(N+2,1)=3 | |
14452 | K(N+2,2)=21 | |
14453 | IF(K(N+1,2).NE.21) K(N+2,2)=-K(N+1,2) | |
14454 | P(N+2,1)=-P(N+1,1) | |
14455 | P(N+2,2)=-P(N+1,2) | |
14456 | P(N+2,3)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)-VINT(42)*(1D0+CTH)) | |
14457 | P(N+2,4)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)+VINT(42)*(1D0+CTH)) | |
14458 | P(N+2,5)=0D0 | |
14459 | ||
14460 | IF(RFLAV.LT.PARP(85).AND.NSTR.GE.1) THEN | |
14461 | C....Choose relevant string pieces to place gluons on. | |
14462 | DO 240 I=N+1,N+2 | |
14463 | DMIN=1D8 | |
14464 | DO 230 ISTR=1,NSTR | |
14465 | I1=KSTR(ISTR,1) | |
14466 | I2=KSTR(ISTR,2) | |
14467 | DIST=(P(I,4)*P(I1,4)-P(I,1)*P(I1,1)-P(I,2)*P(I1,2)- | |
14468 | & P(I,3)*P(I1,3))*(P(I,4)*P(I2,4)-P(I,1)*P(I2,1)- | |
14469 | & P(I,2)*P(I2,2)-P(I,3)*P(I2,3))/MAX(1D0,P(I1,4)*P(I2,4)- | |
14470 | & P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-P(I1,3)*P(I2,3)) | |
14471 | IF(ISTR.EQ.1.OR.DIST.LT.DMIN) THEN | |
14472 | DMIN=DIST | |
14473 | IST1=I1 | |
14474 | IST2=I2 | |
14475 | ISTM=ISTR | |
14476 | ENDIF | |
14477 | 230 CONTINUE | |
14478 | ||
14479 | C....Colour flow adjustments, new string pieces. | |
14480 | IF(K(IST1,4)/MSTU(5).EQ.IST2) K(IST1,4)=MSTU(5)*I+ | |
14481 | & MOD(K(IST1,4),MSTU(5)) | |
14482 | IF(MOD(K(IST1,5),MSTU(5)).EQ.IST2) K(IST1,5)= | |
14483 | & MSTU(5)*(K(IST1,5)/MSTU(5))+I | |
14484 | K(I,5)=MSTU(5)*IST1 | |
14485 | K(I,4)=MSTU(5)*IST2 | |
14486 | IF(K(IST2,5)/MSTU(5).EQ.IST1) K(IST2,5)=MSTU(5)*I+ | |
14487 | & MOD(K(IST2,5),MSTU(5)) | |
14488 | IF(MOD(K(IST2,4),MSTU(5)).EQ.IST1) K(IST2,4)= | |
14489 | & MSTU(5)*(K(IST2,4)/MSTU(5))+I | |
14490 | KSTR(ISTM,2)=I | |
14491 | KSTR(NSTR+1,1)=I | |
14492 | KSTR(NSTR+1,2)=IST2 | |
14493 | NSTR=NSTR+1 | |
14494 | 240 CONTINUE | |
14495 | ||
14496 | C...String drawing and colour flow for gluon loop. | |
14497 | ELSEIF(K(N+1,2).EQ.21) THEN | |
14498 | K(N+1,4)=MSTU(5)*(N+2) | |
14499 | K(N+1,5)=MSTU(5)*(N+2) | |
14500 | K(N+2,4)=MSTU(5)*(N+1) | |
14501 | K(N+2,5)=MSTU(5)*(N+1) | |
14502 | KSTR(NSTR+1,1)=N+1 | |
14503 | KSTR(NSTR+1,2)=N+2 | |
14504 | KSTR(NSTR+2,1)=N+2 | |
14505 | KSTR(NSTR+2,2)=N+1 | |
14506 | NSTR=NSTR+2 | |
14507 | ||
14508 | C...String drawing and colour flow for qqbar pair. | |
14509 | ELSE | |
14510 | K(N+1,4)=MSTU(5)*(N+2) | |
14511 | K(N+2,5)=MSTU(5)*(N+1) | |
14512 | KSTR(NSTR+1,1)=N+1 | |
14513 | KSTR(NSTR+1,2)=N+2 | |
14514 | NSTR=NSTR+1 | |
14515 | ENDIF | |
14516 | ||
14517 | C...Update remaining energy; iterate. | |
14518 | N=N+2 | |
14519 | IF(N.GT.MSTU(4)-MSTU(32)-10) THEN | |
14520 | CALL PYERRM(11,'(PYMULT:) no more memory left in PYJETS') | |
14521 | IF(MSTU(21).GE.1) RETURN | |
14522 | ENDIF | |
14523 | MINT(31)=MINT(31)+1 | |
14524 | VINT(151)=VINT(151)+VINT(41) | |
14525 | VINT(152)=VINT(152)+VINT(42) | |
14526 | VINT(143)=VINT(143)-VINT(41) | |
14527 | VINT(144)=VINT(144)-VINT(42) | |
14528 | IF(MINT(31).LT.240) GOTO 200 | |
14529 | 250 CONTINUE | |
14530 | MINT(1)=ISUBSV | |
14531 | DO 260 J=11,80 | |
14532 | VINT(J)=VINTSV(J) | |
14533 | 260 CONTINUE | |
14534 | ENDIF | |
14535 | ||
14536 | C...Format statements for printout. | |
14537 | 5000 FORMAT(/1X,'****** PYMULT: initialization of multiple inter', | |
14538 | &'actions for MSTP(82) =',I2,' ******') | |
14539 | 5100 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, | |
14540 | &D9.2,' mb: rejected') | |
14541 | 5200 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, | |
14542 | &D9.2,' mb: accepted') | |
14543 | ||
14544 | RETURN | |
14545 | END | |
14546 | ||
14547 | C********************************************************************* | |
14548 | ||
14549 | C...PYREMN | |
14550 | C...Adds on target remnants (one or two from each side) and | |
14551 | C...includes primordial kT for hadron beams. | |
14552 | ||
14553 | SUBROUTINE PYREMN(IPU1,IPU2) | |
14554 | ||
14555 | C...Double precision and integer declarations. | |
14556 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
14557 | IMPLICIT INTEGER(I-N) | |
14558 | INTEGER PYK,PYCHGE,PYCOMP | |
14559 | C...Commonblocks. | |
14560 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
14561 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
14562 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
14563 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
14564 | COMMON/PYINT1/MINT(400),VINT(400) | |
14565 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ | |
14566 | C...Local arrays. | |
14567 | DIMENSION KFLCH(2),KFLSP(2),CHI(2),PMS(0:6),IS(2),ISN(2),ROBO(5), | |
14568 | &PSYS(0:2,5),PMIN(0:2),QOLD(4),QNEW(4),DBE(3),PSUM(4) | |
14569 | ||
14570 | C...Find event type and remaining energy. | |
14571 | ISUB=MINT(1) | |
14572 | NS=N | |
14573 | IF(MINT(50).EQ.0.OR.MSTP(81).LE.0) THEN | |
14574 | VINT(143)=1D0-VINT(141) | |
14575 | VINT(144)=1D0-VINT(142) | |
14576 | ENDIF | |
14577 | ||
14578 | C...Define initial partons. | |
14579 | NTRY=0 | |
14580 | 100 NTRY=NTRY+1 | |
14581 | DO 130 JT=1,2 | |
14582 | I=MINT(83)+JT+2 | |
14583 | IF(JT.EQ.1) IPU=IPU1 | |
14584 | IF(JT.EQ.2) IPU=IPU2 | |
14585 | K(I,1)=21 | |
14586 | K(I,2)=K(IPU,2) | |
14587 | K(I,3)=I-2 | |
14588 | PMS(JT)=0D0 | |
14589 | VINT(156+JT)=0D0 | |
14590 | VINT(158+JT)=0D0 | |
14591 | IF(MINT(47).EQ.1) THEN | |
14592 | DO 110 J=1,5 | |
14593 | P(I,J)=P(I-2,J) | |
14594 | 110 CONTINUE | |
14595 | ELSEIF(ISUB.EQ.95) THEN | |
14596 | K(I,2)=21 | |
14597 | ELSE | |
14598 | P(I,5)=P(IPU,5) | |
14599 | ||
14600 | C...No primordial kT, or chosen according to truncated Gaussian or | |
14601 | C...exponential, or (for photon) predetermined or power law. | |
14602 | 120 IF(MINT(40+JT).EQ.2.AND.MINT(10+JT).NE.22) THEN | |
14603 | IF(MSTP(91).LE.0) THEN | |
14604 | PT=0D0 | |
14605 | ELSEIF(MSTP(91).EQ.1) THEN | |
14606 | PT=PARP(91)*SQRT(-LOG(PYR(0))) | |
14607 | ELSE | |
14608 | RPT1=PYR(0) | |
14609 | RPT2=PYR(0) | |
14610 | PT=-PARP(92)*LOG(RPT1*RPT2) | |
14611 | ENDIF | |
14612 | IF(PT.GT.PARP(93)) GOTO 120 | |
14613 | ELSEIF(MINT(106+JT).EQ.3) THEN | |
14614 | PTA=SQRT(VINT(282+JT)) | |
14615 | PTB=0D0 | |
14616 | IF(MSTP(66).EQ.5.AND.MSTP(93).EQ.1) THEN | |
14617 | PTB=PARP(99)*SQRT(-LOG(PYR(0))) | |
14618 | ELSEIF(MSTP(66).EQ.5.AND.MSTP(93).EQ.2) THEN | |
14619 | RPT1=PYR(0) | |
14620 | RPT2=PYR(0) | |
14621 | PTB=-PARP(99)*LOG(RPT1*RPT2) | |
14622 | ENDIF | |
14623 | IF(PTB.GT.PARP(100)) GOTO 120 | |
14624 | PT=SQRT(PTA**2+PTB**2+2D0*PTA*PTB*COS(PARU(2)*PYR(0))) | |
14625 | PT=PT*0.8D0**MINT(57) | |
14626 | IF(NTRY.GT.10) PT=PT*0.8D0**(NTRY-10) | |
14627 | ELSEIF(IABS(MINT(14+JT)).LE.8.OR.MINT(14+JT).EQ.21) THEN | |
14628 | IF(MSTP(93).LE.0) THEN | |
14629 | PT=0D0 | |
14630 | ELSEIF(MSTP(93).EQ.1) THEN | |
14631 | PT=PARP(99)*SQRT(-LOG(PYR(0))) | |
14632 | ELSEIF(MSTP(93).EQ.2) THEN | |
14633 | RPT1=PYR(0) | |
14634 | RPT2=PYR(0) | |
14635 | PT=-PARP(99)*LOG(RPT1*RPT2) | |
14636 | ELSEIF(MSTP(93).EQ.3) THEN | |
14637 | HA=PARP(99)**2 | |
14638 | HB=PARP(100)**2 | |
14639 | PT=SQRT(MAX(0D0,HA*(HA+HB)/(HA+HB-PYR(0)*HB)-HA)) | |
14640 | ELSE | |
14641 | HA=PARP(99)**2 | |
14642 | HB=PARP(100)**2 | |
14643 | IF(MSTP(93).EQ.5) HB=MIN(VINT(48),PARP(100)**2) | |
14644 | PT=SQRT(MAX(0D0,HA*((HA+HB)/HA)**PYR(0)-HA)) | |
14645 | ENDIF | |
14646 | IF(PT.GT.PARP(100)) GOTO 120 | |
14647 | ELSE | |
14648 | PT=0D0 | |
14649 | ENDIF | |
14650 | VINT(156+JT)=PT | |
14651 | PHI=PARU(2)*PYR(0) | |
14652 | P(I,1)=PT*COS(PHI) | |
14653 | P(I,2)=PT*SIN(PHI) | |
14654 | PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
14655 | ENDIF | |
14656 | 130 CONTINUE | |
14657 | IF(MINT(47).EQ.1) RETURN | |
14658 | ||
14659 | C...Kinematics construction for initial partons. | |
14660 | I1=MINT(83)+3 | |
14661 | I2=MINT(83)+4 | |
14662 | IF(ISUB.EQ.95) THEN | |
14663 | SHS=0D0 | |
14664 | SHR=0D0 | |
14665 | ELSE | |
14666 | SHS=VINT(141)*VINT(142)*VINT(2)+(P(I1,1)+P(I2,1))**2+ | |
14667 | & (P(I1,2)+P(I2,2))**2 | |
14668 | SHR=SQRT(MAX(0D0,SHS)) | |
14669 | IF((SHS-PMS(1)-PMS(2))**2-4D0*PMS(1)*PMS(2).LE.0D0) GOTO 100 | |
14670 | P(I1,4)=0.5D0*(SHR+(PMS(1)-PMS(2))/SHR) | |
14671 | P(I1,3)=SQRT(MAX(0D0,P(I1,4)**2-PMS(1))) | |
14672 | P(I2,4)=SHR-P(I1,4) | |
14673 | P(I2,3)=-P(I1,3) | |
14674 | ||
14675 | C...Transform partons to overall CM-frame. | |
14676 | ROBO(3)=(P(I1,1)+P(I2,1))/SHR | |
14677 | ROBO(4)=(P(I1,2)+P(I2,2))/SHR | |
14678 | CALL PYROBO(I1,I2,0D0,0D0,-ROBO(3),-ROBO(4),0D0) | |
14679 | ROBO(2)=PYANGL(P(I1,1),P(I1,2)) | |
14680 | CALL PYROBO(I1,I2,0D0,-ROBO(2),0D0,0D0,0D0) | |
14681 | ROBO(1)=PYANGL(P(I1,3),P(I1,1)) | |
14682 | CALL PYROBO(I1,I2,-ROBO(1),0D0,0D0,0D0,0D0) | |
14683 | CALL PYROBO(I2+1,MINT(52),0D0,-ROBO(2),0D0,0D0,0D0) | |
14684 | CALL PYROBO(I1,MINT(52),ROBO(1),ROBO(2),ROBO(3),ROBO(4),0D0) | |
14685 | ROBO(5)=(VINT(141)-VINT(142))/(VINT(141)+VINT(142)) | |
14686 | CALL PYROBO(I1,MINT(52),0D0,0D0,0D0,0D0,ROBO(5)) | |
14687 | ENDIF | |
14688 | ||
14689 | C...Optionally fix up x and Q2 definitions for leptoproduction. | |
14690 | IDISXQ=0 | |
14691 | IF((MINT(43).EQ.2.OR.MINT(43).EQ.3).AND.((ISUB.EQ.10.AND. | |
14692 | &MSTP(23).GE.1).OR.(ISUB.EQ.83.AND.MSTP(23).GE.2))) IDISXQ=1 | |
14693 | IF(IDISXQ.EQ.1) THEN | |
14694 | ||
14695 | C...Find where incoming and outgoing leptons/partons are sitting. | |
14696 | LESD=1 | |
14697 | IF(MINT(42).EQ.1) LESD=2 | |
14698 | LPIN=MINT(83)+3-LESD | |
14699 | LEIN=MINT(84)+LESD | |
14700 | LQIN=MINT(84)+3-LESD | |
14701 | LEOUT=MINT(84)+2+LESD | |
14702 | LQOUT=MINT(84)+5-LESD | |
14703 | IF(K(LEIN,3).GT.LEIN) LEIN=K(LEIN,3) | |
14704 | IF(K(LQIN,3).GT.LQIN) LQIN=K(LQIN,3) | |
14705 | LSCMS=0 | |
14706 | DO 140 I=MINT(84)+5,N | |
14707 | IF(K(I,2).EQ.94) THEN | |
14708 | LSCMS=I | |
14709 | LEOUT=I+LESD | |
14710 | LQOUT=I+3-LESD | |
14711 | ENDIF | |
14712 | 140 CONTINUE | |
14713 | LQBG=IPU1 | |
14714 | IF(LESD.EQ.1) LQBG=IPU2 | |
14715 | ||
14716 | C...Calculate actual and wanted momentum transfer. | |
14717 | XNOM=VINT(43-LESD) | |
14718 | Q2NOM=-VINT(45) | |
14719 | HPK=2D0*(P(LPIN,4)*P(LEIN,4)-P(LPIN,1)*P(LEIN,1)- | |
14720 | & P(LPIN,2)*P(LEIN,2)-P(LPIN,3)*P(LEIN,3))* | |
14721 | & (P(MINT(83)+LESD,4)*VINT(40+LESD)/P(LEIN,4)) | |
14722 | HPT2=MAX(0D0,Q2NOM*(1D0-Q2NOM/(XNOM*HPK))) | |
14723 | FAC=SQRT(HPT2/(P(LEOUT,1)**2+P(LEOUT,2)**2)) | |
14724 | P(N+1,1)=FAC*P(LEOUT,1) | |
14725 | P(N+1,2)=FAC*P(LEOUT,2) | |
14726 | P(N+1,3)=0.25D0*((HPK-Q2NOM/XNOM)/P(LPIN,4)- | |
14727 | & Q2NOM/(P(MINT(83)+LESD,4)*VINT(40+LESD)))*(-1)**(LESD+1) | |
14728 | P(N+1,4)=SQRT(P(LEOUT,5)**2+P(N+1,1)**2+P(N+1,2)**2+ | |
14729 | & P(N+1,3)**2) | |
14730 | DO 150 J=1,4 | |
14731 | QOLD(J)=P(LEIN,J)-P(LEOUT,J) | |
14732 | QNEW(J)=P(LEIN,J)-P(N+1,J) | |
14733 | 150 CONTINUE | |
14734 | ||
14735 | C...Boost outgoing electron and daughters. | |
14736 | IF(LSCMS.EQ.0) THEN | |
14737 | DO 160 J=1,4 | |
14738 | P(LEOUT,J)=P(N+1,J) | |
14739 | 160 CONTINUE | |
14740 | ELSE | |
14741 | DO 170 J=1,3 | |
14742 | P(N+2,J)=(P(N+1,J)-P(LEOUT,J))/(P(N+1,4)+P(LEOUT,4)) | |
14743 | 170 CONTINUE | |
14744 | PINV=2D0/(1D0+P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2) | |
14745 | DO 180 J=1,3 | |
14746 | DBE(J)=PINV*P(N+2,J) | |
14747 | 180 CONTINUE | |
14748 | DO 200 I=LSCMS+1,N | |
14749 | IORIG=I | |
14750 | 190 IORIG=K(IORIG,3) | |
14751 | IF(IORIG.GT.LEOUT) GOTO 190 | |
14752 | IF(I.EQ.LEOUT.OR.IORIG.EQ.LEOUT) | |
14753 | & CALL PYROBO(I,I,0D0,0D0,DBE(1),DBE(2),DBE(3)) | |
14754 | 200 CONTINUE | |
14755 | ENDIF | |
14756 | ||
14757 | C...Copy shower initiator and all outgoing partons. | |
14758 | NCOP=N+1 | |
14759 | K(NCOP,3)=LQBG | |
14760 | DO 210 J=1,5 | |
14761 | P(NCOP,J)=P(LQBG,J) | |
14762 | 210 CONTINUE | |
14763 | DO 240 I=MINT(84)+1,N | |
14764 | ICOP=0 | |
14765 | IF(K(I,1).GT.10) GOTO 240 | |
14766 | IF(I.EQ.LQBG.OR.I.EQ.LQOUT) THEN | |
14767 | ICOP=I | |
14768 | ELSE | |
14769 | IORIG=I | |
14770 | 220 IORIG=K(IORIG,3) | |
14771 | IF(IORIG.EQ.LQBG.OR.IORIG.EQ.LQOUT) THEN | |
14772 | ICOP=IORIG | |
14773 | ELSEIF(IORIG.GT.MINT(84).AND.IORIG.LE.N) THEN | |
14774 | GOTO 220 | |
14775 | ENDIF | |
14776 | ENDIF | |
14777 | IF(ICOP.NE.0) THEN | |
14778 | NCOP=NCOP+1 | |
14779 | K(NCOP,3)=I | |
14780 | DO 230 J=1,5 | |
14781 | P(NCOP,J)=P(I,J) | |
14782 | 230 CONTINUE | |
14783 | ENDIF | |
14784 | 240 CONTINUE | |
14785 | ||
14786 | C...Calculate relative rescaling factors. | |
14787 | SLC=3-2*LESD | |
14788 | PLCSUM=0D0 | |
14789 | DO 250 I=N+2,NCOP | |
14790 | PLCSUM=PLCSUM+(P(I,4)+SLC*P(I,3)) | |
14791 | 250 CONTINUE | |
14792 | DO 260 I=N+2,NCOP | |
14793 | V(I,1)=(P(I,4)+SLC*P(I,3))/PLCSUM | |
14794 | 260 CONTINUE | |
14795 | ||
14796 | C...Transfer extra three-momentum of current. | |
14797 | DO 280 I=N+2,NCOP | |
14798 | DO 270 J=1,3 | |
14799 | P(I,J)=P(I,J)+V(I,1)*(QNEW(J)-QOLD(J)) | |
14800 | 270 CONTINUE | |
14801 | P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
14802 | 280 CONTINUE | |
14803 | ||
14804 | C...Iterate change of initiator momentum to get energy right. | |
14805 | ITER=0 | |
14806 | 290 ITER=ITER+1 | |
14807 | PEEX=-P(N+1,4)-QNEW(4) | |
14808 | PEMV=-P(N+1,3)/P(N+1,4) | |
14809 | DO 300 I=N+2,NCOP | |
14810 | PEEX=PEEX+P(I,4) | |
14811 | PEMV=PEMV+V(I,1)*P(I,3)/P(I,4) | |
14812 | 300 CONTINUE | |
14813 | IF(ABS(PEMV).LT.1D-10) THEN | |
14814 | MINT(51)=1 | |
14815 | MINT(57)=MINT(57)+1 | |
14816 | RETURN | |
14817 | ENDIF | |
14818 | PZCH=-PEEX/PEMV | |
14819 | P(N+1,3)=P(N+1,3)+PZCH | |
14820 | 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) | |
14821 | DO 310 I=N+2,NCOP | |
14822 | P(I,3)=P(I,3)+V(I,1)*PZCH | |
14823 | P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
14824 | 310 CONTINUE | |
14825 | IF(ITER.LT.10.AND.ABS(PEEX).GT.1D-6*P(N+1,4)) GOTO 290 | |
14826 | ||
14827 | C...Modify momenta in event record. | |
14828 | HBE=2D0*(P(N+1,4)+P(LQBG,4))*(P(N+1,3)-P(LQBG,3))/ | |
14829 | & ((P(N+1,4)+P(LQBG,4))**2+(P(N+1,3)-P(LQBG,3))**2) | |
14830 | IF(ABS(HBE).GE.1D0) THEN | |
14831 | MINT(51)=1 | |
14832 | MINT(57)=MINT(57)+1 | |
14833 | RETURN | |
14834 | ENDIF | |
14835 | I=MINT(83)+5-LESD | |
14836 | CALL PYROBO(I,I,0D0,0D0,0D0,0D0,HBE) | |
14837 | DO 330 I=N+1,NCOP | |
14838 | ICOP=K(I,3) | |
14839 | DO 320 J=1,4 | |
14840 | P(ICOP,J)=P(I,J) | |
14841 | 320 CONTINUE | |
14842 | 330 CONTINUE | |
14843 | ENDIF | |
14844 | ||
14845 | C...Check minimum invariant mass of remnant system(s). | |
14846 | PSYS(0,4)=P(I1,4)+P(I2,4)+0.5D0*VINT(1)*(VINT(151)+VINT(152)) | |
14847 | PSYS(0,3)=P(I1,3)+P(I2,3)+0.5D0*VINT(1)*(VINT(151)-VINT(152)) | |
14848 | PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) | |
14849 | PMIN(0)=SQRT(PMS(0)) | |
14850 | DO 340 JT=1,2 | |
14851 | PSYS(JT,4)=0.5D0*VINT(1)*VINT(142+JT) | |
14852 | PSYS(JT,3)=PSYS(JT,4)*(-1)**(JT-1) | |
14853 | PMIN(JT)=0D0 | |
14854 | IF(MINT(44+JT).EQ.1) GOTO 340 | |
14855 | MINT(105)=MINT(102+JT) | |
14856 | MINT(109)=MINT(106+JT) | |
14857 | CALL PYSPLI(MINT(10+JT),MINT(12+JT),KFLCH(JT),KFLSP(JT)) | |
14858 | IF(MINT(51).NE.0) THEN | |
14859 | MINT(57)=MINT(57)+1 | |
14860 | RETURN | |
14861 | ENDIF | |
14862 | IF(KFLCH(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLCH(JT)) | |
14863 | IF(KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLSP(JT)) | |
14864 | IF(KFLCH(JT)*KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+0.5D0*PARP(111) | |
14865 | PMIN(JT)=SQRT(PMIN(JT)**2+P(MINT(83)+JT+2,1)**2+ | |
14866 | & P(MINT(83)+JT+2,2)**2) | |
14867 | 340 CONTINUE | |
14868 | IF(PMIN(0)+PMIN(1)+PMIN(2).GT.VINT(1).OR.(MINT(45).GE.2.AND. | |
14869 | &PMIN(1).GT.PSYS(1,4)).OR.(MINT(46).GE.2.AND.PMIN(2).GT. | |
14870 | &PSYS(2,4))) THEN | |
14871 | MINT(51)=1 | |
14872 | MINT(57)=MINT(57)+1 | |
14873 | RETURN | |
14874 | ENDIF | |
14875 | ||
14876 | C...Loop over two remnants; skip if none there. | |
14877 | I=NS | |
14878 | DO 410 JT=1,2 | |
14879 | ISN(JT)=0 | |
14880 | IF(MINT(44+JT).EQ.1) GOTO 410 | |
14881 | IF(JT.EQ.1) IPU=IPU1 | |
14882 | IF(JT.EQ.2) IPU=IPU2 | |
14883 | ||
14884 | C...Store first remnant parton. | |
14885 | I=I+1 | |
14886 | IS(JT)=I | |
14887 | ISN(JT)=1 | |
14888 | DO 350 J=1,5 | |
14889 | K(I,J)=0 | |
14890 | P(I,J)=0D0 | |
14891 | V(I,J)=0D0 | |
14892 | 350 CONTINUE | |
14893 | K(I,1)=1 | |
14894 | K(I,2)=KFLSP(JT) | |
14895 | K(I,3)=MINT(83)+JT | |
14896 | P(I,5)=PYMASS(K(I,2)) | |
14897 | ||
14898 | C...First parton colour connections and kinematics. | |
14899 | KCOL=KCHG(PYCOMP(KFLSP(JT)),2) | |
14900 | IF(KCOL.EQ.2) THEN | |
14901 | K(I,1)=3 | |
14902 | K(I,4)=MSTU(5)*IPU+IPU | |
14903 | K(I,5)=MSTU(5)*IPU+IPU | |
14904 | K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I | |
14905 | K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I | |
14906 | ELSEIF(KCOL.NE.0) THEN | |
14907 | K(I,1)=3 | |
14908 | KFLS=(3-KCOL*ISIGN(1,KFLSP(JT)))/2 | |
14909 | K(I,KFLS+3)=IPU | |
14910 | K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I | |
14911 | ENDIF | |
14912 | IF(KFLCH(JT).EQ.0) THEN | |
14913 | P(I,1)=-P(MINT(83)+JT+2,1) | |
14914 | P(I,2)=-P(MINT(83)+JT+2,2) | |
14915 | PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
14916 | PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) | |
14917 | P(I,3)=PSYS(JT,3) | |
14918 | P(I,4)=PSYS(JT,4) | |
14919 | ||
14920 | C...When extra remnant parton or hadron: store extra remnant. | |
14921 | ELSE | |
14922 | I=I+1 | |
14923 | ISN(JT)=2 | |
14924 | DO 360 J=1,5 | |
14925 | K(I,J)=0 | |
14926 | P(I,J)=0D0 | |
14927 | V(I,J)=0D0 | |
14928 | 360 CONTINUE | |
14929 | K(I,1)=1 | |
14930 | K(I,2)=KFLCH(JT) | |
14931 | K(I,3)=MINT(83)+JT | |
14932 | P(I,5)=PYMASS(K(I,2)) | |
14933 | ||
14934 | C...Find parton colour connections of extra remnant. | |
14935 | KCOL=KCHG(PYCOMP(KFLCH(JT)),2) | |
14936 | IF(KCOL.EQ.2) THEN | |
14937 | K(I,1)=3 | |
14938 | K(I,4)=MSTU(5)*IPU+IPU | |
14939 | K(I,5)=MSTU(5)*IPU+IPU | |
14940 | K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I | |
14941 | K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I | |
14942 | ELSEIF(KCOL.NE.0) THEN | |
14943 | K(I,1)=3 | |
14944 | KFLS=(3-KCOL*ISIGN(1,KFLCH(JT)))/2 | |
14945 | K(I,KFLS+3)=IPU | |
14946 | K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I | |
14947 | ENDIF | |
14948 | ||
14949 | C...Relative transverse momentum when two remnants. | |
14950 | LOOP=0 | |
14951 | 370 LOOP=LOOP+1 | |
14952 | CALL PYPTDI(1,P(I-1,1),P(I-1,2)) | |
14953 | IF(IABS(MINT(10+JT)).LT.20) THEN | |
14954 | P(I-1,1)=0D0 | |
14955 | P(I-1,2)=0D0 | |
14956 | ELSE | |
14957 | P(I-1,1)=P(I-1,1)-0.5D0*P(MINT(83)+JT+2,1) | |
14958 | P(I-1,2)=P(I-1,2)-0.5D0*P(MINT(83)+JT+2,2) | |
14959 | ENDIF | |
14960 | PMS(JT+2)=P(I-1,5)**2+P(I-1,1)**2+P(I-1,2)**2 | |
14961 | P(I,1)=-P(MINT(83)+JT+2,1)-P(I-1,1) | |
14962 | P(I,2)=-P(MINT(83)+JT+2,2)-P(I-1,2) | |
14963 | PMS(JT+4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
14964 | ||
14965 | C...Meson or baryon; photon as meson. For splitup below. | |
14966 | IMB=1 | |
14967 | IF(MOD(MINT(10+JT)/1000,10).NE.0) IMB=2 | |
14968 | ||
14969 | C***Relative distribution for electron into two electrons. Temporary! | |
14970 | IF(IABS(MINT(10+JT)).LT.20.AND.MINT(14+JT).EQ.-MINT(10+JT)) | |
14971 | & THEN | |
14972 | CHI(JT)=PYR(0) | |
14973 | ||
14974 | C...Relative distribution of electron energy into electron plus parton. | |
14975 | ELSEIF(IABS(MINT(10+JT)).LT.20) THEN | |
14976 | XHRD=VINT(140+JT) | |
14977 | XE=VINT(154+JT) | |
14978 | CHI(JT)=(XE-XHRD)/(1D0-XHRD) | |
14979 | ||
14980 | C...Relative distribution of energy for particle into two jets. | |
14981 | ELSEIF(IABS(KFLCH(JT)).LE.10.OR.KFLCH(JT).EQ.21) THEN | |
14982 | CHIK=PARP(92+2*IMB) | |
14983 | IF(MSTP(92).LE.1) THEN | |
14984 | IF(IMB.EQ.1) CHI(JT)=PYR(0) | |
14985 | IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) | |
14986 | ELSEIF(MSTP(92).EQ.2) THEN | |
14987 | CHI(JT)=1D0-PYR(0)**(1D0/(1D0+CHIK)) | |
14988 | ELSEIF(MSTP(92).EQ.3) THEN | |
14989 | CUT=2D0*0.3D0/VINT(1) | |
14990 | 380 CHI(JT)=PYR(0)**2 | |
14991 | IF((CHI(JT)**2/(CHI(JT)**2+CUT**2))**0.25D0* | |
14992 | & (1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 380 | |
14993 | ELSEIF(MSTP(92).EQ.4) THEN | |
14994 | CUT=2D0*0.3D0/VINT(1) | |
14995 | CUTR=(1D0+SQRT(1D0+CUT**2))/CUT | |
14996 | 390 CHIR=CUT*CUTR**PYR(0) | |
14997 | CHI(JT)=(CHIR**2-CUT**2)/(2D0*CHIR) | |
14998 | IF((1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 390 | |
14999 | ELSE | |
15000 | CUT=2D0*0.3D0/VINT(1) | |
15001 | CUTA=CUT**(1D0-PARP(98)) | |
15002 | CUTB=(1D0+CUT)**(1D0-PARP(98)) | |
15003 | 400 CHI(JT)=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) | |
15004 | IF(((CHI(JT)+CUT)**2/(2D0*(CHI(JT)**2+CUT**2)))** | |
15005 | & (0.5D0*PARP(98))*(1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 400 | |
15006 | ENDIF | |
15007 | ||
15008 | C...Relative distribution of energy for particle into jet plus particle. | |
15009 | ELSE | |
15010 | IF(MSTP(94).LE.1) THEN | |
15011 | IF(IMB.EQ.1) CHI(JT)=PYR(0) | |
15012 | IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) | |
15013 | IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) | |
15014 | ELSEIF(MSTP(94).EQ.2) THEN | |
15015 | CHI(JT)=1D0-PYR(0)**(1D0/(1D0+PARP(93+2*IMB))) | |
15016 | IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) | |
15017 | ELSEIF(MSTP(94).EQ.3) THEN | |
15018 | CALL PYZDIS(1,0,PMS(JT+4),ZZ) | |
15019 | CHI(JT)=ZZ | |
15020 | ELSE | |
15021 | CALL PYZDIS(1000,0,PMS(JT+4),ZZ) | |
15022 | CHI(JT)=ZZ | |
15023 | ENDIF | |
15024 | ENDIF | |
15025 | ||
15026 | C...Construct total transverse mass; reject if too large. | |
15027 | CHI(JT)=MAX(1D-8,MIN(1D0-1D-8,CHI(JT))) | |
15028 | PMS(JT)=PMS(JT+4)/CHI(JT)+PMS(JT+2)/(1D0-CHI(JT)) | |
15029 | IF(PMS(JT).GT.PSYS(JT,4)**2) THEN | |
15030 | IF(LOOP.LT.100) THEN | |
15031 | GOTO 370 | |
15032 | ELSE | |
15033 | MINT(51)=1 | |
15034 | MINT(57)=MINT(57)+1 | |
15035 | RETURN | |
15036 | ENDIF | |
15037 | ENDIF | |
15038 | PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) | |
15039 | VINT(158+JT)=CHI(JT) | |
15040 | ||
15041 | C...Subdivide longitudinal momentum according to value selected above. | |
15042 | PW1=CHI(JT)*(PSYS(JT,4)+ABS(PSYS(JT,3))) | |
15043 | P(IS(JT)+1,4)=0.5D0*(PW1+PMS(JT+4)/PW1) | |
15044 | P(IS(JT)+1,3)=0.5D0*(PW1-PMS(JT+4)/PW1)*(-1)**(JT-1) | |
15045 | P(IS(JT),4)=PSYS(JT,4)-P(IS(JT)+1,4) | |
15046 | P(IS(JT),3)=PSYS(JT,3)-P(IS(JT)+1,3) | |
15047 | ENDIF | |
15048 | 410 CONTINUE | |
15049 | N=I | |
15050 | ||
15051 | C...Check if longitudinal boosts needed - if so pick two systems. | |
15052 | PDEV=ABS(PSYS(0,4)+PSYS(1,4)+PSYS(2,4)-VINT(1))+ | |
15053 | &ABS(PSYS(0,3)+PSYS(1,3)+PSYS(2,3)) | |
15054 | IF(PDEV.LE.1D-6*VINT(1)) RETURN | |
15055 | IF(ISN(1).EQ.0) THEN | |
15056 | IR=0 | |
15057 | IL=2 | |
15058 | ELSEIF(ISN(2).EQ.0) THEN | |
15059 | IR=1 | |
15060 | IL=0 | |
15061 | ELSEIF(VINT(143).GT.0.2D0.AND.VINT(144).GT.0.2D0) THEN | |
15062 | IR=1 | |
15063 | IL=2 | |
15064 | ELSEIF(VINT(143).GT.0.2D0) THEN | |
15065 | IR=1 | |
15066 | IL=0 | |
15067 | ELSEIF(VINT(144).GT.0.2D0) THEN | |
15068 | IR=0 | |
15069 | IL=2 | |
15070 | ELSEIF(PMS(1)/PSYS(1,4)**2.GT.PMS(2)/PSYS(2,4)**2) THEN | |
15071 | IR=1 | |
15072 | IL=0 | |
15073 | ELSE | |
15074 | IR=0 | |
15075 | IL=2 | |
15076 | ENDIF | |
15077 | IG=3-IR-IL | |
15078 | ||
15079 | C...E+-pL wanted for system to be modified. | |
15080 | IF((IG.EQ.1.AND.ISN(1).EQ.0).OR.(IG.EQ.2.AND.ISN(2).EQ.0)) THEN | |
15081 | PPB=VINT(1) | |
15082 | PNB=VINT(1) | |
15083 | ELSE | |
15084 | PPB=VINT(1)-(PSYS(IG,4)+PSYS(IG,3)) | |
15085 | PNB=VINT(1)-(PSYS(IG,4)-PSYS(IG,3)) | |
15086 | ENDIF | |
15087 | ||
15088 | C...To keep x and Q2 in leptoproduction: do not count scattered lepton. | |
15089 | IF(IDISXQ.EQ.1.AND.IG.NE.0) THEN | |
15090 | PPB=PPB-(PSYS(0,4)+PSYS(0,3)) | |
15091 | PNB=PNB-(PSYS(0,4)-PSYS(0,3)) | |
15092 | DO 420 J=1,4 | |
15093 | PSYS(0,J)=0D0 | |
15094 | 420 CONTINUE | |
15095 | DO 450 I=MINT(84)+1,NS | |
15096 | IF(K(I,1).GT.10) GOTO 450 | |
15097 | INCL=0 | |
15098 | IORIG=I | |
15099 | 430 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 | |
15100 | IORIG=K(IORIG,3) | |
15101 | IF(IORIG.GT.LPIN) GOTO 430 | |
15102 | IF(INCL.EQ.0) GOTO 450 | |
15103 | DO 440 J=1,4 | |
15104 | PSYS(0,J)=PSYS(0,J)+P(I,J) | |
15105 | 440 CONTINUE | |
15106 | 450 CONTINUE | |
15107 | PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) | |
15108 | PPB=PPB+(PSYS(0,4)+PSYS(0,3)) | |
15109 | PNB=PNB+(PSYS(0,4)-PSYS(0,3)) | |
15110 | ENDIF | |
15111 | ||
15112 | C...Construct longitudinal boosts. | |
15113 | DPMTB=PPB*PNB | |
15114 | DPMTR=PMS(IR) | |
15115 | DPMTL=PMS(IL) | |
15116 | DSQLAM=SQRT(MAX(0D0,(DPMTB-DPMTR-DPMTL)**2-4D0*DPMTR*DPMTL)) | |
15117 | IF(DSQLAM.LE.1D-6*DPMTB) THEN | |
15118 | MINT(51)=1 | |
15119 | MINT(57)=MINT(57)+1 | |
15120 | RETURN | |
15121 | ENDIF | |
15122 | DSQSGN=SIGN(1D0,PSYS(IR,3)*PSYS(IL,4)-PSYS(IL,3)*PSYS(IR,4)) | |
15123 | DRKR=(DPMTB+DPMTR-DPMTL+DSQLAM*DSQSGN)/ | |
15124 | &(2D0*(PSYS(IR,4)+PSYS(IR,3))*PNB) | |
15125 | DRKL=(DPMTB+DPMTL-DPMTR+DSQLAM*DSQSGN)/ | |
15126 | &(2D0*(PSYS(IL,4)-PSYS(IL,3))*PPB) | |
15127 | DBER=(DRKR**2-1D0)/(DRKR**2+1D0) | |
15128 | DBEL=-(DRKL**2-1D0)/(DRKL**2+1D0) | |
15129 | ||
15130 | C...Perform longitudinal boosts. | |
15131 | IF(IR.EQ.1.AND.ISN(1).EQ.1.AND.DBER.LE.-0.99999999D0) THEN | |
15132 | P(IS(1),3)=0D0 | |
15133 | P(IS(1),4)=SQRT(P(IS(1),5)**2+P(IS(1),1)**2+P(IS(1),2)**2) | |
15134 | ELSEIF(IR.EQ.1) THEN | |
15135 | CALL PYROBO(IS(1),IS(1)+ISN(1)-1,0D0,0D0,0D0,0D0,DBER) | |
15136 | ELSEIF(IDISXQ.EQ.1) THEN | |
15137 | DO 470 I=I1,NS | |
15138 | INCL=0 | |
15139 | IORIG=I | |
15140 | 460 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 | |
15141 | IORIG=K(IORIG,3) | |
15142 | IF(IORIG.GT.LPIN) GOTO 460 | |
15143 | IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBER) | |
15144 | 470 CONTINUE | |
15145 | ELSE | |
15146 | CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBER) | |
15147 | ENDIF | |
15148 | IF(IL.EQ.2.AND.ISN(2).EQ.1.AND.DBEL.GE.0.99999999D0) THEN | |
15149 | P(IS(2),3)=0D0 | |
15150 | P(IS(2),4)=SQRT(P(IS(2),5)**2+P(IS(2),1)**2+P(IS(2),2)**2) | |
15151 | ELSEIF(IL.EQ.2) THEN | |
15152 | CALL PYROBO(IS(2),IS(2)+ISN(2)-1,0D0,0D0,0D0,0D0,DBEL) | |
15153 | ELSEIF(IDISXQ.EQ.1) THEN | |
15154 | DO 490 I=I1,NS | |
15155 | INCL=0 | |
15156 | IORIG=I | |
15157 | 480 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 | |
15158 | IORIG=K(IORIG,3) | |
15159 | IF(IORIG.GT.LPIN) GOTO 480 | |
15160 | IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBEL) | |
15161 | 490 CONTINUE | |
15162 | ELSE | |
15163 | CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBEL) | |
15164 | ENDIF | |
15165 | ||
15166 | C...Final check that energy-momentum conservation worked. | |
15167 | PESUM=0D0 | |
15168 | PZSUM=0D0 | |
15169 | DO 500 I=MINT(84)+1,N | |
15170 | IF(K(I,1).GT.10) GOTO 500 | |
15171 | PESUM=PESUM+P(I,4) | |
15172 | PZSUM=PZSUM+P(I,3) | |
15173 | 500 CONTINUE | |
15174 | PDEV=ABS(PESUM-VINT(1))+ABS(PZSUM) | |
15175 | IF(PDEV.GT.1D-4*VINT(1)) THEN | |
15176 | MINT(51)=1 | |
15177 | MINT(57)=MINT(57)+1 | |
15178 | RETURN | |
15179 | ENDIF | |
15180 | ||
15181 | C...Calculate rotation and boost from overall CM frame to | |
15182 | C...hadronic CM frame in leptoproduction. | |
15183 | MINT(91)=0 | |
15184 | IF(MINT(82).EQ.1.AND.(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN | |
15185 | MINT(91)=1 | |
15186 | LESD=1 | |
15187 | IF(MINT(42).EQ.1) LESD=2 | |
15188 | LPIN=MINT(83)+3-LESD | |
15189 | ||
15190 | C...Sum upp momenta of everything not lepton or photon to define boost. | |
15191 | DO 510 J=1,4 | |
15192 | PSUM(J)=0D0 | |
15193 | 510 CONTINUE | |
15194 | DO 530 I=1,N | |
15195 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 530 | |
15196 | IF(IABS(K(I,2)).GE.11.AND.IABS(K(I,2)).LE.20) GOTO 530 | |
15197 | IF(K(I,2).EQ.22) GOTO 530 | |
15198 | DO 520 J=1,4 | |
15199 | PSUM(J)=PSUM(J)+P(I,J) | |
15200 | 520 CONTINUE | |
15201 | 530 CONTINUE | |
15202 | VINT(223)=-PSUM(1)/PSUM(4) | |
15203 | VINT(224)=-PSUM(2)/PSUM(4) | |
15204 | VINT(225)=-PSUM(3)/PSUM(4) | |
15205 | ||
15206 | C...Boost incoming hadron to hadronic CM frame to determine rotations. | |
15207 | K(N+1,1)=1 | |
15208 | DO 540 J=1,5 | |
15209 | P(N+1,J)=P(LPIN,J) | |
15210 | V(N+1,J)=V(LPIN,J) | |
15211 | 540 CONTINUE | |
15212 | CALL PYROBO(N+1,N+1,0D0,0D0,VINT(223),VINT(224),VINT(225)) | |
15213 | VINT(222)=-PYANGL(P(N+1,1),P(N+1,2)) | |
15214 | CALL PYROBO(N+1,N+1,0D0,VINT(222),0D0,0D0,0D0) | |
15215 | IF(LESD.EQ.2) THEN | |
15216 | VINT(221)=-PYANGL(P(N+1,3),P(N+1,1)) | |
15217 | ELSE | |
15218 | VINT(221)=PYANGL(-P(N+1,3),P(N+1,1)) | |
15219 | ENDIF | |
15220 | ENDIF | |
15221 | ||
15222 | RETURN | |
15223 | END | |
15224 | ||
15225 | C********************************************************************* | |
15226 | ||
15227 | C...PYDIFF | |
15228 | C...Handles diffractive and elastic scattering. | |
15229 | ||
15230 | SUBROUTINE PYDIFF | |
15231 | ||
15232 | C...Double precision and integer declarations. | |
15233 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
15234 | IMPLICIT INTEGER(I-N) | |
15235 | INTEGER PYK,PYCHGE,PYCOMP | |
15236 | C...Commonblocks. | |
15237 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
15238 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
15239 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
15240 | COMMON/PYINT1/MINT(400),VINT(400) | |
15241 | SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ | |
15242 | ||
15243 | C...Reset K, P and V vectors. Store incoming particles. | |
15244 | DO 110 JT=1,MSTP(126)+10 | |
15245 | I=MINT(83)+JT | |
15246 | DO 100 J=1,5 | |
15247 | K(I,J)=0 | |
15248 | P(I,J)=0D0 | |
15249 | V(I,J)=0D0 | |
15250 | 100 CONTINUE | |
15251 | 110 CONTINUE | |
15252 | N=MINT(84) | |
15253 | MINT(3)=0 | |
15254 | MINT(21)=0 | |
15255 | MINT(22)=0 | |
15256 | MINT(23)=0 | |
15257 | MINT(24)=0 | |
15258 | MINT(4)=4 | |
15259 | DO 130 JT=1,2 | |
15260 | I=MINT(83)+JT | |
15261 | K(I,1)=21 | |
15262 | K(I,2)=MINT(10+JT) | |
15263 | DO 120 J=1,5 | |
15264 | P(I,J)=VINT(285+5*JT+J) | |
15265 | 120 CONTINUE | |
15266 | 130 CONTINUE | |
15267 | MINT(6)=2 | |
15268 | ||
15269 | C...Subprocess; kinematics. | |
15270 | SQLAM=(VINT(2)-VINT(63)-VINT(64))**2-4D0*VINT(63)*VINT(64) | |
15271 | PZ=SQRT(SQLAM)/(2D0*VINT(1)) | |
15272 | DO 200 JT=1,2 | |
15273 | I=MINT(83)+JT | |
15274 | PE=(VINT(2)+VINT(62+JT)-VINT(65-JT))/(2D0*VINT(1)) | |
15275 | KFH=MINT(102+JT) | |
15276 | ||
15277 | C...Elastically scattered particle. (Except elastic GVMD states.) | |
15278 | IF(MINT(16+JT).LE.0.AND.(MINT(10+JT).NE.22.OR. | |
15279 | & MINT(106+JT).NE.3)) THEN | |
15280 | N=N+1 | |
15281 | K(N,1)=1 | |
15282 | K(N,2)=KFH | |
15283 | K(N,3)=I+2 | |
15284 | P(N,3)=PZ*(-1)**(JT+1) | |
15285 | P(N,4)=PE | |
15286 | P(N,5)=SQRT(VINT(62+JT)) | |
15287 | ||
15288 | C...Decay rho from elastic scattering of gamma with sin**2(theta) | |
15289 | C...distribution of decay products (in rho rest frame). | |
15290 | IF(KFH.EQ.113.AND.MINT(10+JT).EQ.22.AND.MSTP(102).EQ.1) THEN | |
15291 | NSAV=N | |
15292 | DBETAZ=P(N,3)/SQRT(P(N,3)**2+P(N,5)**2) | |
15293 | P(N,3)=0D0 | |
15294 | P(N,4)=P(N,5) | |
15295 | CALL PYDECY(NSAV) | |
15296 | IF(N.EQ.NSAV+2.AND.IABS(K(NSAV+1,2)).EQ.211) THEN | |
15297 | PHI=PYANGL(P(NSAV+1,1),P(NSAV+1,2)) | |
15298 | CALL PYROBO(NSAV+1,NSAV+2,0D0,-PHI,0D0,0D0,0D0) | |
15299 | THE=PYANGL(P(NSAV+1,3),P(NSAV+1,1)) | |
15300 | CALL PYROBO(NSAV+1,NSAV+2,-THE,0D0,0D0,0D0,0D0) | |
15301 | 140 CTHE=2D0*PYR(0)-1D0 | |
15302 | IF(1D0-CTHE**2.LT.PYR(0)) GOTO 140 | |
15303 | CALL PYROBO(NSAV+1,NSAV+2,ACOS(CTHE),PHI,0D0,0D0,0D0) | |
15304 | ENDIF | |
15305 | CALL PYROBO(NSAV,NSAV+2,0D0,0D0,0D0,0D0,DBETAZ) | |
15306 | ENDIF | |
15307 | ||
15308 | C...Diffracted particle: low-mass system to two particles. | |
15309 | ELSEIF(VINT(62+JT).LT.(VINT(66+JT)+PARP(103))**2) THEN | |
15310 | N=N+2 | |
15311 | K(N-1,1)=1 | |
15312 | K(N,1)=1 | |
15313 | K(N-1,3)=I+2 | |
15314 | K(N,3)=I+2 | |
15315 | PMMAS=SQRT(VINT(62+JT)) | |
15316 | NTRY=0 | |
15317 | 150 NTRY=NTRY+1 | |
15318 | IF(NTRY.LT.20) THEN | |
15319 | MINT(105)=MINT(102+JT) | |
15320 | MINT(109)=MINT(106+JT) | |
15321 | CALL PYSPLI(KFH,21,KFL1,KFL2) | |
15322 | CALL PYKFDI(KFL1,0,KFL3,KF1) | |
15323 | IF(KF1.EQ.0) GOTO 150 | |
15324 | CALL PYKFDI(KFL2,-KFL3,KFLDUM,KF2) | |
15325 | IF(KF2.EQ.0) GOTO 150 | |
15326 | ELSE | |
15327 | KF1=KFH | |
15328 | KF2=111 | |
15329 | ENDIF | |
15330 | PM1=PYMASS(KF1) | |
15331 | PM2=PYMASS(KF2) | |
15332 | IF(PM1+PM2+PARJ(64).GT.PMMAS) GOTO 150 | |
15333 | K(N-1,2)=KF1 | |
15334 | K(N,2)=KF2 | |
15335 | P(N-1,5)=PM1 | |
15336 | P(N,5)=PM2 | |
15337 | PZP=SQRT(MAX(0D0,(PMMAS**2-PM1**2-PM2**2)**2- | |
15338 | & 4D0*PM1**2*PM2**2))/(2D0*PMMAS) | |
15339 | P(N-1,3)=PZP | |
15340 | P(N,3)=-PZP | |
15341 | P(N-1,4)=SQRT(PM1**2+PZP**2) | |
15342 | P(N,4)=SQRT(PM2**2+PZP**2) | |
15343 | CALL PYROBO(N-1,N,ACOS(2D0*PYR(0)-1D0),PARU(2)*PYR(0), | |
15344 | & 0D0,0D0,0D0) | |
15345 | DBETAZ=PZ*(-1)**(JT+1)/SQRT(PZ**2+PMMAS**2) | |
15346 | CALL PYROBO(N-1,N,0D0,0D0,0D0,0D0,DBETAZ) | |
15347 | ||
15348 | C...Diffracted particle: valence quark kicked out. | |
15349 | ELSEIF(MSTP(101).EQ.1.OR.(MSTP(101).EQ.3.AND.PYR(0).LT. | |
15350 | & PARP(101))) THEN | |
15351 | N=N+2 | |
15352 | K(N-1,1)=2 | |
15353 | K(N,1)=1 | |
15354 | K(N-1,3)=I+2 | |
15355 | K(N,3)=I+2 | |
15356 | MINT(105)=MINT(102+JT) | |
15357 | MINT(109)=MINT(106+JT) | |
15358 | CALL PYSPLI(KFH,21,K(N,2),K(N-1,2)) | |
15359 | P(N-1,5)=PYMASS(K(N-1,2)) | |
15360 | P(N,5)=PYMASS(K(N,2)) | |
15361 | SQLAM=(VINT(62+JT)-P(N-1,5)**2-P(N,5)**2)**2- | |
15362 | & 4D0*P(N-1,5)**2*P(N,5)**2 | |
15363 | P(N-1,3)=(PE*SQRT(SQLAM)+PZ*(VINT(62+JT)+P(N-1,5)**2- | |
15364 | & P(N,5)**2))/(2D0*VINT(62+JT))*(-1)**(JT+1) | |
15365 | P(N-1,4)=SQRT(P(N-1,3)**2+P(N-1,5)**2) | |
15366 | P(N,3)=PZ*(-1)**(JT+1)-P(N-1,3) | |
15367 | P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) | |
15368 | ||
15369 | C...Diffracted particle: gluon kicked out. | |
15370 | ELSE | |
15371 | N=N+3 | |
15372 | K(N-2,1)=2 | |
15373 | K(N-1,1)=2 | |
15374 | K(N,1)=1 | |
15375 | K(N-2,3)=I+2 | |
15376 | K(N-1,3)=I+2 | |
15377 | K(N,3)=I+2 | |
15378 | MINT(105)=MINT(102+JT) | |
15379 | MINT(109)=MINT(106+JT) | |
15380 | CALL PYSPLI(KFH,21,K(N,2),K(N-2,2)) | |
15381 | K(N-1,2)=21 | |
15382 | P(N-2,5)=PYMASS(K(N-2,2)) | |
15383 | P(N-1,5)=0D0 | |
15384 | P(N,5)=PYMASS(K(N,2)) | |
15385 | C...Energy distribution for particle into two jets. | |
15386 | 160 IMB=1 | |
15387 | IF(MOD(KFH/1000,10).NE.0) IMB=2 | |
15388 | CHIK=PARP(92+2*IMB) | |
15389 | IF(MSTP(92).LE.1) THEN | |
15390 | IF(IMB.EQ.1) CHI=PYR(0) | |
15391 | IF(IMB.EQ.2) CHI=1D0-SQRT(PYR(0)) | |
15392 | ELSEIF(MSTP(92).EQ.2) THEN | |
15393 | CHI=1D0-PYR(0)**(1D0/(1D0+CHIK)) | |
15394 | ELSEIF(MSTP(92).EQ.3) THEN | |
15395 | CUT=2D0*0.3D0/VINT(1) | |
15396 | 170 CHI=PYR(0)**2 | |
15397 | IF((CHI**2/(CHI**2+CUT**2))**0.25D0*(1D0-CHI)**CHIK.LT. | |
15398 | & PYR(0)) GOTO 170 | |
15399 | ELSEIF(MSTP(92).EQ.4) THEN | |
15400 | CUT=2D0*0.3D0/VINT(1) | |
15401 | CUTR=(1D0+SQRT(1D0+CUT**2))/CUT | |
15402 | 180 CHIR=CUT*CUTR**PYR(0) | |
15403 | CHI=(CHIR**2-CUT**2)/(2D0*CHIR) | |
15404 | IF((1D0-CHI)**CHIK.LT.PYR(0)) GOTO 180 | |
15405 | ELSE | |
15406 | CUT=2D0*0.3D0/VINT(1) | |
15407 | CUTA=CUT**(1D0-PARP(98)) | |
15408 | CUTB=(1D0+CUT)**(1D0-PARP(98)) | |
15409 | 190 CHI=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) | |
15410 | IF(((CHI+CUT)**2/(2D0*(CHI**2+CUT**2)))** | |
15411 | & (0.5D0*PARP(98))*(1D0-CHI)**CHIK.LT.PYR(0)) GOTO 190 | |
15412 | ENDIF | |
15413 | IF(CHI.LT.P(N,5)**2/VINT(62+JT).OR.CHI.GT.1D0-P(N-2,5)**2/ | |
15414 | & VINT(62+JT)) GOTO 160 | |
15415 | SQM=P(N-2,5)**2/(1D0-CHI)+P(N,5)**2/CHI | |
15416 | PZI=(PE*(VINT(62+JT)-SQM)+PZ*(VINT(62+JT)+SQM))/ | |
15417 | & (2D0*VINT(62+JT)) | |
15418 | PEI=SQRT(PZI**2+SQM) | |
15419 | PQQP=(1D0-CHI)*(PEI+PZI) | |
15420 | P(N-2,3)=0.5D0*(PQQP-P(N-2,5)**2/PQQP)*(-1)**(JT+1) | |
15421 | P(N-2,4)=SQRT(P(N-2,3)**2+P(N-2,5)**2) | |
15422 | P(N-1,4)=0.5D0*(VINT(62+JT)-SQM)/(PEI+PZI) | |
15423 | P(N-1,3)=P(N-1,4)*(-1)**JT | |
15424 | P(N,3)=PZI*(-1)**(JT+1)-P(N-2,3) | |
15425 | P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) | |
15426 | ENDIF | |
15427 | ||
15428 | C...Documentation lines. | |
15429 | K(I+2,1)=21 | |
15430 | IF(MINT(16+JT).EQ.0) K(I+2,2)=KFH | |
15431 | IF(MINT(16+JT).NE.0.OR.(MINT(10+JT).EQ.22.AND. | |
15432 | & MINT(106+JT).EQ.3)) K(I+2,2)=ISIGN(9900000,KFH)+10*(KFH/10) | |
15433 | K(I+2,3)=I | |
15434 | P(I+2,3)=PZ*(-1)**(JT+1) | |
15435 | P(I+2,4)=PE | |
15436 | P(I+2,5)=SQRT(VINT(62+JT)) | |
15437 | 200 CONTINUE | |
15438 | ||
15439 | C...Rotate outgoing partons/particles using cos(theta). | |
15440 | IF(VINT(23).LT.0.9D0) THEN | |
15441 | CALL PYROBO(MINT(83)+3,N,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) | |
15442 | ELSE | |
15443 | CALL PYROBO(MINT(83)+3,N,ASIN(VINT(59)),VINT(24),0D0,0D0,0D0) | |
15444 | ENDIF | |
15445 | ||
15446 | RETURN | |
15447 | END | |
15448 | ||
15449 | C********************************************************************* | |
15450 | ||
15451 | C...PYDISG | |
15452 | C...Set up a DIS process as gamma* + f -> f, with beam remnant | |
15453 | C...and showering added consecutively. Photon flux by the PYGAGA | |
15454 | C...routine (if at all). | |
15455 | ||
15456 | SUBROUTINE PYDISG | |
15457 | ||
15458 | C...Double precision and integer declarations. | |
15459 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
15460 | IMPLICIT INTEGER(I-N) | |
15461 | INTEGER PYK,PYCHGE,PYCOMP | |
15462 | C...Parameter statement to help give large particle numbers. | |
15463 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
15464 | &KEXCIT=4000000,KDIMEN=5000000) | |
15465 | C...Commonblocks. | |
15466 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
15467 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
15468 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
15469 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
15470 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
15471 | COMMON/PYINT1/MINT(400),VINT(400) | |
15472 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ | |
15473 | C...Local arrays. | |
15474 | DIMENSION PMS(4) | |
15475 | ||
15476 | C...Choice of subprocess, number of documentation lines | |
15477 | IDOC=7 | |
15478 | MINT(3)=IDOC-6 | |
15479 | MINT(4)=IDOC | |
15480 | IPU1=MINT(84)+1 | |
15481 | IPU2=MINT(84)+2 | |
15482 | IPU3=MINT(84)+3 | |
15483 | ISIDE=1 | |
15484 | IF(MINT(107).EQ.4) ISIDE=2 | |
15485 | ||
15486 | C...Reset K, P and V vectors. Store incoming particles | |
15487 | DO 110 JT=1,MSTP(126)+20 | |
15488 | I=MINT(83)+JT | |
15489 | DO 100 J=1,5 | |
15490 | K(I,J)=0 | |
15491 | P(I,J)=0D0 | |
15492 | V(I,J)=0D0 | |
15493 | 100 CONTINUE | |
15494 | 110 CONTINUE | |
15495 | DO 130 JT=1,2 | |
15496 | I=MINT(83)+JT | |
15497 | K(I,1)=21 | |
15498 | K(I,2)=MINT(10+JT) | |
15499 | DO 120 J=1,5 | |
15500 | P(I,J)=VINT(285+5*JT+J) | |
15501 | 120 CONTINUE | |
15502 | 130 CONTINUE | |
15503 | MINT(6)=2 | |
15504 | ||
15505 | C...Store incoming partons in hadronic CM-frame | |
15506 | DO 140 JT=1,2 | |
15507 | I=MINT(84)+JT | |
15508 | K(I,1)=14 | |
15509 | K(I,2)=MINT(14+JT) | |
15510 | K(I,3)=MINT(83)+2+JT | |
15511 | 140 CONTINUE | |
15512 | IF(MINT(15).EQ.22) THEN | |
15513 | P(MINT(84)+1,3)=0.5D0*(VINT(1)+VINT(307)/VINT(1)) | |
15514 | P(MINT(84)+1,4)=0.5D0*(VINT(1)-VINT(307)/VINT(1)) | |
15515 | P(MINT(84)+1,5)=-SQRT(VINT(307)) | |
15516 | P(MINT(84)+2,3)=-0.5D0*VINT(307)/VINT(1) | |
15517 | P(MINT(84)+2,4)=0.5D0*VINT(307)/VINT(1) | |
15518 | KFRES=MINT(16) | |
15519 | ISIDE=2 | |
15520 | ELSE | |
15521 | P(MINT(84)+1,3)=0.5D0*VINT(308)/VINT(1) | |
15522 | P(MINT(84)+1,4)=0.5D0*VINT(308)/VINT(1) | |
15523 | P(MINT(84)+2,3)=-0.5D0*(VINT(1)+VINT(308)/VINT(1)) | |
15524 | P(MINT(84)+2,4)=0.5D0*(VINT(1)-VINT(308)/VINT(1)) | |
15525 | P(MINT(84)+1,5)=-SQRT(VINT(308)) | |
15526 | KFRES=MINT(15) | |
15527 | ISIDE=1 | |
15528 | ENDIF | |
15529 | SIDESG=(-1D0)**(ISIDE-1) | |
15530 | ||
15531 | C...Copy incoming partons to documentation lines. | |
15532 | DO 170 JT=1,2 | |
15533 | I1=MINT(83)+4+JT | |
15534 | I2=MINT(84)+JT | |
15535 | K(I1,1)=21 | |
15536 | K(I1,2)=K(I2,2) | |
15537 | K(I1,3)=I1-2 | |
15538 | DO 150 J=1,5 | |
15539 | P(I1,J)=P(I2,J) | |
15540 | 150 CONTINUE | |
15541 | ||
15542 | C...Second copy for partons before ISR shower, since no such. | |
15543 | I1=MINT(83)+2+JT | |
15544 | K(I1,1)=21 | |
15545 | K(I1,2)=K(I2,2) | |
15546 | K(I1,3)=I1-2 | |
15547 | DO 160 J=1,5 | |
15548 | P(I1,J)=P(I2,J) | |
15549 | 160 CONTINUE | |
15550 | 170 CONTINUE | |
15551 | ||
15552 | C...Define initial partons. | |
15553 | NTRY=0 | |
15554 | 180 NTRY=NTRY+1 | |
15555 | IF(NTRY.GT.100) THEN | |
15556 | MINT(51)=1 | |
15557 | RETURN | |
15558 | ENDIF | |
15559 | ||
15560 | C...Scattered quark in hadronic CM frame. | |
15561 | I=MINT(83)+7 | |
15562 | K(IPU3,1)=3 | |
15563 | K(IPU3,2)=KFRES | |
15564 | K(IPU3,3)=I | |
15565 | P(IPU3,5)=PYMASS(KFRES) | |
15566 | P(IPU3,3)=P(IPU1,3)+P(IPU2,3) | |
15567 | P(IPU3,4)=P(IPU1,4)+P(IPU2,4) | |
15568 | P(IPU3,5)=0D0 | |
15569 | K(I,1)=21 | |
15570 | K(I,2)=KFRES | |
15571 | K(I,3)=MINT(83)+4+ISIDE | |
15572 | P(I,3)=P(IPU3,3) | |
15573 | P(I,4)=P(IPU3,4) | |
15574 | P(I,5)=P(IPU3,5) | |
15575 | N=IPU3 | |
15576 | MINT(21)=KFRES | |
15577 | MINT(22)=0 | |
15578 | ||
15579 | C...No primordial kT, or chosen according to truncated Gaussian or | |
15580 | C...exponential, or (for photon) predetermined or power law. | |
15581 | 190 IF(MINT(40+ISIDE).EQ.2.AND.MINT(10+ISIDE).NE.22) THEN | |
15582 | IF(MSTP(91).LE.0) THEN | |
15583 | PT=0D0 | |
15584 | ELSEIF(MSTP(91).EQ.1) THEN | |
15585 | PT=PARP(91)*SQRT(-LOG(PYR(0))) | |
15586 | ELSE | |
15587 | RPT1=PYR(0) | |
15588 | RPT2=PYR(0) | |
15589 | PT=-PARP(92)*LOG(RPT1*RPT2) | |
15590 | ENDIF | |
15591 | IF(PT.GT.PARP(93)) GOTO 190 | |
15592 | ELSEIF(MINT(106+ISIDE).EQ.3) THEN | |
15593 | PTA=SQRT(VINT(282+ISIDE)) | |
15594 | PTB=0D0 | |
15595 | IF(MSTP(66).EQ.5.AND.MSTP(93).EQ.1) THEN | |
15596 | PTB=PARP(99)*SQRT(-LOG(PYR(0))) | |
15597 | ELSEIF(MSTP(66).EQ.5.AND.MSTP(93).EQ.2) THEN | |
15598 | RPT1=PYR(0) | |
15599 | RPT2=PYR(0) | |
15600 | PTB=-PARP(99)*LOG(RPT1*RPT2) | |
15601 | ENDIF | |
15602 | IF(PTB.GT.PARP(100)) GOTO 190 | |
15603 | PT=SQRT(PTA**2+PTB**2+2D0*PTA*PTB*COS(PARU(2)*PYR(0))) | |
15604 | IF(NTRY.GT.10) PT=PT*0.8D0**(NTRY-10) | |
15605 | ELSEIF(IABS(MINT(14+ISIDE)).LE.8.OR.MINT(14+ISIDE).EQ.21) THEN | |
15606 | IF(MSTP(93).LE.0) THEN | |
15607 | PT=0D0 | |
15608 | ELSEIF(MSTP(93).EQ.1) THEN | |
15609 | PT=PARP(99)*SQRT(-LOG(PYR(0))) | |
15610 | ELSEIF(MSTP(93).EQ.2) THEN | |
15611 | RPT1=PYR(0) | |
15612 | RPT2=PYR(0) | |
15613 | PT=-PARP(99)*LOG(RPT1*RPT2) | |
15614 | ELSEIF(MSTP(93).EQ.3) THEN | |
15615 | HA=PARP(99)**2 | |
15616 | HB=PARP(100)**2 | |
15617 | PT=SQRT(MAX(0D0,HA*(HA+HB)/(HA+HB-PYR(0)*HB)-HA)) | |
15618 | ELSE | |
15619 | HA=PARP(99)**2 | |
15620 | HB=PARP(100)**2 | |
15621 | IF(MSTP(93).EQ.5) HB=MIN(VINT(48),PARP(100)**2) | |
15622 | PT=SQRT(MAX(0D0,HA*((HA+HB)/HA)**PYR(0)-HA)) | |
15623 | ENDIF | |
15624 | IF(PT.GT.PARP(100)) GOTO 190 | |
15625 | ELSE | |
15626 | PT=0D0 | |
15627 | ENDIF | |
15628 | VINT(156+ISIDE)=PT | |
15629 | PHI=PARU(2)*PYR(0) | |
15630 | P(IPU3,1)=PT*COS(PHI) | |
15631 | P(IPU3,2)=PT*SIN(PHI) | |
15632 | P(IPU3,4)=SQRT(P(IPU3,5)**2+PT**2+P(IPU3,3)**2) | |
15633 | PMS(3-ISIDE)=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2 | |
15634 | PCP=P(IPU3,4)+ABS(P(IPU3,3)) | |
15635 | ||
15636 | C...Find one or two beam remnants. | |
15637 | MINT(105)=MINT(102+ISIDE) | |
15638 | MINT(109)=MINT(106+ISIDE) | |
15639 | CALL PYSPLI(MINT(10+ISIDE),MINT(12+ISIDE),KFLCH,KFLSP) | |
15640 | IF(MINT(51).NE.0) THEN | |
15641 | MINT(51)=0 | |
15642 | GOTO 180 | |
15643 | ENDIF | |
15644 | ||
15645 | C...Store first remnant parton, with colour info and kinematics. | |
15646 | I=N+1 | |
15647 | K(I,1)=1 | |
15648 | K(I,2)=KFLSP | |
15649 | K(I,3)=MINT(83)+ISIDE | |
15650 | P(I,5)=PYMASS(K(I,2)) | |
15651 | KCOL=KCHG(PYCOMP(KFLSP),2) | |
15652 | IF(KCOL.NE.0) THEN | |
15653 | K(I,1)=3 | |
15654 | KFLS=(3-KCOL*ISIGN(1,KFLSP))/2 | |
15655 | K(I,KFLS+3)=MSTU(5)*IPU3 | |
15656 | K(IPU3,6-KFLS)=MSTU(5)*I | |
15657 | ICOLR=I | |
15658 | ENDIF | |
15659 | IF(KFLCH.EQ.0) THEN | |
15660 | P(I,1)=-P(IPU3,1) | |
15661 | P(I,2)=-P(IPU3,2) | |
15662 | PMS(ISIDE)=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
15663 | P(I,3)=-P(IPU3,3) | |
15664 | P(I,4)=SQRT(PMS(ISIDE)+P(I,3)**2) | |
15665 | PRP=P(I,4)+ABS(P(I,3)) | |
15666 | ||
15667 | C...When extra remnant parton or hadron: store extra remnant. | |
15668 | ELSE | |
15669 | I=I+1 | |
15670 | K(I,1)=1 | |
15671 | K(I,2)=KFLCH | |
15672 | K(I,3)=MINT(83)+ISIDE | |
15673 | P(I,5)=PYMASS(K(I,2)) | |
15674 | KCOL=KCHG(PYCOMP(KFLCH),2) | |
15675 | IF(KCOL.NE.0) THEN | |
15676 | K(I,1)=3 | |
15677 | KFLS=(3-KCOL*ISIGN(1,KFLCH))/2 | |
15678 | K(I,KFLS+3)=MSTU(5)*IPU3 | |
15679 | K(IPU3,6-KFLS)=MSTU(5)*I | |
15680 | ICOLR=I | |
15681 | ENDIF | |
15682 | ||
15683 | C...Relative transverse momentum when two remnants. | |
15684 | LOOP=0 | |
15685 | 200 LOOP=LOOP+1 | |
15686 | CALL PYPTDI(1,P(I-1,1),P(I-1,2)) | |
15687 | P(I-1,1)=P(I-1,1)-0.5D0*P(IPU3,1) | |
15688 | P(I-1,2)=P(I-1,2)-0.5D0*P(IPU3,2) | |
15689 | PMS(3)=P(I-1,5)**2+P(I-1,1)**2+P(I-1,2)**2 | |
15690 | P(I,1)=-P(IPU3,1)-P(I-1,1) | |
15691 | P(I,2)=-P(IPU3,2)-P(I-1,2) | |
15692 | PMS(4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
15693 | ||
15694 | C...Relative distribution of energy for particle into jet plus particle. | |
15695 | IMB=1 | |
15696 | IF(MOD(MINT(10+ISIDE)/1000,10).NE.0) IMB=2 | |
15697 | IF(MSTP(94).LE.1) THEN | |
15698 | IF(IMB.EQ.1) CHI=PYR(0) | |
15699 | IF(IMB.EQ.2) CHI=1D0-SQRT(PYR(0)) | |
15700 | IF(MOD(KFLCH/1000,10).NE.0) CHI=1D0-CHI | |
15701 | ELSEIF(MSTP(94).EQ.2) THEN | |
15702 | CHI=1D0-PYR(0)**(1D0/(1D0+PARP(93+2*IMB))) | |
15703 | IF(MOD(KFLCH/1000,10).NE.0) CHI=1D0-CHI | |
15704 | ELSEIF(MSTP(94).EQ.3) THEN | |
15705 | CALL PYZDIS(1,0,PMS(4),ZZ) | |
15706 | CHI=ZZ | |
15707 | ELSE | |
15708 | CALL PYZDIS(1000,0,PMS(4),ZZ) | |
15709 | CHI=ZZ | |
15710 | ENDIF | |
15711 | ||
15712 | C...Construct total transverse mass; reject if too large. | |
15713 | CHI=MAX(1D-8,MIN(1D0-1D-8,CHI)) | |
15714 | PMS(ISIDE)=PMS(4)/CHI+PMS(3)/(1D0-CHI) | |
15715 | IF(PMS(ISIDE).GT.P(IPU3,4)**2) THEN | |
15716 | IF(LOOP.LT.10) GOTO 200 | |
15717 | GOTO 180 | |
15718 | ENDIF | |
15719 | VINT(158+ISIDE)=CHI | |
15720 | ||
15721 | C...Subdivide longitudinal momentum according to value selected above. | |
15722 | PRP=SQRT(PMS(ISIDE)+P(IPU3,3)**2)+ABS(P(IPU3,3)) | |
15723 | PW1=(1D0-CHI)*PRP | |
15724 | P(I-1,4)=0.5D0*(PW1+PMS(3)/PW1) | |
15725 | P(I-1,3)=0.5D0*(PW1-PMS(3)/PW1)*SIDESG | |
15726 | PW2=CHI*PRP | |
15727 | P(I,4)=0.5D0*(PW2+PMS(4)/PW2) | |
15728 | P(I,3)=0.5D0*(PW2-PMS(4)/PW2)*SIDESG | |
15729 | ENDIF | |
15730 | N=I | |
15731 | ||
15732 | C...Boost current and remnant systems to correct frame. | |
15733 | IF(SQRT(PMS(1))+SQRT(PMS(2)).GT.0.99D0*VINT(1)) GOTO 180 | |
15734 | DSQLAM=SQRT(MAX(0D0,(VINT(2)-PMS(1)-PMS(2))**2-4D0*PMS(1)*PMS(2))) | |
15735 | DRKC=(VINT(2)+PMS(3-ISIDE)-PMS(ISIDE)+DSQLAM)/ | |
15736 | &(2D0*VINT(1)*PCP) | |
15737 | DRKR=(VINT(2)+PMS(ISIDE)-PMS(3-ISIDE)+DSQLAM)/ | |
15738 | &(2D0*VINT(1)*PRP) | |
15739 | DBEC=-SIDESG*(DRKC**2-1D0)/(DRKC**2+1D0) | |
15740 | DBER=SIDESG*(DRKR**2-1D0)/(DRKR**2+1D0) | |
15741 | CALL PYROBO(IPU3,IPU3,0D0,0D0,0D0,0D0,DBEC) | |
15742 | CALL PYROBO(IPU3+1,N,0D0,0D0,0D0,0D0,DBER) | |
15743 | ||
15744 | C...Let current quark shower; recoil but no showering by colour partner. | |
15745 | QMAX=2D0*SQRT(VINT(309-ISIDE)) | |
15746 | MSTJ48=MSTJ(48) | |
15747 | MSTJ(48)=1 | |
15748 | PARJ86=PARJ(86) | |
15749 | PARJ(86)=0D0 | |
15750 | IF(MSTP(71).EQ.1) CALL PYSHOW(IPU3,ICOLR,QMAX) | |
15751 | MSTJ(48)=MSTJ48 | |
15752 | PARJ(86)=PARJ86 | |
15753 | ||
15754 | RETURN | |
15755 | END | |
15756 | ||
15757 | C********************************************************************* | |
15758 | ||
15759 | C...PYDOCU | |
15760 | C...Handles the documentation of the process in MSTI and PARI, | |
15761 | C...and also computes cross-sections based on accumulated statistics. | |
15762 | ||
15763 | SUBROUTINE PYDOCU | |
15764 | ||
15765 | C...Double precision and integer declarations. | |
15766 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
15767 | IMPLICIT INTEGER(I-N) | |
15768 | INTEGER PYK,PYCHGE,PYCOMP | |
15769 | C...Commonblocks. | |
15770 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
15771 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
15772 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
15773 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
15774 | COMMON/PYINT1/MINT(400),VINT(400) | |
15775 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
15776 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
15777 | SAVE /PYJETS/,/PYDAT1/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, | |
15778 | &/PYINT5/ | |
15779 | ||
15780 | C...Calculate Monte Carlo estimates of cross-sections. | |
15781 | ISUB=MINT(1) | |
15782 | IF(MSTP(111).NE.-1) NGEN(ISUB,3)=NGEN(ISUB,3)+1 | |
15783 | NGEN(0,3)=NGEN(0,3)+1 | |
15784 | XSEC(0,3)=0D0 | |
15785 | DO 100 I=1,500 | |
15786 | IF(I.EQ.96.OR.I.EQ.97) THEN | |
15787 | XSEC(I,3)=0D0 | |
15788 | ELSEIF(MSUB(95).EQ.1.AND.(I.EQ.11.OR.I.EQ.12.OR.I.EQ.13.OR. | |
15789 | & I.EQ.28.OR.I.EQ.53.OR.I.EQ.68)) THEN | |
15790 | XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1D0,DBLE(NGEN(96,1))* | |
15791 | & DBLE(NGEN(96,2))) | |
15792 | ELSEIF(MSUB(95).EQ.1.AND.I.GE.381.AND.I.LE.386) THEN | |
15793 | XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1D0,DBLE(NGEN(96,1))* | |
15794 | & DBLE(NGEN(96,2))) | |
15795 | ELSEIF(MSUB(I).EQ.0.OR.NGEN(I,1).EQ.0) THEN | |
15796 | XSEC(I,3)=0D0 | |
15797 | ELSEIF(NGEN(I,2).EQ.0) THEN | |
15798 | XSEC(I,3)=XSEC(I,2)*NGEN(0,3)/(DBLE(NGEN(I,1))* | |
15799 | & DBLE(NGEN(0,2))) | |
15800 | ELSE | |
15801 | XSEC(I,3)=XSEC(I,2)*NGEN(I,3)/(DBLE(NGEN(I,1))* | |
15802 | & DBLE(NGEN(I,2))) | |
15803 | ENDIF | |
15804 | XSEC(0,3)=XSEC(0,3)+XSEC(I,3) | |
15805 | 100 CONTINUE | |
15806 | ||
15807 | C...Rescale to known low-pT cross-section for standard QCD processes. | |
15808 | IF(MSUB(95).EQ.1) THEN | |
15809 | XSECH=XSEC(11,3)+XSEC(12,3)+XSEC(13,3)+XSEC(28,3)+XSEC(53,3)+ | |
15810 | & XSEC(68,3)+XSEC(95,3) | |
15811 | XSECW=XSEC(97,2)/MAX(1D0,DBLE(NGEN(97,1))) | |
15812 | IF(XSECH.GT.1D-20.AND.XSECW.GT.1D-20) THEN | |
15813 | FAC=XSECW/XSECH | |
15814 | XSEC(11,3)=FAC*XSEC(11,3) | |
15815 | XSEC(12,3)=FAC*XSEC(12,3) | |
15816 | XSEC(13,3)=FAC*XSEC(13,3) | |
15817 | XSEC(28,3)=FAC*XSEC(28,3) | |
15818 | XSEC(53,3)=FAC*XSEC(53,3) | |
15819 | XSEC(68,3)=FAC*XSEC(68,3) | |
15820 | XSEC(95,3)=FAC*XSEC(95,3) | |
15821 | XSEC(0,3)=XSEC(0,3)-XSECH+XSECW | |
15822 | ENDIF | |
15823 | ENDIF | |
15824 | ||
15825 | C...Save information for gamma-p and gamma-gamma. | |
15826 | IF(MINT(121).GT.1) THEN | |
15827 | IGA=MINT(122) | |
15828 | CALL PYSAVE(2,IGA) | |
15829 | CALL PYSAVE(5,0) | |
15830 | ENDIF | |
15831 | ||
15832 | C...Reset information on hard interaction. | |
15833 | DO 110 J=1,200 | |
15834 | MSTI(J)=0 | |
15835 | PARI(J)=0D0 | |
15836 | 110 CONTINUE | |
15837 | ||
15838 | C...Copy integer valued information from MINT into MSTI. | |
15839 | DO 120 J=1,32 | |
15840 | MSTI(J)=MINT(J) | |
15841 | 120 CONTINUE | |
15842 | IF(MINT(121).GT.1) MSTI(9)=MINT(122) | |
15843 | ||
15844 | C...Store cross-section variables in PARI. | |
15845 | PARI(1)=XSEC(0,3) | |
15846 | PARI(2)=XSEC(0,3)/MINT(5) | |
15847 | PARI(7)=VINT(97) | |
15848 | PARI(9)=VINT(99) | |
15849 | PARI(10)=VINT(100) | |
15850 | VINT(98)=VINT(98)+VINT(100) | |
15851 | IF(MSTP(142).EQ.1) PARI(2)=XSEC(0,3)/VINT(98) | |
15852 | ||
15853 | C...Store kinematics variables in PARI. | |
15854 | PARI(11)=VINT(1) | |
15855 | PARI(12)=VINT(2) | |
15856 | IF(ISUB.NE.95) THEN | |
15857 | DO 130 J=13,26 | |
15858 | PARI(J)=VINT(30+J) | |
15859 | 130 CONTINUE | |
15860 | PARI(31)=VINT(141) | |
15861 | PARI(32)=VINT(142) | |
15862 | PARI(33)=VINT(41) | |
15863 | PARI(34)=VINT(42) | |
15864 | PARI(35)=PARI(33)-PARI(34) | |
15865 | PARI(36)=VINT(21) | |
15866 | PARI(37)=VINT(22) | |
15867 | PARI(38)=VINT(26) | |
15868 | PARI(39)=VINT(157) | |
15869 | PARI(40)=VINT(158) | |
15870 | PARI(41)=VINT(23) | |
15871 | PARI(42)=2D0*VINT(47)/VINT(1) | |
15872 | ENDIF | |
15873 | ||
15874 | C...Store information on scattered partons in PARI. | |
15875 | IF(ISUB.NE.95.AND.MINT(7)*MINT(8).NE.0) THEN | |
15876 | DO 140 IS=7,8 | |
15877 | I=MINT(IS) | |
15878 | PARI(36+IS)=P(I,3)/VINT(1) | |
15879 | PARI(38+IS)=P(I,4)/VINT(1) | |
15880 | PR=MAX(1D-20,P(I,5)**2+P(I,1)**2+P(I,2)**2) | |
15881 | PARI(40+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ | |
15882 | & SQRT(PR),1D20)),P(I,3)) | |
15883 | PR=MAX(1D-20,P(I,1)**2+P(I,2)**2) | |
15884 | PARI(42+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ | |
15885 | & SQRT(PR),1D20)),P(I,3)) | |
15886 | PARI(44+IS)=P(I,3)/SQRT(1D-20+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
15887 | PARI(46+IS)=PYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) | |
15888 | PARI(48+IS)=PYANGL(P(I,1),P(I,2)) | |
15889 | 140 CONTINUE | |
15890 | ENDIF | |
15891 | ||
15892 | C...Store sum up transverse and longitudinal momenta. | |
15893 | PARI(65)=2D0*PARI(17) | |
15894 | IF(ISUB.LE.90.OR.ISUB.GE.95) THEN | |
15895 | DO 150 I=MSTP(126)+1,N | |
15896 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 | |
15897 | PT=SQRT(P(I,1)**2+P(I,2)**2) | |
15898 | PARI(69)=PARI(69)+PT | |
15899 | IF(I.LE.MINT(52)) PARI(66)=PARI(66)+PT | |
15900 | IF(I.GT.MINT(52).AND.I.LE.MINT(53)) PARI(68)=PARI(68)+PT | |
15901 | 150 CONTINUE | |
15902 | PARI(67)=PARI(68) | |
15903 | PARI(71)=VINT(151) | |
15904 | PARI(72)=VINT(152) | |
15905 | PARI(73)=VINT(151) | |
15906 | PARI(74)=VINT(152) | |
15907 | ELSE | |
15908 | PARI(66)=PARI(65) | |
15909 | PARI(69)=PARI(65) | |
15910 | ENDIF | |
15911 | ||
15912 | C...Store various other pieces of information into PARI. | |
15913 | PARI(61)=VINT(148) | |
15914 | PARI(75)=VINT(155) | |
15915 | PARI(76)=VINT(156) | |
15916 | PARI(77)=VINT(159) | |
15917 | PARI(78)=VINT(160) | |
15918 | PARI(81)=VINT(138) | |
15919 | ||
15920 | C...Store information on lepton -> lepton + gamma in PYGAGA. | |
15921 | MSTI(71)=MINT(141) | |
15922 | MSTI(72)=MINT(142) | |
15923 | PARI(101)=VINT(301) | |
15924 | PARI(102)=VINT(302) | |
15925 | DO 160 I=103,114 | |
15926 | PARI(I)=VINT(I+202) | |
15927 | 160 CONTINUE | |
15928 | ||
15929 | C...Set information for PYTABU. | |
15930 | IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN | |
15931 | MSTU(161)=MINT(21) | |
15932 | MSTU(162)=0 | |
15933 | ELSEIF(ISET(ISUB).EQ.5) THEN | |
15934 | MSTU(161)=MINT(23) | |
15935 | MSTU(162)=0 | |
15936 | ELSE | |
15937 | MSTU(161)=MINT(21) | |
15938 | MSTU(162)=MINT(22) | |
15939 | ENDIF | |
15940 | ||
15941 | RETURN | |
15942 | END | |
15943 | ||
15944 | C********************************************************************* | |
15945 | ||
15946 | C...PYFRAM | |
15947 | C...Performs transformations between different coordinate frames. | |
15948 | ||
15949 | SUBROUTINE PYFRAM(IFRAME) | |
15950 | ||
15951 | C...Double precision and integer declarations. | |
15952 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
15953 | IMPLICIT INTEGER(I-N) | |
15954 | INTEGER PYK,PYCHGE,PYCOMP | |
15955 | C...Commonblocks. | |
15956 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
15957 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
15958 | COMMON/PYINT1/MINT(400),VINT(400) | |
15959 | SAVE /PYDAT1/,/PYPARS/,/PYINT1/ | |
15960 | ||
15961 | C...Check that transformation can and should be done. | |
15962 | IF(IFRAME.EQ.1.OR.IFRAME.EQ.2.OR.(IFRAME.EQ.3.AND. | |
15963 | &MINT(91).EQ.1)) THEN | |
15964 | IF(IFRAME.EQ.MINT(6)) RETURN | |
15965 | ELSE | |
15966 | WRITE(MSTU(11),5000) IFRAME,MINT(6) | |
15967 | RETURN | |
15968 | ENDIF | |
15969 | ||
15970 | IF(MINT(6).EQ.1) THEN | |
15971 | C...Transform from fixed target or user specified frame to | |
15972 | C...overall CM frame. | |
15973 | CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) | |
15974 | CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) | |
15975 | CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) | |
15976 | ELSEIF(MINT(6).EQ.3) THEN | |
15977 | C...Transform from hadronic CM frame in DIS to overall CM frame. | |
15978 | CALL PYROBO(0,0,-VINT(221),-VINT(222),-VINT(223),-VINT(224), | |
15979 | & -VINT(225)) | |
15980 | ENDIF | |
15981 | ||
15982 | IF(IFRAME.EQ.1) THEN | |
15983 | C...Transform from overall CM frame to fixed target or user specified | |
15984 | C...frame. | |
15985 | CALL PYROBO(0,0,VINT(6),VINT(7),VINT(8),VINT(9),VINT(10)) | |
15986 | ELSEIF(IFRAME.EQ.3) THEN | |
15987 | C...Transform from overall CM frame to hadronic CM frame in DIS. | |
15988 | CALL PYROBO(0,0,0D0,0D0,VINT(223),VINT(224),VINT(225)) | |
15989 | CALL PYROBO(0,0,0D0,VINT(222),0D0,0D0,0D0) | |
15990 | CALL PYROBO(0,0,VINT(221),0D0,0D0,0D0,0D0) | |
15991 | ENDIF | |
15992 | ||
15993 | C...Set information about new frame. | |
15994 | MINT(6)=IFRAME | |
15995 | MSTI(6)=IFRAME | |
15996 | ||
15997 | 5000 FORMAT(1X,'Error: illegal values in subroutine PYFRAM.',1X, | |
15998 | &'No transformation performed.'/1X,'IFRAME =',1X,I5,'; MINT(6) =', | |
15999 | &1X,I5) | |
16000 | ||
16001 | RETURN | |
16002 | END | |
16003 | ||
16004 | C********************************************************************* | |
16005 | ||
16006 | C...PYWIDT | |
16007 | C...Calculates full and partial widths of resonances. | |
16008 | ||
16009 | SUBROUTINE PYWIDT(KFLR,SH,WDTP,WDTE) | |
16010 | ||
16011 | C...Double precision and integer declarations. | |
16012 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
16013 | IMPLICIT INTEGER(I-N) | |
16014 | INTEGER PYK,PYCHGE,PYCOMP | |
16015 | C...Parameter statement to help give large particle numbers. | |
16016 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
16017 | &KEXCIT=4000000,KDIMEN=5000000) | |
16018 | C...Commonblocks. | |
16019 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
16020 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
16021 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
16022 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
16023 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
16024 | COMMON/PYINT1/MINT(400),VINT(400) | |
16025 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
16026 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
16027 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
16028 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
16029 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
16030 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
16031 | &/PYINT4/,/PYMSSM/,/PYSSMT/,/PYTCSM/ | |
16032 | C...Local arrays and saved variables. | |
16033 | COMPLEX*16 ZMIXC(4,4),AL,BL,AR,BR,FL,FR | |
16034 | DIMENSION WDTP(0:400),WDTE(0:400,0:5),MOFSV(3,2),WIDWSV(3,2), | |
16035 | &WID2SV(3,2),WDTPP(0:400),WDTEP(0:400,0:5) | |
16036 | SAVE MOFSV,WIDWSV,WID2SV | |
16037 | DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/ | |
16038 | ||
16039 | C...Compressed code and sign; mass. | |
16040 | KFLA=IABS(KFLR) | |
16041 | KFLS=ISIGN(1,KFLR) | |
16042 | KC=PYCOMP(KFLA) | |
16043 | SHR=SQRT(SH) | |
16044 | PMR=PMAS(KC,1) | |
16045 | ||
16046 | C...Reset width information. | |
16047 | DO 110 I=0,MDCY(KC,3) | |
16048 | WDTP(I)=0D0 | |
16049 | DO 100 J=0,5 | |
16050 | WDTE(I,J)=0D0 | |
16051 | 100 CONTINUE | |
16052 | 110 CONTINUE | |
16053 | ||
16054 | C...Allow for fudge factor to rescale resonance width. | |
16055 | FUDGE=1D0 | |
16056 | IF(MSTP(110).NE.0.AND.(MWID(KC).EQ.1.OR.MWID(KC).EQ.2.OR. | |
16057 | &(MWID(KC).EQ.3.AND.MINT(63).EQ.1))) THEN | |
16058 | IF(MSTP(110).EQ.KFLA) THEN | |
16059 | FUDGE=PARP(110) | |
16060 | ELSEIF(MSTP(110).EQ.-1) THEN | |
16061 | IF(KFLA.NE.6.AND.KFLA.NE.23.AND.KFLA.NE.24) FUDGE=PARP(110) | |
16062 | ELSEIF(MSTP(110).EQ.-2) THEN | |
16063 | FUDGE=PARP(110) | |
16064 | ENDIF | |
16065 | ENDIF | |
16066 | ||
16067 | C...Not to be treated as a resonance: return. | |
16068 | IF((MWID(KC).LE.0.OR.MWID(KC).GE.4).AND.KFLA.NE.21.AND. | |
16069 | &KFLA.NE.22) THEN | |
16070 | WDTP(0)=1D0 | |
16071 | WDTE(0,0)=1D0 | |
16072 | MINT(61)=0 | |
16073 | MINT(62)=0 | |
16074 | MINT(63)=0 | |
16075 | RETURN | |
16076 | ||
16077 | C...Treatment as a resonance based on tabulated branching ratios. | |
16078 | ELSEIF(MWID(KC).EQ.2.OR.(MWID(KC).EQ.3.AND.MINT(63).EQ.0)) THEN | |
16079 | C...Loop over possible decay channels; skip irrelevant ones. | |
16080 | DO 120 I=1,MDCY(KC,3) | |
16081 | IDC=I+MDCY(KC,2)-1 | |
16082 | IF(MDME(IDC,1).LT.0) GOTO 120 | |
16083 | ||
16084 | C...Read out decay products and nominal masses. | |
16085 | KFD1=KFDP(IDC,1) | |
16086 | KFC1=PYCOMP(KFD1) | |
16087 | IF(KCHG(KFC1,3).EQ.1) KFD1=KFLS*KFD1 | |
16088 | PM1=PMAS(KFC1,1) | |
16089 | KFD2=KFDP(IDC,2) | |
16090 | KFC2=PYCOMP(KFD2) | |
16091 | IF(KCHG(KFC2,3).EQ.1) KFD2=KFLS*KFD2 | |
16092 | PM2=PMAS(KFC2,1) | |
16093 | KFD3=KFDP(IDC,3) | |
16094 | PM3=0D0 | |
16095 | IF(KFD3.NE.0) THEN | |
16096 | KFC3=PYCOMP(KFD3) | |
16097 | IF(KCHG(KFC3,3).EQ.1) KFD3=KFLS*KFD3 | |
16098 | PM3=PMAS(KFC3,1) | |
16099 | ENDIF | |
16100 | ||
16101 | C...Naive partial width and alternative threshold factors. | |
16102 | WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR) | |
16103 | IF(MDME(IDC,2).GE.51.AND.MDME(IDC,2).LE.53.AND. | |
16104 | & PM1+PM2+PM3.GE.SHR) THEN | |
16105 | WDTP(I)=0D0 | |
16106 | ELSEIF(MDME(IDC,2).EQ.52.AND.KFD3.EQ.0) THEN | |
16107 | WDTP(I)=WDTP(I)*SQRT(MAX(0D0,(SH-PM1**2-PM2**2)**2- | |
16108 | & 4D0*PM1**2*PM2**2))/SH | |
16109 | ELSEIF(MDME(IDC,2).EQ.52) THEN | |
16110 | PMA=MAX(PM1,PM2,PM3) | |
16111 | PMC=MIN(PM1,PM2,PM3) | |
16112 | PMB=PM1+PM2+PM3-PMA-PMC | |
16113 | PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMC-PMC) | |
16114 | PMAN=PMA**2/SH | |
16115 | PMBN=PMB**2/SH | |
16116 | PMCN=PMC**2/SH | |
16117 | PMBCN=PMBC**2/SH | |
16118 | WDTP(I)=WDTP(I)*SQRT(MAX(0D0, | |
16119 | & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* | |
16120 | & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* | |
16121 | & ((SHR-PMA)**2-(PMB+PMC)**2)* | |
16122 | & (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/ | |
16123 | & ((1D0-PMBCN)*PMBCN*SH) | |
16124 | ELSEIF(MDME(IDC,2).EQ.53.AND.KFD3.EQ.0) THEN | |
16125 | WDTP(I)=WDTP(I)*SQRT( | |
16126 | & MAX(0D0,(SH-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)/ | |
16127 | & MAX(1D-4,(PMR**2-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)) | |
16128 | ELSEIF(MDME(IDC,2).EQ.53) THEN | |
16129 | PMA=MAX(PM1,PM2,PM3) | |
16130 | PMC=MIN(PM1,PM2,PM3) | |
16131 | PMB=PM1+PM2+PM3-PMA-PMC | |
16132 | PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMB-PMC) | |
16133 | PMAN=PMA**2/SH | |
16134 | PMBN=PMB**2/SH | |
16135 | PMCN=PMC**2/SH | |
16136 | PMBCN=PMBC**2/SH | |
16137 | FACACT=SQRT(MAX(0D0, | |
16138 | & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* | |
16139 | & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* | |
16140 | & ((SHR-PMA)**2-(PMB+PMC)**2)* | |
16141 | & (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/ | |
16142 | & ((1D0-PMBCN)*PMBCN*SH) | |
16143 | PMBC=PMB+PMC+0.5D0*(PMR-PMA-PMB-PMC) | |
16144 | PMAN=PMA**2/PMR**2 | |
16145 | PMBN=PMB**2/PMR**2 | |
16146 | PMCN=PMC**2/PMR**2 | |
16147 | PMBCN=PMBC**2/PMR**2 | |
16148 | FACNOM=SQRT(MAX(0D0, | |
16149 | & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* | |
16150 | & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* | |
16151 | & ((PMR-PMA)**2-(PMB+PMC)**2)* | |
16152 | & (1D0+0.25D0*(PMA+PMB+PMC)/PMR)/ | |
16153 | & ((1D0-PMBCN)*PMBCN*PMR**2) | |
16154 | WDTP(I)=WDTP(I)*FACACT/MAX(1D-6,FACNOM) | |
16155 | ENDIF | |
16156 | WDTP(I)=FUDGE*WDTP(I) | |
16157 | WDTP(0)=WDTP(0)+WDTP(I) | |
16158 | ||
16159 | C...Calculate secondary width (at most two identical/opposite). | |
16160 | WID2=1D0 | |
16161 | IF(MDME(IDC,1).GT.0) THEN | |
16162 | IF(KFD2.EQ.KFD1) THEN | |
16163 | IF(KCHG(KFC1,3).EQ.0) THEN | |
16164 | WID2=WIDS(KFC1,1) | |
16165 | ELSEIF(KFD1.GT.0) THEN | |
16166 | WID2=WIDS(KFC1,4) | |
16167 | ELSE | |
16168 | WID2=WIDS(KFC1,5) | |
16169 | ENDIF | |
16170 | IF(KFD3.GT.0) THEN | |
16171 | WID2=WID2*WIDS(KFC3,2) | |
16172 | ELSEIF(KFD3.LT.0) THEN | |
16173 | WID2=WID2*WIDS(KFC3,3) | |
16174 | ENDIF | |
16175 | ELSEIF(KFD2.EQ.-KFD1) THEN | |
16176 | WID2=WIDS(KFC1,1) | |
16177 | IF(KFD3.GT.0) THEN | |
16178 | WID2=WID2*WIDS(KFC3,2) | |
16179 | ELSEIF(KFD3.LT.0) THEN | |
16180 | WID2=WID2*WIDS(KFC3,3) | |
16181 | ENDIF | |
16182 | ELSEIF(KFD3.EQ.KFD1) THEN | |
16183 | IF(KCHG(KFC1,3).EQ.0) THEN | |
16184 | WID2=WIDS(KFC1,1) | |
16185 | ELSEIF(KFD1.GT.0) THEN | |
16186 | WID2=WIDS(KFC1,4) | |
16187 | ELSE | |
16188 | WID2=WIDS(KFC1,5) | |
16189 | ENDIF | |
16190 | IF(KFD2.GT.0) THEN | |
16191 | WID2=WID2*WIDS(KFC2,2) | |
16192 | ELSEIF(KFD2.LT.0) THEN | |
16193 | WID2=WID2*WIDS(KFC2,3) | |
16194 | ENDIF | |
16195 | ELSEIF(KFD3.EQ.-KFD1) THEN | |
16196 | WID2=WIDS(KFC1,1) | |
16197 | IF(KFD2.GT.0) THEN | |
16198 | WID2=WID2*WIDS(KFC2,2) | |
16199 | ELSEIF(KFD2.LT.0) THEN | |
16200 | WID2=WID2*WIDS(KFC2,3) | |
16201 | ENDIF | |
16202 | ELSEIF(KFD3.EQ.KFD2) THEN | |
16203 | IF(KCHG(KFC2,3).EQ.0) THEN | |
16204 | WID2=WIDS(KFC2,1) | |
16205 | ELSEIF(KFD2.GT.0) THEN | |
16206 | WID2=WIDS(KFC2,4) | |
16207 | ELSE | |
16208 | WID2=WIDS(KFC2,5) | |
16209 | ENDIF | |
16210 | IF(KFD1.GT.0) THEN | |
16211 | WID2=WID2*WIDS(KFC1,2) | |
16212 | ELSEIF(KFD1.LT.0) THEN | |
16213 | WID2=WID2*WIDS(KFC1,3) | |
16214 | ENDIF | |
16215 | ELSEIF(KFD3.EQ.-KFD2) THEN | |
16216 | WID2=WIDS(KFC2,1) | |
16217 | IF(KFD1.GT.0) THEN | |
16218 | WID2=WID2*WIDS(KFC1,2) | |
16219 | ELSEIF(KFD1.LT.0) THEN | |
16220 | WID2=WID2*WIDS(KFC1,3) | |
16221 | ENDIF | |
16222 | ELSE | |
16223 | IF(KFD1.GT.0) THEN | |
16224 | WID2=WIDS(KFC1,2) | |
16225 | ELSE | |
16226 | WID2=WIDS(KFC1,3) | |
16227 | ENDIF | |
16228 | IF(KFD2.GT.0) THEN | |
16229 | WID2=WID2*WIDS(KFC2,2) | |
16230 | ELSE | |
16231 | WID2=WID2*WIDS(KFC2,3) | |
16232 | ENDIF | |
16233 | IF(KFD3.GT.0) THEN | |
16234 | WID2=WID2*WIDS(KFC3,2) | |
16235 | ELSEIF(KFD3.LT.0) THEN | |
16236 | WID2=WID2*WIDS(KFC3,3) | |
16237 | ENDIF | |
16238 | ENDIF | |
16239 | ||
16240 | C...Store effective widths according to case. | |
16241 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16242 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
16243 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16244 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16245 | ENDIF | |
16246 | 120 CONTINUE | |
16247 | C...Return. | |
16248 | MINT(61)=0 | |
16249 | MINT(62)=0 | |
16250 | MINT(63)=0 | |
16251 | RETURN | |
16252 | ENDIF | |
16253 | ||
16254 | C...Here begins detailed dynamical calculation of resonance widths. | |
16255 | C...Shared treatment of Higgs states. | |
16256 | KFHIGG=25 | |
16257 | IHIGG=1 | |
16258 | IF(KFLA.EQ.35.OR.KFLA.EQ.36) THEN | |
16259 | KFHIGG=KFLA | |
16260 | IHIGG=KFLA-33 | |
16261 | ENDIF | |
16262 | ||
16263 | C...Common electroweak and strong constants. | |
16264 | XW=PARU(102) | |
16265 | XWV=XW | |
16266 | IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 | |
16267 | XW1=1D0-XW | |
16268 | AEM=PYALEM(SH) | |
16269 | IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) | |
16270 | AS=PYALPS(SH) | |
16271 | RADC=1D0+AS/PARU(1) | |
16272 | ||
16273 | IF(KFLA.EQ.6) THEN | |
16274 | C...t quark. | |
16275 | FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR | |
16276 | RADCT=1D0-2.5D0*AS/PARU(1) | |
16277 | DO 140 I=1,MDCY(KC,3) | |
16278 | IDC=I+MDCY(KC,2)-1 | |
16279 | IF(MDME(IDC,1).LT.0) GOTO 140 | |
16280 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
16281 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
16282 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140 | |
16283 | WID2=1D0 | |
16284 | IF(I.GE.4.AND.I.LE.7) THEN | |
16285 | C...t -> W + q; including approximate QCD correction factor. | |
16286 | WDTP(I)=FAC*VCKM(3,I-3)*RADCT* | |
16287 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16288 | & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) | |
16289 | IF(KFLR.GT.0) THEN | |
16290 | WID2=WIDS(24,2) | |
16291 | IF(I.EQ.7) WID2=WID2*WIDS(7,2) | |
16292 | ELSE | |
16293 | WID2=WIDS(24,3) | |
16294 | IF(I.EQ.7) WID2=WID2*WIDS(7,3) | |
16295 | ENDIF | |
16296 | ELSEIF(I.EQ.9) THEN | |
16297 | C...t -> H + b. | |
16298 | WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16299 | & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) | |
16300 | WID2=WIDS(37,2) | |
16301 | IF(KFLR.LT.0) WID2=WIDS(37,3) | |
16302 | CMRENNA++ | |
16303 | ELSEIF(I.GE.10.AND.I.LE.13.AND.IMSS(1).NE.0) THEN | |
16304 | C...t -> ~t + ~chi_i0, i = 1, 2, 3 or 4. | |
16305 | BETA=ATAN(RMSS(5)) | |
16306 | SINB=SIN(BETA) | |
16307 | TANW=SQRT(PARU(102)/(1D0-PARU(102))) | |
16308 | ET=KCHG(6,1)/3D0 | |
16309 | T3L=SIGN(0.5D0,ET) | |
16310 | KFC1=PYCOMP(KFDP(IDC,1)) | |
16311 | KFC2=PYCOMP(KFDP(IDC,2)) | |
16312 | PMNCHI=PMAS(KFC1,1) | |
16313 | PMSTOP=PMAS(KFC2,1) | |
16314 | IF(SHR.GT.PMNCHI+PMSTOP) THEN | |
16315 | IZ=I-9 | |
16316 | DO 130 IK=1,4 | |
16317 | ZMIXC(IZ,IK)=DCMPLX(ZMIX(IZ,IK),ZMIXI(IZ,IK)) | |
16318 | 130 CONTINUE | |
16319 | AL=SHR*DCONJG(ZMIXC(IZ,4))/(2.0D0*PMAS(24,1)*SINB) | |
16320 | AR=-ET*ZMIXC(IZ,1)*TANW | |
16321 | BL=T3L*(ZMIXC(IZ,2)-ZMIXC(IZ,1)*TANW)-AR | |
16322 | BR=AL | |
16323 | FL=SFMIX(6,1)*AL+SFMIX(6,2)*AR | |
16324 | FR=SFMIX(6,1)*BL+SFMIX(6,2)*BR | |
16325 | PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)* | |
16326 | & (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR) | |
16327 | WDTP(I)=(0.5D0*PYALEM(SH)/PARU(102))*PCM* | |
16328 | & ((ABS(FL)**2+ABS(FR)**2)*(SH+PMNCHI**2-PMSTOP**2)+ | |
16329 | & SMZ(IZ)*4D0*SHR*DBLE(FL*DCONJG(FR)))/SH | |
16330 | IF(KFLR.GT.0) THEN | |
16331 | WID2=WIDS(KFC1,2)*WIDS(KFC2,2) | |
16332 | ELSE | |
16333 | WID2=WIDS(KFC1,2)*WIDS(KFC2,3) | |
16334 | ENDIF | |
16335 | ENDIF | |
16336 | ELSEIF(I.EQ.14.AND.IMSS(1).NE.0) THEN | |
16337 | C...t -> ~g + ~t | |
16338 | KFC1=PYCOMP(KFDP(IDC,1)) | |
16339 | KFC2=PYCOMP(KFDP(IDC,2)) | |
16340 | PMNCHI=PMAS(KFC1,1) | |
16341 | PMSTOP=PMAS(KFC2,1) | |
16342 | IF(SHR.GT.PMNCHI+PMSTOP) THEN | |
16343 | RL=SFMIX(6,1) | |
16344 | RR=-SFMIX(6,2) | |
16345 | PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)* | |
16346 | & (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR) | |
16347 | WDTP(I)=4D0/3D0*0.5D0*PYALPS(SH)*PCM*((RL**2+RR**2)* | |
16348 | & (SH+PMNCHI**2-PMSTOP**2)+PMNCHI*4D0*SHR*RL*RR)/SH | |
16349 | IF(KFLR.GT.0) THEN | |
16350 | WID2=WIDS(KFC1,2)*WIDS(KFC2,2) | |
16351 | ELSE | |
16352 | WID2=WIDS(KFC1,2)*WIDS(KFC2,3) | |
16353 | ENDIF | |
16354 | ENDIF | |
16355 | ELSEIF(I.EQ.15.AND.IMSS(1).NE.0) THEN | |
16356 | C...t -> ~gravitino + ~t | |
16357 | XMP2=RMSS(29)**2 | |
16358 | KFC1=PYCOMP(KFDP(IDC,1)) | |
16359 | XMGR2=PMAS(KFC1,1)**2 | |
16360 | WDTP(I)=SH**2*SHR/(96D0*PARU(1)*XMP2*XMGR2)*(1D0-RM2)**4 | |
16361 | KFC2=PYCOMP(KFDP(IDC,2)) | |
16362 | WID2=WIDS(KFC2,2) | |
16363 | IF(KFLR.LT.0) WID2=WIDS(KFC2,3) | |
16364 | CMRENNA-- | |
16365 | ENDIF | |
16366 | WDTP(I)=FUDGE*WDTP(I) | |
16367 | WDTP(0)=WDTP(0)+WDTP(I) | |
16368 | IF(MDME(IDC,1).GT.0) THEN | |
16369 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16370 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
16371 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16372 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16373 | ENDIF | |
16374 | 140 CONTINUE | |
16375 | ||
16376 | ELSEIF(KFLA.EQ.7) THEN | |
16377 | C...b' quark. | |
16378 | FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR | |
16379 | DO 150 I=1,MDCY(KC,3) | |
16380 | IDC=I+MDCY(KC,2)-1 | |
16381 | IF(MDME(IDC,1).LT.0) GOTO 150 | |
16382 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
16383 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
16384 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 150 | |
16385 | WID2=1D0 | |
16386 | IF(I.GE.4.AND.I.LE.7) THEN | |
16387 | C...b' -> W + q. | |
16388 | WDTP(I)=FAC*VCKM(I-3,4)* | |
16389 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16390 | & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) | |
16391 | IF(KFLR.GT.0) THEN | |
16392 | WID2=WIDS(24,3) | |
16393 | IF(I.EQ.6) WID2=WID2*WIDS(6,2) | |
16394 | IF(I.EQ.7) WID2=WID2*WIDS(8,2) | |
16395 | ELSE | |
16396 | WID2=WIDS(24,2) | |
16397 | IF(I.EQ.6) WID2=WID2*WIDS(6,3) | |
16398 | IF(I.EQ.7) WID2=WID2*WIDS(8,3) | |
16399 | ENDIF | |
16400 | WID2=WIDS(24,3) | |
16401 | IF(KFLR.LT.0) WID2=WIDS(24,2) | |
16402 | ELSEIF(I.EQ.9.OR.I.EQ.10) THEN | |
16403 | C...b' -> H + q. | |
16404 | WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16405 | & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) | |
16406 | IF(KFLR.GT.0) THEN | |
16407 | WID2=WIDS(37,3) | |
16408 | IF(I.EQ.10) WID2=WID2*WIDS(6,2) | |
16409 | ELSE | |
16410 | WID2=WIDS(37,2) | |
16411 | IF(I.EQ.10) WID2=WID2*WIDS(6,3) | |
16412 | ENDIF | |
16413 | ENDIF | |
16414 | WDTP(I)=FUDGE*WDTP(I) | |
16415 | WDTP(0)=WDTP(0)+WDTP(I) | |
16416 | IF(MDME(IDC,1).GT.0) THEN | |
16417 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16418 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
16419 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16420 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16421 | ENDIF | |
16422 | 150 CONTINUE | |
16423 | ||
16424 | ELSEIF(KFLA.EQ.8) THEN | |
16425 | C...t' quark. | |
16426 | FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR | |
16427 | DO 160 I=1,MDCY(KC,3) | |
16428 | IDC=I+MDCY(KC,2)-1 | |
16429 | IF(MDME(IDC,1).LT.0) GOTO 160 | |
16430 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
16431 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
16432 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 160 | |
16433 | WID2=1D0 | |
16434 | IF(I.GE.4.AND.I.LE.7) THEN | |
16435 | C...t' -> W + q. | |
16436 | WDTP(I)=FAC*VCKM(4,I-3)* | |
16437 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16438 | & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) | |
16439 | IF(KFLR.GT.0) THEN | |
16440 | WID2=WIDS(24,2) | |
16441 | IF(I.EQ.7) WID2=WID2*WIDS(7,2) | |
16442 | ELSE | |
16443 | WID2=WIDS(24,3) | |
16444 | IF(I.EQ.7) WID2=WID2*WIDS(7,3) | |
16445 | ENDIF | |
16446 | ELSEIF(I.EQ.9.OR.I.EQ.10) THEN | |
16447 | C...t' -> H + q. | |
16448 | WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16449 | & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) | |
16450 | IF(KFLR.GT.0) THEN | |
16451 | WID2=WIDS(37,2) | |
16452 | IF(I.EQ.10) WID2=WID2*WIDS(7,2) | |
16453 | ELSE | |
16454 | WID2=WIDS(37,3) | |
16455 | IF(I.EQ.10) WID2=WID2*WIDS(7,3) | |
16456 | ENDIF | |
16457 | ENDIF | |
16458 | WDTP(I)=FUDGE*WDTP(I) | |
16459 | WDTP(0)=WDTP(0)+WDTP(I) | |
16460 | IF(MDME(IDC,1).GT.0) THEN | |
16461 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16462 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
16463 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16464 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16465 | ENDIF | |
16466 | 160 CONTINUE | |
16467 | ||
16468 | ELSEIF(KFLA.EQ.17) THEN | |
16469 | C...tau' lepton. | |
16470 | FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR | |
16471 | DO 170 I=1,MDCY(KC,3) | |
16472 | IDC=I+MDCY(KC,2)-1 | |
16473 | IF(MDME(IDC,1).LT.0) GOTO 170 | |
16474 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
16475 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
16476 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 170 | |
16477 | WID2=1D0 | |
16478 | IF(I.EQ.3) THEN | |
16479 | C...tau' -> W + nu'_tau. | |
16480 | WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16481 | & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) | |
16482 | IF(KFLR.GT.0) THEN | |
16483 | WID2=WIDS(24,3) | |
16484 | WID2=WID2*WIDS(18,2) | |
16485 | ELSE | |
16486 | WID2=WIDS(24,2) | |
16487 | WID2=WID2*WIDS(18,3) | |
16488 | ENDIF | |
16489 | ELSEIF(I.EQ.5) THEN | |
16490 | C...tau' -> H + nu'_tau. | |
16491 | WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16492 | & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) | |
16493 | IF(KFLR.GT.0) THEN | |
16494 | WID2=WIDS(37,3) | |
16495 | WID2=WID2*WIDS(18,2) | |
16496 | ELSE | |
16497 | WID2=WIDS(37,2) | |
16498 | WID2=WID2*WIDS(18,3) | |
16499 | ENDIF | |
16500 | ENDIF | |
16501 | WDTP(I)=FUDGE*WDTP(I) | |
16502 | WDTP(0)=WDTP(0)+WDTP(I) | |
16503 | IF(MDME(IDC,1).GT.0) THEN | |
16504 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16505 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
16506 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16507 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16508 | ENDIF | |
16509 | 170 CONTINUE | |
16510 | ||
16511 | ELSEIF(KFLA.EQ.18) THEN | |
16512 | C...nu'_tau neutrino. | |
16513 | FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR | |
16514 | DO 180 I=1,MDCY(KC,3) | |
16515 | IDC=I+MDCY(KC,2)-1 | |
16516 | IF(MDME(IDC,1).LT.0) GOTO 180 | |
16517 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
16518 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
16519 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 180 | |
16520 | WID2=1D0 | |
16521 | IF(I.EQ.2) THEN | |
16522 | C...nu'_tau -> W + tau'. | |
16523 | WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16524 | & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) | |
16525 | IF(KFLR.GT.0) THEN | |
16526 | WID2=WIDS(24,2) | |
16527 | WID2=WID2*WIDS(17,2) | |
16528 | ELSE | |
16529 | WID2=WIDS(24,3) | |
16530 | WID2=WID2*WIDS(17,3) | |
16531 | ENDIF | |
16532 | ELSEIF(I.EQ.3) THEN | |
16533 | C...nu'_tau -> H + tau'. | |
16534 | WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
16535 | & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) | |
16536 | IF(KFLR.GT.0) THEN | |
16537 | WID2=WIDS(37,2) | |
16538 | WID2=WID2*WIDS(17,2) | |
16539 | ELSE | |
16540 | WID2=WIDS(37,3) | |
16541 | WID2=WID2*WIDS(17,3) | |
16542 | ENDIF | |
16543 | ENDIF | |
16544 | WDTP(I)=FUDGE*WDTP(I) | |
16545 | WDTP(0)=WDTP(0)+WDTP(I) | |
16546 | IF(MDME(IDC,1).GT.0) THEN | |
16547 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16548 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
16549 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16550 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16551 | ENDIF | |
16552 | 180 CONTINUE | |
16553 | ||
16554 | ELSEIF(KFLA.EQ.21) THEN | |
16555 | C...QCD: | |
16556 | C***Note that widths are not given in dimensional quantities here. | |
16557 | DO 190 I=1,MDCY(KC,3) | |
16558 | IDC=I+MDCY(KC,2)-1 | |
16559 | IF(MDME(IDC,1).LT.0) GOTO 190 | |
16560 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH | |
16561 | RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH | |
16562 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 190 | |
16563 | WID2=1D0 | |
16564 | IF(I.LE.8) THEN | |
16565 | C...QCD -> q + qbar | |
16566 | WDTP(I)=(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) | |
16567 | IF(I.EQ.6) WID2=WIDS(6,1) | |
16568 | IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) | |
16569 | ENDIF | |
16570 | WDTP(I)=FUDGE*WDTP(I) | |
16571 | WDTP(0)=WDTP(0)+WDTP(I) | |
16572 | IF(MDME(IDC,1).GT.0) THEN | |
16573 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16574 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
16575 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16576 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16577 | ENDIF | |
16578 | 190 CONTINUE | |
16579 | ||
16580 | ELSEIF(KFLA.EQ.22) THEN | |
16581 | C...QED photon. | |
16582 | C***Note that widths are not given in dimensional quantities here. | |
16583 | DO 200 I=1,MDCY(KC,3) | |
16584 | IDC=I+MDCY(KC,2)-1 | |
16585 | IF(MDME(IDC,1).LT.0) GOTO 200 | |
16586 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH | |
16587 | RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH | |
16588 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 200 | |
16589 | WID2=1D0 | |
16590 | IF(I.LE.8) THEN | |
16591 | C...QED -> q + qbar. | |
16592 | EF=KCHG(I,1)/3D0 | |
16593 | FCOF=3D0*RADC | |
16594 | IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) | |
16595 | WDTP(I)=FCOF*EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) | |
16596 | IF(I.EQ.6) WID2=WIDS(6,1) | |
16597 | IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) | |
16598 | ELSEIF(I.LE.12) THEN | |
16599 | C...QED -> l+ + l-. | |
16600 | EF=KCHG(9+2*(I-8),1)/3D0 | |
16601 | WDTP(I)=EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) | |
16602 | IF(I.EQ.12) WID2=WIDS(17,1) | |
16603 | ENDIF | |
16604 | WDTP(I)=FUDGE*WDTP(I) | |
16605 | WDTP(0)=WDTP(0)+WDTP(I) | |
16606 | IF(MDME(IDC,1).GT.0) THEN | |
16607 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16608 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
16609 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16610 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16611 | ENDIF | |
16612 | 200 CONTINUE | |
16613 | ||
16614 | ELSEIF(KFLA.EQ.23) THEN | |
16615 | C...Z0: | |
16616 | ICASE=1 | |
16617 | XWC=1D0/(16D0*XW*XW1) | |
16618 | FAC=(AEM*XWC/3D0)*SHR | |
16619 | 210 CONTINUE | |
16620 | IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN | |
16621 | VINT(111)=0D0 | |
16622 | VINT(112)=0D0 | |
16623 | VINT(114)=0D0 | |
16624 | ENDIF | |
16625 | IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN | |
16626 | KFI=IABS(MINT(15)) | |
16627 | IF(KFI.GT.20) KFI=IABS(MINT(16)) | |
16628 | EI=KCHG(KFI,1)/3D0 | |
16629 | AI=SIGN(1D0,EI) | |
16630 | VI=AI-4D0*EI*XWV | |
16631 | SQMZ=PMAS(23,1)**2 | |
16632 | HZ=SHR*WDTP(0) | |
16633 | IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=1D0 | |
16634 | IF(MSTP(43).EQ.3) VINT(112)= | |
16635 | & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) | |
16636 | IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= | |
16637 | & XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) | |
16638 | ENDIF | |
16639 | DO 220 I=1,MDCY(KC,3) | |
16640 | IDC=I+MDCY(KC,2)-1 | |
16641 | IF(MDME(IDC,1).LT.0) GOTO 220 | |
16642 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH | |
16643 | RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH | |
16644 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 220 | |
16645 | WID2=1D0 | |
16646 | IF(I.LE.8) THEN | |
16647 | C...Z0 -> q + qbar | |
16648 | EF=KCHG(I,1)/3D0 | |
16649 | AF=SIGN(1D0,EF+0.1D0) | |
16650 | VF=AF-4D0*EF*XWV | |
16651 | FCOF=3D0*RADC | |
16652 | IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) | |
16653 | IF(I.EQ.6) WID2=WIDS(6,1) | |
16654 | IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) | |
16655 | ELSEIF(I.LE.16) THEN | |
16656 | C...Z0 -> l+ + l-, nu + nubar | |
16657 | EF=KCHG(I+2,1)/3D0 | |
16658 | AF=SIGN(1D0,EF+0.1D0) | |
16659 | VF=AF-4D0*EF*XWV | |
16660 | FCOF=1D0 | |
16661 | IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) | |
16662 | ENDIF | |
16663 | BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) | |
16664 | IF(ICASE.EQ.1) THEN | |
16665 | WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* | |
16666 | & BE34 | |
16667 | ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN | |
16668 | WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* | |
16669 | & EF*VF+(VI**2+AI**2)*VINT(114)*VF**2)*(1D0+2D0*RM1)+ | |
16670 | & (VI**2+AI**2)*VINT(114)*AF**2*(1D0-4D0*RM1))*BE34 | |
16671 | ELSEIF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN | |
16672 | FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 | |
16673 | FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 | |
16674 | FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 | |
16675 | ENDIF | |
16676 | IF(ICASE.EQ.1) WDTP(I)=FUDGE*WDTP(I) | |
16677 | IF(ICASE.EQ.1) WDTP(0)=WDTP(0)+WDTP(I) | |
16678 | IF(MDME(IDC,1).GT.0) THEN | |
16679 | IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. | |
16680 | & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN | |
16681 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16682 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ | |
16683 | & WDTE(I,MDME(IDC,1)) | |
16684 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16685 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16686 | ENDIF | |
16687 | IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN | |
16688 | IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)= | |
16689 | & VINT(111)+FGGF*WID2 | |
16690 | IF(MSTP(43).EQ.3) VINT(112)=VINT(112)+FGZF*WID2 | |
16691 | IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= | |
16692 | & VINT(114)+FZZF*WID2 | |
16693 | ENDIF | |
16694 | ENDIF | |
16695 | 220 CONTINUE | |
16696 | IF(MINT(61).GE.1) ICASE=3-ICASE | |
16697 | IF(ICASE.EQ.2) GOTO 210 | |
16698 | ||
16699 | ELSEIF(KFLA.EQ.24) THEN | |
16700 | C...W+/-: | |
16701 | FAC=(AEM/(24D0*XW))*SHR | |
16702 | DO 230 I=1,MDCY(KC,3) | |
16703 | IDC=I+MDCY(KC,2)-1 | |
16704 | IF(MDME(IDC,1).LT.0) GOTO 230 | |
16705 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH | |
16706 | RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH | |
16707 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 230 | |
16708 | WID2=1D0 | |
16709 | IF(I.LE.16) THEN | |
16710 | C...W+/- -> q + qbar' | |
16711 | FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1) | |
16712 | IF(KFLR.GT.0) THEN | |
16713 | IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) | |
16714 | IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) | |
16715 | IF(I.GE.13) WID2=WID2*WIDS(7,3) | |
16716 | ELSE | |
16717 | IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) | |
16718 | IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) | |
16719 | IF(I.GE.13) WID2=WID2*WIDS(7,2) | |
16720 | ENDIF | |
16721 | ELSEIF(I.LE.20) THEN | |
16722 | C...W+/- -> l+/- + nu | |
16723 | FCOF=1D0 | |
16724 | IF(KFLR.GT.0) THEN | |
16725 | IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) | |
16726 | ELSE | |
16727 | IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) | |
16728 | ENDIF | |
16729 | ENDIF | |
16730 | WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* | |
16731 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
16732 | WDTP(I)=FUDGE*WDTP(I) | |
16733 | WDTP(0)=WDTP(0)+WDTP(I) | |
16734 | IF(MDME(IDC,1).GT.0) THEN | |
16735 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
16736 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
16737 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
16738 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
16739 | ENDIF | |
16740 | 230 CONTINUE | |
16741 | ||
16742 | ELSEIF(KFLA.EQ.25.OR.KFLA.EQ.35.OR.KFLA.EQ.36) THEN | |
16743 | C...h0 (or H0, or A0): | |
16744 | SHFS=SH | |
16745 | FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR | |
16746 | DO 270 I=1,MDCY(KFHIGG,3) | |
16747 | IDC=I+MDCY(KFHIGG,2)-1 | |
16748 | IF(MDME(IDC,1).LT.0) GOTO 270 | |
16749 | KFC1=PYCOMP(KFDP(IDC,1)) | |
16750 | KFC2=PYCOMP(KFDP(IDC,2)) | |
16751 | RM1=PMAS(KFC1,1)**2/SH | |
16752 | RM2=PMAS(KFC2,1)**2/SH | |
16753 | IF(I.NE.16.AND.I.NE.17.AND.SQRT(RM1)+SQRT(RM2).GT.1D0) | |
16754 | & GOTO 270 | |
16755 | WID2=1D0 | |
16756 | ||
16757 | IF(I.LE.8) THEN | |
16758 | C...h0 -> q + qbar | |
16759 | WDTP(I)=FAC*3D0*(PYMRUN(KFDP(IDC,1),SH)**2/SHFS)* | |
16760 | & SQRT(MAX(0D0,1D0-4D0*RM1))*RADC | |
16761 | C...A0 behaves like beta, ho and H0 like beta**3. | |
16762 | IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1) | |
16763 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN | |
16764 | IF(MOD(I,2).EQ.1) WDTP(I)=WDTP(I)*PARU(151+10*IHIGG)**2 | |
16765 | IF(MOD(I,2).EQ.0) WDTP(I)=WDTP(I)*PARU(152+10*IHIGG)**2 | |
16766 | IF(IMSS(1).NE.0.AND.KFC1.EQ.5) THEN | |
16767 | WDTP(I)=WDTP(I)/(1D0+RMSS(41))**2 | |
16768 | IF(IHIGG.NE.3) THEN | |
16769 | WDTP(I)=WDTP(I)*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ | |
16770 | & PARU(151+10*IHIGG))**2 | |
16771 | ENDIF | |
16772 | ENDIF | |
16773 | ENDIF | |
16774 | IF(I.EQ.6) WID2=WIDS(6,1) | |
16775 | IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) | |
16776 | ELSEIF(I.LE.12) THEN | |
16777 | C...h0 -> l+ + l- | |
16778 | WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))*(SH/SHFS) | |
16779 | C...A0 behaves like beta, ho and H0 like beta**3. | |
16780 | IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1) | |
16781 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* | |
16782 | & PARU(153+10*IHIGG)**2 | |
16783 | IF(I.EQ.12) WID2=WIDS(17,1) | |
16784 | ||
16785 | ELSEIF(I.EQ.13) THEN | |
16786 | C...h0 -> g + g; quark loop contribution only | |
16787 | ETARE=0D0 | |
16788 | ETAIM=0D0 | |
16789 | DO 240 J=1,2*MSTP(1) | |
16790 | EPS=(2D0*PMAS(J,1))**2/SH | |
16791 | C...Loop integral; function of eps=4m^2/shat; different for A0. | |
16792 | IF(EPS.LE.1D0) THEN | |
16793 | IF(EPS.GT.1D-4) THEN | |
16794 | ROOT=SQRT(1D0-EPS) | |
16795 | RLN=LOG((1D0+ROOT)/(1D0-ROOT)) | |
16796 | ELSE | |
16797 | RLN=LOG(4D0/EPS-2D0) | |
16798 | ENDIF | |
16799 | PHIRE=-0.25D0*(RLN**2-PARU(1)**2) | |
16800 | PHIIM=0.5D0*PARU(1)*RLN | |
16801 | ELSE | |
16802 | PHIRE=(ASIN(1D0/SQRT(EPS)))**2 | |
16803 | PHIIM=0D0 | |
16804 | ENDIF | |
16805 | IF(IHIGG.LE.2) THEN | |
16806 | ETAREJ=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) | |
16807 | ETAIMJ=-0.5D0*EPS*(1D0-EPS)*PHIIM | |
16808 | ELSE | |
16809 | ETAREJ=-0.5D0*EPS*PHIRE | |
16810 | ETAIMJ=-0.5D0*EPS*PHIIM | |
16811 | ENDIF | |
16812 | C...Couplings (=1 for standard model Higgs). | |
16813 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN | |
16814 | IF(MOD(J,2).EQ.1) THEN | |
16815 | ETAREJ=ETAREJ*PARU(151+10*IHIGG) | |
16816 | ETAIMJ=ETAIMJ*PARU(151+10*IHIGG) | |
16817 | ELSE | |
16818 | ETAREJ=ETAREJ*PARU(152+10*IHIGG) | |
16819 | ETAIMJ=ETAIMJ*PARU(152+10*IHIGG) | |
16820 | ENDIF | |
16821 | ENDIF | |
16822 | ETARE=ETARE+ETAREJ | |
16823 | ETAIM=ETAIM+ETAIMJ | |
16824 | 240 CONTINUE | |
16825 | ETA2=ETARE**2+ETAIM**2 | |
16826 | WDTP(I)=FAC*(AS/PARU(1))**2*ETA2 | |
16827 | ||
16828 | ELSEIF(I.EQ.14) THEN | |
16829 | C...h0 -> gamma + gamma; quark, lepton, W+- and H+- loop contributions | |
16830 | ETARE=0D0 | |
16831 | ETAIM=0D0 | |
16832 | JMAX=3*MSTP(1)+1 | |
16833 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 | |
16834 | DO 250 J=1,JMAX | |
16835 | IF(J.LE.2*MSTP(1)) THEN | |
16836 | EJ=KCHG(J,1)/3D0 | |
16837 | EPS=(2D0*PMAS(J,1))**2/SH | |
16838 | ELSEIF(J.LE.3*MSTP(1)) THEN | |
16839 | JL=2*(J-2*MSTP(1))-1 | |
16840 | EJ=KCHG(10+JL,1)/3D0 | |
16841 | EPS=(2D0*PMAS(10+JL,1))**2/SH | |
16842 | ELSEIF(J.EQ.3*MSTP(1)+1) THEN | |
16843 | EPS=(2D0*PMAS(24,1))**2/SH | |
16844 | ELSE | |
16845 | EPS=(2D0*PMAS(37,1))**2/SH | |
16846 | ENDIF | |
16847 | C...Loop integral; function of eps=4m^2/shat. | |
16848 | IF(EPS.LE.1D0) THEN | |
16849 | IF(EPS.GT.1D-4) THEN | |
16850 | ROOT=SQRT(1D0-EPS) | |
16851 | RLN=LOG((1D0+ROOT)/(1D0-ROOT)) | |
16852 | ELSE | |
16853 | RLN=LOG(4D0/EPS-2D0) | |
16854 | ENDIF | |
16855 | PHIRE=-0.25D0*(RLN**2-PARU(1)**2) | |
16856 | PHIIM=0.5D0*PARU(1)*RLN | |
16857 | ELSE | |
16858 | PHIRE=(ASIN(1D0/SQRT(EPS)))**2 | |
16859 | PHIIM=0D0 | |
16860 | ENDIF | |
16861 | IF(J.LE.3*MSTP(1)) THEN | |
16862 | C...Fermion loops: loop integral different for A0; charges. | |
16863 | IF(IHIGG.LE.2) THEN | |
16864 | PHIPRE=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) | |
16865 | PHIPIM=-0.5D0*EPS*(1D0-EPS)*PHIIM | |
16866 | ELSE | |
16867 | PHIPRE=-0.5D0*EPS*PHIRE | |
16868 | PHIPIM=-0.5D0*EPS*PHIIM | |
16869 | ENDIF | |
16870 | IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN | |
16871 | EJC=3D0*EJ**2 | |
16872 | EJH=PARU(151+10*IHIGG) | |
16873 | ELSEIF(J.LE.2*MSTP(1)) THEN | |
16874 | EJC=3D0*EJ**2 | |
16875 | EJH=PARU(152+10*IHIGG) | |
16876 | ELSE | |
16877 | EJC=EJ**2 | |
16878 | EJH=PARU(153+10*IHIGG) | |
16879 | ENDIF | |
16880 | IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 | |
16881 | ETAREJ=EJC*EJH*PHIPRE | |
16882 | ETAIMJ=EJC*EJH*PHIPIM | |
16883 | ELSEIF(J.EQ.3*MSTP(1)+1) THEN | |
16884 | C...W loops: loop integral and charges. | |
16885 | ETAREJ=0.5D0+0.75D0*EPS*(1D0+(2D0-EPS)*PHIRE) | |
16886 | ETAIMJ=0.75D0*EPS*(2D0-EPS)*PHIIM | |
16887 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN | |
16888 | ETAREJ=ETAREJ*PARU(155+10*IHIGG) | |
16889 | ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) | |
16890 | ENDIF | |
16891 | ELSE | |
16892 | C...Charged H loops: loop integral and charges. | |
16893 | FACHHH=(PMAS(24,1)/PMAS(37,1))**2* | |
16894 | & PARU(158+10*IHIGG+2*(IHIGG/3)) | |
16895 | ETAREJ=EPS*(1D0-EPS*PHIRE)*FACHHH | |
16896 | ETAIMJ=-EPS**2*PHIIM*FACHHH | |
16897 | ENDIF | |
16898 | ETARE=ETARE+ETAREJ | |
16899 | ETAIM=ETAIM+ETAIMJ | |
16900 | 250 CONTINUE | |
16901 | ETA2=ETARE**2+ETAIM**2 | |
16902 | WDTP(I)=FAC*(AEM/PARU(1))**2*0.5D0*ETA2 | |
16903 | ||
16904 | ELSEIF(I.EQ.15) THEN | |
16905 | C...h0 -> gamma + Z0; quark, lepton, W and H+- loop contributions | |
16906 | ETARE=0D0 | |
16907 | ETAIM=0D0 | |
16908 | JMAX=3*MSTP(1)+1 | |
16909 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 | |
16910 | DO 260 J=1,JMAX | |
16911 | IF(J.LE.2*MSTP(1)) THEN | |
16912 | EJ=KCHG(J,1)/3D0 | |
16913 | AJ=SIGN(1D0,EJ+0.1D0) | |
16914 | VJ=AJ-4D0*EJ*XWV | |
16915 | EPS=(2D0*PMAS(J,1))**2/SH | |
16916 | EPSP=(2D0*PMAS(J,1)/PMAS(23,1))**2 | |
16917 | ELSEIF(J.LE.3*MSTP(1)) THEN | |
16918 | JL=2*(J-2*MSTP(1))-1 | |
16919 | EJ=KCHG(10+JL,1)/3D0 | |
16920 | AJ=SIGN(1D0,EJ+0.1D0) | |
16921 | VJ=AJ-4D0*EJ*XWV | |
16922 | EPS=(2D0*PMAS(10+JL,1))**2/SH | |
16923 | EPSP=(2D0*PMAS(10+JL,1)/PMAS(23,1))**2 | |
16924 | ELSE | |
16925 | EPS=(2D0*PMAS(24,1))**2/SH | |
16926 | EPSP=(2D0*PMAS(24,1)/PMAS(23,1))**2 | |
16927 | ENDIF | |
16928 | C...Loop integrals; functions of eps=4m^2/shat and eps'=4m^2/m_Z^2. | |
16929 | IF(EPS.LE.1D0) THEN | |
16930 | ROOT=SQRT(1D0-EPS) | |
16931 | IF(EPS.GT.1D-4) THEN | |
16932 | RLN=LOG((1D0+ROOT)/(1D0-ROOT)) | |
16933 | ELSE | |
16934 | RLN=LOG(4D0/EPS-2D0) | |
16935 | ENDIF | |
16936 | PHIRE=-0.25D0*(RLN**2-PARU(1)**2) | |
16937 | PHIIM=0.5D0*PARU(1)*RLN | |
16938 | PSIRE=0.5D0*ROOT*RLN | |
16939 | PSIIM=-0.5D0*ROOT*PARU(1) | |
16940 | ELSE | |
16941 | PHIRE=(ASIN(1D0/SQRT(EPS)))**2 | |
16942 | PHIIM=0D0 | |
16943 | PSIRE=SQRT(EPS-1D0)*ASIN(1D0/SQRT(EPS)) | |
16944 | PSIIM=0D0 | |
16945 | ENDIF | |
16946 | IF(EPSP.LE.1D0) THEN | |
16947 | ROOT=SQRT(1D0-EPSP) | |
16948 | IF(EPSP.GT.1D-4) THEN | |
16949 | RLN=LOG((1D0+ROOT)/(1D0-ROOT)) | |
16950 | ELSE | |
16951 | RLN=LOG(4D0/EPSP-2D0) | |
16952 | ENDIF | |
16953 | PHIREP=-0.25D0*(RLN**2-PARU(1)**2) | |
16954 | PHIIMP=0.5D0*PARU(1)*RLN | |
16955 | PSIREP=0.5D0*ROOT*RLN | |
16956 | PSIIMP=-0.5D0*ROOT*PARU(1) | |
16957 | ELSE | |
16958 | PHIREP=(ASIN(1D0/SQRT(EPSP)))**2 | |
16959 | PHIIMP=0D0 | |
16960 | PSIREP=SQRT(EPSP-1D0)*ASIN(1D0/SQRT(EPSP)) | |
16961 | PSIIMP=0D0 | |
16962 | ENDIF | |
16963 | FXYRE=EPS*EPSP/(8D0*(EPS-EPSP))*(1D0+EPS*EPSP/(EPS-EPSP)* | |
16964 | & (PHIRE-PHIREP)+2D0*EPS/(EPS-EPSP)*(PSIRE-PSIREP)) | |
16965 | FXYIM=EPS**2*EPSP/(8D0*(EPS-EPSP)**2)* | |
16966 | & (EPSP*(PHIIM-PHIIMP)+2D0*(PSIIM-PSIIMP)) | |
16967 | F1RE=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIRE-PHIREP) | |
16968 | F1IM=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIIM-PHIIMP) | |
16969 | IF(J.LE.3*MSTP(1)) THEN | |
16970 | C...Fermion loops: loop integral different for A0; charges. | |
16971 | IF(IHIGG.EQ.3) FXYRE=0D0 | |
16972 | IF(IHIGG.EQ.3) FXYIM=0D0 | |
16973 | IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN | |
16974 | EJC=-3D0*EJ*VJ | |
16975 | EJH=PARU(151+10*IHIGG) | |
16976 | ELSEIF(J.LE.2*MSTP(1)) THEN | |
16977 | EJC=-3D0*EJ*VJ | |
16978 | EJH=PARU(152+10*IHIGG) | |
16979 | ELSE | |
16980 | EJC=-EJ*VJ | |
16981 | EJH=PARU(153+10*IHIGG) | |
16982 | ENDIF | |
16983 | IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 | |
16984 | ETAREJ=EJC*EJH*(FXYRE-0.25D0*F1RE) | |
16985 | ETAIMJ=EJC*EJH*(FXYIM-0.25D0*F1IM) | |
16986 | ELSEIF(J.EQ.3*MSTP(1)+1) THEN | |
16987 | C...W loops: loop integral and charges. | |
16988 | HEPS=(1D0+2D0/EPS)*XW/XW1-(5D0+2D0/EPS) | |
16989 | ETAREJ=-XW1*((3D0-XW/XW1)*F1RE+HEPS*FXYRE) | |
16990 | ETAIMJ=-XW1*((3D0-XW/XW1)*F1IM+HEPS*FXYIM) | |
16991 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN | |
16992 | ETAREJ=ETAREJ*PARU(155+10*IHIGG) | |
16993 | ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) | |
16994 | ENDIF | |
16995 | ELSE | |
16996 | C...Charged H loops: loop integral and charges. | |
16997 | FACHHH=(PMAS(24,1)/PMAS(37,1))**2*(1D0-2D0*XW)* | |
16998 | & PARU(158+10*IHIGG+2*(IHIGG/3)) | |
16999 | ETAREJ=FACHHH*FXYRE | |
17000 | ETAIMJ=FACHHH*FXYIM | |
17001 | ENDIF | |
17002 | ETARE=ETARE+ETAREJ | |
17003 | ETAIM=ETAIM+ETAIMJ | |
17004 | 260 CONTINUE | |
17005 | ETA2=(ETARE**2+ETAIM**2)/(XW*XW1) | |
17006 | WDTP(I)=FAC*(AEM/PARU(1))**2*(1D0-PMAS(23,1)**2/SH)**3*ETA2 | |
17007 | WID2=WIDS(23,2) | |
17008 | ||
17009 | ELSEIF(I.LE.17) THEN | |
17010 | C...h0 -> Z0 + Z0, W+ + W- | |
17011 | PM1=PMAS(IABS(KFDP(IDC,1)),1) | |
17012 | PG1=PMAS(IABS(KFDP(IDC,1)),2) | |
17013 | IF(MINT(62).GE.1) THEN | |
17014 | IF(MSTP(42).EQ.0.OR.(4D0*(PM1+10D0*PG1)**2.LT.SH.AND. | |
17015 | & CKIN(46).LT.CKIN(45).AND.CKIN(48).LT.CKIN(47).AND. | |
17016 | & MAX(CKIN(45),CKIN(47)).LT.PM1-10D0*PG1)) THEN | |
17017 | MOFSV(IHIGG,I-15)=0 | |
17018 | WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, | |
17019 | & 1D0-4D0*RM1)) | |
17020 | WID2=1D0 | |
17021 | ELSE | |
17022 | MOFSV(IHIGG,I-15)=1 | |
17023 | RMAS=SQRT(MAX(0D0,SH)) | |
17024 | CALL PYOFSH(1,KFLA,KFDP(IDC,1),KFDP(IDC,2),RMAS,WIDW, | |
17025 | & WID2) | |
17026 | WIDWSV(IHIGG,I-15)=WIDW | |
17027 | WID2SV(IHIGG,I-15)=WID2 | |
17028 | ENDIF | |
17029 | ELSE | |
17030 | IF(MOFSV(IHIGG,I-15).EQ.0) THEN | |
17031 | WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, | |
17032 | & 1D0-4D0*RM1)) | |
17033 | WID2=1D0 | |
17034 | ELSE | |
17035 | WIDW=WIDWSV(IHIGG,I-15) | |
17036 | WID2=WID2SV(IHIGG,I-15) | |
17037 | ENDIF | |
17038 | ENDIF | |
17039 | WDTP(I)=FAC*WIDW/(2D0*(18-I)) | |
17040 | IF(MSTP(49).NE.0) WDTP(I)=WDTP(I)*PMAS(KFHIGG,1)**2/SHFS | |
17041 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* | |
17042 | & PARU(138+I+10*IHIGG)**2 | |
17043 | WID2=WID2*WIDS(7+I,1) | |
17044 | ||
17045 | ELSEIF(I.EQ.18.AND.IHIGG.GE.2) THEN | |
17046 | C...H0 -> Z0 + h0, A0-> Z0 + h0 | |
17047 | WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0, | |
17048 | & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17049 | IF(IHIGG.EQ.2) THEN | |
17050 | WDTP(I)=WDTP(I)*PARU(179)**2 | |
17051 | ELSEIF(IHIGG.EQ.3) THEN | |
17052 | WDTP(I)=WDTP(I)*PARU(186)**2 | |
17053 | ENDIF | |
17054 | WID2=WIDS(23,2)*WIDS(25,2) | |
17055 | ||
17056 | ELSEIF(I.EQ.19.AND.IHIGG.GE.2) THEN | |
17057 | C...H0 -> h0 + h0, A0-> h0 + h0 | |
17058 | WDTP(I)=FAC*0.25D0* | |
17059 | & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) | |
17060 | IF(IHIGG.EQ.2) THEN | |
17061 | WDTP(I)=WDTP(I)*PARU(176)**2 | |
17062 | ELSEIF(IHIGG.EQ.3) THEN | |
17063 | WDTP(I)=WDTP(I)*PARU(169)**2 | |
17064 | ENDIF | |
17065 | WID2=WIDS(25,1) | |
17066 | ELSEIF((I.EQ.20.OR.I.EQ.21).AND.IHIGG.GE.2) THEN | |
17067 | C...H0 -> W+/- + H-/+, A0 -> W+/- + H-/+ | |
17068 | WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0, | |
17069 | & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17070 | & *PARU(195+IHIGG)**2 | |
17071 | IF(I.EQ.20) THEN | |
17072 | WID2=WIDS(24,2)*WIDS(37,3) | |
17073 | ELSEIF(I.EQ.21) THEN | |
17074 | WID2=WIDS(24,3)*WIDS(37,2) | |
17075 | ENDIF | |
17076 | ||
17077 | ELSEIF(I.EQ.22.AND.IHIGG.EQ.2) THEN | |
17078 | C...H0 -> Z0 + A0. | |
17079 | WDTP(I)=FAC*0.5D0*PARU(187)**2*SQRT(MAX(0D0, | |
17080 | & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*0.0D0 | |
17081 | WID2=WIDS(36,2)*WIDS(23,2) | |
17082 | ||
17083 | ELSEIF(I.EQ.23.AND.IHIGG.EQ.2) THEN | |
17084 | C...H0 -> h0 + A0. | |
17085 | WDTP(I)=FAC*0.5D0*PARU(180)**2* | |
17086 | & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) | |
17087 | WID2=WIDS(25,2)*WIDS(36,2) | |
17088 | ||
17089 | ELSEIF(I.EQ.24.AND.IHIGG.EQ.2) THEN | |
17090 | C...H0 -> A0 + A0 | |
17091 | WDTP(I)=FAC*0.25D0*PARU(177)**2* | |
17092 | & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) | |
17093 | WID2=WIDS(36,1) | |
17094 | ||
17095 | CMRENNA++ | |
17096 | ELSE | |
17097 | C...Add in SUSY decays (two-body) by rescaling by phase space factor. | |
17098 | RM10=RM1*SH/PMR**2 | |
17099 | RM20=RM2*SH/PMR**2 | |
17100 | WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20) | |
17101 | WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2) | |
17102 | IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN | |
17103 | WFAC=0D0 | |
17104 | ELSE | |
17105 | WFAC=WFAC/WFAC0 | |
17106 | ENDIF | |
17107 | WDTP(I)=PMAS(KFLA,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC) | |
17108 | CMRENNA-- | |
17109 | IF(KFC2.EQ.KFC1) THEN | |
17110 | WID2=WIDS(KFC1,1) | |
17111 | ELSE | |
17112 | KSGN1=2 | |
17113 | IF(KFDP(IDC,1).LT.0) KSGN1=3 | |
17114 | KSGN2=2 | |
17115 | IF(KFDP(IDC,2).LT.0) KSGN2=3 | |
17116 | WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2) | |
17117 | ENDIF | |
17118 | ENDIF | |
17119 | WDTP(I)=FUDGE*WDTP(I) | |
17120 | WDTP(0)=WDTP(0)+WDTP(I) | |
17121 | IF(MDME(IDC,1).GT.0) THEN | |
17122 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17123 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17124 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17125 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17126 | ENDIF | |
17127 | 270 CONTINUE | |
17128 | ||
17129 | ELSEIF(KFLA.EQ.32) THEN | |
17130 | C...Z'0: | |
17131 | ICASE=1 | |
17132 | XWC=1D0/(16D0*XW*XW1) | |
17133 | FAC=(AEM*XWC/3D0)*SHR | |
17134 | VINT(117)=0D0 | |
17135 | 280 CONTINUE | |
17136 | IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN | |
17137 | VINT(111)=0D0 | |
17138 | VINT(112)=0D0 | |
17139 | VINT(113)=0D0 | |
17140 | VINT(114)=0D0 | |
17141 | VINT(115)=0D0 | |
17142 | VINT(116)=0D0 | |
17143 | ENDIF | |
17144 | IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN | |
17145 | KFAI=IABS(MINT(15)) | |
17146 | EI=KCHG(KFAI,1)/3D0 | |
17147 | AI=SIGN(1D0,EI+0.1D0) | |
17148 | VI=AI-4D0*EI*XWV | |
17149 | KFAIC=1 | |
17150 | IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2 | |
17151 | IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3 | |
17152 | IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4 | |
17153 | IF(KFAI.LE.2.OR.KFAI.EQ.11.OR.KFAI.EQ.12) THEN | |
17154 | VPI=PARU(119+2*KFAIC) | |
17155 | API=PARU(120+2*KFAIC) | |
17156 | ELSEIF(KFAI.LE.4.OR.KFAI.EQ.13.OR.KFAI.EQ.14) THEN | |
17157 | VPI=PARJ(178+2*KFAIC) | |
17158 | API=PARJ(179+2*KFAIC) | |
17159 | ELSE | |
17160 | VPI=PARJ(186+2*KFAIC) | |
17161 | API=PARJ(187+2*KFAIC) | |
17162 | ENDIF | |
17163 | SQMZ=PMAS(23,1)**2 | |
17164 | HZ=SHR*VINT(117) | |
17165 | SQMZP=PMAS(32,1)**2 | |
17166 | HZP=SHR*WDTP(0) | |
17167 | IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. | |
17168 | & MSTP(44).EQ.7) VINT(111)=1D0 | |
17169 | IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)= | |
17170 | & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) | |
17171 | IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)= | |
17172 | & 2D0*XWC*SH*(SH-SQMZP)/((SH-SQMZP)**2+HZP**2) | |
17173 | IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. | |
17174 | & MSTP(44).EQ.7) VINT(114)=XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) | |
17175 | IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)= | |
17176 | & 2D0*XWC**2*SH**2*((SH-SQMZ)*(SH-SQMZP)+HZ*HZP)/ | |
17177 | & (((SH-SQMZ)**2+HZ**2)*((SH-SQMZP)**2+HZP**2)) | |
17178 | IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. | |
17179 | & MSTP(44).EQ.7) VINT(116)=XWC**2*SH**2/((SH-SQMZP)**2+HZP**2) | |
17180 | ENDIF | |
17181 | DO 290 I=1,MDCY(KC,3) | |
17182 | IDC=I+MDCY(KC,2)-1 | |
17183 | IF(MDME(IDC,1).LT.0) GOTO 290 | |
17184 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
17185 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
17186 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0.OR.MDME(IDC,1).LT.0) GOTO 290 | |
17187 | WID2=1D0 | |
17188 | IF(I.LE.16) THEN | |
17189 | IF(I.LE.8) THEN | |
17190 | C...Z'0 -> q + qbar | |
17191 | EF=KCHG(I,1)/3D0 | |
17192 | AF=SIGN(1D0,EF+0.1D0) | |
17193 | VF=AF-4D0*EF*XWV | |
17194 | IF(I.LE.2) THEN | |
17195 | VPF=PARU(123-2*MOD(I,2)) | |
17196 | APF=PARU(124-2*MOD(I,2)) | |
17197 | ELSEIF(I.LE.4) THEN | |
17198 | VPF=PARJ(182-2*MOD(I,2)) | |
17199 | APF=PARJ(183-2*MOD(I,2)) | |
17200 | ELSE | |
17201 | VPF=PARJ(190-2*MOD(I,2)) | |
17202 | APF=PARJ(191-2*MOD(I,2)) | |
17203 | ENDIF | |
17204 | FCOF=3D0*RADC | |
17205 | IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF* | |
17206 | & PYHFTH(SH,SH*RM1,1D0) | |
17207 | IF(I.EQ.6) WID2=WIDS(6,1) | |
17208 | IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) | |
17209 | ELSEIF(I.LE.16) THEN | |
17210 | C...Z'0 -> l+ + l-, nu + nubar | |
17211 | EF=KCHG(I+2,1)/3D0 | |
17212 | AF=SIGN(1D0,EF+0.1D0) | |
17213 | VF=AF-4D0*EF*XWV | |
17214 | IF(I.LE.10) THEN | |
17215 | VPF=PARU(127-2*MOD(I,2)) | |
17216 | APF=PARU(128-2*MOD(I,2)) | |
17217 | ELSEIF(I.LE.12) THEN | |
17218 | VPF=PARJ(186-2*MOD(I,2)) | |
17219 | APF=PARJ(187-2*MOD(I,2)) | |
17220 | ELSE | |
17221 | VPF=PARJ(194-2*MOD(I,2)) | |
17222 | APF=PARJ(195-2*MOD(I,2)) | |
17223 | ENDIF | |
17224 | FCOF=1D0 | |
17225 | IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) | |
17226 | ENDIF | |
17227 | BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) | |
17228 | IF(ICASE.EQ.1) THEN | |
17229 | WDTPZ=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 | |
17230 | WDTP(I)=FAC*FCOF*(VPF**2*(1D0+2D0*RM1)+ | |
17231 | & APF**2*(1D0-4D0*RM1))*BE34 | |
17232 | ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN | |
17233 | WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* | |
17234 | & EF*VF+EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* | |
17235 | & VF**2+(VI*VPI+AI*API)*VINT(115)*VF*VPF+(VPI**2+API**2)* | |
17236 | & VINT(116)*VPF**2)*(1D0+2D0*RM1)+((VI**2+AI**2)*VINT(114)* | |
17237 | & AF**2+(VI*VPI+AI*API)*VINT(115)*AF*APF+(VPI**2+API**2)* | |
17238 | & VINT(116)*APF**2)*(1D0-4D0*RM1))*BE34 | |
17239 | ELSEIF(MINT(61).EQ.2) THEN | |
17240 | FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 | |
17241 | FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 | |
17242 | FGZPF=FCOF*EF*VPF*(1D0+2D0*RM1)*BE34 | |
17243 | FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 | |
17244 | FZZPF=FCOF*(VF*VPF*(1D0+2D0*RM1)+AF*APF*(1D0-4D0*RM1))* | |
17245 | & BE34 | |
17246 | FZPZPF=FCOF*(VPF**2*(1D0+2D0*RM1)+APF**2*(1D0-4D0*RM1))* | |
17247 | & BE34 | |
17248 | ENDIF | |
17249 | ELSEIF(I.EQ.17) THEN | |
17250 | C...Z'0 -> W+ + W- | |
17251 | WDTPZP=PARU(129)**2*XW1**2* | |
17252 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17253 | & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) | |
17254 | IF(ICASE.EQ.1) THEN | |
17255 | WDTPZ=0D0 | |
17256 | WDTP(I)=FAC*WDTPZP | |
17257 | ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN | |
17258 | WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP | |
17259 | ELSEIF(MINT(61).EQ.2) THEN | |
17260 | FGGF=0D0 | |
17261 | FGZF=0D0 | |
17262 | FGZPF=0D0 | |
17263 | FZZF=0D0 | |
17264 | FZZPF=0D0 | |
17265 | FZPZPF=WDTPZP | |
17266 | ENDIF | |
17267 | WID2=WIDS(24,1) | |
17268 | ELSEIF(I.EQ.18) THEN | |
17269 | C...Z'0 -> H+ + H- | |
17270 | CZC=2D0*(1D0-2D0*XW) | |
17271 | BE34C=(1D0-4D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) | |
17272 | IF(ICASE.EQ.1) THEN | |
17273 | WDTPZ=0.25D0*PARU(142)**2*CZC**2*BE34C | |
17274 | WDTP(I)=FAC*0.25D0*PARU(143)**2*CZC**2*BE34C | |
17275 | ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN | |
17276 | WDTP(I)=FAC*0.25D0*(EI**2*VINT(111)+PARU(142)*EI*VI* | |
17277 | & VINT(112)*CZC+PARU(143)*EI*VPI*VINT(113)*CZC+PARU(142)**2* | |
17278 | & (VI**2+AI**2)*VINT(114)*CZC**2+PARU(142)*PARU(143)* | |
17279 | & (VI*VPI+AI*API)*VINT(115)*CZC**2+PARU(143)**2* | |
17280 | & (VPI**2+API**2)*VINT(116)*CZC**2)*BE34C | |
17281 | ELSEIF(MINT(61).EQ.2) THEN | |
17282 | FGGF=0.25D0*BE34C | |
17283 | FGZF=0.25D0*PARU(142)*CZC*BE34C | |
17284 | FGZPF=0.25D0*PARU(143)*CZC*BE34C | |
17285 | FZZF=0.25D0*PARU(142)**2*CZC**2*BE34C | |
17286 | FZZPF=0.25D0*PARU(142)*PARU(143)*CZC**2*BE34C | |
17287 | FZPZPF=0.25D0*PARU(143)**2*CZC**2*BE34C | |
17288 | ENDIF | |
17289 | WID2=WIDS(37,1) | |
17290 | ELSEIF(I.EQ.19) THEN | |
17291 | C...Z'0 -> Z0 + gamma. | |
17292 | ELSEIF(I.EQ.20) THEN | |
17293 | C...Z'0 -> Z0 + h0 | |
17294 | FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
17295 | WDTPZP=PARU(145)**2*4D0*ABS(1D0-2D0*XW)* | |
17296 | & (3D0*RM1+0.25D0*FLAM**2)*FLAM | |
17297 | IF(ICASE.EQ.1) THEN | |
17298 | WDTPZ=0D0 | |
17299 | WDTP(I)=FAC*WDTPZP | |
17300 | ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN | |
17301 | WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP | |
17302 | ELSEIF(MINT(61).EQ.2) THEN | |
17303 | FGGF=0D0 | |
17304 | FGZF=0D0 | |
17305 | FGZPF=0D0 | |
17306 | FZZF=0D0 | |
17307 | FZZPF=0D0 | |
17308 | FZPZPF=WDTPZP | |
17309 | ENDIF | |
17310 | WID2=WIDS(23,2)*WIDS(25,2) | |
17311 | ELSEIF(I.EQ.21.OR.I.EQ.22) THEN | |
17312 | C...Z' -> h0 + A0 or H0 + A0. | |
17313 | BE34C=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17314 | IF(I.EQ.21) THEN | |
17315 | CZAH=PARU(186) | |
17316 | CZPAH=PARU(188) | |
17317 | ELSE | |
17318 | CZAH=PARU(187) | |
17319 | CZPAH=PARU(189) | |
17320 | ENDIF | |
17321 | IF(ICASE.EQ.1) THEN | |
17322 | WDTPZ=CZAH**2*BE34C | |
17323 | WDTP(I)=FAC*CZPAH**2*BE34C | |
17324 | ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN | |
17325 | WDTP(I)=FAC*(CZAH**2*(VI**2+AI**2)*VINT(114)+CZAH*CZPAH* | |
17326 | & (VI*VPI+AI*API)*VINT(115)+CZPAH**2*(VPI**2+API**2)* | |
17327 | & VINT(116))*BE34C | |
17328 | ELSEIF(MINT(61).EQ.2) THEN | |
17329 | FGGF=0D0 | |
17330 | FGZF=0D0 | |
17331 | FGZPF=0D0 | |
17332 | FZZF=CZAH**2*BE34C | |
17333 | FZZPF=CZAH*CZPAH*BE34C | |
17334 | FZPZPF=CZPAH**2*BE34C | |
17335 | ENDIF | |
17336 | IF(I.EQ.21) WID2=WIDS(25,2)*WIDS(36,2) | |
17337 | IF(I.EQ.22) WID2=WIDS(35,2)*WIDS(36,2) | |
17338 | ENDIF | |
17339 | IF(ICASE.EQ.1) THEN | |
17340 | VINT(117)=VINT(117)+FAC*WDTPZ | |
17341 | WDTP(I)=FUDGE*WDTP(I) | |
17342 | WDTP(0)=WDTP(0)+WDTP(I) | |
17343 | ENDIF | |
17344 | IF(MDME(IDC,1).GT.0) THEN | |
17345 | IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. | |
17346 | & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN | |
17347 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17348 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ | |
17349 | & WDTE(I,MDME(IDC,1)) | |
17350 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17351 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17352 | ENDIF | |
17353 | IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN | |
17354 | IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. | |
17355 | & MSTP(44).EQ.7) VINT(111)=VINT(111)+FGGF*WID2 | |
17356 | IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)=VINT(112)+ | |
17357 | & FGZF*WID2 | |
17358 | IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)=VINT(113)+ | |
17359 | & FGZPF*WID2 | |
17360 | IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. | |
17361 | & MSTP(44).EQ.7) VINT(114)=VINT(114)+FZZF*WID2 | |
17362 | IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)=VINT(115)+ | |
17363 | & FZZPF*WID2 | |
17364 | IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. | |
17365 | & MSTP(44).EQ.7) VINT(116)=VINT(116)+FZPZPF*WID2 | |
17366 | ENDIF | |
17367 | ENDIF | |
17368 | 290 CONTINUE | |
17369 | IF(MINT(61).GE.1) ICASE=3-ICASE | |
17370 | IF(ICASE.EQ.2) GOTO 280 | |
17371 | ||
17372 | ELSEIF(KFLA.EQ.34) THEN | |
17373 | C...W'+/-: | |
17374 | FAC=(AEM/(24D0*XW))*SHR | |
17375 | DO 300 I=1,MDCY(KC,3) | |
17376 | IDC=I+MDCY(KC,2)-1 | |
17377 | IF(MDME(IDC,1).LT.0) GOTO 300 | |
17378 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
17379 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
17380 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 300 | |
17381 | WID2=1D0 | |
17382 | IF(I.LE.20) THEN | |
17383 | IF(I.LE.16) THEN | |
17384 | C...W'+/- -> q + qbar' | |
17385 | FCOF=3D0*RADC*(PARU(131)**2+PARU(132)**2)* | |
17386 | & VCKM((I-1)/4+1,MOD(I-1,4)+1) | |
17387 | IF(KFLR.GT.0) THEN | |
17388 | IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) | |
17389 | IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) | |
17390 | IF(I.GE.13) WID2=WID2*WIDS(7,3) | |
17391 | ELSE | |
17392 | IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) | |
17393 | IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) | |
17394 | IF(I.GE.13) WID2=WID2*WIDS(7,2) | |
17395 | ENDIF | |
17396 | ELSEIF(I.LE.20) THEN | |
17397 | C...W'+/- -> l+/- + nu | |
17398 | FCOF=PARU(133)**2+PARU(134)**2 | |
17399 | IF(KFLR.GT.0) THEN | |
17400 | IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) | |
17401 | ELSE | |
17402 | IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) | |
17403 | ENDIF | |
17404 | ENDIF | |
17405 | WDTP(I)=FAC*FCOF*0.5D0*(2D0-RM1-RM2-(RM1-RM2)**2)* | |
17406 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
17407 | ELSEIF(I.EQ.21) THEN | |
17408 | C...W'+/- -> W+/- + Z0 | |
17409 | WDTP(I)=FAC*PARU(135)**2*0.5D0*XW1*(RM1/RM2)* | |
17410 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17411 | & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) | |
17412 | IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(23,2) | |
17413 | IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(23,2) | |
17414 | ELSEIF(I.EQ.23) THEN | |
17415 | C...W'+/- -> W+/- + h0 | |
17416 | FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
17417 | WDTP(I)=FAC*PARU(146)**2*2D0*(3D0*RM1+0.25D0*FLAM**2)*FLAM | |
17418 | IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) | |
17419 | IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) | |
17420 | ENDIF | |
17421 | WDTP(I)=FUDGE*WDTP(I) | |
17422 | WDTP(0)=WDTP(0)+WDTP(I) | |
17423 | IF(MDME(IDC,1).GT.0) THEN | |
17424 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17425 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17426 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17427 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17428 | ENDIF | |
17429 | 300 CONTINUE | |
17430 | ||
17431 | ELSEIF(KFLA.EQ.37) THEN | |
17432 | C...H+/-: | |
17433 | C IF(MSTP(49).EQ.0) THEN | |
17434 | SHFS=SH | |
17435 | C ELSE | |
17436 | C SHFS=PMAS(37,1)**2 | |
17437 | C ENDIF | |
17438 | FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR | |
17439 | DO 310 I=1,MDCY(KC,3) | |
17440 | IDC=I+MDCY(KC,2)-1 | |
17441 | IF(MDME(IDC,1).LT.0) GOTO 310 | |
17442 | KFC1=PYCOMP(KFDP(IDC,1)) | |
17443 | KFC2=PYCOMP(KFDP(IDC,2)) | |
17444 | RM1=PMAS(KFC1,1)**2/SH | |
17445 | RM2=PMAS(KFC2,1)**2/SH | |
17446 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 310 | |
17447 | WID2=1D0 | |
17448 | IF(I.LE.4) THEN | |
17449 | C...H+/- -> q + qbar' | |
17450 | RM1R=PYMRUN(KFDP(IDC,1),SH)**2/SH | |
17451 | RM2R=PYMRUN(KFDP(IDC,2),SH)**2/SH | |
17452 | WDTP(I)=FAC*3D0*RADC*MAX(0D0,(RM1R*PARU(141)**2+ | |
17453 | & RM2R/PARU(141)**2)*(1D0-RM1R-RM2R)-4D0*RM1R*RM2R)* | |
17454 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS) | |
17455 | IF(KFLR.GT.0) THEN | |
17456 | IF(I.EQ.3) WID2=WIDS(6,2) | |
17457 | IF(I.EQ.4) WID2=WIDS(7,3)*WIDS(8,2) | |
17458 | ELSE | |
17459 | IF(I.EQ.3) WID2=WIDS(6,3) | |
17460 | IF(I.EQ.4) WID2=WIDS(7,2)*WIDS(8,3) | |
17461 | ENDIF | |
17462 | ELSEIF(I.LE.8) THEN | |
17463 | C...H+/- -> l+/- + nu | |
17464 | WDTP(I)=FAC*((RM1*PARU(141)**2+RM2/PARU(141)**2)* | |
17465 | & (1D0-RM1-RM2)-4D0*RM1*RM2)*SQRT(MAX(0D0, | |
17466 | & (1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS) | |
17467 | IF(KFLR.GT.0) THEN | |
17468 | IF(I.EQ.8) WID2=WIDS(17,3)*WIDS(18,2) | |
17469 | ELSE | |
17470 | IF(I.EQ.8) WID2=WIDS(17,2)*WIDS(18,3) | |
17471 | ENDIF | |
17472 | ELSEIF(I.EQ.9) THEN | |
17473 | C...H+/- -> W+/- + h0. | |
17474 | WDTP(I)=FAC*PARU(195)**2*0.5D0*SQRT(MAX(0D0, | |
17475 | & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17476 | IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) | |
17477 | IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) | |
17478 | ||
17479 | CMRENNA++ | |
17480 | ELSE | |
17481 | C...Add in SUSY decays (two-body) by rescaling by phase space factor. | |
17482 | RM10=RM1*SH/PMR**2 | |
17483 | RM20=RM2*SH/PMR**2 | |
17484 | WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20) | |
17485 | WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2) | |
17486 | IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN | |
17487 | WFAC=0D0 | |
17488 | ELSE | |
17489 | WFAC=WFAC/WFAC0 | |
17490 | ENDIF | |
17491 | WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC) | |
17492 | CMRENNA-- | |
17493 | KSGN1=2 | |
17494 | IF(KFLS*KFDP(IDC,1).LT.0.AND.KCHG(KFC1,3).EQ.1) KSGN1=3 | |
17495 | KSGN2=2 | |
17496 | IF(KFLS*KFDP(IDC,2).LT.0.AND.KCHG(KFC2,3).EQ.1) KSGN2=3 | |
17497 | WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2) | |
17498 | ENDIF | |
17499 | WDTP(I)=FUDGE*WDTP(I) | |
17500 | WDTP(0)=WDTP(0)+WDTP(I) | |
17501 | IF(MDME(IDC,1).GT.0) THEN | |
17502 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17503 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17504 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17505 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17506 | ENDIF | |
17507 | 310 CONTINUE | |
17508 | ||
17509 | ELSEIF(KFLA.EQ.41) THEN | |
17510 | C...R: | |
17511 | FAC=(AEM/(12D0*XW))*SHR | |
17512 | DO 320 I=1,MDCY(KC,3) | |
17513 | IDC=I+MDCY(KC,2)-1 | |
17514 | IF(MDME(IDC,1).LT.0) GOTO 320 | |
17515 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
17516 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
17517 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 320 | |
17518 | WID2=1D0 | |
17519 | IF(I.LE.6) THEN | |
17520 | C...R -> q + qbar' | |
17521 | FCOF=3D0*RADC | |
17522 | ELSEIF(I.LE.9) THEN | |
17523 | C...R -> l+ + l'- | |
17524 | FCOF=1D0 | |
17525 | ENDIF | |
17526 | WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* | |
17527 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
17528 | IF(KFLR.GT.0) THEN | |
17529 | IF(I.EQ.4) WID2=WIDS(6,3) | |
17530 | IF(I.EQ.5) WID2=WIDS(7,3) | |
17531 | IF(I.EQ.6) WID2=WIDS(6,2)*WIDS(8,3) | |
17532 | IF(I.EQ.9) WID2=WIDS(17,3) | |
17533 | ELSE | |
17534 | IF(I.EQ.4) WID2=WIDS(6,2) | |
17535 | IF(I.EQ.5) WID2=WIDS(7,2) | |
17536 | IF(I.EQ.6) WID2=WIDS(6,3)*WIDS(8,2) | |
17537 | IF(I.EQ.9) WID2=WIDS(17,2) | |
17538 | ENDIF | |
17539 | WDTP(I)=FUDGE*WDTP(I) | |
17540 | WDTP(0)=WDTP(0)+WDTP(I) | |
17541 | IF(MDME(IDC,1).GT.0) THEN | |
17542 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17543 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17544 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17545 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17546 | ENDIF | |
17547 | 320 CONTINUE | |
17548 | ||
17549 | ELSEIF(KFLA.EQ.42) THEN | |
17550 | C...LQ (leptoquark). | |
17551 | FAC=(AEM/4D0)*PARU(151)*SHR | |
17552 | DO 330 I=1,MDCY(KC,3) | |
17553 | IDC=I+MDCY(KC,2)-1 | |
17554 | IF(MDME(IDC,1).LT.0) GOTO 330 | |
17555 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
17556 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
17557 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 330 | |
17558 | WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17559 | WID2=1D0 | |
17560 | ILQQ=KFDP(IDC,1)*ISIGN(1,KFLR) | |
17561 | IF(ILQQ.GE.6) WID2=WIDS(ILQQ,2) | |
17562 | IF(ILQQ.LE.-6) WID2=WIDS(-ILQQ,3) | |
17563 | ILQL=KFDP(IDC,2)*ISIGN(1,KFLR) | |
17564 | IF(ILQL.GE.17) WID2=WID2*WIDS(ILQL,2) | |
17565 | IF(ILQL.LE.-17) WID2=WID2*WIDS(-ILQL,3) | |
17566 | WDTP(I)=FUDGE*WDTP(I) | |
17567 | WDTP(0)=WDTP(0)+WDTP(I) | |
17568 | IF(MDME(IDC,1).GT.0) THEN | |
17569 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17570 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17571 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17572 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17573 | ENDIF | |
17574 | 330 CONTINUE | |
17575 | ||
17576 | ELSEIF(KFLA.EQ.KTECHN+111.OR.KFLA.EQ.KTECHN+221) THEN | |
17577 | C...Techni-pi0 and techni-pi0': | |
17578 | FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR | |
17579 | DO 340 I=1,MDCY(KC,3) | |
17580 | IDC=I+MDCY(KC,2)-1 | |
17581 | IF(MDME(IDC,1).LT.0) GOTO 340 | |
17582 | PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) | |
17583 | PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) | |
17584 | RM1=PM1**2/SH | |
17585 | RM2=PM2**2/SH | |
17586 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 340 | |
17587 | WID2=1D0 | |
17588 | C...pi_tc -> g + g | |
17589 | IF(I.EQ.8) THEN | |
17590 | FACP=(AS/(4D0*PARU(1))*ITCM(1)/RTCM(1))**2 | |
17591 | & /(8D0*PARU(1))*SH*SHR | |
17592 | IF(KFLA.EQ.KTECHN+111) THEN | |
17593 | FACP=FACP*RTCM(9) | |
17594 | ELSE | |
17595 | FACP=FACP*RTCM(10) | |
17596 | ENDIF | |
17597 | WDTP(I)=FACP | |
17598 | ELSE | |
17599 | C...pi_tc -> f + fbar. | |
17600 | FCOF=1D0 | |
17601 | IKA=IABS(KFDP(IDC,1)) | |
17602 | IF(IKA.LT.10) FCOF=3D0*RADC | |
17603 | HM1=PM1 | |
17604 | HM2=PM2 | |
17605 | IF(IKA.GE.4.AND.IKA.LE.6) THEN | |
17606 | FCOF=FCOF*RTCM(1+IKA)**2 | |
17607 | HM1=PYMRUN(KFDP(IDC,1),SH) | |
17608 | HM2=PYMRUN(KFDP(IDC,2),SH) | |
17609 | ELSEIF(IKA.EQ.15) THEN | |
17610 | FCOF=FCOF*RTCM(8)**2 | |
17611 | ENDIF | |
17612 | WDTP(I)=FAC*FCOF*(HM1+HM2)**2* | |
17613 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
17614 | ENDIF | |
17615 | WDTP(I)=FUDGE*WDTP(I) | |
17616 | WDTP(0)=WDTP(0)+WDTP(I) | |
17617 | IF(MDME(IDC,1).GT.0) THEN | |
17618 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17619 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17620 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17621 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17622 | ENDIF | |
17623 | 340 CONTINUE | |
17624 | ||
17625 | ELSEIF(KFLA.EQ.KTECHN+211) THEN | |
17626 | C...pi+_tc | |
17627 | FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR | |
17628 | DO 350 I=1,MDCY(KC,3) | |
17629 | IDC=I+MDCY(KC,2)-1 | |
17630 | IF(MDME(IDC,1).LT.0) GOTO 350 | |
17631 | PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) | |
17632 | PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) | |
17633 | PM3=0D0 | |
17634 | IF(I.EQ.5) PM3=PMAS(PYCOMP(KFDP(IDC,3)),1) | |
17635 | RM1=PM1**2/SH | |
17636 | RM2=PM2**2/SH | |
17637 | RM3=PM3**2/SH | |
17638 | IF(SQRT(RM1)+SQRT(RM2)+SQRT(RM3).GT.1D0) GOTO 350 | |
17639 | WID2=1D0 | |
17640 | C...pi_tc -> f + f'. | |
17641 | FCOF=1D0 | |
17642 | IF(IABS(KFDP(IDC,1)).LT.10) FCOF=3D0*RADC | |
17643 | C...pi_tc+ -> W b b~ | |
17644 | IF(I.EQ.5.AND.SHR.LT.PMAS(6,1)+PMAS(5,1)) THEN | |
17645 | FCOF=3D0*RADC | |
17646 | XMT2=PMAS(6,1)**2/SH | |
17647 | FACP=FAC/(4D0*PARU(1))*FCOF*XMT2*RTCM(7)**2 | |
17648 | KFC3=PYCOMP(KFDP(IDC,3)) | |
17649 | CHECK = SQRT(RM1)+SQRT(RM2)+SQRT(RM3) | |
17650 | CHECK = SQRT(RM1) | |
17651 | T0 = (1D0-CHECK**2)* | |
17652 | & (XMT2*(6D0*XMT2**2+3D0*XMT2*RM1-4D0*RM1**2)- | |
17653 | & (5D0*XMT2**2+2D0*XMT2*RM1-8D0*RM1**2))/(4D0*XMT2**2) | |
17654 | T1 = (1D0-XMT2)*(RM1-XMT2)*((XMT2**2+XMT2*RM1+4D0*RM1**2) | |
17655 | & -3D0*XMT2**2*(XMT2+RM1))/(2D0*XMT2**3) | |
17656 | T3 = RM1**2/XMT2**3*(3D0*XMT2-4D0*RM1+4D0*XMT2*RM1) | |
17657 | WDTP(I)=FACP*(T0 + T1*LOG((XMT2-CHECK**2)/(XMT2-1D0)) | |
17658 | & +T3*LOG(CHECK)) | |
17659 | IF(KFLR.GT.0) THEN | |
17660 | WID2=WIDS(24,2) | |
17661 | ELSE | |
17662 | WID2=WIDS(24,3) | |
17663 | ENDIF | |
17664 | ELSE | |
17665 | FCOF=1D0 | |
17666 | IKA=IABS(KFDP(IDC,1)) | |
17667 | IF(IKA.LT.10) FCOF=3D0*RADC | |
17668 | HM1=PM1 | |
17669 | HM2=PM2 | |
17670 | IF(I.GE.1.AND.I.LE.5) THEN | |
17671 | IF(I.LE.2) THEN | |
17672 | FCOF=FCOF*RTCM(5)**2 | |
17673 | ELSEIF(I.LE.4) THEN | |
17674 | FCOF=FCOF*RTCM(6)**2 | |
17675 | ELSEIF(I.EQ.5) THEN | |
17676 | FCOF=FCOF*RTCM(7)**2 | |
17677 | ENDIF | |
17678 | HM1=PYMRUN(KFDP(IDC,1),SH) | |
17679 | HM2=PYMRUN(KFDP(IDC,2),SH) | |
17680 | ELSEIF(I.EQ.8) THEN | |
17681 | FCOF=FCOF*RTCM(8)**2 | |
17682 | ENDIF | |
17683 | WDTP(I)=FAC*FCOF*(HM1+HM2)**2* | |
17684 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
17685 | ENDIF | |
17686 | WDTP(I)=FUDGE*WDTP(I) | |
17687 | WDTP(0)=WDTP(0)+WDTP(I) | |
17688 | IF(MDME(IDC,1).GT.0) THEN | |
17689 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17690 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17691 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17692 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17693 | ENDIF | |
17694 | 350 CONTINUE | |
17695 | ||
17696 | ELSEIF(KFLA.EQ.KTECHN+331) THEN | |
17697 | C...Techni-eta. | |
17698 | FAC=(SH/PARP(46)**2)*SHR | |
17699 | DO 360 I=1,MDCY(KC,3) | |
17700 | IDC=I+MDCY(KC,2)-1 | |
17701 | IF(MDME(IDC,1).LT.0) GOTO 360 | |
17702 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
17703 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
17704 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 360 | |
17705 | WID2=1D0 | |
17706 | IF(I.LE.2) THEN | |
17707 | WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))/(4D0*PARU(1)) | |
17708 | IF(I.EQ.2) WID2=WIDS(6,1) | |
17709 | ELSE | |
17710 | WDTP(I)=FAC*5D0*AS**2/(96D0*PARU(1)**3) | |
17711 | ENDIF | |
17712 | WDTP(I)=FUDGE*WDTP(I) | |
17713 | WDTP(0)=WDTP(0)+WDTP(I) | |
17714 | IF(MDME(IDC,1).GT.0) THEN | |
17715 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17716 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17717 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17718 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17719 | ENDIF | |
17720 | 360 CONTINUE | |
17721 | ||
17722 | ELSEIF(KFLA.EQ.KTECHN+113) THEN | |
17723 | C...Techni-rho0: | |
17724 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
17725 | FAC=(ALPRHT/12D0)*SHR | |
17726 | FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR | |
17727 | SQMZ=PMAS(23,1)**2 | |
17728 | SQMW=PMAS(24,1)**2 | |
17729 | SHP=SH | |
17730 | CALL PYWIDX(23,SHP,WDTPP,WDTEP) | |
17731 | GMMZ=SHR*WDTPP(0) | |
17732 | XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) | |
17733 | BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) | |
17734 | BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) | |
17735 | DO 370 I=1,MDCY(KC,3) | |
17736 | IDC=I+MDCY(KC,2)-1 | |
17737 | IF(MDME(IDC,1).LT.0) GOTO 370 | |
17738 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
17739 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
17740 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 370 | |
17741 | WID2=1D0 | |
17742 | IF(I.EQ.1) THEN | |
17743 | C...rho_tc0 -> W+ + W-. | |
17744 | WDTP(I)=FAC*RTCM(3)**4* | |
17745 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17746 | WID2=WIDS(24,1) | |
17747 | ELSEIF(I.EQ.2) THEN | |
17748 | C...rho_tc0 -> W+ + pi_tc-. | |
17749 | WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* | |
17750 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ | |
17751 | & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
17752 | & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* | |
17753 | & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 | |
17754 | WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3) | |
17755 | ELSEIF(I.EQ.3) THEN | |
17756 | C...rho_tc0 -> pi_tc+ + W-. | |
17757 | WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* | |
17758 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ | |
17759 | & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
17760 | & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* | |
17761 | & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 | |
17762 | WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(24,3) | |
17763 | ELSEIF(I.EQ.4) THEN | |
17764 | C...rho_tc0 -> pi_tc+ + pi_tc-. | |
17765 | WDTP(I)=FAC*(1D0-RTCM(3)**2)**2* | |
17766 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17767 | WID2=WIDS(PYCOMP(KTECHN+211),1) | |
17768 | ELSEIF(I.EQ.5) THEN | |
17769 | C...rho_tc0 -> gamma + pi_tc0 | |
17770 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17771 | & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* | |
17772 | & SHR**3 | |
17773 | WID2=WIDS(PYCOMP(KTECHN+111),2) | |
17774 | ELSEIF(I.EQ.6) THEN | |
17775 | C...rho_tc0 -> gamma + pi_tc0' | |
17776 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17777 | & (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*SHR**3 | |
17778 | WID2=WIDS(PYCOMP(KTECHN+221),2) | |
17779 | ELSEIF(I.EQ.7) THEN | |
17780 | C...rho_tc0 -> Z0 + pi_tc0 | |
17781 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17782 | & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* | |
17783 | & XW/XW1*SHR**3 | |
17784 | WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2) | |
17785 | ELSEIF(I.EQ.8) THEN | |
17786 | C...rho_tc0 -> Z0 + pi_tc0' | |
17787 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17788 | & (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/ | |
17789 | & XW/XW1*SHR**3 | |
17790 | WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2) | |
17791 | ELSE | |
17792 | C...rho_tc0 -> f + fbar. | |
17793 | WID2=1D0 | |
17794 | IF(I.LE.16) THEN | |
17795 | IA=I-8 | |
17796 | FCOF=3D0*RADC | |
17797 | IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1) | |
17798 | ELSE | |
17799 | IA=I-6 | |
17800 | FCOF=1D0 | |
17801 | IF(IA.GE.17) WID2=WIDS(IA,1) | |
17802 | ENDIF | |
17803 | EI=KCHG(IA,1)/3D0 | |
17804 | AI=SIGN(1D0,EI+0.1D0) | |
17805 | VI=AI-4D0*EI*XWV | |
17806 | VALI=0.5D0*(VI+AI) | |
17807 | VARI=0.5D0*(VI-AI) | |
17808 | WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)* | |
17809 | & ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ | |
17810 | & (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*( | |
17811 | & (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2)) | |
17812 | ENDIF | |
17813 | WDTP(I)=FUDGE*WDTP(I) | |
17814 | WDTP(0)=WDTP(0)+WDTP(I) | |
17815 | IF(MDME(IDC,1).GT.0) THEN | |
17816 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17817 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17818 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17819 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17820 | ENDIF | |
17821 | 370 CONTINUE | |
17822 | ||
17823 | ELSEIF(KFLA.EQ.KTECHN+213) THEN | |
17824 | C...Techni-rho+/-: | |
17825 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
17826 | FAC=(ALPRHT/12D0)*SHR | |
17827 | SQMZ=PMAS(23,1)**2 | |
17828 | SQMW=PMAS(24,1)**2 | |
17829 | SHP=SH | |
17830 | CALL PYWIDX(24,SHP,WDTPP,WDTEP) | |
17831 | GMMW=SHR*WDTPP(0) | |
17832 | FACF=(1D0/12D0)*(AEM**2/ALPRHT)*SHR* | |
17833 | & (0.125D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2) | |
17834 | DO 380 I=1,MDCY(KC,3) | |
17835 | IDC=I+MDCY(KC,2)-1 | |
17836 | IF(MDME(IDC,1).LT.0) GOTO 380 | |
17837 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
17838 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
17839 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 380 | |
17840 | WID2=1D0 | |
17841 | IF(I.EQ.1) THEN | |
17842 | C...rho_tc+ -> W+ + Z0. | |
17843 | WDTP(I)=FAC*RTCM(3)**4* | |
17844 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17845 | IF(KFLR.GT.0) THEN | |
17846 | WID2=WIDS(24,2)*WIDS(23,2) | |
17847 | ELSE | |
17848 | WID2=WIDS(24,3)*WIDS(23,2) | |
17849 | ENDIF | |
17850 | ELSEIF(I.EQ.2) THEN | |
17851 | C...rho_tc+ -> W+ + pi_tc0. | |
17852 | WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* | |
17853 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ | |
17854 | & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
17855 | & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* | |
17856 | & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 | |
17857 | IF(KFLR.GT.0) THEN | |
17858 | WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+111),2) | |
17859 | ELSE | |
17860 | WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+111),2) | |
17861 | ENDIF | |
17862 | ELSEIF(I.EQ.3) THEN | |
17863 | C...rho_tc+ -> pi_tc+ + Z0. | |
17864 | WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* | |
17865 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ | |
17866 | & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* | |
17867 | & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMZ/SH)* | |
17868 | & (1D0-RTCM(3)**2)/4D0/XW/XW1/24D0/RTCM(13)**2*SHR**3+ | |
17869 | & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17870 | & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* | |
17871 | & SHR**3*XW/XW1 | |
17872 | IF(KFLR.GT.0) THEN | |
17873 | WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(23,2) | |
17874 | ELSE | |
17875 | WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(23,2) | |
17876 | ENDIF | |
17877 | ELSEIF(I.EQ.4) THEN | |
17878 | C...rho_tc+ -> pi_tc+ + pi_tc0. | |
17879 | WDTP(I)=FAC*(1D0-RTCM(3)**2)**2* | |
17880 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17881 | IF(KFLR.GT.0) THEN | |
17882 | WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(PYCOMP(KTECHN+111),2) | |
17883 | ELSE | |
17884 | WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(PYCOMP(KTECHN+111),2) | |
17885 | ENDIF | |
17886 | ELSEIF(I.EQ.5) THEN | |
17887 | C...rho_tc+ -> pi_tc+ + gamma | |
17888 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17889 | & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* | |
17890 | & SHR**3 | |
17891 | IF(KFLR.GT.0) THEN | |
17892 | WID2=WIDS(PYCOMP(KTECHN+211),2) | |
17893 | ELSE | |
17894 | WID2=WIDS(PYCOMP(KTECHN+211),3) | |
17895 | ENDIF | |
17896 | ELSEIF(I.EQ.6) THEN | |
17897 | C...rho_tc+ -> W+ + pi_tc0' | |
17898 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17899 | & (1D0-RTCM(4)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3 | |
17900 | IF(KFLR.GT.0) THEN | |
17901 | WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+221),2) | |
17902 | ELSE | |
17903 | WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+221),2) | |
17904 | ENDIF | |
17905 | ELSE | |
17906 | C...rho_tc+ -> f + fbar'. | |
17907 | IA=I-6 | |
17908 | WID2=1D0 | |
17909 | IF(IA.LE.16) THEN | |
17910 | FCOF=3D0*RADC*VCKM((IA-1)/4+1,MOD(IA-1,4)+1) | |
17911 | IF(KFLR.GT.0) THEN | |
17912 | IF(MOD(IA,4).EQ.3) WID2=WIDS(6,2) | |
17913 | IF(MOD(IA,4).EQ.0) WID2=WIDS(8,2) | |
17914 | IF(IA.GE.13) WID2=WID2*WIDS(7,3) | |
17915 | ELSE | |
17916 | IF(MOD(IA,4).EQ.3) WID2=WIDS(6,3) | |
17917 | IF(MOD(IA,4).EQ.0) WID2=WIDS(8,3) | |
17918 | IF(IA.GE.13) WID2=WID2*WIDS(7,2) | |
17919 | ENDIF | |
17920 | ELSE | |
17921 | FCOF=1D0 | |
17922 | IF(KFLR.GT.0) THEN | |
17923 | IF(IA.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) | |
17924 | ELSE | |
17925 | IF(IA.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) | |
17926 | ENDIF | |
17927 | ENDIF | |
17928 | WDTP(I)=FACF*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* | |
17929 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
17930 | ENDIF | |
17931 | WDTP(I)=FUDGE*WDTP(I) | |
17932 | WDTP(0)=WDTP(0)+WDTP(I) | |
17933 | IF(MDME(IDC,1).GT.0) THEN | |
17934 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
17935 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
17936 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
17937 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
17938 | ENDIF | |
17939 | 380 CONTINUE | |
17940 | ||
17941 | ELSEIF(KFLA.EQ.KTECHN+223) THEN | |
17942 | C...Techni-omega: | |
17943 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
17944 | FAC=(ALPRHT/12D0)*SHR | |
17945 | FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR*(2D0*RTCM(2)-1D0)**2 | |
17946 | SQMZ=PMAS(23,1)**2 | |
17947 | SHP=SH | |
17948 | CALL PYWIDX(23,SHP,WDTPP,WDTEP) | |
17949 | GMMZ=SHR*WDTPP(0) | |
17950 | BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) | |
17951 | BWZI=-(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) | |
17952 | DO 390 I=1,MDCY(KC,3) | |
17953 | IDC=I+MDCY(KC,2)-1 | |
17954 | IF(MDME(IDC,1).LT.0) GOTO 390 | |
17955 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
17956 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
17957 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 390 | |
17958 | WID2=1D0 | |
17959 | IF(I.EQ.1) THEN | |
17960 | C...omega_tc0 -> gamma + pi_tc0. | |
17961 | WDTP(I)=AEM/24D0/RTCM(12)**2*(1D0-RTCM(3)**2)* | |
17962 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*SHR**3 | |
17963 | WID2=WIDS(PYCOMP(KTECHN+111),2) | |
17964 | ELSEIF(I.EQ.2) THEN | |
17965 | C...omega_tc0 -> Z0 + pi_tc0 | |
17966 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17967 | & (1D0-RTCM(3)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/ | |
17968 | & XW/XW1*SHR**3 | |
17969 | WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2) | |
17970 | ELSEIF(I.EQ.3) THEN | |
17971 | C...omega_tc0 -> gamma + pi_tc0' | |
17972 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17973 | & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2* | |
17974 | & SHR**3 | |
17975 | WID2=WIDS(PYCOMP(KTECHN+221),2) | |
17976 | ELSEIF(I.EQ.4) THEN | |
17977 | C...omega_tc0 -> Z0 + pi_tc0' | |
17978 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17979 | & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2* | |
17980 | & XW/XW1*SHR**3 | |
17981 | WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2) | |
17982 | ELSEIF(I.EQ.5) THEN | |
17983 | C...omega_tc0 -> W+ + pi_tc- | |
17984 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17985 | & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+ | |
17986 | & FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2* | |
17987 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17988 | WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3) | |
17989 | ELSEIF(I.EQ.6) THEN | |
17990 | C...omega_tc0 -> pi_tc+ + W- | |
17991 | WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* | |
17992 | & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+ | |
17993 | & FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2* | |
17994 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
17995 | WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+211),2) | |
17996 | ELSEIF(I.EQ.7) THEN | |
17997 | C...omega_tc0 -> W+ + W-. | |
17998 | WDTP(I)=FAC*RTCM(3)**4*RTCM(11)**2* | |
17999 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
18000 | WID2=WIDS(24,1) | |
18001 | ELSEIF(I.EQ.8) THEN | |
18002 | C...omega_tc0 -> pi_tc+ + pi_tc-. | |
18003 | WDTP(I)=FAC*(1D0-RTCM(3)**2)**2*RTCM(11)**2* | |
18004 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 | |
18005 | WID2=WIDS(PYCOMP(KTECHN+211),1) | |
18006 | ELSE | |
18007 | C...omega_tc0 -> f + fbar. | |
18008 | WID2=1D0 | |
18009 | IF(I.LE.14) THEN | |
18010 | IA=I-8 | |
18011 | FCOF=3D0*RADC | |
18012 | IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1) | |
18013 | ELSE | |
18014 | IA=I-6 | |
18015 | FCOF=1D0 | |
18016 | IF(IA.GE.17) WID2=WIDS(IA,1) | |
18017 | ENDIF | |
18018 | EI=KCHG(IA,1)/3D0 | |
18019 | AI=SIGN(1D0,EI+0.1D0) | |
18020 | VI=AI-4D0*EI*XWV | |
18021 | VALI=-0.5D0*(VI+AI) | |
18022 | VARI=-0.5D0*(VI-AI) | |
18023 | WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)* | |
18024 | & ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ | |
18025 | & (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*( | |
18026 | & (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2)) | |
18027 | ENDIF | |
18028 | WDTP(I)=FUDGE*WDTP(I) | |
18029 | WDTP(0)=WDTP(0)+WDTP(I) | |
18030 | IF(MDME(IDC,1).GT.0) THEN | |
18031 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18032 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18033 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18034 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18035 | ENDIF | |
18036 | 390 CONTINUE | |
18037 | ||
18038 | C.....V8 -> quark anti-quark | |
18039 | ELSEIF(KFLA.EQ.KTECHN+100021) THEN | |
18040 | FAC=AS/6D0*SHR | |
18041 | TANT3=RTCM(21) | |
18042 | IF(ITCM(2).EQ.0) THEN | |
18043 | IMDL=1 | |
18044 | ELSEIF(ITCM(2).EQ.1) THEN | |
18045 | IMDL=2 | |
18046 | ENDIF | |
18047 | DO 400 I=1,MDCY(KC,3) | |
18048 | IDC=I+MDCY(KC,2)-1 | |
18049 | IF(MDME(IDC,1).LT.0) GOTO 400 | |
18050 | PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) | |
18051 | RM1=PM1**2/SH | |
18052 | IF(RM1.GT.0.25D0) GOTO 400 | |
18053 | WID2=1D0 | |
18054 | IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN | |
18055 | FMIX=1D0/TANT3**2 | |
18056 | ELSE | |
18057 | FMIX=TANT3**2 | |
18058 | ENDIF | |
18059 | WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*FMIX | |
18060 | IF(I.EQ.6) WID2=WIDS(6,1) | |
18061 | WDTP(I)=FUDGE*WDTP(I) | |
18062 | WDTP(0)=WDTP(0)+WDTP(I) | |
18063 | IF(MDME(IDC,1).GT.0) THEN | |
18064 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18065 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18066 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18067 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18068 | ENDIF | |
18069 | 400 CONTINUE | |
18070 | ||
18071 | ELSEIF(KFLA.EQ.KTECHN+100111.OR.KFLA.EQ.KTECHN+200111) THEN | |
18072 | FAC=(1D0/(4D0*PARU(1)*RTCM(1)**2))*SHR | |
18073 | CLEBF=0D0 | |
18074 | DO 410 I=1,MDCY(KC,3) | |
18075 | IDC=I+MDCY(KC,2)-1 | |
18076 | IF(MDME(IDC,1).LT.0) GOTO 410 | |
18077 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18078 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18079 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 410 | |
18080 | WID2=1D0 | |
18081 | C...pi_tc -> g + g | |
18082 | IF(I.EQ.7) THEN | |
18083 | IF(KFLA.EQ.KTECHN+100111) THEN | |
18084 | CLEBG=4D0/3D0 | |
18085 | ELSE | |
18086 | CLEBG=5D0/3D0 | |
18087 | ENDIF | |
18088 | FACP=(AS/(8D0*PARU(1))*ITCM(1)/RTCM(1))**2 | |
18089 | & /(2D0*PARU(1))*SH*SHR*CLEBG | |
18090 | WDTP(I)=FACP | |
18091 | ELSE | |
18092 | C...pi_tc -> f + fbar. | |
18093 | IF(I.EQ.6) WID2=WIDS(6,1) | |
18094 | FCOF=1D0 | |
18095 | IKA=IABS(KFDP(IDC,1)) | |
18096 | IF(IKA.LT.10) FCOF=3D0*RADC | |
18097 | HM1=PYMRUN(KFDP(IDC,1),SH) | |
18098 | WDTP(I)=FAC*FCOF*HM1**2*CLEBF* | |
18099 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
18100 | ENDIF | |
18101 | WDTP(I)=FUDGE*WDTP(I) | |
18102 | WDTP(0)=WDTP(0)+WDTP(I) | |
18103 | IF(MDME(IDC,1).GT.0) THEN | |
18104 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18105 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18106 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18107 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18108 | ENDIF | |
18109 | 410 CONTINUE | |
18110 | ||
18111 | ELSEIF(KFLA.GE.KTECHN+100113.AND.KFLA.LE.KTECHN+400113) THEN | |
18112 | FAC=AS/6D0*SHR | |
18113 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
18114 | TANT3=RTCM(21) | |
18115 | SIN2T=2D0*TANT3/(TANT3**2+1D0) | |
18116 | SINT3=TANT3/SQRT(TANT3**2+1D0) | |
18117 | CSXPP=RTCM(22) | |
18118 | RM82=RTCM(27)**2 | |
18119 | X12=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*COS(RTCM(30))+ | |
18120 | & RTCM(31)*SQRT(1D0-RTCM(31)**2)*COS(RTCM(32)))/SQRT(2D0) | |
18121 | X21=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*SIN(RTCM(30))+ | |
18122 | & RTCM(31)*SQRT(1D0-RTCM(31)**2)*SIN(RTCM(32)))/SQRT(2D0) | |
18123 | X11=(.25D0*(RTCM(29)**2+RTCM(31)**2+2D0)- | |
18124 | & SINT3**2)*2D0 | |
18125 | X22=(.25D0*(2D0-RTCM(29)**2-RTCM(31)**2)- | |
18126 | & SINT3**2)*2D0 | |
18127 | CALL PYWIDX(KTECHN+100021,SH,WDTPP,WDTEP) | |
18128 | ||
18129 | IF(WDTPP(0).GT.RTCM(33)*SHR) WDTPP(0)=RTCM(33)*SHR | |
18130 | GMV8=SHR*WDTPP(0) | |
18131 | RMV8=PMAS(PYCOMP(KTECHN+100021),1) | |
18132 | FV8RE=SH*(SH-RMV8**2)/((SH-RMV8**2)**2+GMV8**2) | |
18133 | FV8IM=SH*GMV8/((SH-RMV8**2)**2+GMV8**2) | |
18134 | IF(ITCM(2).EQ.0) THEN | |
18135 | IMDL=1 | |
18136 | ELSE | |
18137 | IMDL=2 | |
18138 | ENDIF | |
18139 | DO 420 I=1,MDCY(KC,3) | |
18140 | IF(I.EQ.7.AND.(KFLA.EQ.KTECHN+200113.OR. | |
18141 | & KFLA.EQ.KTECHN+300113)) GOTO 420 | |
18142 | IDC=I+MDCY(KC,2)-1 | |
18143 | IF(MDME(IDC,1).LT.0) GOTO 420 | |
18144 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18145 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18146 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 420 | |
18147 | WID2=1D0 | |
18148 | IF(I.LE.6) THEN | |
18149 | IF(I.EQ.6) WID2=WIDS(6,1) | |
18150 | XIG=1D0 | |
18151 | IF(KFLA.EQ.KTECHN+200113) THEN | |
18152 | XIG=0D0 | |
18153 | XIJ=X12 | |
18154 | ELSEIF(KFLA.EQ.KTECHN+300113) THEN | |
18155 | XIG=0D0 | |
18156 | XIJ=X21 | |
18157 | ELSEIF(KFLA.EQ.KTECHN+100113) THEN | |
18158 | XIJ=X11 | |
18159 | ELSE | |
18160 | XIJ=X22 | |
18161 | ENDIF | |
18162 | IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN | |
18163 | FMIX=1D0/TANT3/SIN2T | |
18164 | ELSE | |
18165 | FMIX=-TANT3/SIN2T | |
18166 | ENDIF | |
18167 | XFAC=(XIG+FMIX*XIJ*FV8RE)**2+(FMIX*XIJ*FV8IM)**2 | |
18168 | WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*AS/ALPRHT*XFAC | |
18169 | ELSEIF(I.EQ.7) THEN | |
18170 | WDTP(I)=SHR*AS**2/(4D0*ALPRHT) | |
18171 | ELSEIF(KFLA.EQ.KTECHN+400113.AND.I.LE.9) THEN | |
18172 | PSH=SHR*(1D0-RM1)/2D0 | |
18173 | WDTP(I)=AS/9D0*PSH**3/RM82 | |
18174 | IF(I.EQ.8) THEN | |
18175 | WDTP(I)=2D0*WDTP(I)*CSXPP**2 | |
18176 | WID2=WIDS(PYCOMP(KFDP(IDC,1)),2) | |
18177 | ELSE | |
18178 | WDTP(I)=5D0*WDTP(I) | |
18179 | WID2=WIDS(PYCOMP(KFDP(IDC,1)),2) | |
18180 | ENDIF | |
18181 | ENDIF | |
18182 | WDTP(I)=FUDGE*WDTP(I) | |
18183 | WDTP(0)=WDTP(0)+WDTP(I) | |
18184 | IF(MDME(IDC,1).GT.0) THEN | |
18185 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18186 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18187 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18188 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18189 | ENDIF | |
18190 | 420 CONTINUE | |
18191 | ||
18192 | ELSEIF(KFLA.EQ.KEXCIT+1) THEN | |
18193 | C...d* excited quark. | |
18194 | FAC=(SH/RTCM(41)**2)*SHR | |
18195 | DO 430 I=1,MDCY(KC,3) | |
18196 | IDC=I+MDCY(KC,2)-1 | |
18197 | IF(MDME(IDC,1).LT.0) GOTO 430 | |
18198 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18199 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18200 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 430 | |
18201 | WID2=1D0 | |
18202 | IF(I.EQ.1) THEN | |
18203 | C...d* -> g + d. | |
18204 | WDTP(I)=FAC*AS*RTCM(45)**2/3D0 | |
18205 | WID2=1D0 | |
18206 | ELSEIF(I.EQ.2) THEN | |
18207 | C...d* -> gamma + d. | |
18208 | QF=-RTCM(43)/2D0+RTCM(44)/6D0 | |
18209 | WDTP(I)=FAC*AEM*QF**2/4D0 | |
18210 | WID2=1D0 | |
18211 | ELSEIF(I.EQ.3) THEN | |
18212 | C...d* -> Z0 + d. | |
18213 | QF=-RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0 | |
18214 | WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* | |
18215 | & (1D0-RM1)**2*(2D0+RM1) | |
18216 | WID2=WIDS(23,2) | |
18217 | ELSEIF(I.EQ.4) THEN | |
18218 | C...d* -> W- + u. | |
18219 | WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* | |
18220 | & (1D0-RM1)**2*(2D0+RM1) | |
18221 | IF(KFLR.GT.0) WID2=WIDS(24,3) | |
18222 | IF(KFLR.LT.0) WID2=WIDS(24,2) | |
18223 | ENDIF | |
18224 | WDTP(I)=FUDGE*WDTP(I) | |
18225 | WDTP(0)=WDTP(0)+WDTP(I) | |
18226 | IF(MDME(IDC,1).GT.0) THEN | |
18227 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18228 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18229 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18230 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18231 | ENDIF | |
18232 | 430 CONTINUE | |
18233 | ||
18234 | ELSEIF(KFLA.EQ.KEXCIT+2) THEN | |
18235 | C...u* excited quark. | |
18236 | FAC=(SH/RTCM(41)**2)*SHR | |
18237 | DO 440 I=1,MDCY(KC,3) | |
18238 | IDC=I+MDCY(KC,2)-1 | |
18239 | IF(MDME(IDC,1).LT.0) GOTO 440 | |
18240 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18241 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18242 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 440 | |
18243 | WID2=1D0 | |
18244 | IF(I.EQ.1) THEN | |
18245 | C...u* -> g + u. | |
18246 | WDTP(I)=FAC*AS*RTCM(45)**2/3D0 | |
18247 | WID2=1D0 | |
18248 | ELSEIF(I.EQ.2) THEN | |
18249 | C...u* -> gamma + u. | |
18250 | QF=RTCM(43)/2D0+RTCM(44)/6D0 | |
18251 | WDTP(I)=FAC*AEM*QF**2/4D0 | |
18252 | WID2=1D0 | |
18253 | ELSEIF(I.EQ.3) THEN | |
18254 | C...u* -> Z0 + u. | |
18255 | QF=RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0 | |
18256 | WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* | |
18257 | & (1D0-RM1)**2*(2D0+RM1) | |
18258 | WID2=WIDS(23,2) | |
18259 | ELSEIF(I.EQ.4) THEN | |
18260 | C...u* -> W+ + d. | |
18261 | WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* | |
18262 | & (1D0-RM1)**2*(2D0+RM1) | |
18263 | IF(KFLR.GT.0) WID2=WIDS(24,2) | |
18264 | IF(KFLR.LT.0) WID2=WIDS(24,3) | |
18265 | ENDIF | |
18266 | WDTP(I)=FUDGE*WDTP(I) | |
18267 | WDTP(0)=WDTP(0)+WDTP(I) | |
18268 | IF(MDME(IDC,1).GT.0) THEN | |
18269 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18270 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18271 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18272 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18273 | ENDIF | |
18274 | 440 CONTINUE | |
18275 | ||
18276 | ELSEIF(KFLA.EQ.KEXCIT+11) THEN | |
18277 | C...e* excited lepton. | |
18278 | FAC=(SH/RTCM(41)**2)*SHR | |
18279 | DO 450 I=1,MDCY(KC,3) | |
18280 | IDC=I+MDCY(KC,2)-1 | |
18281 | IF(MDME(IDC,1).LT.0) GOTO 450 | |
18282 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18283 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18284 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 450 | |
18285 | WID2=1D0 | |
18286 | IF(I.EQ.1) THEN | |
18287 | C...e* -> gamma + e. | |
18288 | QF=-RTCM(43)/2D0-RTCM(44)/2D0 | |
18289 | WDTP(I)=FAC*AEM*QF**2/4D0 | |
18290 | WID2=1D0 | |
18291 | ELSEIF(I.EQ.2) THEN | |
18292 | C...e* -> Z0 + e. | |
18293 | QF=-RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0 | |
18294 | WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* | |
18295 | & (1D0-RM1)**2*(2D0+RM1) | |
18296 | WID2=WIDS(23,2) | |
18297 | ELSEIF(I.EQ.3) THEN | |
18298 | C...e* -> W- + nu. | |
18299 | WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* | |
18300 | & (1D0-RM1)**2*(2D0+RM1) | |
18301 | IF(KFLR.GT.0) WID2=WIDS(24,3) | |
18302 | IF(KFLR.LT.0) WID2=WIDS(24,2) | |
18303 | ENDIF | |
18304 | WDTP(I)=FUDGE*WDTP(I) | |
18305 | WDTP(0)=WDTP(0)+WDTP(I) | |
18306 | IF(MDME(IDC,1).GT.0) THEN | |
18307 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18308 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18309 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18310 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18311 | ENDIF | |
18312 | 450 CONTINUE | |
18313 | ||
18314 | ELSEIF(KFLA.EQ.KEXCIT+12) THEN | |
18315 | C...nu*_e excited neutrino. | |
18316 | FAC=(SH/RTCM(41)**2)*SHR | |
18317 | DO 460 I=1,MDCY(KC,3) | |
18318 | IDC=I+MDCY(KC,2)-1 | |
18319 | IF(MDME(IDC,1).LT.0) GOTO 460 | |
18320 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18321 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18322 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 460 | |
18323 | WID2=1D0 | |
18324 | IF(I.EQ.1) THEN | |
18325 | C...nu*_e -> Z0 + nu*_e. | |
18326 | QF=RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0 | |
18327 | WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* | |
18328 | & (1D0-RM1)**2*(2D0+RM1) | |
18329 | WID2=WIDS(23,2) | |
18330 | ELSEIF(I.EQ.2) THEN | |
18331 | C...nu*_e -> W+ + e. | |
18332 | WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* | |
18333 | & (1D0-RM1)**2*(2D0+RM1) | |
18334 | IF(KFLR.GT.0) WID2=WIDS(24,2) | |
18335 | IF(KFLR.LT.0) WID2=WIDS(24,3) | |
18336 | ENDIF | |
18337 | WDTP(I)=FUDGE*WDTP(I) | |
18338 | WDTP(0)=WDTP(0)+WDTP(I) | |
18339 | IF(MDME(IDC,1).GT.0) THEN | |
18340 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18341 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18342 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18343 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18344 | ENDIF | |
18345 | 460 CONTINUE | |
18346 | ||
18347 | ELSEIF(KFLA.EQ.KDIMEN+39) THEN | |
18348 | C...G* (graviton resonance): | |
18349 | FAC=(PARP(50)**2/PARU(1))*SHR | |
18350 | DO 470 I=1,MDCY(KC,3) | |
18351 | IDC=I+MDCY(KC,2)-1 | |
18352 | IF(MDME(IDC,1).LT.0) GOTO 470 | |
18353 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18354 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18355 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 470 | |
18356 | WID2=1D0 | |
18357 | IF(I.LE.8) THEN | |
18358 | C...G* -> q + qbar | |
18359 | FCOF=3D0*RADC | |
18360 | IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF* | |
18361 | & PYHFTH(SH,SH*RM1,1D0) | |
18362 | WDTP(I)=FAC*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))**3* | |
18363 | & (1D0+8D0*RM1/3D0)/320D0 | |
18364 | IF(I.EQ.6) WID2=WIDS(6,1) | |
18365 | IF(I.EQ.7.OR.I.EQ.8) WID2=WIDS(I,1) | |
18366 | ELSEIF(I.LE.16) THEN | |
18367 | C...G* -> l+ + l-, nu + nubar | |
18368 | FCOF=1D0 | |
18369 | WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))**3* | |
18370 | & (1D0+8D0*RM1/3D0)/320D0 | |
18371 | IF(I.EQ.15.OR.I.EQ.16) WID2=WIDS(2+I,1) | |
18372 | ELSEIF(I.EQ.17) THEN | |
18373 | C...G* -> g + g. | |
18374 | WDTP(I)=FAC/20D0 | |
18375 | ELSEIF(I.EQ.18) THEN | |
18376 | C...G* -> gamma + gamma. | |
18377 | WDTP(I)=FAC/160D0 | |
18378 | ELSEIF(I.EQ.19) THEN | |
18379 | C...G* -> Z0 + Z0. | |
18380 | WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+ | |
18381 | & 14D0*RM1/3D0+4D0*RM1**2)/160D0 | |
18382 | WID2=WIDS(23,1) | |
18383 | ELSEIF(I.EQ.20) THEN | |
18384 | C...G* -> W+ + W-. | |
18385 | WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+ | |
18386 | & 14D0*RM1/3D0+4D0*RM1**2)/80D0 | |
18387 | WID2=WIDS(24,1) | |
18388 | ENDIF | |
18389 | WDTP(I)=FUDGE*WDTP(I) | |
18390 | WDTP(0)=WDTP(0)+WDTP(I) | |
18391 | IF(MDME(IDC,1).GT.0) THEN | |
18392 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18393 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18394 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18395 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18396 | ENDIF | |
18397 | 470 CONTINUE | |
18398 | ||
18399 | ELSEIF(KFLA.EQ.9900012.OR.KFLA.EQ.9900014.OR.KFLA.EQ.9900016) THEN | |
18400 | C...nu_eR, nu_muR, nu_tauR: righthanded Majorana neutrinos. | |
18401 | PMWR=MAX(1.001D0*SHR,PMAS(PYCOMP(9900024),1)) | |
18402 | FAC=(AEM**2/(768D0*PARU(1)*XW**2))*SHR**5/PMWR**4 | |
18403 | DO 480 I=1,MDCY(KC,3) | |
18404 | IDC=I+MDCY(KC,2)-1 | |
18405 | IF(MDME(IDC,1).LT.0) GOTO 480 | |
18406 | PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) | |
18407 | PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) | |
18408 | PM3=PMAS(PYCOMP(KFDP(IDC,3)),1) | |
18409 | IF(PM1+PM2+PM3.GE.SHR) GOTO 480 | |
18410 | WID2=1D0 | |
18411 | IF(I.LE.9) THEN | |
18412 | C...nu_lR -> l- qbar q' | |
18413 | FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1) | |
18414 | IF(MOD(I,3).EQ.0) WID2=WIDS(6,2) | |
18415 | ELSEIF(I.LE.18) THEN | |
18416 | C...nu_lR -> l+ q qbar' | |
18417 | FCOF=3D0*RADC*VCKM((I-10)/3+1,MOD(I-10,3)+1) | |
18418 | IF(MOD(I-9,3).EQ.0) WID2=WIDS(6,3) | |
18419 | ELSE | |
18420 | C...nu_lR -> l- l'+ nu_lR' + charge conjugate. | |
18421 | FCOF=1D0 | |
18422 | WID2=WIDS(PYCOMP(KFDP(IDC,3)),2) | |
18423 | ENDIF | |
18424 | X=(PM1+PM2+PM3)/SHR | |
18425 | FX=1D0-8D0*X**2+8D0*X**6-X**8-24D0*X**4*LOG(X) | |
18426 | Y=(SHR/PMWR)**2 | |
18427 | FY=(12D0*(1D0-Y)*LOG(1D0-Y)+12D0*Y-6D0*Y**2-2D0*Y**3)/Y**4 | |
18428 | WDTP(I)=FAC*FCOF*FX*FY | |
18429 | WDTP(I)=FUDGE*WDTP(I) | |
18430 | WDTP(0)=WDTP(0)+WDTP(I) | |
18431 | IF(MDME(IDC,1).GT.0) THEN | |
18432 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18433 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18434 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18435 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18436 | ENDIF | |
18437 | 480 CONTINUE | |
18438 | ||
18439 | ELSEIF(KFLA.EQ.9900023) THEN | |
18440 | C...Z_R0: | |
18441 | FAC=(AEM/(48D0*XW*XW1*(1D0-2D0*XW)))*SHR | |
18442 | DO 490 I=1,MDCY(KC,3) | |
18443 | IDC=I+MDCY(KC,2)-1 | |
18444 | IF(MDME(IDC,1).LT.0) GOTO 490 | |
18445 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18446 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18447 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 490 | |
18448 | WID2=1D0 | |
18449 | SYMMET=1D0 | |
18450 | IF(I.LE.6) THEN | |
18451 | C...Z_R0 -> q + qbar | |
18452 | EF=KCHG(I,1)/3D0 | |
18453 | AF=SIGN(1D0,EF+0.1D0)*(1D0-2D0*XW) | |
18454 | VF=SIGN(1D0,EF+0.1D0)-4D0*EF*XW | |
18455 | FCOF=3D0*RADC | |
18456 | IF(I.EQ.6) WID2=WIDS(6,1) | |
18457 | ELSEIF(I.EQ.7.OR.I.EQ.10.OR.I.EQ.13) THEN | |
18458 | C...Z_R0 -> l+ + l- | |
18459 | AF=-(1D0-2D0*XW) | |
18460 | VF=-1D0+4D0*XW | |
18461 | FCOF=1D0 | |
18462 | ELSEIF(I.EQ.8.OR.I.EQ.11.OR.I.EQ.14) THEN | |
18463 | C...Z0 -> nu_L + nu_Lbar, assumed Majorana. | |
18464 | AF=-2D0*XW | |
18465 | VF=0D0 | |
18466 | FCOF=1D0 | |
18467 | SYMMET=0.5D0 | |
18468 | ELSEIF(I.LE.15) THEN | |
18469 | C...Z0 -> nu_R + nu_R, assumed Majorana. | |
18470 | AF=2D0*XW1 | |
18471 | VF=0D0 | |
18472 | FCOF=1D0 | |
18473 | WID2=WIDS(PYCOMP(KFDP(IDC,1)),1) | |
18474 | SYMMET=0.5D0 | |
18475 | ENDIF | |
18476 | WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* | |
18477 | & SQRT(MAX(0D0,1D0-4D0*RM1))*SYMMET | |
18478 | WDTP(I)=FUDGE*WDTP(I) | |
18479 | WDTP(0)=WDTP(0)+WDTP(I) | |
18480 | IF(MDME(IDC,1).GT.0) THEN | |
18481 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18482 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18483 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18484 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18485 | ENDIF | |
18486 | 490 CONTINUE | |
18487 | ||
18488 | ELSEIF(KFLA.EQ.9900024) THEN | |
18489 | C...W_R+/-: | |
18490 | FAC=(AEM/(24D0*XW))*SHR | |
18491 | DO 500 I=1,MDCY(KC,3) | |
18492 | IDC=I+MDCY(KC,2)-1 | |
18493 | IF(MDME(IDC,1).LT.0) GOTO 500 | |
18494 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18495 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18496 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 500 | |
18497 | WID2=1D0 | |
18498 | IF(I.LE.9) THEN | |
18499 | C...W_R+/- -> q + qbar' | |
18500 | FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1) | |
18501 | IF(KFLR.GT.0) THEN | |
18502 | IF(MOD(I,3).EQ.0) WID2=WIDS(6,2) | |
18503 | ELSE | |
18504 | IF(MOD(I,3).EQ.0) WID2=WIDS(6,3) | |
18505 | ENDIF | |
18506 | ELSEIF(I.LE.12) THEN | |
18507 | C...W_R+/- -> l+/- + nu_R | |
18508 | FCOF=1D0 | |
18509 | ENDIF | |
18510 | WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* | |
18511 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
18512 | WDTP(I)=FUDGE*WDTP(I) | |
18513 | WDTP(0)=WDTP(0)+WDTP(I) | |
18514 | IF(MDME(IDC,1).GT.0) THEN | |
18515 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18516 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18517 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18518 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18519 | ENDIF | |
18520 | 500 CONTINUE | |
18521 | ||
18522 | ELSEIF(KFLA.EQ.9900041) THEN | |
18523 | C...H_L++/--: | |
18524 | FAC=(1D0/(8D0*PARU(1)))*SHR | |
18525 | DO 510 I=1,MDCY(KC,3) | |
18526 | IDC=I+MDCY(KC,2)-1 | |
18527 | IF(MDME(IDC,1).LT.0) GOTO 510 | |
18528 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18529 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18530 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 510 | |
18531 | WID2=1D0 | |
18532 | IF(I.LE.6) THEN | |
18533 | C...H_L++/-- -> l+/- + l'+/- | |
18534 | FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+ | |
18535 | & (IABS(KFDP(IDC,2))-9)/2)**2 | |
18536 | IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF | |
18537 | ELSEIF(I.EQ.7) THEN | |
18538 | C...H_L++/-- -> W_L+/- + W_L+/- | |
18539 | FCOF=0.5D0*PARP(190)**4*PARP(192)**2/PMAS(24,1)**2* | |
18540 | & (3D0*RM1+0.25D0/RM1-1D0) | |
18541 | WID2=WIDS(24,4+(1-KFLS)/2) | |
18542 | ENDIF | |
18543 | WDTP(I)=FAC*FCOF* | |
18544 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
18545 | WDTP(I)=FUDGE*WDTP(I) | |
18546 | WDTP(0)=WDTP(0)+WDTP(I) | |
18547 | IF(MDME(IDC,1).GT.0) THEN | |
18548 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18549 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18550 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18551 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18552 | ENDIF | |
18553 | 510 CONTINUE | |
18554 | ||
18555 | ELSEIF(KFLA.EQ.9900042) THEN | |
18556 | C...H_R++/--: | |
18557 | FAC=(1D0/(8D0*PARU(1)))*SHR | |
18558 | DO 520 I=1,MDCY(KC,3) | |
18559 | IDC=I+MDCY(KC,2)-1 | |
18560 | IF(MDME(IDC,1).LT.0) GOTO 520 | |
18561 | RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH | |
18562 | RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH | |
18563 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 520 | |
18564 | WID2=1D0 | |
18565 | IF(I.LE.6) THEN | |
18566 | C...H_R++/-- -> l+/- + l'+/- | |
18567 | FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+ | |
18568 | & (IABS(KFDP(IDC,2))-9)/2)**2 | |
18569 | IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF | |
18570 | ELSEIF(I.EQ.7) THEN | |
18571 | C...H_R++/-- -> W_R+/- + W_R+/- | |
18572 | FCOF=PARP(191)**2*(3D0*RM1+0.25D0/RM1-1D0) | |
18573 | WID2=WIDS(PYCOMP(9900024),4+(1-KFLS)/2) | |
18574 | ENDIF | |
18575 | WDTP(I)=FAC*FCOF* | |
18576 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
18577 | WDTP(I)=FUDGE*WDTP(I) | |
18578 | WDTP(0)=WDTP(0)+WDTP(I) | |
18579 | IF(MDME(IDC,1).GT.0) THEN | |
18580 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
18581 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
18582 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
18583 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
18584 | ENDIF | |
18585 | 520 CONTINUE | |
18586 | ||
18587 | ENDIF | |
18588 | MINT(61)=0 | |
18589 | MINT(62)=0 | |
18590 | MINT(63)=0 | |
18591 | RETURN | |
18592 | END | |
18593 | ||
18594 | C*********************************************************************** | |
18595 | ||
18596 | C...PYOFSH | |
18597 | C...Calculates partial width and differential cross-section maxima | |
18598 | C...of channels/processes not allowed on mass-shell, and selects | |
18599 | C...masses in such channels/processes. | |
18600 | ||
18601 | SUBROUTINE PYOFSH(MOFSH,KFMO,KFD1,KFD2,PMMO,RET1,RET2) | |
18602 | ||
18603 | C...Double precision and integer declarations. | |
18604 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
18605 | IMPLICIT INTEGER(I-N) | |
18606 | INTEGER PYK,PYCHGE,PYCOMP | |
18607 | C...Commonblocks. | |
18608 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
18609 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
18610 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
18611 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
18612 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
18613 | COMMON/PYINT1/MINT(400),VINT(400) | |
18614 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
18615 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
18616 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
18617 | &/PYINT2/,/PYINT5/ | |
18618 | C...Local arrays. | |
18619 | DIMENSION KFD(2),MBW(2),PMD(2),PGD(2),PMG(2),PML(2),PMU(2), | |
18620 | &PMH(2),ATL(2),ATU(2),ATH(2),RMG(2),INX1(100),XPT1(100), | |
18621 | &FPT1(100),INX2(100),XPT2(100),FPT2(100),WDTP(0:400), | |
18622 | &WDTE(0:400,0:5) | |
18623 | ||
18624 | C...Find if particles equal, maximum mass, matrix elements, etc. | |
18625 | MINT(51)=0 | |
18626 | ISUB=MINT(1) | |
18627 | KFD(1)=IABS(KFD1) | |
18628 | KFD(2)=IABS(KFD2) | |
18629 | MEQL=0 | |
18630 | IF(KFD(1).EQ.KFD(2)) MEQL=1 | |
18631 | MLM=0 | |
18632 | IF(MOFSH.GE.2.AND.MEQL.EQ.1) MLM=INT(1.5D0+PYR(0)) | |
18633 | IF(MOFSH.LE.2.OR.MOFSH.EQ.5) THEN | |
18634 | NOFF=44 | |
18635 | PMMX=PMMO | |
18636 | ELSE | |
18637 | NOFF=40 | |
18638 | PMMX=VINT(1) | |
18639 | IF(CKIN(2).GT.CKIN(1)) PMMX=MIN(CKIN(2),VINT(1)) | |
18640 | ENDIF | |
18641 | MMED=0 | |
18642 | IF((KFMO.EQ.25.OR.KFMO.EQ.35.OR.KFMO.EQ.36).AND.MEQL.EQ.1.AND. | |
18643 | &(KFD(1).EQ.23.OR.KFD(1).EQ.24)) MMED=1 | |
18644 | IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(1).EQ.23.OR. | |
18645 | &KFD(1).EQ.24).AND.(KFD(2).EQ.23.OR.KFD(2).EQ.24)) MMED=2 | |
18646 | IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(2).EQ.25.OR. | |
18647 | &KFD(2).EQ.35.OR.KFD(2).EQ.36)) MMED=3 | |
18648 | LOOP=1 | |
18649 | ||
18650 | C...Find where Breit-Wigners are required, else select discrete masses. | |
18651 | 100 DO 110 I=1,2 | |
18652 | KFCA=PYCOMP(KFD(I)) | |
18653 | IF(KFCA.GT.0) THEN | |
18654 | PMD(I)=PMAS(KFCA,1) | |
18655 | PGD(I)=PMAS(KFCA,2) | |
18656 | ELSE | |
18657 | PMD(I)=0D0 | |
18658 | PGD(I)=0D0 | |
18659 | ENDIF | |
18660 | IF(MSTP(42).LE.0.OR.PGD(I).LT.PARP(41)) THEN | |
18661 | MBW(I)=0 | |
18662 | PMG(I)=PMD(I) | |
18663 | RMG(I)=(PMG(I)/PMMX)**2 | |
18664 | ELSE | |
18665 | MBW(I)=1 | |
18666 | ENDIF | |
18667 | 110 CONTINUE | |
18668 | ||
18669 | C...Find allowed mass range and Breit-Wigner parameters. | |
18670 | DO 120 I=1,2 | |
18671 | IF(MOFSH.EQ.1.AND.LOOP.EQ.1.AND.MBW(I).EQ.1) THEN | |
18672 | PML(I)=PARP(42) | |
18673 | PMU(I)=PMMX-PARP(42) | |
18674 | IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) | |
18675 | IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 | |
18676 | ELSEIF(MBW(I).EQ.1.AND.MOFSH.NE.5) THEN | |
18677 | ILM=I | |
18678 | IF(MLM.EQ.2) ILM=3-I | |
18679 | PML(I)=MAX(CKIN(NOFF+2*ILM-1),PARP(42)) | |
18680 | IF(MBW(3-I).EQ.0) THEN | |
18681 | PMU(I)=PMMX-PMD(3-I) | |
18682 | ELSE | |
18683 | PMU(I)=PMMX-MAX(CKIN(NOFF+5-2*ILM),PARP(42)) | |
18684 | ENDIF | |
18685 | IF(CKIN(NOFF+2*ILM).GT.CKIN(NOFF+2*ILM-1)) PMU(I)= | |
18686 | & MIN(PMU(I),CKIN(NOFF+2*ILM)) | |
18687 | IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) | |
18688 | IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) | |
18689 | IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 | |
18690 | IF(MBW(I).EQ.1) THEN | |
18691 | ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) | |
18692 | ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) | |
18693 | IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* | |
18694 | & PGD(I))) | |
18695 | ENDIF | |
18696 | ELSEIF(MBW(I).EQ.1.AND.MOFSH.EQ.5) THEN | |
18697 | ILM=I | |
18698 | IF(MLM.EQ.2) ILM=3-I | |
18699 | PML(I)=MAX(CKIN(48+I),PARP(42)) | |
18700 | PMU(I)=PMMX-MAX(CKIN(51-I),PARP(42)) | |
18701 | IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) | |
18702 | IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) | |
18703 | IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) | |
18704 | IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 | |
18705 | IF(MBW(I).EQ.1) THEN | |
18706 | ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) | |
18707 | ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) | |
18708 | IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* | |
18709 | & PGD(I))) | |
18710 | ENDIF | |
18711 | ENDIF | |
18712 | 120 CONTINUE | |
18713 | IF(MBW(1).LT.0.OR.MBW(2).LT.0.OR.(MBW(1).EQ.0.AND.MBW(2).EQ.0)) | |
18714 | &THEN | |
18715 | CALL PYERRM(3,'(PYOFSH:) no allowed decay product masses') | |
18716 | MINT(51)=1 | |
18717 | RETURN | |
18718 | ENDIF | |
18719 | ||
18720 | C...Calculation of partial width of resonance. | |
18721 | IF(MOFSH.EQ.1) THEN | |
18722 | ||
18723 | C..If only one integration, pick that to be the inner. | |
18724 | IF(MBW(1).EQ.0) THEN | |
18725 | PM2=PMD(1) | |
18726 | PMD(1)=PMD(2) | |
18727 | PGD(1)=PGD(2) | |
18728 | PML(1)=PML(2) | |
18729 | PMU(1)=PMU(2) | |
18730 | ELSEIF(MBW(2).EQ.0) THEN | |
18731 | PM2=PMD(2) | |
18732 | ENDIF | |
18733 | ||
18734 | C...Start outer loop of integration. | |
18735 | IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN | |
18736 | ATL2=ATAN((PML(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) | |
18737 | ATU2=ATAN((PMU(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) | |
18738 | NPT2=1 | |
18739 | XPT2(1)=1D0 | |
18740 | INX2(1)=0 | |
18741 | FMAX2=0D0 | |
18742 | ENDIF | |
18743 | 130 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN | |
18744 | PM2S=PMD(2)**2+PMD(2)*PGD(2)*TAN(ATL2+XPT2(NPT2)*(ATU2-ATL2)) | |
18745 | PM2=MIN(PMU(2),MAX(PML(2),SQRT(MAX(0D0,PM2S)))) | |
18746 | ENDIF | |
18747 | RM2=(PM2/PMMX)**2 | |
18748 | ||
18749 | C...Start inner loop of integration. | |
18750 | PML1=PML(1) | |
18751 | PMU1=MIN(PMU(1),PMMX-PM2) | |
18752 | IF(MEQL.EQ.1) PMU1=MIN(PMU1,PM2) | |
18753 | ATL1=ATAN((PML1**2-PMD(1)**2)/(PMD(1)*PGD(1))) | |
18754 | ATU1=ATAN((PMU1**2-PMD(1)**2)/(PMD(1)*PGD(1))) | |
18755 | IF(PML1+PARJ(64).GE.PMU1.OR.ATL1+1D-7.GE.ATU1) THEN | |
18756 | FUNC2=0D0 | |
18757 | GOTO 180 | |
18758 | ENDIF | |
18759 | NPT1=1 | |
18760 | XPT1(1)=1D0 | |
18761 | INX1(1)=0 | |
18762 | FMAX1=0D0 | |
18763 | 140 PM1S=PMD(1)**2+PMD(1)*PGD(1)*TAN(ATL1+XPT1(NPT1)*(ATU1-ATL1)) | |
18764 | PM1=MIN(PMU1,MAX(PML1,SQRT(MAX(0D0,PM1S)))) | |
18765 | RM1=(PM1/PMMX)**2 | |
18766 | ||
18767 | C...Evaluate function value - inner loop. | |
18768 | FUNC1=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
18769 | IF(MMED.EQ.1) FUNC1=FUNC1*((1D0-RM1-RM2)**2+8D0*RM1*RM2) | |
18770 | IF(MMED.EQ.2) FUNC1=FUNC1**3*(1D0+10D0*RM1+10D0*RM2+RM1**2+ | |
18771 | & RM2**2+10D0*RM1*RM2) | |
18772 | IF(FUNC1.GT.FMAX1) FMAX1=FUNC1 | |
18773 | FPT1(NPT1)=FUNC1 | |
18774 | ||
18775 | C...Go to next position in inner loop. | |
18776 | IF(NPT1.EQ.1) THEN | |
18777 | NPT1=NPT1+1 | |
18778 | XPT1(NPT1)=0D0 | |
18779 | INX1(NPT1)=1 | |
18780 | GOTO 140 | |
18781 | ELSEIF(NPT1.LE.8) THEN | |
18782 | NPT1=NPT1+1 | |
18783 | IF(NPT1.LE.4.OR.NPT1.EQ.6) ISH1=1 | |
18784 | ISH1=ISH1+1 | |
18785 | XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) | |
18786 | INX1(NPT1)=INX1(ISH1) | |
18787 | INX1(ISH1)=NPT1 | |
18788 | GOTO 140 | |
18789 | ELSEIF(NPT1.LT.100) THEN | |
18790 | ISN1=ISH1 | |
18791 | 150 ISH1=ISH1+1 | |
18792 | IF(ISH1.GT.NPT1) ISH1=2 | |
18793 | IF(ISH1.EQ.ISN1) GOTO 160 | |
18794 | DFPT1=ABS(FPT1(ISH1)-FPT1(INX1(ISH1))) | |
18795 | IF(DFPT1.LT.PARP(43)*FMAX1) GOTO 150 | |
18796 | NPT1=NPT1+1 | |
18797 | XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) | |
18798 | INX1(NPT1)=INX1(ISH1) | |
18799 | INX1(ISH1)=NPT1 | |
18800 | GOTO 140 | |
18801 | ENDIF | |
18802 | ||
18803 | C...Calculate integral over inner loop. | |
18804 | 160 FSUM1=0D0 | |
18805 | DO 170 IPT1=2,NPT1 | |
18806 | FSUM1=FSUM1+0.5D0*(FPT1(IPT1)+FPT1(INX1(IPT1)))* | |
18807 | & (XPT1(INX1(IPT1))-XPT1(IPT1)) | |
18808 | 170 CONTINUE | |
18809 | FUNC2=FSUM1*(ATU1-ATL1)/PARU(1) | |
18810 | 180 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN | |
18811 | IF(FUNC2.GT.FMAX2) FMAX2=FUNC2 | |
18812 | FPT2(NPT2)=FUNC2 | |
18813 | ||
18814 | C...Go to next position in outer loop. | |
18815 | IF(NPT2.EQ.1) THEN | |
18816 | NPT2=NPT2+1 | |
18817 | XPT2(NPT2)=0D0 | |
18818 | INX2(NPT2)=1 | |
18819 | GOTO 130 | |
18820 | ELSEIF(NPT2.LE.8) THEN | |
18821 | NPT2=NPT2+1 | |
18822 | IF(NPT2.LE.4.OR.NPT2.EQ.6) ISH2=1 | |
18823 | ISH2=ISH2+1 | |
18824 | XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) | |
18825 | INX2(NPT2)=INX2(ISH2) | |
18826 | INX2(ISH2)=NPT2 | |
18827 | GOTO 130 | |
18828 | ELSEIF(NPT2.LT.100) THEN | |
18829 | ISN2=ISH2 | |
18830 | 190 ISH2=ISH2+1 | |
18831 | IF(ISH2.GT.NPT2) ISH2=2 | |
18832 | IF(ISH2.EQ.ISN2) GOTO 200 | |
18833 | DFPT2=ABS(FPT2(ISH2)-FPT2(INX2(ISH2))) | |
18834 | IF(DFPT2.LT.PARP(43)*FMAX2) GOTO 190 | |
18835 | NPT2=NPT2+1 | |
18836 | XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) | |
18837 | INX2(NPT2)=INX2(ISH2) | |
18838 | INX2(ISH2)=NPT2 | |
18839 | GOTO 130 | |
18840 | ENDIF | |
18841 | ||
18842 | C...Calculate integral over outer loop. | |
18843 | 200 FSUM2=0D0 | |
18844 | DO 210 IPT2=2,NPT2 | |
18845 | FSUM2=FSUM2+0.5D0*(FPT2(IPT2)+FPT2(INX2(IPT2)))* | |
18846 | & (XPT2(INX2(IPT2))-XPT2(IPT2)) | |
18847 | 210 CONTINUE | |
18848 | FSUM2=FSUM2*(ATU2-ATL2)/PARU(1) | |
18849 | IF(MEQL.EQ.1) FSUM2=2D0*FSUM2 | |
18850 | ELSE | |
18851 | FSUM2=FUNC2 | |
18852 | ENDIF | |
18853 | ||
18854 | C...Save result; second integration for user-selected mass range. | |
18855 | IF(LOOP.EQ.1) WIDW=FSUM2 | |
18856 | WID2=FSUM2 | |
18857 | IF(LOOP.EQ.1.AND.(CKIN(46).GE.CKIN(45).OR.CKIN(48).GE.CKIN(47) | |
18858 | & .OR.MAX(CKIN(45),CKIN(47)).GE.1.01D0*PARP(42))) THEN | |
18859 | LOOP=2 | |
18860 | GOTO 100 | |
18861 | ENDIF | |
18862 | RET1=WIDW | |
18863 | RET2=WID2/WIDW | |
18864 | ||
18865 | C...Select two decay product masses of a resonance. | |
18866 | ELSEIF(MOFSH.EQ.2.OR.MOFSH.EQ.5) THEN | |
18867 | 220 DO 230 I=1,2 | |
18868 | IF(MBW(I).EQ.0) GOTO 230 | |
18869 | PMBW=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)* | |
18870 | & (ATU(I)-ATL(I))) | |
18871 | PMG(I)=MIN(PMU(I),MAX(PML(I),SQRT(MAX(0D0,PMBW)))) | |
18872 | RMG(I)=(PMG(I)/PMMX)**2 | |
18873 | 230 CONTINUE | |
18874 | IF((MEQL.EQ.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. | |
18875 | & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) GOTO 220 | |
18876 | ||
18877 | C...Weight with matrix element (if none known, use beta factor). | |
18878 | FLAM=SQRT(MAX(0D0,(1D0-RMG(1)-RMG(2))**2-4D0*RMG(1)*RMG(2))) | |
18879 | IF(MMED.EQ.1) THEN | |
18880 | WTBE=FLAM*((1D0-RMG(1)-RMG(2))**2+8D0*RMG(1)*RMG(2)) | |
18881 | ELSEIF(MMED.EQ.2) THEN | |
18882 | WTBE=FLAM**3*(1D0+10D0*RMG(1)+10D0*RMG(2)+RMG(1)**2+ | |
18883 | & RMG(2)**2+10D0*RMG(1)*RMG(2)) | |
18884 | ELSEIF(MMED.EQ.3) THEN | |
18885 | WTBE=FLAM*(RMG(1)+FLAM**2/12D0) | |
18886 | ELSE | |
18887 | WTBE=FLAM | |
18888 | ENDIF | |
18889 | IF(WTBE.LT.PYR(0)) GOTO 220 | |
18890 | RET1=PMG(1) | |
18891 | RET2=PMG(2) | |
18892 | ||
18893 | C...Find suitable set of masses for initialization of 2 -> 2 processes. | |
18894 | ELSEIF(MOFSH.EQ.3) THEN | |
18895 | IF(MBW(1).NE.0.AND.MBW(2).EQ.0) THEN | |
18896 | PMG(1)=MIN(PMD(1),0.5D0*(PML(1)+PMU(1))) | |
18897 | PMG(2)=PMD(2) | |
18898 | ELSEIF(MBW(2).NE.0.AND.MBW(1).EQ.0) THEN | |
18899 | PMG(1)=PMD(1) | |
18900 | PMG(2)=MIN(PMD(2),0.5D0*(PML(2)+PMU(2))) | |
18901 | ELSE | |
18902 | IDIV=-1 | |
18903 | 240 IDIV=IDIV+1 | |
18904 | PMG(1)=MIN(PMD(1),0.1D0*(IDIV*PML(1)+(10-IDIV)*PMU(1))) | |
18905 | PMG(2)=MIN(PMD(2),0.1D0*(IDIV*PML(2)+(10-IDIV)*PMU(2))) | |
18906 | IF(IDIV.LE.9.AND.PMG(1)+PMG(2).GT.0.9D0*PMMX) GOTO 240 | |
18907 | ENDIF | |
18908 | RET1=PMG(1) | |
18909 | RET2=PMG(2) | |
18910 | ||
18911 | C...Evaluate importance of excluded tails of Breit-Wigners. | |
18912 | IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) | |
18913 | & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 | |
18914 | IF(MEQL.LE.1) THEN | |
18915 | VINT(80)=1D0 | |
18916 | DO 250 I=1,2 | |
18917 | IF(MBW(I).NE.0) VINT(80)=VINT(80)*1.25D0*(ATU(I)-ATL(I))/ | |
18918 | & PARU(1) | |
18919 | 250 CONTINUE | |
18920 | ELSE | |
18921 | VINT(80)=(1.25D0/PARU(1))**2*MAX((ATU(1)-ATL(1))* | |
18922 | & (ATH(2)-ATL(2)),(ATH(1)-ATL(1))*(ATU(2)-ATL(2))) | |
18923 | ENDIF | |
18924 | IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.30.OR.ISUB.EQ.35).AND. | |
18925 | & MSTP(43).NE.2) VINT(80)=2D0*VINT(80) | |
18926 | IF(ISUB.EQ.22.AND.MSTP(43).NE.2) VINT(80)=4D0*VINT(80) | |
18927 | IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) | |
18928 | ||
18929 | C...Pick one particle to be the lighter (if improves efficiency). | |
18930 | ELSEIF(MOFSH.EQ.4) THEN | |
18931 | IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) | |
18932 | & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 | |
18933 | 260 IF(MEQL.EQ.2) MLM=INT(1.5D0+PYR(0)) | |
18934 | ||
18935 | C...Select two masses according to Breit-Wigner + flat in s + 1/s. | |
18936 | DO 270 I=1,2 | |
18937 | IF(MBW(I).EQ.0) GOTO 270 | |
18938 | PMV=PMU(I) | |
18939 | IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) | |
18940 | ATV=ATU(I) | |
18941 | IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) | |
18942 | RBR=PYR(0) | |
18943 | IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. | |
18944 | & ISUB.EQ.35).AND.MSTP(43).NE.2) RBR=2D0*RBR | |
18945 | IF(RBR.LT.0.8D0) THEN | |
18946 | PMSR=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)*(ATV-ATL(I))) | |
18947 | PMG(I)=MIN(PMV,MAX(PML(I),SQRT(MAX(0D0,PMSR)))) | |
18948 | ELSEIF(RBR.LT.0.9D0) THEN | |
18949 | PMG(I)=SQRT(MAX(0D0,PML(I)**2+PYR(0)*(PMV**2-PML(I)**2))) | |
18950 | ELSEIF(RBR.LT.1.5D0) THEN | |
18951 | PMG(I)=PML(I)*(PMV/PML(I))**PYR(0) | |
18952 | ELSE | |
18953 | PMG(I)=SQRT(MAX(0D0,PML(I)**2*PMV**2/(PML(I)**2+PYR(0)* | |
18954 | & (PMV**2-PML(I)**2)))) | |
18955 | ENDIF | |
18956 | 270 CONTINUE | |
18957 | IF((MEQL.GE.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. | |
18958 | & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) THEN | |
18959 | IF(MINT(48).EQ.1) THEN | |
18960 | NGEN(0,1)=NGEN(0,1)+1 | |
18961 | NGEN(MINT(1),1)=NGEN(MINT(1),1)+1 | |
18962 | GOTO 260 | |
18963 | ELSE | |
18964 | MINT(51)=1 | |
18965 | RETURN | |
18966 | ENDIF | |
18967 | ENDIF | |
18968 | RET1=PMG(1) | |
18969 | RET2=PMG(2) | |
18970 | ||
18971 | C...Give weight for selected mass distribution. | |
18972 | VINT(80)=1D0 | |
18973 | DO 280 I=1,2 | |
18974 | IF(MBW(I).EQ.0) GOTO 280 | |
18975 | PMV=PMU(I) | |
18976 | IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) | |
18977 | ATV=ATU(I) | |
18978 | IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) | |
18979 | F0=PMD(I)*PGD(I)/((PMG(I)**2-PMD(I)**2)**2+ | |
18980 | & (PMD(I)*PGD(I))**2)/PARU(1) | |
18981 | F1=1D0 | |
18982 | F2=1D0/PMG(I)**2 | |
18983 | F3=1D0/PMG(I)**4 | |
18984 | FI0=(ATV-ATL(I))/PARU(1) | |
18985 | FI1=PMV**2-PML(I)**2 | |
18986 | FI2=2D0*LOG(PMV/PML(I)) | |
18987 | FI3=1D0/PML(I)**2-1D0/PMV**2 | |
18988 | IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. | |
18989 | & ISUB.EQ.35).AND.MSTP(43).NE.2) THEN | |
18990 | VINT(80)=VINT(80)*20D0/(8D0+(FI0/F0)*(F1/FI1+6D0*F2/FI2+ | |
18991 | & 5D0*F3/FI3)) | |
18992 | ELSE | |
18993 | VINT(80)=VINT(80)*10D0/(8D0+(FI0/F0)*(F1/FI1+F2/FI2)) | |
18994 | ENDIF | |
18995 | VINT(80)=VINT(80)*FI0 | |
18996 | 280 CONTINUE | |
18997 | IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) | |
18998 | ENDIF | |
18999 | ||
19000 | RETURN | |
19001 | END | |
19002 | ||
19003 | C*********************************************************************** | |
19004 | ||
19005 | C...PYRECO | |
19006 | C...Handles the possibility of colour reconnection in W+W- events, | |
19007 | C...Based on the main scenarios of the Sjostrand and Khoze study: | |
19008 | C...I, II, II', intermediate and instantaneous; plus one model | |
19009 | C...along the lines of the Gustafson and Hakkinen: GH. | |
19010 | C...Note: also handles Z0 Z0 and W-W+ events, but notation below | |
19011 | C...is as if first resonance is W+ and second W-. | |
19012 | ||
19013 | SUBROUTINE PYRECO(IW1,IW2,NSD1,NAFT1) | |
19014 | ||
19015 | C...Double precision and integer declarations. | |
19016 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
19017 | IMPLICIT INTEGER(I-N) | |
19018 | INTEGER PYK,PYCHGE,PYCOMP | |
19019 | C...Parameter value; number of points in MC integration. | |
19020 | PARAMETER (NPT=100) | |
19021 | C...Commonblocks. | |
19022 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
19023 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
19024 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
19025 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
19026 | COMMON/PYINT1/MINT(400),VINT(400) | |
19027 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ | |
19028 | C...Local arrays. | |
19029 | DIMENSION NBEG(2),NEND(2),INP(50),INM(50),BEWW(3),XP(3),XM(3), | |
19030 | &V1(3),V2(3),BETP(50,4),DIRP(50,3),BETM(50,4),DIRM(50,3), | |
19031 | &XD(4),XB(4),IAP(NPT),IAM(NPT),WTA(NPT),V1P(3),V2P(3),V1M(3), | |
19032 | &V2M(3),Q(4,3),XPP(3),XMM(3),IPC(20),IMC(20),TC(0:20),TPC(20), | |
19033 | &TMC(20),IJOIN(100) | |
19034 | ||
19035 | C...Functions to give four-product and to do determinants. | |
19036 | 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) | |
19037 | DETER(I,J,L)=Q(I,1)*Q(J,2)*Q(L,3)-Q(I,1)*Q(L,2)*Q(J,3)+ | |
19038 | &Q(J,1)*Q(L,2)*Q(I,3)-Q(J,1)*Q(I,2)*Q(L,3)+ | |
19039 | &Q(L,1)*Q(I,2)*Q(J,3)-Q(L,1)*Q(J,2)*Q(I,3) | |
19040 | ||
19041 | C...Only allow fraction of recoupling for GH, intermediate and | |
19042 | C...instantaneous. | |
19043 | IF(MSTP(115).EQ.5.OR.MSTP(115).EQ.11.OR.MSTP(115).EQ.12) THEN | |
19044 | IF(PYR(0).GT.PARP(120)) RETURN | |
19045 | ENDIF | |
19046 | ISUB=MINT(1) | |
19047 | ||
19048 | C...Common part for scenarios I, II, II', and GH. | |
19049 | IF(MSTP(115).EQ.1.OR.MSTP(115).EQ.2.OR.MSTP(115).EQ.3.OR. | |
19050 | &MSTP(115).EQ.5) THEN | |
19051 | ||
19052 | C...Read out frequently-used parameters. | |
19053 | PI=PARU(1) | |
19054 | HBAR=PARU(3) | |
19055 | PMW=PMAS(24,1) | |
19056 | IF(ISUB.EQ.22) PMW=PMAS(23,1) | |
19057 | PGW=PMAS(24,2) | |
19058 | IF(ISUB.EQ.22) PGW=PMAS(23,2) | |
19059 | TFRAG=PARP(115) | |
19060 | RHAD=PARP(116) | |
19061 | FACT=PARP(117) | |
19062 | BLOWR=PARP(118) | |
19063 | BLOWT=PARP(119) | |
19064 | ||
19065 | C...Find range of decay products of the W's. | |
19066 | C...Background: the W's are stored in IW1 and IW2. | |
19067 | C...Their direct decay products in NSD1+1 through NSD1+4. | |
19068 | C...Products after shower (if any) in NSD1+5 through NAFT1 | |
19069 | C...for first W and in NAFT1+1 through N for the second. | |
19070 | IF(NAFT1.GT.NSD1+4) THEN | |
19071 | NBEG(1)=NSD1+5 | |
19072 | NEND(1)=NAFT1 | |
19073 | ELSE | |
19074 | NBEG(1)=NSD1+1 | |
19075 | NEND(1)=NSD1+2 | |
19076 | ENDIF | |
19077 | IF(N.GT.NAFT1) THEN | |
19078 | NBEG(2)=NAFT1+1 | |
19079 | NEND(2)=N | |
19080 | ELSE | |
19081 | NBEG(2)=NSD1+3 | |
19082 | NEND(2)=NSD1+4 | |
19083 | ENDIF | |
19084 | ||
19085 | C...Rearrange parton shower products along strings. | |
19086 | NOLD=N | |
19087 | CALL PYPREP(NSD1+1) | |
19088 | ||
19089 | C...Find partons pointing back to W+ and W-; store them with quark | |
19090 | C...end of string first. | |
19091 | NNP=0 | |
19092 | NNM=0 | |
19093 | ISGP=0 | |
19094 | ISGM=0 | |
19095 | DO 120 I=NOLD+1,N | |
19096 | IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 120 | |
19097 | IF(IABS(K(I,2)).GE.22) GOTO 120 | |
19098 | IF(K(I,3).GE.NBEG(1).AND.K(I,3).LE.NEND(1)) THEN | |
19099 | IF(ISGP.EQ.0) ISGP=ISIGN(1,K(I,2)) | |
19100 | NNP=NNP+1 | |
19101 | IF(ISGP.EQ.1) THEN | |
19102 | INP(NNP)=I | |
19103 | ELSE | |
19104 | DO 100 I1=NNP,2,-1 | |
19105 | INP(I1)=INP(I1-1) | |
19106 | 100 CONTINUE | |
19107 | INP(1)=I | |
19108 | ENDIF | |
19109 | IF(K(I,1).EQ.1) ISGP=0 | |
19110 | ELSEIF(K(I,3).GE.NBEG(2).AND.K(I,3).LE.NEND(2)) THEN | |
19111 | IF(ISGM.EQ.0) ISGM=ISIGN(1,K(I,2)) | |
19112 | NNM=NNM+1 | |
19113 | IF(ISGM.EQ.1) THEN | |
19114 | INM(NNM)=I | |
19115 | ELSE | |
19116 | DO 110 I1=NNM,2,-1 | |
19117 | INM(I1)=INM(I1-1) | |
19118 | 110 CONTINUE | |
19119 | INM(1)=I | |
19120 | ENDIF | |
19121 | IF(K(I,1).EQ.1) ISGM=0 | |
19122 | ENDIF | |
19123 | 120 CONTINUE | |
19124 | ||
19125 | C...Boost to W+W- rest frame (not strictly needed). | |
19126 | DO 130 J=1,3 | |
19127 | BEWW(J)=(P(IW1,J)+P(IW2,J))/(P(IW1,4)+P(IW2,4)) | |
19128 | 130 CONTINUE | |
19129 | CALL PYROBO(IW1,IW1,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3)) | |
19130 | CALL PYROBO(IW2,IW2,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3)) | |
19131 | CALL PYROBO(NOLD+1,N,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3)) | |
19132 | ||
19133 | C...Select decay vertices of W+ and W-. | |
19134 | TP=HBAR*(-LOG(PYR(0)))*P(IW1,4)/ | |
19135 | & SQRT((P(IW1,5)**2-PMW**2)**2+(P(IW1,5)**2*PGW/PMW)**2) | |
19136 | TM=HBAR*(-LOG(PYR(0)))*P(IW2,4)/ | |
19137 | & SQRT((P(IW2,5)**2-PMW**2)**2+(P(IW2,5)**2*PGW/PMW)**2) | |
19138 | GTMAX=MAX(TP,TM) | |
19139 | DO 140 J=1,3 | |
19140 | XP(J)=TP*P(IW1,J)/P(IW1,4) | |
19141 | XM(J)=TM*P(IW2,J)/P(IW2,4) | |
19142 | 140 CONTINUE | |
19143 | ||
19144 | C...Begin scenario I specifics. | |
19145 | IF(MSTP(115).EQ.1) THEN | |
19146 | ||
19147 | C...Reconstruct velocity and direction of W+ string pieces. | |
19148 | DO 170 IIP=1,NNP-1 | |
19149 | IF(K(INP(IIP),2).LT.0) GOTO 170 | |
19150 | I1=INP(IIP) | |
19151 | I2=INP(IIP+1) | |
19152 | P1A=SQRT(P(I1,1)**2+P(I1,2)**2+P(I1,3)**2) | |
19153 | P2A=SQRT(P(I2,1)**2+P(I2,2)**2+P(I2,3)**2) | |
19154 | DO 150 J=1,3 | |
19155 | V1(J)=P(I1,J)/P1A | |
19156 | V2(J)=P(I2,J)/P2A | |
19157 | BETP(IIP,J)=0.5D0*(V1(J)+V2(J)) | |
19158 | DIRP(IIP,J)=V1(J)-V2(J) | |
19159 | 150 CONTINUE | |
19160 | BETP(IIP,4)=1D0/SQRT(1D0-BETP(IIP,1)**2-BETP(IIP,2)**2- | |
19161 | & BETP(IIP,3)**2) | |
19162 | DIRL=SQRT(DIRP(IIP,1)**2+DIRP(IIP,2)**2+DIRP(IIP,3)**2) | |
19163 | DO 160 J=1,3 | |
19164 | DIRP(IIP,J)=DIRP(IIP,J)/DIRL | |
19165 | 160 CONTINUE | |
19166 | 170 CONTINUE | |
19167 | ||
19168 | C...Reconstruct velocity and direction of W- string pieces. | |
19169 | DO 200 IIM=1,NNM-1 | |
19170 | IF(K(INM(IIM),2).LT.0) GOTO 200 | |
19171 | I1=INM(IIM) | |
19172 | I2=INM(IIM+1) | |
19173 | P1A=SQRT(P(I1,1)**2+P(I1,2)**2+P(I1,3)**2) | |
19174 | P2A=SQRT(P(I2,1)**2+P(I2,2)**2+P(I2,3)**2) | |
19175 | DO 180 J=1,3 | |
19176 | V1(J)=P(I1,J)/P1A | |
19177 | V2(J)=P(I2,J)/P2A | |
19178 | BETM(IIM,J)=0.5D0*(V1(J)+V2(J)) | |
19179 | DIRM(IIM,J)=V1(J)-V2(J) | |
19180 | 180 CONTINUE | |
19181 | BETM(IIM,4)=1D0/SQRT(1D0-BETM(IIM,1)**2-BETM(IIM,2)**2- | |
19182 | & BETM(IIM,3)**2) | |
19183 | DIRL=SQRT(DIRM(IIM,1)**2+DIRM(IIM,2)**2+DIRM(IIM,3)**2) | |
19184 | DO 190 J=1,3 | |
19185 | DIRM(IIM,J)=DIRM(IIM,J)/DIRL | |
19186 | 190 CONTINUE | |
19187 | 200 CONTINUE | |
19188 | ||
19189 | C...Loop over number of space-time points. | |
19190 | NACC=0 | |
19191 | SUM=0D0 | |
19192 | DO 250 IPT=1,NPT | |
19193 | ||
19194 | C...Pick x,y,z,t Gaussian (width RHAD and TFRAG, respectively). | |
19195 | R=SQRT(-LOG(PYR(0))) | |
19196 | PHI=2D0*PI*PYR(0) | |
19197 | X=BLOWR*RHAD*R*COS(PHI) | |
19198 | Y=BLOWR*RHAD*R*SIN(PHI) | |
19199 | R=SQRT(-LOG(PYR(0))) | |
19200 | PHI=2D0*PI*PYR(0) | |
19201 | Z=BLOWR*RHAD*R*COS(PHI) | |
19202 | T=GTMAX+BLOWT*SQRT(0.5D0)*TFRAG*R*ABS(SIN(PHI)) | |
19203 | ||
19204 | C...Reject impossible points. Weight for sample distribution. | |
19205 | IF(T**2-X**2-Y**2-Z**2.LT.0D0) GOTO 250 | |
19206 | WTSMP=EXP(-(X**2+Y**2+Z**2)/(BLOWR*RHAD)**2)* | |
19207 | & EXP(-2D0*(T-GTMAX)**2/(BLOWT*TFRAG)**2) | |
19208 | ||
19209 | C...Loop over W+ string pieces and find one with largest weight. | |
19210 | IMAXP=0 | |
19211 | WTMAXP=1D-10 | |
19212 | XD(1)=X-XP(1) | |
19213 | XD(2)=Y-XP(2) | |
19214 | XD(3)=Z-XP(3) | |
19215 | XD(4)=T-TP | |
19216 | DO 220 IIP=1,NNP-1 | |
19217 | IF(K(INP(IIP),2).LT.0) GOTO 220 | |
19218 | BED=BETP(IIP,1)*XD(1)+BETP(IIP,2)*XD(2)+BETP(IIP,3)*XD(3) | |
19219 | BEDG=BETP(IIP,4)*(BETP(IIP,4)*BED/(1D0+BETP(IIP,4))-XD(4)) | |
19220 | DO 210 J=1,3 | |
19221 | XB(J)=XD(J)+BEDG*BETP(IIP,J) | |
19222 | 210 CONTINUE | |
19223 | XB(4)=BETP(IIP,4)*(XD(4)-BED) | |
19224 | SR2=XB(1)**2+XB(2)**2+XB(3)**2 | |
19225 | SZ2=(DIRP(IIP,1)*XB(1)+DIRP(IIP,2)*XB(2)+ | |
19226 | & DIRP(IIP,3)*XB(3))**2 | |
19227 | WTP=EXP(-(SR2-SZ2)/(2D0*RHAD**2))*EXP(-(XB(4)**2-SZ2)/ | |
19228 | & TFRAG**2) | |
19229 | IF(XB(4)-SQRT(SR2).LT.0D0) WTP=0D0 | |
19230 | IF(WTP.GT.WTMAXP) THEN | |
19231 | IMAXP=IIP | |
19232 | WTMAXP=WTP | |
19233 | ENDIF | |
19234 | 220 CONTINUE | |
19235 | ||
19236 | C...Loop over W- string pieces and find one with largest weight. | |
19237 | IMAXM=0 | |
19238 | WTMAXM=1D-10 | |
19239 | XD(1)=X-XM(1) | |
19240 | XD(2)=Y-XM(2) | |
19241 | XD(3)=Z-XM(3) | |
19242 | XD(4)=T-TM | |
19243 | DO 240 IIM=1,NNM-1 | |
19244 | IF(K(INM(IIM),2).LT.0) GOTO 240 | |
19245 | BED=BETM(IIM,1)*XD(1)+BETM(IIM,2)*XD(2)+BETM(IIM,3)*XD(3) | |
19246 | BEDG=BETM(IIM,4)*(BETM(IIM,4)*BED/(1D0+BETM(IIM,4))-XD(4)) | |
19247 | DO 230 J=1,3 | |
19248 | XB(J)=XD(J)+BEDG*BETM(IIM,J) | |
19249 | 230 CONTINUE | |
19250 | XB(4)=BETM(IIM,4)*(XD(4)-BED) | |
19251 | SR2=XB(1)**2+XB(2)**2+XB(3)**2 | |
19252 | SZ2=(DIRM(IIM,1)*XB(1)+DIRM(IIM,2)*XB(2)+ | |
19253 | & DIRM(IIM,3)*XB(3))**2 | |
19254 | WTM=EXP(-(SR2-SZ2)/(2D0*RHAD**2))*EXP(-(XB(4)**2-SZ2)/ | |
19255 | & TFRAG**2) | |
19256 | IF(XB(4)-SQRT(SR2).LT.0D0) WTM=0D0 | |
19257 | IF(WTM.GT.WTMAXM) THEN | |
19258 | IMAXM=IIM | |
19259 | WTMAXM=WTM | |
19260 | ENDIF | |
19261 | 240 CONTINUE | |
19262 | ||
19263 | C...Result of integration. | |
19264 | WT=0D0 | |
19265 | IF(IMAXP.NE.0.AND.IMAXM.NE.0) THEN | |
19266 | WT=WTMAXP*WTMAXM/WTSMP | |
19267 | SUM=SUM+WT | |
19268 | NACC=NACC+1 | |
19269 | IAP(NACC)=IMAXP | |
19270 | IAM(NACC)=IMAXM | |
19271 | WTA(NACC)=WT | |
19272 | ENDIF | |
19273 | 250 CONTINUE | |
19274 | RES=BLOWR**3*BLOWT*SUM/NPT | |
19275 | ||
19276 | C...Decide whether to reconnect and, if so, where. | |
19277 | IACC=0 | |
19278 | PREC=1D0-EXP(-FACT*RES) | |
19279 | IF(PREC.GT.PYR(0)) THEN | |
19280 | RSUM=PYR(0)*SUM | |
19281 | DO 260 IA=1,NACC | |
19282 | IACC=IA | |
19283 | RSUM=RSUM-WTA(IA) | |
19284 | IF(RSUM.LE.0D0) GOTO 270 | |
19285 | 260 CONTINUE | |
19286 | 270 IIP=IAP(IACC) | |
19287 | IIM=IAM(IACC) | |
19288 | ENDIF | |
19289 | ||
19290 | C...Begin scenario II and II' specifics. | |
19291 | ELSEIF(MSTP(115).EQ.2.OR.MSTP(115).EQ.3) THEN | |
19292 | ||
19293 | C...Loop through all string pieces, one from W+ and one from W-. | |
19294 | NCROSS=0 | |
19295 | TC(0)=0D0 | |
19296 | DO 340 IIP=1,NNP-1 | |
19297 | IF(K(INP(IIP),2).LT.0) GOTO 340 | |
19298 | I1P=INP(IIP) | |
19299 | I2P=INP(IIP+1) | |
19300 | DO 330 IIM=1,NNM-1 | |
19301 | IF(K(INM(IIM),2).LT.0) GOTO 330 | |
19302 | I1M=INM(IIM) | |
19303 | I2M=INM(IIM+1) | |
19304 | ||
19305 | C...Find endpoint velocity vectors. | |
19306 | DO 280 J=1,3 | |
19307 | V1P(J)=P(I1P,J)/P(I1P,4) | |
19308 | V2P(J)=P(I2P,J)/P(I2P,4) | |
19309 | V1M(J)=P(I1M,J)/P(I1M,4) | |
19310 | V2M(J)=P(I2M,J)/P(I2M,4) | |
19311 | 280 CONTINUE | |
19312 | ||
19313 | C...Define q matrix and find t. | |
19314 | DO 290 J=1,3 | |
19315 | Q(1,J)=V2P(J)-V1P(J) | |
19316 | Q(2,J)=-(V2M(J)-V1M(J)) | |
19317 | Q(3,J)=XP(J)-XM(J)-TP*V1P(J)+TM*V1M(J) | |
19318 | Q(4,J)=V1P(J)-V1M(J) | |
19319 | 290 CONTINUE | |
19320 | T=-DETER(1,2,3)/DETER(1,2,4) | |
19321 | ||
19322 | C...Find alpha and beta; i.e. coordinates of crossing point. | |
19323 | S11=Q(1,1)*(T-TP) | |
19324 | S12=Q(2,1)*(T-TM) | |
19325 | S13=Q(3,1)+Q(4,1)*T | |
19326 | S21=Q(1,2)*(T-TP) | |
19327 | S22=Q(2,2)*(T-TM) | |
19328 | S23=Q(3,2)+Q(4,2)*T | |
19329 | DEN=S11*S22-S12*S21 | |
19330 | ALP=(S12*S23-S22*S13)/DEN | |
19331 | BET=(S21*S13-S11*S23)/DEN | |
19332 | ||
19333 | C...Check if solution acceptable. | |
19334 | IANSW=1 | |
19335 | IF(T.LT.GTMAX) IANSW=0 | |
19336 | IF(ALP.LT.0D0.OR.ALP.GT.1D0) IANSW=0 | |
19337 | IF(BET.LT.0D0.OR.BET.GT.1D0) IANSW=0 | |
19338 | ||
19339 | C...Find point of crossing and check that not inconsistent. | |
19340 | DO 300 J=1,3 | |
19341 | XPP(J)=XP(J)+(V1P(J)+ALP*(V2P(J)-V1P(J)))*(T-TP) | |
19342 | XMM(J)=XM(J)+(V1M(J)+BET*(V2M(J)-V1M(J)))*(T-TM) | |
19343 | 300 CONTINUE | |
19344 | D2PM=(XPP(1)-XMM(1))**2+(XPP(2)-XMM(2))**2+ | |
19345 | & (XPP(3)-XMM(3))**2 | |
19346 | D2P=XPP(1)**2+XPP(2)**2+XPP(3)**2 | |
19347 | D2M=XMM(1)**2+XMM(2)**2+XMM(3)**2 | |
19348 | IF(D2PM.GT.1D-4*(D2P+D2M)) IANSW=-1 | |
19349 | ||
19350 | C...Find string eigentimes at crossing. | |
19351 | IF(IANSW.EQ.1) THEN | |
19352 | TAUP=SQRT(MAX(0D0,(T-TP)**2-(XPP(1)-XP(1))**2- | |
19353 | & (XPP(2)-XP(2))**2-(XPP(3)-XP(3))**2)) | |
19354 | TAUM=SQRT(MAX(0D0,(T-TM)**2-(XMM(1)-XM(1))**2- | |
19355 | & (XMM(2)-XM(2))**2-(XMM(3)-XM(3))**2)) | |
19356 | ELSE | |
19357 | TAUP=0D0 | |
19358 | TAUM=0D0 | |
19359 | ENDIF | |
19360 | ||
19361 | C...Order crossings by time. End loop over crossings. | |
19362 | IF(IANSW.EQ.1.AND.NCROSS.LT.20) THEN | |
19363 | NCROSS=NCROSS+1 | |
19364 | DO 310 I1=NCROSS,1,-1 | |
19365 | IF(T.GT.TC(I1-1).OR.I1.EQ.1) THEN | |
19366 | IPC(I1)=IIP | |
19367 | IMC(I1)=IIM | |
19368 | TC(I1)=T | |
19369 | TPC(I1)=TAUP | |
19370 | TMC(I1)=TAUM | |
19371 | GOTO 320 | |
19372 | ELSE | |
19373 | IPC(I1)=IPC(I1-1) | |
19374 | IMC(I1)=IMC(I1-1) | |
19375 | TC(I1)=TC(I1-1) | |
19376 | TPC(I1)=TPC(I1-1) | |
19377 | TMC(I1)=TMC(I1-1) | |
19378 | ENDIF | |
19379 | 310 CONTINUE | |
19380 | 320 CONTINUE | |
19381 | ENDIF | |
19382 | 330 CONTINUE | |
19383 | 340 CONTINUE | |
19384 | ||
19385 | C...Loop over crossings; find first (if any) acceptable one. | |
19386 | IACC=0 | |
19387 | IF(NCROSS.GE.1) THEN | |
19388 | DO 350 IC=1,NCROSS | |
19389 | PNFRAG=EXP(-(TPC(IC)**2+TMC(IC)**2)/TFRAG**2) | |
19390 | IF(PNFRAG.GT.PYR(0)) THEN | |
19391 | C...Scenario II: only compare with fragmentation time. | |
19392 | IF(MSTP(115).EQ.2) THEN | |
19393 | IACC=IC | |
19394 | IIP=IPC(IACC) | |
19395 | IIM=IMC(IACC) | |
19396 | GOTO 360 | |
19397 | C...Scenario II': also require that string length decreases. | |
19398 | ELSE | |
19399 | IIP=IPC(IC) | |
19400 | IIM=IMC(IC) | |
19401 | I1P=INP(IIP) | |
19402 | I2P=INP(IIP+1) | |
19403 | I1M=INM(IIM) | |
19404 | I2M=INM(IIM+1) | |
19405 | ELOLD=FOUR(I1P,I2P)*FOUR(I1M,I2M) | |
19406 | ELNEW=FOUR(I1P,I2M)*FOUR(I1M,I2P) | |
19407 | IF(ELNEW.LT.ELOLD) THEN | |
19408 | IACC=IC | |
19409 | IIP=IPC(IACC) | |
19410 | IIM=IMC(IACC) | |
19411 | GOTO 360 | |
19412 | ENDIF | |
19413 | ENDIF | |
19414 | ENDIF | |
19415 | 350 CONTINUE | |
19416 | 360 CONTINUE | |
19417 | ENDIF | |
19418 | ||
19419 | C...Begin scenario GH specifics. | |
19420 | ELSEIF(MSTP(115).EQ.5) THEN | |
19421 | ||
19422 | C...Loop through all string pieces, one from W+ and one from W-. | |
19423 | IACC=0 | |
19424 | ELMIN=1D0 | |
19425 | DO 380 IIP=1,NNP-1 | |
19426 | IF(K(INP(IIP),2).LT.0) GOTO 380 | |
19427 | I1P=INP(IIP) | |
19428 | I2P=INP(IIP+1) | |
19429 | DO 370 IIM=1,NNM-1 | |
19430 | IF(K(INM(IIM),2).LT.0) GOTO 370 | |
19431 | I1M=INM(IIM) | |
19432 | I2M=INM(IIM+1) | |
19433 | ||
19434 | C...Look for largest decrease of (exponent of) Lambda measure. | |
19435 | ELOLD=FOUR(I1P,I2P)*FOUR(I1M,I2M) | |
19436 | ELNEW=FOUR(I1P,I2M)*FOUR(I1M,I2P) | |
19437 | ELDIF=ELNEW/MAX(1D-10,ELOLD) | |
19438 | IF(ELDIF.LT.ELMIN) THEN | |
19439 | IACC=IIP+IIM | |
19440 | ELMIN=ELDIF | |
19441 | IPC(1)=IIP | |
19442 | IMC(1)=IIM | |
19443 | ENDIF | |
19444 | 370 CONTINUE | |
19445 | 380 CONTINUE | |
19446 | IIP=IPC(1) | |
19447 | IIM=IMC(1) | |
19448 | ENDIF | |
19449 | ||
19450 | C...Common for scenarios I, II, II' and GH: reconnect strings. | |
19451 | IF(IACC.NE.0) THEN | |
19452 | MINT(32)=1 | |
19453 | NJOIN=0 | |
19454 | DO 390 IS=1,NNP+NNM | |
19455 | NJOIN=NJOIN+1 | |
19456 | IF(IS.LE.IIP) THEN | |
19457 | I=INP(IS) | |
19458 | ELSEIF(IS.LE.IIP+NNM-IIM) THEN | |
19459 | I=INM(IS-IIP+IIM) | |
19460 | ELSEIF(IS.LE.IIP+NNM) THEN | |
19461 | I=INM(IS-IIP-NNM+IIM) | |
19462 | ELSE | |
19463 | I=INP(IS-NNM) | |
19464 | ENDIF | |
19465 | IJOIN(NJOIN)=I | |
19466 | IF(K(I,2).LT.0) THEN | |
19467 | CALL PYJOIN(NJOIN,IJOIN) | |
19468 | NJOIN=0 | |
19469 | ENDIF | |
19470 | 390 CONTINUE | |
19471 | ||
19472 | C...Restore original event record if no reconnection. | |
19473 | ELSE | |
19474 | DO 400 I=NSD1+1,NOLD | |
19475 | IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) THEN | |
19476 | K(I,4)=MOD(K(I,4),MSTU(5)**2) | |
19477 | K(I,5)=MOD(K(I,5),MSTU(5)**2) | |
19478 | ENDIF | |
19479 | 400 CONTINUE | |
19480 | DO 410 I=NOLD+1,N | |
19481 | K(K(I,3),1)=3 | |
19482 | 410 CONTINUE | |
19483 | N=NOLD | |
19484 | ENDIF | |
19485 | ||
19486 | C...Boost back system. | |
19487 | CALL PYROBO(IW1,IW1,0D0,0D0,BEWW(1),BEWW(2),BEWW(3)) | |
19488 | CALL PYROBO(IW2,IW2,0D0,0D0,BEWW(1),BEWW(2),BEWW(3)) | |
19489 | IF(N.GT.NOLD) CALL PYROBO(NOLD+1,N,0D0,0D0, | |
19490 | & BEWW(1),BEWW(2),BEWW(3)) | |
19491 | ||
19492 | C...Common part for intermediate and instantaneous scenarios. | |
19493 | ELSEIF(MSTP(115).EQ.11.OR.MSTP(115).EQ.12) THEN | |
19494 | MINT(32)=1 | |
19495 | ||
19496 | C...Remove old shower products and reset showering ones. | |
19497 | N=NSD1+4 | |
19498 | DO 420 I=NSD1+1,NSD1+4 | |
19499 | K(I,1)=3 | |
19500 | K(I,4)=MOD(K(I,4),MSTU(5)**2) | |
19501 | K(I,5)=MOD(K(I,5),MSTU(5)**2) | |
19502 | 420 CONTINUE | |
19503 | ||
19504 | C...Identify quark-antiquark pairs. | |
19505 | IQ1=NSD1+1 | |
19506 | IQ2=NSD1+2 | |
19507 | IQ3=NSD1+3 | |
19508 | IF(K(IQ1,2)*K(IQ3,2).LT.0) IQ3=NSD1+4 | |
19509 | IQ4=2*NSD1+7-IQ3 | |
19510 | ||
19511 | C...Reconnect strings. | |
19512 | IJOIN(1)=IQ1 | |
19513 | IJOIN(2)=IQ4 | |
19514 | CALL PYJOIN(2,IJOIN) | |
19515 | IJOIN(1)=IQ3 | |
19516 | IJOIN(2)=IQ2 | |
19517 | CALL PYJOIN(2,IJOIN) | |
19518 | ||
19519 | C...Do new parton showers in intermediate scenario. | |
19520 | IF(MSTP(71).GE.1.AND.MSTP(115).EQ.11) THEN | |
19521 | MSTJ50=MSTJ(50) | |
19522 | MSTJ(50)=0 | |
19523 | CALL PYSHOW(IQ1,IQ2,P(IW1,5)) | |
19524 | CALL PYSHOW(IQ3,IQ4,P(IW2,5)) | |
19525 | MSTJ(50)=MSTJ50 | |
19526 | ||
19527 | C...Do new parton showers in instantaneous scenario. | |
19528 | ELSEIF(MSTP(71).GE.1.AND.MSTP(115).EQ.12) THEN | |
19529 | PPM2=(P(IQ1,4)+P(IQ4,4))**2-(P(IQ1,1)+P(IQ4,1))**2- | |
19530 | & (P(IQ1,2)+P(IQ4,2))**2-(P(IQ1,3)+P(IQ4,3))**2 | |
19531 | PPM=SQRT(MAX(0D0,PPM2)) | |
19532 | CALL PYSHOW(IQ1,IQ4,PPM) | |
19533 | PPM2=(P(IQ3,4)+P(IQ2,4))**2-(P(IQ3,1)+P(IQ2,1))**2- | |
19534 | & (P(IQ3,2)+P(IQ2,2))**2-(P(IQ3,3)+P(IQ2,3))**2 | |
19535 | PPM=SQRT(MAX(0D0,PPM2)) | |
19536 | CALL PYSHOW(IQ3,IQ2,PPM) | |
19537 | ENDIF | |
19538 | ENDIF | |
19539 | ||
19540 | RETURN | |
19541 | END | |
19542 | ||
19543 | C*********************************************************************** | |
19544 | ||
19545 | C...PYKLIM | |
19546 | C...Checks generated variables against pre-set kinematical limits; | |
19547 | C...also calculates limits on variables used in generation. | |
19548 | ||
19549 | SUBROUTINE PYKLIM(ILIM) | |
19550 | ||
19551 | C...Double precision and integer declarations. | |
19552 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
19553 | IMPLICIT INTEGER(I-N) | |
19554 | INTEGER PYK,PYCHGE,PYCOMP | |
19555 | C...Commonblocks. | |
19556 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
19557 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
19558 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
19559 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
19560 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
19561 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
19562 | COMMON/PYINT1/MINT(400),VINT(400) | |
19563 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
19564 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, | |
19565 | &/PYINT1/,/PYINT2/ | |
19566 | ||
19567 | C...Common kinematical expressions. | |
19568 | MINT(51)=0 | |
19569 | ISUB=MINT(1) | |
19570 | ISTSB=ISET(ISUB) | |
19571 | IF(ISUB.EQ.96) GOTO 100 | |
19572 | SQM3=VINT(63) | |
19573 | SQM4=VINT(64) | |
19574 | IF(ILIM.NE.0) THEN | |
19575 | IF(ABS(SQM3).LT.1D-4.AND.ABS(SQM4).LT.1D-4) THEN | |
19576 | CKIN09=MAX(CKIN(9),CKIN(13)) | |
19577 | CKIN10=MIN(CKIN(10),CKIN(14)) | |
19578 | CKIN11=MAX(CKIN(11),CKIN(15)) | |
19579 | CKIN12=MIN(CKIN(12),CKIN(16)) | |
19580 | ELSE | |
19581 | CKIN09=MAX(CKIN(9),MIN(0D0,CKIN(13))) | |
19582 | CKIN10=MIN(CKIN(10),MAX(0D0,CKIN(14))) | |
19583 | CKIN11=MAX(CKIN(11),MIN(0D0,CKIN(15))) | |
19584 | CKIN12=MIN(CKIN(12),MAX(0D0,CKIN(16))) | |
19585 | ENDIF | |
19586 | ENDIF | |
19587 | IF(ILIM.NE.1) THEN | |
19588 | TAU=VINT(21) | |
19589 | RM3=SQM3/(TAU*VINT(2)) | |
19590 | RM4=SQM4/(TAU*VINT(2)) | |
19591 | BE34=SQRT(MAX(1D-20,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) | |
19592 | ENDIF | |
19593 | PTHMIN=CKIN(3) | |
19594 | IF(MIN(SQM3,SQM4).LT.CKIN(6)**2.AND.ISTSB.NE.1.AND.ISTSB.NE.3) | |
19595 | &PTHMIN=MAX(CKIN(3),CKIN(5)) | |
19596 | ||
19597 | IF(ILIM.EQ.0) THEN | |
19598 | C...Check generated values of tau, y*, cos(theta-hat), and tau' against | |
19599 | C...pre-set kinematical limits. | |
19600 | YST=VINT(22) | |
19601 | CTH=VINT(23) | |
19602 | TAUP=VINT(26) | |
19603 | TAUE=TAU | |
19604 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP | |
19605 | X1=SQRT(TAUE)*EXP(YST) | |
19606 | X2=SQRT(TAUE)*EXP(-YST) | |
19607 | XF=X1-X2 | |
19608 | IF(MINT(47).NE.1) THEN | |
19609 | IF(TAU*VINT(2).LT.CKIN(1)**2) MINT(51)=1 | |
19610 | IF(CKIN(2).GE.0D0.AND.TAU*VINT(2).GT.CKIN(2)**2) MINT(51)=1 | |
19611 | IF(YST.LT.CKIN(7).OR.YST.GT.CKIN(8)) MINT(51)=1 | |
19612 | IF(XF.LT.CKIN(25).OR.XF.GT.CKIN(26)) MINT(51)=1 | |
19613 | ENDIF | |
19614 | IF(MINT(45).NE.1) THEN | |
19615 | IF(X1.LT.CKIN(21).OR.X1.GT.CKIN(22)) MINT(51)=1 | |
19616 | ENDIF | |
19617 | IF(MINT(46).NE.1) THEN | |
19618 | IF(X2.LT.CKIN(23).OR.X2.GT.CKIN(24)) MINT(51)=1 | |
19619 | ENDIF | |
19620 | IF(MINT(45).EQ.2) THEN | |
19621 | IF(X1.GT.1D0-2D0*PARP(111)/VINT(1)) MINT(51)=1 | |
19622 | ENDIF | |
19623 | IF(MINT(46).EQ.2) THEN | |
19624 | IF(X2.GT.1D0-2D0*PARP(111)/VINT(1)) MINT(51)=1 | |
19625 | ENDIF | |
19626 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN | |
19627 | PTH=0.5D0*BE34*SQRT(TAU*VINT(2)*MAX(0D0,1D0-CTH**2)) | |
19628 | EXPY3=MAX(1D-20,(1D0+RM3-RM4+BE34*CTH)/ | |
19629 | & MAX(1D-20,(1D0+RM3-RM4-BE34*CTH))) | |
19630 | EXPY4=MAX(1D-20,(1D0-RM3+RM4-BE34*CTH)/ | |
19631 | & MAX(1D-20,(1D0-RM3+RM4+BE34*CTH))) | |
19632 | Y3=YST+0.5D0*LOG(EXPY3) | |
19633 | Y4=YST+0.5D0*LOG(EXPY4) | |
19634 | YLARGE=MAX(Y3,Y4) | |
19635 | YSMALL=MIN(Y3,Y4) | |
19636 | ETALAR=20D0 | |
19637 | ETASMA=-20D0 | |
19638 | STH=SQRT(MAX(0D0,1D0-CTH**2)) | |
19639 | EXSQ3=SQRT(MAX(1D-20,((1D0+RM3-RM4)*COSH(YST)+BE34*SINH(YST)* | |
19640 | & CTH)**2-4D0*RM3)) | |
19641 | EXSQ4=SQRT(MAX(1D-20,((1D0-RM3+RM4)*COSH(YST)-BE34*SINH(YST)* | |
19642 | & CTH)**2-4D0*RM4)) | |
19643 | IF(STH.GE.1D-10) THEN | |
19644 | EXPET3=((1D0+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH+EXSQ3)/ | |
19645 | & (BE34*STH) | |
19646 | EXPET4=((1D0-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH+EXSQ4)/ | |
19647 | & (BE34*STH) | |
19648 | ETA3=LOG(MIN(1D10,MAX(1D-10,EXPET3))) | |
19649 | ETA4=LOG(MIN(1D10,MAX(1D-10,EXPET4))) | |
19650 | ETALAR=MAX(ETA3,ETA4) | |
19651 | ETASMA=MIN(ETA3,ETA4) | |
19652 | ENDIF | |
19653 | CTS3=((1D0+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH)/EXSQ3 | |
19654 | CTS4=((1D0-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH)/EXSQ4 | |
19655 | CTSLAR=MIN(1D0,MAX(-1D0,CTS3,CTS4)) | |
19656 | CTSSMA=MAX(-1D0,MIN(1D0,CTS3,CTS4)) | |
19657 | SH=TAU*VINT(2) | |
19658 | RPTS=4D0*VINT(71)**2/SH | |
19659 | BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) | |
19660 | RM34=MAX(1D-20,2D0*RM3*RM4) | |
19661 | IF(2D0*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001D0) | |
19662 | & RM34=MAX(RM34,2D0*VINT(71)**2/(VINT(21)*VINT(2))) | |
19663 | RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) | |
19664 | THA=0.5D0*SH*MAX(RTHM,1D0-RM3-RM4-BE34*CTH) | |
19665 | UHA=0.5D0*SH*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) | |
19666 | IF(PTH.LT.PTHMIN) MINT(51)=1 | |
19667 | IF(CKIN(4).GE.0D0.AND.PTH.GT.CKIN(4)) MINT(51)=1 | |
19668 | IF(YLARGE.LT.CKIN(9).OR.YLARGE.GT.CKIN(10)) MINT(51)=1 | |
19669 | IF(YSMALL.LT.CKIN(11).OR.YSMALL.GT.CKIN(12)) MINT(51)=1 | |
19670 | IF(ETALAR.LT.CKIN(13).OR.ETALAR.GT.CKIN(14)) MINT(51)=1 | |
19671 | IF(ETASMA.LT.CKIN(15).OR.ETASMA.GT.CKIN(16)) MINT(51)=1 | |
19672 | IF(CTSLAR.LT.CKIN(17).OR.CTSLAR.GT.CKIN(18)) MINT(51)=1 | |
19673 | IF(CTSSMA.LT.CKIN(19).OR.CTSSMA.GT.CKIN(20)) MINT(51)=1 | |
19674 | IF(CTH.LT.CKIN(27).OR.CTH.GT.CKIN(28)) MINT(51)=1 | |
19675 | IF(THA.LT.CKIN(35)) MINT(51)=1 | |
19676 | IF(CKIN(36).GE.0D0.AND.THA.GT.CKIN(36)) MINT(51)=1 | |
19677 | IF(UHA.LT.CKIN(37)) MINT(51)=1 | |
19678 | IF(CKIN(38).GE.0D0.AND.UHA.GT.CKIN(38)) MINT(51)=1 | |
19679 | ENDIF | |
19680 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN | |
19681 | IF(TAUP*VINT(2).LT.CKIN(31)**2) MINT(51)=1 | |
19682 | IF(CKIN(32).GE.0D0.AND.TAUP*VINT(2).GT.CKIN(32)**2) MINT(51)=1 | |
19683 | ENDIF | |
19684 | ||
19685 | C...Additional cuts on W2 (approximately) in DIS. | |
19686 | IF(ISUB.EQ.10.AND.MINT(43).GE.2) THEN | |
19687 | XBJ=X2 | |
19688 | IF(IABS(MINT(12)).LT.20) XBJ=X1 | |
19689 | Q2BJ=THA | |
19690 | W2BJ=Q2BJ*(1D0-XBJ)/XBJ | |
19691 | IF(W2BJ.LT.CKIN(39)) MINT(51)=1 | |
19692 | IF(CKIN(40).GT.0D0.AND.W2BJ.GT.CKIN(40)) MINT(51)=1 | |
19693 | ENDIF | |
19694 | ||
19695 | ELSEIF(ILIM.EQ.1) THEN | |
19696 | C...Calculate limits on tau | |
19697 | C...0) due to definition | |
19698 | TAUMN0=0D0 | |
19699 | TAUMX0=1D0 | |
19700 | C...1) due to limits on subsystem mass | |
19701 | TAUMN1=CKIN(1)**2/VINT(2) | |
19702 | TAUMX1=1D0 | |
19703 | IF(CKIN(2).GE.0D0) TAUMX1=CKIN(2)**2/VINT(2) | |
19704 | C...2) due to limits on pT-hat (and non-overlapping rapidity intervals) | |
19705 | TM3=SQRT(SQM3+PTHMIN**2) | |
19706 | TM4=SQRT(SQM4+PTHMIN**2) | |
19707 | YDCOSH=1D0 | |
19708 | IF(CKIN09.GT.CKIN12) YDCOSH=COSH(CKIN09-CKIN12) | |
19709 | TAUMN2=(TM3**2+2D0*TM3*TM4*YDCOSH+TM4**2)/VINT(2) | |
19710 | TAUMX2=1D0 | |
19711 | C...3) due to limits on pT-hat and cos(theta-hat) | |
19712 | CTH2MN=MIN(CKIN(27)**2,CKIN(28)**2) | |
19713 | CTH2MX=MAX(CKIN(27)**2,CKIN(28)**2) | |
19714 | TAUMN3=0D0 | |
19715 | IF(CKIN(27)*CKIN(28).GT.0D0) TAUMN3= | |
19716 | & (SQRT(SQM3+PTHMIN**2/(1D0-CTH2MN))+ | |
19717 | & SQRT(SQM4+PTHMIN**2/(1D0-CTH2MN)))**2/VINT(2) | |
19718 | TAUMX3=1D0 | |
19719 | IF(CKIN(4).GE.0D0.AND.CTH2MX.LT.1D0) TAUMX3= | |
19720 | & (SQRT(SQM3+CKIN(4)**2/(1D0-CTH2MX))+ | |
19721 | & SQRT(SQM4+CKIN(4)**2/(1D0-CTH2MX)))**2/VINT(2) | |
19722 | C...4) due to limits on x1 and x2 | |
19723 | TAUMN4=CKIN(21)*CKIN(23) | |
19724 | TAUMX4=CKIN(22)*CKIN(24) | |
19725 | C...5) due to limits on xF | |
19726 | TAUMN5=0D0 | |
19727 | TAUMX5=MAX(1D0-CKIN(25),1D0+CKIN(26)) | |
19728 | C...6) due to limits on that and uhat | |
19729 | TAUMN6=(SQM3+SQM4+CKIN(35)+CKIN(37))/VINT(2) | |
19730 | TAUMX6=1D0 | |
19731 | IF(CKIN(36).GT.0D0.AND.CKIN(38).GT.0D0) TAUMX6= | |
19732 | & (SQM3+SQM4+CKIN(36)+CKIN(38))/VINT(2) | |
19733 | ||
19734 | C...Net effect of all separate limits. | |
19735 | VINT(11)=MAX(TAUMN0,TAUMN1,TAUMN2,TAUMN3,TAUMN4,TAUMN5,TAUMN6) | |
19736 | VINT(31)=MIN(TAUMX0,TAUMX1,TAUMX2,TAUMX3,TAUMX4,TAUMX5,TAUMX6) | |
19737 | IF(MINT(47).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2)) THEN | |
19738 | VINT(11)=1D0-1D-9 | |
19739 | VINT(31)=1D0+1D-9 | |
19740 | ELSEIF(MINT(47).EQ.5) THEN | |
19741 | VINT(31)=MIN(VINT(31),1D0-2D-10) | |
19742 | ELSEIF(MINT(47).GE.6) THEN | |
19743 | VINT(31)=MIN(VINT(31),1D0-1D-10) | |
19744 | ENDIF | |
19745 | IF(VINT(31).LE.VINT(11)) MINT(51)=1 | |
19746 | ||
19747 | ELSEIF(ILIM.EQ.2) THEN | |
19748 | C...Calculate limits on y* | |
19749 | TAUE=TAU | |
19750 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINT(26) | |
19751 | TAURT=SQRT(TAUE) | |
19752 | C...0) due to kinematics | |
19753 | YSTMN0=LOG(TAURT) | |
19754 | YSTMX0=-YSTMN0 | |
19755 | C...1) due to explicit limits | |
19756 | YSTMN1=CKIN(7) | |
19757 | YSTMX1=CKIN(8) | |
19758 | C...2) due to limits on x1 | |
19759 | YSTMN2=LOG(MAX(TAUE,CKIN(21))/TAURT) | |
19760 | YSTMX2=LOG(MAX(TAUE,CKIN(22))/TAURT) | |
19761 | C...3) due to limits on x2 | |
19762 | YSTMN3=-LOG(MAX(TAUE,CKIN(24))/TAURT) | |
19763 | YSTMX3=-LOG(MAX(TAUE,CKIN(23))/TAURT) | |
19764 | C...4) due to limits on xF | |
19765 | YEPMN4=0.5D0*ABS(CKIN(25))/TAURT | |
19766 | YSTMN4=SIGN(LOG(MAX(1D-20,SQRT(1D0+YEPMN4**2)+YEPMN4)),CKIN(25)) | |
19767 | YEPMX4=0.5D0*ABS(CKIN(26))/TAURT | |
19768 | YSTMX4=SIGN(LOG(MAX(1D-20,SQRT(1D0+YEPMX4**2)+YEPMX4)),CKIN(26)) | |
19769 | C...5) due to simultaneous limits on y-large and y-small | |
19770 | YEPSMN=(RM3-RM4)*SINH(CKIN09-CKIN11) | |
19771 | YEPSMX=(RM3-RM4)*SINH(CKIN10-CKIN12) | |
19772 | YDIFMN=ABS(LOG(MAX(1D-20,SQRT(1D0+YEPSMN**2)-YEPSMN))) | |
19773 | YDIFMX=ABS(LOG(MAX(1D-20,SQRT(1D0+YEPSMX**2)-YEPSMX))) | |
19774 | YSTMN5=0.5D0*(CKIN09+CKIN11-YDIFMN) | |
19775 | YSTMX5=0.5D0*(CKIN10+CKIN12+YDIFMX) | |
19776 | C...6) due to simultaneous limits on cos(theta-hat) and y-large or | |
19777 | C... y-small | |
19778 | CTHLIM=SQRT(MAX(0D0,1D0-4D0*PTHMIN**2/(BE34**2*TAUE*VINT(2)))) | |
19779 | RZMN=BE34*MAX(CKIN(27),-CTHLIM) | |
19780 | RZMX=BE34*MIN(CKIN(28),CTHLIM) | |
19781 | YEX3MX=(1D0+RM3-RM4+RZMX)/MAX(1D-10,1D0+RM3-RM4-RZMX) | |
19782 | YEX4MX=(1D0+RM4-RM3-RZMN)/MAX(1D-10,1D0+RM4-RM3+RZMN) | |
19783 | YEX3MN=MAX(1D-10,1D0+RM3-RM4+RZMN)/(1D0+RM3-RM4-RZMN) | |
19784 | YEX4MN=MAX(1D-10,1D0+RM4-RM3-RZMX)/(1D0+RM4-RM3+RZMX) | |
19785 | YSTMN6=CKIN09-0.5D0*LOG(MAX(YEX3MX,YEX4MX)) | |
19786 | YSTMX6=CKIN12-0.5D0*LOG(MIN(YEX3MN,YEX4MN)) | |
19787 | ||
19788 | C...Net effect of all separate limits. | |
19789 | VINT(12)=MAX(YSTMN0,YSTMN1,YSTMN2,YSTMN3,YSTMN4,YSTMN5,YSTMN6) | |
19790 | VINT(32)=MIN(YSTMX0,YSTMX1,YSTMX2,YSTMX3,YSTMX4,YSTMX5,YSTMX6) | |
19791 | IF(MINT(47).EQ.1) THEN | |
19792 | VINT(12)=-1D-9 | |
19793 | VINT(32)=1D-9 | |
19794 | ELSEIF(MINT(47).EQ.2.OR.MINT(47).EQ.6) THEN | |
19795 | VINT(12)=(1D0-1D-9)*YSTMX0 | |
19796 | VINT(32)=(1D0+1D-9)*YSTMX0 | |
19797 | ELSEIF(MINT(47).EQ.3.OR.MINT(47).EQ.7) THEN | |
19798 | VINT(12)=-(1D0+1D-9)*YSTMX0 | |
19799 | VINT(32)=-(1D0-1D-9)*YSTMX0 | |
19800 | ELSEIF(MINT(47).EQ.5) THEN | |
19801 | YSTEE=LOG((1D0-1D-10)/TAURT) | |
19802 | VINT(12)=MAX(VINT(12),-YSTEE) | |
19803 | VINT(32)=MIN(VINT(32),YSTEE) | |
19804 | ENDIF | |
19805 | IF(VINT(32).LE.VINT(12)) MINT(51)=1 | |
19806 | ||
19807 | ELSEIF(ILIM.EQ.3) THEN | |
19808 | C...Calculate limits on cos(theta-hat) | |
19809 | YST=VINT(22) | |
19810 | C...0) due to definition | |
19811 | CTNMN0=-1D0 | |
19812 | CTNMX0=0D0 | |
19813 | CTPMN0=0D0 | |
19814 | CTPMX0=1D0 | |
19815 | C...1) due to explicit limits | |
19816 | CTNMN1=MIN(0D0,CKIN(27)) | |
19817 | CTNMX1=MIN(0D0,CKIN(28)) | |
19818 | CTPMN1=MAX(0D0,CKIN(27)) | |
19819 | CTPMX1=MAX(0D0,CKIN(28)) | |
19820 | C...2) due to limits on pT-hat | |
19821 | CTNMN2=-SQRT(MAX(0D0,1D0-4D0*PTHMIN**2/(BE34**2*TAU*VINT(2)))) | |
19822 | CTPMX2=-CTNMN2 | |
19823 | CTNMX2=0D0 | |
19824 | CTPMN2=0D0 | |
19825 | IF(CKIN(4).GE.0D0) THEN | |
19826 | CTNMX2=-SQRT(MAX(0D0,1D0-4D0*CKIN(4)**2/ | |
19827 | & (BE34**2*TAU*VINT(2)))) | |
19828 | CTPMN2=-CTNMX2 | |
19829 | ENDIF | |
19830 | C...3) due to limits on y-large and y-small | |
19831 | CTNMN3=MIN(0D0,MAX((1D0+RM3-RM4)/BE34*TANH(CKIN11-YST), | |
19832 | & -(1D0-RM3+RM4)/BE34*TANH(CKIN10-YST))) | |
19833 | CTNMX3=MIN(0D0,(1D0+RM3-RM4)/BE34*TANH(CKIN12-YST), | |
19834 | & -(1D0-RM3+RM4)/BE34*TANH(CKIN09-YST)) | |
19835 | CTPMN3=MAX(0D0,(1D0+RM3-RM4)/BE34*TANH(CKIN09-YST), | |
19836 | & -(1D0-RM3+RM4)/BE34*TANH(CKIN12-YST)) | |
19837 | CTPMX3=MAX(0D0,MIN((1D0+RM3-RM4)/BE34*TANH(CKIN10-YST), | |
19838 | & -(1D0-RM3+RM4)/BE34*TANH(CKIN11-YST))) | |
19839 | C...4) due to limits on that | |
19840 | CTNMN4=-1D0 | |
19841 | CTNMX4=0D0 | |
19842 | CTPMN4=0D0 | |
19843 | CTPMX4=1D0 | |
19844 | SH=TAU*VINT(2) | |
19845 | IF(CKIN(35).GT.0D0) THEN | |
19846 | CTLIM=(1D0-RM3-RM4-2D0*CKIN(35)/SH)/BE34 | |
19847 | IF(CTLIM.GT.0D0) THEN | |
19848 | CTPMX4=CTLIM | |
19849 | ELSE | |
19850 | CTPMX4=0D0 | |
19851 | CTNMX4=CTLIM | |
19852 | ENDIF | |
19853 | ENDIF | |
19854 | IF(CKIN(36).GT.0D0) THEN | |
19855 | CTLIM=(1D0-RM3-RM4-2D0*CKIN(36)/SH)/BE34 | |
19856 | IF(CTLIM.LT.0D0) THEN | |
19857 | CTNMN4=CTLIM | |
19858 | ELSE | |
19859 | CTNMN4=0D0 | |
19860 | CTPMN4=CTLIM | |
19861 | ENDIF | |
19862 | ENDIF | |
19863 | C...5) due to limits on uhat | |
19864 | CTNMN5=-1D0 | |
19865 | CTNMX5=0D0 | |
19866 | CTPMN5=0D0 | |
19867 | CTPMX5=1D0 | |
19868 | IF(CKIN(37).GT.0D0) THEN | |
19869 | CTLIM=(2D0*CKIN(37)/SH-(1D0-RM3-RM4))/BE34 | |
19870 | IF(CTLIM.LT.0D0) THEN | |
19871 | CTNMN5=CTLIM | |
19872 | ELSE | |
19873 | CTNMN5=0D0 | |
19874 | CTPMN5=CTLIM | |
19875 | ENDIF | |
19876 | ENDIF | |
19877 | IF(CKIN(38).GT.0D0) THEN | |
19878 | CTLIM=(2D0*CKIN(38)/SH-(1D0-RM3-RM4))/BE34 | |
19879 | IF(CTLIM.GT.0D0) THEN | |
19880 | CTPMX5=CTLIM | |
19881 | ELSE | |
19882 | CTPMX5=0D0 | |
19883 | CTNMX5=CTLIM | |
19884 | ENDIF | |
19885 | ENDIF | |
19886 | ||
19887 | C...Net effect of all separate limits. | |
19888 | VINT(13)=MAX(CTNMN0,CTNMN1,CTNMN2,CTNMN3,CTNMN4,CTNMN5) | |
19889 | VINT(33)=MIN(CTNMX0,CTNMX1,CTNMX2,CTNMX3,CTNMX4,CTNMX5) | |
19890 | VINT(14)=MAX(CTPMN0,CTPMN1,CTPMN2,CTPMN3,CTPMN4,CTPMN5) | |
19891 | VINT(34)=MIN(CTPMX0,CTPMX1,CTPMX2,CTPMX3,CTPMX4,CTPMX5) | |
19892 | IF(VINT(33).LE.VINT(13).AND.VINT(34).LE.VINT(14)) MINT(51)=1 | |
19893 | ||
19894 | ELSEIF(ILIM.EQ.4) THEN | |
19895 | C...Calculate limits on tau' | |
19896 | C...0) due to kinematics | |
19897 | TAPMN0=TAU | |
19898 | IF(ISTSB.EQ.5.AND.KFPR(ISUB,2).GT.0) THEN | |
19899 | PQRAT=2D0*PMAS(PYCOMP(KFPR(ISUB,2)),1)/VINT(1) | |
19900 | TAPMN0=(SQRT(TAU)+PQRAT)**2 | |
19901 | ENDIF | |
19902 | TAPMX0=1D0 | |
19903 | C...1) due to explicit limits | |
19904 | TAPMN1=CKIN(31)**2/VINT(2) | |
19905 | TAPMX1=1D0 | |
19906 | IF(CKIN(32).GE.0D0) TAPMX1=CKIN(32)**2/VINT(2) | |
19907 | ||
19908 | C...Net effect of all separate limits. | |
19909 | VINT(16)=MAX(TAPMN0,TAPMN1) | |
19910 | VINT(36)=MIN(TAPMX0,TAPMX1) | |
19911 | IF(MINT(47).EQ.1) THEN | |
19912 | VINT(16)=1D0-1D-9 | |
19913 | VINT(36)=1D0+1D-9 | |
19914 | ELSEIF(MINT(47).EQ.5) THEN | |
19915 | VINT(36)=MIN(VINT(36),1D0-2D-10) | |
19916 | ELSEIF(MINT(47).EQ.6.OR.MINT(47).EQ.7) THEN | |
19917 | VINT(36)=MIN(VINT(36),1D0-1D-10) | |
19918 | ENDIF | |
19919 | IF(VINT(36).LE.VINT(16)) MINT(51)=1 | |
19920 | ||
19921 | ENDIF | |
19922 | RETURN | |
19923 | ||
19924 | C...Special case for low-pT and multiple interactions: | |
19925 | C...effective kinematical limits for tau, y*, cos(theta-hat). | |
19926 | 100 IF(ILIM.EQ.0) THEN | |
19927 | ELSEIF(ILIM.EQ.1) THEN | |
19928 | IF(MSTP(82).LE.1) THEN | |
19929 | VINT(11)=4D0*(PARP(81)*(VINT(1)/PARP(89))**PARP(90))**2/ | |
19930 | & VINT(2) | |
19931 | ELSE | |
19932 | VINT(11)=(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/VINT(2) | |
19933 | ENDIF | |
19934 | VINT(31)=1D0 | |
19935 | ELSEIF(ILIM.EQ.2) THEN | |
19936 | VINT(12)=0.5D0*LOG(VINT(21)) | |
19937 | VINT(32)=-VINT(12) | |
19938 | ELSEIF(ILIM.EQ.3) THEN | |
19939 | IF(MSTP(82).LE.1) THEN | |
19940 | ST2EFF=4D0*(PARP(81)*(VINT(1)/PARP(89))**PARP(90))**2/ | |
19941 | & (VINT(21)*VINT(2)) | |
19942 | ELSE | |
19943 | ST2EFF=0.01D0*(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/ | |
19944 | & (VINT(21)*VINT(2)) | |
19945 | ENDIF | |
19946 | VINT(13)=-SQRT(MAX(0D0,1D0-ST2EFF)) | |
19947 | VINT(33)=0D0 | |
19948 | VINT(14)=0D0 | |
19949 | VINT(34)=-VINT(13) | |
19950 | ENDIF | |
19951 | ||
19952 | RETURN | |
19953 | END | |
19954 | ||
19955 | C********************************************************************* | |
19956 | ||
19957 | C...PYKMAP | |
19958 | C...Maps a uniform distribution into a distribution of a kinematical | |
19959 | C...variable according to one of the possibilities allowed. It is | |
19960 | C...assumed that kinematical limits have been set by a PYKLIM call. | |
19961 | ||
19962 | SUBROUTINE PYKMAP(IVAR,MVAR,VVAR) | |
19963 | ||
19964 | C...Double precision and integer declarations. | |
19965 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
19966 | IMPLICIT INTEGER(I-N) | |
19967 | INTEGER PYK,PYCHGE,PYCOMP | |
19968 | C...Commonblocks. | |
19969 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
19970 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
19971 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
19972 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
19973 | COMMON/PYINT1/MINT(400),VINT(400) | |
19974 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
19975 | SAVE /PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/ | |
19976 | ||
19977 | C...Convert VVAR to tau variable. | |
19978 | ISUB=MINT(1) | |
19979 | ISTSB=ISET(ISUB) | |
19980 | IF(IVAR.EQ.1) THEN | |
19981 | TAUMIN=VINT(11) | |
19982 | TAUMAX=VINT(31) | |
19983 | IF(MVAR.EQ.3.OR.MVAR.EQ.4) THEN | |
19984 | TAURE=VINT(73) | |
19985 | GAMRE=VINT(74) | |
19986 | ELSEIF(MVAR.EQ.5.OR.MVAR.EQ.6) THEN | |
19987 | TAURE=VINT(75) | |
19988 | GAMRE=VINT(76) | |
19989 | ENDIF | |
19990 | IF(MINT(47).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2)) THEN | |
19991 | TAU=1D0 | |
19992 | ELSEIF(MVAR.EQ.1) THEN | |
19993 | TAU=TAUMIN*(TAUMAX/TAUMIN)**VVAR | |
19994 | ELSEIF(MVAR.EQ.2) THEN | |
19995 | TAU=TAUMAX*TAUMIN/(TAUMIN+(TAUMAX-TAUMIN)*VVAR) | |
19996 | ELSEIF(MVAR.EQ.3.OR.MVAR.EQ.5) THEN | |
19997 | RATGEN=(TAURE+TAUMAX)/(TAURE+TAUMIN)*TAUMIN/TAUMAX | |
19998 | TAU=TAURE*TAUMIN/((TAURE+TAUMIN)*RATGEN**VVAR-TAUMIN) | |
19999 | ELSEIF(MVAR.EQ.4.OR.MVAR.EQ.6) THEN | |
20000 | AUPP=ATAN((TAUMAX-TAURE)/GAMRE) | |
20001 | ALOW=ATAN((TAUMIN-TAURE)/GAMRE) | |
20002 | TAU=TAURE+GAMRE*TAN(ALOW+(AUPP-ALOW)*VVAR) | |
20003 | ELSEIF(MINT(47).EQ.5) THEN | |
20004 | AUPP=LOG(MAX(2D-10,1D0-TAUMAX)) | |
20005 | ALOW=LOG(MAX(2D-10,1D0-TAUMIN)) | |
20006 | TAU=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) | |
20007 | ELSE | |
20008 | AUPP=LOG(MAX(1D-10,1D0-TAUMAX)) | |
20009 | ALOW=LOG(MAX(1D-10,1D0-TAUMIN)) | |
20010 | TAU=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) | |
20011 | ENDIF | |
20012 | VINT(21)=MIN(TAUMAX,MAX(TAUMIN,TAU)) | |
20013 | ||
20014 | C...Convert VVAR to y* variable. | |
20015 | ELSEIF(IVAR.EQ.2) THEN | |
20016 | YSTMIN=VINT(12) | |
20017 | YSTMAX=VINT(32) | |
20018 | TAUE=VINT(21) | |
20019 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINT(26) | |
20020 | IF(MINT(47).EQ.1) THEN | |
20021 | YST=0D0 | |
20022 | ELSEIF(MINT(47).EQ.2.OR.MINT(47).EQ.6) THEN | |
20023 | YST=-0.5D0*LOG(TAUE) | |
20024 | ELSEIF(MINT(47).EQ.3.OR.MINT(47).EQ.7) THEN | |
20025 | YST=0.5D0*LOG(TAUE) | |
20026 | ELSEIF(MVAR.EQ.1) THEN | |
20027 | YST=YSTMIN+(YSTMAX-YSTMIN)*SQRT(VVAR) | |
20028 | ELSEIF(MVAR.EQ.2) THEN | |
20029 | YST=YSTMAX-(YSTMAX-YSTMIN)*SQRT(1D0-VVAR) | |
20030 | ELSEIF(MVAR.EQ.3) THEN | |
20031 | AUPP=ATAN(EXP(YSTMAX)) | |
20032 | ALOW=ATAN(EXP(YSTMIN)) | |
20033 | YST=LOG(TAN(ALOW+(AUPP-ALOW)*VVAR)) | |
20034 | ELSEIF(MVAR.EQ.4) THEN | |
20035 | YST0=-0.5D0*LOG(TAUE) | |
20036 | AUPP=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)) | |
20037 | ALOW=LOG(MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) | |
20038 | YST=YST0-LOG(1D0+EXP(ALOW+VVAR*(AUPP-ALOW))) | |
20039 | ELSE | |
20040 | YST0=-0.5D0*LOG(TAUE) | |
20041 | AUPP=LOG(MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) | |
20042 | ALOW=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)) | |
20043 | YST=LOG(1D0+EXP(AUPP+VVAR*(ALOW-AUPP)))-YST0 | |
20044 | ENDIF | |
20045 | VINT(22)=MIN(YSTMAX,MAX(YSTMIN,YST)) | |
20046 | ||
20047 | C...Convert VVAR to cos(theta-hat) variable. | |
20048 | ELSEIF(IVAR.EQ.3) THEN | |
20049 | RM34=MAX(1D-20,2D0*VINT(63)*VINT(64)/(VINT(21)*VINT(2))**2) | |
20050 | RSQM=1D0+RM34 | |
20051 | IF(2D0*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001D0) | |
20052 | & RM34=MAX(RM34,2D0*VINT(71)**2/(VINT(21)*VINT(2))) | |
20053 | CTNMIN=VINT(13) | |
20054 | CTNMAX=VINT(33) | |
20055 | CTPMIN=VINT(14) | |
20056 | CTPMAX=VINT(34) | |
20057 | IF(MVAR.EQ.1) THEN | |
20058 | ANEG=CTNMAX-CTNMIN | |
20059 | APOS=CTPMAX-CTPMIN | |
20060 | IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
20061 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
20062 | CTH=CTNMIN+(CTNMAX-CTNMIN)*VCTN | |
20063 | ELSE | |
20064 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
20065 | CTH=CTPMIN+(CTPMAX-CTPMIN)*VCTP | |
20066 | ENDIF | |
20067 | ELSEIF(MVAR.EQ.2) THEN | |
20068 | RMNMIN=MAX(RM34,RSQM-CTNMIN) | |
20069 | RMNMAX=MAX(RM34,RSQM-CTNMAX) | |
20070 | RMPMIN=MAX(RM34,RSQM-CTPMIN) | |
20071 | RMPMAX=MAX(RM34,RSQM-CTPMAX) | |
20072 | ANEG=LOG(RMNMIN/RMNMAX) | |
20073 | APOS=LOG(RMPMIN/RMPMAX) | |
20074 | IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
20075 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
20076 | CTH=RSQM-RMNMIN*(RMNMAX/RMNMIN)**VCTN | |
20077 | ELSE | |
20078 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
20079 | CTH=RSQM-RMPMIN*(RMPMAX/RMPMIN)**VCTP | |
20080 | ENDIF | |
20081 | ELSEIF(MVAR.EQ.3) THEN | |
20082 | RMNMIN=MAX(RM34,RSQM+CTNMIN) | |
20083 | RMNMAX=MAX(RM34,RSQM+CTNMAX) | |
20084 | RMPMIN=MAX(RM34,RSQM+CTPMIN) | |
20085 | RMPMAX=MAX(RM34,RSQM+CTPMAX) | |
20086 | ANEG=LOG(RMNMAX/RMNMIN) | |
20087 | APOS=LOG(RMPMAX/RMPMIN) | |
20088 | IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
20089 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
20090 | CTH=RMNMIN*(RMNMAX/RMNMIN)**VCTN-RSQM | |
20091 | ELSE | |
20092 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
20093 | CTH=RMPMIN*(RMPMAX/RMPMIN)**VCTP-RSQM | |
20094 | ENDIF | |
20095 | ELSEIF(MVAR.EQ.4) THEN | |
20096 | RMNMIN=MAX(RM34,RSQM-CTNMIN) | |
20097 | RMNMAX=MAX(RM34,RSQM-CTNMAX) | |
20098 | RMPMIN=MAX(RM34,RSQM-CTPMIN) | |
20099 | RMPMAX=MAX(RM34,RSQM-CTPMAX) | |
20100 | ANEG=1D0/RMNMAX-1D0/RMNMIN | |
20101 | APOS=1D0/RMPMAX-1D0/RMPMIN | |
20102 | IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
20103 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
20104 | CTH=RSQM-1D0/(1D0/RMNMIN+ANEG*VCTN) | |
20105 | ELSE | |
20106 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
20107 | CTH=RSQM-1D0/(1D0/RMPMIN+APOS*VCTP) | |
20108 | ENDIF | |
20109 | ELSEIF(MVAR.EQ.5) THEN | |
20110 | RMNMIN=MAX(RM34,RSQM+CTNMIN) | |
20111 | RMNMAX=MAX(RM34,RSQM+CTNMAX) | |
20112 | RMPMIN=MAX(RM34,RSQM+CTPMIN) | |
20113 | RMPMAX=MAX(RM34,RSQM+CTPMAX) | |
20114 | ANEG=1D0/RMNMIN-1D0/RMNMAX | |
20115 | APOS=1D0/RMPMIN-1D0/RMPMAX | |
20116 | IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
20117 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
20118 | CTH=1D0/(1D0/RMNMIN-ANEG*VCTN)-RSQM | |
20119 | ELSE | |
20120 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
20121 | CTH=1D0/(1D0/RMPMIN-APOS*VCTP)-RSQM | |
20122 | ENDIF | |
20123 | ENDIF | |
20124 | IF(CTH.LT.0D0) CTH=MIN(CTNMAX,MAX(CTNMIN,CTH)) | |
20125 | IF(CTH.GT.0D0) CTH=MIN(CTPMAX,MAX(CTPMIN,CTH)) | |
20126 | VINT(23)=CTH | |
20127 | ||
20128 | C...Convert VVAR to tau' variable. | |
20129 | ELSEIF(IVAR.EQ.4) THEN | |
20130 | TAU=VINT(21) | |
20131 | TAUPMN=VINT(16) | |
20132 | TAUPMX=VINT(36) | |
20133 | IF(MINT(47).EQ.1) THEN | |
20134 | TAUP=1D0 | |
20135 | ELSEIF(MVAR.EQ.1) THEN | |
20136 | TAUP=TAUPMN*(TAUPMX/TAUPMN)**VVAR | |
20137 | ELSEIF(MVAR.EQ.2) THEN | |
20138 | AUPP=(1D0-TAU/TAUPMX)**4 | |
20139 | ALOW=(1D0-TAU/TAUPMN)**4 | |
20140 | TAUP=TAU/MAX(1D-10,1D0-(ALOW+(AUPP-ALOW)*VVAR)**0.25D0) | |
20141 | ELSEIF(MINT(47).EQ.5) THEN | |
20142 | AUPP=LOG(MAX(2D-10,1D0-TAUPMX)) | |
20143 | ALOW=LOG(MAX(2D-10,1D0-TAUPMN)) | |
20144 | TAUP=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) | |
20145 | ELSE | |
20146 | AUPP=LOG(MAX(1D-10,1D0-TAUPMX)) | |
20147 | ALOW=LOG(MAX(1D-10,1D0-TAUPMN)) | |
20148 | TAUP=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) | |
20149 | ENDIF | |
20150 | VINT(26)=MIN(TAUPMX,MAX(TAUPMN,TAUP)) | |
20151 | ||
20152 | C...Selection of extra variables needed in 2 -> 3 process: | |
20153 | C...pT1, pT2, phi1, phi2, y3 for three outgoing particles. | |
20154 | C...Since no options are available, the functions of PYKLIM | |
20155 | C...and PYKMAP are joint for these choices. | |
20156 | ELSEIF(IVAR.EQ.5) THEN | |
20157 | ||
20158 | C...Read out total energy and particle masses. | |
20159 | MINT(51)=0 | |
20160 | MPTPK=1 | |
20161 | IF(ISUB.EQ.123.OR.ISUB.EQ.124.OR.ISUB.EQ.173.OR.ISUB.EQ.174 | |
20162 | & .OR.ISUB.EQ.178.OR.ISUB.EQ.179.OR.ISUB.EQ.351.OR.ISUB.EQ.352) | |
20163 | & MPTPK=2 | |
20164 | SHP=VINT(26)*VINT(2) | |
20165 | SHPR=SQRT(SHP) | |
20166 | PM1=VINT(201) | |
20167 | PM2=VINT(206) | |
20168 | PM3=SQRT(VINT(21))*VINT(1) | |
20169 | IF(PM1+PM2+PM3.GT.0.9999D0*SHPR) THEN | |
20170 | MINT(51)=1 | |
20171 | RETURN | |
20172 | ENDIF | |
20173 | PMRS1=VINT(204)**2 | |
20174 | PMRS2=VINT(209)**2 | |
20175 | ||
20176 | C...Specify coefficients of pT choice; upper and lower limits. | |
20177 | IF(MPTPK.EQ.1) THEN | |
20178 | HWT1=0.4D0 | |
20179 | HWT2=0.4D0 | |
20180 | ELSE | |
20181 | HWT1=0.05D0 | |
20182 | HWT2=0.05D0 | |
20183 | ENDIF | |
20184 | HWT3=1D0-HWT1-HWT2 | |
20185 | PTSMX1=((SHP-PM1**2-(PM2+PM3)**2)**2-(2D0*PM1*(PM2+PM3))**2)/ | |
20186 | & (4D0*SHP) | |
20187 | IF(CKIN(52).GT.0D0) PTSMX1=MIN(PTSMX1,CKIN(52)**2) | |
20188 | PTSMN1=CKIN(51)**2 | |
20189 | PTSMX2=((SHP-PM2**2-(PM1+PM3)**2)**2-(2D0*PM2*(PM1+PM3))**2)/ | |
20190 | & (4D0*SHP) | |
20191 | IF(CKIN(54).GT.0D0) PTSMX2=MIN(PTSMX2,CKIN(54)**2) | |
20192 | PTSMN2=CKIN(53)**2 | |
20193 | ||
20194 | C...Select transverse momenta according to | |
20195 | C...dp_T^2 * (a + b/(M^2 + p_T^2) + c/(M^2 + p_T^2)^2). | |
20196 | HMX=PMRS1+PTSMX1 | |
20197 | HMN=PMRS1+PTSMN1 | |
20198 | IF(HMX.LT.1.0001D0*HMN) THEN | |
20199 | MINT(51)=1 | |
20200 | RETURN | |
20201 | ENDIF | |
20202 | HDE=PTSMX1-PTSMN1 | |
20203 | RPT=PYR(0) | |
20204 | IF(RPT.LT.HWT1) THEN | |
20205 | PTS1=PTSMN1+PYR(0)*HDE | |
20206 | ELSEIF(RPT.LT.HWT1+HWT2) THEN | |
20207 | PTS1=MAX(PTSMN1,HMN*(HMX/HMN)**PYR(0)-PMRS1) | |
20208 | ELSE | |
20209 | PTS1=MAX(PTSMN1,HMN*HMX/(HMN+PYR(0)*HDE)-PMRS1) | |
20210 | ENDIF | |
20211 | WTPTS1=HDE/(HWT1+HWT2*HDE/(LOG(HMX/HMN)*(PMRS1+PTS1))+ | |
20212 | & HWT3*HMN*HMX/(PMRS1+PTS1)**2) | |
20213 | HMX=PMRS2+PTSMX2 | |
20214 | HMN=PMRS2+PTSMN2 | |
20215 | IF(HMX.LT.1.0001D0*HMN) THEN | |
20216 | MINT(51)=1 | |
20217 | RETURN | |
20218 | ENDIF | |
20219 | HDE=PTSMX2-PTSMN2 | |
20220 | RPT=PYR(0) | |
20221 | IF(RPT.LT.HWT1) THEN | |
20222 | PTS2=PTSMN2+PYR(0)*HDE | |
20223 | ELSEIF(RPT.LT.HWT1+HWT2) THEN | |
20224 | PTS2=MAX(PTSMN2,HMN*(HMX/HMN)**PYR(0)-PMRS2) | |
20225 | ELSE | |
20226 | PTS2=MAX(PTSMN2,HMN*HMX/(HMN+PYR(0)*HDE)-PMRS2) | |
20227 | ENDIF | |
20228 | WTPTS2=HDE/(HWT1+HWT2*HDE/(LOG(HMX/HMN)*(PMRS2+PTS2))+ | |
20229 | & HWT3*HMN*HMX/(PMRS2+PTS2)**2) | |
20230 | ||
20231 | C...Select azimuthal angles and check pT choice. | |
20232 | PHI1=PARU(2)*PYR(0) | |
20233 | PHI2=PARU(2)*PYR(0) | |
20234 | PHIR=PHI2-PHI1 | |
20235 | PTS3=MAX(0D0,PTS1+PTS2+2D0*SQRT(PTS1*PTS2)*COS(PHIR)) | |
20236 | IF(PTS3.LT.CKIN(55)**2.OR.(CKIN(56).GT.0D0.AND.PTS3.GT. | |
20237 | & CKIN(56)**2)) THEN | |
20238 | MINT(51)=1 | |
20239 | RETURN | |
20240 | ENDIF | |
20241 | ||
20242 | C...Calculate transverse masses and check phase space not closed. | |
20243 | PMS1=PM1**2+PTS1 | |
20244 | PMS2=PM2**2+PTS2 | |
20245 | PMS3=PM3**2+PTS3 | |
20246 | PMT1=SQRT(PMS1) | |
20247 | PMT2=SQRT(PMS2) | |
20248 | PMT3=SQRT(PMS3) | |
20249 | PM12=(PMT1+PMT2)**2 | |
20250 | IF(PMT1+PMT2+PMT3.GT.0.9999D0*SHPR) THEN | |
20251 | MINT(51)=1 | |
20252 | RETURN | |
20253 | ENDIF | |
20254 | ||
20255 | C...Select rapidity for particle 3 and check phase space not closed. | |
20256 | Y3MAX=LOG((SHP+PMS3-PM12+SQRT(MAX(0D0,(SHP-PMS3-PM12)**2- | |
20257 | & 4D0*PMS3*PM12)))/(2D0*SHPR*PMT3)) | |
20258 | IF(Y3MAX.LT.1D-6) THEN | |
20259 | MINT(51)=1 | |
20260 | RETURN | |
20261 | ENDIF | |
20262 | Y3=(2D0*PYR(0)-1D0)*0.999999D0*Y3MAX | |
20263 | PZ3=PMT3*SINH(Y3) | |
20264 | PE3=PMT3*COSH(Y3) | |
20265 | ||
20266 | C...Find momentum transfers in two mirror solutions (in 1-2 frame). | |
20267 | PZ12=-PZ3 | |
20268 | PE12=SHPR-PE3 | |
20269 | PMS12=PE12**2-PZ12**2 | |
20270 | SQL12=SQRT(MAX(0D0,(PMS12-PMS1-PMS2)**2-4D0*PMS1*PMS2)) | |
20271 | IF(SQL12.LT.1D-6*SHP) THEN | |
20272 | MINT(51)=1 | |
20273 | RETURN | |
20274 | ENDIF | |
20275 | PMM1=PMS12+PMS1-PMS2 | |
20276 | PMM2=PMS12+PMS2-PMS1 | |
20277 | TFAC=-SHPR/(2D0*PMS12) | |
20278 | T1P=TFAC*(PE12-PZ12)*(PMM1-SQL12) | |
20279 | T1N=TFAC*(PE12-PZ12)*(PMM1+SQL12) | |
20280 | T2P=TFAC*(PE12+PZ12)*(PMM2-SQL12) | |
20281 | T2N=TFAC*(PE12+PZ12)*(PMM2+SQL12) | |
20282 | ||
20283 | C...Construct relative mirror weights and make choice. | |
20284 | IF(MPTPK.EQ.1.OR.ISUB.EQ.351.OR.ISUB.EQ.352) THEN | |
20285 | WTPU=1D0 | |
20286 | WTNU=1D0 | |
20287 | ELSE | |
20288 | WTPU=1D0/((T1P-PMRS1)*(T2P-PMRS2))**2 | |
20289 | WTNU=1D0/((T1N-PMRS1)*(T2N-PMRS2))**2 | |
20290 | ENDIF | |
20291 | WTP=WTPU/(WTPU+WTNU) | |
20292 | WTN=WTNU/(WTPU+WTNU) | |
20293 | EPS=1D0 | |
20294 | IF(WTN.GT.PYR(0)) EPS=-1D0 | |
20295 | ||
20296 | C...Store result of variable choice and associated weights. | |
20297 | VINT(202)=PTS1 | |
20298 | VINT(207)=PTS2 | |
20299 | VINT(203)=PHI1 | |
20300 | VINT(208)=PHI2 | |
20301 | VINT(205)=WTPTS1 | |
20302 | VINT(210)=WTPTS2 | |
20303 | VINT(211)=Y3 | |
20304 | VINT(212)=Y3MAX | |
20305 | VINT(213)=EPS | |
20306 | IF(EPS.GT.0D0) THEN | |
20307 | VINT(214)=1D0/WTP | |
20308 | VINT(215)=T1P | |
20309 | VINT(216)=T2P | |
20310 | ELSE | |
20311 | VINT(214)=1D0/WTN | |
20312 | VINT(215)=T1N | |
20313 | VINT(216)=T2N | |
20314 | ENDIF | |
20315 | VINT(217)=-0.5D0*TFAC*(PE12-PZ12)*(PMM2+EPS*SQL12) | |
20316 | VINT(218)=-0.5D0*TFAC*(PE12+PZ12)*(PMM1+EPS*SQL12) | |
20317 | VINT(219)=0.5D0*(PMS12-PTS3) | |
20318 | VINT(220)=SQL12 | |
20319 | ENDIF | |
20320 | ||
20321 | RETURN | |
20322 | END | |
20323 | ||
20324 | C*********************************************************************** | |
20325 | ||
20326 | C...PYSIGH | |
20327 | C...Differential matrix elements for all included subprocesses | |
20328 | C...Note that what is coded is (disregarding the COMFAC factor) | |
20329 | C...1) for 2 -> 1 processes: s-hat/pi*d(sigma-hat), where, | |
20330 | C...when d(sigma-hat) is given in the zero-width limit, the delta | |
20331 | C...function in tau is replaced by a (modified) Breit-Wigner: | |
20332 | C...1/pi*s*H_res/((s*tau-m_res^2)^2+H_res^2), | |
20333 | C...where H_res = s-hat/m_res*Gamma_res(s-hat); | |
20334 | C...2) for 2 -> 2 processes: (s-hat)**2/pi*d(sigma-hat)/d(t-hat); | |
20335 | C...i.e., dimensionless quantities | |
20336 | C...3) for 2 -> 3 processes: abs(M)^2, where the total cross-section is | |
20337 | C...Integral abs(M)^2/(2shat') * (prod_(i=1)^3 d^3p_i/((2pi)^3*2E_i)) * | |
20338 | C...(2pi)^4 delta^4(P - sum p_i) | |
20339 | C...COMFAC contains the factor pi/s (or equivalent) and | |
20340 | C...the conversion factor from GeV^-2 to mb | |
20341 | ||
20342 | SUBROUTINE PYSIGH(NCHN,SIGS) | |
20343 | ||
20344 | C...Double precision and integer declarations | |
20345 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
20346 | IMPLICIT INTEGER(I-N) | |
20347 | INTEGER PYK,PYCHGE,PYCOMP | |
20348 | C...Parameter statement to help give large particle numbers. | |
20349 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
20350 | &KEXCIT=4000000,KDIMEN=5000000) | |
20351 | C...Commonblocks | |
20352 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
20353 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
20354 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
20355 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
20356 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
20357 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
20358 | COMMON/PYINT1/MINT(400),VINT(400) | |
20359 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
20360 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
20361 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
20362 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
20363 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
20364 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
20365 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
20366 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
20367 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
20368 | COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, | |
20369 | &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, | |
20370 | &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, | |
20371 | &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR | |
20372 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, | |
20373 | &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/, | |
20374 | &/PYMSSM/,/PYSSMT/,/PYTCSM/,/PYSGCM/ | |
20375 | C...Local arrays and complex variables | |
20376 | DIMENSION X(2),XPQ(-25:25) | |
20377 | ||
20378 | C...Map of processes onto which routine to call | |
20379 | C...in order to evaluate cross section: | |
20380 | C...0 = not implemented; | |
20381 | C...1 = standard QCD (including photons); | |
20382 | C...2 = heavy flavours; | |
20383 | C...3 = W/Z; | |
20384 | C...4 = Higgs (2 doublets; including longitudinal W/Z scattering); | |
20385 | C...5 = SUSY; | |
20386 | C...6 = Technicolor; | |
20387 | C...7 = exotics (Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*). | |
20388 | DIMENSION MAPPR(500) | |
20389 | DATA (MAPPR(I),I=1,180)/ | |
20390 | & 3, 3, 4, 0, 4, 0, 0, 4, 0, 1, | |
20391 | 1 1, 1, 1, 1, 3, 3, 0, 1, 3, 3, | |
20392 | 2 0, 3, 3, 4, 3, 4, 0, 1, 1, 3, | |
20393 | 3 3, 4, 1, 1, 3, 3, 0, 0, 0, 0, | |
20394 | 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
20395 | 5 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, | |
20396 | 6 0, 0, 0, 0, 0, 0, 0, 1, 3, 3, | |
20397 | 7 4, 4, 4, 0, 0, 4, 4, 0, 0, 1, | |
20398 | 8 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, | |
20399 | 9 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, | |
20400 | & 0, 4, 4, 2, 2, 2, 2, 2, 0, 4, | |
20401 | 1 4, 4, 4, 1, 1, 0, 0, 0, 0, 0, | |
20402 | 2 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, | |
20403 | 3 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, | |
20404 | 4 7, 7, 4, 7, 7, 7, 7, 7, 6, 0, | |
20405 | 5 4, 4, 4, 0, 0, 4, 4, 4, 0, 0, | |
20406 | 6 4, 7, 7, 7, 6, 6, 7, 7, 7, 0, | |
20407 | 7 4, 4, 4, 4, 0, 4, 4, 4, 4, 0/ | |
20408 | DATA (MAPPR(I),I=181,500)/ | |
20409 | 8 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, | |
20410 | 9 6, 6, 6, 6, 6, 0, 0, 0, 0, 0, | |
20411 | & 100*5, | |
20412 | & 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
20413 | 1 30*0, | |
20414 | 4 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, | |
20415 | 5 7, 7, 7, 7, 0, 0, 0, 0, 0, 0, | |
20416 | 6 6, 6, 6, 6, 6, 6, 6, 6, 0, 6, | |
20417 | 7 6, 6, 6, 6, 6, 6, 6, 0, 0, 0, | |
20418 | 8 6, 6, 6, 6, 6, 6, 6, 6, 0, 0, | |
20419 | 9 7, 7, 7, 7, 7, 0, 0, 0, 0, 0, | |
20420 | & 100*0/ | |
20421 | ||
20422 | C...Reset number of channels and cross-section | |
20423 | NCHN=0 | |
20424 | SIGS=0D0 | |
20425 | ||
20426 | C...Read process to consider. | |
20427 | ISUB=MINT(1) | |
20428 | ISUBSV=ISUB | |
20429 | MAP=MAPPR(ISUB) | |
20430 | ||
20431 | C...Read kinematical variables and limits | |
20432 | ISTSB=ISET(ISUBSV) | |
20433 | TAUMIN=VINT(11) | |
20434 | YSTMIN=VINT(12) | |
20435 | CTNMIN=VINT(13) | |
20436 | CTPMIN=VINT(14) | |
20437 | TAUPMN=VINT(16) | |
20438 | TAU=VINT(21) | |
20439 | YST=VINT(22) | |
20440 | CTH=VINT(23) | |
20441 | XT2=VINT(25) | |
20442 | TAUP=VINT(26) | |
20443 | TAUMAX=VINT(31) | |
20444 | YSTMAX=VINT(32) | |
20445 | CTNMAX=VINT(33) | |
20446 | CTPMAX=VINT(34) | |
20447 | TAUPMX=VINT(36) | |
20448 | ||
20449 | C...Derive kinematical quantities | |
20450 | TAUE=TAU | |
20451 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP | |
20452 | X(1)=SQRT(TAUE)*EXP(YST) | |
20453 | X(2)=SQRT(TAUE)*EXP(-YST) | |
20454 | IF(MINT(45).EQ.2.AND.ISTSB.GE.1) THEN | |
20455 | IF(X(1).GT.1D0-1D-7) RETURN | |
20456 | ELSEIF(MINT(45).EQ.3) THEN | |
20457 | X(1)=MIN(1D0-1.1D-10,X(1)) | |
20458 | ENDIF | |
20459 | IF(MINT(46).EQ.2.AND.ISTSB.GE.1) THEN | |
20460 | IF(X(2).GT.1D0-1D-7) RETURN | |
20461 | ELSEIF(MINT(46).EQ.3) THEN | |
20462 | X(2)=MIN(1D0-1.1D-10,X(2)) | |
20463 | ENDIF | |
20464 | SH=MAX(1D0,TAU*VINT(2)) | |
20465 | SQM3=VINT(63) | |
20466 | SQM4=VINT(64) | |
20467 | RM3=SQM3/SH | |
20468 | RM4=SQM4/SH | |
20469 | BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) | |
20470 | RPTS=4D0*VINT(71)**2/SH | |
20471 | BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) | |
20472 | RM34=MAX(1D-20,2D0*RM3*RM4) | |
20473 | RSQM=1D0+RM34 | |
20474 | IF(2D0*VINT(71)**2/MAX(1D0,VINT(21)*VINT(2)).LT.0.0001D0) | |
20475 | &RM34=MAX(RM34,2D0*VINT(71)**2/MAX(1D0,VINT(21)*VINT(2))) | |
20476 | RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) | |
20477 | IF(ISTSB.EQ.0) THEN | |
20478 | TH=VINT(45) | |
20479 | UH=-0.5D0*SH*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) | |
20480 | SQPTH=MAX(VINT(71)**2,0.25D0*SH*BE34**2*VINT(59)**2) | |
20481 | ELSE | |
20482 | C...Kinematics with incoming masses tricky: now depends on how | |
20483 | C...subprocess has been set up w.r.t. order of incoming partons. | |
20484 | RM1=0D0 | |
20485 | IF(MINT(15).EQ.22.AND.VINT(3).LT.0D0) RM1=-VINT(3)**2/SH | |
20486 | RM2=0D0 | |
20487 | IF(MINT(16).EQ.22.AND.VINT(4).LT.0D0) RM2=-VINT(4)**2/SH | |
20488 | IF(ISUB.EQ.35) THEN | |
20489 | RM2=MIN(RM1,RM2) | |
20490 | RM1=0D0 | |
20491 | ENDIF | |
20492 | BE12=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
20493 | TUCOM=(1D0-RM1-RM2)*(1D0-RM3-RM4) | |
20494 | TH=-0.5D0*SH*MAX(RTHM,TUCOM-2D0*RM1*RM4-2D0*RM2*RM3- | |
20495 | & BE12*BE34*CTH) | |
20496 | UH=-0.5D0*SH*MAX(RTHM,TUCOM-2D0*RM1*RM3-2D0*RM2*RM4+ | |
20497 | & BE12*BE34*CTH) | |
20498 | SQPTH=MAX(VINT(71)**2,0.25D0*SH*BE34**2*(1D0-CTH**2)) | |
20499 | ENDIF | |
20500 | SHR=SQRT(SH) | |
20501 | SH2=SH**2 | |
20502 | TH2=TH**2 | |
20503 | UH2=UH**2 | |
20504 | ||
20505 | C...Choice of Q2 scale: hard, parton distributions, parton showers | |
20506 | IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN | |
20507 | Q2=SH | |
20508 | ELSEIF(ISTSB.EQ.8) THEN | |
20509 | IF(MINT(107).EQ.4) Q2=VINT(307) | |
20510 | IF(MINT(108).EQ.4) Q2=VINT(308) | |
20511 | ELSEIF(MOD(ISTSB,2).EQ.0.OR.ISTSB.EQ.9) THEN | |
20512 | Q2IN1=0D0 | |
20513 | IF(MINT(11).EQ.22.AND.VINT(3).LT.0D0) Q2IN1=VINT(3)**2 | |
20514 | Q2IN2=0D0 | |
20515 | IF(MINT(12).EQ.22.AND.VINT(4).LT.0D0) Q2IN2=VINT(4)**2 | |
20516 | IF(MSTP(32).EQ.1) THEN | |
20517 | Q2=2D0*SH*TH*UH/(SH**2+TH**2+UH**2) | |
20518 | ELSEIF(MSTP(32).EQ.2) THEN | |
20519 | Q2=SQPTH+0.5D0*(SQM3+SQM4) | |
20520 | ELSEIF(MSTP(32).EQ.3) THEN | |
20521 | Q2=MIN(-TH,-UH) | |
20522 | ELSEIF(MSTP(32).EQ.4) THEN | |
20523 | Q2=SH | |
20524 | ELSEIF(MSTP(32).EQ.5) THEN | |
20525 | Q2=-TH | |
20526 | ELSEIF(MSTP(32).EQ.6) THEN | |
20527 | XSF1=X(1) | |
20528 | IF(ISTSB.EQ.9) XSF1=X(1)/VINT(143) | |
20529 | XSF2=X(2) | |
20530 | IF(ISTSB.EQ.9) XSF2=X(2)/VINT(144) | |
20531 | Q2=(1D0+XSF1*Q2IN1/SH+XSF2*Q2IN2/SH)* | |
20532 | & (SQPTH+0.5D0*(SQM3+SQM4)) | |
20533 | ELSEIF(MSTP(32).EQ.7) THEN | |
20534 | Q2=(1D0+Q2IN1/SH+Q2IN2/SH)*(SQPTH+0.5D0*(SQM3+SQM4)) | |
20535 | ELSEIF(MSTP(32).EQ.8) THEN | |
20536 | Q2=SQPTH+0.5D0*(Q2IN1+Q2IN2+SQM3+SQM4) | |
20537 | ELSEIF(MSTP(32).EQ.9) THEN | |
20538 | Q2=SQPTH+Q2IN1+Q2IN2+SQM3+SQM4 | |
20539 | ELSEIF(MSTP(32).EQ.10) THEN | |
20540 | Q2=VINT(2) | |
20541 | ENDIF | |
20542 | IF(ISTSB.EQ.9) Q2=SQPTH | |
20543 | IF(ISTSB.EQ.9.AND.MSTP(82).GE.2) Q2=Q2+ | |
20544 | & (PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2 | |
20545 | ENDIF | |
20546 | Q2SF=Q2 | |
20547 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN | |
20548 | Q2SF=PMAS(23,1)**2 | |
20549 | IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77.OR.ISUB.EQ.124.OR. | |
20550 | & ISUB.EQ.351) Q2SF=PMAS(24,1)**2 | |
20551 | IF(ISUB.EQ.352) Q2SF=PMAS(PYCOMP(9900024),1)**2 | |
20552 | IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182.OR. | |
20553 | & ISUB.EQ.186.OR.ISUB.EQ.187) THEN | |
20554 | Q2SF=PMAS(PYCOMP(KFPR(ISUBSV,2)),1)**2 | |
20555 | IF(MSTP(39).EQ.2) Q2SF=Q2SF+MAX(VINT(202),VINT(207)) | |
20556 | IF(MSTP(39).EQ.3) Q2SF=SH | |
20557 | IF(MSTP(39).EQ.4) Q2SF=VINT(26)*VINT(2) | |
20558 | IF(MSTP(39).EQ.5) Q2SF=PMAS(PYCOMP(KFPR(ISUBSV,1)),1)**2 | |
20559 | ENDIF | |
20560 | ENDIF | |
20561 | Q2PS=Q2SF | |
20562 | Q2SF=Q2SF*PARP(34) | |
20563 | IF(MSTP(69).GE.1.AND.MINT(47).EQ.5) Q2SF=VINT(2) | |
20564 | IF(MSTP(69).GE.2) Q2SF=VINT(2) | |
20565 | IF(MSTP(22).GE.1.AND.(ISUB.EQ.10.OR.ISUB.EQ.83).AND. | |
20566 | &(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN | |
20567 | XBJ=X(2) | |
20568 | IF(MINT(43).EQ.3) XBJ=X(1) | |
20569 | IF(MSTP(22).EQ.1) THEN | |
20570 | Q2PS=-TH | |
20571 | ELSEIF(MSTP(22).EQ.2) THEN | |
20572 | Q2PS=((1D0-XBJ)/XBJ)*(-TH) | |
20573 | ELSEIF(MSTP(22).EQ.3) THEN | |
20574 | Q2PS=SQRT((1D0-XBJ)/XBJ)*(-TH) | |
20575 | ELSE | |
20576 | Q2PS=(1D0-XBJ)*MAX(1D0,-LOG(XBJ))*(-TH) | |
20577 | ENDIF | |
20578 | ENDIF | |
20579 | IF(MSTP(68).EQ.1.AND.(ISUBSV.EQ.1.OR.ISUBSV.EQ.2.OR. | |
20580 | &ISUBSV.EQ.102.OR.ISUBSV.EQ.141.OR.ISUBSV.EQ.142.OR. | |
20581 | &ISUBSV.EQ.144.OR.ISUBSV.EQ.152.OR.ISUBSV.EQ.157)) THEN | |
20582 | Q2PS=VINT(2) | |
20583 | ELSEIF(MSTP(68).GE.2.AND.(ISUBSV.NE.11.AND.ISUBSV.NE.12.AND. | |
20584 | &ISUBSV.NE.13.AND.ISUBSV.NE.28.AND.ISUBSV.NE.53.AND. | |
20585 | &ISUBSV.NE.68)) THEN | |
20586 | Q2PS=VINT(2) | |
20587 | ENDIF | |
20588 | ||
20589 | C...Store derived kinematical quantities | |
20590 | VINT(41)=X(1) | |
20591 | VINT(42)=X(2) | |
20592 | VINT(44)=SH | |
20593 | VINT(43)=SQRT(SH) | |
20594 | VINT(45)=TH | |
20595 | VINT(46)=UH | |
20596 | IF(ISTSB.NE.8) VINT(48)=SQPTH | |
20597 | IF(ISTSB.NE.8) VINT(47)=SQRT(SQPTH) | |
20598 | VINT(50)=TAUP*VINT(2) | |
20599 | VINT(49)=SQRT(MAX(0D0,VINT(50))) | |
20600 | VINT(52)=Q2 | |
20601 | VINT(51)=SQRT(Q2) | |
20602 | VINT(54)=Q2SF | |
20603 | VINT(53)=SQRT(Q2SF) | |
20604 | VINT(56)=Q2PS | |
20605 | VINT(55)=SQRT(Q2PS) | |
20606 | ||
20607 | C...Calculate parton distributions | |
20608 | IF(ISTSB.LE.0) GOTO 160 | |
20609 | IF(MINT(47).GE.2) THEN | |
20610 | DO 110 I=3-MIN(2,MINT(45)),MIN(2,MINT(46)) | |
20611 | XSF=X(I) | |
20612 | IF(ISTSB.EQ.9) XSF=X(I)/VINT(142+I) | |
20613 | IF(ISUB.EQ.99) THEN | |
20614 | IF(MINT(140+I).EQ.0) THEN | |
20615 | XSF=VINT(309-I)/(VINT(2)+VINT(309-I)-VINT(I+2)**2) | |
20616 | ELSE | |
20617 | XSF=VINT(309-I)/(VINT(2)+VINT(307)+VINT(308)) | |
20618 | ENDIF | |
20619 | VINT(40+I)=XSF | |
20620 | Q2SF=VINT(309-I) | |
20621 | ENDIF | |
20622 | MINT(105)=MINT(102+I) | |
20623 | MINT(109)=MINT(106+I) | |
20624 | VINT(120)=VINT(2+I) | |
20625 | C.... ALICE | |
20626 | C.... Store side in MINT(124) | |
20627 | MINT(124)=I | |
20628 | C.... | |
20629 | IF(MSTP(57).LE.1) THEN | |
20630 | CALL PYPDFU(MINT(10+I),XSF,Q2SF,XPQ) | |
20631 | ELSE | |
20632 | CALL PYPDFL(MINT(10+I),XSF,Q2SF,XPQ) | |
20633 | ENDIF | |
20634 | DO 100 KFL=-25,25 | |
20635 | XSFX(I,KFL)=XPQ(KFL) | |
20636 | 100 CONTINUE | |
20637 | 110 CONTINUE | |
20638 | ENDIF | |
20639 | ||
20640 | C...Calculate alpha_em, alpha_strong and K-factor | |
20641 | XW=PARU(102) | |
20642 | XWV=XW | |
20643 | IF(MSTP(8).GE.2.OR.(ISUB.GE.71.AND.ISUB.LE.77)) XW= | |
20644 | &1D0-(PMAS(24,1)/PMAS(23,1))**2 | |
20645 | XW1=1D0-XW | |
20646 | XWC=1D0/(16D0*XW*XW1) | |
20647 | AEM=PYALEM(Q2) | |
20648 | IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) | |
20649 | IF(MSTP(33).NE.3) AS=PYALPS(PARP(34)*Q2) | |
20650 | FACK=1D0 | |
20651 | FACA=1D0 | |
20652 | IF(MSTP(33).EQ.1) THEN | |
20653 | FACK=PARP(31) | |
20654 | ELSEIF(MSTP(33).EQ.2) THEN | |
20655 | FACK=PARP(31) | |
20656 | FACA=PARP(32)/PARP(31) | |
20657 | ELSEIF(MSTP(33).EQ.3) THEN | |
20658 | Q2AS=PARP(33)*Q2 | |
20659 | IF(ISTSB.EQ.9.AND.MSTP(82).GE.2) Q2AS=Q2AS+ | |
20660 | & PARU(112)*PARP(82)*(VINT(1)/PARP(89))**PARP(90) | |
20661 | AS=PYALPS(Q2AS) | |
20662 | ENDIF | |
20663 | VINT(138)=1D0 | |
20664 | VINT(57)=AEM | |
20665 | VINT(58)=AS | |
20666 | ||
20667 | C...Set flags for allowed reacting partons/leptons | |
20668 | DO 140 I=1,2 | |
20669 | DO 120 J=-25,25 | |
20670 | KFAC(I,J)=0 | |
20671 | 120 CONTINUE | |
20672 | IF(MINT(44+I).EQ.1) THEN | |
20673 | KFAC(I,MINT(10+I))=1 | |
20674 | ELSEIF(MINT(40+I).EQ.1.AND.MSTP(12).EQ.0) THEN | |
20675 | KFAC(I,MINT(10+I))=1 | |
20676 | KFAC(I,22)=1 | |
20677 | KFAC(I,24)=1 | |
20678 | KFAC(I,-24)=1 | |
20679 | ELSE | |
20680 | DO 130 J=-25,25 | |
20681 | KFAC(I,J)=KFIN(I,J) | |
20682 | IF(IABS(J).GT.MSTP(58).AND.IABS(J).LE.10) KFAC(I,J)=0 | |
20683 | IF(XSFX(I,J).LT.1D-10) KFAC(I,J)=0 | |
20684 | 130 CONTINUE | |
20685 | ENDIF | |
20686 | 140 CONTINUE | |
20687 | ||
20688 | C...Lower and upper limit for fermion flavour loops | |
20689 | MMIN1=0 | |
20690 | MMAX1=0 | |
20691 | MMIN2=0 | |
20692 | MMAX2=0 | |
20693 | DO 150 J=-20,20 | |
20694 | IF(KFAC(1,-J).EQ.1) MMIN1=-J | |
20695 | IF(KFAC(1,J).EQ.1) MMAX1=J | |
20696 | IF(KFAC(2,-J).EQ.1) MMIN2=-J | |
20697 | IF(KFAC(2,J).EQ.1) MMAX2=J | |
20698 | 150 CONTINUE | |
20699 | MMINA=MIN(MMIN1,MMIN2) | |
20700 | MMAXA=MAX(MMAX1,MMAX2) | |
20701 | ||
20702 | C...Common resonance mass and width combinations | |
20703 | SQMZ=PMAS(23,1)**2 | |
20704 | SQMW=PMAS(24,1)**2 | |
20705 | GMMZ=PMAS(23,1)*PMAS(23,2) | |
20706 | GMMW=PMAS(24,1)*PMAS(24,2) | |
20707 | ||
20708 | C...Polarization factors...implemented so far for W+W-(25) | |
20709 | POLR=(1D0+PARJ(132))*(1D0-PARJ(131)) | |
20710 | POLL=(1D0-PARJ(132))*(1D0+PARJ(131)) | |
20711 | POLRR=(1D0+PARJ(132))*(1D0+PARJ(131)) | |
20712 | POLLL=(1D0-PARJ(132))*(1D0-PARJ(131)) | |
20713 | ||
20714 | C...Phase space integral in tau | |
20715 | COMFAC=PARU(1)*PARU(5)/VINT(2) | |
20716 | IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) COMFAC=COMFAC*FACK | |
20717 | IF((MINT(47).GE.2.OR.(ISTSB.GE.3.AND.ISTSB.LE.5)).AND. | |
20718 | &ISTSB.NE.8.AND.ISTSB.NE.9) THEN | |
20719 | ATAU1=LOG(TAUMAX/TAUMIN) | |
20720 | ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) | |
20721 | H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/TAU | |
20722 | IF(MINT(72).GE.1) THEN | |
20723 | TAUR1=VINT(73) | |
20724 | GAMR1=VINT(74) | |
20725 | ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1)) | |
20726 | ATAU3=ATAUD/TAUR1 | |
20727 | IF(ATAUD.GT.1D-10) H1=H1+ | |
20728 | & (ATAU1/ATAU3)*COEF(ISUBSV,3)/(TAU+TAUR1) | |
20729 | ATAUD=ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1) | |
20730 | ATAU4=ATAUD/GAMR1 | |
20731 | IF(ATAUD.GT.1D-10) H1=H1+ | |
20732 | & (ATAU1/ATAU4)*COEF(ISUBSV,4)*TAU/((TAU-TAUR1)**2+GAMR1**2) | |
20733 | ENDIF | |
20734 | IF(MINT(72).EQ.2) THEN | |
20735 | TAUR2=VINT(75) | |
20736 | GAMR2=VINT(76) | |
20737 | ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2)) | |
20738 | ATAU5=ATAUD/TAUR2 | |
20739 | IF(ATAUD.GT.1D-10) H1=H1+ | |
20740 | & (ATAU1/ATAU5)*COEF(ISUBSV,5)/(TAU+TAUR2) | |
20741 | ATAUD=ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2) | |
20742 | ATAU6=ATAUD/GAMR2 | |
20743 | IF(ATAUD.GT.1D-10) H1=H1+ | |
20744 | & (ATAU1/ATAU6)*COEF(ISUBSV,6)*TAU/((TAU-TAUR2)**2+GAMR2**2) | |
20745 | ENDIF | |
20746 | IF(MINT(47).EQ.5.AND.(ISTSB.LE.2.OR.ISTSB.GE.5)) THEN | |
20747 | ATAU7=LOG(MAX(2D-10,1D0-TAUMIN)/MAX(2D-10,1D0-TAUMAX)) | |
20748 | IF(ATAU7.GT.1D-10) H1=H1+(ATAU1/ATAU7)*COEF(ISUBSV,7)*TAU/ | |
20749 | & MAX(2D-10,1D0-TAU) | |
20750 | ELSEIF(MINT(47).GE.6.AND.(ISTSB.LE.2.OR.ISTSB.GE.5)) THEN | |
20751 | ATAU7=LOG(MAX(1D-10,1D0-TAUMIN)/MAX(1D-10,1D0-TAUMAX)) | |
20752 | IF(ATAU7.GT.1D-10) H1=H1+(ATAU1/ATAU7)*COEF(ISUBSV,7)*TAU/ | |
20753 | & MAX(1D-10,1D0-TAU) | |
20754 | ENDIF | |
20755 | COMFAC=COMFAC*ATAU1/(TAU*H1) | |
20756 | ENDIF | |
20757 | ||
20758 | C...Phase space integral in y* | |
20759 | IF((MINT(47).EQ.4.OR.MINT(47).EQ.5).AND.ISTSB.NE.8.AND.ISTSB.NE.9) | |
20760 | &THEN | |
20761 | AYST0=YSTMAX-YSTMIN | |
20762 | IF(AYST0.LT.1D-10) THEN | |
20763 | COMFAC=0D0 | |
20764 | ELSE | |
20765 | AYST1=0.5D0*(YSTMAX-YSTMIN)**2 | |
20766 | AYST2=AYST1 | |
20767 | AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) | |
20768 | H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+ | |
20769 | & (AYST0/AYST2)*COEF(ISUBSV,9)*(YSTMAX-YST)+ | |
20770 | & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST) | |
20771 | IF(MINT(45).EQ.3) THEN | |
20772 | YST0=-0.5D0*LOG(TAUE) | |
20773 | AYST4=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)/ | |
20774 | & MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) | |
20775 | IF(AYST4.GT.1D-10) H2=H2+(AYST0/AYST4)*COEF(ISUBSV,11)/ | |
20776 | & MAX(1D-10,1D0-EXP(YST-YST0)) | |
20777 | ENDIF | |
20778 | IF(MINT(46).EQ.3) THEN | |
20779 | YST0=-0.5D0*LOG(TAUE) | |
20780 | AYST5=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)/ | |
20781 | & MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) | |
20782 | IF(AYST5.GT.1D-10) H2=H2+(AYST0/AYST5)*COEF(ISUBSV,12)/ | |
20783 | & MAX(1D-10,1D0-EXP(-YST-YST0)) | |
20784 | ENDIF | |
20785 | COMFAC=COMFAC*AYST0/H2 | |
20786 | ENDIF | |
20787 | ENDIF | |
20788 | ||
20789 | C...2 -> 1 processes: reduction in angular part of phase space integral | |
20790 | C...for case of decaying resonance | |
20791 | ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN | |
20792 | IF((ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5)) THEN | |
20793 | IF(MDCY(PYCOMP(KFPR(ISUBSV,1)),1).EQ.1) THEN | |
20794 | IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37.OR. | |
20795 | & KFPR(ISUB,1).EQ.39) THEN | |
20796 | COMFAC=COMFAC*0.5D0*ACTH0 | |
20797 | ELSE | |
20798 | COMFAC=COMFAC*0.125D0*(3D0*ACTH0+CTNMAX**3-CTNMIN**3+ | |
20799 | & CTPMAX**3-CTPMIN**3) | |
20800 | ENDIF | |
20801 | ENDIF | |
20802 | ||
20803 | C...2 -> 2 processes: angular part of phase space integral | |
20804 | ELSEIF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN | |
20805 | ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/ | |
20806 | & (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX))) | |
20807 | ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/ | |
20808 | & (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN))) | |
20809 | ACTH3=1D0/MAX(RM34,RSQM-CTNMAX)-1D0/MAX(RM34,RSQM-CTNMIN)+ | |
20810 | & 1D0/MAX(RM34,RSQM-CTPMAX)-1D0/MAX(RM34,RSQM-CTPMIN) | |
20811 | ACTH4=1D0/MAX(RM34,RSQM+CTNMIN)-1D0/MAX(RM34,RSQM+CTNMAX)+ | |
20812 | & 1D0/MAX(RM34,RSQM+CTPMIN)-1D0/MAX(RM34,RSQM+CTPMAX) | |
20813 | H3=COEF(ISUBSV,13)+ | |
20814 | & (ACTH0/ACTH1)*COEF(ISUBSV,14)/MAX(RM34,RSQM-CTH)+ | |
20815 | & (ACTH0/ACTH2)*COEF(ISUBSV,15)/MAX(RM34,RSQM+CTH)+ | |
20816 | & (ACTH0/ACTH3)*COEF(ISUBSV,16)/MAX(RM34,RSQM-CTH)**2+ | |
20817 | & (ACTH0/ACTH4)*COEF(ISUBSV,17)/MAX(RM34,RSQM+CTH)**2 | |
20818 | COMFAC=COMFAC*ACTH0*0.5D0*BE34/H3 | |
20819 | ||
20820 | C...2 -> 2 processes: take into account final state Breit-Wigners | |
20821 | COMFAC=COMFAC*VINT(80) | |
20822 | ENDIF | |
20823 | ||
20824 | C...2 -> 3, 4 processes: phace space integral in tau' | |
20825 | IF(MINT(47).GE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5) THEN | |
20826 | ATAUP1=LOG(TAUPMX/TAUPMN) | |
20827 | ATAUP2=((1D0-TAU/TAUPMX)**4-(1D0-TAU/TAUPMN)**4)/(4D0*TAU) | |
20828 | H4=COEF(ISUBSV,18)+ | |
20829 | & (ATAUP1/ATAUP2)*COEF(ISUBSV,19)*(1D0-TAU/TAUP)**3/TAUP | |
20830 | IF(MINT(47).EQ.5) THEN | |
20831 | ATAUP3=LOG(MAX(2D-10,1D0-TAUPMN)/MAX(2D-10,1D0-TAUPMX)) | |
20832 | H4=H4+(ATAUP1/ATAUP3)*COEF(ISUBSV,20)*TAUP/MAX(2D-10,1D0-TAUP) | |
20833 | ELSEIF(MINT(47).GE.6) THEN | |
20834 | ATAUP3=LOG(MAX(1D-10,1D0-TAUPMN)/MAX(1D-10,1D0-TAUPMX)) | |
20835 | H4=H4+(ATAUP1/ATAUP3)*COEF(ISUBSV,20)*TAUP/MAX(1D-10,1D0-TAUP) | |
20836 | ENDIF | |
20837 | COMFAC=COMFAC*ATAUP1/H4 | |
20838 | ENDIF | |
20839 | ||
20840 | C...2 -> 3, 4 processes: effective W/Z parton distributions | |
20841 | IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) THEN | |
20842 | IF(1D0-TAU/TAUP.GT.1D-4) THEN | |
20843 | FZW=(1D0+TAU/TAUP)*LOG(TAUP/TAU)-2D0*(1D0-TAU/TAUP) | |
20844 | ELSE | |
20845 | FZW=1D0/6D0*(1D0-TAU/TAUP)**3*TAU/TAUP | |
20846 | ENDIF | |
20847 | COMFAC=COMFAC*FZW | |
20848 | ENDIF | |
20849 | ||
20850 | C...2 -> 3 processes: phase space integrals for pT1, pT2, y3, mirror | |
20851 | IF(ISTSB.EQ.5) THEN | |
20852 | COMFAC=COMFAC*VINT(205)*VINT(210)*VINT(212)*VINT(214)/ | |
20853 | & (128D0*PARU(1)**4*VINT(220))*(TAU**2/TAUP) | |
20854 | ENDIF | |
20855 | ||
20856 | C...Phase space integral for low-pT and multiple interactions | |
20857 | IF(ISTSB.EQ.9) THEN | |
20858 | COMFAC=PARU(1)*PARU(5)*FACK*0.5D0*VINT(2)/SH2 | |
20859 | ATAU1=LOG(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0) | |
20860 | ATAU2=2D0*ATAN(1D0/XT2-1D0)/SQRT(XT2) | |
20861 | H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/SQRT(TAU) | |
20862 | COMFAC=COMFAC*ATAU1/H1 | |
20863 | AYST0=YSTMAX-YSTMIN | |
20864 | AYST1=0.5D0*(YSTMAX-YSTMIN)**2 | |
20865 | AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) | |
20866 | H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+ | |
20867 | & (AYST0/AYST1)*COEF(ISUBSV,9)*(YSTMAX-YST)+ | |
20868 | & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST) | |
20869 | COMFAC=COMFAC*AYST0/H2 | |
20870 | IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1D0/VINT(149)-1D0) | |
20871 | C...For MSTP(82)>=2 an additional factor (xT2/(xT2+VINT(149))**2 is | |
20872 | C...introduced to make cross-section finite for xT2 -> 0 | |
20873 | IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)* | |
20874 | & (1D0+VINT(149))) | |
20875 | ENDIF | |
20876 | ||
20877 | C...Real gamma + gamma: include factor 2 when different nature | |
20878 | 160 IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4.AND. | |
20879 | &MSTP(14).LE.10) COMFAC=2D0*COMFAC | |
20880 | ||
20881 | C...Extra factors to include the effects of | |
20882 | C...longitudinal resolved photons (but not direct or DIS ones). | |
20883 | DO 170 ISDE=1,2 | |
20884 | IF(MINT(10+ISDE).EQ.22.AND.MINT(106+ISDE).GE.1.AND. | |
20885 | & MINT(106+ISDE).LE.3) THEN | |
20886 | VINT(314+ISDE)=1D0 | |
20887 | XY=PARP(166+ISDE) | |
20888 | IF(MSTP(16).EQ.0) THEN | |
20889 | IF(VINT(304+ISDE).GT.0D0.AND.VINT(304+ISDE).LT.1D0) | |
20890 | & XY=VINT(304+ISDE) | |
20891 | ELSE | |
20892 | IF(VINT(308+ISDE).GT.0D0.AND.VINT(308+ISDE).LT.1D0) | |
20893 | & XY=VINT(308+ISDE) | |
20894 | ENDIF | |
20895 | Q2GA=VINT(306+ISDE) | |
20896 | IF(MSTP(17).GT.0.AND.XY.GT.0D0.AND.XY.LT.1D0.AND. | |
20897 | & Q2GA.GT.0D0) THEN | |
20898 | REDUCE=0D0 | |
20899 | IF(MSTP(17).EQ.1) THEN | |
20900 | REDUCE=4D0*Q2*Q2GA/(Q2+Q2GA)**2 | |
20901 | ELSEIF(MSTP(17).EQ.2) THEN | |
20902 | REDUCE=4D0*Q2GA/(Q2+Q2GA) | |
20903 | ELSEIF(MSTP(17).EQ.3) THEN | |
20904 | PMVIRT=PMAS(PYCOMP(113),1) | |
20905 | REDUCE=4D0*Q2GA/(PMVIRT**2+Q2GA) | |
20906 | ELSEIF(MSTP(17).EQ.4.AND.MINT(106+ISDE).EQ.1) THEN | |
20907 | PMVIRT=PMAS(PYCOMP(113),1) | |
20908 | REDUCE=4D0*PMVIRT**2*Q2GA/(PMVIRT**2+Q2GA)**2 | |
20909 | ELSEIF(MSTP(17).EQ.4.AND.MINT(106+ISDE).EQ.2) THEN | |
20910 | PMVIRT=PMAS(PYCOMP(113),1) | |
20911 | REDUCE=4D0*PMVIRT**2*Q2GA/(PMVIRT**2+Q2GA)**2 | |
20912 | ELSEIF(MSTP(17).EQ.4.AND.MINT(106+ISDE).EQ.3) THEN | |
20913 | PMVSMN=4D0*PARP(15)**2 | |
20914 | PMVSMX=4D0*VINT(154)**2 | |
20915 | REDTRA=1D0/(PMVSMN+Q2GA)-1D0/(PMVSMX+Q2GA) | |
20916 | REDLON=(3D0*PMVSMN+Q2GA)/(PMVSMN+Q2GA)**3- | |
20917 | & (3D0*PMVSMX+Q2GA)/(PMVSMX+Q2GA)**3 | |
20918 | REDUCE=4D0*(Q2GA/6D0)*REDLON/REDTRA | |
20919 | ELSEIF(MSTP(17).EQ.5.AND.MINT(106+ISDE).EQ.1) THEN | |
20920 | PMVIRT=PMAS(PYCOMP(113),1) | |
20921 | REDUCE=4D0*Q2GA/(PMVIRT**2+Q2GA) | |
20922 | ELSEIF(MSTP(17).EQ.5.AND.MINT(106+ISDE).EQ.2) THEN | |
20923 | PMVIRT=PMAS(PYCOMP(113),1) | |
20924 | REDUCE=4D0*Q2GA/(PMVIRT**2+Q2GA) | |
20925 | ELSEIF(MSTP(17).EQ.5.AND.MINT(106+ISDE).EQ.3) THEN | |
20926 | PMVSMN=4D0*PARP(15)**2 | |
20927 | PMVSMX=4D0*VINT(154)**2 | |
20928 | REDTRA=1D0/(PMVSMN+Q2GA)-1D0/(PMVSMX+Q2GA) | |
20929 | REDLON=1D0/(PMVSMN+Q2GA)**2-1D0/(PMVSMX+Q2GA)**2 | |
20930 | REDUCE=4D0*(Q2GA/2D0)*REDLON/REDTRA | |
20931 | ENDIF | |
20932 | BEAMAS=PYMASS(11) | |
20933 | IF(VINT(302+ISDE).GT.0D0) BEAMAS=VINT(302+ISDE) | |
20934 | FRACLT=1D0/(1D0+XY**2/2D0/(1D0-XY)* | |
20935 | & (1D0-2D0*BEAMAS**2/Q2GA)) | |
20936 | VINT(314+ISDE)=1D0+PARP(165)*REDUCE*FRACLT | |
20937 | ENDIF | |
20938 | ELSE | |
20939 | VINT(314+ISDE)=1D0 | |
20940 | ENDIF | |
20941 | COMFAC=COMFAC*VINT(314+ISDE) | |
20942 | 170 CONTINUE | |
20943 | ||
20944 | C...Evaluate cross sections - done in separate routines by kind | |
20945 | C...of physics, to keep PYSIGH of sensible size. | |
20946 | IF(MAP.EQ.1) THEN | |
20947 | C...Standard QCD (including photons). | |
20948 | CALL PYSGQC(NCHN,SIGS) | |
20949 | ELSEIF(MAP.EQ.2) THEN | |
20950 | C...Heavy flavours. | |
20951 | CALL PYSGHF(NCHN,SIGS) | |
20952 | ELSEIF(MAP.EQ.3) THEN | |
20953 | C...W/Z. | |
20954 | CALL PYSGWZ(NCHN,SIGS) | |
20955 | ELSEIF(MAP.EQ.4) THEN | |
20956 | C...Higgs (2 doublets; including longitudinal W/Z scattering). | |
20957 | CALL PYSGHG(NCHN,SIGS) | |
20958 | ELSEIF(MAP.EQ.5) THEN | |
20959 | C...SUSY. | |
20960 | CALL PYSGSU(NCHN,SIGS) | |
20961 | ELSEIF(MAP.EQ.6) THEN | |
20962 | C...Technicolor. | |
20963 | CALL PYSGTC(NCHN,SIGS) | |
20964 | ELSEIF(MAP.EQ.7) THEN | |
20965 | C...Exotics (Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*). | |
20966 | CALL PYSGEX(NCHN,SIGS) | |
20967 | ENDIF | |
20968 | ||
20969 | C...Multiply with parton distributions | |
20970 | IF(ISUB.LE.90.OR.ISUB.GE.96) THEN | |
20971 | DO 180 ICHN=1,NCHN | |
20972 | IF(MINT(45).GE.2) THEN | |
20973 | KFL1=ISIG(ICHN,1) | |
20974 | SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1) | |
20975 | ENDIF | |
20976 | IF(MINT(46).GE.2) THEN | |
20977 | KFL2=ISIG(ICHN,2) | |
20978 | SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2) | |
20979 | ENDIF | |
20980 | SIGS=SIGS+SIGH(ICHN) | |
20981 | 180 CONTINUE | |
20982 | ENDIF | |
20983 | ||
20984 | RETURN | |
20985 | END | |
20986 | ||
20987 | C********************************************************************* | |
20988 | ||
20989 | C...PYSGQC | |
20990 | C...Subprocess cross sections for QCD processes, | |
20991 | C...including photons. | |
20992 | C...Auxiliary to PYSIGH. | |
20993 | ||
20994 | SUBROUTINE PYSGQC(NCHN,SIGS) | |
20995 | ||
20996 | C...Double precision and integer declarations | |
20997 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
20998 | IMPLICIT INTEGER(I-N) | |
20999 | INTEGER PYK,PYCHGE,PYCOMP | |
21000 | C...Parameter statement to help give large particle numbers. | |
21001 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
21002 | &KEXCIT=4000000,KDIMEN=5000000) | |
21003 | C...Commonblocks | |
21004 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
21005 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
21006 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
21007 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
21008 | COMMON/PYINT1/MINT(400),VINT(400) | |
21009 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
21010 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
21011 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
21012 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
21013 | COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, | |
21014 | &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, | |
21015 | &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, | |
21016 | &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR | |
21017 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/, | |
21018 | &/PYINT3/,/PYINT4/,/PYINT7/,/PYSGCM/ | |
21019 | C...Local arrays | |
21020 | DIMENSION WDTP(0:400),WDTE(0:400,0:5) | |
21021 | ||
21022 | C...Differential cross section expressions. | |
21023 | ||
21024 | IF(ISUB.LE.20) THEN | |
21025 | IF(ISUB.EQ.10) THEN | |
21026 | C...f + f' -> f + f' (gamma/Z/W exchange) | |
21027 | FACGGF=COMFAC*AEM**2*2D0*(SH2+UH2)/TH2 | |
21028 | FACGZF=COMFAC*AEM**2*XWC*4D0*SH2/(TH*(TH-SQMZ)) | |
21029 | FACZZF=COMFAC*(AEM*XWC)**2*2D0*SH2/(TH-SQMZ)**2 | |
21030 | FACWWF=COMFAC*(0.5D0*AEM/XW)**2*SH2/(TH-SQMW)**2 | |
21031 | DO 110 I=MMIN1,MMAX1 | |
21032 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 110 | |
21033 | IA=IABS(I) | |
21034 | DO 100 J=MMIN2,MMAX2 | |
21035 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 100 | |
21036 | JA=IABS(J) | |
21037 | C...Electroweak couplings | |
21038 | EI=KCHG(IA,1)*ISIGN(1,I)/3D0 | |
21039 | AI=SIGN(1D0,KCHG(IA,1)+0.5D0)*ISIGN(1,I) | |
21040 | VI=AI-4D0*EI*XWV | |
21041 | EJ=KCHG(JA,1)*ISIGN(1,J)/3D0 | |
21042 | AJ=SIGN(1D0,KCHG(JA,1)+0.5D0)*ISIGN(1,J) | |
21043 | VJ=AJ-4D0*EJ*XWV | |
21044 | EPSIJ=ISIGN(1,I*J) | |
21045 | C...gamma/Z exchange, only gamma exchange, or only Z exchange | |
21046 | IF(MSTP(21).GE.1.AND.MSTP(21).LE.4) THEN | |
21047 | IF(MSTP(21).EQ.1.OR.MSTP(21).EQ.4) THEN | |
21048 | FACNCF=FACGGF*EI**2*EJ**2+FACGZF*EI*EJ* | |
21049 | & (VI*VJ*(1D0+UH2/SH2)+AI*AJ*EPSIJ*(1D0-UH2/SH2))+ | |
21050 | & FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*(1D0+UH2/SH2)+ | |
21051 | & 4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2)) | |
21052 | ELSEIF(MSTP(21).EQ.2) THEN | |
21053 | FACNCF=FACGGF*EI**2*EJ**2 | |
21054 | ELSE | |
21055 | FACNCF=FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)* | |
21056 | & (1D0+UH2/SH2)+4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2)) | |
21057 | ENDIF | |
21058 | C...Extrafactor 2 for only one incoming neutrino spin state. | |
21059 | IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACNCF=2D0*FACNCF | |
21060 | IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACNCF=2D0*FACNCF | |
21061 | NCHN=NCHN+1 | |
21062 | ISIG(NCHN,1)=I | |
21063 | ISIG(NCHN,2)=J | |
21064 | ISIG(NCHN,3)=1 | |
21065 | SIGH(NCHN)=FACNCF | |
21066 | ENDIF | |
21067 | C...W exchange | |
21068 | IF((MSTP(21).EQ.1.OR.MSTP(21).EQ.5).AND.AI*AJ.LT.0D0) THEN | |
21069 | FACCCF=FACWWF*VINT(180+I)*VINT(180+J) | |
21070 | IF(EPSIJ.LT.0D0) FACCCF=FACCCF*UH2/SH2 | |
21071 | IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACCCF=2D0*FACCCF | |
21072 | IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACCCF=2D0*FACCCF | |
21073 | NCHN=NCHN+1 | |
21074 | ISIG(NCHN,1)=I | |
21075 | ISIG(NCHN,2)=J | |
21076 | ISIG(NCHN,3)=2 | |
21077 | SIGH(NCHN)=FACCCF | |
21078 | ENDIF | |
21079 | 100 CONTINUE | |
21080 | 110 CONTINUE | |
21081 | ||
21082 | ELSEIF(ISUB.EQ.11) THEN | |
21083 | C...f + f' -> f + f' (g exchange) | |
21084 | FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)/TH2 | |
21085 | FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)/TH2*FACA- | |
21086 | & MSTP(34)*2D0/3D0*UH2/(SH*TH)) | |
21087 | FACQQ2=COMFAC*AS**2*4D0/9D0*((SH2+TH2)/UH2- | |
21088 | & MSTP(34)*2D0/3D0*SH2/(TH*UH)) | |
21089 | DO 130 I=MMIN1,MMAX1 | |
21090 | IA=IABS(I) | |
21091 | IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 130 | |
21092 | DO 120 J=MMIN2,MMAX2 | |
21093 | JA=IABS(J) | |
21094 | IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 120 | |
21095 | NCHN=NCHN+1 | |
21096 | ISIG(NCHN,1)=I | |
21097 | ISIG(NCHN,2)=J | |
21098 | ISIG(NCHN,3)=1 | |
21099 | SIGH(NCHN)=FACQQ1 | |
21100 | IF(I.EQ.-J) SIGH(NCHN)=FACQQB | |
21101 | IF(I.EQ.J) THEN | |
21102 | SIGH(NCHN)=0.5D0*SIGH(NCHN) | |
21103 | NCHN=NCHN+1 | |
21104 | ISIG(NCHN,1)=I | |
21105 | ISIG(NCHN,2)=J | |
21106 | ISIG(NCHN,3)=2 | |
21107 | SIGH(NCHN)=0.5D0*FACQQ2 | |
21108 | ENDIF | |
21109 | 120 CONTINUE | |
21110 | 130 CONTINUE | |
21111 | ||
21112 | ELSEIF(ISUB.EQ.12) THEN | |
21113 | C...f + fbar -> f' + fbar' (q + qbar -> q' + qbar' only) | |
21114 | CALL PYWIDT(21,SH,WDTP,WDTE) | |
21115 | FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2* | |
21116 | & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
21117 | DO 140 I=MMINA,MMAXA | |
21118 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
21119 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 140 | |
21120 | NCHN=NCHN+1 | |
21121 | ISIG(NCHN,1)=I | |
21122 | ISIG(NCHN,2)=-I | |
21123 | ISIG(NCHN,3)=1 | |
21124 | SIGH(NCHN)=FACQQB | |
21125 | 140 CONTINUE | |
21126 | ||
21127 | ELSEIF(ISUB.EQ.13) THEN | |
21128 | C...f + fbar -> g + g (q + qbar -> g + g only) | |
21129 | FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* | |
21130 | & UH2/SH2) | |
21131 | FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* | |
21132 | & TH2/SH2) | |
21133 | DO 150 I=MMINA,MMAXA | |
21134 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
21135 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150 | |
21136 | NCHN=NCHN+1 | |
21137 | ISIG(NCHN,1)=I | |
21138 | ISIG(NCHN,2)=-I | |
21139 | ISIG(NCHN,3)=1 | |
21140 | SIGH(NCHN)=0.5D0*FACGG1 | |
21141 | NCHN=NCHN+1 | |
21142 | ISIG(NCHN,1)=I | |
21143 | ISIG(NCHN,2)=-I | |
21144 | ISIG(NCHN,3)=2 | |
21145 | SIGH(NCHN)=0.5D0*FACGG2 | |
21146 | 150 CONTINUE | |
21147 | ||
21148 | ELSEIF(ISUB.EQ.14) THEN | |
21149 | C...f + fbar -> g + gamma (q + qbar -> g + gamma only) | |
21150 | FACGG=COMFAC*AS*AEM*8D0/9D0*(TH2+UH2)/(TH*UH) | |
21151 | DO 160 I=MMINA,MMAXA | |
21152 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
21153 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 160 | |
21154 | EI=KCHG(IABS(I),1)/3D0 | |
21155 | NCHN=NCHN+1 | |
21156 | ISIG(NCHN,1)=I | |
21157 | ISIG(NCHN,2)=-I | |
21158 | ISIG(NCHN,3)=1 | |
21159 | SIGH(NCHN)=FACGG*EI**2 | |
21160 | 160 CONTINUE | |
21161 | ||
21162 | ELSEIF(ISUB.EQ.18) THEN | |
21163 | C...f + fbar -> gamma + gamma | |
21164 | FACGG=COMFAC*AEM**2*2D0*(TH2+UH2)/(TH*UH) | |
21165 | DO 170 I=MMINA,MMAXA | |
21166 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 170 | |
21167 | EI=KCHG(IABS(I),1)/3D0 | |
21168 | FCOI=1D0 | |
21169 | IF(IABS(I).LE.10) FCOI=FACA/3D0 | |
21170 | NCHN=NCHN+1 | |
21171 | ISIG(NCHN,1)=I | |
21172 | ISIG(NCHN,2)=-I | |
21173 | ISIG(NCHN,3)=1 | |
21174 | SIGH(NCHN)=0.5D0*FACGG*FCOI*EI**4 | |
21175 | 170 CONTINUE | |
21176 | ENDIF | |
21177 | ||
21178 | ELSEIF(ISUB.LE.40) THEN | |
21179 | IF(ISUB.EQ.28) THEN | |
21180 | C...f + g -> f + g (q + g -> q + g only) | |
21181 | FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2- | |
21182 | & UH/SH)*FACA | |
21183 | FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2- | |
21184 | & SH/UH) | |
21185 | DO 190 I=MMINA,MMAXA | |
21186 | IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 190 | |
21187 | DO 180 ISDE=1,2 | |
21188 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 180 | |
21189 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 180 | |
21190 | NCHN=NCHN+1 | |
21191 | ISIG(NCHN,ISDE)=I | |
21192 | ISIG(NCHN,3-ISDE)=21 | |
21193 | ISIG(NCHN,3)=1 | |
21194 | SIGH(NCHN)=FACQG1 | |
21195 | NCHN=NCHN+1 | |
21196 | ISIG(NCHN,ISDE)=I | |
21197 | ISIG(NCHN,3-ISDE)=21 | |
21198 | ISIG(NCHN,3)=2 | |
21199 | SIGH(NCHN)=FACQG2 | |
21200 | 180 CONTINUE | |
21201 | 190 CONTINUE | |
21202 | ||
21203 | ELSEIF(ISUB.EQ.29) THEN | |
21204 | C...f + g -> f + gamma (q + g -> q + gamma only) | |
21205 | FGQ=COMFAC*FACA*AS*AEM*1D0/3D0*(SH2+UH2)/(-SH*UH) | |
21206 | DO 210 I=MMINA,MMAXA | |
21207 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 210 | |
21208 | EI=KCHG(IABS(I),1)/3D0 | |
21209 | FACGQ=FGQ*EI**2 | |
21210 | DO 200 ISDE=1,2 | |
21211 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 200 | |
21212 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 200 | |
21213 | NCHN=NCHN+1 | |
21214 | ISIG(NCHN,ISDE)=I | |
21215 | ISIG(NCHN,3-ISDE)=21 | |
21216 | ISIG(NCHN,3)=1 | |
21217 | SIGH(NCHN)=FACGQ | |
21218 | 200 CONTINUE | |
21219 | 210 CONTINUE | |
21220 | ||
21221 | ELSEIF(ISUB.EQ.33) THEN | |
21222 | C...f + gamma -> f + g (q + gamma -> q + g only) | |
21223 | FGQ=COMFAC*AS*AEM*8D0/3D0*(SH2+UH2)/(-SH*UH) | |
21224 | DO 230 I=MMINA,MMAXA | |
21225 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 230 | |
21226 | EI=KCHG(IABS(I),1)/3D0 | |
21227 | FACGQ=FGQ*EI**2 | |
21228 | DO 220 ISDE=1,2 | |
21229 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 220 | |
21230 | IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 220 | |
21231 | NCHN=NCHN+1 | |
21232 | ISIG(NCHN,ISDE)=I | |
21233 | ISIG(NCHN,3-ISDE)=22 | |
21234 | ISIG(NCHN,3)=1 | |
21235 | SIGH(NCHN)=FACGQ | |
21236 | 220 CONTINUE | |
21237 | 230 CONTINUE | |
21238 | ||
21239 | ELSEIF(ISUB.EQ.34) THEN | |
21240 | C...f + gamma -> f + gamma | |
21241 | FGQ=COMFAC*AEM**2*2D0*(SH2+UH2)/(-SH*UH) | |
21242 | DO 250 I=MMINA,MMAXA | |
21243 | IF(I.EQ.0) GOTO 250 | |
21244 | EI=KCHG(IABS(I),1)/3D0 | |
21245 | FACGQ=FGQ*EI**4 | |
21246 | DO 240 ISDE=1,2 | |
21247 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 240 | |
21248 | IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 240 | |
21249 | NCHN=NCHN+1 | |
21250 | ISIG(NCHN,ISDE)=I | |
21251 | ISIG(NCHN,3-ISDE)=22 | |
21252 | ISIG(NCHN,3)=1 | |
21253 | SIGH(NCHN)=FACGQ | |
21254 | 240 CONTINUE | |
21255 | 250 CONTINUE | |
21256 | ENDIF | |
21257 | ||
21258 | ELSEIF(ISUB.LE.80) THEN | |
21259 | IF(ISUB.EQ.53) THEN | |
21260 | C...g + g -> f + fbar (g + g -> q + qbar only) | |
21261 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 270 | |
21262 | IDC0=MDCY(21,2)-1 | |
21263 | C...Begin by d, u, s flavours. | |
21264 | FLAVWT=0D0 | |
21265 | IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+ | |
21266 | & SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH)) | |
21267 | IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+ | |
21268 | & SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH)) | |
21269 | IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+ | |
21270 | & SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH)) | |
21271 | FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* | |
21272 | & UH2/SH2)*FLAVWT*FACA | |
21273 | FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* | |
21274 | & TH2/SH2)*FLAVWT*FACA | |
21275 | NCHN=NCHN+1 | |
21276 | ISIG(NCHN,1)=21 | |
21277 | ISIG(NCHN,2)=21 | |
21278 | ISIG(NCHN,3)=1 | |
21279 | SIGH(NCHN)=FACQQ1 | |
21280 | NCHN=NCHN+1 | |
21281 | ISIG(NCHN,1)=21 | |
21282 | ISIG(NCHN,2)=21 | |
21283 | ISIG(NCHN,3)=2 | |
21284 | SIGH(NCHN)=FACQQ2 | |
21285 | C...Next c and b flavours: modified that and uhat for fixed | |
21286 | C...cos(theta-hat). | |
21287 | DO 260 IFL=4,5 | |
21288 | SQMAVG=PMAS(IFL,1)**2 | |
21289 | IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN | |
21290 | BE34=SQRT(1D0-4D0*SQMAVG/SH) | |
21291 | THQ=-0.5D0*SH*(1D0-BE34*CTH) | |
21292 | UHQ=-0.5D0*SH*(1D0+BE34*CTH) | |
21293 | THUHQ=THQ*UHQ-SQMAVG*SH | |
21294 | IF(MSTP(34).EQ.0) THEN | |
21295 | FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 | |
21296 | FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 | |
21297 | ELSE | |
21298 | FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
21299 | & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) | |
21300 | FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
21301 | & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) | |
21302 | ENDIF | |
21303 | FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34 | |
21304 | FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34 | |
21305 | NCHN=NCHN+1 | |
21306 | ISIG(NCHN,1)=21 | |
21307 | ISIG(NCHN,2)=21 | |
21308 | ISIG(NCHN,3)=1+2*(IFL-3) | |
21309 | SIGH(NCHN)=FACQQ1 | |
21310 | NCHN=NCHN+1 | |
21311 | ISIG(NCHN,1)=21 | |
21312 | ISIG(NCHN,2)=21 | |
21313 | ISIG(NCHN,3)=2+2*(IFL-3) | |
21314 | SIGH(NCHN)=FACQQ2 | |
21315 | ENDIF | |
21316 | 260 CONTINUE | |
21317 | 270 CONTINUE | |
21318 | ||
21319 | ELSEIF(ISUB.EQ.54) THEN | |
21320 | C...g + gamma -> f + fbar (g + gamma -> q + qbar only) | |
21321 | CALL PYWIDT(21,SH,WDTP,WDTE) | |
21322 | WDTESU=0D0 | |
21323 | DO 280 I=1,MIN(8,MDCY(21,3)) | |
21324 | EF=KCHG(I,1)/3D0 | |
21325 | WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ | |
21326 | & WDTE(I,4)) | |
21327 | 280 CONTINUE | |
21328 | FACQQ=COMFAC*AEM*AS*WDTESU*(TH2+UH2)/(TH*UH) | |
21329 | IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN | |
21330 | NCHN=NCHN+1 | |
21331 | ISIG(NCHN,1)=21 | |
21332 | ISIG(NCHN,2)=22 | |
21333 | ISIG(NCHN,3)=1 | |
21334 | SIGH(NCHN)=FACQQ | |
21335 | ENDIF | |
21336 | IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN | |
21337 | NCHN=NCHN+1 | |
21338 | ISIG(NCHN,1)=22 | |
21339 | ISIG(NCHN,2)=21 | |
21340 | ISIG(NCHN,3)=1 | |
21341 | SIGH(NCHN)=FACQQ | |
21342 | ENDIF | |
21343 | ||
21344 | ELSEIF(ISUB.EQ.58) THEN | |
21345 | C...gamma + gamma -> f + fbar | |
21346 | CALL PYWIDT(22,SH,WDTP,WDTE) | |
21347 | WDTESU=0D0 | |
21348 | DO 290 I=1,MIN(12,MDCY(22,3)) | |
21349 | IF(I.LE.8) EF= KCHG(I,1)/3D0 | |
21350 | IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3D0 | |
21351 | WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ | |
21352 | & WDTE(I,4)) | |
21353 | 290 CONTINUE | |
21354 | FACFF=COMFAC*AEM**2*WDTESU*2D0*(TH2+UH2)/(TH*UH) | |
21355 | IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN | |
21356 | NCHN=NCHN+1 | |
21357 | ISIG(NCHN,1)=22 | |
21358 | ISIG(NCHN,2)=22 | |
21359 | ISIG(NCHN,3)=1 | |
21360 | SIGH(NCHN)=FACFF | |
21361 | ENDIF | |
21362 | ||
21363 | ELSEIF(ISUB.EQ.68) THEN | |
21364 | C...g + g -> g + g | |
21365 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 300 | |
21366 | FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+2D0*TH/SH+ | |
21367 | & TH2/SH2)*FACA | |
21368 | FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+2D0*SH/UH+ | |
21369 | & SH2/UH2)*FACA | |
21370 | FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3D0+2D0*UH/TH+ | |
21371 | & UH2/TH2) | |
21372 | NCHN=NCHN+1 | |
21373 | ISIG(NCHN,1)=21 | |
21374 | ISIG(NCHN,2)=21 | |
21375 | ISIG(NCHN,3)=1 | |
21376 | SIGH(NCHN)=0.5D0*FACGG1 | |
21377 | NCHN=NCHN+1 | |
21378 | ISIG(NCHN,1)=21 | |
21379 | ISIG(NCHN,2)=21 | |
21380 | ISIG(NCHN,3)=2 | |
21381 | SIGH(NCHN)=0.5D0*FACGG2 | |
21382 | NCHN=NCHN+1 | |
21383 | ISIG(NCHN,1)=21 | |
21384 | ISIG(NCHN,2)=21 | |
21385 | ISIG(NCHN,3)=3 | |
21386 | SIGH(NCHN)=0.5D0*FACGG3 | |
21387 | 300 CONTINUE | |
21388 | ||
21389 | ELSEIF(ISUB.EQ.80) THEN | |
21390 | C...q + gamma -> q' + pi+/- | |
21391 | FQPI=COMFAC*(2D0*AEM/9D0)*(-SH/TH)*(1D0/SH2+1D0/TH2) | |
21392 | ASSH=PYALPS(MAX(0.5D0,0.5D0*SH)) | |
21393 | Q2FPSH=0.55D0/LOG(MAX(2D0,2D0*SH)) | |
21394 | DELSH=UH*SQRT(ASSH*Q2FPSH) | |
21395 | ASUH=PYALPS(MAX(0.5D0,-0.5D0*UH)) | |
21396 | Q2FPUH=0.55D0/LOG(MAX(2D0,-2D0*UH)) | |
21397 | DELUH=SH*SQRT(ASUH*Q2FPUH) | |
21398 | DO 320 I=MAX(-2,MMINA),MIN(2,MMAXA) | |
21399 | IF(I.EQ.0) GOTO 320 | |
21400 | EI=KCHG(IABS(I),1)/3D0 | |
21401 | EJ=SIGN(1D0-ABS(EI),EI) | |
21402 | DO 310 ISDE=1,2 | |
21403 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 310 | |
21404 | IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 310 | |
21405 | NCHN=NCHN+1 | |
21406 | ISIG(NCHN,ISDE)=I | |
21407 | ISIG(NCHN,3-ISDE)=22 | |
21408 | ISIG(NCHN,3)=1 | |
21409 | SIGH(NCHN)=FQPI*(EI*DELSH+EJ*DELUH)**2 | |
21410 | 310 CONTINUE | |
21411 | 320 CONTINUE | |
21412 | ENDIF | |
21413 | ||
21414 | ELSEIF(ISUB.LE.100) THEN | |
21415 | IF(ISUB.EQ.91) THEN | |
21416 | C...Elastic scattering | |
21417 | SIGS=VINT(315)*VINT(316)*SIGT(0,0,1) | |
21418 | ||
21419 | ELSEIF(ISUB.EQ.92) THEN | |
21420 | C...Single diffractive scattering (first side, i.e. XB) | |
21421 | SIGS=VINT(315)*VINT(316)*SIGT(0,0,2) | |
21422 | ||
21423 | ELSEIF(ISUB.EQ.93) THEN | |
21424 | C...Single diffractive scattering (second side, i.e. AX) | |
21425 | SIGS=VINT(315)*VINT(316)*SIGT(0,0,3) | |
21426 | ||
21427 | ELSEIF(ISUB.EQ.94) THEN | |
21428 | C...Double diffractive scattering | |
21429 | SIGS=VINT(315)*VINT(316)*SIGT(0,0,4) | |
21430 | ||
21431 | ELSEIF(ISUB.EQ.95) THEN | |
21432 | C...Low-pT scattering | |
21433 | SIGS=VINT(315)*VINT(316)*SIGT(0,0,5) | |
21434 | ||
21435 | ELSEIF(ISUB.EQ.96) THEN | |
21436 | C...Multiple interactions: sum of QCD processes | |
21437 | CALL PYWIDT(21,SH,WDTP,WDTE) | |
21438 | ||
21439 | C...q + q' -> q + q' | |
21440 | FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)/TH2 | |
21441 | FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)/TH2*FACA- | |
21442 | & MSTP(34)*2D0/3D0*UH2/(SH*TH)) | |
21443 | FACQQ2=COMFAC*AS**2*4D0/9D0*(SH2+TH2)/UH2 | |
21444 | FACQQI=-COMFAC*AS**2*4D0/9D0*MSTP(34)*2D0/3D0*SH2/(TH*UH) | |
21445 | RATQQI=(FACQQ1+FACQQ2+FACQQI)/(FACQQ1+FACQQ2) | |
21446 | DO 340 I=-5,5 | |
21447 | IF(I.EQ.0) GOTO 340 | |
21448 | DO 330 J=-5,5 | |
21449 | IF(J.EQ.0) GOTO 330 | |
21450 | NCHN=NCHN+1 | |
21451 | ISIG(NCHN,1)=I | |
21452 | ISIG(NCHN,2)=J | |
21453 | ISIG(NCHN,3)=111 | |
21454 | SIGH(NCHN)=FACQQ1 | |
21455 | IF(I.EQ.-J) SIGH(NCHN)=FACQQB | |
21456 | IF(I.EQ.J) THEN | |
21457 | SIGH(NCHN)=0.5D0*FACQQ1*RATQQI | |
21458 | NCHN=NCHN+1 | |
21459 | ISIG(NCHN,1)=I | |
21460 | ISIG(NCHN,2)=J | |
21461 | ISIG(NCHN,3)=112 | |
21462 | SIGH(NCHN)=0.5D0*FACQQ2*RATQQI | |
21463 | ENDIF | |
21464 | 330 CONTINUE | |
21465 | 340 CONTINUE | |
21466 | ||
21467 | C...q + qbar -> q' + qbar' or g + g | |
21468 | FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2* | |
21469 | & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4)) | |
21470 | FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* | |
21471 | & UH2/SH2) | |
21472 | FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* | |
21473 | & TH2/SH2) | |
21474 | DO 350 I=-5,5 | |
21475 | IF(I.EQ.0) GOTO 350 | |
21476 | NCHN=NCHN+1 | |
21477 | ISIG(NCHN,1)=I | |
21478 | ISIG(NCHN,2)=-I | |
21479 | ISIG(NCHN,3)=121 | |
21480 | SIGH(NCHN)=FACQQB | |
21481 | NCHN=NCHN+1 | |
21482 | ISIG(NCHN,1)=I | |
21483 | ISIG(NCHN,2)=-I | |
21484 | ISIG(NCHN,3)=131 | |
21485 | SIGH(NCHN)=0.5D0*FACGG1 | |
21486 | NCHN=NCHN+1 | |
21487 | ISIG(NCHN,1)=I | |
21488 | ISIG(NCHN,2)=-I | |
21489 | ISIG(NCHN,3)=132 | |
21490 | SIGH(NCHN)=0.5D0*FACGG2 | |
21491 | 350 CONTINUE | |
21492 | ||
21493 | C...q + g -> q + g | |
21494 | FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2- | |
21495 | & UH/SH)*FACA | |
21496 | FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2- | |
21497 | & SH/UH) | |
21498 | DO 370 I=-5,5 | |
21499 | IF(I.EQ.0) GOTO 370 | |
21500 | DO 360 ISDE=1,2 | |
21501 | NCHN=NCHN+1 | |
21502 | ISIG(NCHN,ISDE)=I | |
21503 | ISIG(NCHN,3-ISDE)=21 | |
21504 | ISIG(NCHN,3)=281 | |
21505 | SIGH(NCHN)=FACQG1 | |
21506 | NCHN=NCHN+1 | |
21507 | ISIG(NCHN,ISDE)=I | |
21508 | ISIG(NCHN,3-ISDE)=21 | |
21509 | ISIG(NCHN,3)=282 | |
21510 | SIGH(NCHN)=FACQG2 | |
21511 | 360 CONTINUE | |
21512 | 370 CONTINUE | |
21513 | ||
21514 | C...g + g -> q + qbar (only d, u, s) | |
21515 | IDC0=MDCY(21,2)-1 | |
21516 | FLAVWT=0D0 | |
21517 | IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+ | |
21518 | & SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH)) | |
21519 | IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+ | |
21520 | & SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH)) | |
21521 | IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+ | |
21522 | & SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH)) | |
21523 | FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* | |
21524 | & UH2/SH2)*FLAVWT*FACA | |
21525 | FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* | |
21526 | & TH2/SH2)*FLAVWT*FACA | |
21527 | NCHN=NCHN+1 | |
21528 | ISIG(NCHN,1)=21 | |
21529 | ISIG(NCHN,2)=21 | |
21530 | ISIG(NCHN,3)=531 | |
21531 | SIGH(NCHN)=FACQQ1 | |
21532 | NCHN=NCHN+1 | |
21533 | ISIG(NCHN,1)=21 | |
21534 | ISIG(NCHN,2)=21 | |
21535 | ISIG(NCHN,3)=532 | |
21536 | SIGH(NCHN)=FACQQ2 | |
21537 | ||
21538 | C...g + g -> c + cbar, b + bbar: modified that/uhat for fixed | |
21539 | C...cos(theta-hat) | |
21540 | DO 380 IFL=4,5 | |
21541 | SQMAVG=PMAS(IFL,1)**2 | |
21542 | IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN | |
21543 | BE34=SQRT(1D0-4D0*SQMAVG/SH) | |
21544 | THQ=-0.5D0*SH*(1D0-BE34*CTH) | |
21545 | UHQ=-0.5D0*SH*(1D0+BE34*CTH) | |
21546 | THUHQ=THQ*UHQ-SQMAVG*SH | |
21547 | IF(MSTP(34).EQ.0) THEN | |
21548 | FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 | |
21549 | FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 | |
21550 | ELSE | |
21551 | FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
21552 | & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) | |
21553 | FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
21554 | & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) | |
21555 | ENDIF | |
21556 | FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34 | |
21557 | FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34 | |
21558 | NCHN=NCHN+1 | |
21559 | ISIG(NCHN,1)=21 | |
21560 | ISIG(NCHN,2)=21 | |
21561 | ISIG(NCHN,3)=531+2*(IFL-3) | |
21562 | SIGH(NCHN)=FACQQ1 | |
21563 | NCHN=NCHN+1 | |
21564 | ISIG(NCHN,1)=21 | |
21565 | ISIG(NCHN,2)=21 | |
21566 | ISIG(NCHN,3)=532+2*(IFL-3) | |
21567 | SIGH(NCHN)=FACQQ2 | |
21568 | ENDIF | |
21569 | 380 CONTINUE | |
21570 | ||
21571 | C...g + g -> g + g | |
21572 | FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+ | |
21573 | & 2D0*TH/SH+TH2/SH2)*FACA | |
21574 | FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+ | |
21575 | & 2D0*SH/UH+SH2/UH2)*FACA | |
21576 | FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3+ | |
21577 | & 2D0*UH/TH+UH2/TH2) | |
21578 | NCHN=NCHN+1 | |
21579 | ISIG(NCHN,1)=21 | |
21580 | ISIG(NCHN,2)=21 | |
21581 | ISIG(NCHN,3)=681 | |
21582 | SIGH(NCHN)=0.5D0*FACGG1 | |
21583 | NCHN=NCHN+1 | |
21584 | ISIG(NCHN,1)=21 | |
21585 | ISIG(NCHN,2)=21 | |
21586 | ISIG(NCHN,3)=682 | |
21587 | SIGH(NCHN)=0.5D0*FACGG2 | |
21588 | NCHN=NCHN+1 | |
21589 | ISIG(NCHN,1)=21 | |
21590 | ISIG(NCHN,2)=21 | |
21591 | ISIG(NCHN,3)=683 | |
21592 | SIGH(NCHN)=0.5D0*FACGG3 | |
21593 | ||
21594 | ELSEIF(ISUB.EQ.99) THEN | |
21595 | C...f + gamma* -> f. | |
21596 | IF(MINT(107).EQ.4) THEN | |
21597 | Q2GA=VINT(307) | |
21598 | P2GA=VINT(308) | |
21599 | ISDE=2 | |
21600 | ELSE | |
21601 | Q2GA=VINT(308) | |
21602 | P2GA=VINT(307) | |
21603 | ISDE=1 | |
21604 | ENDIF | |
21605 | COMFAC=PARU(5)*4D0*PARU(1)**2*PARU(101)*VINT(315)*VINT(316) | |
21606 | PM2RHO=PMAS(PYCOMP(113),1)**2 | |
21607 | IF(MSTP(19).EQ.0) THEN | |
21608 | COMFAC=COMFAC/Q2GA | |
21609 | ELSEIF(MSTP(19).EQ.1) THEN | |
21610 | COMFAC=COMFAC/(Q2GA+PM2RHO) | |
21611 | ELSEIF(MSTP(19).EQ.2) THEN | |
21612 | COMFAC=COMFAC*Q2GA/(Q2GA+PM2RHO)**2 | |
21613 | ELSE | |
21614 | COMFAC=COMFAC*Q2GA/(Q2GA+PM2RHO)**2 | |
21615 | W2GA=VINT(2) | |
21616 | IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN | |
21617 | RDRDS=4.1D-3*W2GA**2.167D0/((Q2GA+0.15D0*W2GA)**2* | |
21618 | & Q2GA**0.75D0)*(1D0+0.11D0*Q2GA*P2GA/(1D0+0.02D0*P2GA**2)) | |
21619 | XGA=Q2GA/(W2GA+VINT(307)+VINT(308)) | |
21620 | ELSE | |
21621 | RDRDS=1.5D-4*W2GA**2.167D0/((Q2GA+0.041D0*W2GA)**2* | |
21622 | & Q2GA**0.57D0) | |
21623 | XGA=Q2GA/(W2GA+Q2GA-PMAS(PYCOMP(MINT(10+ISDE)),1)**2) | |
21624 | ENDIF | |
21625 | COMFAC=COMFAC*EXP(-MAX(1D-10,RDRDS)) | |
21626 | IF(MSTP(19).EQ.4) COMFAC=COMFAC/MAX(1D-2,1D0-XGA) | |
21627 | ENDIF | |
21628 | DO 390 I=MMINA,MMAXA | |
21629 | IF(I.EQ.0.OR.KFAC(ISDE,I).EQ.0) GOTO 390 | |
21630 | IF(IABS(I).LT.10.AND.IABS(I).GT.MSTP(58)) GOTO 390 | |
21631 | EI=KCHG(IABS(I),1)/3D0 | |
21632 | NCHN=NCHN+1 | |
21633 | ISIG(NCHN,ISDE)=I | |
21634 | ISIG(NCHN,3-ISDE)=22 | |
21635 | ISIG(NCHN,3)=1 | |
21636 | SIGH(NCHN)=COMFAC*EI**2 | |
21637 | 390 CONTINUE | |
21638 | ENDIF | |
21639 | ||
21640 | ELSE | |
21641 | IF(ISUB.EQ.114.OR.ISUB.EQ.115) THEN | |
21642 | C...g + g -> gamma + gamma or g + g -> g + gamma | |
21643 | A0STUR=0D0 | |
21644 | A0STUI=0D0 | |
21645 | A0TSUR=0D0 | |
21646 | A0TSUI=0D0 | |
21647 | A0UTSR=0D0 | |
21648 | A0UTSI=0D0 | |
21649 | A1STUR=0D0 | |
21650 | A1STUI=0D0 | |
21651 | A2STUR=0D0 | |
21652 | A2STUI=0D0 | |
21653 | ALST=LOG(-SH/TH) | |
21654 | ALSU=LOG(-SH/UH) | |
21655 | ALTU=LOG(TH/UH) | |
21656 | IMAX=2*MSTP(1) | |
21657 | IF(MSTP(38).GE.1.AND.MSTP(38).LE.8) IMAX=MSTP(38) | |
21658 | DO 400 I=1,IMAX | |
21659 | EI=KCHG(IABS(I),1)/3D0 | |
21660 | EIWT=EI**2 | |
21661 | IF(ISUB.EQ.115) EIWT=EI | |
21662 | SQMQ=PMAS(I,1)**2 | |
21663 | EPSS=4D0*SQMQ/SH | |
21664 | EPST=4D0*SQMQ/TH | |
21665 | EPSU=4D0*SQMQ/UH | |
21666 | IF((MSTP(38).GE.1.AND.MSTP(38).LE.8).OR.EPSS.LT.1D-4) THEN | |
21667 | B0STUR=1D0+(TH-UH)/SH*ALTU+0.5D0*(TH2+UH2)/SH2*(ALTU**2+ | |
21668 | & PARU(1)**2) | |
21669 | B0STUI=0D0 | |
21670 | B0TSUR=1D0+(SH-UH)/TH*ALSU+0.5D0*(SH2+UH2)/TH2*ALSU**2 | |
21671 | B0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*ALSU) | |
21672 | B0UTSR=1D0+(SH-TH)/UH*ALST+0.5D0*(SH2+TH2)/UH2*ALST**2 | |
21673 | B0UTSI=-PARU(1)*((SH-TH)/UH+(SH2+TH2)/UH2*ALST) | |
21674 | B1STUR=-1D0 | |
21675 | B1STUI=0D0 | |
21676 | B2STUR=-1D0 | |
21677 | B2STUI=0D0 | |
21678 | ELSE | |
21679 | CALL PYWAUX(1,EPSS,W1SR,W1SI) | |
21680 | CALL PYWAUX(1,EPST,W1TR,W1TI) | |
21681 | CALL PYWAUX(1,EPSU,W1UR,W1UI) | |
21682 | CALL PYWAUX(2,EPSS,W2SR,W2SI) | |
21683 | CALL PYWAUX(2,EPST,W2TR,W2TI) | |
21684 | CALL PYWAUX(2,EPSU,W2UR,W2UI) | |
21685 | CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI) | |
21686 | CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI) | |
21687 | CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI) | |
21688 | CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI) | |
21689 | CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI) | |
21690 | CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI) | |
21691 | B0STUR=1D0+(1D0+2D0*TH/SH)*W1TR+(1D0+2D0*UH/SH)*W1UR+ | |
21692 | & 0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TR+W2UR)- | |
21693 | & 0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTR+Y3TUSR)- | |
21694 | & 0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUR+Y3UTSR)+ | |
21695 | & 0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+ | |
21696 | & 0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR) | |
21697 | B0STUI=(1D0+2D0*TH/SH)*W1TI+(1D0+2D0*UH/SH)*W1UI+ | |
21698 | & 0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TI+W2UI)- | |
21699 | & 0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTI+Y3TUSI)- | |
21700 | & 0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUI+Y3UTSI)+ | |
21701 | & 0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+ | |
21702 | & 0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI) | |
21703 | B0TSUR=1D0+(1D0+2D0*SH/TH)*W1SR+(1D0+2D0*UH/TH)*W1UR+ | |
21704 | & 0.5D0*((SH2+UH2)/TH2-EPST)*(W2SR+W2UR)- | |
21705 | & 0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSR+Y3SUTR)- | |
21706 | & 0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUR+Y3USTR)+ | |
21707 | & 0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+ | |
21708 | & 0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR) | |
21709 | B0TSUI=(1D0+2D0*SH/TH)*W1SI+(1D0+2D0*UH/TH)*W1UI+ | |
21710 | & 0.5D0*((SH2+UH2)/TH2-EPST)*(W2SI+W2UI)- | |
21711 | & 0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSI+Y3SUTI)- | |
21712 | & 0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUI+Y3USTI)+ | |
21713 | & 0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+ | |
21714 | & 0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI) | |
21715 | B0UTSR=1D0+(1D0+2D0*TH/UH)*W1TR+(1D0+2D0*SH/UH)*W1SR+ | |
21716 | & 0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TR+W2SR)- | |
21717 | & 0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTR+Y3TSUR)- | |
21718 | & 0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSR+Y3STUR)+ | |
21719 | & 0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+ | |
21720 | & 0.5D0*EPST*EPSS)*(Y3TUSR+Y3SUTR) | |
21721 | B0UTSI=(1D0+2D0*TH/UH)*W1TI+(1D0+2D0*SH/UH)*W1SI+ | |
21722 | & 0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TI+W2SI)- | |
21723 | & 0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTI+Y3TSUI)- | |
21724 | & 0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSI+Y3STUI)+ | |
21725 | & 0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+ | |
21726 | & 0.5D0*EPST*EPSS)*(Y3TUSI+Y3SUTI) | |
21727 | B1STUR=-1D0-0.25D0*(EPSS+EPST+EPSU)*(W2SR+W2TR+W2UR)+ | |
21728 | & 0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTR+Y3TUSR)+ | |
21729 | & 0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR)+ | |
21730 | & 0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR) | |
21731 | B1STUI=-0.25D0*(EPSS+EPST+EPSU)*(W2SI+W2TI+W2UI)+ | |
21732 | & 0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTI+Y3TUSI)+ | |
21733 | & 0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI)+ | |
21734 | & 0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI) | |
21735 | B2STUR=-1D0+0.125D0*EPSS*EPST*(Y3SUTR+Y3TUSR)+ | |
21736 | & 0.125D0*EPSS*EPSU*(Y3STUR+Y3UTSR)+ | |
21737 | & 0.125D0*EPST*EPSU*(Y3TSUR+Y3USTR) | |
21738 | B2STUI=0.125D0*EPSS*EPST*(Y3SUTI+Y3TUSI)+ | |
21739 | & 0.125D0*EPSS*EPSU*(Y3STUI+Y3UTSI)+ | |
21740 | & 0.125D0*EPST*EPSU*(Y3TSUI+Y3USTI) | |
21741 | ENDIF | |
21742 | A0STUR=A0STUR+EIWT*B0STUR | |
21743 | A0STUI=A0STUI+EIWT*B0STUI | |
21744 | A0TSUR=A0TSUR+EIWT*B0TSUR | |
21745 | A0TSUI=A0TSUI+EIWT*B0TSUI | |
21746 | A0UTSR=A0UTSR+EIWT*B0UTSR | |
21747 | A0UTSI=A0UTSI+EIWT*B0UTSI | |
21748 | A1STUR=A1STUR+EIWT*B1STUR | |
21749 | A1STUI=A1STUI+EIWT*B1STUI | |
21750 | A2STUR=A2STUR+EIWT*B2STUR | |
21751 | A2STUI=A2STUI+EIWT*B2STUI | |
21752 | 400 CONTINUE | |
21753 | ASQSUM=A0STUR**2+A0STUI**2+A0TSUR**2+A0TSUI**2+A0UTSR**2+ | |
21754 | & A0UTSI**2+4D0*A1STUR**2+4D0*A1STUI**2+A2STUR**2+A2STUI**2 | |
21755 | FACGG=COMFAC*FACA/(16D0*PARU(1)**2)*AS**2*AEM**2*ASQSUM | |
21756 | FACGP=COMFAC*FACA*5D0/(192D0*PARU(1)**2)*AS**3*AEM*ASQSUM | |
21757 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 410 | |
21758 | NCHN=NCHN+1 | |
21759 | ISIG(NCHN,1)=21 | |
21760 | ISIG(NCHN,2)=21 | |
21761 | ISIG(NCHN,3)=1 | |
21762 | IF(ISUB.EQ.114) SIGH(NCHN)=0.5D0*FACGG | |
21763 | IF(ISUB.EQ.115) SIGH(NCHN)=FACGP | |
21764 | 410 CONTINUE | |
21765 | ||
21766 | ELSEIF(ISUB.EQ.131.OR.ISUB.EQ.132) THEN | |
21767 | C...f + gamma*_(T,L) -> f + g (q + gamma*_(T,L) -> q + g only) | |
21768 | PH=0D0 | |
21769 | IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0) | |
21770 | & PH=VINT(3)**2 | |
21771 | IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0) | |
21772 | & PH=VINT(4)**2 | |
21773 | IF(ISUB.EQ.131) THEN | |
21774 | FGQ=COMFAC*AS*AEM*8D0/3D0*SH**2/(SH+PH)**2* | |
21775 | & ((SH2+UH2-2D0*PH*TH)/(-SH*UH)-2D0*PH*TH/(SH+PH)**2) | |
21776 | ELSE | |
21777 | FGQ=COMFAC*AS*AEM*8D0/3D0*SH**2/(SH+PH)**4*(-4D0*PH*TH) | |
21778 | ENDIF | |
21779 | DO 430 I=MMINA,MMAXA | |
21780 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 430 | |
21781 | EI=KCHG(IABS(I),1)/3D0 | |
21782 | FACGQ=FGQ*EI**2 | |
21783 | DO 420 ISDE=1,2 | |
21784 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 420 | |
21785 | IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 420 | |
21786 | NCHN=NCHN+1 | |
21787 | ISIG(NCHN,ISDE)=I | |
21788 | ISIG(NCHN,3-ISDE)=22 | |
21789 | ISIG(NCHN,3)=1 | |
21790 | SIGH(NCHN)=FACGQ | |
21791 | 420 CONTINUE | |
21792 | 430 CONTINUE | |
21793 | ||
21794 | ELSEIF(ISUB.EQ.133.OR.ISUB.EQ.134) THEN | |
21795 | C...f + gamma*_(T,L) -> f + gamma | |
21796 | PH=0D0 | |
21797 | IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0) | |
21798 | & PH=VINT(3)**2 | |
21799 | IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0) | |
21800 | & PH=VINT(4)**2 | |
21801 | IF(ISUB.EQ.133) THEN | |
21802 | FGQ=COMFAC*AEM**2*2D0*SH**2/(SH+PH)**2* | |
21803 | & ((SH2+UH2-2D0*PH*TH)/(-SH*UH)-2D0*PH*TH/(SH+PH)**2) | |
21804 | ELSE | |
21805 | FGQ=COMFAC*AEM**2*2D0*SH**2/(SH+PH)**4*(-4D0*PH*TH) | |
21806 | ENDIF | |
21807 | DO 450 I=MMINA,MMAXA | |
21808 | IF(I.EQ.0) GOTO 450 | |
21809 | EI=KCHG(IABS(I),1)/3D0 | |
21810 | FACGQ=FGQ*EI**4 | |
21811 | DO 440 ISDE=1,2 | |
21812 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 440 | |
21813 | IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 440 | |
21814 | NCHN=NCHN+1 | |
21815 | ISIG(NCHN,ISDE)=I | |
21816 | ISIG(NCHN,3-ISDE)=22 | |
21817 | ISIG(NCHN,3)=1 | |
21818 | SIGH(NCHN)=FACGQ | |
21819 | 440 CONTINUE | |
21820 | 450 CONTINUE | |
21821 | ||
21822 | ELSEIF(ISUB.EQ.135.OR.ISUB.EQ.136) THEN | |
21823 | C...g + gamma*_(T,L) -> f + fbar (g + gamma*_(T,L) -> q + qbar only) | |
21824 | PH=0D0 | |
21825 | IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0) | |
21826 | & PH=VINT(3)**2 | |
21827 | IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0) | |
21828 | & PH=VINT(4)**2 | |
21829 | CALL PYWIDT(21,SH,WDTP,WDTE) | |
21830 | WDTESU=0D0 | |
21831 | DO 460 I=1,MIN(8,MDCY(21,3)) | |
21832 | EF=KCHG(I,1)/3D0 | |
21833 | WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ | |
21834 | & WDTE(I,4)) | |
21835 | 460 CONTINUE | |
21836 | IF(ISUB.EQ.135) THEN | |
21837 | FACQQ=COMFAC*AEM*AS*WDTESU*SH**2/(SH+PH)**2* | |
21838 | & ((TH2+UH2-2D0*PH*SH)/(TH*UH)+4D0*PH*SH/(SH+PH)**2) | |
21839 | ELSE | |
21840 | FACQQ=COMFAC*AEM*AS*WDTESU*SH**2/(SH+PH)**4*8D0*PH*SH | |
21841 | ENDIF | |
21842 | IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN | |
21843 | NCHN=NCHN+1 | |
21844 | ISIG(NCHN,1)=21 | |
21845 | ISIG(NCHN,2)=22 | |
21846 | ISIG(NCHN,3)=1 | |
21847 | SIGH(NCHN)=FACQQ | |
21848 | ENDIF | |
21849 | IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN | |
21850 | NCHN=NCHN+1 | |
21851 | ISIG(NCHN,1)=22 | |
21852 | ISIG(NCHN,2)=21 | |
21853 | ISIG(NCHN,3)=1 | |
21854 | SIGH(NCHN)=FACQQ | |
21855 | ENDIF | |
21856 | ||
21857 | ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN | |
21858 | C...gamma*_(T,L) + gamma*_(T,L) -> f + fbar | |
21859 | PH1=0D0 | |
21860 | IF(VINT(3).LT.0D0) PH1=VINT(3)**2 | |
21861 | PH2=0D0 | |
21862 | IF(VINT(4).LT.0D0) PH2=VINT(4)**2 | |
21863 | CALL PYWIDT(22,SH,WDTP,WDTE) | |
21864 | WDTESU=0D0 | |
21865 | DO 470 I=1,MIN(12,MDCY(22,3)) | |
21866 | IF(I.LE.8) EF= KCHG(I,1)/3D0 | |
21867 | IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3D0 | |
21868 | WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ | |
21869 | & WDTE(I,4)) | |
21870 | 470 CONTINUE | |
21871 | DLAMB2=(TH+UH)**2-4D0*PH1*PH2 | |
21872 | IF(ISUB.EQ.137) THEN | |
21873 | FPARAM=-SH*(TH+UH)/DLAMB2 | |
21874 | FACFF=COMFAC*AEM**2*WDTESU*2D0*SH2/(DLAMB2*TH2*UH2)* | |
21875 | & (TH*UH-PH1*PH2)*((TH2+UH2)*(1D0-2D0*FPARAM*(1D0-FPARAM))- | |
21876 | & 2D0*PH1*PH2*FPARAM**2) | |
21877 | ELSEIF(ISUB.EQ.138) THEN | |
21878 | FACFF=COMFAC*AEM**2*WDTESU*4D0*SH2*SH/(DLAMB2**2*TH2*UH2)* | |
21879 | & PH2*(4D0*(TH*UH-PH1*PH2)*(TH*UH+PH1*SH*(TH-UH)**2/DLAMB2)+ | |
21880 | & 2D0*PH1**2*(TH-UH)**2) | |
21881 | ELSEIF(ISUB.EQ.139) THEN | |
21882 | FACFF=COMFAC*AEM**2*WDTESU*4D0*SH2*SH/(DLAMB2**2*TH2*UH2)* | |
21883 | & PH1*(4D0*(TH*UH-PH1*PH2)*(TH*UH+PH2*SH*(TH-UH)**2/DLAMB2)+ | |
21884 | & 2D0*PH2**2*(TH-UH)**2) | |
21885 | ELSE | |
21886 | FACFF=COMFAC*AEM**2*WDTESU*32D0*SH2**2/(DLAMB2**3*TH2*UH2)* | |
21887 | & PH1*PH2*(TH*UH-PH1*PH2)*(TH-UH)**2 | |
21888 | ENDIF | |
21889 | IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN | |
21890 | NCHN=NCHN+1 | |
21891 | ISIG(NCHN,1)=22 | |
21892 | ISIG(NCHN,2)=22 | |
21893 | ISIG(NCHN,3)=1 | |
21894 | SIGH(NCHN)=FACFF | |
21895 | ENDIF | |
21896 | ||
21897 | ENDIF | |
21898 | ENDIF | |
21899 | ||
21900 | RETURN | |
21901 | END | |
21902 | ||
21903 | C********************************************************************* | |
21904 | ||
21905 | C...PYSGHF | |
21906 | C...Subprocess cross sections for heavy flavour production, | |
21907 | C...open and closed. | |
21908 | C...Auxiliary to PYSIGH. | |
21909 | ||
21910 | SUBROUTINE PYSGHF(NCHN,SIGS) | |
21911 | ||
21912 | C...Double precision and integer declarations | |
21913 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
21914 | IMPLICIT INTEGER(I-N) | |
21915 | INTEGER PYK,PYCHGE,PYCOMP | |
21916 | C...Parameter statement to help give large particle numbers. | |
21917 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
21918 | &KEXCIT=4000000,KDIMEN=5000000) | |
21919 | C...Commonblocks | |
21920 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
21921 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
21922 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
21923 | COMMON/PYINT1/MINT(400),VINT(400) | |
21924 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
21925 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
21926 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
21927 | COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, | |
21928 | &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, | |
21929 | &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, | |
21930 | &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR | |
21931 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, | |
21932 | &/PYINT4/,/PYSGCM/ | |
21933 | C...Local arrays | |
21934 | DIMENSION WDTP(0:400),WDTE(0:400,0:5) | |
21935 | ||
21936 | C...Differential cross section expressions. | |
21937 | ||
21938 | IF(ISUB.LE.100) THEN | |
21939 | IF(ISUB.EQ.81) THEN | |
21940 | C...q + qbar -> Q + Qbar | |
21941 | SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH | |
21942 | THQ=-0.5D0*SH*(1D0-BE34*CTH) | |
21943 | UHQ=-0.5D0*SH*(1D0+BE34*CTH) | |
21944 | FACQQB=COMFAC*AS**2*4D0/9D0*((THQ**2+UHQ**2)/SH2+ | |
21945 | & 2D0*SQMAVG/SH) | |
21946 | IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQMAVG,0D0) | |
21947 | WID2=1D0 | |
21948 | IF(MINT(55).EQ.6) WID2=WIDS(6,1) | |
21949 | IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) | |
21950 | FACQQB=FACQQB*WID2 | |
21951 | DO 100 I=MMINA,MMAXA | |
21952 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
21953 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 | |
21954 | NCHN=NCHN+1 | |
21955 | ISIG(NCHN,1)=I | |
21956 | ISIG(NCHN,2)=-I | |
21957 | ISIG(NCHN,3)=1 | |
21958 | SIGH(NCHN)=FACQQB | |
21959 | 100 CONTINUE | |
21960 | ||
21961 | ELSEIF(ISUB.EQ.82) THEN | |
21962 | C...g + g -> Q + Qbar | |
21963 | SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH | |
21964 | THQ=-0.5D0*SH*(1D0-BE34*CTH) | |
21965 | UHQ=-0.5D0*SH*(1D0+BE34*CTH) | |
21966 | THUHQ=THQ*UHQ-SQMAVG*SH | |
21967 | IF(MSTP(34).EQ.0) THEN | |
21968 | FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 | |
21969 | FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 | |
21970 | ELSE | |
21971 | FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
21972 | & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) | |
21973 | FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
21974 | & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) | |
21975 | ENDIF | |
21976 | FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1 | |
21977 | FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2 | |
21978 | IF(MSTP(35).GE.1) THEN | |
21979 | FATRE=PYHFTH(SH,SQMAVG,2D0/7D0) | |
21980 | FACQQ1=FACQQ1*FATRE | |
21981 | FACQQ2=FACQQ2*FATRE | |
21982 | ENDIF | |
21983 | WID2=1D0 | |
21984 | IF(MINT(55).EQ.6) WID2=WIDS(6,1) | |
21985 | IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) | |
21986 | FACQQ1=FACQQ1*WID2 | |
21987 | FACQQ2=FACQQ2*WID2 | |
21988 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 110 | |
21989 | NCHN=NCHN+1 | |
21990 | ISIG(NCHN,1)=21 | |
21991 | ISIG(NCHN,2)=21 | |
21992 | ISIG(NCHN,3)=1 | |
21993 | SIGH(NCHN)=FACQQ1 | |
21994 | NCHN=NCHN+1 | |
21995 | ISIG(NCHN,1)=21 | |
21996 | ISIG(NCHN,2)=21 | |
21997 | ISIG(NCHN,3)=2 | |
21998 | SIGH(NCHN)=FACQQ2 | |
21999 | 110 CONTINUE | |
22000 | ||
22001 | ELSEIF(ISUB.EQ.83) THEN | |
22002 | C...f + q -> f' + Q | |
22003 | FACQQS=COMFAC*(0.5D0*AEM/XW)**2*SH*(SH-SQM3)/(SQMW-TH)**2 | |
22004 | FACQQU=COMFAC*(0.5D0*AEM/XW)**2*UH*(UH-SQM3)/(SQMW-TH)**2 | |
22005 | DO 130 I=MMIN1,MMAX1 | |
22006 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 130 | |
22007 | DO 120 J=MMIN2,MMAX2 | |
22008 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 120 | |
22009 | IF(I*J.GT.0.AND.MOD(IABS(I+J),2).EQ.0) GOTO 120 | |
22010 | IF(I*J.LT.0.AND.MOD(IABS(I+J),2).EQ.1) GOTO 120 | |
22011 | IF(IABS(I).LT.MINT(55).AND.MOD(IABS(I+MINT(55)),2).EQ.1) | |
22012 | & THEN | |
22013 | NCHN=NCHN+1 | |
22014 | ISIG(NCHN,1)=I | |
22015 | ISIG(NCHN,2)=J | |
22016 | ISIG(NCHN,3)=1 | |
22017 | IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2, | |
22018 | & (IABS(I)+1)/2)*VINT(180+J) | |
22019 | IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(I)/2, | |
22020 | & (MINT(55)+1)/2)*VINT(180+J) | |
22021 | WID2=1D0 | |
22022 | IF(I.GT.0) THEN | |
22023 | IF(MINT(55).EQ.6) WID2=WIDS(6,2) | |
22024 | IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= | |
22025 | & WIDS(MINT(55),2) | |
22026 | ELSE | |
22027 | IF(MINT(55).EQ.6) WID2=WIDS(6,3) | |
22028 | IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= | |
22029 | & WIDS(MINT(55),3) | |
22030 | ENDIF | |
22031 | IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2 | |
22032 | IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2 | |
22033 | ENDIF | |
22034 | IF(IABS(J).LT.MINT(55).AND.MOD(IABS(J+MINT(55)),2).EQ.1) | |
22035 | & THEN | |
22036 | NCHN=NCHN+1 | |
22037 | ISIG(NCHN,1)=I | |
22038 | ISIG(NCHN,2)=J | |
22039 | ISIG(NCHN,3)=2 | |
22040 | IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2, | |
22041 | & (IABS(J)+1)/2)*VINT(180+I) | |
22042 | IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(J)/2, | |
22043 | & (MINT(55)+1)/2)*VINT(180+I) | |
22044 | IF(J.GT.0) THEN | |
22045 | IF(MINT(55).EQ.6) WID2=WIDS(6,2) | |
22046 | IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= | |
22047 | & WIDS(MINT(55),2) | |
22048 | ELSE | |
22049 | IF(MINT(55).EQ.6) WID2=WIDS(6,3) | |
22050 | IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= | |
22051 | & WIDS(MINT(55),3) | |
22052 | ENDIF | |
22053 | IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2 | |
22054 | IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2 | |
22055 | ENDIF | |
22056 | 120 CONTINUE | |
22057 | 130 CONTINUE | |
22058 | ||
22059 | ELSEIF(ISUB.EQ.84) THEN | |
22060 | C...g + gamma -> Q + Qbar | |
22061 | SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH | |
22062 | THQ=-0.5D0*SH*(1D0-BE34*CTH) | |
22063 | UHQ=-0.5D0*SH*(1D0+BE34*CTH) | |
22064 | FACQQ=COMFAC*AS*AEM*(KCHG(IABS(MINT(55)),1)/3D0)**2* | |
22065 | & (THQ**2+UHQ**2+4D0*SQMAVG*SH*(1D0-SQMAVG*SH/(THQ*UHQ)))/ | |
22066 | & (THQ*UHQ) | |
22067 | IF(MSTP(35).GE.1) FACQQ=FACQQ*PYHFTH(SH,SQMAVG,0D0) | |
22068 | WID2=1D0 | |
22069 | IF(MINT(55).EQ.6) WID2=WIDS(6,1) | |
22070 | IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) | |
22071 | FACQQ=FACQQ*WID2 | |
22072 | IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN | |
22073 | NCHN=NCHN+1 | |
22074 | ISIG(NCHN,1)=21 | |
22075 | ISIG(NCHN,2)=22 | |
22076 | ISIG(NCHN,3)=1 | |
22077 | SIGH(NCHN)=FACQQ | |
22078 | ENDIF | |
22079 | IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN | |
22080 | NCHN=NCHN+1 | |
22081 | ISIG(NCHN,1)=22 | |
22082 | ISIG(NCHN,2)=21 | |
22083 | ISIG(NCHN,3)=1 | |
22084 | SIGH(NCHN)=FACQQ | |
22085 | ENDIF | |
22086 | ||
22087 | ELSEIF(ISUB.EQ.85) THEN | |
22088 | C...gamma + gamma -> F + Fbar (heavy fermion, quark or lepton) | |
22089 | SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH | |
22090 | THQ=-0.5D0*SH*(1D0-BE34*CTH) | |
22091 | UHQ=-0.5D0*SH*(1D0+BE34*CTH) | |
22092 | FACFF=COMFAC*AEM**2*(KCHG(IABS(MINT(56)),1)/3D0)**4*2D0* | |
22093 | & ((1D0-PARJ(131)*PARJ(132))*(THQ*UHQ-SQMAVG*SH)* | |
22094 | & (UHQ**2+THQ**2+2D0*SQMAVG*SH)+(1D0+PARJ(131)*PARJ(132))* | |
22095 | & SQMAVG*SH**2*(SH-2D0*SQMAVG))/(THQ*UHQ)**2 | |
22096 | IF(IABS(MINT(56)).LT.10) FACFF=3D0*FACFF | |
22097 | IF(IABS(MINT(56)).LT.10.AND.MSTP(35).GE.1) | |
22098 | & FACFF=FACFF*PYHFTH(SH,SQMAVG,1D0) | |
22099 | WID2=1D0 | |
22100 | IF(MINT(56).EQ.6) WID2=WIDS(6,1) | |
22101 | IF(MINT(56).EQ.7.OR.MINT(56).EQ.8) WID2=WIDS(MINT(56),1) | |
22102 | IF(MINT(56).EQ.17) WID2=WIDS(17,1) | |
22103 | FACFF=FACFF*WID2 | |
22104 | IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN | |
22105 | NCHN=NCHN+1 | |
22106 | ISIG(NCHN,1)=22 | |
22107 | ISIG(NCHN,2)=22 | |
22108 | ISIG(NCHN,3)=1 | |
22109 | SIGH(NCHN)=FACFF | |
22110 | ENDIF | |
22111 | ||
22112 | ELSEIF(ISUB.EQ.86) THEN | |
22113 | C...g + g -> J/Psi + g | |
22114 | FACQQG=COMFAC*AS**3*(5D0/9D0)*PARP(38)*SQRT(SQM3)* | |
22115 | & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ | |
22116 | & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 | |
22117 | IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN | |
22118 | NCHN=NCHN+1 | |
22119 | ISIG(NCHN,1)=21 | |
22120 | ISIG(NCHN,2)=21 | |
22121 | ISIG(NCHN,3)=1 | |
22122 | SIGH(NCHN)=FACQQG | |
22123 | ENDIF | |
22124 | ||
22125 | ELSEIF(ISUB.EQ.87) THEN | |
22126 | C...g + g -> chi_0c + g | |
22127 | PGTW=(SH*TH+TH*UH+UH*SH)/SH2 | |
22128 | QGTW=(SH*TH*UH)/SH**3 | |
22129 | RGTW=SQM3/SH | |
22130 | FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)* | |
22131 | & (9D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)- | |
22132 | & 6D0*RGTW*PGTW**3*QGTW*(2D0*RGTW**4-5D0*RGTW**2*PGTW+PGTW**2)- | |
22133 | & PGTW**2*QGTW**2*(RGTW**4+2D0*RGTW**2*PGTW-PGTW**2)+ | |
22134 | & 2D0*RGTW*PGTW*QGTW**3*(RGTW**2-PGTW)+6D0*RGTW**2*QGTW**4)/ | |
22135 | & (QGTW*(QGTW-RGTW*PGTW)**4) | |
22136 | IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN | |
22137 | NCHN=NCHN+1 | |
22138 | ISIG(NCHN,1)=21 | |
22139 | ISIG(NCHN,2)=21 | |
22140 | ISIG(NCHN,3)=1 | |
22141 | SIGH(NCHN)=FACQQG | |
22142 | ENDIF | |
22143 | ||
22144 | ELSEIF(ISUB.EQ.88) THEN | |
22145 | C...g + g -> chi_1c + g | |
22146 | PGTW=(SH*TH+TH*UH+UH*SH)/SH2 | |
22147 | QGTW=(SH*TH*UH)/SH**3 | |
22148 | RGTW=SQM3/SH | |
22149 | FACQQG=COMFAC*AS**3*12D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)* | |
22150 | & PGTW**2*(RGTW*PGTW**2*(RGTW**2-4D0*PGTW)+2D0*QGTW*(-RGTW**4+ | |
22151 | & 5D0*RGTW**2*PGTW+PGTW**2)-15D0*RGTW*QGTW**2)/ | |
22152 | & (QGTW-RGTW*PGTW)**4 | |
22153 | IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN | |
22154 | NCHN=NCHN+1 | |
22155 | ISIG(NCHN,1)=21 | |
22156 | ISIG(NCHN,2)=21 | |
22157 | ISIG(NCHN,3)=1 | |
22158 | SIGH(NCHN)=FACQQG | |
22159 | ENDIF | |
22160 | ||
22161 | ELSEIF(ISUB.EQ.89) THEN | |
22162 | C...g + g -> chi_2c + g | |
22163 | PGTW=(SH*TH+TH*UH+UH*SH)/SH2 | |
22164 | QGTW=(SH*TH*UH)/SH**3 | |
22165 | RGTW=SQM3/SH | |
22166 | FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)* | |
22167 | & (12D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)- | |
22168 | & 3D0*RGTW*PGTW**3*QGTW*(8D0*RGTW**4-RGTW**2*PGTW+4D0*PGTW**2)+ | |
22169 | & 2D0*PGTW**2*QGTW**2*(-7D0*RGTW**4+43D0*RGTW**2*PGTW+PGTW**2)+ | |
22170 | & RGTW*PGTW*QGTW**3*(16D0*RGTW**2-61D0*PGTW)+12D0*RGTW**2* | |
22171 | & QGTW**4)/(QGTW*(QGTW-RGTW*PGTW)**4) | |
22172 | IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN | |
22173 | NCHN=NCHN+1 | |
22174 | ISIG(NCHN,1)=21 | |
22175 | ISIG(NCHN,2)=21 | |
22176 | ISIG(NCHN,3)=1 | |
22177 | SIGH(NCHN)=FACQQG | |
22178 | ENDIF | |
22179 | ENDIF | |
22180 | ||
22181 | ELSEIF(ISUB.LE.200) THEN | |
22182 | IF(ISUB.EQ.104) THEN | |
22183 | C...g + g -> chi_c0. | |
22184 | KC=PYCOMP(10441) | |
22185 | FACBW=COMFAC*12D0*AS**2*PARP(39)*PMAS(KC,2)/ | |
22186 | & ((SH-PMAS(KC,1)**2)**2+(PMAS(KC,1)*PMAS(KC,2))**2) | |
22187 | IF(ABS(SQRT(SH)-PMAS(KC,1)).GT.50D0*PMAS(KC,2)) FACBW=0D0 | |
22188 | IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN | |
22189 | NCHN=NCHN+1 | |
22190 | ISIG(NCHN,1)=21 | |
22191 | ISIG(NCHN,2)=21 | |
22192 | ISIG(NCHN,3)=1 | |
22193 | SIGH(NCHN)=FACBW | |
22194 | ENDIF | |
22195 | ||
22196 | ELSEIF(ISUB.EQ.105) THEN | |
22197 | C...g + g -> chi_c2. | |
22198 | KC=PYCOMP(445) | |
22199 | FACBW=COMFAC*16D0*AS**2*PARP(39)*PMAS(KC,2)/ | |
22200 | & ((SH-PMAS(KC,1)**2)**2+(PMAS(KC,1)*PMAS(KC,2))**2) | |
22201 | IF(ABS(SQRT(SH)-PMAS(KC,1)).GT.50D0*PMAS(KC,2)) FACBW=0D0 | |
22202 | IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN | |
22203 | NCHN=NCHN+1 | |
22204 | ISIG(NCHN,1)=21 | |
22205 | ISIG(NCHN,2)=21 | |
22206 | ISIG(NCHN,3)=1 | |
22207 | SIGH(NCHN)=FACBW | |
22208 | ENDIF | |
22209 | ||
22210 | ELSEIF(ISUB.EQ.106) THEN | |
22211 | C...g + g -> J/Psi + gamma. | |
22212 | EQ=2D0/3D0 | |
22213 | FACQQG=COMFAC*AEM*EQ**2*AS**2*(4D0/3D0)*PARP(38)*SQRT(SQM3)* | |
22214 | & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ | |
22215 | & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 | |
22216 | IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN | |
22217 | NCHN=NCHN+1 | |
22218 | ISIG(NCHN,1)=21 | |
22219 | ISIG(NCHN,2)=21 | |
22220 | ISIG(NCHN,3)=1 | |
22221 | SIGH(NCHN)=FACQQG | |
22222 | ENDIF | |
22223 | ||
22224 | ELSEIF(ISUB.EQ.107) THEN | |
22225 | C...g + gamma -> J/Psi + g. | |
22226 | EQ=2D0/3D0 | |
22227 | FACQQG=COMFAC*AEM*EQ**2*AS**2*(32D0/3D0)*PARP(38)*SQRT(SQM3)* | |
22228 | & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ | |
22229 | & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 | |
22230 | IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN | |
22231 | NCHN=NCHN+1 | |
22232 | ISIG(NCHN,1)=21 | |
22233 | ISIG(NCHN,2)=22 | |
22234 | ISIG(NCHN,3)=1 | |
22235 | SIGH(NCHN)=FACQQG | |
22236 | ENDIF | |
22237 | IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN | |
22238 | NCHN=NCHN+1 | |
22239 | ISIG(NCHN,1)=22 | |
22240 | ISIG(NCHN,2)=21 | |
22241 | ISIG(NCHN,3)=1 | |
22242 | SIGH(NCHN)=FACQQG | |
22243 | ENDIF | |
22244 | ||
22245 | ELSEIF(ISUB.EQ.108) THEN | |
22246 | C...gamma + gamma -> J/Psi + gamma. | |
22247 | EQ=2D0/3D0 | |
22248 | FACQQG=COMFAC*AEM**3*EQ**6*384D0*PARP(38)*SQRT(SQM3)* | |
22249 | & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ | |
22250 | & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 | |
22251 | IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN | |
22252 | NCHN=NCHN+1 | |
22253 | ISIG(NCHN,1)=22 | |
22254 | ISIG(NCHN,2)=22 | |
22255 | ISIG(NCHN,3)=1 | |
22256 | SIGH(NCHN)=FACQQG | |
22257 | ENDIF | |
22258 | ENDIF | |
22259 | ENDIF | |
22260 | ||
22261 | RETURN | |
22262 | END | |
22263 | ||
22264 | C********************************************************************* | |
22265 | ||
22266 | C...PYSGWZ | |
22267 | C...Subprocess cross sections for W/Z processes, | |
22268 | C...except that longitudinal WW scattering is in Higgs sector. | |
22269 | C...Auxiliary to PYSIGH. | |
22270 | ||
22271 | SUBROUTINE PYSGWZ(NCHN,SIGS) | |
22272 | ||
22273 | C...Double precision and integer declarations | |
22274 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
22275 | IMPLICIT INTEGER(I-N) | |
22276 | INTEGER PYK,PYCHGE,PYCOMP | |
22277 | C...Parameter statement to help give large particle numbers. | |
22278 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
22279 | &KEXCIT=4000000,KDIMEN=5000000) | |
22280 | C...Commonblocks | |
22281 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
22282 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
22283 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
22284 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
22285 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
22286 | COMMON/PYINT1/MINT(400),VINT(400) | |
22287 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
22288 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
22289 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
22290 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
22291 | COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, | |
22292 | &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, | |
22293 | &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, | |
22294 | &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR | |
22295 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
22296 | &/PYINT2/,/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/ | |
22297 | C...Local arrays and complex numbers | |
22298 | DIMENSION WDTP(0:400),WDTE(0:400,0:5),HGZ(6,3),HL3(3),HR3(3), | |
22299 | &HL4(3),HR4(3) | |
22300 | COMPLEX*16 COULCK,COULCP,COULCD,COULCR,COULCS | |
22301 | ||
22302 | C...Differential cross section expressions. | |
22303 | ||
22304 | IF(ISUB.LE.20) THEN | |
22305 | IF(ISUB.EQ.1) THEN | |
22306 | C...f + fbar -> gamma*/Z0 | |
22307 | MINT(61)=2 | |
22308 | CALL PYWIDT(23,SH,WDTP,WDTE) | |
22309 | HS=SHR*WDTP(0) | |
22310 | FACZ=4D0*COMFAC*3D0 | |
22311 | HP0=AEM/3D0*SH | |
22312 | HP1=AEM/3D0*XWC*SH | |
22313 | DO 100 I=MMINA,MMAXA | |
22314 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 | |
22315 | EI=KCHG(IABS(I),1)/3D0 | |
22316 | AI=SIGN(1D0,EI) | |
22317 | VI=AI-4D0*EI*XWV | |
22318 | HI0=HP0 | |
22319 | IF(IABS(I).LE.10) HI0=HI0*FACA/3D0 | |
22320 | HI1=HP1 | |
22321 | IF(IABS(I).LE.10) HI1=HI1*FACA/3D0 | |
22322 | NCHN=NCHN+1 | |
22323 | ISIG(NCHN,1)=I | |
22324 | ISIG(NCHN,2)=-I | |
22325 | ISIG(NCHN,3)=1 | |
22326 | SIGH(NCHN)=FACZ*(EI**2/SH2*HI0*HP0*VINT(111)+ | |
22327 | & EI*VI*(1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)* | |
22328 | & (HI0*HP1+HI1*HP0)*VINT(112)+(VI**2+AI**2)/ | |
22329 | & ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)) | |
22330 | 100 CONTINUE | |
22331 | ||
22332 | ELSEIF(ISUB.EQ.2) THEN | |
22333 | C...f + fbar' -> W+/- | |
22334 | CALL PYWIDT(24,SH,WDTP,WDTE) | |
22335 | HS=SHR*WDTP(0) | |
22336 | FACBW=4D0*COMFAC/((SH-SQMW)**2+HS**2)*3D0 | |
22337 | HP=AEM/(24D0*XW)*SH | |
22338 | DO 120 I=MMIN1,MMAX1 | |
22339 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120 | |
22340 | IA=IABS(I) | |
22341 | DO 110 J=MMIN2,MMAX2 | |
22342 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110 | |
22343 | JA=IABS(J) | |
22344 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 110 | |
22345 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
22346 | & GOTO 110 | |
22347 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
22348 | HI=HP*2D0 | |
22349 | IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 | |
22350 | NCHN=NCHN+1 | |
22351 | ISIG(NCHN,1)=I | |
22352 | ISIG(NCHN,2)=J | |
22353 | ISIG(NCHN,3)=1 | |
22354 | HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) | |
22355 | SIGH(NCHN)=HI*FACBW*HF | |
22356 | 110 CONTINUE | |
22357 | 120 CONTINUE | |
22358 | ||
22359 | ELSEIF(ISUB.EQ.15) THEN | |
22360 | C...f + fbar -> g + (gamma*/Z0) (q + qbar -> g + (gamma*/Z0) only) | |
22361 | FACZG=COMFAC*AS*AEM*(8D0/9D0)*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) | |
22362 | C...gamma, gamma/Z interference and Z couplings to final fermion pairs | |
22363 | HFGG=0D0 | |
22364 | HFGZ=0D0 | |
22365 | HFZZ=0D0 | |
22366 | RADC4=1D0+PYALPS(SQM4)/PARU(1) | |
22367 | DO 130 I=1,MIN(16,MDCY(23,3)) | |
22368 | IDC=I+MDCY(23,2)-1 | |
22369 | IF(MDME(IDC,1).LT.0) GOTO 130 | |
22370 | IMDM=0 | |
22371 | IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) | |
22372 | & IMDM=1 | |
22373 | IF(I.LE.8) THEN | |
22374 | EF=KCHG(I,1)/3D0 | |
22375 | AF=SIGN(1D0,EF+0.1D0) | |
22376 | VF=AF-4D0*EF*XWV | |
22377 | ELSEIF(I.LE.16) THEN | |
22378 | EF=KCHG(I+2,1)/3D0 | |
22379 | AF=SIGN(1D0,EF+0.1D0) | |
22380 | VF=AF-4D0*EF*XWV | |
22381 | ENDIF | |
22382 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 | |
22383 | IF(4D0*RM1.LT.1D0) THEN | |
22384 | FCOF=1D0 | |
22385 | IF(I.LE.8) FCOF=3D0*RADC4 | |
22386 | BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) | |
22387 | IF(IMDM.EQ.1) THEN | |
22388 | HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 | |
22389 | HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 | |
22390 | HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ | |
22391 | & AF**2*(1D0-4D0*RM1))*BE34 | |
22392 | ENDIF | |
22393 | ENDIF | |
22394 | 130 CONTINUE | |
22395 | C...Propagators: as simulated in PYOFSH and as desired | |
22396 | HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) | |
22397 | MINT15=MINT(15) | |
22398 | MINT(15)=1 | |
22399 | MINT(61)=1 | |
22400 | CALL PYWIDT(23,SQM4,WDTP,WDTE) | |
22401 | MINT(15)=MINT15 | |
22402 | HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) | |
22403 | HFGG=HFGG*HFAEM*VINT(111)/SQM4 | |
22404 | HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 | |
22405 | HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 | |
22406 | C...Loop over flavours; consider full gamma/Z structure | |
22407 | DO 140 I=MMINA,MMAXA | |
22408 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
22409 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 140 | |
22410 | EI=KCHG(IABS(I),1)/3D0 | |
22411 | AI=SIGN(1D0,EI) | |
22412 | VI=AI-4D0*EI*XWV | |
22413 | NCHN=NCHN+1 | |
22414 | ISIG(NCHN,1)=I | |
22415 | ISIG(NCHN,2)=-I | |
22416 | ISIG(NCHN,3)=1 | |
22417 | SIGH(NCHN)=FACZG*(EI**2*HFGG+EI*VI*HFGZ+ | |
22418 | & (VI**2+AI**2)*HFZZ)/HBW4 | |
22419 | 140 CONTINUE | |
22420 | ||
22421 | ELSEIF(ISUB.EQ.16) THEN | |
22422 | C...f + fbar' -> g + W+/- (q + qbar' -> g + W+/- only) | |
22423 | FACWG=COMFAC*AS*AEM/XW*2D0/9D0*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) | |
22424 | C...Propagators: as simulated in PYOFSH and as desired | |
22425 | HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) | |
22426 | CALL PYWIDT(24,SQM4,WDTP,WDTE) | |
22427 | GMMWC=SQRT(SQM4)*WDTP(0) | |
22428 | HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) | |
22429 | FACWG=FACWG*HBW4C/HBW4 | |
22430 | DO 160 I=MMIN1,MMAX1 | |
22431 | IA=IABS(I) | |
22432 | IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 160 | |
22433 | DO 150 J=MMIN2,MMAX2 | |
22434 | JA=IABS(J) | |
22435 | IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 150 | |
22436 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 150 | |
22437 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
22438 | WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) | |
22439 | FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
22440 | NCHN=NCHN+1 | |
22441 | ISIG(NCHN,1)=I | |
22442 | ISIG(NCHN,2)=J | |
22443 | ISIG(NCHN,3)=1 | |
22444 | SIGH(NCHN)=FACWG*FCKM*WIDSC | |
22445 | 150 CONTINUE | |
22446 | 160 CONTINUE | |
22447 | ||
22448 | ELSEIF(ISUB.EQ.19) THEN | |
22449 | C...f + fbar -> gamma + (gamma*/Z0) | |
22450 | FACGZ=COMFAC*2D0*AEM**2*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) | |
22451 | C...gamma, gamma/Z interference and Z couplings to final fermion pairs | |
22452 | HFGG=0D0 | |
22453 | HFGZ=0D0 | |
22454 | HFZZ=0D0 | |
22455 | RADC4=1D0+PYALPS(SQM4)/PARU(1) | |
22456 | DO 170 I=1,MIN(16,MDCY(23,3)) | |
22457 | IDC=I+MDCY(23,2)-1 | |
22458 | IF(MDME(IDC,1).LT.0) GOTO 170 | |
22459 | IMDM=0 | |
22460 | IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) | |
22461 | & IMDM=1 | |
22462 | IF(I.LE.8) THEN | |
22463 | EF=KCHG(I,1)/3D0 | |
22464 | AF=SIGN(1D0,EF+0.1D0) | |
22465 | VF=AF-4D0*EF*XWV | |
22466 | ELSEIF(I.LE.16) THEN | |
22467 | EF=KCHG(I+2,1)/3D0 | |
22468 | AF=SIGN(1D0,EF+0.1D0) | |
22469 | VF=AF-4D0*EF*XWV | |
22470 | ENDIF | |
22471 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 | |
22472 | IF(4D0*RM1.LT.1D0) THEN | |
22473 | FCOF=1D0 | |
22474 | IF(I.LE.8) FCOF=3D0*RADC4 | |
22475 | BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) | |
22476 | IF(IMDM.EQ.1) THEN | |
22477 | HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 | |
22478 | HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 | |
22479 | HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ | |
22480 | & AF**2*(1D0-4D0*RM1))*BE34 | |
22481 | ENDIF | |
22482 | ENDIF | |
22483 | 170 CONTINUE | |
22484 | C...Propagators: as simulated in PYOFSH and as desired | |
22485 | HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) | |
22486 | MINT15=MINT(15) | |
22487 | MINT(15)=1 | |
22488 | MINT(61)=1 | |
22489 | CALL PYWIDT(23,SQM4,WDTP,WDTE) | |
22490 | MINT(15)=MINT15 | |
22491 | HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) | |
22492 | HFGG=HFGG*HFAEM*VINT(111)/SQM4 | |
22493 | HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 | |
22494 | HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 | |
22495 | C...Loop over flavours; consider full gamma/Z structure | |
22496 | DO 180 I=MMINA,MMAXA | |
22497 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 180 | |
22498 | EI=KCHG(IABS(I),1)/3D0 | |
22499 | AI=SIGN(1D0,EI) | |
22500 | VI=AI-4D0*EI*XWV | |
22501 | FCOI=1D0 | |
22502 | IF(IABS(I).LE.10) FCOI=FACA/3D0 | |
22503 | NCHN=NCHN+1 | |
22504 | ISIG(NCHN,1)=I | |
22505 | ISIG(NCHN,2)=-I | |
22506 | ISIG(NCHN,3)=1 | |
22507 | SIGH(NCHN)=FACGZ*FCOI*EI**2*(EI**2*HFGG+EI*VI*HFGZ+ | |
22508 | & (VI**2+AI**2)*HFZZ)/HBW4 | |
22509 | 180 CONTINUE | |
22510 | ||
22511 | ELSEIF(ISUB.EQ.20) THEN | |
22512 | C...f + fbar' -> gamma + W+/- | |
22513 | FACGW=COMFAC*0.5D0*AEM**2/XW | |
22514 | C...Propagators: as simulated in PYOFSH and as desired | |
22515 | HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) | |
22516 | CALL PYWIDT(24,SQM4,WDTP,WDTE) | |
22517 | GMMWC=SQRT(SQM4)*WDTP(0) | |
22518 | HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) | |
22519 | FACGW=FACGW*HBW4C/HBW4 | |
22520 | C...Anomalous couplings | |
22521 | TERM1=(TH2+UH2+2D0*SQM4*SH)/(TH*UH) | |
22522 | TERM2=0D0 | |
22523 | TERM3=0D0 | |
22524 | IF(ITCM(5).GE.1.AND.ITCM(5).LE.4) THEN | |
22525 | TERM2=RTCM(46)*(TH-UH)/(TH+UH) | |
22526 | TERM3=0.5D0*RTCM(46)**2*(TH*UH+(TH2+UH2)*SH/ | |
22527 | & (4D0*SQMW))/(TH+UH)**2 | |
22528 | ENDIF | |
22529 | DO 200 I=MMIN1,MMAX1 | |
22530 | IA=IABS(I) | |
22531 | IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 200 | |
22532 | DO 190 J=MMIN2,MMAX2 | |
22533 | JA=IABS(J) | |
22534 | IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 190 | |
22535 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 190 | |
22536 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
22537 | & GOTO 190 | |
22538 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
22539 | WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) | |
22540 | IF(IA.LE.10) THEN | |
22541 | FACWR=UH/(TH+UH)-1D0/3D0 | |
22542 | FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
22543 | FCOI=FACA/3D0 | |
22544 | ELSE | |
22545 | FACWR=-TH/(TH+UH) | |
22546 | FCKM=1D0 | |
22547 | FCOI=1D0 | |
22548 | ENDIF | |
22549 | FACWK=TERM1*FACWR**2+TERM2*FACWR+TERM3 | |
22550 | NCHN=NCHN+1 | |
22551 | ISIG(NCHN,1)=I | |
22552 | ISIG(NCHN,2)=J | |
22553 | ISIG(NCHN,3)=1 | |
22554 | SIGH(NCHN)=FACGW*FACWK*FCOI*FCKM*WIDSC | |
22555 | 190 CONTINUE | |
22556 | 200 CONTINUE | |
22557 | ENDIF | |
22558 | ||
22559 | ELSEIF(ISUB.LE.40) THEN | |
22560 | IF(ISUB.EQ.22) THEN | |
22561 | C...f + fbar -> (gamma*/Z0) + (gamma*/Z0) | |
22562 | C...Kinematics dependence | |
22563 | FACZZ=COMFAC*AEM**2*((TH2+UH2+2D0*(SQM3+SQM4)*SH)/(TH*UH)- | |
22564 | & SQM3*SQM4*(1D0/TH2+1D0/UH2)) | |
22565 | C...gamma, gamma/Z interference and Z couplings to final fermion pairs | |
22566 | DO 220 I=1,6 | |
22567 | DO 210 J=1,3 | |
22568 | HGZ(I,J)=0D0 | |
22569 | 210 CONTINUE | |
22570 | 220 CONTINUE | |
22571 | RADC3=1D0+PYALPS(SQM3)/PARU(1) | |
22572 | RADC4=1D0+PYALPS(SQM4)/PARU(1) | |
22573 | DO 230 I=1,MIN(16,MDCY(23,3)) | |
22574 | IDC=I+MDCY(23,2)-1 | |
22575 | IF(MDME(IDC,1).LT.0) GOTO 230 | |
22576 | IMDM=0 | |
22577 | IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2) IMDM=1 | |
22578 | IF(MDME(IDC,1).EQ.4.OR.MDME(IDC,1).EQ.5) IMDM=MDME(IDC,1)-2 | |
22579 | IF(I.LE.8) THEN | |
22580 | EF=KCHG(I,1)/3D0 | |
22581 | AF=SIGN(1D0,EF+0.1D0) | |
22582 | VF=AF-4D0*EF*XWV | |
22583 | ELSEIF(I.LE.16) THEN | |
22584 | EF=KCHG(I+2,1)/3D0 | |
22585 | AF=SIGN(1D0,EF+0.1D0) | |
22586 | VF=AF-4D0*EF*XWV | |
22587 | ENDIF | |
22588 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM3 | |
22589 | IF(4D0*RM1.LT.1D0) THEN | |
22590 | FCOF=1D0 | |
22591 | IF(I.LE.8) FCOF=3D0*RADC3 | |
22592 | BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) | |
22593 | IF(IMDM.GE.1) THEN | |
22594 | HGZ(1,IMDM)=HGZ(1,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34 | |
22595 | HGZ(2,IMDM)=HGZ(2,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 | |
22596 | HGZ(3,IMDM)=HGZ(3,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+ | |
22597 | & AF**2*(1D0-4D0*RM1))*BE34 | |
22598 | ENDIF | |
22599 | ENDIF | |
22600 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 | |
22601 | IF(4D0*RM1.LT.1D0) THEN | |
22602 | FCOF=1D0 | |
22603 | IF(I.LE.8) FCOF=3D0*RADC4 | |
22604 | BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) | |
22605 | IF(IMDM.GE.1) THEN | |
22606 | HGZ(4,IMDM)=HGZ(4,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34 | |
22607 | HGZ(5,IMDM)=HGZ(5,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 | |
22608 | HGZ(6,IMDM)=HGZ(6,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+ | |
22609 | & AF**2*(1D0-4D0*RM1))*BE34 | |
22610 | ENDIF | |
22611 | ENDIF | |
22612 | 230 CONTINUE | |
22613 | C...Propagators: as simulated in PYOFSH and as desired | |
22614 | HBW3=(1D0/PARU(1))*GMMZ/((SQM3-SQMZ)**2+GMMZ**2) | |
22615 | HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) | |
22616 | MINT15=MINT(15) | |
22617 | MINT(15)=1 | |
22618 | MINT(61)=1 | |
22619 | CALL PYWIDT(23,SQM3,WDTP,WDTE) | |
22620 | MINT(15)=MINT15 | |
22621 | HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) | |
22622 | DO 240 J=1,3 | |
22623 | HGZ(1,J)=HGZ(1,J)*HFAEM*VINT(111)/SQM3 | |
22624 | HGZ(2,J)=HGZ(2,J)*HFAEM*VINT(112)/SQM3 | |
22625 | HGZ(3,J)=HGZ(3,J)*HFAEM*VINT(114)/SQM3 | |
22626 | 240 CONTINUE | |
22627 | MINT15=MINT(15) | |
22628 | MINT(15)=1 | |
22629 | MINT(61)=1 | |
22630 | CALL PYWIDT(23,SQM4,WDTP,WDTE) | |
22631 | MINT(15)=MINT15 | |
22632 | HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) | |
22633 | DO 250 J=1,3 | |
22634 | HGZ(4,J)=HGZ(4,J)*HFAEM*VINT(111)/SQM4 | |
22635 | HGZ(5,J)=HGZ(5,J)*HFAEM*VINT(112)/SQM4 | |
22636 | HGZ(6,J)=HGZ(6,J)*HFAEM*VINT(114)/SQM4 | |
22637 | 250 CONTINUE | |
22638 | C...Loop over flavours; separate left- and right-handed couplings | |
22639 | DO 270 I=MMINA,MMAXA | |
22640 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 270 | |
22641 | EI=KCHG(IABS(I),1)/3D0 | |
22642 | AI=SIGN(1D0,EI) | |
22643 | VI=AI-4D0*EI*XWV | |
22644 | VALI=VI-AI | |
22645 | VARI=VI+AI | |
22646 | FCOI=1D0 | |
22647 | IF(IABS(I).LE.10) FCOI=FACA/3D0 | |
22648 | DO 260 J=1,3 | |
22649 | HL3(J)=EI**2*HGZ(1,J)+EI*VALI*HGZ(2,J)+VALI**2*HGZ(3,J) | |
22650 | HR3(J)=EI**2*HGZ(1,J)+EI*VARI*HGZ(2,J)+VARI**2*HGZ(3,J) | |
22651 | HL4(J)=EI**2*HGZ(4,J)+EI*VALI*HGZ(5,J)+VALI**2*HGZ(6,J) | |
22652 | HR4(J)=EI**2*HGZ(4,J)+EI*VARI*HGZ(5,J)+VARI**2*HGZ(6,J) | |
22653 | 260 CONTINUE | |
22654 | FACLR=HL3(1)*HL4(1)+HL3(1)*(HL4(2)+HL4(3))+ | |
22655 | & HL4(1)*(HL3(2)+HL3(3))+HL3(2)*HL4(3)+HL4(2)*HL3(3)+ | |
22656 | & HR3(1)*HR4(1)+HR3(1)*(HR4(2)+HR4(3))+ | |
22657 | & HR4(1)*(HR3(2)+HR3(3))+HR3(2)*HR4(3)+HR4(2)*HR3(3) | |
22658 | NCHN=NCHN+1 | |
22659 | ISIG(NCHN,1)=I | |
22660 | ISIG(NCHN,2)=-I | |
22661 | ISIG(NCHN,3)=1 | |
22662 | SIGH(NCHN)=0.5D0*FACZZ*FCOI*FACLR/(HBW3*HBW4) | |
22663 | 270 CONTINUE | |
22664 | ||
22665 | ELSEIF(ISUB.EQ.23) THEN | |
22666 | C...f + fbar' -> Z0 + W+/- (Z0 only, i.e. no gamma* admixture.) | |
22667 | FACZW=COMFAC*0.5D0*(AEM/XW)**2 | |
22668 | FACZW=FACZW*WIDS(23,2) | |
22669 | THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) | |
22670 | FACBW=1D0/((SH-SQMW)**2+GMMW**2) | |
22671 | DO 290 I=MMIN1,MMAX1 | |
22672 | IA=IABS(I) | |
22673 | IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 290 | |
22674 | DO 280 J=MMIN2,MMAX2 | |
22675 | JA=IABS(J) | |
22676 | IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 280 | |
22677 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 280 | |
22678 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
22679 | & GOTO 280 | |
22680 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
22681 | EI=KCHG(IA,1)/3D0 | |
22682 | AI=SIGN(1D0,EI+0.1D0) | |
22683 | VI=AI-4D0*EI*XWV | |
22684 | EJ=KCHG(JA,1)/3D0 | |
22685 | AJ=SIGN(1D0,EJ+0.1D0) | |
22686 | VJ=AJ-4D0*EJ*XWV | |
22687 | IF(VI+AI.GT.0) THEN | |
22688 | VISAV=VI | |
22689 | AISAV=AI | |
22690 | VI=VJ | |
22691 | AI=AJ | |
22692 | VJ=VISAV | |
22693 | AJ=AISAV | |
22694 | ENDIF | |
22695 | FCKM=1D0 | |
22696 | IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
22697 | FCOI=1D0 | |
22698 | IF(IA.LE.10) FCOI=FACA/3D0 | |
22699 | NCHN=NCHN+1 | |
22700 | ISIG(NCHN,1)=I | |
22701 | ISIG(NCHN,2)=J | |
22702 | ISIG(NCHN,3)=1 | |
22703 | SIGH(NCHN)=FACZW*FCOI*FCKM*(FACBW*((9D0-8D0*XW)/4D0*THUH+ | |
22704 | & (8D0*XW-6D0)/4D0*SH*(SQM3+SQM4))+(THUH-SH*(SQM3+SQM4))* | |
22705 | & (SH-SQMW)*FACBW*0.5D0*((VJ+AJ)/TH-(VI+AI)/UH)+ | |
22706 | & THUH/(16D0*XW1)*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+ | |
22707 | & SH*(SQM3+SQM4)/(8D0*XW1)*(VI+AI)*(VJ+AJ)/(TH*UH))* | |
22708 | & WIDS(24,(5-KCHW)/2) | |
22709 | C***Protect against slightly negative cross sections. (Reason yet to be | |
22710 | C***sorted out. One possibility: addition of width to the W propagator.) | |
22711 | SIGH(NCHN)=MAX(0D0,SIGH(NCHN)) | |
22712 | 280 CONTINUE | |
22713 | 290 CONTINUE | |
22714 | ||
22715 | ELSEIF(ISUB.EQ.25) THEN | |
22716 | C...f + fbar -> W+ + W- | |
22717 | C...Propagators: Z0, W+- as simulated in PYOFSH and as desired | |
22718 | GMMZC=GMMZ | |
22719 | HBWZC=SH**2/((SH-SQMZ)**2+GMMZC**2) | |
22720 | HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2) | |
22721 | CALL PYWIDT(24,SQM3,WDTP,WDTE) | |
22722 | GMMW3=SQRT(SQM3)*WDTP(0) | |
22723 | HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2) | |
22724 | HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) | |
22725 | CALL PYWIDT(24,SQM4,WDTP,WDTE) | |
22726 | GMMW4=SQRT(SQM4)*WDTP(0) | |
22727 | HBW4C=GMMW4/((SQM4-SQMW)**2+GMMW4**2) | |
22728 | C...Kinematical functions | |
22729 | THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) | |
22730 | THUH34=(2D0*SH*(SQM3+SQM4)+THUH)/(SQM3*SQM4) | |
22731 | GS=(((SH-SQM3-SQM4)**2-4D0*SQM3*SQM4)*THUH34+12D0*THUH)/SH2 | |
22732 | GT=THUH34+4D0*THUH/TH2 | |
22733 | GST=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/TH)/SH | |
22734 | GU=THUH34+4D0*THUH/UH2 | |
22735 | GSU=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/UH)/SH | |
22736 | C...Common factors and couplings | |
22737 | FACWW=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4) | |
22738 | FACWW=FACWW*WIDS(24,1) | |
22739 | CGG=AEM**2/2D0 | |
22740 | CGZ=AEM**2/(4D0*XW)*HBWZC*(1D0-SQMZ/SH) | |
22741 | CZZ=AEM**2/(32D0*XW**2)*HBWZC | |
22742 | CNG=AEM**2/(4D0*XW) | |
22743 | CNZ=AEM**2/(16D0*XW**2)*HBWZC*(1D0-SQMZ/SH) | |
22744 | CNN=AEM**2/(16D0*XW**2) | |
22745 | C...Coulomb factor for W+W- pair | |
22746 | IF(MSTP(40).GE.1.AND.MSTP(40).LE.3) THEN | |
22747 | COULE=(SH-4D0*SQMW)/(4D0*PMAS(24,1)) | |
22748 | COULP=MAX(1D-10,0.5D0*BE34*SQRT(SH)) | |
22749 | IF(COULE.LT.100D0*PMAS(24,2)) THEN | |
22750 | COULP1=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+ | |
22751 | & PMAS(24,2)**2)-COULE)) | |
22752 | ELSE | |
22753 | COULP1=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/COULE)) | |
22754 | ENDIF | |
22755 | IF(COULE.GT.-100D0*PMAS(24,2)) THEN | |
22756 | COULP2=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+ | |
22757 | & PMAS(24,2)**2)+COULE)) | |
22758 | ELSE | |
22759 | COULP2=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/ | |
22760 | & ABS(COULE))) | |
22761 | ENDIF | |
22762 | IF(MSTP(40).EQ.1) THEN | |
22763 | COULDC=PARU(1)-2D0*ATAN((COULP1**2+COULP2**2-COULP**2)/ | |
22764 | & MAX(1D-10,2D0*COULP*COULP1)) | |
22765 | FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34) | |
22766 | ELSEIF(MSTP(40).EQ.2) THEN | |
22767 | COULCK=DCMPLX(DBLE(COULP1),DBLE(COULP2)) | |
22768 | COULCP=DCMPLX(0D0,DBLE(COULP)) | |
22769 | COULCD=(COULCK+COULCP)/(COULCK-COULCP) | |
22770 | COULCR=1D0+DBLE(PARU(101)*SQRT(SH))/ | |
22771 | & (4D0*COULCP)*LOG(COULCD) | |
22772 | COULCS=DCMPLX(0D0,0D0) | |
22773 | NSTP=100 | |
22774 | DO 300 ISTP=1,NSTP | |
22775 | COULXX=(ISTP-0.5)/NSTP | |
22776 | COULCS=COULCS+(1D0/COULXX)*LOG((1D0+COULXX*COULCD)/ | |
22777 | & (1D0+COULXX/COULCD)) | |
22778 | 300 CONTINUE | |
22779 | COULCR=COULCR+DBLE(PARU(101)**2*SH)/(16D0*COULCP*COULCK)* | |
22780 | & (COULCS/NSTP) | |
22781 | FACCOU=ABS(COULCR)**2 | |
22782 | ELSEIF(MSTP(40).EQ.3) THEN | |
22783 | COULDC=PARU(1)-2D0*(1D0-BE34)**2*ATAN((COULP1**2+ | |
22784 | & COULP2**2-COULP**2)/MAX(1D-10,2D0*COULP*COULP1)) | |
22785 | FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34) | |
22786 | ENDIF | |
22787 | ELSEIF(MSTP(40).EQ.4) THEN | |
22788 | FACCOU=1D0+0.5D0*PARU(101)*PARU(1)/MAX(1D-5,BE34) | |
22789 | ELSE | |
22790 | FACCOU=1D0 | |
22791 | ENDIF | |
22792 | VINT(95)=FACCOU | |
22793 | FACWW=FACWW*FACCOU | |
22794 | C...Loop over allowed flavours | |
22795 | DO 310 I=MMINA,MMAXA | |
22796 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310 | |
22797 | EI=KCHG(IABS(I),1)/3D0 | |
22798 | AI=SIGN(1D0,EI+0.1D0) | |
22799 | VI=AI-4D0*EI*XWV | |
22800 | FCOI=1D0 | |
22801 | IF(IABS(I).LE.10) FCOI=FACA/3D0 | |
22802 | IF(MSTP(50).LE.0.OR.IABS(I).LE.10) THEN | |
22803 | IF(AI.LT.0D0) THEN | |
22804 | DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS+ | |
22805 | & (CNG*EI+CNZ*(VI+AI))*GST+CNN*GT | |
22806 | ELSE | |
22807 | DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS- | |
22808 | & (CNG*EI+CNZ*(VI+AI))*GSU+CNN*GU | |
22809 | ENDIF | |
22810 | ELSE | |
22811 | XMW02=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH | |
22812 | BET=SQRT(1D0-4D0*XMW02/SH) | |
22813 | GAT=1D0/SQRT(1D0-BET**2) | |
22814 | STHE2=1D0-CTH**2 | |
22815 | AMPZG=BET**3*(16D0+(4D0*BET**2*GAT**2+3D0/GAT**2)*STHE2) | |
22816 | AMPNU=BET*(2D0+BET**2*GAT**2*STHE2/2D0+ | |
22817 | & 2D0*BET**2*(1D0-BET**2)*STHE2/(1D0-2D0*BET*CTH+BET**2)**2) | |
22818 | AMPNG=BET*((1D0+BET**2)*(4D0+BET**2*GAT**2*STHE2)+ | |
22819 | & 2D0*(1D0-BET**2)*(BET**2*STHE2-2D0*(1D0-BET**2))/ | |
22820 | & (1D0-2D0*BET*CTH+BET**2)) | |
22821 | PROPI1=(0.25D0*SQMZ/XMW02)*HBWZC*(1D0-SQMZ/SH) | |
22822 | PROPI2=(0.25D0*SQMZ/XMW02)**2*HBWZC | |
22823 | A0=(2D0*(XMW02/SQMZ)-(1D0-BET**2)*XW)*POLL | |
22824 | A1=(2D0*(XMW02/SQMZ)**2-2*XMW02/SQMZ*(1D0-BET**2)*XW)*POLL | |
22825 | A2=(1D0-BET**2)**2*XW**2*(POLR+POLL)/2D0 | |
22826 | ATOT=AMPNU*POLL+(A1+A2)*PROPI2*AMPZG-A0*PROPI1*AMPNG | |
22827 | ATOT=ATOT*CNN/SQMW*SH/BET*2D0 | |
22828 | DSIGWW=ATOT | |
22829 | ENDIF | |
22830 | NCHN=NCHN+1 | |
22831 | ISIG(NCHN,1)=I | |
22832 | ISIG(NCHN,2)=-I | |
22833 | ISIG(NCHN,3)=1 | |
22834 | SIGH(NCHN)=FACWW*FCOI*DSIGWW | |
22835 | 310 CONTINUE | |
22836 | ||
22837 | ELSEIF(ISUB.EQ.30) THEN | |
22838 | C...f + g -> f + (gamma*/Z0) (q + g -> q + (gamma*/Z0) only) | |
22839 | FZQ=COMFAC*FACA*AS*AEM*(1D0/3D0)*(SH2+UH2+2D0*SQM4*TH)/ | |
22840 | & (-SH*UH) | |
22841 | C...gamma, gamma/Z interference and Z couplings to final fermion pairs | |
22842 | HFGG=0D0 | |
22843 | HFGZ=0D0 | |
22844 | HFZZ=0D0 | |
22845 | RADC4=1D0+PYALPS(SQM4)/PARU(1) | |
22846 | DO 320 I=1,MIN(16,MDCY(23,3)) | |
22847 | IDC=I+MDCY(23,2)-1 | |
22848 | IF(MDME(IDC,1).LT.0) GOTO 320 | |
22849 | IMDM=0 | |
22850 | IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) | |
22851 | & IMDM=1 | |
22852 | IF(I.LE.8) THEN | |
22853 | EF=KCHG(I,1)/3D0 | |
22854 | AF=SIGN(1D0,EF+0.1D0) | |
22855 | VF=AF-4D0*EF*XWV | |
22856 | ELSEIF(I.LE.16) THEN | |
22857 | EF=KCHG(I+2,1)/3D0 | |
22858 | AF=SIGN(1D0,EF+0.1D0) | |
22859 | VF=AF-4D0*EF*XWV | |
22860 | ENDIF | |
22861 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 | |
22862 | IF(4D0*RM1.LT.1D0) THEN | |
22863 | FCOF=1D0 | |
22864 | IF(I.LE.8) FCOF=3D0*RADC4 | |
22865 | BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) | |
22866 | IF(IMDM.EQ.1) THEN | |
22867 | HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 | |
22868 | HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 | |
22869 | HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ | |
22870 | & AF**2*(1D0-4D0*RM1))*BE34 | |
22871 | ENDIF | |
22872 | ENDIF | |
22873 | 320 CONTINUE | |
22874 | C...Propagators: as simulated in PYOFSH and as desired | |
22875 | HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) | |
22876 | MINT15=MINT(15) | |
22877 | MINT(15)=1 | |
22878 | MINT(61)=1 | |
22879 | CALL PYWIDT(23,SQM4,WDTP,WDTE) | |
22880 | MINT(15)=MINT15 | |
22881 | HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) | |
22882 | HFGG=HFGG*HFAEM*VINT(111)/SQM4 | |
22883 | HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 | |
22884 | HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 | |
22885 | C...Loop over flavours; consider full gamma/Z structure | |
22886 | DO 340 I=MMINA,MMAXA | |
22887 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 340 | |
22888 | EI=KCHG(IABS(I),1)/3D0 | |
22889 | AI=SIGN(1D0,EI) | |
22890 | VI=AI-4D0*EI*XWV | |
22891 | FACZQ=FZQ*(EI**2*HFGG+EI*VI*HFGZ+ | |
22892 | & (VI**2+AI**2)*HFZZ)/HBW4 | |
22893 | DO 330 ISDE=1,2 | |
22894 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 330 | |
22895 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 330 | |
22896 | NCHN=NCHN+1 | |
22897 | ISIG(NCHN,ISDE)=I | |
22898 | ISIG(NCHN,3-ISDE)=21 | |
22899 | ISIG(NCHN,3)=1 | |
22900 | SIGH(NCHN)=FACZQ | |
22901 | 330 CONTINUE | |
22902 | 340 CONTINUE | |
22903 | ||
22904 | ELSEIF(ISUB.EQ.31) THEN | |
22905 | C...f + g -> f' + W+/- (q + g -> q' + W+/- only) | |
22906 | FACWQ=COMFAC*FACA*AS*AEM/XW*1D0/12D0* | |
22907 | & (SH2+UH2+2D0*SQM4*TH)/(-SH*UH) | |
22908 | C...Propagators: as simulated in PYOFSH and as desired | |
22909 | HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) | |
22910 | CALL PYWIDT(24,SQM4,WDTP,WDTE) | |
22911 | GMMWC=SQRT(SQM4)*WDTP(0) | |
22912 | HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) | |
22913 | FACWQ=FACWQ*HBW4C/HBW4 | |
22914 | DO 360 I=MMINA,MMAXA | |
22915 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 360 | |
22916 | IA=IABS(I) | |
22917 | KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) | |
22918 | WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) | |
22919 | DO 350 ISDE=1,2 | |
22920 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 350 | |
22921 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 350 | |
22922 | NCHN=NCHN+1 | |
22923 | ISIG(NCHN,ISDE)=I | |
22924 | ISIG(NCHN,3-ISDE)=21 | |
22925 | ISIG(NCHN,3)=1 | |
22926 | SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC | |
22927 | 350 CONTINUE | |
22928 | 360 CONTINUE | |
22929 | ||
22930 | ELSEIF(ISUB.EQ.35) THEN | |
22931 | C...f + gamma -> f + (gamma*/Z0) | |
22932 | IF(MINT(15).EQ.22.AND.VINT(3).LT.0D0) THEN | |
22933 | FZQN=SH2+UH2+2D0*(SQM4-VINT(3)**2)*TH | |
22934 | FZQDTM=VINT(3)**2*SQM4-SH*(UH-VINT(4)**2) | |
22935 | ELSEIF(MINT(16).EQ.22.AND.VINT(4).LT.0D0) THEN | |
22936 | FZQN=SH2+UH2+2D0*(SQM4-VINT(4)**2)*TH | |
22937 | FZQDTM=VINT(4)**2*SQM4-SH*(UH-VINT(3)**2) | |
22938 | ELSE | |
22939 | FZQN=SH2+UH2+2D0*SQM4*TH | |
22940 | FZQDTM=-SH*UH | |
22941 | ENDIF | |
22942 | FZQN=COMFAC*2D0*AEM**2*MAX(0D0,FZQN) | |
22943 | C...gamma, gamma/Z interference and Z couplings to final fermion pairs | |
22944 | HFGG=0D0 | |
22945 | HFGZ=0D0 | |
22946 | HFZZ=0D0 | |
22947 | RADC4=1D0+PYALPS(SQM4)/PARU(1) | |
22948 | DO 370 I=1,MIN(16,MDCY(23,3)) | |
22949 | IDC=I+MDCY(23,2)-1 | |
22950 | IF(MDME(IDC,1).LT.0) GOTO 370 | |
22951 | IMDM=0 | |
22952 | IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) | |
22953 | & IMDM=1 | |
22954 | IF(I.LE.8) THEN | |
22955 | EF=KCHG(I,1)/3D0 | |
22956 | AF=SIGN(1D0,EF+0.1D0) | |
22957 | VF=AF-4D0*EF*XWV | |
22958 | ELSEIF(I.LE.16) THEN | |
22959 | EF=KCHG(I+2,1)/3D0 | |
22960 | AF=SIGN(1D0,EF+0.1D0) | |
22961 | VF=AF-4D0*EF*XWV | |
22962 | ENDIF | |
22963 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 | |
22964 | IF(4D0*RM1.LT.1D0) THEN | |
22965 | FCOF=1D0 | |
22966 | IF(I.LE.8) FCOF=3D0*RADC4 | |
22967 | BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) | |
22968 | IF(IMDM.EQ.1) THEN | |
22969 | HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 | |
22970 | HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 | |
22971 | HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ | |
22972 | & AF**2*(1D0-4D0*RM1))*BE34 | |
22973 | ENDIF | |
22974 | ENDIF | |
22975 | 370 CONTINUE | |
22976 | C...Propagators: as simulated in PYOFSH and as desired | |
22977 | HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) | |
22978 | MINT15=MINT(15) | |
22979 | MINT(15)=1 | |
22980 | MINT(61)=1 | |
22981 | CALL PYWIDT(23,SQM4,WDTP,WDTE) | |
22982 | MINT(15)=MINT15 | |
22983 | HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) | |
22984 | HFGG=HFGG*HFAEM*VINT(111)/SQM4 | |
22985 | HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 | |
22986 | HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 | |
22987 | C...Loop over flavours; consider full gamma/Z structure | |
22988 | DO 390 I=MMINA,MMAXA | |
22989 | IF(I.EQ.0) GOTO 390 | |
22990 | EI=KCHG(IABS(I),1)/3D0 | |
22991 | AI=SIGN(1D0,EI) | |
22992 | VI=AI-4D0*EI*XWV | |
22993 | FACZQ=EI**2*(EI**2*HFGG+EI*VI*HFGZ+ | |
22994 | & (VI**2+AI**2)*HFZZ)/HBW4 | |
22995 | FZQD=MAX(PMAS(IABS(I),1)**2*SQM4,FZQDTM) | |
22996 | DO 380 ISDE=1,2 | |
22997 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 380 | |
22998 | IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 380 | |
22999 | NCHN=NCHN+1 | |
23000 | ISIG(NCHN,ISDE)=I | |
23001 | ISIG(NCHN,3-ISDE)=22 | |
23002 | ISIG(NCHN,3)=1 | |
23003 | SIGH(NCHN)=FACZQ*FZQN/FZQD | |
23004 | 380 CONTINUE | |
23005 | 390 CONTINUE | |
23006 | ||
23007 | ELSEIF(ISUB.EQ.36) THEN | |
23008 | C...f + gamma -> f' + W+/- | |
23009 | FWQ=COMFAC*AEM**2/(2D0*XW)* | |
23010 | & (SH2+UH2+2D0*SQM4*TH)/(SQPTH*SQM4-SH*UH) | |
23011 | C...Propagators: as simulated in PYOFSH and as desired | |
23012 | HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) | |
23013 | CALL PYWIDT(24,SQM4,WDTP,WDTE) | |
23014 | GMMWC=SQRT(SQM4)*WDTP(0) | |
23015 | HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) | |
23016 | FWQ=FWQ*HBW4C/HBW4 | |
23017 | DO 410 I=MMINA,MMAXA | |
23018 | IF(I.EQ.0) GOTO 410 | |
23019 | IA=IABS(I) | |
23020 | EIA=ABS(KCHG(IABS(I),1)/3D0) | |
23021 | FACWQ=FWQ*(EIA-SH/(SH+UH))**2 | |
23022 | KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) | |
23023 | WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) | |
23024 | DO 400 ISDE=1,2 | |
23025 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 400 | |
23026 | IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 400 | |
23027 | NCHN=NCHN+1 | |
23028 | ISIG(NCHN,ISDE)=I | |
23029 | ISIG(NCHN,3-ISDE)=22 | |
23030 | ISIG(NCHN,3)=1 | |
23031 | SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC | |
23032 | 400 CONTINUE | |
23033 | 410 CONTINUE | |
23034 | ENDIF | |
23035 | ||
23036 | ELSEIF(ISUB.LE.100) THEN | |
23037 | IF(ISUB.EQ.69) THEN | |
23038 | C...gamma + gamma -> W+ + W- | |
23039 | SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4)) | |
23040 | FPROP=SH2/((SQMWE-TH)*(SQMWE-UH)) | |
23041 | FACWW=COMFAC*6D0*AEM**2*(1D0-FPROP*(4D0/3D0+2D0*SQMWE/SH)+ | |
23042 | & FPROP**2*(2D0/3D0+2D0*(SQMWE/SH)**2))*WIDS(24,1) | |
23043 | IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 420 | |
23044 | NCHN=NCHN+1 | |
23045 | ISIG(NCHN,1)=22 | |
23046 | ISIG(NCHN,2)=22 | |
23047 | ISIG(NCHN,3)=1 | |
23048 | SIGH(NCHN)=FACWW | |
23049 | 420 CONTINUE | |
23050 | ||
23051 | ELSEIF(ISUB.EQ.70) THEN | |
23052 | C...gamma + W+/- -> Z0 + W+/- | |
23053 | SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4)) | |
23054 | FPROP=(TH-SQMWE)**2/(-SH*(SQMWE-UH)) | |
23055 | FACZW=COMFAC*6D0*AEM**2*(XW1/XW)* | |
23056 | & (1D0-FPROP*(4D0/3D0+2D0*SQMWE/(TH-SQMWE))+ | |
23057 | & FPROP**2*(2D0/3D0+2D0*(SQMWE/(TH-SQMWE))**2))*WIDS(23,2) | |
23058 | DO 440 KCHW=1,-1,-2 | |
23059 | DO 430 ISDE=1,2 | |
23060 | IF(KFAC(ISDE,22)*KFAC(3-ISDE,24*KCHW).EQ.0) GOTO 430 | |
23061 | NCHN=NCHN+1 | |
23062 | ISIG(NCHN,ISDE)=22 | |
23063 | ISIG(NCHN,3-ISDE)=24*KCHW | |
23064 | ISIG(NCHN,3)=1 | |
23065 | SIGH(NCHN)=FACZW*WIDS(24,(5-KCHW)/2) | |
23066 | 430 CONTINUE | |
23067 | 440 CONTINUE | |
23068 | ENDIF | |
23069 | ENDIF | |
23070 | ||
23071 | RETURN | |
23072 | END | |
23073 | ||
23074 | C********************************************************************* | |
23075 | ||
23076 | C...PYSGHG | |
23077 | C...Subprocess cross sections for Higgs processes, | |
23078 | C...except Higgs pairs in PYSGSU, but including WW scattering. | |
23079 | C...Auxiliary to PYSIGH. | |
23080 | ||
23081 | SUBROUTINE PYSGHG(NCHN,SIGS) | |
23082 | ||
23083 | C...Double precision and integer declarations | |
23084 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
23085 | IMPLICIT INTEGER(I-N) | |
23086 | INTEGER PYK,PYCHGE,PYCOMP | |
23087 | C...Parameter statement to help give large particle numbers. | |
23088 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
23089 | &KEXCIT=4000000,KDIMEN=5000000) | |
23090 | C...Commonblocks | |
23091 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
23092 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
23093 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
23094 | COMMON/PYINT1/MINT(400),VINT(400) | |
23095 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
23096 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
23097 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
23098 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
23099 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
23100 | COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, | |
23101 | &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, | |
23102 | &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, | |
23103 | &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR | |
23104 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, | |
23105 | &/PYINT4/,/PYSUBS/,/PYMSSM/,/PYSGCM/ | |
23106 | C...Local arrays and complex variables | |
23107 | DIMENSION WDTP(0:400),WDTE(0:400,0:5) | |
23108 | COMPLEX*16 A004,A204,A114,A00U,A20U,A11U | |
23109 | COMPLEX*16 CIGTOT,CIZTOT,F0ALP,F1ALP,F2ALP,F0BET,F1BET,F2BET,FIF | |
23110 | ||
23111 | C...Convert H or A process into equivalent h one | |
23112 | IHIGG=1 | |
23113 | KFHIGG=25 | |
23114 | IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND. | |
23115 | &ISUB.LE.190)) THEN | |
23116 | IHIGG=2 | |
23117 | IF(MOD(ISUB-1,10).GE.5) IHIGG=3 | |
23118 | KFHIGG=33+IHIGG | |
23119 | IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3 | |
23120 | IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102 | |
23121 | IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103 | |
23122 | IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24 | |
23123 | IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26 | |
23124 | IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123 | |
23125 | IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124 | |
23126 | IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121 | |
23127 | IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122 | |
23128 | IF(ISUB.EQ.183.OR.ISUB.EQ.188) ISUB=111 | |
23129 | IF(ISUB.EQ.184.OR.ISUB.EQ.189) ISUB=112 | |
23130 | IF(ISUB.EQ.185.OR.ISUB.EQ.190) ISUB=113 | |
23131 | ENDIF | |
23132 | SQMH=PMAS(KFHIGG,1)**2 | |
23133 | GMMH=PMAS(KFHIGG,1)*PMAS(KFHIGG,2) | |
23134 | ||
23135 | C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron | |
23136 | IF((MSTP(46).GE.3.AND.MSTP(46).LE.6).AND.(ISUB.EQ.71.OR.ISUB.EQ. | |
23137 | &72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR.ISUB.EQ.77)) THEN | |
23138 | C...Calculate M_R and N_R functions for Higgs-like and QCD-like models | |
23139 | IF(MSTP(46).LE.4) THEN | |
23140 | HDTLH=LOG(PMAS(25,1)/PARP(44)) | |
23141 | HDTMR=(4.5D0*PARU(1)/SQRT(3D0)-74D0/9D0)/8D0+HDTLH/12D0 | |
23142 | HDTNR=-1D0/18D0+HDTLH/6D0 | |
23143 | ELSE | |
23144 | HDTNM=0.125D0*(1D0/(288D0*PARU(1)**2)+(PARP(47)/PARP(45))**2) | |
23145 | HDTLQ=LOG(PARP(45)/PARP(44)) | |
23146 | HDTMR=-(4D0*PARU(1))**2*0.5D0*HDTNM+HDTLQ/12D0 | |
23147 | HDTNR=(4D0*PARU(1))**2*HDTNM+HDTLQ/6D0 | |
23148 | ENDIF | |
23149 | ||
23150 | C...Calculate lowest and next-to-lowest order partial wave amplitudes | |
23151 | HDTV=1D0/(16D0*PARU(1)*PARP(47)**2) | |
23152 | A00L=DBLE(HDTV*SH) | |
23153 | A20L=-0.5D0*A00L | |
23154 | A11L=A00L/6D0 | |
23155 | HDTLS=LOG(SH/PARP(44)**2) | |
23156 | A004=DBLE((HDTV*SH)**2/(4D0*PARU(1)))* | |
23157 | & CMPLX(DBLE((176D0*HDTMR+112D0*HDTNR)/3D0+11D0/27D0- | |
23158 | & (50D0/9D0)*HDTLS),DBLE(4D0*PARU(1))) | |
23159 | A204=DBLE((HDTV*SH)**2/(4D0*PARU(1)))* | |
23160 | & CMPLX(DBLE(32D0*(HDTMR+2D0*HDTNR)/3D0+25D0/54D0- | |
23161 | & (20D0/9D0)*HDTLS),DBLE(PARU(1))) | |
23162 | A114=DBLE((HDTV*SH)**2/(6D0*PARU(1)))* | |
23163 | & CMPLX(DBLE(4D0*(-2D0*HDTMR+HDTNR)-1D0/18D0),DBLE(PARU(1)/6D0)) | |
23164 | ||
23165 | C...Unitarize partial wave amplitudes with Pade or K-matrix method | |
23166 | IF(MSTP(46).EQ.3.OR.MSTP(46).EQ.5) THEN | |
23167 | A00U=A00L/(1D0-A004/A00L) | |
23168 | A20U=A20L/(1D0-A204/A20L) | |
23169 | A11U=A11L/(1D0-A114/A11L) | |
23170 | ELSE | |
23171 | A00U=(A00L+DBLE(A004))/(1D0-DCMPLX(0.D0,A00L+DBLE(A004))) | |
23172 | A20U=(A20L+DBLE(A204))/(1D0-DCMPLX(0.D0,A20L+DBLE(A204))) | |
23173 | A11U=(A11L+DBLE(A114))/(1D0-DCMPLX(0.D0,A11L+DBLE(A114))) | |
23174 | ENDIF | |
23175 | ENDIF | |
23176 | ||
23177 | C...Differential cross section expressions. | |
23178 | ||
23179 | IF(ISUB.LE.60) THEN | |
23180 | IF(ISUB.EQ.3) THEN | |
23181 | C...f + fbar -> h0 (or H0, or A0) | |
23182 | CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) | |
23183 | HS=SHR*WDTP(0) | |
23184 | FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) | |
23185 | IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) | |
23186 | & FACBW=0D0 | |
23187 | HP=AEM/(8D0*XW)*SH/SQMW*SH | |
23188 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
23189 | DO 100 I=MMINA,MMAXA | |
23190 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 | |
23191 | IA=IABS(I) | |
23192 | RMQ=PYMRUN(IA,SH)**2/SH | |
23193 | HI=HP*RMQ | |
23194 | IF(IA.LE.10) HI=HP*RMQ*FACA/3D0 | |
23195 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN | |
23196 | IKFI=1 | |
23197 | IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 | |
23198 | IF(IA.GT.10) IKFI=3 | |
23199 | HI=HI*PARU(150+10*IHIGG+IKFI)**2 | |
23200 | IF(IMSS(1).NE.0.AND.IA.EQ.5) THEN | |
23201 | HI=HI/(1D0+RMSS(41))**2 | |
23202 | IF(IHIGG.NE.3) THEN | |
23203 | HI=HI*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ | |
23204 | & PARU(151+10*IHIGG))**2 | |
23205 | ENDIF | |
23206 | ENDIF | |
23207 | ENDIF | |
23208 | NCHN=NCHN+1 | |
23209 | ISIG(NCHN,1)=I | |
23210 | ISIG(NCHN,2)=-I | |
23211 | ISIG(NCHN,3)=1 | |
23212 | SIGH(NCHN)=HI*FACBW*HF | |
23213 | 100 CONTINUE | |
23214 | ||
23215 | ELSEIF(ISUB.EQ.5) THEN | |
23216 | C...Z0 + Z0 -> h0 | |
23217 | CALL PYWIDT(25,SH,WDTP,WDTE) | |
23218 | HS=SHR*WDTP(0) | |
23219 | FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) | |
23220 | IF(ABS(SHR-PMAS(25,1)).GT.PARP(48)*PMAS(25,2)) FACBW=0D0 | |
23221 | HP=AEM/(8D0*XW)*SH/SQMW*SH | |
23222 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
23223 | HI=HP/4D0 | |
23224 | FACI=8D0/(PARU(1)**2*XW1)*(AEM*XWC)**2 | |
23225 | DO 120 I=MMIN1,MMAX1 | |
23226 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120 | |
23227 | DO 110 J=MMIN2,MMAX2 | |
23228 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110 | |
23229 | EI=KCHG(IABS(I),1)/3D0 | |
23230 | AI=SIGN(1D0,EI) | |
23231 | VI=AI-4D0*EI*XWV | |
23232 | EJ=KCHG(IABS(J),1)/3D0 | |
23233 | AJ=SIGN(1D0,EJ) | |
23234 | VJ=AJ-4D0*EJ*XWV | |
23235 | NCHN=NCHN+1 | |
23236 | ISIG(NCHN,1)=I | |
23237 | ISIG(NCHN,2)=J | |
23238 | ISIG(NCHN,3)=1 | |
23239 | SIGH(NCHN)=FACI*(VI**2+AI**2)*(VJ**2+AJ**2)*HI*FACBW*HF | |
23240 | 110 CONTINUE | |
23241 | 120 CONTINUE | |
23242 | ||
23243 | ELSEIF(ISUB.EQ.8) THEN | |
23244 | C...W+ + W- -> h0 | |
23245 | CALL PYWIDT(25,SH,WDTP,WDTE) | |
23246 | HS=SHR*WDTP(0) | |
23247 | FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) | |
23248 | IF(ABS(SHR-PMAS(25,1)).GT.PARP(48)*PMAS(25,2)) FACBW=0D0 | |
23249 | HP=AEM/(8D0*XW)*SH/SQMW*SH | |
23250 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
23251 | HI=HP/2D0 | |
23252 | FACI=1D0/(4D0*PARU(1)**2)*(AEM/XW)**2 | |
23253 | DO 140 I=MMIN1,MMAX1 | |
23254 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 140 | |
23255 | EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) | |
23256 | DO 130 J=MMIN2,MMAX2 | |
23257 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 130 | |
23258 | EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) | |
23259 | IF(EI*EJ.GT.0D0) GOTO 130 | |
23260 | NCHN=NCHN+1 | |
23261 | ISIG(NCHN,1)=I | |
23262 | ISIG(NCHN,2)=J | |
23263 | ISIG(NCHN,3)=1 | |
23264 | SIGH(NCHN)=FACI*VINT(180+I)*VINT(180+J)*HI*FACBW*HF | |
23265 | 130 CONTINUE | |
23266 | 140 CONTINUE | |
23267 | ||
23268 | ELSEIF(ISUB.EQ.24) THEN | |
23269 | C...f + fbar -> Z0 + h0 (or H0, or A0) | |
23270 | C...Propagators: Z0, h0 as simulated in PYOFSH and as desired | |
23271 | HBW3=GMMZ/((SQM3-SQMZ)**2+GMMZ**2) | |
23272 | CALL PYWIDT(23,SQM3,WDTP,WDTE) | |
23273 | GMMZ3=SQRT(SQM3)*WDTP(0) | |
23274 | HBW3C=GMMZ3/((SQM3-SQMZ)**2+GMMZ3**2) | |
23275 | HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) | |
23276 | CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) | |
23277 | GMMH4=SQRT(SQM4)*WDTP(0) | |
23278 | HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2) | |
23279 | THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) | |
23280 | FACHZ=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)*8D0*(AEM*XWC)**2* | |
23281 | & (THUH+2D0*SH*SQM3)/((SH-SQMZ)**2+GMMZ**2) | |
23282 | FACHZ=FACHZ*WIDS(23,2)*WIDS(KFHIGG,2) | |
23283 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHZ=FACHZ* | |
23284 | & PARU(154+10*IHIGG)**2 | |
23285 | DO 150 I=MMINA,MMAXA | |
23286 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150 | |
23287 | EI=KCHG(IABS(I),1)/3D0 | |
23288 | AI=SIGN(1D0,EI) | |
23289 | VI=AI-4D0*EI*XWV | |
23290 | FCOI=1D0 | |
23291 | IF(IABS(I).LE.10) FCOI=FACA/3D0 | |
23292 | NCHN=NCHN+1 | |
23293 | ISIG(NCHN,1)=I | |
23294 | ISIG(NCHN,2)=-I | |
23295 | ISIG(NCHN,3)=1 | |
23296 | SIGH(NCHN)=FACHZ*FCOI*(VI**2+AI**2) | |
23297 | 150 CONTINUE | |
23298 | ||
23299 | ELSEIF(ISUB.EQ.26) THEN | |
23300 | C...f + fbar' -> W+/- + h0 (or H0, or A0) | |
23301 | C...Propagators: W+-, h0 as simulated in PYOFSH and as desired | |
23302 | HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2) | |
23303 | CALL PYWIDT(24,SQM3,WDTP,WDTE) | |
23304 | GMMW3=SQRT(SQM3)*WDTP(0) | |
23305 | HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2) | |
23306 | HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) | |
23307 | CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) | |
23308 | GMMH4=SQRT(SQM4)*WDTP(0) | |
23309 | HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2) | |
23310 | THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) | |
23311 | FACHW=COMFAC*0.125D0*(AEM/XW)**2*(THUH+2D0*SH*SQM3)/ | |
23312 | & ((SH-SQMW)**2+GMMW**2)*(HBW3C/HBW3)*(HBW4C/HBW4) | |
23313 | FACHW=FACHW*WIDS(KFHIGG,2) | |
23314 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHW=FACHW* | |
23315 | & PARU(155+10*IHIGG)**2 | |
23316 | DO 170 I=MMIN1,MMAX1 | |
23317 | IA=IABS(I) | |
23318 | IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 170 | |
23319 | DO 160 J=MMIN2,MMAX2 | |
23320 | JA=IABS(J) | |
23321 | IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(1,J).EQ.0) GOTO 160 | |
23322 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 160 | |
23323 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
23324 | & GOTO 160 | |
23325 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
23326 | FCKM=1D0 | |
23327 | IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
23328 | FCOI=1D0 | |
23329 | IF(IA.LE.10) FCOI=FACA/3D0 | |
23330 | NCHN=NCHN+1 | |
23331 | ISIG(NCHN,1)=I | |
23332 | ISIG(NCHN,2)=J | |
23333 | ISIG(NCHN,3)=1 | |
23334 | SIGH(NCHN)=FACHW*FCOI*FCKM*WIDS(24,(5-KCHW)/2) | |
23335 | 160 CONTINUE | |
23336 | 170 CONTINUE | |
23337 | ||
23338 | ELSEIF(ISUB.EQ.32) THEN | |
23339 | C...f + g -> f + h0 (q + g -> q + h0 only) | |
23340 | SQMHC=PMAS(25,1)**2 | |
23341 | FHCQ=COMFAC*FACA*AS*AEM/XW*1D0/24D0 | |
23342 | DO 190 I=MMINA,MMAXA | |
23343 | IA=IABS(I) | |
23344 | IF(IA.NE.5) GOTO 190 | |
23345 | SQML=PMAS(IA,1)**2 | |
23346 | IF(IA.LE.10.AND.MSTP(37).EQ.1.AND.MSTP(2).GE.1) SQML=SQML* | |
23347 | & (LOG(MAX(4D0,PARP(37)**2*SQML/PARU(117)**2))/ | |
23348 | & LOG(MAX(4D0,SH/PARU(117)**2)))**(24D0/(33D0-2D0*MSTU(118))) | |
23349 | IUA=IA+MOD(IA,2) | |
23350 | SQMQ=SQML | |
23351 | FACHCQ=FHCQ*SQML/SQMW* | |
23352 | & (SH/(SQMQ-UH)+2D0*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH+ | |
23353 | & 2D0*SQMQ/(SQMQ-UH)+2D0*(SQMHC-UH)/(SQMQ-UH)* | |
23354 | & (SQMHC-SQMQ-SH)/SH) | |
23355 | KCHHC=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) | |
23356 | DO 180 ISDE=1,2 | |
23357 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 180 | |
23358 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,1).EQ.0) GOTO 180 | |
23359 | NCHN=NCHN+1 | |
23360 | ISIG(NCHN,ISDE)=I | |
23361 | ISIG(NCHN,3-ISDE)=21 | |
23362 | ISIG(NCHN,3)=1 | |
23363 | SIGH(NCHN)=FACHCQ*WIDS(37,(5-KCHHC)/2) | |
23364 | 180 CONTINUE | |
23365 | 190 CONTINUE | |
23366 | ENDIF | |
23367 | ||
23368 | ELSEIF(ISUB.LE.80) THEN | |
23369 | IF(ISUB.EQ.71) THEN | |
23370 | C...Z0 + Z0 -> Z0 + Z0 | |
23371 | IF(SH.LE.4.01D0*SQMZ) GOTO 220 | |
23372 | ||
23373 | IF(MSTP(46).LE.2) THEN | |
23374 | C...Exact scattering ME:s for on-mass-shell gauge bosons | |
23375 | BE2=1D0-4D0*SQMZ/SH | |
23376 | TH=-0.5D0*SH*BE2*(1D0-CTH) | |
23377 | UH=-0.5D0*SH*BE2*(1D0+CTH) | |
23378 | IF(MAX(TH,UH).GT.-1D0) GOTO 220 | |
23379 | SHANG=1D0/XW1*SQMW/SQMZ*(1D0+BE2)**2 | |
23380 | ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG | |
23381 | ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG | |
23382 | THANG=1D0/XW1*SQMW/SQMZ*(BE2-CTH)**2 | |
23383 | ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG | |
23384 | ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG | |
23385 | UHANG=1D0/XW1*SQMW/SQMZ*(BE2+CTH)**2 | |
23386 | AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG | |
23387 | AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG | |
23388 | FACZZ=COMFAC*1D0/(4096D0*PARU(1)**2*16D0*XW1**2)* | |
23389 | & (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2 | |
23390 | IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2) | |
23391 | IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATHRE+AUHRE)**2+ | |
23392 | & (ASHIM+ATHIM+AUHIM)**2) | |
23393 | IF(MSTP(46).EQ.2) FACZZ=0D0 | |
23394 | ||
23395 | ELSE | |
23396 | C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron | |
23397 | FACZZ=COMFAC*(AEM/(16D0*PARU(1)*XW*XW1))**2*(64D0/9D0)* | |
23398 | & ABS(A00U+2D0*A20U)**2 | |
23399 | ENDIF | |
23400 | FACZZ=FACZZ*WIDS(23,1) | |
23401 | ||
23402 | DO 210 I=MMIN1,MMAX1 | |
23403 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 210 | |
23404 | EI=KCHG(IABS(I),1)/3D0 | |
23405 | AI=SIGN(1D0,EI) | |
23406 | VI=AI-4D0*EI*XWV | |
23407 | AVI=AI**2+VI**2 | |
23408 | DO 200 J=MMIN2,MMAX2 | |
23409 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 200 | |
23410 | EJ=KCHG(IABS(J),1)/3D0 | |
23411 | AJ=SIGN(1D0,EJ) | |
23412 | VJ=AJ-4D0*EJ*XWV | |
23413 | AVJ=AJ**2+VJ**2 | |
23414 | NCHN=NCHN+1 | |
23415 | ISIG(NCHN,1)=I | |
23416 | ISIG(NCHN,2)=J | |
23417 | ISIG(NCHN,3)=1 | |
23418 | SIGH(NCHN)=0.5D0*FACZZ*AVI*AVJ | |
23419 | 200 CONTINUE | |
23420 | 210 CONTINUE | |
23421 | 220 CONTINUE | |
23422 | ||
23423 | ELSEIF(ISUB.EQ.72) THEN | |
23424 | C...Z0 + Z0 -> W+ + W- | |
23425 | IF(SH.LE.4.01D0*SQMZ) GOTO 250 | |
23426 | ||
23427 | IF(MSTP(46).LE.2) THEN | |
23428 | C...Exact scattering ME:s for on-mass-shell gauge bosons | |
23429 | BE2=SQRT((1D0-4D0*SQMW/SH)*(1D0-4D0*SQMZ/SH)) | |
23430 | CTH2=CTH**2 | |
23431 | TH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH-BE2*CTH) | |
23432 | UH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH+BE2*CTH) | |
23433 | IF(MAX(TH,UH).GT.-1D0) GOTO 250 | |
23434 | SHANG=4D0*SQRT(SQMW/(SQMZ*XW1))*(1D0-2D0*SQMW/SH)* | |
23435 | & (1D0-2D0*SQMZ/SH) | |
23436 | ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG | |
23437 | ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG | |
23438 | ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3D0/2D0+BE2/2D0* | |
23439 | & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* | |
23440 | & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* | |
23441 | & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2+ | |
23442 | & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) | |
23443 | ATWIM=0D0 | |
23444 | AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3D0/2D0-BE2/2D0* | |
23445 | & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* | |
23446 | & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* | |
23447 | & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2- | |
23448 | & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) | |
23449 | AUWIM=0D0 | |
23450 | A4RE=2D0*XW1/SQMZ*(3D0-CTH2-4D0*(SQMW+SQMZ)/SH) | |
23451 | A4IM=0D0 | |
23452 | FACWW=COMFAC*1D0/(4096D0*PARU(1)**2*16D0*XW1**2)* | |
23453 | & (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2 | |
23454 | IF(MSTP(46).LE.0) FACWW=FACWW*(ASHRE**2+ASHIM**2) | |
23455 | IF(MSTP(46).EQ.1) FACWW=FACWW*((ASHRE+ATWRE+AUWRE+A4RE)**2+ | |
23456 | & (ASHIM+ATWIM+AUWIM+A4IM)**2) | |
23457 | IF(MSTP(46).EQ.2) FACWW=FACWW*((ATWRE+AUWRE+A4RE)**2+ | |
23458 | & (ATWIM+AUWIM+A4IM)**2) | |
23459 | ||
23460 | ELSE | |
23461 | C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron | |
23462 | FACWW=COMFAC*(AEM/(16D0*PARU(1)*XW*XW1))**2*(64D0/9D0)* | |
23463 | & ABS(A00U-A20U)**2 | |
23464 | ENDIF | |
23465 | FACWW=FACWW*WIDS(24,1) | |
23466 | ||
23467 | DO 240 I=MMIN1,MMAX1 | |
23468 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240 | |
23469 | EI=KCHG(IABS(I),1)/3D0 | |
23470 | AI=SIGN(1D0,EI) | |
23471 | VI=AI-4D0*EI*XWV | |
23472 | AVI=AI**2+VI**2 | |
23473 | DO 230 J=MMIN2,MMAX2 | |
23474 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230 | |
23475 | EJ=KCHG(IABS(J),1)/3D0 | |
23476 | AJ=SIGN(1D0,EJ) | |
23477 | VJ=AJ-4D0*EJ*XWV | |
23478 | AVJ=AJ**2+VJ**2 | |
23479 | NCHN=NCHN+1 | |
23480 | ISIG(NCHN,1)=I | |
23481 | ISIG(NCHN,2)=J | |
23482 | ISIG(NCHN,3)=1 | |
23483 | SIGH(NCHN)=FACWW*AVI*AVJ | |
23484 | 230 CONTINUE | |
23485 | 240 CONTINUE | |
23486 | 250 CONTINUE | |
23487 | ||
23488 | ELSEIF(ISUB.EQ.73) THEN | |
23489 | C...Z0 + W+/- -> Z0 + W+/- | |
23490 | IF(SH.LE.2D0*SQMZ+2D0*SQMW) GOTO 280 | |
23491 | ||
23492 | IF(MSTP(46).LE.2) THEN | |
23493 | C...Exact scattering ME:s for on-mass-shell gauge bosons | |
23494 | BE2=1D0-2D0*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2 | |
23495 | EP1=1D0-(SQMZ-SQMW)/SH | |
23496 | EP2=1D0+(SQMZ-SQMW)/SH | |
23497 | TH=-0.5D0*SH*BE2*(1D0-CTH) | |
23498 | UH=(SQMZ-SQMW)**2/SH-0.5D0*SH*BE2*(1D0+CTH) | |
23499 | IF(MAX(TH,UH).GT.-1D0) GOTO 280 | |
23500 | THANG=(BE2-EP1*CTH)*(BE2-EP2*CTH) | |
23501 | ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG | |
23502 | ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG | |
23503 | ASWRE=-XW1/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+ | |
23504 | & 1D0/4D0*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4D0*BE2*CTH)+ | |
23505 | & 2D0*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH- | |
23506 | & 1D0/16D0*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2) | |
23507 | ASWIM=0D0 | |
23508 | AUWRE=XW1/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)* | |
23509 | & (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)* | |
23510 | & (BE2+EP1*EP2*CTH)*(2D0*EP2-EP2*CTH+EP1)- | |
23511 | & BE2*(EP2+EP1*CTH)**2*(BE2-EP2**2*CTH)-1D0/8D0* | |
23512 | & (BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2D0*BE2*(1D0-CTH))+ | |
23513 | & 1D0/32D0*SH/SQMW*(BE2+EP1*EP2*CTH)**2* | |
23514 | & (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)* | |
23515 | & (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)* | |
23516 | & (2D0*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2* | |
23517 | & (BE2-EP1**2*CTH)-1D0/8D0*(BE2+EP1*EP2*CTH)**2* | |
23518 | & ((EP1+EP2)**2+2D0*BE2*(1D0-CTH))+1D0/32D0*SH/SQMW* | |
23519 | & (BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2) | |
23520 | AUWIM=0D0 | |
23521 | A4RE=XW1/SQMZ*(EP1**2*EP2**2*(CTH**2-1D0)- | |
23522 | & 2D0*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2D0*BE2*EP1*EP2) | |
23523 | A4IM=0D0 | |
23524 | FACZW=COMFAC*1D0/(4096D0*PARU(1)**2*4D0*XW1)*(AEM/XW)**4* | |
23525 | & (SH/SQMW)**2*SQRT(SQMZ/SQMW)*SH2 | |
23526 | IF(MSTP(46).LE.0) FACZW=0D0 | |
23527 | IF(MSTP(46).EQ.1) FACZW=FACZW*((ATHRE+ASWRE+AUWRE+A4RE)**2+ | |
23528 | & (ATHIM+ASWIM+AUWIM+A4IM)**2) | |
23529 | IF(MSTP(46).EQ.2) FACZW=FACZW*((ASWRE+AUWRE+A4RE)**2+ | |
23530 | & (ASWIM+AUWIM+A4IM)**2) | |
23531 | ||
23532 | ELSE | |
23533 | C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron | |
23534 | FACZW=COMFAC*AEM**2/(64D0*PARU(1)**2*XW**2*XW1)*16D0* | |
23535 | & ABS(A20U+3D0*A11U*DBLE(CTH))**2 | |
23536 | ENDIF | |
23537 | FACZW=FACZW*WIDS(23,2) | |
23538 | ||
23539 | DO 270 I=MMIN1,MMAX1 | |
23540 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 270 | |
23541 | EI=KCHG(IABS(I),1)/3D0 | |
23542 | AI=SIGN(1D0,EI) | |
23543 | VI=AI-4D0*EI*XWV | |
23544 | AVI=AI**2+VI**2 | |
23545 | KCHWI=ISIGN(1,KCHG(IABS(I),1)*ISIGN(1,I)) | |
23546 | DO 260 J=MMIN2,MMAX2 | |
23547 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 260 | |
23548 | EJ=KCHG(IABS(J),1)/3D0 | |
23549 | AJ=SIGN(1D0,EJ) | |
23550 | VJ=AI-4D0*EJ*XWV | |
23551 | AVJ=AJ**2+VJ**2 | |
23552 | KCHWJ=ISIGN(1,KCHG(IABS(J),1)*ISIGN(1,J)) | |
23553 | NCHN=NCHN+1 | |
23554 | ISIG(NCHN,1)=I | |
23555 | ISIG(NCHN,2)=J | |
23556 | ISIG(NCHN,3)=1 | |
23557 | SIGH(NCHN)=FACZW*AVI*VINT(180+J)*WIDS(24,(5-KCHWJ)/2) | |
23558 | NCHN=NCHN+1 | |
23559 | ISIG(NCHN,1)=I | |
23560 | ISIG(NCHN,2)=J | |
23561 | ISIG(NCHN,3)=2 | |
23562 | SIGH(NCHN)=FACZW*VINT(180+I)*WIDS(24,(5-KCHWI)/2)*AVJ | |
23563 | 260 CONTINUE | |
23564 | 270 CONTINUE | |
23565 | 280 CONTINUE | |
23566 | ||
23567 | ELSEIF(ISUB.EQ.75) THEN | |
23568 | C...W+ + W- -> gamma + gamma | |
23569 | ||
23570 | ELSEIF(ISUB.EQ.76) THEN | |
23571 | C...W+ + W- -> Z0 + Z0 | |
23572 | IF(SH.LE.4.01D0*SQMZ) GOTO 310 | |
23573 | ||
23574 | IF(MSTP(46).LE.2) THEN | |
23575 | C...Exact scattering ME:s for on-mass-shell gauge bosons | |
23576 | BE2=SQRT((1D0-4D0*SQMW/SH)*(1D0-4D0*SQMZ/SH)) | |
23577 | CTH2=CTH**2 | |
23578 | TH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH-BE2*CTH) | |
23579 | UH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH+BE2*CTH) | |
23580 | IF(MAX(TH,UH).GT.-1D0) GOTO 310 | |
23581 | SHANG=4D0*SQRT(SQMW/(SQMZ*XW1))*(1D0-2D0*SQMW/SH)* | |
23582 | & (1D0-2D0*SQMZ/SH) | |
23583 | ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG | |
23584 | ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG | |
23585 | ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3D0/2D0+BE2/2D0* | |
23586 | & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* | |
23587 | & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* | |
23588 | & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2+ | |
23589 | & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) | |
23590 | ATWIM=0D0 | |
23591 | AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3D0/2D0-BE2/2D0* | |
23592 | & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* | |
23593 | & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* | |
23594 | & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2- | |
23595 | & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) | |
23596 | AUWIM=0D0 | |
23597 | A4RE=2D0*XW1/SQMZ*(3D0-CTH2-4D0*(SQMW+SQMZ)/SH) | |
23598 | A4IM=0D0 | |
23599 | FACZZ=COMFAC*1D0/(4096D0*PARU(1)**2)*(AEM/XW)**4* | |
23600 | & (SH/SQMW)**2*SH2 | |
23601 | IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2) | |
23602 | IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATWRE+AUWRE+A4RE)**2+ | |
23603 | & (ASHIM+ATWIM+AUWIM+A4IM)**2) | |
23604 | IF(MSTP(46).EQ.2) FACZZ=FACZZ*((ATWRE+AUWRE+A4RE)**2+ | |
23605 | & (ATWIM+AUWIM+A4IM)**2) | |
23606 | ||
23607 | ELSE | |
23608 | C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron | |
23609 | FACZZ=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*(64D0/9D0)* | |
23610 | & ABS(A00U-A20U)**2 | |
23611 | ENDIF | |
23612 | FACZZ=FACZZ*WIDS(23,1) | |
23613 | ||
23614 | DO 300 I=MMIN1,MMAX1 | |
23615 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 300 | |
23616 | EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) | |
23617 | DO 290 J=MMIN2,MMAX2 | |
23618 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 290 | |
23619 | EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) | |
23620 | IF(EI*EJ.GT.0D0) GOTO 290 | |
23621 | NCHN=NCHN+1 | |
23622 | ISIG(NCHN,1)=I | |
23623 | ISIG(NCHN,2)=J | |
23624 | ISIG(NCHN,3)=1 | |
23625 | SIGH(NCHN)=0.5D0*FACZZ*VINT(180+I)*VINT(180+J) | |
23626 | 290 CONTINUE | |
23627 | 300 CONTINUE | |
23628 | 310 CONTINUE | |
23629 | ||
23630 | ELSEIF(ISUB.EQ.77) THEN | |
23631 | C...W+/- + W+/- -> W+/- + W+/- | |
23632 | IF(SH.LE.4.01D0*SQMW) GOTO 340 | |
23633 | ||
23634 | IF(MSTP(46).LE.2) THEN | |
23635 | C...Exact scattering ME:s for on-mass-shell gauge bosons | |
23636 | BE2=1D0-4D0*SQMW/SH | |
23637 | BE4=BE2**2 | |
23638 | CTH2=CTH**2 | |
23639 | CTH3=CTH**3 | |
23640 | TH=-0.5D0*SH*BE2*(1D0-CTH) | |
23641 | UH=-0.5D0*SH*BE2*(1D0+CTH) | |
23642 | IF(MAX(TH,UH).GT.-1D0) GOTO 340 | |
23643 | SHANG=(1D0+BE2)**2 | |
23644 | ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG | |
23645 | ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG | |
23646 | THANG=(BE2-CTH)**2 | |
23647 | ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG | |
23648 | ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG | |
23649 | UHANG=(BE2+CTH)**2 | |
23650 | AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG | |
23651 | AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG | |
23652 | SGZANG=1D0/SQMW*BE2*(3D0-BE2)**2*CTH | |
23653 | ASGRE=XW*SGZANG | |
23654 | ASGIM=0D0 | |
23655 | ASZRE=XW1*SH/(SH-SQMZ)*SGZANG | |
23656 | ASZIM=0D0 | |
23657 | TGZANG=1D0/SQMW*(BE2*(4D0-2D0*BE2+BE4)+BE2*(4D0-10D0*BE2+ | |
23658 | & BE4)*CTH+(2D0-11D0*BE2+10D0*BE4)*CTH2+BE2*CTH3) | |
23659 | ATGRE=0.5D0*XW*SH/TH*TGZANG | |
23660 | ATGIM=0D0 | |
23661 | ATZRE=0.5D0*XW1*SH/(TH-SQMZ)*TGZANG | |
23662 | ATZIM=0D0 | |
23663 | UGZANG=1D0/SQMW*(BE2*(4D0-2D0*BE2+BE4)-BE2*(4D0-10D0*BE2+ | |
23664 | & BE4)*CTH+(2D0-11D0*BE2+10D0*BE4)*CTH2-BE2*CTH3) | |
23665 | AUGRE=0.5D0*XW*SH/UH*UGZANG | |
23666 | AUGIM=0D0 | |
23667 | AUZRE=0.5D0*XW1*SH/(UH-SQMZ)*UGZANG | |
23668 | AUZIM=0D0 | |
23669 | A4ARE=1D0/SQMW*(1D0+2D0*BE2-6D0*BE2*CTH-CTH2) | |
23670 | A4AIM=0D0 | |
23671 | A4SRE=2D0/SQMW*(1D0+2D0*BE2-CTH2) | |
23672 | A4SIM=0D0 | |
23673 | FWW=COMFAC*1D0/(4096D0*PARU(1)**2)*(AEM/XW)**4* | |
23674 | & (SH/SQMW)**2*SH2 | |
23675 | IF(MSTP(46).LE.0) THEN | |
23676 | AWWARE=ASHRE | |
23677 | AWWAIM=ASHIM | |
23678 | AWWSRE=0D0 | |
23679 | AWWSIM=0D0 | |
23680 | ELSEIF(MSTP(46).EQ.1) THEN | |
23681 | AWWARE=ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4ARE | |
23682 | AWWAIM=ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4AIM | |
23683 | AWWSRE=-ATHRE-AUHRE+ATGRE+ATZRE+AUGRE+AUZRE+A4SRE | |
23684 | AWWSIM=-ATHIM-AUHIM+ATGIM+ATZIM+AUGIM+AUZIM+A4SIM | |
23685 | ELSE | |
23686 | AWWARE=ASGRE+ASZRE+ATGRE+ATZRE+A4ARE | |
23687 | AWWAIM=ASGIM+ASZIM+ATGIM+ATZIM+A4AIM | |
23688 | AWWSRE=ATGRE+ATZRE+AUGRE+AUZRE+A4SRE | |
23689 | AWWSIM=ATGIM+ATZIM+AUGIM+AUZIM+A4SIM | |
23690 | ENDIF | |
23691 | AWWA2=AWWARE**2+AWWAIM**2 | |
23692 | AWWS2=AWWSRE**2+AWWSIM**2 | |
23693 | ||
23694 | ELSE | |
23695 | C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron | |
23696 | FWWA=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*(64D0/9D0)* | |
23697 | & ABS(A00U+0.5D0*A20U+4.5D0*A11U*DBLE(CTH))**2 | |
23698 | FWWS=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*64D0*ABS(A20U)**2 | |
23699 | ENDIF | |
23700 | ||
23701 | DO 330 I=MMIN1,MMAX1 | |
23702 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 330 | |
23703 | EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) | |
23704 | DO 320 J=MMIN2,MMAX2 | |
23705 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 320 | |
23706 | EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) | |
23707 | IF(EI*EJ.LT.0D0) THEN | |
23708 | C...W+W- | |
23709 | IF(MSTP(45).EQ.1) GOTO 320 | |
23710 | IF(MSTP(46).LE.2) FACWW=FWW*AWWA2*WIDS(24,1) | |
23711 | IF(MSTP(46).GE.3) FACWW=FWWA*WIDS(24,1) | |
23712 | ELSE | |
23713 | C...W+W+/W-W- | |
23714 | IF(MSTP(45).EQ.2) GOTO 320 | |
23715 | IF(MSTP(46).LE.2) FACWW=FWW*AWWS2 | |
23716 | IF(MSTP(46).GE.3) FACWW=FWWS | |
23717 | IF(EI.GT.0D0) FACWW=FACWW*WIDS(24,4) | |
23718 | IF(EI.LT.0D0) FACWW=FACWW*WIDS(24,5) | |
23719 | ENDIF | |
23720 | NCHN=NCHN+1 | |
23721 | ISIG(NCHN,1)=I | |
23722 | ISIG(NCHN,2)=J | |
23723 | ISIG(NCHN,3)=1 | |
23724 | SIGH(NCHN)=FACWW*VINT(180+I)*VINT(180+J) | |
23725 | IF(EI*EJ.GT.0D0) SIGH(NCHN)=0.5D0*SIGH(NCHN) | |
23726 | 320 CONTINUE | |
23727 | 330 CONTINUE | |
23728 | 340 CONTINUE | |
23729 | ENDIF | |
23730 | ||
23731 | ELSEIF(ISUB.LE.120) THEN | |
23732 | IF(ISUB.EQ.102) THEN | |
23733 | C...g + g -> h0 (or H0, or A0) | |
23734 | CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) | |
23735 | HS=SHR*WDTP(0) | |
23736 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
23737 | FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) | |
23738 | IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) | |
23739 | & FACBW=0D0 | |
23740 | HI=SHR*WDTP(13)/32D0 | |
23741 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 350 | |
23742 | NCHN=NCHN+1 | |
23743 | ISIG(NCHN,1)=21 | |
23744 | ISIG(NCHN,2)=21 | |
23745 | ISIG(NCHN,3)=1 | |
23746 | SIGH(NCHN)=HI*FACBW*HF | |
23747 | 350 CONTINUE | |
23748 | ||
23749 | ELSEIF(ISUB.EQ.103) THEN | |
23750 | C...gamma + gamma -> h0 (or H0, or A0) | |
23751 | CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) | |
23752 | HS=SHR*WDTP(0) | |
23753 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
23754 | FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) | |
23755 | IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) | |
23756 | & FACBW=0D0 | |
23757 | HI=SHR*WDTP(14)*2D0 | |
23758 | IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 360 | |
23759 | NCHN=NCHN+1 | |
23760 | ISIG(NCHN,1)=22 | |
23761 | ISIG(NCHN,2)=22 | |
23762 | ISIG(NCHN,3)=1 | |
23763 | SIGH(NCHN)=HI*FACBW*HF | |
23764 | 360 CONTINUE | |
23765 | ||
23766 | ELSEIF(ISUB.EQ.110) THEN | |
23767 | C...f + fbar -> gamma + h0 | |
23768 | THUH=MAX(TH*UH,SH*CKIN(3)**2) | |
23769 | FACHG=COMFAC*(3D0*AEM**4)/(2D0*PARU(1)**2*XW*SQMW)*SH*THUH | |
23770 | FACHG=FACHG*WIDS(KFHIGG,2) | |
23771 | C...Calculate loop contributions for intermediate gamma* and Z0 | |
23772 | CIGTOT=DCMPLX(0D0,0D0) | |
23773 | CIZTOT=DCMPLX(0D0,0D0) | |
23774 | JMAX=3*MSTP(1)+1 | |
23775 | DO 370 J=1,JMAX | |
23776 | IF(J.LE.2*MSTP(1)) THEN | |
23777 | FNC=1D0 | |
23778 | EJ=KCHG(J,1)/3D0 | |
23779 | AJ=SIGN(1D0,EJ+0.1D0) | |
23780 | VJ=AJ-4D0*EJ*XWV | |
23781 | BALP=SQM4/(2D0*PMAS(J,1))**2 | |
23782 | BBET=SH/(2D0*PMAS(J,1))**2 | |
23783 | ELSEIF(J.LE.3*MSTP(1)) THEN | |
23784 | FNC=3D0 | |
23785 | JL=2*(J-2*MSTP(1))-1 | |
23786 | EJ=KCHG(10+JL,1)/3D0 | |
23787 | AJ=SIGN(1D0,EJ+0.1D0) | |
23788 | VJ=AJ-4D0*EJ*XWV | |
23789 | BALP=SQM4/(2D0*PMAS(10+JL,1))**2 | |
23790 | BBET=SH/(2D0*PMAS(10+JL,1))**2 | |
23791 | ELSE | |
23792 | BALP=SQM4/(2D0*PMAS(24,1))**2 | |
23793 | BBET=SH/(2D0*PMAS(24,1))**2 | |
23794 | ENDIF | |
23795 | BABI=1D0/(BALP-BBET) | |
23796 | IF(BALP.LT.1D0) THEN | |
23797 | F0ALP=DCMPLX(DBLE(ASIN(SQRT(BALP))),0D0) | |
23798 | F1ALP=F0ALP**2 | |
23799 | ELSE | |
23800 | F0ALP=DCMPLX(DBLE(LOG(SQRT(BALP)+SQRT(BALP-1D0))), | |
23801 | & -DBLE(0.5D0*PARU(1))) | |
23802 | F1ALP=-F0ALP**2 | |
23803 | ENDIF | |
23804 | F2ALP=DBLE(SQRT(ABS(BALP-1D0)/BALP))*F0ALP | |
23805 | IF(BBET.LT.1D0) THEN | |
23806 | F0BET=DCMPLX(DBLE(ASIN(SQRT(BBET))),0D0) | |
23807 | F1BET=F0BET**2 | |
23808 | ELSE | |
23809 | F0BET=DCMPLX(DBLE(LOG(SQRT(BBET)+SQRT(BBET-1D0))), | |
23810 | & -DBLE(0.5D0*PARU(1))) | |
23811 | F1BET=-F0BET**2 | |
23812 | ENDIF | |
23813 | F2BET=DBLE(SQRT(ABS(BBET-1D0)/BBET))*F0BET | |
23814 | IF(J.LE.3*MSTP(1)) THEN | |
23815 | FIF=DBLE(0.5D0*BABI)+DBLE(BABI**2)*(DBLE(0.5D0*(1D0-BALP+ | |
23816 | & BBET))*(F1BET-F1ALP)+DBLE(BBET)*(F2BET-F2ALP)) | |
23817 | CIGTOT=CIGTOT+DBLE(FNC*EJ**2)*FIF | |
23818 | CIZTOT=CIZTOT+DBLE(FNC*EJ*VJ)*FIF | |
23819 | ELSE | |
23820 | TXW=XW/XW1 | |
23821 | CIGTOT=CIGTOT-0.5*(DBLE(BABI*(1.5D0+BALP))+DBLE(BABI**2)* | |
23822 | & (DBLE(1.5D0-3D0*BALP+4D0*BBET)*(F1BET-F1ALP)+ | |
23823 | & DBLE(BBET*(2D0*BALP+3D0))*(F2BET-F2ALP))) | |
23824 | CIZTOT=CIZTOT-DBLE(0.5D0*BABI*XW1)*(DBLE(5D0-TXW+2D0*BALP* | |
23825 | & (1D0-TXW))*(1D0+DBLE(2D0*BABI*BBET)*(F2BET-F2ALP))+ | |
23826 | & DBLE(BABI*(4D0*BBET*(3D0-TXW)-(2D0*BALP-1D0)*(5D0-TXW)))* | |
23827 | & (F1BET-F1ALP)) | |
23828 | ENDIF | |
23829 | 370 CONTINUE | |
23830 | CIGTOT=CIGTOT/DBLE(SH) | |
23831 | CIZTOT=CIZTOT*DBLE(XWC)/DCMPLX(DBLE(SH-SQMZ),DBLE(GMMZ)) | |
23832 | C...Loop over initial flavours | |
23833 | DO 380 I=MMINA,MMAXA | |
23834 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380 | |
23835 | EI=KCHG(IABS(I),1)/3D0 | |
23836 | AI=SIGN(1D0,EI) | |
23837 | VI=AI-4D0*EI*XWV | |
23838 | FCOI=1D0 | |
23839 | IF(IABS(I).LE.10) FCOI=FACA/3D0 | |
23840 | NCHN=NCHN+1 | |
23841 | ISIG(NCHN,1)=I | |
23842 | ISIG(NCHN,2)=-I | |
23843 | ISIG(NCHN,3)=1 | |
23844 | SIGH(NCHN)=FACHG*FCOI*(ABS(DBLE(EI)*CIGTOT+DBLE(VI)* | |
23845 | & CIZTOT)**2+AI**2*ABS(CIZTOT)**2) | |
23846 | 380 CONTINUE | |
23847 | ||
23848 | ELSEIF(ISUB.EQ.111) THEN | |
23849 | C...f + fbar -> g + h0 (q + qbar -> g + h0 only) | |
23850 | IF(MSTP(38).NE.0) THEN | |
23851 | C...Simple case: only do gg <-> h exactly. | |
23852 | CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) | |
23853 | FACGH=COMFAC*FACA*(2D0/9D0)*AS*(WDTP(13)/SQRT(SQM4))* | |
23854 | & (TH**2+UH**2)/(SH*SQM4) | |
23855 | C...Propagators: as simulated in PYOFSH and as desired | |
23856 | HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) | |
23857 | GMMHC=SQRT(SQM4)*WDTP(0) | |
23858 | HBW4C=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/ | |
23859 | & ((SQM4-SQMH)**2+GMMHC**2) | |
23860 | FACGH=FACGH*HBW4C/HBW4 | |
23861 | ELSE | |
23862 | C...Messy case: do full loop integrals | |
23863 | A5STUR=0D0 | |
23864 | A5STUI=0D0 | |
23865 | DO 390 I=1,2*MSTP(1) | |
23866 | SQMQ=PMAS(I,1)**2 | |
23867 | EPSS=4D0*SQMQ/SH | |
23868 | EPSH=4D0*SQMQ/SQMH | |
23869 | CALL PYWAUX(1,EPSS,W1SR,W1SI) | |
23870 | CALL PYWAUX(1,EPSH,W1HR,W1HI) | |
23871 | CALL PYWAUX(2,EPSS,W2SR,W2SI) | |
23872 | CALL PYWAUX(2,EPSH,W2HR,W2HI) | |
23873 | A5STUR=A5STUR+EPSH*(1D0+SH/(TH+UH)*(W1SR-W1HR)+ | |
23874 | & (0.25D0-SQMQ/(TH+UH))*(W2SR-W2HR)) | |
23875 | A5STUI=A5STUI+EPSH*(SH/(TH+UH)*(W1SI-W1HI)+ | |
23876 | & (0.25D0-SQMQ/(TH+UH))*(W2SI-W2HI)) | |
23877 | 390 CONTINUE | |
23878 | FACGH=COMFAC*FACA/(144D0*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW* | |
23879 | & SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2) | |
23880 | FACGH=FACGH*WIDS(25,2) | |
23881 | ENDIF | |
23882 | DO 400 I=MMINA,MMAXA | |
23883 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
23884 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400 | |
23885 | NCHN=NCHN+1 | |
23886 | ISIG(NCHN,1)=I | |
23887 | ISIG(NCHN,2)=-I | |
23888 | ISIG(NCHN,3)=1 | |
23889 | SIGH(NCHN)=FACGH | |
23890 | 400 CONTINUE | |
23891 | ||
23892 | ELSEIF(ISUB.EQ.112) THEN | |
23893 | C...f + g -> f + h0 (q + g -> q + h0 only) | |
23894 | IF(MSTP(38).NE.0) THEN | |
23895 | C...Simple case: only do gg <-> h exactly. | |
23896 | CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) | |
23897 | FACQH=COMFAC*FACA*(1D0/12D0)*AS*(WDTP(13)/SQRT(SQM4))* | |
23898 | & (SH**2+UH**2)/(-TH*SQM4) | |
23899 | C...Propagators: as simulated in PYOFSH and as desired | |
23900 | HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) | |
23901 | GMMHC=SQRT(SQM4)*WDTP(0) | |
23902 | HBW4C=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/ | |
23903 | & ((SQM4-SQMH)**2+GMMHC**2) | |
23904 | FACQH=FACQH*HBW4C/HBW4 | |
23905 | ELSE | |
23906 | C...Messy case: do full loop integrals | |
23907 | A5TSUR=0D0 | |
23908 | A5TSUI=0D0 | |
23909 | DO 410 I=1,2*MSTP(1) | |
23910 | SQMQ=PMAS(I,1)**2 | |
23911 | EPST=4D0*SQMQ/TH | |
23912 | EPSH=4D0*SQMQ/SQMH | |
23913 | CALL PYWAUX(1,EPST,W1TR,W1TI) | |
23914 | CALL PYWAUX(1,EPSH,W1HR,W1HI) | |
23915 | CALL PYWAUX(2,EPST,W2TR,W2TI) | |
23916 | CALL PYWAUX(2,EPSH,W2HR,W2HI) | |
23917 | A5TSUR=A5TSUR+EPSH*(1D0+TH/(SH+UH)*(W1TR-W1HR)+ | |
23918 | & (0.25D0-SQMQ/(SH+UH))*(W2TR-W2HR)) | |
23919 | A5TSUI=A5TSUI+EPSH*(TH/(SH+UH)*(W1TI-W1HI)+ | |
23920 | & (0.25D0-SQMQ/(SH+UH))*(W2TI-W2HI)) | |
23921 | 410 CONTINUE | |
23922 | FACQH=COMFAC*FACA/(384D0*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW* | |
23923 | & SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2) | |
23924 | FACQH=FACQH*WIDS(25,2) | |
23925 | ENDIF | |
23926 | DO 430 I=MMINA,MMAXA | |
23927 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 430 | |
23928 | DO 420 ISDE=1,2 | |
23929 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 420 | |
23930 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 420 | |
23931 | NCHN=NCHN+1 | |
23932 | ISIG(NCHN,ISDE)=I | |
23933 | ISIG(NCHN,3-ISDE)=21 | |
23934 | ISIG(NCHN,3)=1 | |
23935 | SIGH(NCHN)=FACQH | |
23936 | 420 CONTINUE | |
23937 | 430 CONTINUE | |
23938 | ||
23939 | ELSEIF(ISUB.EQ.113) THEN | |
23940 | C...g + g -> g + h0 | |
23941 | IF(MSTP(38).NE.0) THEN | |
23942 | C...Simple case: only do gg <-> h exactly. | |
23943 | CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) | |
23944 | FACGH=COMFAC*FACA*(3D0/16D0)*AS*(WDTP(13)/SQRT(SQM4))* | |
23945 | & (SH**4+TH**4+UH**4+SQM4**4)/(SH*TH*UH*SQM4) | |
23946 | C...Propagators: as simulated in PYOFSH and as desired | |
23947 | HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) | |
23948 | GMMHC=SQRT(SQM4)*WDTP(0) | |
23949 | HBW4C=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/ | |
23950 | & ((SQM4-SQMH)**2+GMMHC**2) | |
23951 | FACGH=FACGH*HBW4C/HBW4 | |
23952 | ELSE | |
23953 | C...Messy case: do full loop integrals | |
23954 | A2STUR=0D0 | |
23955 | A2STUI=0D0 | |
23956 | A2USTR=0D0 | |
23957 | A2USTI=0D0 | |
23958 | A2TUSR=0D0 | |
23959 | A2TUSI=0D0 | |
23960 | A4STUR=0D0 | |
23961 | A4STUI=0D0 | |
23962 | DO 440 I=1,2*MSTP(1) | |
23963 | SQMQ=PMAS(I,1)**2 | |
23964 | EPSS=4D0*SQMQ/SH | |
23965 | EPST=4D0*SQMQ/TH | |
23966 | EPSU=4D0*SQMQ/UH | |
23967 | EPSH=4D0*SQMQ/SQMH | |
23968 | IF(EPSH.LT.1D-6) GOTO 440 | |
23969 | CALL PYWAUX(1,EPSS,W1SR,W1SI) | |
23970 | CALL PYWAUX(1,EPST,W1TR,W1TI) | |
23971 | CALL PYWAUX(1,EPSU,W1UR,W1UI) | |
23972 | CALL PYWAUX(1,EPSH,W1HR,W1HI) | |
23973 | CALL PYWAUX(2,EPSS,W2SR,W2SI) | |
23974 | CALL PYWAUX(2,EPST,W2TR,W2TI) | |
23975 | CALL PYWAUX(2,EPSU,W2UR,W2UI) | |
23976 | CALL PYWAUX(2,EPSH,W2HR,W2HI) | |
23977 | CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI) | |
23978 | CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI) | |
23979 | CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI) | |
23980 | CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI) | |
23981 | CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI) | |
23982 | CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI) | |
23983 | CALL PYI3AU(EPSH,SQMH/SH*TH/UH,YHSTUR,YHSTUI) | |
23984 | CALL PYI3AU(EPSH,SQMH/SH*UH/TH,YHSUTR,YHSUTI) | |
23985 | CALL PYI3AU(EPSH,SQMH/TH*SH/UH,YHTSUR,YHTSUI) | |
23986 | CALL PYI3AU(EPSH,SQMH/TH*UH/SH,YHTUSR,YHTUSI) | |
23987 | CALL PYI3AU(EPSH,SQMH/UH*SH/TH,YHUSTR,YHUSTI) | |
23988 | CALL PYI3AU(EPSH,SQMH/UH*TH/SH,YHUTSR,YHUTSI) | |
23989 | W3STUR=YHSTUR-Y3STUR-Y3UTSR | |
23990 | W3STUI=YHSTUI-Y3STUI-Y3UTSI | |
23991 | W3SUTR=YHSUTR-Y3SUTR-Y3TUSR | |
23992 | W3SUTI=YHSUTI-Y3SUTI-Y3TUSI | |
23993 | W3TSUR=YHTSUR-Y3TSUR-Y3USTR | |
23994 | W3TSUI=YHTSUI-Y3TSUI-Y3USTI | |
23995 | W3TUSR=YHTUSR-Y3TUSR-Y3SUTR | |
23996 | W3TUSI=YHTUSI-Y3TUSI-Y3SUTI | |
23997 | W3USTR=YHUSTR-Y3USTR-Y3TSUR | |
23998 | W3USTI=YHUSTI-Y3USTI-Y3TSUI | |
23999 | W3UTSR=YHUTSR-Y3UTSR-Y3STUR | |
24000 | W3UTSI=YHUTSI-Y3UTSI-Y3STUI | |
24001 | B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2D0*TH*UH* | |
24002 | & (UH+2D0*SH)/(SH+UH)**2*(W1TR-W1HR)+(SQMQ-SH/4D0)* | |
24003 | & (0.5D0*W2SR+0.5D0*W2HR-W2TR+W3STUR)+SH2*(2D0*SQMQ/ | |
24004 | & (SH+UH)**2-0.5D0/(SH+UH))*(W2TR-W2HR)+0.5D0*TH*UH/SH* | |
24005 | & (W2HR-2D0*W2TR)+0.125D0*(SH-12D0*SQMQ-4D0*TH*UH/SH)*W3TSUR) | |
24006 | B2STUI=SQMQ/SQMH**2*(2D0*TH*UH*(UH+2D0*SH)/(SH+UH)**2* | |
24007 | & (W1TI-W1HI)+(SQMQ-SH/4D0)*(0.5D0*W2SI+0.5D0*W2HI-W2TI+ | |
24008 | & W3STUI)+SH2*(2D0*SQMQ/(SH+UH)**2-0.5D0/(SH+UH))* | |
24009 | & (W2TI-W2HI)+0.5D0*TH*UH/SH*(W2HI-2D0*W2TI)+0.125D0* | |
24010 | & (SH-12D0*SQMQ-4D0*TH*UH/SH)*W3TSUI) | |
24011 | B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2D0*UH*TH* | |
24012 | & (TH+2D0*SH)/(SH+TH)**2*(W1UR-W1HR)+(SQMQ-SH/4D0)* | |
24013 | & (0.5D0*W2SR+0.5D0*W2HR-W2UR+W3SUTR)+SH2*(2D0*SQMQ/ | |
24014 | & (SH+TH)**2-0.5D0/(SH+TH))*(W2UR-W2HR)+0.5D0*UH*TH/SH* | |
24015 | & (W2HR-2D0*W2UR)+0.125D0*(SH-12D0*SQMQ-4D0*UH*TH/SH)*W3USTR) | |
24016 | B2SUTI=SQMQ/SQMH**2*(2D0*UH*TH*(TH+2D0*SH)/(SH+TH)**2* | |
24017 | & (W1UI-W1HI)+(SQMQ-SH/4D0)*(0.5D0*W2SI+0.5D0*W2HI-W2UI+ | |
24018 | & W3SUTI)+SH2*(2D0*SQMQ/(SH+TH)**2-0.5D0/(SH+TH))* | |
24019 | & (W2UI-W2HI)+0.5D0*UH*TH/SH*(W2HI-2D0*W2UI)+0.125D0* | |
24020 | & (SH-12D0*SQMQ-4D0*UH*TH/SH)*W3USTI) | |
24021 | B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2D0*SH*UH* | |
24022 | & (UH+2D0*TH)/(TH+UH)**2*(W1SR-W1HR)+(SQMQ-TH/4D0)* | |
24023 | & (0.5D0*W2TR+0.5D0*W2HR-W2SR+W3TSUR)+TH2*(2D0*SQMQ/ | |
24024 | & (TH+UH)**2-0.5D0/(TH+UH))*(W2SR-W2HR)+0.5D0*SH*UH/TH* | |
24025 | & (W2HR-2D0*W2SR)+0.125D0*(TH-12D0*SQMQ-4D0*SH*UH/TH)*W3STUR) | |
24026 | B2TSUI=SQMQ/SQMH**2*(2D0*SH*UH*(UH+2D0*TH)/(TH+UH)**2* | |
24027 | & (W1SI-W1HI)+(SQMQ-TH/4D0)*(0.5D0*W2TI+0.5D0*W2HI-W2SI+ | |
24028 | & W3TSUI)+TH2*(2D0*SQMQ/(TH+UH)**2-0.5D0/(TH+UH))* | |
24029 | & (W2SI-W2HI)+0.5D0*SH*UH/TH*(W2HI-2D0*W2SI)+0.125D0* | |
24030 | & (TH-12D0*SQMQ-4D0*SH*UH/TH)*W3STUI) | |
24031 | B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2D0*UH*SH* | |
24032 | & (SH+2D0*TH)/(TH+SH)**2*(W1UR-W1HR)+(SQMQ-TH/4D0)* | |
24033 | & (0.5D0*W2TR+0.5D0*W2HR-W2UR+W3TUSR)+TH2*(2D0*SQMQ/ | |
24034 | & (TH+SH)**2-0.5D0/(TH+SH))*(W2UR-W2HR)+0.5D0*UH*SH/TH* | |
24035 | & (W2HR-2D0*W2UR)+0.125D0*(TH-12D0*SQMQ-4D0*UH*SH/TH)*W3UTSR) | |
24036 | B2TUSI=SQMQ/SQMH**2*(2D0*UH*SH*(SH+2D0*TH)/(TH+SH)**2* | |
24037 | & (W1UI-W1HI)+(SQMQ-TH/4D0)*(0.5D0*W2TI+0.5D0*W2HI-W2UI+ | |
24038 | & W3TUSI)+TH2*(2D0*SQMQ/(TH+SH)**2-0.5D0/(TH+SH))* | |
24039 | & (W2UI-W2HI)+0.5D0*UH*SH/TH*(W2HI-2D0*W2UI)+0.125D0* | |
24040 | & (TH-12D0*SQMQ-4D0*UH*SH/TH)*W3UTSI) | |
24041 | B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2D0*SH*TH* | |
24042 | & (TH+2D0*UH)/(UH+TH)**2*(W1SR-W1HR)+(SQMQ-UH/4D0)* | |
24043 | & (0.5D0*W2UR+0.5D0*W2HR-W2SR+W3USTR)+UH2*(2D0*SQMQ/ | |
24044 | & (UH+TH)**2-0.5D0/(UH+TH))*(W2SR-W2HR)+0.5D0*SH*TH/UH* | |
24045 | & (W2HR-2D0*W2SR)+0.125D0*(UH-12D0*SQMQ-4D0*SH*TH/UH)*W3SUTR) | |
24046 | B2USTI=SQMQ/SQMH**2*(2D0*SH*TH*(TH+2D0*UH)/(UH+TH)**2* | |
24047 | & (W1SI-W1HI)+(SQMQ-UH/4D0)*(0.5D0*W2UI+0.5D0*W2HI-W2SI+ | |
24048 | & W3USTI)+UH2*(2D0*SQMQ/(UH+TH)**2-0.5D0/(UH+TH))* | |
24049 | & (W2SI-W2HI)+0.5D0*SH*TH/UH*(W2HI-2D0*W2SI)+0.125D0* | |
24050 | & (UH-12D0*SQMQ-4D0*SH*TH/UH)*W3SUTI) | |
24051 | B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2D0*TH*SH* | |
24052 | & (SH+2D0*UH)/(UH+SH)**2*(W1TR-W1HR)+(SQMQ-UH/4D0)* | |
24053 | & (0.5D0*W2UR+0.5D0*W2HR-W2TR+W3UTSR)+UH2*(2D0*SQMQ/ | |
24054 | & (UH+SH)**2-0.5D0/(UH+SH))*(W2TR-W2HR)+0.5D0*TH*SH/UH* | |
24055 | & (W2HR-2D0*W2TR)+0.125D0*(UH-12D0*SQMQ-4D0*TH*SH/UH)*W3TUSR) | |
24056 | B2UTSI=SQMQ/SQMH**2*(2D0*TH*SH*(SH+2D0*UH)/(UH+SH)**2* | |
24057 | & (W1TI-W1HI)+(SQMQ-UH/4D0)*(0.5D0*W2UI+0.5D0*W2HI-W2TI+ | |
24058 | & W3UTSI)+UH2*(2D0*SQMQ/(UH+SH)**2-0.5D0/(UH+SH))* | |
24059 | & (W2TI-W2HI)+0.5D0*TH*SH/UH*(W2HI-2D0*W2TI)+0.125D0* | |
24060 | & (UH-12D0*SQMQ-4D0*TH*SH/UH)*W3TUSI) | |
24061 | B4STUR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)* | |
24062 | & (W2SR-W2HR+W3STUR)) | |
24063 | B4STUI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2SI-W2HI+W3STUI) | |
24064 | B4TUSR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)* | |
24065 | & (W2TR-W2HR+W3TUSR)) | |
24066 | B4TUSI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2TI-W2HI+W3TUSI) | |
24067 | B4USTR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)* | |
24068 | & (W2UR-W2HR+W3USTR)) | |
24069 | B4USTI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2UI-W2HI+W3USTI) | |
24070 | A2STUR=A2STUR+B2STUR+B2SUTR | |
24071 | A2STUI=A2STUI+B2STUI+B2SUTI | |
24072 | A2USTR=A2USTR+B2USTR+B2UTSR | |
24073 | A2USTI=A2USTI+B2USTI+B2UTSI | |
24074 | A2TUSR=A2TUSR+B2TUSR+B2TSUR | |
24075 | A2TUSI=A2TUSI+B2TUSI+B2TSUI | |
24076 | A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR | |
24077 | A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI | |
24078 | 440 CONTINUE | |
24079 | FACGH=COMFAC*FACA*3D0/(128D0*PARU(1)**2)*AEM/XW*AS**3* | |
24080 | & SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+ | |
24081 | & A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2) | |
24082 | FACGH=FACGH*WIDS(25,2) | |
24083 | ENDIF | |
24084 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 450 | |
24085 | NCHN=NCHN+1 | |
24086 | ISIG(NCHN,1)=21 | |
24087 | ISIG(NCHN,2)=21 | |
24088 | ISIG(NCHN,3)=1 | |
24089 | SIGH(NCHN)=FACGH | |
24090 | 450 CONTINUE | |
24091 | ENDIF | |
24092 | ||
24093 | ELSEIF(ISUB.LE.170) THEN | |
24094 | IF(ISUB.EQ.121) THEN | |
24095 | C...g + g -> Q + Qbar + h0 | |
24096 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 460 | |
24097 | IA=KFPR(ISUBSV,2) | |
24098 | PMF=PYMRUN(IA,SH) | |
24099 | FACQQH=COMFAC*(4D0*PARU(1)*AEM/XW)*(4D0*PARU(1)*AS)**2* | |
24100 | & (0.5D0*PMF/PMAS(24,1))**2 | |
24101 | WID2=1D0 | |
24102 | IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) | |
24103 | FACQQH=FACQQH*WID2 | |
24104 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN | |
24105 | IKFI=1 | |
24106 | IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 | |
24107 | IF(IA.GT.10) IKFI=3 | |
24108 | FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2 | |
24109 | IF(IMSS(1).NE.0.AND.IA.EQ.5) THEN | |
24110 | FACQQH=FACQQH/(1D0+RMSS(41))**2 | |
24111 | IF(IHIGG.NE.3) THEN | |
24112 | FACQQH=FACQQH*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ | |
24113 | & PARU(151+10*IHIGG))**2 | |
24114 | ENDIF | |
24115 | ENDIF | |
24116 | ENDIF | |
24117 | CALL PYQQBH(WTQQBH) | |
24118 | CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) | |
24119 | HS=SHR*WDTP(0) | |
24120 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
24121 | FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) | |
24122 | IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) | |
24123 | & FACBW=0D0 | |
24124 | NCHN=NCHN+1 | |
24125 | ISIG(NCHN,1)=21 | |
24126 | ISIG(NCHN,2)=21 | |
24127 | ISIG(NCHN,3)=1 | |
24128 | SIGH(NCHN)=FACQQH*WTQQBH*FACBW | |
24129 | 460 CONTINUE | |
24130 | ||
24131 | ELSEIF(ISUB.EQ.122) THEN | |
24132 | C...q + qbar -> Q + Qbar + h0 | |
24133 | IA=KFPR(ISUBSV,2) | |
24134 | PMF=PYMRUN(IA,SH) | |
24135 | FACQQH=COMFAC*(4D0*PARU(1)*AEM/XW)*(4D0*PARU(1)*AS)**2* | |
24136 | & (0.5D0*PMF/PMAS(24,1))**2 | |
24137 | WID2=1D0 | |
24138 | IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) | |
24139 | FACQQH=FACQQH*WID2 | |
24140 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN | |
24141 | IKFI=1 | |
24142 | IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 | |
24143 | IF(IA.GT.10) IKFI=3 | |
24144 | FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2 | |
24145 | IF(IMSS(1).NE.0.AND.IA.EQ.5) THEN | |
24146 | FACQQH=FACQQH/(1D0+RMSS(41))**2 | |
24147 | IF(IHIGG.NE.3) THEN | |
24148 | FACQQH=FACQQH*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ | |
24149 | & PARU(151+10*IHIGG))**2 | |
24150 | ENDIF | |
24151 | ENDIF | |
24152 | ENDIF | |
24153 | CALL PYQQBH(WTQQBH) | |
24154 | CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) | |
24155 | HS=SHR*WDTP(0) | |
24156 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
24157 | FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) | |
24158 | IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) | |
24159 | & FACBW=0D0 | |
24160 | DO 470 I=MMINA,MMAXA | |
24161 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
24162 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 470 | |
24163 | NCHN=NCHN+1 | |
24164 | ISIG(NCHN,1)=I | |
24165 | ISIG(NCHN,2)=-I | |
24166 | ISIG(NCHN,3)=1 | |
24167 | SIGH(NCHN)=FACQQH*WTQQBH*FACBW | |
24168 | 470 CONTINUE | |
24169 | ||
24170 | ELSEIF(ISUB.EQ.123) THEN | |
24171 | C...f + f' -> f + f' + h0 (or H0, or A0) (Z0 + Z0 -> h0 as | |
24172 | C...inner process) | |
24173 | FACNOR=COMFAC*(4D0*PARU(1)*AEM/(XW*XW1))**3*SQMZ/32D0 | |
24174 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR* | |
24175 | & PARU(154+10*IHIGG)**2 | |
24176 | FACPRP=1D0/((VINT(215)-VINT(204)**2)* | |
24177 | & (VINT(216)-VINT(209)**2))**2 | |
24178 | FACZZ1=FACNOR*FACPRP*(0.5D0*TAUP*VINT(2))*VINT(219) | |
24179 | FACZZ2=FACNOR*FACPRP*VINT(217)*VINT(218) | |
24180 | CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) | |
24181 | HS=SHR*WDTP(0) | |
24182 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
24183 | FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) | |
24184 | IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) | |
24185 | & FACBW=0D0 | |
24186 | DO 490 I=MMIN1,MMAX1 | |
24187 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 490 | |
24188 | IA=IABS(I) | |
24189 | DO 480 J=MMIN2,MMAX2 | |
24190 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 480 | |
24191 | JA=IABS(J) | |
24192 | EI=KCHG(IA,1)*ISIGN(1,I)/3D0 | |
24193 | AI=SIGN(1D0,KCHG(IA,1)+0.5D0)*ISIGN(1,I) | |
24194 | VI=AI-4D0*EI*XWV | |
24195 | EJ=KCHG(JA,1)*ISIGN(1,J)/3D0 | |
24196 | AJ=SIGN(1D0,KCHG(JA,1)+0.5D0)*ISIGN(1,J) | |
24197 | VJ=AJ-4D0*EJ*XWV | |
24198 | FACLR1=(VI**2+AI**2)*(VJ**2+AJ**2)+4D0*VI*AI*VJ*AJ | |
24199 | FACLR2=(VI**2+AI**2)*(VJ**2+AJ**2)-4D0*VI*AI*VJ*AJ | |
24200 | NCHN=NCHN+1 | |
24201 | ISIG(NCHN,1)=I | |
24202 | ISIG(NCHN,2)=J | |
24203 | ISIG(NCHN,3)=1 | |
24204 | SIGH(NCHN)=(FACLR1*FACZZ1+FACLR2*FACZZ2)*FACBW | |
24205 | 480 CONTINUE | |
24206 | 490 CONTINUE | |
24207 | ||
24208 | ELSEIF(ISUB.EQ.124) THEN | |
24209 | C...f + f' -> f" + f"' + h0 (or H0, or A0) (W+ + W- -> h0 as | |
24210 | C...inner process) | |
24211 | FACNOR=COMFAC*(4D0*PARU(1)*AEM/XW)**3*SQMW | |
24212 | IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR* | |
24213 | & PARU(155+10*IHIGG)**2 | |
24214 | FACPRP=1D0/((VINT(215)-VINT(204)**2)* | |
24215 | & (VINT(216)-VINT(209)**2))**2 | |
24216 | FACWW=FACNOR*FACPRP*(0.5D0*TAUP*VINT(2))*VINT(219) | |
24217 | CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) | |
24218 | HS=SHR*WDTP(0) | |
24219 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
24220 | FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) | |
24221 | IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) | |
24222 | & FACBW=0D0 | |
24223 | DO 510 I=MMIN1,MMAX1 | |
24224 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 510 | |
24225 | EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) | |
24226 | DO 500 J=MMIN2,MMAX2 | |
24227 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 500 | |
24228 | EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) | |
24229 | IF(EI*EJ.GT.0D0) GOTO 500 | |
24230 | FACLR=VINT(180+I)*VINT(180+J) | |
24231 | NCHN=NCHN+1 | |
24232 | ISIG(NCHN,1)=I | |
24233 | ISIG(NCHN,2)=J | |
24234 | ISIG(NCHN,3)=1 | |
24235 | SIGH(NCHN)=FACLR*FACWW*FACBW | |
24236 | 500 CONTINUE | |
24237 | 510 CONTINUE | |
24238 | ||
24239 | ELSEIF(ISUB.EQ.143) THEN | |
24240 | C...f + fbar' -> H+/- | |
24241 | SQMHC=PMAS(37,1)**2 | |
24242 | CALL PYWIDT(37,SH,WDTP,WDTE) | |
24243 | HS=SHR*WDTP(0) | |
24244 | FACBW=4D0*COMFAC/((SH-SQMHC)**2+HS**2) | |
24245 | HP=AEM/(8D0*XW)*SH/SQMW*SH | |
24246 | DO 530 I=MMIN1,MMAX1 | |
24247 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 530 | |
24248 | IA=IABS(I) | |
24249 | IM=(MOD(IA,10)+1)/2 | |
24250 | DO 520 J=MMIN2,MMAX2 | |
24251 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 520 | |
24252 | JA=IABS(J) | |
24253 | JM=(MOD(JA,10)+1)/2 | |
24254 | IF(I*J.GT.0.OR.IA.EQ.JA.OR.IM.NE.JM) GOTO 520 | |
24255 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
24256 | & GOTO 520 | |
24257 | IF(MOD(IA,2).EQ.0) THEN | |
24258 | IU=IA | |
24259 | IL=JA | |
24260 | ELSE | |
24261 | IU=JA | |
24262 | IL=IA | |
24263 | ENDIF | |
24264 | RML=PYMRUN(IL,SH)**2/SH | |
24265 | RMU=PYMRUN(IU,SH)**2/SH | |
24266 | HI=HP*(RML*PARU(141)**2+RMU/PARU(141)**2) | |
24267 | IF(IA.LE.10) HI=HI*FACA/3D0 | |
24268 | KCHHC=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
24269 | HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) | |
24270 | NCHN=NCHN+1 | |
24271 | ISIG(NCHN,1)=I | |
24272 | ISIG(NCHN,2)=J | |
24273 | ISIG(NCHN,3)=1 | |
24274 | SIGH(NCHN)=HI*FACBW*HF | |
24275 | 520 CONTINUE | |
24276 | 530 CONTINUE | |
24277 | ||
24278 | ELSEIF(ISUB.EQ.161) THEN | |
24279 | C...f + g -> f' + H+/- (b + g -> t + H+/- only) | |
24280 | C...(choice of only b and t to avoid kinematics problems) | |
24281 | FHCQ=COMFAC*FACA*AS*AEM/XW*1D0/24 | |
24282 | C...H propagator: as simulated in PYOFSH and as desired | |
24283 | SQMHC=PMAS(37,1)**2 | |
24284 | GMMHC=PMAS(37,1)*PMAS(37,2) | |
24285 | HBW4=GMMHC/((SQM4-SQMHC)**2+GMMHC**2) | |
24286 | CALL PYWIDT(37,SQM4,WDTP,WDTE) | |
24287 | GMMHCC=SQRT(SQM4)*WDTP(0) | |
24288 | HBW4C=GMMHCC/((SQM4-SQMHC)**2+GMMHCC**2) | |
24289 | FHCQ=FHCQ*HBW4C/HBW4 | |
24290 | DO 550 I=MMINA,MMAXA | |
24291 | IA=IABS(I) | |
24292 | IF(IA.NE.5) GOTO 550 | |
24293 | SQML=PYMRUN(IA,SH)**2 | |
24294 | IUA=IA+MOD(IA,2) | |
24295 | SQMQ=PYMRUN(IUA,SH)**2 | |
24296 | FACHCQ=FHCQ*(SQML*PARU(141)**2+SQMQ/PARU(141)**2)/SQMW* | |
24297 | & (SH/(SQMQ-UH)+2D0*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH+ | |
24298 | & 2D0*SQMQ/(SQMQ-UH)+2D0*(SQMHC-UH)/(SQMQ-UH)* | |
24299 | & (SQMHC-SQMQ-SH)/SH) | |
24300 | KCHHC=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) | |
24301 | DO 540 ISDE=1,2 | |
24302 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 540 | |
24303 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,1).EQ.0) GOTO 540 | |
24304 | NCHN=NCHN+1 | |
24305 | ISIG(NCHN,ISDE)=I | |
24306 | ISIG(NCHN,3-ISDE)=21 | |
24307 | ISIG(NCHN,3)=1 | |
24308 | SIGH(NCHN)=FACHCQ*WIDS(37,(5-KCHHC)/2) | |
24309 | 540 CONTINUE | |
24310 | 550 CONTINUE | |
24311 | ENDIF | |
24312 | ENDIF | |
24313 | ||
24314 | RETURN | |
24315 | END | |
24316 | ||
24317 | C********************************************************************* | |
24318 | ||
24319 | C...PYSGSU | |
24320 | C...Subprocess cross sections for SUSY processes, | |
24321 | C...including Higgs pair production. | |
24322 | C...Auxiliary to PYSIGH. | |
24323 | ||
24324 | SUBROUTINE PYSGSU(NCHN,SIGS) | |
24325 | ||
24326 | C...Double precision and integer declarations | |
24327 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
24328 | IMPLICIT INTEGER(I-N) | |
24329 | INTEGER PYK,PYCHGE,PYCOMP | |
24330 | C...Parameter statement to help give large particle numbers. | |
24331 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
24332 | &KEXCIT=4000000,KDIMEN=5000000) | |
24333 | C...Commonblocks | |
24334 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
24335 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
24336 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
24337 | COMMON/PYINT1/MINT(400),VINT(400) | |
24338 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
24339 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
24340 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
24341 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
24342 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
24343 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
24344 | COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, | |
24345 | &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, | |
24346 | &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, | |
24347 | &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR | |
24348 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, | |
24349 | &/PYINT4/,/PYMSSM/,/PYSSMT/,/PYSGCM/ | |
24350 | C...Local arrays and complex variables | |
24351 | DIMENSION WDTP(0:400),WDTE(0:400,0:5) | |
24352 | COMPLEX*16 OLPP,ORPP,OLP,ORP,OL,OR,QLL,QLR | |
24353 | COMPLEX*16 QRR,QRL,GLIJ,GRIJ,PROPW,PROPZ | |
24354 | COMPLEX*16 ZMIXC(4,4),UMIXC(2,2),VMIXC(2,2) | |
24355 | ||
24356 | CMRENNA++ | |
24357 | C...Z and W width, combinations of weak mixing angle | |
24358 | ZWID=PMAS(23,2) | |
24359 | WWID=PMAS(24,2) | |
24360 | TANW=SQRT(XW/XW1) | |
24361 | CT2W=(1D0-2D0*XW)/(2D0*XW/TANW) | |
24362 | ||
24363 | C...Convert almost equivalent SUSY processes into each other | |
24364 | C...Extract differences in flavours and couplings | |
24365 | ||
24366 | C...Sleptons and sneutrinos | |
24367 | IF(ISUB.EQ.201.OR.ISUB.EQ.204.OR.ISUB.EQ.207) THEN | |
24368 | KFID=MOD(KFPR(ISUB,1),KSUSY1) | |
24369 | ISUB=201 | |
24370 | ILR=0 | |
24371 | ELSEIF(ISUB.EQ.202.OR.ISUB.EQ.205.OR.ISUB.EQ.208) THEN | |
24372 | KFID=MOD(KFPR(ISUB,1),KSUSY1) | |
24373 | ISUB=201 | |
24374 | ILR=1 | |
24375 | ELSEIF(ISUB.EQ.203.OR.ISUB.EQ.206.OR.ISUB.EQ.209) THEN | |
24376 | KFID=MOD(KFPR(ISUB,1),KSUSY1) | |
24377 | ISUB=203 | |
24378 | ELSEIF(ISUB.GE.210.AND.ISUB.LE.212) THEN | |
24379 | IF(ISUB.EQ.210) THEN | |
24380 | RKF=2.0D0 | |
24381 | ELSEIF(ISUB.EQ.211) THEN | |
24382 | RKF=SFMIX(15,1)**2 | |
24383 | ELSEIF(ISUB.EQ.212) THEN | |
24384 | RKF=SFMIX(15,2)**2 | |
24385 | ENDIF | |
24386 | ISUB=210 | |
24387 | ELSEIF(ISUB.EQ.213.OR.ISUB.EQ.214) THEN | |
24388 | IF(ISUB.EQ.213) THEN | |
24389 | KFID=MOD(KFPR(ISUB,1),KSUSY1) | |
24390 | RKF=2.0D0 | |
24391 | ELSEIF(ISUB.EQ.214) THEN | |
24392 | KFID=16 | |
24393 | RKF=1.0D0 | |
24394 | ENDIF | |
24395 | ISUB=213 | |
24396 | ||
24397 | C...Neutralinos | |
24398 | ELSEIF(ISUB.GE.216.AND.ISUB.LE.225) THEN | |
24399 | IF(ISUB.EQ.216) THEN | |
24400 | IZID1=1 | |
24401 | IZID2=1 | |
24402 | ELSEIF(ISUB.EQ.217) THEN | |
24403 | IZID1=2 | |
24404 | IZID2=2 | |
24405 | ELSEIF(ISUB.EQ.218) THEN | |
24406 | IZID1=3 | |
24407 | IZID2=3 | |
24408 | ELSEIF(ISUB.EQ.219) THEN | |
24409 | IZID1=4 | |
24410 | IZID2=4 | |
24411 | ELSEIF(ISUB.EQ.220) THEN | |
24412 | IZID1=1 | |
24413 | IZID2=2 | |
24414 | ELSEIF(ISUB.EQ.221) THEN | |
24415 | IZID1=1 | |
24416 | IZID2=3 | |
24417 | ELSEIF(ISUB.EQ.222) THEN | |
24418 | IZID1=1 | |
24419 | IZID2=4 | |
24420 | ELSEIF(ISUB.EQ.223) THEN | |
24421 | IZID1=2 | |
24422 | IZID2=3 | |
24423 | ELSEIF(ISUB.EQ.224) THEN | |
24424 | IZID1=2 | |
24425 | IZID2=4 | |
24426 | ELSEIF(ISUB.EQ.225) THEN | |
24427 | IZID1=3 | |
24428 | IZID2=4 | |
24429 | ENDIF | |
24430 | ISUB=216 | |
24431 | ||
24432 | C...Charginos | |
24433 | ELSEIF(ISUB.GE.226.AND.ISUB.LE.228) THEN | |
24434 | IF(ISUB.EQ.226) THEN | |
24435 | IZID1=1 | |
24436 | IZID2=1 | |
24437 | ELSEIF(ISUB.EQ.227) THEN | |
24438 | IZID1=2 | |
24439 | IZID2=2 | |
24440 | ELSEIF(ISUB.EQ.228) THEN | |
24441 | IZID1=1 | |
24442 | IZID2=2 | |
24443 | ENDIF | |
24444 | ISUB=226 | |
24445 | ||
24446 | C...Neutralino + chargino | |
24447 | ELSEIF(ISUB.GE.229.AND.ISUB.LE.236) THEN | |
24448 | IF(ISUB.EQ.229) THEN | |
24449 | IZID1=1 | |
24450 | IZID2=1 | |
24451 | ELSEIF(ISUB.EQ.230) THEN | |
24452 | IZID1=1 | |
24453 | IZID2=2 | |
24454 | ELSEIF(ISUB.EQ.231) THEN | |
24455 | IZID1=1 | |
24456 | IZID2=3 | |
24457 | ELSEIF(ISUB.EQ.232) THEN | |
24458 | IZID1=1 | |
24459 | IZID2=4 | |
24460 | ELSEIF(ISUB.EQ.233) THEN | |
24461 | IZID1=2 | |
24462 | IZID2=1 | |
24463 | ELSEIF(ISUB.EQ.234) THEN | |
24464 | IZID1=2 | |
24465 | IZID2=2 | |
24466 | ELSEIF(ISUB.EQ.235) THEN | |
24467 | IZID1=2 | |
24468 | IZID2=3 | |
24469 | ELSEIF(ISUB.EQ.236) THEN | |
24470 | IZID1=2 | |
24471 | IZID2=4 | |
24472 | ENDIF | |
24473 | ISUB=229 | |
24474 | ||
24475 | C...Gluino + neutralino | |
24476 | ELSEIF(ISUB.GE.237.AND.ISUB.LE.240) THEN | |
24477 | IF(ISUB.EQ.237) THEN | |
24478 | IZID=1 | |
24479 | ELSEIF(ISUB.EQ.238) THEN | |
24480 | IZID=2 | |
24481 | ELSEIF(ISUB.EQ.239) THEN | |
24482 | IZID=3 | |
24483 | ELSEIF(ISUB.EQ.240) THEN | |
24484 | IZID=4 | |
24485 | ENDIF | |
24486 | ISUB=237 | |
24487 | ||
24488 | C...Gluino + chargino | |
24489 | ELSEIF(ISUB.GE.241.AND.ISUB.LE.242) THEN | |
24490 | IF(ISUB.EQ.241) THEN | |
24491 | IZID=1 | |
24492 | ELSEIF(ISUB.EQ.242) THEN | |
24493 | IZID=2 | |
24494 | ENDIF | |
24495 | ISUB=241 | |
24496 | ||
24497 | C...Squark + neutralino | |
24498 | ELSEIF(ISUB.GE.246.AND.ISUB.LE.253) THEN | |
24499 | ILR=0 | |
24500 | IF(MOD(ISUB,2).NE.0) ILR=1 | |
24501 | IF(ISUB.LE.247) THEN | |
24502 | IZID=1 | |
24503 | ELSEIF(ISUB.LE.249) THEN | |
24504 | IZID=2 | |
24505 | ELSEIF(ISUB.LE.251) THEN | |
24506 | IZID=3 | |
24507 | ELSEIF(ISUB.LE.253) THEN | |
24508 | IZID=4 | |
24509 | ENDIF | |
24510 | ISUB=246 | |
24511 | RKF=5D0 | |
24512 | ||
24513 | C...Squark + chargino | |
24514 | ELSEIF(ISUB.GE.254.AND.ISUB.LE.257) THEN | |
24515 | IF(ISUB.LE.255) THEN | |
24516 | IZID=1 | |
24517 | ELSEIF(ISUB.LE.257) THEN | |
24518 | IZID=2 | |
24519 | ENDIF | |
24520 | IF(MOD(ISUB,2).EQ.0) THEN | |
24521 | ILR=0 | |
24522 | ELSE | |
24523 | ILR=1 | |
24524 | ENDIF | |
24525 | ISUB=254 | |
24526 | RKF=5D0 | |
24527 | ||
24528 | C...Squark + gluino | |
24529 | ELSEIF(ISUB.EQ.258.OR.ISUB.EQ.259) THEN | |
24530 | ISUB=258 | |
24531 | RKF=4D0 | |
24532 | ||
24533 | C...Stops | |
24534 | ELSEIF(ISUB.EQ.261.OR.ISUB.EQ.262) THEN | |
24535 | ILR=0 | |
24536 | IF(ISUB.EQ.262) ILR=1 | |
24537 | ISUB=261 | |
24538 | ELSEIF(ISUB.EQ.265) THEN | |
24539 | ISUB=264 | |
24540 | ||
24541 | C...Squarks | |
24542 | ELSEIF(ISUB.GE.271.AND.ISUB.LE.280) THEN | |
24543 | ILR=0 | |
24544 | IF(ISUB.LE.273) THEN | |
24545 | IF(ISUB.EQ.273) ILR=1 | |
24546 | ISUB=271 | |
24547 | RKF=16D0 | |
24548 | ELSEIF(ISUB.LE.276) THEN | |
24549 | IF(ISUB.EQ.276) ILR=1 | |
24550 | ISUB=274 | |
24551 | RKF=16D0 | |
24552 | ELSEIF(ISUB.LE.278) THEN | |
24553 | IF(ISUB.EQ.278) ILR=1 | |
24554 | ISUB=277 | |
24555 | RKF=4D0 | |
24556 | ELSE | |
24557 | IF(ISUB.EQ.280) ILR=1 | |
24558 | ISUB=279 | |
24559 | RKF=4D0 | |
24560 | ENDIF | |
24561 | C...Sbottoms | |
24562 | ELSEIF(ISUB.GE.281.AND.ISUB.LE.296) THEN | |
24563 | ILR=0 | |
24564 | IF(ISUB.LE.283) THEN | |
24565 | IF(ISUB.EQ.283) ILR=1 | |
24566 | ISUB=271 | |
24567 | RKF=4D0 | |
24568 | ELSEIF(ISUB.LE.286) THEN | |
24569 | IF(ISUB.EQ.286) ILR=1 | |
24570 | ISUB=274 | |
24571 | RKF=4D0 | |
24572 | ELSEIF(ISUB.LE.288) THEN | |
24573 | IF(ISUB.EQ.288) ILR=1 | |
24574 | ISUB=277 | |
24575 | RKF=1D0 | |
24576 | ELSEIF(ISUB.LE.290) THEN | |
24577 | IF(ISUB.EQ.290) ILR=1 | |
24578 | ISUB=279 | |
24579 | RKF=1D0 | |
24580 | ELSEIF(ISUB.LE.293) THEN | |
24581 | IF(ISUB.EQ.293) ILR=1 | |
24582 | ISUB=271 | |
24583 | RKF=1D0 | |
24584 | ELSEIF(ISUB.EQ.296) THEN | |
24585 | ILR=1 | |
24586 | ISUB=274 | |
24587 | RKF=1D0 | |
24588 | C...Squark + gluino | |
24589 | ELSEIF(ISUB.EQ.294.OR.ISUB.EQ.295) THEN | |
24590 | ISUB=258 | |
24591 | RKF=1D0 | |
24592 | ENDIF | |
24593 | C...H+/- + H0 | |
24594 | ELSEIF(ISUB.EQ.297.OR.ISUB.EQ.298) THEN | |
24595 | IF(ISUB.EQ.297) THEN | |
24596 | RKF=.5D0*PARU(195)**2 | |
24597 | ELSEIF(ISUB.EQ.298) THEN | |
24598 | RKF=.5D0*(1D0-PARU(195)**2) | |
24599 | ENDIF | |
24600 | ISUB=210 | |
24601 | C...A0 + H0 | |
24602 | ELSEIF(ISUB.EQ.299.OR.ISUB.EQ.300) THEN | |
24603 | IF(ISUB.EQ.299) THEN | |
24604 | RKF=PARU(186)**2 | |
24605 | KFID=25 | |
24606 | ELSEIF(ISUB.EQ.300) THEN | |
24607 | RKF=PARU(187)**2 | |
24608 | KFID=35 | |
24609 | ENDIF | |
24610 | ISUB=213 | |
24611 | C...H+ + H- | |
24612 | ELSEIF(ISUB.EQ.301) THEN | |
24613 | KFID=37 | |
24614 | RKF=1D0 | |
24615 | ISUB=201 | |
24616 | ENDIF | |
24617 | ||
24618 | C...Supersymmetric processes - all of type 2 -> 2 : | |
24619 | C...correct final-state Breit-Wigners from fixed to running width. | |
24620 | IF(MSTP(42).GT.0) THEN | |
24621 | DO 100 I=1,2 | |
24622 | KFLW=KFPR(ISUBSV,I) | |
24623 | KCW=PYCOMP(KFLW) | |
24624 | IF(PMAS(KCW,2).LT.PARP(41)) GOTO 100 | |
24625 | IF(I.EQ.1) SQMI=SQM3 | |
24626 | IF(I.EQ.2) SQMI=SQM4 | |
24627 | SQMS=PMAS(KCW,1)**2 | |
24628 | GMMS=PMAS(KCW,1)*PMAS(KCW,2) | |
24629 | HBWS=GMMS/((SQMI-SQMS)**2+GMMS**2) | |
24630 | CALL PYWIDT(KFLW,SQMI,WDTP,WDTE) | |
24631 | GMMI=SQRT(SQMI)*WDTP(0) | |
24632 | HBWI=GMMI/((SQMI-SQMS)**2+GMMI**2) | |
24633 | COMFAC=COMFAC*(HBWI/HBWS) | |
24634 | 100 CONTINUE | |
24635 | ENDIF | |
24636 | ||
24637 | C...Differential cross section expressions. | |
24638 | ||
24639 | IF(ISUB.LE.210) THEN | |
24640 | IF(ISUB.EQ.201) THEN | |
24641 | C...f + fbar -> e_L + e_Lbar | |
24642 | COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
24643 | DO 130 I=MMIN1,MMAX1 | |
24644 | IA=IABS(I) | |
24645 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 130 | |
24646 | EI=KCHG(IA,1)/3D0 | |
24647 | TT3I=SIGN(1D0,EI+1D-6)/2D0 | |
24648 | EJ=-1D0 | |
24649 | TT3J=-1D0/2D0 | |
24650 | FCOL=1D0 | |
24651 | C...Color factor for e+ e- | |
24652 | IF(IA.GE.11) FCOL=3D0 | |
24653 | IF(ISUBSV.EQ.301) THEN | |
24654 | A1=1D0 | |
24655 | A2=0D0 | |
24656 | ELSEIF(ILR.EQ.1) THEN | |
24657 | A1=SFMIX(KFID,3)**2 | |
24658 | A2=SFMIX(KFID,4)**2 | |
24659 | ELSEIF(ILR.EQ.0) THEN | |
24660 | A1=SFMIX(KFID,1)**2 | |
24661 | A2=SFMIX(KFID,2)**2 | |
24662 | ENDIF | |
24663 | XLQ=(TT3J-EJ*XW)*A1 | |
24664 | XRQ=(-EJ*XW)*A2 | |
24665 | XLF=(TT3I-EI*XW) | |
24666 | XRF=(-EI*XW) | |
24667 | TAA=(EI*EJ)**2*(POLL+POLR) | |
24668 | TZZ=(XLF**2*POLL+XRF**2*POLR)*(XLQ+XRQ)**2/XW**2/XW1**2 | |
24669 | TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*ZWID/SH**2) | |
24670 | TAZ=2D0*EI*EJ*(XLQ+XRQ)*(XLF*POLL+XRF*POLR)/XW/XW1 | |
24671 | TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH) | |
24672 | TNN=0.0D0 | |
24673 | TAN=0.0D0 | |
24674 | TZN=0.0D0 | |
24675 | IF(IA.GE.11.AND.IA.LE.18.AND.KFID.EQ.IA) THEN | |
24676 | FAC2=SQRT(2D0) | |
24677 | TNN1=0D0 | |
24678 | TNN2=0D0 | |
24679 | TNN3=0D0 | |
24680 | DO 120 II=1,4 | |
24681 | DK=1D0/(TH-SMZ(II)**2) | |
24682 | FLEK=-FAC2*(TT3I*ZMIX(II,2)-TANW*(TT3I-EI)* | |
24683 | & ZMIX(II,1)) | |
24684 | FREK=FAC2*TANW*EI*ZMIX(II,1) | |
24685 | TNN1=TNN1+FLEK**2*DK | |
24686 | TNN2=TNN2+FREK**2*DK | |
24687 | DO 110 JJ=1,4 | |
24688 | DL=1D0/(TH-SMZ(JJ)**2) | |
24689 | FLEL=-FAC2*(TT3J*ZMIX(JJ,2)-TANW*(TT3J-EJ)* | |
24690 | & ZMIX(JJ,1)) | |
24691 | FREL=FAC2*TANW*EJ*ZMIX(JJ,1) | |
24692 | TNN3=TNN3+FLEK*FREK*FLEL*FREL*DK*DL*SMZ(II)*SMZ(JJ) | |
24693 | 110 CONTINUE | |
24694 | 120 CONTINUE | |
24695 | TNN=(UH*TH-SQM3*SQM4)*(A1**2*TNN1**2*POLL+ | |
24696 | & A2**2*TNN2**2*POLR) | |
24697 | TNN=(TNN+SH*A1*A2*TNN3*((1D0-PARJ(131))*(1D0-PARJ(132))+ | |
24698 | & (1D0+PARJ(131))*(1D0+PARJ(132))))/4D0/XW**2 | |
24699 | TZN=(UH*TH-SQM3*SQM4)*(XLQ+XRQ)* | |
24700 | & (TNN1*XLF*A1*POLL+TNN2*XRF*A2*POLR) | |
24701 | TZN=TZN/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)* | |
24702 | & (1D0-SQMZ/SH)/SH | |
24703 | TZN=TZN/XW**2/XW1 | |
24704 | TAN=EI*EJ*(UH*TH-SQM3*SQM4)/SH*(A1*TNN1*POLL+ | |
24705 | & A2*TNN2*POLR)/XW | |
24706 | ENDIF | |
24707 | FACQQ1=COMFAC*AEM**2*(TAA+TZZ+TAZ)*FCOL/3D0 | |
24708 | FACQQ1=FACQQ1*( UH*TH-SQM3*SQM4 )/SH**2 | |
24709 | FACQQ2=COMFAC*AEM**2*(TNN+TZN+TAN)*FCOL/3D0 | |
24710 | NCHN=NCHN+1 | |
24711 | ISIG(NCHN,1)=I | |
24712 | ISIG(NCHN,2)=-I | |
24713 | ISIG(NCHN,3)=1 | |
24714 | SIGH(NCHN)=FACQQ1+FACQQ2 | |
24715 | 130 CONTINUE | |
24716 | ||
24717 | ELSEIF(ISUB.EQ.203) THEN | |
24718 | C...f + fbar -> e_L + e_Rbar | |
24719 | DO 160 I=MMIN1,MMAX1 | |
24720 | IA=IABS(I) | |
24721 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 160 | |
24722 | EI=KCHG(IABS(I),1)/3D0 | |
24723 | TT3I=SIGN(1D0,EI)/2D0 | |
24724 | EJ=-1 | |
24725 | TT3J=-1D0/2D0 | |
24726 | FCOL=1D0 | |
24727 | C...Color factor for e+ e- | |
24728 | IF(IA.GE.11) FCOL=3D0 | |
24729 | A1=SFMIX(KFID,1)**2 | |
24730 | A2=SFMIX(KFID,2)**2 | |
24731 | XLQ=(TT3J-EJ*XW) | |
24732 | XRQ=(-EJ*XW) | |
24733 | XLF=(TT3I-EI*XW) | |
24734 | XRF=(-EI*XW) | |
24735 | TZZ=(XLF**2*POLL+XRF**2*POLR)*(XLQ-XRQ)**2 | |
24736 | & /XW**2/XW1**2*A1*A2 | |
24737 | TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) | |
24738 | TNN=0.0D0 | |
24739 | TZN=0.0D0 | |
24740 | TNNA=0D0 | |
24741 | TNNB=0D0 | |
24742 | IF(IA.GE.11.AND.IA.LE.18.AND.KFID.EQ.IA) THEN | |
24743 | FAC2=SQRT(2D0) | |
24744 | TNN1=0D0 | |
24745 | TNN2=0D0 | |
24746 | TNN3=0D0 | |
24747 | DO 150 II=1,4 | |
24748 | DK=1D0/(TH-SMZ(II)**2) | |
24749 | FLEK=-FAC2*(TT3I*ZMIX(II,2)-TANW*(TT3I-EI)* | |
24750 | & ZMIX(II,1)) | |
24751 | FREK=FAC2*TANW*EI*ZMIX(II,1) | |
24752 | TNN1=TNN1+FLEK**2*DK | |
24753 | TNN2=TNN2+FREK**2*DK | |
24754 | DO 140 JJ=1,4 | |
24755 | DL=1D0/(TH-SMZ(JJ)**2) | |
24756 | FLEL=-FAC2*(TT3J*ZMIX(JJ,2)-TANW*(TT3J-EJ)* | |
24757 | & ZMIX(JJ,1)) | |
24758 | FREL=FAC2*TANW*EJ*ZMIX(JJ,1) | |
24759 | TNN3=TNN3+FLEK*FREK*FLEL*FREL*DK*DL*SMZ(II)*SMZ(JJ) | |
24760 | 140 CONTINUE | |
24761 | 150 CONTINUE | |
24762 | TNN=(UH*TH-SQM3*SQM4)*A1*A2*(TNN2**2*POLR+TNN1**2*POLL) | |
24763 | TNNA=(TNN+SH*(A1**2*POLLL+A2**2*POLRR)*TNN3)/4D0 | |
24764 | TNNB=(TNN+SH*(A1**2*POLRR+A2**2*POLLL)*TNN3)/4D0 | |
24765 | TZN=(UH*TH-SQM3*SQM4)*A1*A2 | |
24766 | TZN=TZN*(XLQ-XRQ)*(XLF*TNN1*POLL-XRF*TNN2*POLR)/XW1 | |
24767 | TZN=TZN/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)* | |
24768 | & (1D0-SQMZ/SH)/SH | |
24769 | ENDIF | |
24770 | FACQQ0=COMFAC*AEM**2*TZZ*FCOL/3D0*(UH*TH-SQM3*SQM4)/SH2 | |
24771 | FACQQ2=COMFAC*AEM**2/XW**2*(TNNA+TZN)*FCOL/3D0 | |
24772 | FACQQ1=COMFAC*AEM**2/XW**2*(TNNB+TZN)*FCOL/3D0 | |
24773 | C%%%%%%%%%%% | |
24774 | NCHN=NCHN+1 | |
24775 | ISIG(NCHN,1)=I | |
24776 | ISIG(NCHN,2)=-I | |
24777 | ISIG(NCHN,3)=1 | |
24778 | SIGH(NCHN)=(FACQQ0+FACQQ1)*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* | |
24779 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),3) | |
24780 | NCHN=NCHN+1 | |
24781 | ISIG(NCHN,1)=I | |
24782 | ISIG(NCHN,2)=-I | |
24783 | ISIG(NCHN,3)=2 | |
24784 | SIGH(NCHN)=(FACQQ0+FACQQ2)*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)* | |
24785 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) | |
24786 | 160 CONTINUE | |
24787 | ||
24788 | ELSEIF(ISUB.EQ.210) THEN | |
24789 | C...q + qbar' -> W*- > ~l_L + ~nu_L | |
24790 | FAC0=RKF*COMFAC*AEM**2/XW**2/12D0 | |
24791 | FAC1=(TH*UH-SQM3*SQM4)/((SH-SQMW)**2+WWID**2*SQMW) | |
24792 | DO 180 I=MMIN1,MMAX1 | |
24793 | IA=IABS(I) | |
24794 | IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 180 | |
24795 | DO 170 J=MMIN2,MMAX2 | |
24796 | JA=IABS(J) | |
24797 | IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 170 | |
24798 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 170 | |
24799 | FCKM=3D0 | |
24800 | IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
24801 | KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J) | |
24802 | KCHW=2 | |
24803 | IF(KCHSUM.LT.0) KCHW=3 | |
24804 | NCHN=NCHN+1 | |
24805 | ISIG(NCHN,1)=I | |
24806 | ISIG(NCHN,2)=J | |
24807 | ISIG(NCHN,3)=1 | |
24808 | IF(ISUBSV.EQ.297.OR.ISUBSV.EQ.298) THEN | |
24809 | FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),5-KCHW)* | |
24810 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) | |
24811 | ELSE | |
24812 | FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),5-KCHW)* | |
24813 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW) | |
24814 | ENDIF | |
24815 | SIGH(NCHN)=FAC0*FAC1*FCKM*FACR | |
24816 | 170 CONTINUE | |
24817 | 180 CONTINUE | |
24818 | ENDIF | |
24819 | ||
24820 | ELSEIF(ISUB.LE.220) THEN | |
24821 | IF(ISUB.EQ.213) THEN | |
24822 | C...f + fbar -> ~nu_L + ~nu_Lbar | |
24823 | IF(ISUBSV.EQ.299.OR.ISUBSV.EQ.300) THEN | |
24824 | FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* | |
24825 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) | |
24826 | ELSE | |
24827 | FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
24828 | ENDIF | |
24829 | COMFAC=COMFAC*FACR | |
24830 | PROPZ2=(SH-SQMZ)**2+ZWID**2*SQMZ | |
24831 | XLL=0.5D0 | |
24832 | XLR=0.0D0 | |
24833 | DO 190 I=MMIN1,MMAX1 | |
24834 | IA=IABS(I) | |
24835 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 190 | |
24836 | EI=KCHG(IA,1)/3D0 | |
24837 | FCOL=1D0 | |
24838 | C...Color factor for e+ e- | |
24839 | IF(IA.GE.11) FCOL=3D0 | |
24840 | XLQ=(SIGN(1D0,EI)-2D0*EI*XW)/2D0 | |
24841 | XRQ=-EI*XW | |
24842 | TZC=0.0D0 | |
24843 | TCC=0.0D0 | |
24844 | IF(IA.GE.11.AND.KFID.EQ.IA+1) THEN | |
24845 | TZC=VMIX(1,1)**2/(TH-SMW(1)**2)+VMIX(2,1)**2/ | |
24846 | & (TH-SMW(2)**2) | |
24847 | TCC=TZC**2 | |
24848 | TZC=TZC/XW1*(SH-SQMZ)/PROPZ2*XLQ*XLL | |
24849 | ENDIF | |
24850 | FACQQ1=(XLQ**2+XRQ**2)*(XLL+XLR)**2/XW1**2/PROPZ2 | |
24851 | FACQQ2=TZC+TCC/4D0 | |
24852 | NCHN=NCHN+1 | |
24853 | ISIG(NCHN,1)=I | |
24854 | ISIG(NCHN,2)=-I | |
24855 | ISIG(NCHN,3)=1 | |
24856 | SIGH(NCHN)=(FACQQ1+FACQQ2)*RKF*(UH*TH-SQM3*SQM4)*COMFAC | |
24857 | & *AEM**2*FCOL/3D0/XW**2 | |
24858 | 190 CONTINUE | |
24859 | ||
24860 | ELSEIF(ISUB.EQ.216) THEN | |
24861 | C...q + qbar -> ~chi0_1 + ~chi0_1 | |
24862 | IF(IZID1.EQ.IZID2) THEN | |
24863 | COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
24864 | ELSE | |
24865 | COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* | |
24866 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) | |
24867 | ENDIF | |
24868 | FACXX=COMFAC*AEM**2/3D0/XW**2 | |
24869 | IF(IZID1.EQ.IZID2) FACXX=FACXX/2D0 | |
24870 | ZM12=SQM3 | |
24871 | ZM22=SQM4 | |
24872 | WU2 = (UH-ZM12)*(UH-ZM22) | |
24873 | WT2 = (TH-ZM12)*(TH-ZM22) | |
24874 | WS2 = SMZ(IZID1)*SMZ(IZID2)*SH | |
24875 | PROPZ2 = (SH-SQMZ)**2 + SQMZ*ZWID**2 | |
24876 | PROPZ=DCMPLX(SH-SQMZ,-ZWID*PMAS(23,1))/DCMPLX(PROPZ2) | |
24877 | DO 200 I=1,4 | |
24878 | ZMIXC(IZID1,I)=DCMPLX(ZMIX(IZID1,I),ZMIXI(IZID1,I)) | |
24879 | IF(IZID2.NE.IZID1) THEN | |
24880 | ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) | |
24881 | ENDIF | |
24882 | 200 CONTINUE | |
24883 | OLPP=(ZMIXC(IZID1,3)*DCONJG(ZMIXC(IZID2,3))- | |
24884 | & ZMIXC(IZID1,4)*DCONJG(ZMIXC(IZID2,4)))/2D0 | |
24885 | ORPP=DCONJG(OLPP) | |
24886 | DO 210 I=MMINA,MMAXA | |
24887 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 210 | |
24888 | EI=KCHG(IABS(I),1)/3D0 | |
24889 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
24890 | XML2=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2 | |
24891 | XMR2=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2 | |
24892 | GLIJ=(T3I*ZMIXC(IZID1,2)-TANW*(T3I-EI)*ZMIXC(IZID1,1))* | |
24893 | & DCONJG(T3I*ZMIXC(IZID2,2)-TANW*(T3I-EI)*ZMIXC(IZID2,1)) | |
24894 | GRIJ=ZMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1))*(EI*TANW)**2 | |
24895 | QLL=DCMPLX((T3I-EI*XW)/XW1)*OLPP*PROPZ-GLIJ/DCMPLX(UH-XML2) | |
24896 | QLR=-DCMPLX((T3I-EI*XW)/XW1)*ORPP*PROPZ+DCONJG(GLIJ) | |
24897 | & /DCMPLX(TH-XML2) | |
24898 | QRL=-DCMPLX((EI*XW)/XW1)*OLPP*PROPZ+GRIJ/DCMPLX(TH-XMR2) | |
24899 | QRR=DCMPLX((EI*XW)/XW1)*ORPP*PROPZ | |
24900 | & -DCONJG(GRIJ)/DCMPLX(UH-XMR2) | |
24901 | FCOL=1D0 | |
24902 | IF(IABS(I).GE.11) FCOL=3D0 | |
24903 | FACGG1=(ABS(QLL)**2*POLL+ABS(QRR)**2*POLR)*WU2+ | |
24904 | & (ABS(QRL)**2*POLR+ABS(QLR)**2*POLL)*WT2+ | |
24905 | & 2D0*DBLE(QLR*DCONJG(QLL)*POLL+ | |
24906 | & QRL*DCONJG(QRR)*POLR)*WS2 | |
24907 | NCHN=NCHN+1 | |
24908 | ISIG(NCHN,1)=I | |
24909 | ISIG(NCHN,2)=-I | |
24910 | ISIG(NCHN,3)=1 | |
24911 | SIGH(NCHN)=FACXX*FACGG1*FCOL | |
24912 | 210 CONTINUE | |
24913 | ENDIF | |
24914 | ||
24915 | ELSEIF(ISUB.LE.230) THEN | |
24916 | IF(ISUB.EQ.226) THEN | |
24917 | C...f + fbar -> ~chi+_1 + ~chi-_1 | |
24918 | FACXX=COMFAC*AEM**2/3D0 | |
24919 | ZM12=SQM3 | |
24920 | ZM22=SQM4 | |
24921 | WU2 = (UH-ZM12)*(UH-ZM22) | |
24922 | WT2 = (TH-ZM12)*(TH-ZM22) | |
24923 | WS2 = SMW(IZID1)*SMW(IZID2)*SH | |
24924 | PROPZ2 = (SH-SQMZ)**2 + SQMZ*ZWID**2 | |
24925 | PROPZ=DCMPLX(SH-SQMZ,-ZWID*PMAS(23,1))/DCMPLX(PROPZ2) | |
24926 | DIFF=0D0 | |
24927 | IF(IZID1.EQ.IZID2) DIFF=1D0 | |
24928 | DO 220 I=1,2 | |
24929 | VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) | |
24930 | UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) | |
24931 | IF(IZID2.NE.IZID1) THEN | |
24932 | VMIXC(IZID2,I)=DCMPLX(VMIX(IZID2,I),VMIXI(IZID2,I)) | |
24933 | UMIXC(IZID2,I)=DCMPLX(UMIX(IZID2,I),UMIXI(IZID2,I)) | |
24934 | ENDIF | |
24935 | 220 CONTINUE | |
24936 | OLP=-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))- | |
24937 | & VMIXC(IZID2,2)*DCONJG(VMIXC(IZID1,2))/2D0+DCMPLX(XW*DIFF) | |
24938 | ORP=-UMIXC(IZID1,1)*DCONJG(UMIXC(IZID2,1))- | |
24939 | & UMIXC(IZID1,2)*DCONJG(UMIXC(IZID2,2))/2D0+DCMPLX(XW*DIFF) | |
24940 | DO 230 I=MMINA,MMAXA | |
24941 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 230 | |
24942 | EI=KCHG(IABS(I),1)/3D0 | |
24943 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
24944 | QRL=DCMPLX(-EI/SH*DIFF)-DCMPLX(EI/XW1)*PROPZ*ORP | |
24945 | QLL=DCMPLX(-EI/SH*DIFF)+DCMPLX((T3I-XW*EI)/XW/XW1)*PROPZ*ORP | |
24946 | QRR=DCMPLX(-EI/SH*DIFF)-DCMPLX(EI/XW1)*PROPZ*OLP | |
24947 | IF(MOD(I,2).EQ.0) THEN | |
24948 | XML2=PMAS(PYCOMP(KSUSY1+IABS(I)-1),1)**2 | |
24949 | QLR=DCMPLX(-EI/SH*DIFF)+DCMPLX((T3I-XW*EI)/XW/XW1)* | |
24950 | & PROPZ*OLP-UMIXC(IZID2,1)*DCONJG(UMIXC(IZID1,1))* | |
24951 | & DCMPLX(T3I/XW/(TH-XML2)) | |
24952 | ELSE | |
24953 | XML2=PMAS(PYCOMP(KSUSY1+IABS(I)+1),1)**2 | |
24954 | QLR=DCMPLX(-EI/SH*DIFF)+DCMPLX((T3I-XW*EI)/XW/XW1)* | |
24955 | & PROPZ*OLP-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))* | |
24956 | & DCMPLX(T3I/XW/(TH-XML2)) | |
24957 | ENDIF | |
24958 | FCOL=1D0 | |
24959 | IF(IABS(I).GE.11) FCOL=3D0 | |
24960 | FACSUM=((ABS(QLL)**2*POLL+ABS(QRR)**2*POLR)*WU2+ | |
24961 | & (ABS(QRL)**2*POLR+ABS(QLR)**2*POLL)*WT2+ | |
24962 | & 2D0*DBLE(QLR*DCONJG(QLL)*POLL+ | |
24963 | & QRL*DCONJG(QRR)*POLR)*WS2)*FACXX*FCOL | |
24964 | NCHN=NCHN+1 | |
24965 | ISIG(NCHN,1)=I | |
24966 | ISIG(NCHN,2)=-I | |
24967 | ISIG(NCHN,3)=1 | |
24968 | IF(IZID1.EQ.IZID2) THEN | |
24969 | SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
24970 | ELSE | |
24971 | SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)* | |
24972 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) | |
24973 | NCHN=NCHN+1 | |
24974 | ISIG(NCHN,1)=I | |
24975 | ISIG(NCHN,2)=-I | |
24976 | ISIG(NCHN,3)=2 | |
24977 | SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* | |
24978 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),3) | |
24979 | ENDIF | |
24980 | 230 CONTINUE | |
24981 | ||
24982 | ELSEIF(ISUB.EQ.229) THEN | |
24983 | C...q + qbar' -> ~chi0_1 + ~chi+-_1 | |
24984 | FACXX=COMFAC*AEM**2/6D0/XW**2 | |
24985 | ZM12=SQM3 | |
24986 | ZM22=SQM4 | |
24987 | WU2 = (UH-ZM12)*(UH-ZM22) | |
24988 | WT2 = (TH-ZM12)*(TH-ZM22) | |
24989 | WS2 = SMW(IZID1)*SMZ(IZID2)*SH | |
24990 | RT2I = 1D0/SQRT(2D0) | |
24991 | PROPW = DCMPLX(SH-SQMW,-WWID*PMAS(24,1))/ | |
24992 | & DCMPLX((SH-SQMW)**2+WWID**2*SQMW,0D0) | |
24993 | DO 240 I=1,2 | |
24994 | VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) | |
24995 | UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) | |
24996 | 240 CONTINUE | |
24997 | DO 250 I=1,4 | |
24998 | ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) | |
24999 | 250 CONTINUE | |
25000 | OL=(DCONJG(ZMIXC(IZID2,2))*VMIXC(IZID1,1)- | |
25001 | & DCONJG(ZMIXC(IZID2,4))*VMIXC(IZID1,2)*RT2I)*PROPW | |
25002 | OR=(ZMIXC(IZID2,2)*DCONJG(UMIXC(IZID1,1))+ | |
25003 | & ZMIXC(IZID2,3)*DCONJG(UMIXC(IZID1,2))*RT2I)*PROPW | |
25004 | ||
25005 | DO 270 I=MMIN1,MMAX1 | |
25006 | IA=IABS(I) | |
25007 | IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 270 | |
25008 | EI=KCHG(IA,1)/3D0 | |
25009 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
25010 | DO 260 J=MMIN2,MMAX2 | |
25011 | JA=IABS(J) | |
25012 | IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 260 | |
25013 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 260 | |
25014 | EJ=KCHG(JA,1)/3D0 | |
25015 | T3J=SIGN(1D0,EJ+1D-6)/2D0 | |
25016 | FCKM=3D0 | |
25017 | IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
25018 | KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J) | |
25019 | KCHW=2 | |
25020 | IF(KCHSUM.LT.0) KCHW=3 | |
25021 | IF(MOD(IA,2).EQ.0) THEN | |
25022 | ZMI2 = PMAS(PYCOMP(KSUSY1+IA),1)**2 | |
25023 | ZMJ2 = PMAS(PYCOMP(KSUSY1+JA),1)**2 | |
25024 | QLL=OL+VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EI-T3I)* | |
25025 | & TANW+ZMIXC(IZID2,2)*T3I)/DCMPLX(UH-ZMI2) | |
25026 | QLR=OR-DCONJG(UMIXC(IZID1,1))*( | |
25027 | & ZMIXC(IZID2,1)*(EJ-T3J)*TANW+ZMIXC(IZID2,2)*T3J) | |
25028 | & /DCMPLX(TH-ZMJ2) | |
25029 | ELSE | |
25030 | ZMI2 = PMAS(PYCOMP(KSUSY1+JA),1)**2 | |
25031 | ZMJ2 = PMAS(PYCOMP(KSUSY1+IA),1)**2 | |
25032 | QLL=OL+VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EJ-T3J)* | |
25033 | & TANW+ZMIXC(IZID2,2)*T3J)/DCMPLX(UH-ZMJ2) | |
25034 | QLR=OR-DCONJG(UMIXC(IZID1,1))*( | |
25035 | & ZMIXC(IZID2,1)*(EI-T3I)*TANW+ZMIXC(IZID2,2)*T3I) | |
25036 | & /DCMPLX(TH-ZMI2) | |
25037 | ENDIF | |
25038 | ZINTR=DBLE(QLR*DCONJG(QLL)) | |
25039 | FACGG1=FACXX*(ABS(QLL)**2*WU2+ABS(QLR)**2*WT2+ | |
25040 | & 2D0*ZINTR*WS2) | |
25041 | NCHN=NCHN+1 | |
25042 | ISIG(NCHN,1)=I | |
25043 | ISIG(NCHN,2)=J | |
25044 | ISIG(NCHN,3)=1 | |
25045 | SIGH(NCHN)=FACGG1*FCKM*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* | |
25046 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW) | |
25047 | 260 CONTINUE | |
25048 | 270 CONTINUE | |
25049 | ENDIF | |
25050 | ||
25051 | ELSEIF(ISUB.LE.240) THEN | |
25052 | IF(ISUB.EQ.237) THEN | |
25053 | C...q + qbar -> gluino + ~chi0_1 | |
25054 | COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* | |
25055 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) | |
25056 | FAC0=COMFAC*AS*AEM*4D0/9D0/XW | |
25057 | GM2=SQM3 | |
25058 | ZM2=SQM4 | |
25059 | DO 280 I=MMINA,MMAXA | |
25060 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 280 | |
25061 | EI=KCHG(IABS(I),1)/3D0 | |
25062 | IA=IABS(I) | |
25063 | XLQC = -TANW*EI*ZMIX(IZID,1) | |
25064 | XRQC =(SIGN(1D0,EI)*ZMIX(IZID,2)-TANW* | |
25065 | & (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID,1))/2D0 | |
25066 | XLQ2=XLQC**2 | |
25067 | XRQ2=XRQC**2 | |
25068 | XML2=PMAS(PYCOMP(KSUSY1+IA),1)**2 | |
25069 | XMR2=PMAS(PYCOMP(KSUSY2+IA),1)**2 | |
25070 | ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XML2)**2 | |
25071 | AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XML2)**2 | |
25072 | ATUKIN=SMZ(IZID)*SQRT(GM2)*SH/(TH-XML2)/(UH-XML2) | |
25073 | SGCHIL=XLQ2*(ATKIN+AUKIN-2D0*ATUKIN) | |
25074 | ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XMR2)**2 | |
25075 | AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XMR2)**2 | |
25076 | ATUKIN=SMZ(IZID)*SQRT(GM2)*SH/(TH-XMR2)/(UH-XMR2) | |
25077 | SGCHIR=XRQ2*(ATKIN+AUKIN-2D0*ATUKIN) | |
25078 | NCHN=NCHN+1 | |
25079 | ISIG(NCHN,1)=I | |
25080 | ISIG(NCHN,2)=-I | |
25081 | ISIG(NCHN,3)=1 | |
25082 | SIGH(NCHN)=FAC0*(SGCHIL+SGCHIR) | |
25083 | 280 CONTINUE | |
25084 | ENDIF | |
25085 | ||
25086 | ELSEIF(ISUB.LE.250) THEN | |
25087 | IF(ISUB.EQ.241) THEN | |
25088 | C...q + qbar' -> ~chi+-_1 + gluino | |
25089 | FACWG=COMFAC*AS*AEM/XW*2D0/9D0 | |
25090 | GM2=SQM3 | |
25091 | ZM2=SQM4 | |
25092 | FAC01=2D0*UMIX(IZID,1)*VMIX(IZID,1) | |
25093 | FAC0=UMIX(IZID,1)**2 | |
25094 | FAC1=VMIX(IZID,1)**2 | |
25095 | DO 300 I=MMIN1,MMAX1 | |
25096 | IA=IABS(I) | |
25097 | IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 300 | |
25098 | DO 290 J=MMIN2,MMAX2 | |
25099 | JA=IABS(J) | |
25100 | IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 290 | |
25101 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 290 | |
25102 | FCKM=1D0 | |
25103 | IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
25104 | KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J) | |
25105 | KCHW=2 | |
25106 | IF(KCHSUM.LT.0) KCHW=3 | |
25107 | XMU2=PMAS(PYCOMP(KSUSY1+2),1)**2 | |
25108 | XMD2=PMAS(PYCOMP(KSUSY1+1),1)**2 | |
25109 | ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XMU2)**2 | |
25110 | AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XMD2)**2 | |
25111 | ATUKIN=SMW(IZID)*SQRT(GM2)*SH/(TH-XMU2)/(UH-XMD2) | |
25112 | XMU2=PMAS(PYCOMP(KSUSY2+2),1)**2 | |
25113 | XMD2=PMAS(PYCOMP(KSUSY2+1),1)**2 | |
25114 | ATKIN=(ATKIN+(TH-GM2)*(TH-ZM2)/(TH-XMU2)**2)/2D0 | |
25115 | AUKIN=(AUKIN+(UH-GM2)*(UH-ZM2)/(UH-XMD2)**2)/2D0 | |
25116 | ATUKIN=(ATUKIN+SMW(IZID)*SQRT(GM2)* | |
25117 | & SH/(TH-XMU2)/(UH-XMD2))/2D0 | |
25118 | NCHN=NCHN+1 | |
25119 | ISIG(NCHN,1)=I | |
25120 | ISIG(NCHN,2)=J | |
25121 | ISIG(NCHN,3)=1 | |
25122 | SIGH(NCHN)=FACWG*FCKM*(FAC0*ATKIN+FAC1*AUKIN- | |
25123 | & FAC01*ATUKIN)*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* | |
25124 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW) | |
25125 | 290 CONTINUE | |
25126 | 300 CONTINUE | |
25127 | ||
25128 | ELSEIF(ISUB.EQ.243) THEN | |
25129 | C...q + qbar -> gluino + gluino | |
25130 | COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
25131 | XMT=SQM3-TH | |
25132 | XMU=SQM3-UH | |
25133 | DO 310 I=MMINA,MMAXA | |
25134 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
25135 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310 | |
25136 | NCHN=NCHN+1 | |
25137 | XSU=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2-UH | |
25138 | XST=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2-TH | |
25139 | FACGG1=COMFAC*AS**2*8D0/3D0*( (XMT**2+XMU**2+ | |
25140 | & 2D0*SQM3*SH)/SH2 +4D0/9D0*(XMT**2/XST**2+ | |
25141 | & XMU**2/XSU**2) - (XMT**2+SH*SQM3)/SH/XST + | |
25142 | & SQM3*SH/XST/XSU/9D0- (XMU**2+SH*SQM3)/SH/XSU ) | |
25143 | XSU=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2-UH | |
25144 | XST=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2-TH | |
25145 | FACGG2=COMFAC*AS**2*8D0/3D0*( (XMT**2+XMU**2+ | |
25146 | & 2D0*SQM3*SH)/SH2 +4D0/9D0*(XMT**2/XST**2+ | |
25147 | & XMU**2/XSU**2) - (XMT**2+SH*SQM3)/SH/XST + | |
25148 | & SQM3*SH/XST/XSU/9D0- (XMU**2+SH*SQM3)/SH/XSU ) | |
25149 | ISIG(NCHN,1)=I | |
25150 | ISIG(NCHN,2)=-I | |
25151 | ISIG(NCHN,3)=1 | |
25152 | C...1/2 for identical particles | |
25153 | SIGH(NCHN)=0.25D0*(FACGG1+FACGG2) | |
25154 | 310 CONTINUE | |
25155 | ||
25156 | ELSEIF(ISUB.EQ.244) THEN | |
25157 | C...g + g -> gluino + gluino | |
25158 | COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
25159 | XMT=SQM3-TH | |
25160 | XMU=SQM3-UH | |
25161 | FACQQ1=COMFAC*AS**2*9D0/4D0*( | |
25162 | & (XMT*XMU-2D0*SQM3*(TH+SQM3))/XMT**2 - | |
25163 | & (XMT*XMU+SQM3*(UH-TH))/SH/XMT ) | |
25164 | FACQQ2=COMFAC*AS**2*9D0/4D0*( | |
25165 | & (XMU*XMT-2D0*SQM3*(UH+SQM3))/XMU**2 - | |
25166 | & (XMU*XMT+SQM3*(TH-UH))/SH/XMU ) | |
25167 | FACQQ3=COMFAC*AS**2*9D0/4D0*(2D0*XMT*XMU/SH2 + | |
25168 | & SQM3*(SH-4D0*SQM3)/XMT/XMU) | |
25169 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 320 | |
25170 | NCHN=NCHN+1 | |
25171 | ISIG(NCHN,1)=21 | |
25172 | ISIG(NCHN,2)=21 | |
25173 | ISIG(NCHN,3)=1 | |
25174 | SIGH(NCHN)=FACQQ1/2D0 | |
25175 | NCHN=NCHN+1 | |
25176 | ISIG(NCHN,1)=21 | |
25177 | ISIG(NCHN,2)=21 | |
25178 | ISIG(NCHN,3)=2 | |
25179 | SIGH(NCHN)=FACQQ2/2D0 | |
25180 | NCHN=NCHN+1 | |
25181 | ISIG(NCHN,1)=21 | |
25182 | ISIG(NCHN,2)=21 | |
25183 | ISIG(NCHN,3)=3 | |
25184 | SIGH(NCHN)=FACQQ3/2D0 | |
25185 | 320 CONTINUE | |
25186 | ||
25187 | ELSEIF(ISUB.EQ.246) THEN | |
25188 | C...g + q_j -> ~chi0_1 + ~q_j | |
25189 | FAC0=COMFAC*AS*AEM/6D0/XW | |
25190 | ZM2=SQM4 | |
25191 | QM2=SQM3 | |
25192 | FACZQ0=FAC0*( (ZM2-TH)/SH + | |
25193 | & (UH-ZM2)*(UH+QM2)/(UH-QM2)**2 - | |
25194 | & (SH*(UH+ZM2)+2D0*(QM2-ZM2)*(ZM2-UH))/SH/(UH-QM2) ) | |
25195 | KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) | |
25196 | DO 340 I=-KFNSQ,KFNSQ,2*KFNSQ | |
25197 | IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 340 | |
25198 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 340 | |
25199 | EI=KCHG(IABS(I),1)/3D0 | |
25200 | IA=IABS(I) | |
25201 | XRQZ = -TANW*EI*ZMIX(IZID,1) | |
25202 | XLQZ =(SIGN(1D0,EI)*ZMIX(IZID,2)-TANW* | |
25203 | & (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID,1))/2D0 | |
25204 | IF(ILR.EQ.0) THEN | |
25205 | BS=XLQZ**2*SFMIX(IA,1)**2+XRQZ**2*SFMIX(IA,2)**2 | |
25206 | ELSE | |
25207 | BS=XLQZ**2*SFMIX(IA,3)**2+XRQZ**2*SFMIX(IA,4)**2 | |
25208 | ENDIF | |
25209 | FACZQ=FACZQ0*BS | |
25210 | KCHQ=2 | |
25211 | IF(I.LT.0) KCHQ=3 | |
25212 | DO 330 ISDE=1,2 | |
25213 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 330 | |
25214 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 330 | |
25215 | NCHN=NCHN+1 | |
25216 | ISIG(NCHN,ISDE)=I | |
25217 | ISIG(NCHN,3-ISDE)=21 | |
25218 | ISIG(NCHN,3)=1 | |
25219 | SIGH(NCHN)=FACZQ*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* | |
25220 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) | |
25221 | 330 CONTINUE | |
25222 | 340 CONTINUE | |
25223 | ENDIF | |
25224 | ||
25225 | ELSEIF(ISUB.LE.260) THEN | |
25226 | IF(ISUB.EQ.254) THEN | |
25227 | C...g + q_j -> ~chi1_1 + ~q_i | |
25228 | FAC0=COMFAC*AS*AEM/12D0/XW | |
25229 | ZM2=SQM4 | |
25230 | QM2=SQM3 | |
25231 | AU=UMIX(IZID,1)**2 | |
25232 | AD=VMIX(IZID,1)**2 | |
25233 | FACZQ0=FAC0*( (ZM2-TH)/SH + | |
25234 | & (UH-ZM2)*(UH+QM2)/(UH-QM2)**2 - | |
25235 | & (SH*(UH+ZM2)+2D0*(QM2-ZM2)*(ZM2-UH))/SH/(UH-QM2) ) | |
25236 | KFNSQ1=MOD(KFPR(ISUBSV,1),KSUSY1) | |
25237 | IF(MOD(KFNSQ1,2).EQ.0) THEN | |
25238 | KFNSQ=KFNSQ1-1 | |
25239 | KCHW=2 | |
25240 | ELSE | |
25241 | KFNSQ=KFNSQ1+1 | |
25242 | KCHW=3 | |
25243 | ENDIF | |
25244 | DO 360 I=-KFNSQ,KFNSQ,2*KFNSQ | |
25245 | IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 360 | |
25246 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 360 | |
25247 | IA=IABS(I) | |
25248 | IF(MOD(IA,2).EQ.0) THEN | |
25249 | FACZQ=FACZQ0*AU | |
25250 | ELSE | |
25251 | FACZQ=FACZQ0*AD | |
25252 | ENDIF | |
25253 | FACZQ=FACZQ*SFMIX(KFNSQ1,1+2*ILR)**2 | |
25254 | KCHQ=2 | |
25255 | IF(I.LT.0) KCHQ=3 | |
25256 | KCHWQ=KCHW | |
25257 | IF(I.LT.0) KCHWQ=5-KCHW | |
25258 | DO 350 ISDE=1,2 | |
25259 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 350 | |
25260 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 350 | |
25261 | NCHN=NCHN+1 | |
25262 | ISIG(NCHN,ISDE)=I | |
25263 | ISIG(NCHN,3-ISDE)=21 | |
25264 | ISIG(NCHN,3)=1 | |
25265 | SIGH(NCHN)=FACZQ*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* | |
25266 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHWQ) | |
25267 | 350 CONTINUE | |
25268 | 360 CONTINUE | |
25269 | ||
25270 | ELSEIF(ISUB.EQ.258) THEN | |
25271 | C...g + q_j -> gluino + ~q_i | |
25272 | XG2=SQM4 | |
25273 | XQ2=SQM3 | |
25274 | XMT=XG2-TH | |
25275 | XMU=XG2-UH | |
25276 | XST=XQ2-TH | |
25277 | XSU=XQ2-UH | |
25278 | FACQG1=0.5D0*4D0/9D0*XMT/SH + (XMT*SH+2D0*XG2*XST)/XMT**2 - | |
25279 | & ( (SH-XQ2+XG2)*(-XST)-SH*XG2 )/SH/(-XMT) + | |
25280 | & 0.5D0*1D0/2D0*( XST*(TH+2D0*UH+XG2)-XMT*(SH-2D0*XST) + | |
25281 | & (-XMU)*(TH+XG2+2D0*XQ2) )/2D0/XMT/XSU | |
25282 | FACQG2= 4D0/9D0*(-XMU)*(UH+XQ2)/XSU**2 + 1D0/18D0* | |
25283 | & (SH*(UH+XG2) | |
25284 | & +2D0*(XQ2-XG2)*XMU)/SH/(-XSU) + 0.5D0*4D0/9D0*XMT/SH + | |
25285 | & 0.5D0*1D0/2D0*(XST*(TH+2D0*UH+XG2)-XMT*(SH-2D0*XST)+ | |
25286 | & (-XMU)*(TH+XG2+2D0*XQ2))/2D0/XMT/XSU | |
25287 | FACQG1=COMFAC*AS**2*FACQG1/2D0 | |
25288 | FACQG2=COMFAC*AS**2*FACQG2/2D0 | |
25289 | KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) | |
25290 | DO 380 I=-KFNSQ,KFNSQ,2*KFNSQ | |
25291 | IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 380 | |
25292 | IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 380 | |
25293 | KCHQ=2 | |
25294 | IF(I.LT.0) KCHQ=3 | |
25295 | FACSEL=RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* | |
25296 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) | |
25297 | DO 370 ISDE=1,2 | |
25298 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 370 | |
25299 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 370 | |
25300 | NCHN=NCHN+1 | |
25301 | ISIG(NCHN,ISDE)=I | |
25302 | ISIG(NCHN,3-ISDE)=21 | |
25303 | ISIG(NCHN,3)=1 | |
25304 | SIGH(NCHN)=FACQG1*FACSEL | |
25305 | NCHN=NCHN+1 | |
25306 | ISIG(NCHN,ISDE)=I | |
25307 | ISIG(NCHN,3-ISDE)=21 | |
25308 | ISIG(NCHN,3)=2 | |
25309 | SIGH(NCHN)=FACQG2*FACSEL | |
25310 | 370 CONTINUE | |
25311 | 380 CONTINUE | |
25312 | ENDIF | |
25313 | ||
25314 | ELSEIF(ISUB.LE.270) THEN | |
25315 | IF(ISUB.EQ.261) THEN | |
25316 | C...q_i + q_ibar -> ~t_1 + ~t_1bar | |
25317 | FACQQ1=COMFAC*( (UH*TH-SQM3*SQM4)/ SH**2 )* | |
25318 | & WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
25319 | KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) | |
25320 | FAC0=AS**2*4D0/9D0 | |
25321 | DO 390 I=MMIN1,MMAX1 | |
25322 | IA=IABS(I) | |
25323 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 390 | |
25324 | IF(IA.GE.11.AND.IA.LE.18) THEN | |
25325 | EI=KCHG(IA,1)/3D0 | |
25326 | EJ=KCHG(KFNSQ,1)/3D0 | |
25327 | T3I=SIGN(1D0,EI)/2D0 | |
25328 | T3J=SIGN(1D0,EJ)/2D0 | |
25329 | XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,2*ILR+1)**2 | |
25330 | XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,2*ILR+2)**2 | |
25331 | XLF=2D0*(T3I-EI*XW) | |
25332 | XRF=2D0*(-EI*XW) | |
25333 | TAA=0.5D0*(EI*EJ)**2 | |
25334 | TZZ=(XLF**2+XRF**2)*(XLQ+XRQ)**2/64D0/XW**2/XW1**2 | |
25335 | TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) | |
25336 | TAZ=EI*EJ*(XLQ+XRQ)*(XLF+XRF)/8D0/XW/XW1 | |
25337 | TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH) | |
25338 | FAC0=AEM**2*12D0*(TAA+TZZ+TAZ) | |
25339 | ENDIF | |
25340 | NCHN=NCHN+1 | |
25341 | ISIG(NCHN,1)=I | |
25342 | ISIG(NCHN,2)=-I | |
25343 | ISIG(NCHN,3)=1 | |
25344 | SIGH(NCHN)=FACQQ1*FAC0 | |
25345 | 390 CONTINUE | |
25346 | ||
25347 | ELSEIF(ISUB.EQ.263) THEN | |
25348 | C...f + fbar -> ~t1 + ~t2bar | |
25349 | DO 400 I=MMIN1,MMAX1 | |
25350 | IA=IABS(I) | |
25351 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400 | |
25352 | EI=KCHG(IABS(I),1)/3D0 | |
25353 | TT3I=SIGN(1D0,EI)/2D0 | |
25354 | EJ=2D0/3D0 | |
25355 | TT3J=1D0/2D0 | |
25356 | FCOL=1D0 | |
25357 | C...Color factor for e+ e- | |
25358 | IF(IA.GE.11) FCOL=3D0 | |
25359 | XLQ=2D0*(TT3J-EJ*XW) | |
25360 | XRQ=2D0*(-EJ*XW) | |
25361 | XLF=2D0*(TT3I-EI*XW) | |
25362 | XRF=2D0*(-EI*XW) | |
25363 | TZZ=(XLF**2+XRF**2)*(XLQ-XRQ)**2/64D0/XW**2/XW1**2 | |
25364 | TZZ=TZZ*(SFMIX(6,1)*SFMIX(6,2))**2 | |
25365 | TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) | |
25366 | C...Factor of 2 for t1 t2bar + t2 t1bar | |
25367 | FACQQ1=2D0*COMFAC*AEM**2*TZZ*FCOL*4D0 | |
25368 | FACQQ1=FACQQ1*( UH*TH-SQM3*SQM4 )/SH2 | |
25369 | NCHN=NCHN+1 | |
25370 | ISIG(NCHN,1)=I | |
25371 | ISIG(NCHN,2)=-I | |
25372 | ISIG(NCHN,3)=1 | |
25373 | SIGH(NCHN)=FACQQ1*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* | |
25374 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),3) | |
25375 | NCHN=NCHN+1 | |
25376 | ISIG(NCHN,1)=I | |
25377 | ISIG(NCHN,2)=-I | |
25378 | ISIG(NCHN,3)=2 | |
25379 | SIGH(NCHN)=FACQQ1*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)* | |
25380 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) | |
25381 | 400 CONTINUE | |
25382 | ||
25383 | ELSEIF(ISUB.EQ.264) THEN | |
25384 | C...g + g -> ~t_1 + ~t_1bar | |
25385 | XSU=SQM3-UH | |
25386 | XST=SQM3-TH | |
25387 | FAC0=COMFAC*AS**2*(7D0/48D0+3D0*(UH-TH)**2/16D0/SH2 )*0.5D0* | |
25388 | & WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
25389 | FACQQ1=FAC0*(0.5D0+2D0*SQM3*TH/XST**2 + 2D0*SQM3**2/XSU/XST) | |
25390 | FACQQ2=FAC0*(0.5D0+2D0*SQM3*UH/XSU**2 + 2D0*SQM3**2/XSU/XST) | |
25391 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 410 | |
25392 | NCHN=NCHN+1 | |
25393 | ISIG(NCHN,1)=21 | |
25394 | ISIG(NCHN,2)=21 | |
25395 | ISIG(NCHN,3)=1 | |
25396 | SIGH(NCHN)=FACQQ1 | |
25397 | NCHN=NCHN+1 | |
25398 | ISIG(NCHN,1)=21 | |
25399 | ISIG(NCHN,2)=21 | |
25400 | ISIG(NCHN,3)=2 | |
25401 | SIGH(NCHN)=FACQQ2 | |
25402 | 410 CONTINUE | |
25403 | ENDIF | |
25404 | ||
25405 | ELSEIF(ISUB.LE.280) THEN | |
25406 | IF(ISUB.EQ.271) THEN | |
25407 | C...q + q' -> ~q + ~q' (~g exchange) | |
25408 | XMG2=PMAS(PYCOMP(KSUSY1+21),1)**2 | |
25409 | XMT=XMG2-TH | |
25410 | XMU=XMG2-UH | |
25411 | XSU1=SQM3-UH | |
25412 | XSU2=SQM4-UH | |
25413 | XST1=SQM3-TH | |
25414 | XST2=SQM4-TH | |
25415 | IF(ILR.EQ.1) THEN | |
25416 | FACQQ1=COMFAC*AS**2*4D0/9D0*( -(XST1*XST2+SH*TH)/XMT**2 ) | |
25417 | FACQQ2=COMFAC*AS**2*4D0/9D0*( -(XSU1*XSU2+SH*UH)/XMU**2 ) | |
25418 | FACQQB=0.0D0 | |
25419 | ELSE | |
25420 | FACQQ1=0.5D0*COMFAC*AS**2*4D0/9D0*( SH*XMG2/XMT**2 ) | |
25421 | FACQQ2=0.5D0*COMFAC*AS**2*4D0/9D0*( SH*XMG2/XMU**2 ) | |
25422 | FACQQB=0.5D0*COMFAC*AS**2*4D0/9D0*( -2D0*SH*XMG2/3D0/ | |
25423 | & XMT/XMU ) | |
25424 | ENDIF | |
25425 | KFNSQI=MOD(KFPR(ISUBSV,1),KSUSY1) | |
25426 | KFNSQJ=MOD(KFPR(ISUBSV,2),KSUSY1) | |
25427 | DO 430 I=-KFNSQI,KFNSQI,2*KFNSQI | |
25428 | IF(I.LT.MMIN1.OR.I.GT.MMAX1) GOTO 430 | |
25429 | IA=IABS(I) | |
25430 | IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 430 | |
25431 | KCHQ=2 | |
25432 | IF(I.LT.0) KCHQ=3 | |
25433 | DO 420 J=-KFNSQJ,KFNSQJ,2*KFNSQJ | |
25434 | IF(J.LT.MMIN2.OR.J.GT.MMAX2) GOTO 420 | |
25435 | JA=IABS(J) | |
25436 | IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 420 | |
25437 | IF(I*J.LT.0) GOTO 420 | |
25438 | NCHN=NCHN+1 | |
25439 | ISIG(NCHN,1)=I | |
25440 | ISIG(NCHN,2)=J | |
25441 | ISIG(NCHN,3)=1 | |
25442 | SIGH(NCHN)=FACQQ1*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* | |
25443 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ) | |
25444 | IF(I.EQ.J) THEN | |
25445 | IF(ILR.EQ.0) THEN | |
25446 | SIGH(NCHN)=0.5D0*(FACQQ1+0.5D0*FACQQB)*RKF* | |
25447 | & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ+2) | |
25448 | ELSE | |
25449 | SIGH(NCHN)=0.5D0*FACQQ1*RKF* | |
25450 | & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* | |
25451 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ) | |
25452 | ENDIF | |
25453 | NCHN=NCHN+1 | |
25454 | ISIG(NCHN,1)=I | |
25455 | ISIG(NCHN,2)=J | |
25456 | ISIG(NCHN,3)=2 | |
25457 | IF(ILR.EQ.0) THEN | |
25458 | SIGH(NCHN)=0.5D0*(FACQQ2+0.5D0*FACQQB)*RKF* | |
25459 | & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ+2) | |
25460 | ELSE | |
25461 | SIGH(NCHN)=0.5D0*FACQQ2*RKF* | |
25462 | & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* | |
25463 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ) | |
25464 | ENDIF | |
25465 | ENDIF | |
25466 | 420 CONTINUE | |
25467 | 430 CONTINUE | |
25468 | ||
25469 | ELSEIF(ISUB.EQ.274) THEN | |
25470 | C...q + qbar' -> ~q + ~qbar' | |
25471 | XMG2=PMAS(PYCOMP(KSUSY1+21),1)**2 | |
25472 | XMT=XMG2-TH | |
25473 | XMU=XMG2-UH | |
25474 | IF(ILR.EQ.0) THEN | |
25475 | C...Mrenna...Normalization.and.1/XMT | |
25476 | FACQQ1=COMFAC*AS**2*2D0/9D0*( | |
25477 | & (UH*TH-SQM3*SQM4)/XMT**2 ) | |
25478 | FACQQB=COMFAC*AS**2*2D0/9D0*( | |
25479 | & (UH*TH-SQM3*SQM4)/SH2*(2D0-2D0/3D0*SH/XMT)) | |
25480 | FACQQB=FACQQB+FACQQ1 | |
25481 | ELSE | |
25482 | FACQQ1=COMFAC*AS**2*4D0/9D0*( XMG2*SH/XMT**2 ) | |
25483 | FACQQB=FACQQ1 | |
25484 | ENDIF | |
25485 | KFNSQI=MOD(KFPR(ISUBSV,1),KSUSY1) | |
25486 | KFNSQJ=MOD(KFPR(ISUBSV,2),KSUSY1) | |
25487 | DO 450 I=-KFNSQI,KFNSQI,2*KFNSQI | |
25488 | IF(I.LT.MMIN1.OR.I.GT.MMAX1) GOTO 450 | |
25489 | IA=IABS(I) | |
25490 | IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 450 | |
25491 | KCHQ=2 | |
25492 | IF(I.LT.0) KCHQ=3 | |
25493 | DO 440 J=-KFNSQJ,KFNSQJ,2*KFNSQJ | |
25494 | IF(J.LT.MMIN2.OR.J.GT.MMAX2) GOTO 440 | |
25495 | JA=IABS(J) | |
25496 | IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 440 | |
25497 | IF(I*J.GT.0) GOTO 440 | |
25498 | NCHN=NCHN+1 | |
25499 | ISIG(NCHN,1)=I | |
25500 | ISIG(NCHN,2)=J | |
25501 | ISIG(NCHN,3)=1 | |
25502 | SIGH(NCHN)=FACQQ1*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* | |
25503 | & WIDS(PYCOMP(KFPR(ISUBSV,2)),5-KCHQ) | |
25504 | IF(I.EQ.-J) SIGH(NCHN)=FACQQB*RKF* | |
25505 | & WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
25506 | 440 CONTINUE | |
25507 | 450 CONTINUE | |
25508 | ||
25509 | ELSEIF(ISUB.EQ.277) THEN | |
25510 | C...q_i + q_ibar -> ~q_j + ~q_jbar ,i .ne. j | |
25511 | C...if i .eq. j covered in 274 | |
25512 | FACQQ1=COMFAC*( (UH*TH-SQM3*SQM4)/ SH**2 ) | |
25513 | KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) | |
25514 | FAC0=0D0 | |
25515 | DO 460 I=MMIN1,MMAX1 | |
25516 | IA=IABS(I) | |
25517 | IF(I.EQ.0.OR.IA.GT.MSTP(58).OR. | |
25518 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 460 | |
25519 | IF(IA.EQ.KFNSQ) GOTO 460 | |
25520 | IF(IA.EQ.11.OR.IA.EQ.13.OR.IA.EQ.15) THEN | |
25521 | EI=KCHG(IA,1)/3D0 | |
25522 | EJ=KCHG(KFNSQ,1)/3D0 | |
25523 | T3J=SIGN(0.5D0,EJ) | |
25524 | T3I=SIGN(1D0,EI)/2D0 | |
25525 | IF(ILR.EQ.0) THEN | |
25526 | XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,1) | |
25527 | XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,2) | |
25528 | ELSE | |
25529 | XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,3) | |
25530 | XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,4) | |
25531 | ENDIF | |
25532 | XLF=2D0*(T3I-EI*XW) | |
25533 | XRF=2D0*(-EI*XW) | |
25534 | IF(ILR.EQ.0) THEN | |
25535 | XRQ=0D0 | |
25536 | ELSE | |
25537 | XLQ=0D0 | |
25538 | ENDIF | |
25539 | TAA=0.5D0*(EI*EJ)**2 | |
25540 | TZZ=(XLF**2+XRF**2)*(XLQ+XRQ)**2/64D0/XW**2/XW1**2 | |
25541 | TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) | |
25542 | TAZ=EI*EJ*(XLQ+XRQ)*(XLF+XRF)/8D0/XW/XW1 | |
25543 | TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH) | |
25544 | FAC0=AEM**2*12D0*(TAA+TZZ+TAZ) | |
25545 | ELSEIF(IA.LE.6) THEN | |
25546 | FAC0=AS**2*8D0/9D0/2D0 | |
25547 | ENDIF | |
25548 | NCHN=NCHN+1 | |
25549 | ISIG(NCHN,1)=I | |
25550 | ISIG(NCHN,2)=-I | |
25551 | ISIG(NCHN,3)=1 | |
25552 | SIGH(NCHN)=FACQQ1*FAC0*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
25553 | 460 CONTINUE | |
25554 | ||
25555 | ELSEIF(ISUB.EQ.279) THEN | |
25556 | C...g + g -> ~q_j + ~q_jbar | |
25557 | XSU=SQM3-UH | |
25558 | XST=SQM3-TH | |
25559 | C...5=RKF because ~t ~tbar treated separately | |
25560 | FAC0=RKF*COMFAC*AS**2*( 7D0/48D0+3D0*(UH-TH)**2/16D0/SH2 ) | |
25561 | FACQQ1=FAC0*(0.5D0+2D0*SQM3*TH/XST**2 + 2D0*SQM3**2/XSU/XST) | |
25562 | FACQQ2=FAC0*(0.5D0+2D0*SQM3*UH/XSU**2 + 2D0*SQM3**2/XSU/XST) | |
25563 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 470 | |
25564 | NCHN=NCHN+1 | |
25565 | ISIG(NCHN,1)=21 | |
25566 | ISIG(NCHN,2)=21 | |
25567 | ISIG(NCHN,3)=1 | |
25568 | SIGH(NCHN)=FACQQ1/2D0*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
25569 | NCHN=NCHN+1 | |
25570 | ISIG(NCHN,1)=21 | |
25571 | ISIG(NCHN,2)=21 | |
25572 | ISIG(NCHN,3)=2 | |
25573 | SIGH(NCHN)=FACQQ2/2D0*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) | |
25574 | 470 CONTINUE | |
25575 | ||
25576 | ENDIF | |
25577 | ENDIF | |
25578 | CMRENNA-- | |
25579 | ||
25580 | RETURN | |
25581 | END | |
25582 | ||
25583 | C********************************************************************* | |
25584 | ||
25585 | C...PYSGTC | |
25586 | C...Subprocess cross sections for Technicolor processes. | |
25587 | C...Auxiliary to PYSIGH. | |
25588 | ||
25589 | SUBROUTINE PYSGTC(NCHN,SIGS) | |
25590 | ||
25591 | C...Double precision and integer declarations | |
25592 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
25593 | IMPLICIT INTEGER(I-N) | |
25594 | INTEGER PYK,PYCHGE,PYCOMP | |
25595 | C...Parameter statement to help give large particle numbers. | |
25596 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
25597 | &KEXCIT=4000000,KDIMEN=5000000) | |
25598 | C...Commonblocks | |
25599 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
25600 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
25601 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
25602 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
25603 | COMMON/PYINT1/MINT(400),VINT(400) | |
25604 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
25605 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
25606 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
25607 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
25608 | COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, | |
25609 | &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, | |
25610 | &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, | |
25611 | &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR | |
25612 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/, | |
25613 | &/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/ | |
25614 | C...Local arrays and complex variables | |
25615 | DIMENSION WDTP(0:400),WDTE(0:400,0:5) | |
25616 | COMPLEX*16 SSMZ,SSMR,SSMO,DETD,F2L,F2R,DARHO,DZRHO,DAOME,DZOME | |
25617 | COMPLEX*16 DAA,DZZ,DAZ,DWW,DWRHO | |
25618 | COMPLEX*16 ZTC(6,6),YTC(6,6),DGGS,DGGT,DGGU,DGVS,DGVT,DGVU | |
25619 | COMPLEX*16 DQQS,DQQT,DQQU,DQTS,DQGS,DTGS | |
25620 | COMPLEX*16 DVVS,DVVT,DVVU | |
25621 | INTEGER INDX(6) | |
25622 | ||
25623 | C...Combinations of weak mixing angle. | |
25624 | TANW=SQRT(XW/XW1) | |
25625 | CT2W=(1D0-2D0*XW)/(2D0*XW/TANW) | |
25626 | ||
25627 | C...Convert almost equivalent technicolor processes into | |
25628 | C...a few basic processes, and set distinguishing parameters. | |
25629 | IF(ISUB.GE.361.AND.ISUB.LE.379) THEN | |
25630 | SQTV=RTCM(12)**2 | |
25631 | SQTA=RTCM(13)**2 | |
25632 | SN2W=2D0*SQRT(PARU(102)*(1D0-PARU(102))) | |
25633 | CS2W=1D0-2D0*PARU(102) | |
25634 | TANW=SQRT(PARU(102)/(1D0-PARU(102))) | |
25635 | CT2W=CS2W/SN2W | |
25636 | CSXI=COS(ASIN(RTCM(3))) | |
25637 | CSXIP=COS(ASIN(RTCM(4))) | |
25638 | QUPD=2D0*RTCM(2)-1D0 | |
25639 | Q2UD=RTCM(2)**2+(RTCM(2)-1D0)**2 | |
25640 | C... rho_tc0 -> W_L W_L | |
25641 | IF(ISUB.EQ.361) THEN | |
25642 | KFA=24 | |
25643 | KFB=24 | |
25644 | CAB2=RTCM(3)**4 | |
25645 | C... rho_tc0 -> W_L pi_tc- | |
25646 | ELSEIF(ISUB.EQ.362) THEN | |
25647 | KFA=24 | |
25648 | KFB=KTECHN+211 | |
25649 | ISUB=361 | |
25650 | CAB2=RTCM(3)**2*(1D0-RTCM(3)**2) | |
25651 | C... pi_tc pi_tc | |
25652 | ELSEIF(ISUB.EQ.363) THEN | |
25653 | KFA=KTECHN+211 | |
25654 | KFB=KTECHN+211 | |
25655 | ISUB=361 | |
25656 | CAB2=(1D0-RTCM(3)**2)**2 | |
25657 | C... rho_tc0/omega_tc -> gamma pi_tc | |
25658 | ELSEIF(ISUB.EQ.364) THEN | |
25659 | KFA=22 | |
25660 | KFB=KTECHN+111 | |
25661 | VOGP=CSXI/RTCM(12) | |
25662 | C..........!!! | |
25663 | VRGP=VOGP*QUPD | |
25664 | AOGP=0D0 | |
25665 | ARGP=0D0 | |
25666 | VAGP=2D0*QUPD*CSXI | |
25667 | VZGP=QUPD*CSXI*(1D0-4D0*PARU(102))/SN2W | |
25668 | C... gamma pi_tc' | |
25669 | ELSEIF(ISUB.EQ.365) THEN | |
25670 | KFA=22 | |
25671 | KFB=KTECHN+221 | |
25672 | ISUB=364 | |
25673 | VRGP=CSXIP/RTCM(12) | |
25674 | C..........!!!! | |
25675 | VOGP=VRGP*QUPD | |
25676 | AOGP=0D0 | |
25677 | ARGP=0D0 | |
25678 | VAGP=2D0*Q2UD*CSXIP | |
25679 | VZGP=CSXIP/SN2W*(1D0-4D0*PARU(102)*Q2UD) | |
25680 | C... Z pi_tc | |
25681 | ELSEIF(ISUB.EQ.366) THEN | |
25682 | KFA=23 | |
25683 | KFB=KTECHN+111 | |
25684 | ISUB=364 | |
25685 | VOGP=CSXI*CT2W/RTCM(12) | |
25686 | VRGP=-QUPD*CSXI*TANW/RTCM(12) | |
25687 | AOGP=0D0 | |
25688 | ARGP=0D0 | |
25689 | VAGP=QUPD*CSXI*(1D0-4D0*PARU(102))/SN2W | |
25690 | VZGP=-QUPD*CSXI*CS2W/(1D0-PARU(102)) | |
25691 | C... Z pi_tc' | |
25692 | ELSEIF(ISUB.EQ.367) THEN | |
25693 | KFA=23 | |
25694 | KFB=KTECHN+221 | |
25695 | ISUB=364 | |
25696 | VRGP=CSXIP*CT2W/RTCM(12) | |
25697 | VOGP=-QUPD*CSXIP*TANW/RTCM(12) | |
25698 | AOGP=0D0 | |
25699 | ARGP=0D0 | |
25700 | VAGP=CSXIP*(1D0-4D0*Q2UD*PARU(102))/SN2W | |
25701 | VZGP=2D0*CSXIP*(CS2W+4D0*Q2UD*PARU(102)**2)/SN2W**2 | |
25702 | C... W_T pi_tc | |
25703 | ELSEIF(ISUB.EQ.368) THEN | |
25704 | KFA=24 | |
25705 | KFB=KTECHN+211 | |
25706 | ISUB=364 | |
25707 | VOGP=CSXI/(2D0*SQRT(PARU(102)))/RTCM(12) | |
25708 | VRGP=0D0 | |
25709 | AOGP=0D0 | |
25710 | C..........!!!! | |
25711 | ARGP=-CSXI/(2D0*SQRT(PARU(102)))/RTCM(13) | |
25712 | VAGP=QUPD*CSXI/(2D0*SQRT(PARU(102))) | |
25713 | VZGP=-QUPD*CSXI/(2D0*SQRT(1D0-PARU(102))) | |
25714 | C... rho_tc+ -> W_L Z_L | |
25715 | ELSEIF(ISUB.EQ.370) THEN | |
25716 | KFA=24 | |
25717 | KFB=23 | |
25718 | CAB2=RTCM(3)**4 | |
25719 | C... W_L pi_tc0 | |
25720 | ELSEIF(ISUB.EQ.371) THEN | |
25721 | KFA=24 | |
25722 | KFB=KTECHN+111 | |
25723 | ISUB=370 | |
25724 | CAB2=RTCM(3)**2*(1D0-RTCM(3)**2) | |
25725 | C... Z_L pi_tc+ | |
25726 | ELSEIF(ISUB.EQ.372) THEN | |
25727 | KFA=KTECHN+211 | |
25728 | KFB=23 | |
25729 | ISUB=370 | |
25730 | CAB2=RTCM(3)**2*(1D0-RTCM(3)**2) | |
25731 | C... pi_tc+ pi_tc0 | |
25732 | ELSEIF(ISUB.EQ.373) THEN | |
25733 | KFA=KTECHN+211 | |
25734 | KFB=KTECHN+111 | |
25735 | ISUB=370 | |
25736 | CAB2=(1D0-RTCM(3)**2)**2 | |
25737 | C... gamma pi_tc+ | |
25738 | ELSEIF(ISUB.EQ.374) THEN | |
25739 | KFA=KTECHN+211 | |
25740 | KFB=22 | |
25741 | VRGP=QUPD*CSXI | |
25742 | ARGP=0D0 | |
25743 | VWGP=QUPD*CSXI/(2D0*SQRT(PARU(102))) | |
25744 | C... Z_T pi_tc+ | |
25745 | ELSEIF(ISUB.EQ.375) THEN | |
25746 | KFA=KTECHN+211 | |
25747 | KFB=23 | |
25748 | ISUB=374 | |
25749 | VRGP=-QUPD*CSXI*TANW | |
25750 | ARGP=CSXI/(2D0*SQRT(PARU(102)*(1D0-PARU(102)))) | |
25751 | VWGP=-QUPD*CSXI/(2D0*SQRT(1D0-PARU(102))) | |
25752 | C... W_T pi_tc0 | |
25753 | ELSEIF(ISUB.EQ.376) THEN | |
25754 | KFA=24 | |
25755 | KFB=KTECHN+111 | |
25756 | ISUB=374 | |
25757 | VRGP=0D0 | |
25758 | ARGP=-CSXI/(2D0*SQRT(PARU(102))) | |
25759 | VWGP=0D0 | |
25760 | C... W_T pi_tc0' | |
25761 | ELSEIF(ISUB.EQ.377) THEN | |
25762 | KFA=24 | |
25763 | KFB=KTECHN+221 | |
25764 | ISUB=374 | |
25765 | ARGP=0D0 | |
25766 | VRGP=CSXIP/(2D0*SQRT(PARU(102))) | |
25767 | VWGP=CSXIP/(2D0*PARU(102)) | |
25768 | ENDIF | |
25769 | ENDIF | |
25770 | ||
25771 | C...QCD 2 -> 2 processes: corrections from virtual technicolor exchange. | |
25772 | IF(ISUB.GE.381.AND.ISUB.LE.388) THEN | |
25773 | IF(ITCM(5).LE.4) THEN | |
25774 | SQDQQS=1D0/SH2 | |
25775 | SQDQQT=1D0/TH2 | |
25776 | SQDQQU=1D0/UH2 | |
25777 | SQDGGS=SQDQQS | |
25778 | SQDGGT=SQDQQT | |
25779 | SQDGGU=SQDQQU | |
25780 | REDGGS=1D0/SH | |
25781 | REDGGT=1D0/TH | |
25782 | REDGGU=1D0/UH | |
25783 | REDGTU=1D0/UH/TH | |
25784 | REDGSU=1D0/SH/UH | |
25785 | REDGST=1D0/SH/TH | |
25786 | REDQST=1D0/SH/TH | |
25787 | REDQTU=1D0/UH/TH | |
25788 | SQDLGS=0D0 | |
25789 | SQDLGT=0D0 | |
25790 | SQDQTS=SQDQQS | |
25791 | ELSEIF(ITCM(5).EQ.5) THEN | |
25792 | TANT3=RTCM(21) | |
25793 | IF(ITCM(2).EQ.0) THEN | |
25794 | IMDL=1 | |
25795 | ELSE | |
25796 | IMDL=2 | |
25797 | ENDIF | |
25798 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
25799 | SIN2T=2D0*TANT3/(TANT3**2+1D0) | |
25800 | SINT3=TANT3/SQRT(TANT3**2+1D0) | |
25801 | XIG=SQRT(PYALPS(SH)/ALPRHT) | |
25802 | X12=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*COS(RTCM(30))+ | |
25803 | & RTCM(31)*SQRT(1D0-RTCM(31)**2)*COS(RTCM(32)))/SQRT(2D0)/SIN2T | |
25804 | X21=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*SIN(RTCM(30))+ | |
25805 | & RTCM(31)*SQRT(1D0-RTCM(31)**2)*SIN(RTCM(32)))/SQRT(2D0)/SIN2T | |
25806 | X11=(.25D0*(RTCM(29)**2+RTCM(31)**2+2D0)- | |
25807 | & SINT3**2)*2D0/SIN2T | |
25808 | X22=(.25D0*(2D0-RTCM(29)**2-RTCM(31)**2)- | |
25809 | & SINT3**2)*2D0/SIN2T | |
25810 | ||
25811 | SM1122=.5D0*(2D0-RTCM(29)**2-RTCM(31)**2)*RTCM(28)**2 | |
25812 | SM1112=X12*RTCM(28)**2*SIN2T | |
25813 | SM1121=-X21*RTCM(28)**2*SIN2T | |
25814 | SM2212=-SM1112 | |
25815 | SM2221=-SM1121 | |
25816 | SM1221=-.5D0*((1D0-RTCM(29)**2)*SIN(2D0*RTCM(30))+ | |
25817 | & (1D0-RTCM(31)**2)*SIN(2D0*RTCM(32)))*RTCM(28)**2 | |
25818 | ||
25819 | C.........SH LOOP | |
25820 | ZTC(1,1)=DCMPLX(SH,0D0) | |
25821 | CALL PYWIDT(3100021,SH,WDTP,WDTE) | |
25822 | IF(WDTP(0).GT.RTCM(33)*SHR) WDTP(0)=RTCM(33)*SHR | |
25823 | ZTC(2,2)=DCMPLX(SH-PMAS(PYCOMP(3100021),1)**2,-SHR*WDTP(0)) | |
25824 | CALL PYWIDT(3100113,SH,WDTP,WDTE) | |
25825 | ZTC(3,3)=DCMPLX(SH-PMAS(PYCOMP(3100113),1)**2,-SHR*WDTP(0)) | |
25826 | CALL PYWIDT(3400113,SH,WDTP,WDTE) | |
25827 | ZTC(4,4)=DCMPLX(SH-PMAS(PYCOMP(3400113),1)**2,-SHR*WDTP(0)) | |
25828 | CALL PYWIDT(3200113,SH,WDTP,WDTE) | |
25829 | ZTC(5,5)=DCMPLX(SH-PMAS(PYCOMP(3200113),1)**2,-SHR*WDTP(0)) | |
25830 | CALL PYWIDT(3300113,SH,WDTP,WDTE) | |
25831 | ZTC(6,6)=DCMPLX(SH-PMAS(PYCOMP(3300113),1)**2,-SHR*WDTP(0)) | |
25832 | ZTC(1,2)=(0D0,0D0) | |
25833 | ZTC(1,3)=DCMPLX(SH*XIG,0D0) | |
25834 | ZTC(1,4)=ZTC(1,3) | |
25835 | ZTC(1,5)=ZTC(1,2) | |
25836 | ZTC(1,6)=ZTC(1,2) | |
25837 | ZTC(2,3)=DCMPLX(SH*XIG*X11,0D0) | |
25838 | ZTC(2,4)=DCMPLX(SH*XIG*X22,0D0) | |
25839 | ZTC(2,5)=DCMPLX(SH*XIG*X12,0D0) | |
25840 | ZTC(2,6)=DCMPLX(SH*XIG*X21,0D0) | |
25841 | ZTC(3,4)=-SM1122 | |
25842 | ZTC(3,5)=-SM1112 | |
25843 | ZTC(3,6)=-SM1121 | |
25844 | ZTC(4,5)=-SM2212 | |
25845 | ZTC(4,6)=-SM2221 | |
25846 | ZTC(5,6)=-SM1221 | |
25847 | ||
25848 | DO 110 I=1,5 | |
25849 | DO 100 J=I+1,6 | |
25850 | ZTC(J,I)=ZTC(I,J) | |
25851 | 100 CONTINUE | |
25852 | 110 CONTINUE | |
25853 | CALL PYLDCM(ZTC,6,6,INDX,D) | |
25854 | DO 130 I=1,6 | |
25855 | DO 120 J=1,6 | |
25856 | YTC(I,J)=(0D0,0D0) | |
25857 | IF(I.EQ.J) YTC(I,J)=(1D0,0D0) | |
25858 | 120 CONTINUE | |
25859 | 130 CONTINUE | |
25860 | ||
25861 | DO 140 I=1,6 | |
25862 | CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I)) | |
25863 | 140 CONTINUE | |
25864 | DGGS=YTC(1,1) | |
25865 | DVVS=YTC(2,2) | |
25866 | DGVS=YTC(1,2) | |
25867 | ||
25868 | XIG=SQRT(PYALPS(-TH)/ALPRHT) | |
25869 | C.........TH LOOP | |
25870 | ZTC(1,1)=DCMPLX(TH) | |
25871 | ZTC(2,2)=DCMPLX(TH-PMAS(PYCOMP(3100021),1)**2) | |
25872 | ZTC(3,3)=DCMPLX(TH-PMAS(PYCOMP(3100113),1)**2) | |
25873 | ZTC(4,4)=DCMPLX(TH-PMAS(PYCOMP(3400113),1)**2) | |
25874 | ZTC(5,5)=DCMPLX(TH-PMAS(PYCOMP(3200113),1)**2) | |
25875 | ZTC(6,6)=DCMPLX(TH-PMAS(PYCOMP(3300113),1)**2) | |
25876 | ZTC(1,2)=(0D0,0D0) | |
25877 | ZTC(1,3)=DCMPLX(TH*XIG,0D0) | |
25878 | ZTC(1,4)=ZTC(1,3) | |
25879 | ZTC(1,5)=ZTC(1,2) | |
25880 | ZTC(1,6)=ZTC(1,2) | |
25881 | ZTC(2,3)=DCMPLX(TH*XIG*X11,0D0) | |
25882 | ZTC(2,4)=DCMPLX(TH*XIG*X22,0D0) | |
25883 | ZTC(2,5)=DCMPLX(TH*XIG*X12,0D0) | |
25884 | ZTC(2,6)=DCMPLX(TH*XIG*X21,0D0) | |
25885 | ZTC(3,4)=-SM1122 | |
25886 | ZTC(3,5)=-SM1112 | |
25887 | ZTC(3,6)=-SM1121 | |
25888 | ZTC(4,5)=-SM2212 | |
25889 | ZTC(4,6)=-SM2221 | |
25890 | ZTC(5,6)=-SM1221 | |
25891 | DO 160 I=1,5 | |
25892 | DO 150 J=I+1,6 | |
25893 | ZTC(J,I)=ZTC(I,J) | |
25894 | 150 CONTINUE | |
25895 | 160 CONTINUE | |
25896 | CALL PYLDCM(ZTC,6,6,INDX,D) | |
25897 | DO 180 I=1,6 | |
25898 | DO 170 J=1,6 | |
25899 | YTC(I,J)=(0D0,0D0) | |
25900 | IF(I.EQ.J) YTC(I,J)=(1D0,0D0) | |
25901 | 170 CONTINUE | |
25902 | 180 CONTINUE | |
25903 | DO 190 I=1,6 | |
25904 | CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I)) | |
25905 | 190 CONTINUE | |
25906 | DGGT=YTC(1,1) | |
25907 | DVVT=YTC(2,2) | |
25908 | DGVT=YTC(1,2) | |
25909 | ||
25910 | XIG=SQRT(PYALPS(-UH)/ALPRHT) | |
25911 | C.........UH LOOP | |
25912 | ZTC(1,1)=DCMPLX(UH,0D0) | |
25913 | ZTC(2,2)=DCMPLX(UH-PMAS(PYCOMP(3100021),1)**2) | |
25914 | ZTC(3,3)=DCMPLX(UH-PMAS(PYCOMP(3100113),1)**2) | |
25915 | ZTC(4,4)=DCMPLX(UH-PMAS(PYCOMP(3400113),1)**2) | |
25916 | ZTC(5,5)=DCMPLX(UH-PMAS(PYCOMP(3200113),1)**2) | |
25917 | ZTC(6,6)=DCMPLX(UH-PMAS(PYCOMP(3300113),1)**2) | |
25918 | ZTC(1,2)=(0D0,0D0) | |
25919 | ZTC(1,3)=DCMPLX(UH*XIG,0D0) | |
25920 | ZTC(1,4)=ZTC(1,3) | |
25921 | ZTC(1,5)=ZTC(1,2) | |
25922 | ZTC(1,6)=ZTC(1,2) | |
25923 | ZTC(2,3)=DCMPLX(UH*XIG*X11,0D0) | |
25924 | ZTC(2,4)=DCMPLX(UH*XIG*X22,0D0) | |
25925 | ZTC(2,5)=DCMPLX(UH*XIG*X12,0D0) | |
25926 | ZTC(2,6)=DCMPLX(UH*XIG*X21,0D0) | |
25927 | ZTC(3,4)=-SM1122 | |
25928 | ZTC(3,5)=-SM1112 | |
25929 | ZTC(3,6)=-SM1121 | |
25930 | ZTC(4,5)=-SM2212 | |
25931 | ZTC(4,6)=-SM2221 | |
25932 | ZTC(5,6)=-SM1221 | |
25933 | DO 210 I=1,5 | |
25934 | DO 200 J=I+1,6 | |
25935 | ZTC(J,I)=ZTC(I,J) | |
25936 | 200 CONTINUE | |
25937 | 210 CONTINUE | |
25938 | CALL PYLDCM(ZTC,6,6,INDX,D) | |
25939 | DO 230 I=1,6 | |
25940 | DO 220 J=1,6 | |
25941 | YTC(I,J)=(0D0,0D0) | |
25942 | IF(I.EQ.J) YTC(I,J)=(1D0,0D0) | |
25943 | 220 CONTINUE | |
25944 | 230 CONTINUE | |
25945 | DO 240 I=1,6 | |
25946 | CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I)) | |
25947 | 240 CONTINUE | |
25948 | DGGU=YTC(1,1) | |
25949 | DVVU=YTC(2,2) | |
25950 | DGVU=YTC(1,2) | |
25951 | ||
25952 | IF(IMDL.EQ.1) THEN | |
25953 | DQQS=DGGS+DVVS*DCMPLX(TANT3**2)-DGVS*DCMPLX(2D0*TANT3) | |
25954 | DQQT=DGGT+DVVT*DCMPLX(TANT3**2)-DGVT*DCMPLX(2D0*TANT3) | |
25955 | DQQU=DGGU+DVVU*DCMPLX(TANT3**2)-DGVU*DCMPLX(2D0*TANT3) | |
25956 | DQTS=DGGS-DVVS-DGVS*DCMPLX(TANT3-1D0/TANT3) | |
25957 | DQGS=DGGS-DGVS*DCMPLX(TANT3) | |
25958 | DTGS=DGGS+DGVS*DCMPLX(1D0/TANT3) | |
25959 | ELSE | |
25960 | DQQS=DGGS+DVVS*DCMPLX(1D0/TANT3**2)+DGVS*DCMPLX(2D0/TANT3) | |
25961 | DQQT=DGGT+DVVT*DCMPLX(1D0/TANT3**2)+DGVT*DCMPLX(2D0/TANT3) | |
25962 | DQQU=DGGU+DVVU*DCMPLX(1D0/TANT3**2)+DGVU*DCMPLX(2D0/TANT3) | |
25963 | DQTS=DGGS+DVVS*DCMPLX(1D0/TANT3**2)+DGVS*DCMPLX(2D0/TANT3) | |
25964 | DQGS=DGGS+DGVS*DCMPLX(1D0/TANT3) | |
25965 | DTGS=DGGS+DGVS*DCMPLX(1D0/TANT3) | |
25966 | ENDIF | |
25967 | ||
25968 | SQDQTS=ABS(DQTS)**2 | |
25969 | SQDQQS=ABS(DQQS)**2 | |
25970 | SQDQQT=ABS(DQQT)**2 | |
25971 | SQDQQU=ABS(DQQU)**2 | |
25972 | SQDLGS=ABS(DCMPLX(SH)*DQGS-DCMPLX(1D0))**2 | |
25973 | REDLGS=DBLE(DQGS) | |
25974 | SQDHGS=ABS(DCMPLX(SH)*DTGS-DCMPLX(1D0))**2 | |
25975 | REDHGS=DBLE(DTGS) | |
25976 | SQDLGT=ABS(DCMPLX(TH)*DGGT-DCMPLX(1D0))**2 | |
25977 | ||
25978 | SQDGGS=ABS(DGGS)**2 | |
25979 | SQDGGT=ABS(DGGT)**2 | |
25980 | SQDGGU=ABS(DGGU)**2 | |
25981 | REDGGS=DBLE(DGGS) | |
25982 | REDGGT=DBLE(DGGT) | |
25983 | REDGGU=DBLE(DGGU) | |
25984 | REDGTU=DBLE(DGGU*DCONJG(DGGT)) | |
25985 | REDGSU=DBLE(DGGU*DCONJG(DGGS)) | |
25986 | REDGST=DBLE(DGGS*DCONJG(DGGT)) | |
25987 | REDQST=DBLE(DQQS*DCONJG(DQQT)) | |
25988 | REDQTU=DBLE(DQQT*DCONJG(DQQU)) | |
25989 | ENDIF | |
25990 | ENDIF | |
25991 | ||
25992 | ||
25993 | C...Differential cross section expressions. | |
25994 | ||
25995 | IF(ISUB.LE.190) THEN | |
25996 | IF(ISUB.EQ.149) THEN | |
25997 | C...g + g -> eta_tc | |
25998 | KCTC=PYCOMP(KTECHN+331) | |
25999 | CALL PYWIDT(KTECHN+331,SH,WDTP,WDTE) | |
26000 | HS=SHR*WDTP(0) | |
26001 | FACBW=COMFAC*0.5D0/((SH-PMAS(KCTC,1)**2)**2+HS**2) | |
26002 | IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 | |
26003 | HP=SH | |
26004 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 250 | |
26005 | HI=HP*WDTP(3) | |
26006 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
26007 | NCHN=NCHN+1 | |
26008 | ISIG(NCHN,1)=21 | |
26009 | ISIG(NCHN,2)=21 | |
26010 | ISIG(NCHN,3)=1 | |
26011 | SIGH(NCHN)=HI*FACBW*HF | |
26012 | 250 CONTINUE | |
26013 | ||
26014 | ELSEIF(ISUB.EQ.165) THEN | |
26015 | C...q + qbar -> l+ + l- (including contact term for compositeness) | |
26016 | ZRATR=XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) | |
26017 | ZRATI=XWC*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) | |
26018 | KFF=IABS(KFPR(ISUB,1)) | |
26019 | EF=KCHG(KFF,1)/3D0 | |
26020 | AF=SIGN(1D0,EF+0.1D0) | |
26021 | VF=AF-4D0*EF*XWV | |
26022 | VALF=VF+AF | |
26023 | VARF=VF-AF | |
26024 | FCOF=1D0 | |
26025 | IF(KFF.LE.10) FCOF=3D0 | |
26026 | WID2=1D0 | |
26027 | IF(KFF.EQ.6) WID2=WIDS(6,1) | |
26028 | IF(KFF.EQ.7.OR.KFF.EQ.8) WID2=WIDS(KFF,1) | |
26029 | IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1) | |
26030 | DO 260 I=MMINA,MMAXA | |
26031 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 260 | |
26032 | EI=KCHG(IABS(I),1)/3D0 | |
26033 | AI=SIGN(1D0,EI+0.1D0) | |
26034 | VI=AI-4D0*EI*XWV | |
26035 | VALI=VI+AI | |
26036 | VARI=VI-AI | |
26037 | FCOI=1D0 | |
26038 | IF(IABS(I).LE.10) FCOI=FACA/3D0 | |
26039 | IF((ITCM(5).EQ.1.AND.IABS(I).LE.2).OR.ITCM(5).EQ.2) THEN | |
26040 | FGZA=(EI*EF+VALI*VALF*ZRATR+RTCM(42)*SH/ | |
26041 | & (AEM*RTCM(41)**2))**2+(VALI*VALF*ZRATI)**2+ | |
26042 | & (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2 | |
26043 | ELSE | |
26044 | FGZA=(EI*EF+VALI*VALF*ZRATR)**2+(VALI*VALF*ZRATI)**2+ | |
26045 | & (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2 | |
26046 | ENDIF | |
26047 | FGZB=(EI*EF+VALI*VARF*ZRATR)**2+(VALI*VARF*ZRATI)**2+ | |
26048 | & (EI*EF+VARI*VALF*ZRATR)**2+(VARI*VALF*ZRATI)**2 | |
26049 | FGZAB=AEM**2*(FGZA*UH2/SH2+FGZB*TH2/SH2) | |
26050 | IF((ITCM(5).EQ.3.AND.IABS(I).EQ.2).OR.(ITCM(5).EQ.4.AND. | |
26051 | & MOD(IABS(I),2).EQ.0)) FGZAB=FGZAB+SH2/(2D0*RTCM(41)**4) | |
26052 | NCHN=NCHN+1 | |
26053 | ISIG(NCHN,1)=I | |
26054 | ISIG(NCHN,2)=-I | |
26055 | ISIG(NCHN,3)=1 | |
26056 | SIGH(NCHN)=COMFAC*FCOI*FCOF*FGZAB*WID2 | |
26057 | 260 CONTINUE | |
26058 | ||
26059 | ELSEIF(ISUB.EQ.166) THEN | |
26060 | C...q + q'bar -> l + nu_l (including contact term for compositeness) | |
26061 | WFAC=(1D0/4D0)*(AEM/XW)**2*UH2/((SH-SQMW)**2+GMMW**2) | |
26062 | WCIFAC=WFAC+SH2/(4D0*RTCM(41)**4) | |
26063 | KFF=IABS(KFPR(ISUB,1)) | |
26064 | FCOF=1D0 | |
26065 | IF(KFF.LE.10) FCOF=3D0 | |
26066 | DO 280 I=MMIN1,MMAX1 | |
26067 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 280 | |
26068 | IA=IABS(I) | |
26069 | DO 270 J=MMIN2,MMAX2 | |
26070 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 270 | |
26071 | JA=IABS(J) | |
26072 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 270 | |
26073 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
26074 | & GOTO 270 | |
26075 | FCOI=1D0 | |
26076 | IF(IA.LE.10) FCOI=VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 | |
26077 | WID2=1D0 | |
26078 | IF((I.GT.0.AND.MOD(I,2).EQ.0).OR.(J.GT.0.AND. | |
26079 | & MOD(J,2).EQ.0)) THEN | |
26080 | IF(KFF.EQ.5) WID2=WIDS(6,2) | |
26081 | IF(KFF.EQ.7) WID2=WIDS(8,2)*WIDS(7,3) | |
26082 | IF(KFF.EQ.17) WID2=WIDS(18,2)*WIDS(17,3) | |
26083 | ELSE | |
26084 | IF(KFF.EQ.5) WID2=WIDS(6,3) | |
26085 | IF(KFF.EQ.7) WID2=WIDS(8,3)*WIDS(7,2) | |
26086 | IF(KFF.EQ.17) WID2=WIDS(18,3)*WIDS(17,2) | |
26087 | ENDIF | |
26088 | NCHN=NCHN+1 | |
26089 | ISIG(NCHN,1)=I | |
26090 | ISIG(NCHN,2)=J | |
26091 | ISIG(NCHN,3)=1 | |
26092 | SIGH(NCHN)=COMFAC*FCOI*FCOF*WFAC*WID2 | |
26093 | IF((ITCM(5).EQ.3.AND.IA.LE.2.AND.JA.LE.2).OR.ITCM(5).EQ.4) | |
26094 | & SIGH(NCHN)=COMFAC*FCOI*FCOF*WCIFAC*WID2 | |
26095 | 270 CONTINUE | |
26096 | 280 CONTINUE | |
26097 | ENDIF | |
26098 | ||
26099 | ELSEIF(ISUB.LE.200) THEN | |
26100 | IF(ISUB.EQ.191) THEN | |
26101 | C...q + qbar -> rho_tc0. | |
26102 | KCTC=PYCOMP(KTECHN+113) | |
26103 | SQMRHT=PMAS(KCTC,1)**2 | |
26104 | CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) | |
26105 | HS=SHR*WDTP(0) | |
26106 | FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2) | |
26107 | IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 | |
26108 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
26109 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
26110 | HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH) | |
26111 | XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) | |
26112 | BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) | |
26113 | BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) | |
26114 | DO 290 I=MMINA,MMAXA | |
26115 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 290 | |
26116 | IA=IABS(I) | |
26117 | EI=KCHG(IABS(I),1)/3D0 | |
26118 | AI=SIGN(1D0,EI+0.1D0) | |
26119 | VI=AI-4D0*EI*XWV | |
26120 | VALI=0.5D0*(VI+AI) | |
26121 | VARI=0.5D0*(VI-AI) | |
26122 | HI=HP*((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ | |
26123 | & (EI+VARI*BWZR)**2+(VARI*BWZI)**2) | |
26124 | IF(IA.LE.10) HI=HI*FACA/3D0 | |
26125 | NCHN=NCHN+1 | |
26126 | ISIG(NCHN,1)=I | |
26127 | ISIG(NCHN,2)=-I | |
26128 | ISIG(NCHN,3)=1 | |
26129 | SIGH(NCHN)=HI*FACBW*HF | |
26130 | 290 CONTINUE | |
26131 | ||
26132 | ELSEIF(ISUB.EQ.192) THEN | |
26133 | C...q + qbar' -> rho_tc+/-. | |
26134 | KCTC=PYCOMP(KTECHN+213) | |
26135 | SQMRHT=PMAS(KCTC,1)**2 | |
26136 | CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) | |
26137 | HS=SHR*WDTP(0) | |
26138 | FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2) | |
26139 | IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 | |
26140 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
26141 | HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH)* | |
26142 | & (0.25D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2) | |
26143 | DO 310 I=MMIN1,MMAX1 | |
26144 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 310 | |
26145 | IA=IABS(I) | |
26146 | DO 300 J=MMIN2,MMAX2 | |
26147 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 300 | |
26148 | JA=IABS(J) | |
26149 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 300 | |
26150 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
26151 | & GOTO 300 | |
26152 | KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
26153 | HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHR)/2)+WDTE(0,4)) | |
26154 | HI=HP | |
26155 | IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 | |
26156 | NCHN=NCHN+1 | |
26157 | ISIG(NCHN,1)=I | |
26158 | ISIG(NCHN,2)=J | |
26159 | ISIG(NCHN,3)=1 | |
26160 | SIGH(NCHN)=HI*FACBW*HF | |
26161 | 300 CONTINUE | |
26162 | 310 CONTINUE | |
26163 | ||
26164 | ELSEIF(ISUB.EQ.193) THEN | |
26165 | C...q + qbar -> omega_tc0. | |
26166 | KCTC=PYCOMP(KTECHN+223) | |
26167 | SQMOMT=PMAS(KCTC,1)**2 | |
26168 | CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) | |
26169 | HS=SHR*WDTP(0) | |
26170 | FACBW=12D0*COMFAC/((SH-SQMOMT)**2+HS**2) | |
26171 | IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 | |
26172 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
26173 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
26174 | HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMOMT**2/SH)* | |
26175 | & (2D0*RTCM(2)-1D0)**2 | |
26176 | BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) | |
26177 | BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) | |
26178 | DO 320 I=MMINA,MMAXA | |
26179 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320 | |
26180 | IA=IABS(I) | |
26181 | EI=KCHG(IABS(I),1)/3D0 | |
26182 | AI=SIGN(1D0,EI+0.1D0) | |
26183 | VI=AI-4D0*EI*XWV | |
26184 | VALI=0.5D0*(VI+AI) | |
26185 | VARI=0.5D0*(VI-AI) | |
26186 | HI=HP*((EI-VALI*BWZR)**2+(VALI*BWZI)**2+ | |
26187 | & (EI-VARI*BWZR)**2+(VARI*BWZI)**2) | |
26188 | IF(IA.LE.10) HI=HI*FACA/3D0 | |
26189 | NCHN=NCHN+1 | |
26190 | ISIG(NCHN,1)=I | |
26191 | ISIG(NCHN,2)=-I | |
26192 | ISIG(NCHN,3)=1 | |
26193 | SIGH(NCHN)=HI*FACBW*HF | |
26194 | 320 CONTINUE | |
26195 | ||
26196 | ELSEIF(ISUB.EQ.194) THEN | |
26197 | C...f + fbar -> f' + fbar' via s-channel rho_tc and omega_tc. | |
26198 | KFA=KFPR(ISUBSV,1) | |
26199 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
26200 | HP=AEM**2*COMFAC | |
26201 | TANW=SQRT(PARU(102)/(1D0-PARU(102))) | |
26202 | CT2W=(1D0-2D0*PARU(102))/(2D0*PARU(102)/TANW) | |
26203 | ||
26204 | QUPD=2D0*RTCM(2)-1D0 | |
26205 | FAR=SQRT(AEM/ALPRHT) | |
26206 | FAO=FAR*QUPD | |
26207 | FZR=FAR*CT2W | |
26208 | FZO=-FAO*TANW | |
26209 | SFAR=FAR**2 | |
26210 | SFAO=FAO**2 | |
26211 | SFZR=FZR**2 | |
26212 | SFZO=FZO**2 | |
26213 | CALL PYWIDT(23,SH,WDTP,WDTE) | |
26214 | SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR) | |
26215 | CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) | |
26216 | SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR) | |
26217 | CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) | |
26218 | SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR) | |
26219 | DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO- | |
26220 | $ SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ | |
26221 | DAA=(-Sfzr*SSMO - Sfzo*SSMR + SSMO*SSMR*SSMZ)/DETD/SH | |
26222 | DZZ=(-Sfar*SSMO - Sfao*SSMR + SSMO*SSMR)/DETD/SH | |
26223 | DAZ=(far*fzr*SSMO + fao*fzo*SSMR)/DETD/SH | |
26224 | ||
26225 | XWRHT=1D0/(4D0*XW*(1D0-XW)) | |
26226 | KFF=IABS(KFPR(ISUB,1)) | |
26227 | EF=KCHG(KFF,1)/3D0 | |
26228 | AF=SIGN(1D0,EF+0.1D0) | |
26229 | VF=AF-4D0*EF*XWV | |
26230 | VALF=0.5D0*(VF+AF) | |
26231 | VARF=0.5D0*(VF-AF) | |
26232 | FCOF=1D0 | |
26233 | IF(KFF.LE.10) FCOF=3D0 | |
26234 | ||
26235 | WID2=1D0 | |
26236 | IF(KFF.GE.6.AND.KFF.LE.8) WID2=WIDS(KFF,1) | |
26237 | IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1) | |
26238 | DZZ=DZZ*DCMPLX(XWRHT,0D0) | |
26239 | DAZ=DAZ*DCMPLX(SQRT(XWRHT),0D0) | |
26240 | ||
26241 | DO 330 I=MMINA,MMAXA | |
26242 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 330 | |
26243 | EI=KCHG(IABS(I),1)/3D0 | |
26244 | AI=SIGN(1D0,EI+0.1D0) | |
26245 | VI=AI-4D0*EI*XWV | |
26246 | VALI=0.5D0*(VI+AI) | |
26247 | VARI=0.5D0*(VI-AI) | |
26248 | FCOI=FCOF | |
26249 | IF(IABS(I).LE.10) FCOI=FCOI/3D0 | |
26250 | DIFLL=ABS(EI*EF*DAA+VALI*VALF*DZZ+DAZ*(EI*VALF+EF*VALI))**2 | |
26251 | DIFRR=ABS(EI*EF*DAA+VARI*VARF*DZZ+DAZ*(EI*VARF+EF*VARI))**2 | |
26252 | DIFLR=ABS(EI*EF*DAA+VALI*VARF*DZZ+DAZ*(EI*VARF+EF*VALI))**2 | |
26253 | DIFRL=ABS(EI*EF*DAA+VARI*VALF*DZZ+DAZ*(EI*VALF+EF*VARI))**2 | |
26254 | FACSIG=(DIFLL+DIFRR)*((UH-SQM4)**2+SH*SQM4)+ | |
26255 | & (DIFLR+DIFRL)*((TH-SQM3)**2+SH*SQM3) | |
26256 | NCHN=NCHN+1 | |
26257 | ISIG(NCHN,1)=I | |
26258 | ISIG(NCHN,2)=-I | |
26259 | ISIG(NCHN,3)=1 | |
26260 | SIGH(NCHN)=HP*FCOI*FACSIG*WID2 | |
26261 | 330 CONTINUE | |
26262 | ||
26263 | ELSEIF(ISUB.EQ.195) THEN | |
26264 | C...f + fbar' -> f'' + fbar''' via s-channel rho_tc+ | |
26265 | KFA=KFPR(ISUBSV,1) | |
26266 | KFB=KFA+1 | |
26267 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
26268 | FACTC=COMFAC*(AEM**2/12D0/XW**2)*(UH-SQM3)*(UH-SQM4)*3D0 | |
26269 | ||
26270 | FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW)) | |
26271 | CALL PYWIDT(24,SH,WDTP,WDTE) | |
26272 | SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR) | |
26273 | CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) | |
26274 | SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR) | |
26275 | ||
26276 | FCOF=1D0 | |
26277 | IF(KFA.LE.8) FCOF=3D0 | |
26278 | DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0) | |
26279 | HP=FACTC*ABS(SSMR/DETD)**2/SH**2*FCOF | |
26280 | ||
26281 | DO 350 I=MMIN1,MMAX1 | |
26282 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 350 | |
26283 | IA=IABS(I) | |
26284 | DO 340 J=MMIN2,MMAX2 | |
26285 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 340 | |
26286 | JA=IABS(J) | |
26287 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 340 | |
26288 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
26289 | & GOTO 340 | |
26290 | KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
26291 | HI=HP | |
26292 | IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0 | |
26293 | NCHN=NCHN+1 | |
26294 | ISIG(NCHN,1)=I | |
26295 | ISIG(NCHN,2)=J | |
26296 | ISIG(NCHN,3)=1 | |
26297 | SIGH(NCHN)=HI*WIDS(KFA,(5-KCHR)/2)*WIDS(KFB,(5+KCHR)/2) | |
26298 | 340 CONTINUE | |
26299 | 350 CONTINUE | |
26300 | ENDIF | |
26301 | ||
26302 | ELSEIF(ISUB.LE.380) THEN | |
26303 | IF(ISUB.EQ.361) THEN | |
26304 | C...f + fbar -> W_L W_L, W_L pi_tc, pi_tc pi_tc | |
26305 | FACA=(SH**2*BE34**2-(TH-UH)**2) | |
26306 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
26307 | HP=(1D0/12D0)*AEM**2*CAB2*COMFAC*FACA*3D0 | |
26308 | FAR=SQRT(AEM/ALPRHT) | |
26309 | FAO=FAR*QUPD | |
26310 | FZR=FAR*CT2W | |
26311 | FZO=-FAO*TANW | |
26312 | SFAR=FAR**2 | |
26313 | SFAO=FAO**2 | |
26314 | SFZR=FZR**2 | |
26315 | SFZO=FZO**2 | |
26316 | CALL PYWIDT(23,SH,WDTP,WDTE) | |
26317 | SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR) | |
26318 | CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) | |
26319 | SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR) | |
26320 | CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) | |
26321 | SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR) | |
26322 | DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO- | |
26323 | $ SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ | |
26324 | DARHO=-(-FAR*SFZO+FAO*FZO*FZR+FAR*SSMO*SSMZ)/DETD/SH | |
26325 | DZRHO=-(-FZR*SFAO+FAO*FZO*FAR+FZR*SSMO)/DETD/SH | |
26326 | DAA=-(SFZO*SSMR+SFZR*SSMO-SSMO*SSMR*SSMZ)/DETD/SH | |
26327 | DZZ=-(SFAO*SSMR+SFAR*SSMO-SSMO*SSMR)/DETD/SH | |
26328 | DAZ=(FAR*FZR*SSMO+FAO*FZO*SSMR)/DETD/SH | |
26329 | ||
26330 | DO 360 I=MMINA,MMAXA | |
26331 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 360 | |
26332 | IA=IABS(I) | |
26333 | EI=KCHG(IABS(I),1)/3D0 | |
26334 | AI=SIGN(1D0,EI+0.1D0) | |
26335 | VI=AI-4D0*EI*XWV | |
26336 | VALI=0.25D0*(VI+AI) | |
26337 | VARI=0.25D0*(VI-AI) | |
26338 | F2L=EI*(DARHO/FAR+DAA+CT2W*DAZ)+ | |
26339 | $ VALI*(CT2W*DZRHO/FZR+CT2W*DZZ+DAZ)/SQRT(XW*XW1) | |
26340 | F2R=EI*(DARHO/FAR+DAA+CT2W*DAZ)+ | |
26341 | $ VARI*(CT2W*DZRHO/FZR+CT2W*DZZ+DAZ)/SQRT(XW*XW1) | |
26342 | HI=ABS(F2L)**2+ABS(F2R)**2 | |
26343 | IF(IA.LE.10) HI=HI/3D0 | |
26344 | NCHN=NCHN+1 | |
26345 | ISIG(NCHN,1)=I | |
26346 | ISIG(NCHN,2)=-I | |
26347 | ISIG(NCHN,3)=1 | |
26348 | IF(KFA.EQ.KFB) THEN | |
26349 | SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),1) | |
26350 | ELSE | |
26351 | SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),3) | |
26352 | NCHN=NCHN+1 | |
26353 | ISIG(NCHN,1)=I | |
26354 | ISIG(NCHN,2)=-I | |
26355 | ISIG(NCHN,3)=2 | |
26356 | SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),3)*WIDS(PYCOMP(KFB),2) | |
26357 | ENDIF | |
26358 | 360 CONTINUE | |
26359 | ||
26360 | ELSEIF(ISUB.EQ.364) THEN | |
26361 | C...f + fbar -> gamma pi_tc, gamma pi_tc', Z pi_tc, Z pi_tc', | |
26362 | C...W pi_tc | |
26363 | VFAC=(TH**2+UH**2-2D0*SQM3*SQM4) | |
26364 | AFAC=(TH**2+UH**2-2D0*SQM3*SQM4+4D0*SH*SQM3) | |
26365 | FANOM=SQRT(PARU(1)*AEM)*ITCM(1)/PARU(2)**2/RTCM(1) | |
26366 | ||
26367 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
26368 | HP=(1D0/24D0)*AEM**2*COMFAC*3D0*SH | |
26369 | FAR=SQRT(AEM/ALPRHT) | |
26370 | FAO=FAR*QUPD | |
26371 | FZR=FAR*CT2W | |
26372 | FZO=-FAO*TANW | |
26373 | SFAR=FAR**2 | |
26374 | SFAO=FAO**2 | |
26375 | SFZR=FZR**2 | |
26376 | SFZO=FZO**2 | |
26377 | CALL PYWIDT(23,SH,WDTP,WDTE) | |
26378 | SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR) | |
26379 | CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) | |
26380 | SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR) | |
26381 | CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) | |
26382 | SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR) | |
26383 | DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO- | |
26384 | $ SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ | |
26385 | DARHO=(-FAR*SFZO+FAO*FZO*FZR+FAR*SSMO*SSMZ)/DETD/SH | |
26386 | DZRHO=(-FZR*SFAO+FAO*FZO*FAR+FZR*SSMO)/DETD/SH | |
26387 | DAOME=(-FAO*SFZR+FAR*FZO*FZR+FAO*SSMR*SSMZ)/DETD/SH | |
26388 | DZOME=(-FZO*SFAR+FAR*FAO*FZR+FZO*SSMR)/DETD/SH | |
26389 | DAA=(SFZO*SSMR+SFZR*SSMO-SSMO*SSMR*SSMZ)/DETD/SH | |
26390 | DZZ=(SFAO*SSMR+SFAR*SSMO-SSMO*SSMR)/DETD/SH | |
26391 | DAZ=(FAR*FZR*SSMO+FAO*FZO*SSMR)/DETD/SH | |
26392 | ||
26393 | DO 370 I=MMINA,MMAXA | |
26394 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 370 | |
26395 | IA=IABS(I) | |
26396 | EI=KCHG(IABS(I),1)/3D0 | |
26397 | AI=SIGN(1D0,EI+0.1D0) | |
26398 | VI=AI-4D0*EI*XWV | |
26399 | VALI=0.25D0*(VI+AI) | |
26400 | VARI=0.25D0*(VI-AI) | |
26401 | C...........Add in anomaly contribution | |
26402 | F2L=(EI*DARHO+VALI*DZRHO/SQRT(XW*XW1))*VRGP | |
26403 | F2L=F2L+(EI*DAOME+VALI*DZOME/SQRT(XW*XW1))*VOGP | |
26404 | F2L=F2L+FANOM*(VAGP*(EI*DAA+VALI*DAZ/SQRT(XW*XW1))+ | |
26405 | $ VZGP*(EI*DAZ+VALI*DZZ/SQRT(XW*XW1))) | |
26406 | F2R=(EI*DARHO+VARI*DZRHO/SQRT(XW*XW1))*VRGP | |
26407 | F2R=F2R+(EI*DAOME+VARI*DZOME/SQRT(XW*XW1))*VOGP | |
26408 | F2R=F2R+FANOM*(VAGP*(EI*DAA+VARI*DAZ/SQRT(XW*XW1))+ | |
26409 | $ VZGP*(EI*DAZ+VARI*DZZ/SQRT(XW*XW1))) | |
26410 | HI=(ABS(F2L)**2+ABS(F2R)**2)*VFAC | |
26411 | F2L=(EI*DARHO+VALI*DZRHO/SQRT(XW*XW1))*ARGP | |
26412 | F2L=F2L+(EI*DAOME+VALI*DZOME/SQRT(XW*XW1))*AOGP | |
26413 | F2R=(EI*DARHO+VARI*DZRHO/SQRT(XW*XW1))*ARGP | |
26414 | F2R=F2R+(EI*DAOME+VARI*DZOME/SQRT(XW*XW1))*AOGP | |
26415 | HJ=(ABS(F2L)**2+ABS(F2R)**2)*AFAC | |
26416 | HI=HI+HJ | |
26417 | IF(IA.LE.10) HI=HI/3D0 | |
26418 | NCHN=NCHN+1 | |
26419 | ISIG(NCHN,1)=I | |
26420 | ISIG(NCHN,2)=-I | |
26421 | ISIG(NCHN,3)=1 | |
26422 | IF(ISUBSV.NE.368) THEN | |
26423 | SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),2) | |
26424 | ELSE | |
26425 | SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),3) | |
26426 | NCHN=NCHN+1 | |
26427 | ISIG(NCHN,1)=I | |
26428 | ISIG(NCHN,2)=-I | |
26429 | ISIG(NCHN,3)=2 | |
26430 | SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),3)*WIDS(PYCOMP(KFB),2) | |
26431 | ENDIF | |
26432 | 370 CONTINUE | |
26433 | ||
26434 | ELSEIF(ISUB.EQ.370) THEN | |
26435 | C...f + fbar' -> W_L Z_L, W_L pi_tc, Z_L pi_tc, pi_tc pi_tc | |
26436 | ||
26437 | FACA=(SH**2*BE34**2-(TH-UH)**2) | |
26438 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
26439 | HP=(1D0/96D0)*AEM**2*CAB2*COMFAC*FACA*3D0/XW**2 | |
26440 | FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW)) | |
26441 | CALL PYWIDT(24,SH,WDTP,WDTE) | |
26442 | SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR) | |
26443 | CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) | |
26444 | SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR) | |
26445 | DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0) | |
26446 | DWW=SSMR/DETD/SH | |
26447 | DWRHO=-1D0/DETD/SH | |
26448 | HP=HP*ABS(DWW+DWRHO)**2 | |
26449 | DO 390 I=MMIN1,MMAX1 | |
26450 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 390 | |
26451 | IA=IABS(I) | |
26452 | DO 380 J=MMIN2,MMAX2 | |
26453 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 380 | |
26454 | JA=IABS(J) | |
26455 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 380 | |
26456 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
26457 | & GOTO 380 | |
26458 | KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
26459 | HI=HP | |
26460 | IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0 | |
26461 | NCHN=NCHN+1 | |
26462 | ISIG(NCHN,1)=I | |
26463 | ISIG(NCHN,2)=J | |
26464 | ISIG(NCHN,3)=1 | |
26465 | SIGH(NCHN)=HI*WIDS(PYCOMP(KFA),(5-KCHR)/2)* | |
26466 | & WIDS(PYCOMP(KFB),2) | |
26467 | 380 CONTINUE | |
26468 | 390 CONTINUE | |
26469 | ||
26470 | ELSEIF(ISUB.EQ.374) THEN | |
26471 | C...f + fbar' -> gamma pi_tc | |
26472 | FANOM=SQRT(AEM)*ITCM(1)/2D0/PARU(2)/RTCM(1) | |
26473 | VFAC=(TH**2+UH**2-2D0*SQM3*SQM4) | |
26474 | AFAC=(TH**2+UH**2-2D0*SQM3*SQM4+4D0*SH*SQM3)/SQTA*ARGP**2 | |
26475 | ALPRHT=2.91D0*(3D0/ITCM(1)) | |
26476 | HP=(1D0/48D0)*AEM**2/XW*COMFAC*3D0*SH | |
26477 | FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW)) | |
26478 | CALL PYWIDT(24,SH,WDTP,WDTE) | |
26479 | SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR) | |
26480 | CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) | |
26481 | SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR) | |
26482 | DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0) | |
26483 | DWW=SSMR/DETD/SH | |
26484 | DWRHO=-DCMPLX(FWR,0D0)/DETD/SH | |
26485 | HP=HP*(AFAC*ABS(DWRHO)**2+ | |
26486 | $ VFAC*ABS(FANOM*DWW*VWGP+DWRHO*VRGP/SQRT(SQTV))**2) | |
26487 | DO 410 I=MMIN1,MMAX1 | |
26488 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 410 | |
26489 | IA=IABS(I) | |
26490 | DO 400 J=MMIN2,MMAX2 | |
26491 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 400 | |
26492 | JA=IABS(J) | |
26493 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400 | |
26494 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
26495 | & GOTO 400 | |
26496 | KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
26497 | HI=HP | |
26498 | IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0 | |
26499 | NCHN=NCHN+1 | |
26500 | ISIG(NCHN,1)=I | |
26501 | ISIG(NCHN,2)=J | |
26502 | ISIG(NCHN,3)=1 | |
26503 | SIGH(NCHN)=HI*WIDS(PYCOMP(KFA),(5-KCHR)/2)* | |
26504 | & WIDS(PYCOMP(KFB),2) | |
26505 | 400 CONTINUE | |
26506 | 410 CONTINUE | |
26507 | ENDIF | |
26508 | ||
26509 | ELSEIF(ISUB.LE.390) THEN | |
26510 | IF(ISUB.EQ.381) THEN | |
26511 | C...f + f' -> f + f' (g exchange) | |
26512 | FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)*SQDQQT | |
26513 | FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)*SQDQQT*FACA- | |
26514 | & MSTP(34)*2D0/3D0*UH2*REDQST) | |
26515 | FACQQ2=COMFAC*AS**2*4D0/9D0*(SH2+TH2)*SQDQQU | |
26516 | FACQQI=-COMFAC*AS**2*4D0/9D0*MSTP(34)*2D0/3D0*SH2/(TH*UH) | |
26517 | RATQQI=(FACQQ1+FACQQ2+FACQQI)/(FACQQ1+FACQQ2) | |
26518 | IF(ITCM(5).GE.1.AND.ITCM(5).LE.4) THEN | |
26519 | C...Modifications from contact interactions (compositeness) | |
26520 | FACCI1=FACQQ1+COMFAC*(SH2/RTCM(41)**4) | |
26521 | FACCIB=FACQQB+COMFAC*(8D0/9D0)*(AS*RTCM(42)/RTCM(41)**2)* | |
26522 | & (UH2/TH+UH2/SH)+COMFAC*(5D0/3D0)*(UH2/RTCM(41)**4) | |
26523 | FACCI2=FACQQ2+COMFAC*(8D0/9D0)*(AS*RTCM(42)/RTCM(41)**2)* | |
26524 | & (SH2/TH+SH2/UH)+COMFAC*(5D0/3D0)*(SH2/RTCM(41)**4) | |
26525 | FACCI3=FACQQ1+COMFAC*(UH2/RTCM(41)**4) | |
26526 | RATCII=(FACCI1*FACCI2+FACQQI)/(FACCI1+FACCI2) | |
26527 | ELSEIF(ITCM(5).EQ.5) THEN | |
26528 | FACCI1=FACQQ1 | |
26529 | FACCIB=FACQQB | |
26530 | FACCI2=FACQQ2 | |
26531 | FACCI3=FACQQ1 | |
26532 | CSM.......Check this change from | |
26533 | CSM RATCII=1D0 | |
26534 | RATCII=RATQQI | |
26535 | ENDIF | |
26536 | DO 430 I=MMIN1,MMAX1 | |
26537 | IA=IABS(I) | |
26538 | IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 430 | |
26539 | DO 420 J=MMIN2,MMAX2 | |
26540 | JA=IABS(J) | |
26541 | IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 420 | |
26542 | NCHN=NCHN+1 | |
26543 | ISIG(NCHN,1)=I | |
26544 | ISIG(NCHN,2)=J | |
26545 | ISIG(NCHN,3)=1 | |
26546 | IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.(IA.GE.3.OR. | |
26547 | & JA.GE.3))) THEN | |
26548 | SIGH(NCHN)=FACQQ1 | |
26549 | IF(I.EQ.-J) SIGH(NCHN)=FACQQB | |
26550 | ELSE | |
26551 | SIGH(NCHN)=FACCI1 | |
26552 | IF(I*J.LT.0) SIGH(NCHN)=FACCI3 | |
26553 | IF(I.EQ.-J) SIGH(NCHN)=FACCIB | |
26554 | ENDIF | |
26555 | IF(I.EQ.J) THEN | |
26556 | NCHN=NCHN+1 | |
26557 | ISIG(NCHN,1)=I | |
26558 | ISIG(NCHN,2)=J | |
26559 | ISIG(NCHN,3)=2 | |
26560 | IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.IA.GE.3)) THEN | |
26561 | SIGH(NCHN-1)=0.5D0*FACQQ1*RATQQI | |
26562 | SIGH(NCHN)=0.5D0*FACQQ2*RATQQI | |
26563 | ELSE | |
26564 | SIGH(NCHN-1)=0.5D0*FACCI1*RATCII | |
26565 | SIGH(NCHN)=0.5D0*FACCI2*RATCII | |
26566 | ENDIF | |
26567 | ENDIF | |
26568 | 420 CONTINUE | |
26569 | 430 CONTINUE | |
26570 | ||
26571 | ELSEIF(ISUB.EQ.382) THEN | |
26572 | C...f + fbar -> f' + fbar' (q + qbar -> q' + qbar' only) | |
26573 | CALL PYWIDT(21,SH,WDTP,WDTE) | |
26574 | FACQQF=COMFAC*AS**2*4D0/9D0*(TH2+UH2) | |
26575 | FACQQB=FACQQF*SQDQQS*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
26576 | IF(ITCM(5).EQ.1) THEN | |
26577 | C...Modifications from contact interactions (compositeness) | |
26578 | FACCIB=FACQQB | |
26579 | DO 440 I=1,2 | |
26580 | FACCIB=FACCIB+COMFAC*(UH2/RTCM(41)**4)*(WDTE(I,1)+ | |
26581 | & WDTE(I,2)+WDTE(I,4)) | |
26582 | 440 CONTINUE | |
26583 | ELSEIF(ITCM(5).GE.2.AND.ITCM(5).LE.4) THEN | |
26584 | FACCIB=FACQQB+COMFAC*(UH2/RTCM(41)**4)* | |
26585 | & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
26586 | ELSEIF(ITCM(5).EQ.5) THEN | |
26587 | FACQQB=FACQQF*SQDQQS*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)- | |
26588 | & WDTE(5,1)-WDTE(5,2)-WDTE(5,4)) | |
26589 | FACCIB=FACQQF*SQDQTS*(WDTE(5,1)+WDTE(5,2)+WDTE(5,4)) | |
26590 | ENDIF | |
26591 | DO 450 I=MMINA,MMAXA | |
26592 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
26593 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 450 | |
26594 | NCHN=NCHN+1 | |
26595 | ISIG(NCHN,1)=I | |
26596 | ISIG(NCHN,2)=-I | |
26597 | ISIG(NCHN,3)=1 | |
26598 | IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.IABS(I).GE.3)) THEN | |
26599 | SIGH(NCHN)=FACQQB | |
26600 | ELSEIF(ITCM(5).EQ.5) THEN | |
26601 | SIGH(NCHN)=FACQQB | |
26602 | NCHN=NCHN+1 | |
26603 | ISIG(NCHN,1)=I | |
26604 | ISIG(NCHN,2)=-I | |
26605 | ISIG(NCHN,3)=2 | |
26606 | SIGH(NCHN)=FACCIB | |
26607 | ELSE | |
26608 | SIGH(NCHN)=FACCIB | |
26609 | ENDIF | |
26610 | 450 CONTINUE | |
26611 | ||
26612 | ELSEIF(ISUB.EQ.383) THEN | |
26613 | C...f + fbar -> g + g (q + qbar -> g + g only) | |
26614 | FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* | |
26615 | & UH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS) | |
26616 | FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* | |
26617 | & TH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS) | |
26618 | IF(ITCM(5).EQ.5) THEN | |
26619 | FACGG3=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* | |
26620 | & UH2/SH2+9D0/4D0*TH*UH/SH2*SQDHGS) | |
26621 | FACGG4=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* | |
26622 | & TH2/SH2+9D0/4D0*TH*UH/SH2*SQDHGS) | |
26623 | ENDIF | |
26624 | DO 460 I=MMINA,MMAXA | |
26625 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
26626 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 460 | |
26627 | NCHN=NCHN+1 | |
26628 | ISIG(NCHN,1)=I | |
26629 | ISIG(NCHN,2)=-I | |
26630 | ISIG(NCHN,3)=1 | |
26631 | SIGH(NCHN)=0.5D0*FACGG1 | |
26632 | IF(ITCM(5).EQ.5.AND.IABS(I).EQ.5) SIGH(NCHN)=0.5D0*FACGG3 | |
26633 | NCHN=NCHN+1 | |
26634 | ISIG(NCHN,1)=I | |
26635 | ISIG(NCHN,2)=-I | |
26636 | ISIG(NCHN,3)=2 | |
26637 | SIGH(NCHN)=0.5D0*FACGG2 | |
26638 | IF(ITCM(5).EQ.5.AND.IABS(I).EQ.5) SIGH(NCHN)=0.5D0*FACGG4 | |
26639 | 460 CONTINUE | |
26640 | ||
26641 | ELSEIF(ISUB.EQ.384) THEN | |
26642 | C...f + g -> f + g (q + g -> q + g only) | |
26643 | FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2- | |
26644 | & UH/SH-9D0/4D0*SH*UH/TH2*SQDLGT)*FACA | |
26645 | FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2- | |
26646 | & SH/UH-9D0/4D0*SH*UH/TH2*SQDLGT) | |
26647 | DO 480 I=MMINA,MMAXA | |
26648 | IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 480 | |
26649 | DO 470 ISDE=1,2 | |
26650 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 470 | |
26651 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 470 | |
26652 | NCHN=NCHN+1 | |
26653 | ISIG(NCHN,ISDE)=I | |
26654 | ISIG(NCHN,3-ISDE)=21 | |
26655 | ISIG(NCHN,3)=1 | |
26656 | SIGH(NCHN)=FACQG1 | |
26657 | NCHN=NCHN+1 | |
26658 | ISIG(NCHN,ISDE)=I | |
26659 | ISIG(NCHN,3-ISDE)=21 | |
26660 | ISIG(NCHN,3)=2 | |
26661 | SIGH(NCHN)=FACQG2 | |
26662 | 470 CONTINUE | |
26663 | 480 CONTINUE | |
26664 | ||
26665 | ELSEIF(ISUB.EQ.385) THEN | |
26666 | C...g + g -> f + fbar (g + g -> q + qbar only) | |
26667 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 500 | |
26668 | IDC0=MDCY(21,2)-1 | |
26669 | C...Begin by d, u, s flavours. | |
26670 | FLAVWT=0D0 | |
26671 | IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+ | |
26672 | & SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH)) | |
26673 | IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+ | |
26674 | & SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH)) | |
26675 | IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+ | |
26676 | & SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH)) | |
26677 | FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* | |
26678 | & UH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)*FLAVWT*FACA | |
26679 | FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* | |
26680 | & TH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)*FLAVWT*FACA | |
26681 | NCHN=NCHN+1 | |
26682 | ISIG(NCHN,1)=21 | |
26683 | ISIG(NCHN,2)=21 | |
26684 | ISIG(NCHN,3)=1 | |
26685 | SIGH(NCHN)=FACQQ1 | |
26686 | NCHN=NCHN+1 | |
26687 | ISIG(NCHN,1)=21 | |
26688 | ISIG(NCHN,2)=21 | |
26689 | ISIG(NCHN,3)=2 | |
26690 | SIGH(NCHN)=FACQQ2 | |
26691 | C...Next c and b flavours: modified that and uhat for fixed | |
26692 | C...cos(theta-hat). | |
26693 | DO 490 IFL=4,5 | |
26694 | SQMAVG=PMAS(IFL,1)**2 | |
26695 | IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN | |
26696 | BE34=SQRT(1D0-4D0*SQMAVG/SH) | |
26697 | THQ=-0.5D0*SH*(1D0-BE34*CTH) | |
26698 | UHQ=-0.5D0*SH*(1D0+BE34*CTH) | |
26699 | THUHQ=THQ*UHQ-SQMAVG*SH | |
26700 | IF(MSTP(34).EQ.0) THEN | |
26701 | FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 | |
26702 | FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 | |
26703 | ELSE | |
26704 | FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
26705 | & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) | |
26706 | FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
26707 | & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) | |
26708 | ENDIF | |
26709 | IF(ITCM(5).GE.5) THEN | |
26710 | IF(IFL.EQ.4) THEN | |
26711 | FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDLGS+ | |
26712 | & 2.25D0*THQ*UHQ/SH2*SQDLGS | |
26713 | FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDLGS+ | |
26714 | & 2.25D0*THQ*UHQ/SH2*SQDLGS | |
26715 | ELSE | |
26716 | FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDHGS+ | |
26717 | & 2.25D0*THQ*UHQ/SH2*SQDHGS | |
26718 | FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDHGS+ | |
26719 | & 2.25D0*THQ*UHQ/SH2*SQDHGS | |
26720 | ENDIF | |
26721 | ENDIF | |
26722 | FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34 | |
26723 | FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34 | |
26724 | NCHN=NCHN+1 | |
26725 | ISIG(NCHN,1)=21 | |
26726 | ISIG(NCHN,2)=21 | |
26727 | ISIG(NCHN,3)=1+2*(IFL-3) | |
26728 | SIGH(NCHN)=FACQQ1 | |
26729 | NCHN=NCHN+1 | |
26730 | ISIG(NCHN,1)=21 | |
26731 | ISIG(NCHN,2)=21 | |
26732 | ISIG(NCHN,3)=2+2*(IFL-3) | |
26733 | SIGH(NCHN)=FACQQ2 | |
26734 | ENDIF | |
26735 | 490 CONTINUE | |
26736 | 500 CONTINUE | |
26737 | ||
26738 | ELSEIF(ISUB.EQ.386) THEN | |
26739 | C...g + g -> g + g | |
26740 | IF(ITCM(5).LE.4) THEN | |
26741 | FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+ | |
26742 | & 2D0*TH/SH+TH2/SH2)*FACA | |
26743 | FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+ | |
26744 | & 2D0*SH/UH+SH2/UH2)*FACA | |
26745 | FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3D0+ | |
26746 | & 2D0*UH/TH+UH2/TH2) | |
26747 | ELSE | |
26748 | GST= (12D0 + 40D0*TH/SH + 56D0*TH2/SH2 + 32D0*TH**3/SH**3 + | |
26749 | & 16D0*TH**4/SH**4 + SQDGGS*(4D0*SH2 + 16D0*SH*TH + 16D0*TH2)+ | |
26750 | & 4D0*REDGST*(SH + 2D0*TH)* | |
26751 | & (2D0*SH**3 - 3D0*SH2*TH - 2D0*SH*TH2 + 2D0*TH**3)/SH2 + | |
26752 | & 2D0*REDGGS*(2D0*SH - 12D0*TH2/SH - 8D0*TH**3/SH2) + | |
26753 | & 2D0*REDGGT*(4D0*SH - 22D0*TH - 68D0*TH2/SH - 60D0*TH**3/SH2- | |
26754 | & 32D0*TH**4/SH**3 - 16D0*TH**5/SH**4) + | |
26755 | & SQDGGT*(16D0*SH2 + 16D0*SH*TH + 68D0*TH2 + 144D0*TH**3/SH + | |
26756 | & 96D0*TH**4/SH2 + 32D0*TH**5/SH**3 + 16D0*TH**6/SH**4))/16D0 | |
26757 | GSU= (12D0 + 40D0*UH/SH + 56D0*UH2/SH2 + 32D0*UH**3/SH**3 + | |
26758 | & 16D0*UH**4/SH**4 + SQDGGS*(4D0*SH2 + 16D0*SH*UH + 16D0*UH2)+ | |
26759 | & 4D0*REDGSU*(SH + 2D0*UH)* | |
26760 | & (2D0*SH**3 - 3D0*SH2*UH - 2D0*SH*UH2 + 2D0*UH**3)/SH2 + | |
26761 | & 2D0*REDGGS*(2D0*SH - 12D0*UH2/SH - 8D0*UH**3/SH2) + | |
26762 | & 2D0*REDGGU*(4D0*SH - 22D0*UH - 68D0*UH2/SH - 60D0*UH**3/SH2- | |
26763 | & 32D0*UH**4/SH**3 - 16D0*UH**5/SH**4) + | |
26764 | & SQDGGU*(16D0*SH2 + 16D0*SH*UH + 68D0*UH2 + 144D0*UH**3/SH + | |
26765 | & 96D0*UH**4/SH2 + 32D0*UH**5/SH**3 + 16D0*UH**6/SH**4))/16D0 | |
26766 | GUT= (12D0 - 16D0*TH*(TH - UH)**2*UH/SH**4 + | |
26767 | & 4D0*REDGGU*(2D0*TH**5 - 15D0*TH**4*UH - 48D0*TH**3*UH2 - | |
26768 | & 58D0*TH2*UH**3 - 10D0*TH*UH**4 + UH**5)/SH**4 + | |
26769 | & 4D0*REDGGT*(TH**5 - 10D0*TH**4*UH - 58D0*TH**3*UH2 - | |
26770 | & 48D0*TH2*UH**3 - 15D0*TH*UH**4 + 2D0*UH**5)/SH**4 + | |
26771 | & 4D0*SQDGGU*(4D0*TH**6 + 20D0*TH**5*UH + 57D0*TH**4*UH2 + | |
26772 | & 72D0*TH**3*UH**3+ 38D0*TH2*UH**4+4D0*TH*UH**5 +UH**6)/SH**4+ | |
26773 | & 4D0*SQDGGT*(4D0*UH**6 + 4D0*TH**5*UH + 38D0*TH**4*UH2 + | |
26774 | & 72D0*TH**3*UH**3 +57D0*TH2*UH**4+20D0*TH*UH**5+TH**6)/SH**4+ | |
26775 | & 2D0*REDGTU*((TH - UH)**2* (TH**4 + 20D0*TH**3*UH + | |
26776 | & 30D0*TH2*UH2 + 20D0*TH*UH**3 + UH**4) + | |
26777 | & SH2*(7D0*TH**4 + 52D0*TH**3*UH + 274D0*TH2*UH2 + | |
26778 | & 52D0*TH*UH**3 + 7D0*UH**4))/(2D0*SH**4))/16D0 | |
26779 | FACGG1=COMFAC*AS**2*9D0/4D0*GST*FACA | |
26780 | FACGG2=COMFAC*AS**2*9D0/4D0*GSU*FACA | |
26781 | FACGG3=COMFAC*AS**2*9D0/4D0*GUT | |
26782 | ENDIF | |
26783 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 510 | |
26784 | NCHN=NCHN+1 | |
26785 | ISIG(NCHN,1)=21 | |
26786 | ISIG(NCHN,2)=21 | |
26787 | ISIG(NCHN,3)=1 | |
26788 | SIGH(NCHN)=0.5D0*FACGG1 | |
26789 | NCHN=NCHN+1 | |
26790 | ISIG(NCHN,1)=21 | |
26791 | ISIG(NCHN,2)=21 | |
26792 | ISIG(NCHN,3)=2 | |
26793 | SIGH(NCHN)=0.5D0*FACGG2 | |
26794 | NCHN=NCHN+1 | |
26795 | ISIG(NCHN,1)=21 | |
26796 | ISIG(NCHN,2)=21 | |
26797 | ISIG(NCHN,3)=3 | |
26798 | SIGH(NCHN)=0.5D0*FACGG3 | |
26799 | 510 CONTINUE | |
26800 | ||
26801 | ELSEIF(ISUB.EQ.387) THEN | |
26802 | C...q + qbar -> Q + Qbar | |
26803 | SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH | |
26804 | THQ=-0.5D0*SH*(1D0-BE34*CTH) | |
26805 | UHQ=-0.5D0*SH*(1D0+BE34*CTH) | |
26806 | FACQQB=COMFAC*AS**2*4D0/9D0*((THQ**2+UHQ**2)/SH2+ | |
26807 | & 2D0*SQMAVG/SH) | |
26808 | IF(ITCM(5).GE.5) THEN | |
26809 | IF(MINT(55).EQ.5.OR.MINT(55).EQ.6) THEN | |
26810 | FACQQB=FACQQB*SH2*SQDQTS | |
26811 | ELSE | |
26812 | FACQQB=FACQQB*SH2*SQDQQS | |
26813 | ENDIF | |
26814 | ENDIF | |
26815 | IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQMAVG,0D0) | |
26816 | WID2=1D0 | |
26817 | IF(MINT(55).EQ.6) WID2=WIDS(6,1) | |
26818 | IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) | |
26819 | FACQQB=FACQQB*WID2 | |
26820 | DO 520 I=MMINA,MMAXA | |
26821 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
26822 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 520 | |
26823 | NCHN=NCHN+1 | |
26824 | ISIG(NCHN,1)=I | |
26825 | ISIG(NCHN,2)=-I | |
26826 | ISIG(NCHN,3)=1 | |
26827 | SIGH(NCHN)=FACQQB | |
26828 | 520 CONTINUE | |
26829 | ||
26830 | ELSEIF(ISUB.EQ.388) THEN | |
26831 | C...g + g -> Q + Qbar | |
26832 | SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH | |
26833 | THQ=-0.5D0*SH*(1D0-BE34*CTH) | |
26834 | UHQ=-0.5D0*SH*(1D0+BE34*CTH) | |
26835 | THUHQ=THQ*UHQ-SQMAVG*SH | |
26836 | IF(MSTP(34).EQ.0) THEN | |
26837 | FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 | |
26838 | FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 | |
26839 | ELSE | |
26840 | FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
26841 | & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) | |
26842 | FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ | |
26843 | & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) | |
26844 | ENDIF | |
26845 | IF(ITCM(5).GE.5) THEN | |
26846 | IF(MINT(55).EQ.5.OR.MINT(55).EQ.6) THEN | |
26847 | FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDHGS+ | |
26848 | & 2.25D0*THQ*UHQ/SH2*SQDHGS | |
26849 | FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDHGS+ | |
26850 | & 2.25D0*THQ*UHQ/SH2*SQDHGS | |
26851 | ELSE | |
26852 | FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDLGS+ | |
26853 | & 2.25D0*THQ*UHQ/SH2*SQDLGS | |
26854 | FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDLGS+ | |
26855 | & 2.25D0*THQ*UHQ/SH2*SQDLGS | |
26856 | ENDIF | |
26857 | ENDIF | |
26858 | FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1 | |
26859 | FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2 | |
26860 | IF(MSTP(35).GE.1) THEN | |
26861 | FATRE=PYHFTH(SH,SQMAVG,2D0/7D0) | |
26862 | FACQQ1=FACQQ1*FATRE | |
26863 | FACQQ2=FACQQ2*FATRE | |
26864 | ENDIF | |
26865 | WID2=1D0 | |
26866 | IF(MINT(55).EQ.6) WID2=WIDS(6,1) | |
26867 | IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) | |
26868 | FACQQ1=FACQQ1*WID2 | |
26869 | FACQQ2=FACQQ2*WID2 | |
26870 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 530 | |
26871 | NCHN=NCHN+1 | |
26872 | ISIG(NCHN,1)=21 | |
26873 | ISIG(NCHN,2)=21 | |
26874 | ISIG(NCHN,3)=1 | |
26875 | SIGH(NCHN)=FACQQ1 | |
26876 | NCHN=NCHN+1 | |
26877 | ISIG(NCHN,1)=21 | |
26878 | ISIG(NCHN,2)=21 | |
26879 | ISIG(NCHN,3)=2 | |
26880 | SIGH(NCHN)=FACQQ2 | |
26881 | 530 CONTINUE | |
26882 | ENDIF | |
26883 | ENDIF | |
26884 | ||
26885 | CMRENNA-- | |
26886 | ||
26887 | RETURN | |
26888 | END | |
26889 | ||
26890 | C********************************************************************* | |
26891 | ||
26892 | C...PYSGEX | |
26893 | C...Subprocess cross sections for assorted exotic processes, | |
26894 | C...including Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*. | |
26895 | C...Auxiliary to PYSIGH. | |
26896 | ||
26897 | SUBROUTINE PYSGEX(NCHN,SIGS) | |
26898 | ||
26899 | C...Double precision and integer declarations | |
26900 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
26901 | IMPLICIT INTEGER(I-N) | |
26902 | INTEGER PYK,PYCHGE,PYCOMP | |
26903 | C...Parameter statement to help give large particle numbers. | |
26904 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
26905 | &KEXCIT=4000000,KDIMEN=5000000) | |
26906 | C...Commonblocks | |
26907 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
26908 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
26909 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
26910 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
26911 | COMMON/PYINT1/MINT(400),VINT(400) | |
26912 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
26913 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
26914 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
26915 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
26916 | COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, | |
26917 | &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, | |
26918 | &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, | |
26919 | &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR | |
26920 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/, | |
26921 | &/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/ | |
26922 | C...Local arrays | |
26923 | DIMENSION WDTP(0:400),WDTE(0:400,0:5) | |
26924 | ||
26925 | C...Differential cross section expressions. | |
26926 | ||
26927 | IF(ISUB.LE.160) THEN | |
26928 | IF(ISUB.EQ.141) THEN | |
26929 | C...f + fbar -> gamma*/Z0/Z'0 | |
26930 | SQMZP=PMAS(32,1)**2 | |
26931 | MINT(61)=2 | |
26932 | CALL PYWIDT(32,SH,WDTP,WDTE) | |
26933 | HP0=AEM/3D0*SH | |
26934 | HP1=AEM/3D0*XWC*SH | |
26935 | HP2=HP1 | |
26936 | HS=SHR*VINT(117) | |
26937 | HSP=SHR*WDTP(0) | |
26938 | FACZP=4D0*COMFAC*3D0 | |
26939 | DO 100 I=MMINA,MMAXA | |
26940 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 | |
26941 | EI=KCHG(IABS(I),1)/3D0 | |
26942 | AI=SIGN(1D0,EI) | |
26943 | VI=AI-4D0*EI*XWV | |
26944 | IA=IABS(I) | |
26945 | IF(IA.LT.10) THEN | |
26946 | IF(IA.LE.2) THEN | |
26947 | VPI=PARU(123-2*MOD(IABS(I),2)) | |
26948 | API=PARU(124-2*MOD(IABS(I),2)) | |
26949 | ELSEIF(IA.LE.4) THEN | |
26950 | VPI=PARJ(182-2*MOD(IABS(I),2)) | |
26951 | API=PARJ(183-2*MOD(IABS(I),2)) | |
26952 | ELSE | |
26953 | VPI=PARJ(190-2*MOD(IABS(I),2)) | |
26954 | API=PARJ(191-2*MOD(IABS(I),2)) | |
26955 | ENDIF | |
26956 | ELSE | |
26957 | IF(IA.LE.12) THEN | |
26958 | VPI=PARU(127-2*MOD(IABS(I),2)) | |
26959 | API=PARU(128-2*MOD(IABS(I),2)) | |
26960 | ELSEIF(IA.LE.14) THEN | |
26961 | VPI=PARJ(186-2*MOD(IABS(I),2)) | |
26962 | API=PARJ(187-2*MOD(IABS(I),2)) | |
26963 | ELSE | |
26964 | VPI=PARJ(194-2*MOD(IABS(I),2)) | |
26965 | API=PARJ(195-2*MOD(IABS(I),2)) | |
26966 | ENDIF | |
26967 | ENDIF | |
26968 | HI0=HP0 | |
26969 | IF(IABS(I).LE.10) HI0=HI0*FACA/3D0 | |
26970 | HI1=HP1 | |
26971 | IF(IABS(I).LE.10) HI1=HI1*FACA/3D0 | |
26972 | HI2=HP2 | |
26973 | IF(IABS(I).LE.10) HI2=HI2*FACA/3D0 | |
26974 | NCHN=NCHN+1 | |
26975 | ISIG(NCHN,1)=I | |
26976 | ISIG(NCHN,2)=-I | |
26977 | ISIG(NCHN,3)=1 | |
26978 | SIGH(NCHN)=FACZP*(EI**2/SH2*HI0*HP0*VINT(111)+EI*VI* | |
26979 | & (1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)*(HI0*HP1+HI1*HP0)* | |
26980 | & VINT(112)+EI*VPI*(1D0-SQMZP/SH)/((SH-SQMZP)**2+HSP**2)* | |
26981 | & (HI0*HP2+HI2*HP0)*VINT(113)+(VI**2+AI**2)/ | |
26982 | & ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)+(VI*VPI+AI*API)* | |
26983 | & ((SH-SQMZ)*(SH-SQMZP)+HS*HSP)/(((SH-SQMZ)**2+HS**2)* | |
26984 | & ((SH-SQMZP)**2+HSP**2))*(HI1*HP2+HI2*HP1)*VINT(115)+ | |
26985 | & (VPI**2+API**2)/((SH-SQMZP)**2+HSP**2)*HI2*HP2*VINT(116)) | |
26986 | 100 CONTINUE | |
26987 | ||
26988 | ELSEIF(ISUB.EQ.142) THEN | |
26989 | C...f + fbar' -> W'+/- | |
26990 | SQMWP=PMAS(34,1)**2 | |
26991 | CALL PYWIDT(34,SH,WDTP,WDTE) | |
26992 | HS=SHR*WDTP(0) | |
26993 | FACBW=4D0*COMFAC/((SH-SQMWP)**2+HS**2)*3D0 | |
26994 | HP=AEM/(24D0*XW)*SH | |
26995 | DO 120 I=MMIN1,MMAX1 | |
26996 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120 | |
26997 | IA=IABS(I) | |
26998 | DO 110 J=MMIN2,MMAX2 | |
26999 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110 | |
27000 | JA=IABS(J) | |
27001 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 110 | |
27002 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
27003 | & GOTO 110 | |
27004 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
27005 | HI=HP*(PARU(133)**2+PARU(134)**2) | |
27006 | IF(IA.LE.10) HI=HP*(PARU(131)**2+PARU(132)**2)* | |
27007 | & VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 | |
27008 | NCHN=NCHN+1 | |
27009 | ISIG(NCHN,1)=I | |
27010 | ISIG(NCHN,2)=J | |
27011 | ISIG(NCHN,3)=1 | |
27012 | HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) | |
27013 | SIGH(NCHN)=HI*FACBW*HF | |
27014 | 110 CONTINUE | |
27015 | 120 CONTINUE | |
27016 | ||
27017 | ELSEIF(ISUB.EQ.144) THEN | |
27018 | C...f + fbar' -> R | |
27019 | SQMR=PMAS(41,1)**2 | |
27020 | CALL PYWIDT(41,SH,WDTP,WDTE) | |
27021 | HS=SHR*WDTP(0) | |
27022 | FACBW=4D0*COMFAC/((SH-SQMR)**2+HS**2)*3D0 | |
27023 | HP=AEM/(12D0*XW)*SH | |
27024 | DO 140 I=MMIN1,MMAX1 | |
27025 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 140 | |
27026 | IA=IABS(I) | |
27027 | DO 130 J=MMIN2,MMAX2 | |
27028 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 130 | |
27029 | JA=IABS(J) | |
27030 | IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 130 | |
27031 | HI=HP | |
27032 | IF(IA.LE.10) HI=HI*FACA/3D0 | |
27033 | HF=SHR*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4)) | |
27034 | NCHN=NCHN+1 | |
27035 | ISIG(NCHN,1)=I | |
27036 | ISIG(NCHN,2)=J | |
27037 | ISIG(NCHN,3)=1 | |
27038 | SIGH(NCHN)=HI*FACBW*HF | |
27039 | 130 CONTINUE | |
27040 | 140 CONTINUE | |
27041 | ||
27042 | ELSEIF(ISUB.EQ.145) THEN | |
27043 | C...q + l -> LQ (leptoquark) | |
27044 | SQMLQ=PMAS(42,1)**2 | |
27045 | CALL PYWIDT(42,SH,WDTP,WDTE) | |
27046 | HS=SHR*WDTP(0) | |
27047 | FACBW=4D0*COMFAC/((SH-SQMLQ)**2+HS**2) | |
27048 | IF(ABS(SHR-PMAS(42,1)).GT.PARP(48)*PMAS(42,2)) FACBW=0D0 | |
27049 | HP=AEM/4D0*SH | |
27050 | KFLQQ=KFDP(MDCY(42,2),1) | |
27051 | KFLQL=KFDP(MDCY(42,2),2) | |
27052 | DO 160 I=MMIN1,MMAX1 | |
27053 | IF(KFAC(1,I).EQ.0) GOTO 160 | |
27054 | IA=IABS(I) | |
27055 | IF(IA.NE.KFLQQ.AND.IA.NE.IABS(KFLQL)) GOTO 160 | |
27056 | DO 150 J=MMIN2,MMAX2 | |
27057 | IF(KFAC(2,J).EQ.0) GOTO 150 | |
27058 | JA=IABS(J) | |
27059 | IF(JA.NE.KFLQQ.AND.JA.NE.IABS(KFLQL)) GOTO 150 | |
27060 | IF(I*J.NE.KFLQQ*KFLQL) GOTO 150 | |
27061 | IF(JA.EQ.IA) GOTO 150 | |
27062 | IF(IA.EQ.KFLQQ) KCHLQ=ISIGN(1,I) | |
27063 | IF(JA.EQ.KFLQQ) KCHLQ=ISIGN(1,J) | |
27064 | HI=HP*PARU(151) | |
27065 | HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHLQ)/2)+WDTE(0,4)) | |
27066 | NCHN=NCHN+1 | |
27067 | ISIG(NCHN,1)=I | |
27068 | ISIG(NCHN,2)=J | |
27069 | ISIG(NCHN,3)=1 | |
27070 | SIGH(NCHN)=HI*FACBW*HF | |
27071 | 150 CONTINUE | |
27072 | 160 CONTINUE | |
27073 | ||
27074 | ELSEIF(ISUB.EQ.146) THEN | |
27075 | C...e + gamma* -> e* (excited lepton) | |
27076 | KFQSTR=KFPR(ISUB,1) | |
27077 | KCQSTR=PYCOMP(KFQSTR) | |
27078 | KFQEXC=MOD(KFQSTR,KEXCIT) | |
27079 | CALL PYWIDT(KFQSTR,SH,WDTP,WDTE) | |
27080 | HS=SHR*WDTP(0) | |
27081 | FACBW=COMFAC/((SH-PMAS(KCQSTR,1)**2)**2+HS**2) | |
27082 | QF=-RTCM(43)/2D0-RTCM(44)/2D0 | |
27083 | FACBW=FACBW*AEM*QF**2*SH/RTCM(41)**2 | |
27084 | IF(ABS(SHR-PMAS(KCQSTR,1)).GT.PARP(48)*PMAS(KCQSTR,2)) | |
27085 | & FACBW=0D0 | |
27086 | HP=SH | |
27087 | DO 180 I=-KFQEXC,KFQEXC,2*KFQEXC | |
27088 | DO 170 ISDE=1,2 | |
27089 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 170 | |
27090 | IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 170 | |
27091 | HI=HP | |
27092 | IF(I.GT.0) HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
27093 | IF(I.LT.0) HF=SHR*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4)) | |
27094 | NCHN=NCHN+1 | |
27095 | ISIG(NCHN,ISDE)=I | |
27096 | ISIG(NCHN,3-ISDE)=22 | |
27097 | ISIG(NCHN,3)=1 | |
27098 | SIGH(NCHN)=HI*FACBW*HF | |
27099 | 170 CONTINUE | |
27100 | 180 CONTINUE | |
27101 | ||
27102 | ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN | |
27103 | C...d + g -> d* and u + g -> u* (excited quarks) | |
27104 | KFQSTR=KFPR(ISUB,1) | |
27105 | KCQSTR=PYCOMP(KFQSTR) | |
27106 | KFQEXC=MOD(KFQSTR,KEXCIT) | |
27107 | CALL PYWIDT(KFQSTR,SH,WDTP,WDTE) | |
27108 | HS=SHR*WDTP(0) | |
27109 | FACBW=COMFAC/((SH-PMAS(KCQSTR,1)**2)**2+HS**2) | |
27110 | FACBW=FACBW*AS*RTCM(45)**2*SH/(3D0*RTCM(41)**2) | |
27111 | IF(ABS(SHR-PMAS(KCQSTR,1)).GT.PARP(48)*PMAS(KCQSTR,2)) | |
27112 | & FACBW=0D0 | |
27113 | HP=SH | |
27114 | DO 200 I=-KFQEXC,KFQEXC,2*KFQEXC | |
27115 | DO 190 ISDE=1,2 | |
27116 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 190 | |
27117 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 190 | |
27118 | HI=HP | |
27119 | IF(I.GT.0) HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
27120 | IF(I.LT.0) HF=SHR*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4)) | |
27121 | NCHN=NCHN+1 | |
27122 | ISIG(NCHN,ISDE)=I | |
27123 | ISIG(NCHN,3-ISDE)=21 | |
27124 | ISIG(NCHN,3)=1 | |
27125 | SIGH(NCHN)=HI*FACBW*HF | |
27126 | 190 CONTINUE | |
27127 | 200 CONTINUE | |
27128 | ENDIF | |
27129 | ||
27130 | ELSEIF(ISUB.LE.190) THEN | |
27131 | IF(ISUB.EQ.162) THEN | |
27132 | C...q + g -> LQ + lbar; LQ=leptoquark | |
27133 | SQMLQ=PMAS(42,1)**2 | |
27134 | FACLQ=COMFAC*FACA*PARU(151)*(AS*AEM/6D0)*(-TH/SH)* | |
27135 | & (UH2+SQMLQ**2)/(UH-SQMLQ)**2 | |
27136 | KFLQQ=KFDP(MDCY(42,2),1) | |
27137 | DO 220 I=MMINA,MMAXA | |
27138 | IF(IABS(I).NE.KFLQQ) GOTO 220 | |
27139 | KCHLQ=ISIGN(1,I) | |
27140 | DO 210 ISDE=1,2 | |
27141 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 210 | |
27142 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 210 | |
27143 | NCHN=NCHN+1 | |
27144 | ISIG(NCHN,ISDE)=I | |
27145 | ISIG(NCHN,3-ISDE)=21 | |
27146 | ISIG(NCHN,3)=1 | |
27147 | SIGH(NCHN)=FACLQ*WIDS(42,(5-KCHLQ)/2) | |
27148 | 210 CONTINUE | |
27149 | 220 CONTINUE | |
27150 | ||
27151 | ELSEIF(ISUB.EQ.163) THEN | |
27152 | C...g + g -> LQ + LQbar; LQ=leptoquark | |
27153 | SQMLQ=PMAS(42,1)**2 | |
27154 | FACLQ=COMFAC*FACA*WIDS(42,1)*(AS**2/2D0)* | |
27155 | & (7D0/48D0+3D0*(UH-TH)**2/(16D0*SH2))*(1D0+2D0*SQMLQ*TH/ | |
27156 | & (TH-SQMLQ)**2+2D0*SQMLQ*UH/(UH-SQMLQ)**2+4D0*SQMLQ**2/ | |
27157 | & ((TH-SQMLQ)*(UH-SQMLQ))) | |
27158 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 230 | |
27159 | NCHN=NCHN+1 | |
27160 | ISIG(NCHN,1)=21 | |
27161 | ISIG(NCHN,2)=21 | |
27162 | C...Since don't know proper colour flow, randomize between alternatives | |
27163 | ISIG(NCHN,3)=INT(1.5D0+PYR(0)) | |
27164 | SIGH(NCHN)=FACLQ | |
27165 | 230 CONTINUE | |
27166 | ||
27167 | ELSEIF(ISUB.EQ.164) THEN | |
27168 | C...q + qbar -> LQ + LQbar; LQ=leptoquark | |
27169 | DELTA=0.25D0*(SQM3-SQM4)**2/SH | |
27170 | SQMLQ=0.5D0*(SQM3+SQM4)-DELTA | |
27171 | TH=TH-DELTA | |
27172 | UH=UH-DELTA | |
27173 | C SQMLQ=PMAS(42,1)**2 | |
27174 | FACLQA=COMFAC*WIDS(42,1)*(AS**2/9D0)* | |
27175 | & (SH*(SH-4D0*SQMLQ)-(UH-TH)**2)/SH2 | |
27176 | FACLQS=COMFAC*WIDS(42,1)*((PARU(151)**2*AEM**2/8D0)* | |
27177 | & (-SH*TH-(SQMLQ-TH)**2)/TH2+(PARU(151)*AEM*AS/18D0)* | |
27178 | & ((SQMLQ-TH)*(UH-TH)+SH*(SQMLQ+TH))/(SH*TH)) | |
27179 | KFLQQ=KFDP(MDCY(42,2),1) | |
27180 | DO 240 I=MMINA,MMAXA | |
27181 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
27182 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 240 | |
27183 | NCHN=NCHN+1 | |
27184 | ISIG(NCHN,1)=I | |
27185 | ISIG(NCHN,2)=-I | |
27186 | ISIG(NCHN,3)=1 | |
27187 | SIGH(NCHN)=FACLQA | |
27188 | IF(IABS(I).EQ.KFLQQ) SIGH(NCHN)=FACLQA+FACLQS | |
27189 | 240 CONTINUE | |
27190 | ||
27191 | ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN | |
27192 | C...q + q' -> q" + d* and q + q' -> q" + u* (excited quarks) | |
27193 | KFQSTR=KFPR(ISUB,2) | |
27194 | KCQSTR=PYCOMP(KFQSTR) | |
27195 | KFQEXC=MOD(KFQSTR,KEXCIT) | |
27196 | FACQSA=COMFAC*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH) | |
27197 | FACQSB=COMFAC*0.25D0*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH)* | |
27198 | & (1D0+SQM4/SH)*(1D0+CTH)*(1D0+((SH-SQM4)/(SH+SQM4))*CTH) | |
27199 | C...Propagators: as simulated in PYOFSH and as desired | |
27200 | GMMQ=PMAS(KCQSTR,1)*PMAS(KCQSTR,2) | |
27201 | HBW4=GMMQ/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQ**2) | |
27202 | CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE) | |
27203 | GMMQC=SQRT(SQM4)*WDTP(0) | |
27204 | HBW4C=GMMQC/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQC**2) | |
27205 | FACQSA=FACQSA*HBW4C/HBW4 | |
27206 | FACQSB=FACQSB*HBW4C/HBW4 | |
27207 | C...Branching ratios. | |
27208 | BRPOS=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
27209 | BRNEG=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0) | |
27210 | DO 260 I=MMIN1,MMAX1 | |
27211 | IA=IABS(I) | |
27212 | IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 260 | |
27213 | DO 250 J=MMIN2,MMAX2 | |
27214 | JA=IABS(J) | |
27215 | IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 250 | |
27216 | IF(IA.EQ.KFQEXC.AND.I.EQ.J) THEN | |
27217 | NCHN=NCHN+1 | |
27218 | ISIG(NCHN,1)=I | |
27219 | ISIG(NCHN,2)=J | |
27220 | ISIG(NCHN,3)=1 | |
27221 | IF(I.GT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRPOS | |
27222 | IF(I.LT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRNEG | |
27223 | NCHN=NCHN+1 | |
27224 | ISIG(NCHN,1)=I | |
27225 | ISIG(NCHN,2)=J | |
27226 | ISIG(NCHN,3)=2 | |
27227 | IF(J.GT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRPOS | |
27228 | IF(J.LT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRNEG | |
27229 | ELSEIF((IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC).AND.I*J.GT.0) THEN | |
27230 | NCHN=NCHN+1 | |
27231 | ISIG(NCHN,1)=I | |
27232 | ISIG(NCHN,2)=J | |
27233 | ISIG(NCHN,3)=1 | |
27234 | IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2 | |
27235 | IF(ISIG(NCHN,ISIG(NCHN,3)).GT.0) SIGH(NCHN)=FACQSA*BRPOS | |
27236 | IF(ISIG(NCHN,ISIG(NCHN,3)).LT.0) SIGH(NCHN)=FACQSA*BRNEG | |
27237 | ELSEIF(IA.EQ.KFQEXC.AND.I.EQ.-J) THEN | |
27238 | NCHN=NCHN+1 | |
27239 | ISIG(NCHN,1)=I | |
27240 | ISIG(NCHN,2)=J | |
27241 | ISIG(NCHN,3)=1 | |
27242 | IF(I.GT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRPOS | |
27243 | IF(I.LT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRNEG | |
27244 | NCHN=NCHN+1 | |
27245 | ISIG(NCHN,1)=I | |
27246 | ISIG(NCHN,2)=J | |
27247 | ISIG(NCHN,3)=2 | |
27248 | IF(J.GT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRPOS | |
27249 | IF(J.LT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRNEG | |
27250 | ELSEIF(I.EQ.-J) THEN | |
27251 | NCHN=NCHN+1 | |
27252 | ISIG(NCHN,1)=I | |
27253 | ISIG(NCHN,2)=J | |
27254 | ISIG(NCHN,3)=1 | |
27255 | IF(I.GT.0) SIGH(NCHN)=FACQSB*BRPOS | |
27256 | IF(I.LT.0) SIGH(NCHN)=FACQSB*BRNEG | |
27257 | NCHN=NCHN+1 | |
27258 | ISIG(NCHN,1)=I | |
27259 | ISIG(NCHN,2)=J | |
27260 | ISIG(NCHN,3)=2 | |
27261 | IF(J.GT.0) SIGH(NCHN)=FACQSB*BRPOS | |
27262 | IF(J.LT.0) SIGH(NCHN)=FACQSB*BRNEG | |
27263 | ELSEIF(IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC) THEN | |
27264 | NCHN=NCHN+1 | |
27265 | ISIG(NCHN,1)=I | |
27266 | ISIG(NCHN,2)=J | |
27267 | ISIG(NCHN,3)=1 | |
27268 | IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2 | |
27269 | IF(ISIG(NCHN,ISIG(NCHN,3)).GT.0) SIGH(NCHN)=FACQSB*BRPOS | |
27270 | IF(ISIG(NCHN,ISIG(NCHN,3)).LT.0) SIGH(NCHN)=FACQSB*BRNEG | |
27271 | ENDIF | |
27272 | 250 CONTINUE | |
27273 | 260 CONTINUE | |
27274 | ||
27275 | ELSEIF(ISUB.EQ.169) THEN | |
27276 | C...q + qbar -> e + e* (excited lepton) | |
27277 | KFQSTR=KFPR(ISUB,2) | |
27278 | KCQSTR=PYCOMP(KFQSTR) | |
27279 | KFQEXC=MOD(KFQSTR,KEXCIT) | |
27280 | FACQSB=(COMFAC/12D0)*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH)* | |
27281 | & (1D0+SQM4/SH)*(1D0+CTH)*(1D0+((SH-SQM4)/(SH+SQM4))*CTH) | |
27282 | C...Propagators: as simulated in PYOFSH and as desired | |
27283 | GMMQ=PMAS(KCQSTR,1)*PMAS(KCQSTR,2) | |
27284 | HBW4=GMMQ/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQ**2) | |
27285 | CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE) | |
27286 | GMMQC=SQRT(SQM4)*WDTP(0) | |
27287 | HBW4C=GMMQC/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQC**2) | |
27288 | FACQSB=FACQSB*HBW4C/HBW4 | |
27289 | C...Branching ratios. | |
27290 | BRPOS=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
27291 | BRNEG=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0) | |
27292 | DO 270 I=MMIN1,MMAX1 | |
27293 | IA=IABS(I) | |
27294 | IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 270 | |
27295 | J=-I | |
27296 | JA=IABS(J) | |
27297 | IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 270 | |
27298 | NCHN=NCHN+1 | |
27299 | ISIG(NCHN,1)=I | |
27300 | ISIG(NCHN,2)=J | |
27301 | ISIG(NCHN,3)=1 | |
27302 | IF(I.GT.0) SIGH(NCHN)=FACQSB*BRPOS | |
27303 | IF(I.LT.0) SIGH(NCHN)=FACQSB*BRNEG | |
27304 | NCHN=NCHN+1 | |
27305 | ISIG(NCHN,1)=I | |
27306 | ISIG(NCHN,2)=J | |
27307 | ISIG(NCHN,3)=2 | |
27308 | IF(J.GT.0) SIGH(NCHN)=FACQSB*BRPOS | |
27309 | IF(J.LT.0) SIGH(NCHN)=FACQSB*BRNEG | |
27310 | 270 CONTINUE | |
27311 | ENDIF | |
27312 | ||
27313 | ELSEIF(ISUB.LE.360) THEN | |
27314 | IF(ISUB.EQ.341.OR.ISUB.EQ.342) THEN | |
27315 | C...l + l -> H_L++/-- or H_R++/--. | |
27316 | KFRES=KFPR(ISUB,1) | |
27317 | KFREC=PYCOMP(KFRES) | |
27318 | CALL PYWIDT(KFRES,SH,WDTP,WDTE) | |
27319 | HS=SHR*WDTP(0) | |
27320 | FACBW=8D0*COMFAC/((SH-PMAS(KFREC,1)**2)**2+HS**2) | |
27321 | DO 290 I=MMIN1,MMAX1 | |
27322 | IA=IABS(I) | |
27323 | IF((IA.NE.11.AND.IA.NE.13.AND.IA.NE.15).OR.KFAC(1,I).EQ.0) | |
27324 | & GOTO 290 | |
27325 | DO 280 J=MMIN2,MMAX2 | |
27326 | JA=IABS(J) | |
27327 | IF((JA.NE.11.AND.JA.NE.13.AND.JA.NE.15).OR.KFAC(2,J).EQ.0) | |
27328 | & GOTO 280 | |
27329 | IF(I*J.LT.0) GOTO 280 | |
27330 | KCHH=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
27331 | NCHN=NCHN+1 | |
27332 | ISIG(NCHN,1)=I | |
27333 | ISIG(NCHN,2)=J | |
27334 | ISIG(NCHN,3)=1 | |
27335 | HI=SH*PARP(181+3*((IA-11)/2)+(JA-11)/2)**2/(8D0*PARU(1)) | |
27336 | HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4)) | |
27337 | SIGH(NCHN)=HI*FACBW*HF | |
27338 | 280 CONTINUE | |
27339 | 290 CONTINUE | |
27340 | ||
27341 | ELSEIF(ISUB.GE.343.AND.ISUB.LE.348) THEN | |
27342 | C...l + gamma -> H_L++/-- l' or l + gamma -> H_R++/-- l'. | |
27343 | KFRES=KFPR(ISUB,1) | |
27344 | KFREC=PYCOMP(KFRES) | |
27345 | C...Propagators: as simulated in PYOFSH and as desired | |
27346 | HBW3=PMAS(KFREC,1)*PMAS(KFREC,2)/((SQM3-PMAS(KFREC,1)**2)**2+ | |
27347 | & (PMAS(KFREC,1)*PMAS(KFREC,2))**2) | |
27348 | CALL PYWIDT(KFRES,SQM3,WDTP,WDTE) | |
27349 | GMMC=SQRT(SQM3)*WDTP(0) | |
27350 | HBW3C=GMMC/((SQM3-PMAS(KFREC,1)**2)**2+GMMC**2) | |
27351 | FHCC=COMFAC*AEM*HBW3C/HBW3 | |
27352 | DO 310 I=MMINA,MMAXA | |
27353 | IA=IABS(I) | |
27354 | IF(IA.NE.11.AND.IA.NE.13.AND.IA.NE.15) GOTO 310 | |
27355 | SQML=PMAS(IA,1)**2 | |
27356 | J=ISIGN(KFPR(ISUB,2),-I) | |
27357 | KCHH=ISIGN(2,KCHG(IA,1)*ISIGN(1,I)) | |
27358 | WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4))/WDTP(0) | |
27359 | SMM1=8D0*(SH+TH-SQM3)*(SH+TH-2D0*SQM3-SQML-SQM4)/ | |
27360 | & (UH-SQM3)**2 | |
27361 | SMM2=2D0*((2D0*SQM3-3D0*SQML)*SQM4+(SQML-2D0*SQM4)*TH- | |
27362 | & (TH-SQM4)*SH)/(TH-SQM4)**2 | |
27363 | SMM3=2D0*((2D0*SQM3-3D0*SQM4+TH)*SQML-(2D0*SQML-SQM4+TH)* | |
27364 | & SH)/(SH-SQML)**2 | |
27365 | SMM12=4D0*((2D0*SQML-SQM4-2D0*SQM3+TH)*SH+(TH-3D0*SQM3- | |
27366 | & 3D0*SQM4)*TH+(2D0*SQM3-2D0*SQML+3D0*SQM4)*SQM3)/ | |
27367 | & ((UH-SQM3)*(TH-SQM4)) | |
27368 | SMM13=-4D0*((TH+SQML-2D0*SQM4)*TH-(SQM3+3D0*SQML-2D0*SQM4)* | |
27369 | & SQM3+(SQM3+3D0*SQML+TH)*SH-(TH-SQM3+SH)**2)/ | |
27370 | & ((UH-SQM3)*(SH-SQML)) | |
27371 | SMM23=-4D0*((SQML-SQM4+SQM3)*TH-SQM3**2+SQM3*(SQML+SQM4)- | |
27372 | & 3D0*SQML*SQM4-(SQML-SQM4-SQM3+TH)*SH)/ | |
27373 | & ((SH-SQML)*(TH-SQM4)) | |
27374 | SMM=(SH/(SH-SQML))**2*(SMM1+SMM2+SMM3+SMM12+SMM13+SMM23)* | |
27375 | & PARP(181+3*((IA-11)/2)+(IABS(J)-11)/2)**2/(4D0*PARU(1)) | |
27376 | DO 300 ISDE=1,2 | |
27377 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 300 | |
27378 | IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 300 | |
27379 | NCHN=NCHN+1 | |
27380 | ISIG(NCHN,ISDE)=I | |
27381 | ISIG(NCHN,3-ISDE)=22 | |
27382 | ISIG(NCHN,3)=0 | |
27383 | SIGH(NCHN)=FHCC*SMM*WIDSC | |
27384 | 300 CONTINUE | |
27385 | 310 CONTINUE | |
27386 | ||
27387 | ELSEIF(ISUB.EQ.349.OR.ISUB.EQ.350) THEN | |
27388 | C...f + fbar -> H_L++ + H_L-- or H_R++ + H_R-- | |
27389 | KFRES=KFPR(ISUB,1) | |
27390 | KFREC=PYCOMP(KFRES) | |
27391 | SQMH=PMAS(KFREC,1)**2 | |
27392 | GMMH=PMAS(KFREC,1)*PMAS(KFREC,2) | |
27393 | C...Propagators: H++/-- as simulated in PYOFSH and as desired | |
27394 | HBW3=GMMH/((SQM3-SQMH)**2+GMMH**2) | |
27395 | CALL PYWIDT(KFRES,SQM3,WDTP,WDTE) | |
27396 | GMMH3=SQRT(SQM3)*WDTP(0) | |
27397 | HBW3C=GMMH3/((SQM3-SQMH)**2+GMMH3**2) | |
27398 | HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) | |
27399 | CALL PYWIDT(KFRES,SQM4,WDTP,WDTE) | |
27400 | GMMH4=SQRT(SQM4)*WDTP(0) | |
27401 | HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2) | |
27402 | C...Kinematical and coupling functions | |
27403 | FACHH=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)*(TH*UH-SQM3*SQM4) | |
27404 | XWHH=(1D0-2D0*XWV)/(8D0*XWV*(1D0-XWV)) | |
27405 | C...Loop over allowed flavours | |
27406 | DO 320 I=MMINA,MMAXA | |
27407 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320 | |
27408 | EI=KCHG(IABS(I),1)/3D0 | |
27409 | AI=SIGN(1D0,EI+0.1D0) | |
27410 | VI=AI-4D0*EI*XWV | |
27411 | FCOI=1D0 | |
27412 | IF(IABS(I).LE.10) FCOI=FACA/3D0 | |
27413 | IF(ISUB.EQ.349) THEN | |
27414 | HBWZ=1D0/((SH-SQMZ)**2+GMMZ**2) | |
27415 | IF(IABS(I).LT.10) THEN | |
27416 | DSIGHH=8D0*AEM**2*(EI**2/SH2+ | |
27417 | & 2D0*EI*VI*XWHH*(SH-SQMZ)*HBWZ/SH+ | |
27418 | & (VI**2+AI**2)*XWHH**2*HBWZ) | |
27419 | ELSE | |
27420 | IAOFF=181+3*((IABS(I)-11)/2) | |
27421 | HSUM=(PARP(IAOFF)**2+PARP(IAOFF+1)**2+PARP(IAOFF+2)**2)/ | |
27422 | & (4D0*PARU(1)) | |
27423 | DSIGHH=8D0*AEM**2*(EI**2/SH2+ | |
27424 | & 2D0*EI*VI*XWHH*(SH-SQMZ)*HBWZ/SH+ | |
27425 | & (VI**2+AI**2)*XWHH**2*HBWZ)+ | |
27426 | & 8D0*AEM*(EI*HSUM/(SH*TH)+ | |
27427 | & (VI+AI)*XWHH*HSUM*(SH-SQMZ)*HBWZ/TH)+ | |
27428 | & 4D0*HSUM**2/TH2 | |
27429 | ENDIF | |
27430 | ELSE | |
27431 | IF(IABS(I).LT.10) THEN | |
27432 | DSIGHH=8D0*AEM**2*EI**2/SH2 | |
27433 | ELSE | |
27434 | IAOFF=181+3*((IABS(I)-11)/2) | |
27435 | HSUM=(PARP(IAOFF)**2+PARP(IAOFF+1)**2+PARP(IAOFF+2)**2)/ | |
27436 | & (4D0*PARU(1)) | |
27437 | DSIGHH=8D0*AEM**2*EI**2/SH2+8D0*AEM*EI*HSUM/(SH*TH)+ | |
27438 | & 4D0*HSUM**2/TH2 | |
27439 | ENDIF | |
27440 | ENDIF | |
27441 | NCHN=NCHN+1 | |
27442 | ISIG(NCHN,1)=I | |
27443 | ISIG(NCHN,2)=-I | |
27444 | ISIG(NCHN,3)=1 | |
27445 | SIGH(NCHN)=FACHH*FCOI*DSIGHH | |
27446 | 320 CONTINUE | |
27447 | ||
27448 | ELSEIF(ISUB.EQ.351.OR.ISUB.EQ.352) THEN | |
27449 | C...f + f' -> f" + f"' + H++/-- (W+/- + W+/- -> H++/-- as inner process) | |
27450 | KFRES=KFPR(ISUB,1) | |
27451 | KFREC=PYCOMP(KFRES) | |
27452 | SQMH=PMAS(KFREC,1)**2 | |
27453 | IF(ISUB.EQ.351) FACNOR=PARP(190)**8*PARP(192)**2 | |
27454 | IF(ISUB.EQ.352) FACNOR=PARP(191)**6*2D0* | |
27455 | & PMAS(PYCOMP(9900024),1)**2 | |
27456 | FACWW=COMFAC*FACNOR*TAUP*VINT(2)*VINT(219) | |
27457 | FACPRT=1D0/((VINT(204)**2-VINT(215))* | |
27458 | & (VINT(209)**2-VINT(216))) | |
27459 | FACPRU=1D0/((VINT(204)**2+2D0*VINT(217))* | |
27460 | & (VINT(209)**2+2D0*VINT(218))) | |
27461 | CALL PYWIDT(KFRES,SH,WDTP,WDTE) | |
27462 | HS=SHR*WDTP(0) | |
27463 | FACBW=(1D0/PARU(1))*VINT(2)/((SH-SQMH)**2+HS**2) | |
27464 | IF(ABS(SHR-PMAS(KFREC,1)).GT.PARP(48)*PMAS(KFREC,2)) | |
27465 | & FACBW=0D0 | |
27466 | DO 340 I=MMIN1,MMAX1 | |
27467 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 340 | |
27468 | IF(ISUB.EQ.352.AND.IABS(I).GT.10) GOTO 340 | |
27469 | KCHWI=(1-2*MOD(IABS(I),2))*ISIGN(1,I) | |
27470 | DO 330 J=MMIN2,MMAX2 | |
27471 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 330 | |
27472 | IF(ISUB.EQ.352.AND.IABS(J).GT.10) GOTO 330 | |
27473 | KCHWJ=(1-2*MOD(IABS(J),2))*ISIGN(1,J) | |
27474 | KCHH=KCHWI+KCHWJ | |
27475 | IF(IABS(KCHH).NE.2) GOTO 330 | |
27476 | FACLR=VINT(180+I)*VINT(180+J) | |
27477 | HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4)) | |
27478 | IF(I.EQ.J.AND.IABS(I).GT.10) THEN | |
27479 | FACPRP=0.5D0*(FACPRT+FACPRU)**2 | |
27480 | ELSE | |
27481 | FACPRP=FACPRT**2 | |
27482 | ENDIF | |
27483 | NCHN=NCHN+1 | |
27484 | ISIG(NCHN,1)=I | |
27485 | ISIG(NCHN,2)=J | |
27486 | ISIG(NCHN,3)=1 | |
27487 | SIGH(NCHN)=FACLR*FACWW*FACPRP*FACBW*HF | |
27488 | 330 CONTINUE | |
27489 | 340 CONTINUE | |
27490 | ||
27491 | ELSEIF(ISUB.EQ.353) THEN | |
27492 | C...f + fbar -> Z_R0 | |
27493 | SQMZR=PMAS(PYCOMP(KFPR(ISUB,1)),1)**2 | |
27494 | CALL PYWIDT(KFPR(ISUB,1),SH,WDTP,WDTE) | |
27495 | HS=SHR*WDTP(0) | |
27496 | FACBW=4D0*COMFAC/((SH-SQMZR)**2+HS**2)*3D0 | |
27497 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
27498 | HP=(AEM/(3D0*(1D0-2D0*XW)))*XWC*SH | |
27499 | DO 350 I=MMINA,MMAXA | |
27500 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 350 | |
27501 | IF(IABS(I).LE.8) THEN | |
27502 | EI=KCHG(IABS(I),1)/3D0 | |
27503 | AI=SIGN(1D0,EI+0.1D0)*(1D0-2D0*XW) | |
27504 | VI=SIGN(1D0,EI+0.1D0)-4D0*EI*XW | |
27505 | ELSE | |
27506 | AI=-(1D0-2D0*XW) | |
27507 | VI=-1D0+4D0*XW | |
27508 | ENDIF | |
27509 | HI=HP*(VI**2+AI**2) | |
27510 | IF(IABS(I).LE.10) HI=HI*FACA/3D0 | |
27511 | NCHN=NCHN+1 | |
27512 | ISIG(NCHN,1)=I | |
27513 | ISIG(NCHN,2)=-I | |
27514 | ISIG(NCHN,3)=1 | |
27515 | SIGH(NCHN)=HI*FACBW*HF | |
27516 | 350 CONTINUE | |
27517 | ||
27518 | ELSEIF(ISUB.EQ.354) THEN | |
27519 | C...f + fbar' -> W_R+/- | |
27520 | SQMWR=PMAS(PYCOMP(KFPR(ISUB,1)),1)**2 | |
27521 | CALL PYWIDT(KFPR(ISUB,1),SH,WDTP,WDTE) | |
27522 | HS=SHR*WDTP(0) | |
27523 | FACBW=4D0*COMFAC/((SH-SQMWR)**2+HS**2)*3D0 | |
27524 | HP=AEM/(24D0*XW)*SH | |
27525 | DO 370 I=MMIN1,MMAX1 | |
27526 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 370 | |
27527 | IA=IABS(I) | |
27528 | DO 360 J=MMIN2,MMAX2 | |
27529 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 360 | |
27530 | JA=IABS(J) | |
27531 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 360 | |
27532 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) | |
27533 | & GOTO 360 | |
27534 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
27535 | HI=HP*2D0 | |
27536 | IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 | |
27537 | NCHN=NCHN+1 | |
27538 | ISIG(NCHN,1)=I | |
27539 | ISIG(NCHN,2)=J | |
27540 | ISIG(NCHN,3)=1 | |
27541 | HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) | |
27542 | SIGH(NCHN)=HI*FACBW*HF | |
27543 | 360 CONTINUE | |
27544 | 370 CONTINUE | |
27545 | ENDIF | |
27546 | ||
27547 | ELSEIF(ISUB.LE.400) THEN | |
27548 | IF(ISUB.EQ.391) THEN | |
27549 | C...f + fbar -> G*. | |
27550 | KFGSTR=KFPR(ISUB,1) | |
27551 | KCGSTR=PYCOMP(KFGSTR) | |
27552 | CALL PYWIDT(KFGSTR,SH,WDTP,WDTE) | |
27553 | HS=SHR*WDTP(0) | |
27554 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
27555 | FACG=COMFAC*PARP(50)**2/(16D0*PARU(1))*SH*HF/ | |
27556 | & ((SH-PMAS(KCGSTR,1)**2)**2+HS**2) | |
27557 | DO 380 I=MMINA,MMAXA | |
27558 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380 | |
27559 | HI=1D0 | |
27560 | IF(IABS(I).LE.10) HI=HI*FACA/3D0 | |
27561 | NCHN=NCHN+1 | |
27562 | ISIG(NCHN,1)=I | |
27563 | ISIG(NCHN,2)=-I | |
27564 | ISIG(NCHN,3)=1 | |
27565 | SIGH(NCHN)=FACG*HI | |
27566 | 380 CONTINUE | |
27567 | ||
27568 | ELSEIF(ISUB.EQ.392) THEN | |
27569 | C...g + g -> G*. | |
27570 | KFGSTR=KFPR(ISUB,1) | |
27571 | KCGSTR=PYCOMP(KFGSTR) | |
27572 | CALL PYWIDT(KFGSTR,SH,WDTP,WDTE) | |
27573 | HS=SHR*WDTP(0) | |
27574 | HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
27575 | FACG=COMFAC*PARP(50)**2/(32D0*PARU(1))*SH*HF/ | |
27576 | & ((SH-PMAS(KCGSTR,1)**2)**2+HS**2) | |
27577 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 390 | |
27578 | NCHN=NCHN+1 | |
27579 | ISIG(NCHN,1)=21 | |
27580 | ISIG(NCHN,2)=21 | |
27581 | ISIG(NCHN,3)=1 | |
27582 | SIGH(NCHN)=FACG | |
27583 | 390 CONTINUE | |
27584 | ||
27585 | ELSEIF(ISUB.EQ.393) THEN | |
27586 | C...q + qbar -> g + G*. | |
27587 | KFGSTR=KFPR(ISUB,2) | |
27588 | KCGSTR=PYCOMP(KFGSTR) | |
27589 | FACG=COMFAC*PARP(50)**2*AS*SH/(72D0*PARU(1)*SQM4)* | |
27590 | & (4D0*(TH2+UH2)/SH2+9D0*(TH+UH)/SH+(TH2/UH+UH2/TH)/SH+ | |
27591 | & 3D0*(4D0+TH/UH+UH/TH)+4D0*(SH/UH+SH/TH)+ | |
27592 | & 2D0*SH2/(TH*UH)) | |
27593 | C...Propagators: as simulated in PYOFSH and as desired | |
27594 | GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2) | |
27595 | HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2) | |
27596 | CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE) | |
27597 | HS=SQRT(SQM4)*WDTP(0) | |
27598 | HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
27599 | HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2) | |
27600 | FACG=FACG*HBW4C/HBW4 | |
27601 | DO 400 I=MMINA,MMAXA | |
27602 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. | |
27603 | & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400 | |
27604 | NCHN=NCHN+1 | |
27605 | ISIG(NCHN,1)=I | |
27606 | ISIG(NCHN,2)=-I | |
27607 | ISIG(NCHN,3)=1 | |
27608 | SIGH(NCHN)=FACG | |
27609 | 400 CONTINUE | |
27610 | ||
27611 | ELSEIF(ISUB.EQ.394) THEN | |
27612 | C...q + g -> q + G*. | |
27613 | KFGSTR=KFPR(ISUB,2) | |
27614 | KCGSTR=PYCOMP(KFGSTR) | |
27615 | FACG=-COMFAC*PARP(50)**2*AS*SH/(192D0*PARU(1)*SQM4)* | |
27616 | & (4D0*(SH2+UH2)/(TH*SH)+9D0*(SH+UH)/SH+SH/UH+UH2/SH2+ | |
27617 | & 3D0*TH*(4D0+SH/UH+UH/SH)/SH+4D0*TH2*(1D0/UH+1D0/SH)/SH+ | |
27618 | & 2D0*TH2*TH/(UH*SH2)) | |
27619 | C...Propagators: as simulated in PYOFSH and as desired | |
27620 | GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2) | |
27621 | HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2) | |
27622 | CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE) | |
27623 | HS=SQRT(SQM4)*WDTP(0) | |
27624 | HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
27625 | HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2) | |
27626 | FACG=FACG*HBW4C/HBW4 | |
27627 | DO 420 I=MMINA,MMAXA | |
27628 | IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 420 | |
27629 | DO 410 ISDE=1,2 | |
27630 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 410 | |
27631 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 410 | |
27632 | NCHN=NCHN+1 | |
27633 | ISIG(NCHN,ISDE)=I | |
27634 | ISIG(NCHN,3-ISDE)=21 | |
27635 | ISIG(NCHN,3)=1 | |
27636 | SIGH(NCHN)=FACG | |
27637 | 410 CONTINUE | |
27638 | 420 CONTINUE | |
27639 | ||
27640 | ELSEIF(ISUB.EQ.395) THEN | |
27641 | C...g + g -> g + G*. | |
27642 | KFGSTR=KFPR(ISUB,2) | |
27643 | KCGSTR=PYCOMP(KFGSTR) | |
27644 | FACG=COMFAC*3D0*PARP(50)**2*AS*SH/(32D0*PARU(1)*SQM4)* | |
27645 | & ((TH2+TH*UH+UH2)**2/(SH2*TH*UH)+2D0*(TH2/UH+UH2/TH)/SH+ | |
27646 | & 3D0*(TH/UH+UH/TH)+2D0*(SH/UH+SH/TH)+SH2/(TH*UH)) | |
27647 | C...Propagators: as simulated in PYOFSH and as desired | |
27648 | GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2) | |
27649 | HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2) | |
27650 | CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE) | |
27651 | HS=SQRT(SQM4)*WDTP(0) | |
27652 | HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
27653 | HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2) | |
27654 | FACG=FACG*HBW4C/HBW4 | |
27655 | IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN | |
27656 | NCHN=NCHN+1 | |
27657 | ISIG(NCHN,1)=21 | |
27658 | ISIG(NCHN,2)=21 | |
27659 | ISIG(NCHN,3)=1 | |
27660 | SIGH(NCHN)=FACG | |
27661 | ENDIF | |
27662 | ENDIF | |
27663 | ENDIF | |
27664 | ||
27665 | RETURN | |
27666 | END | |
27667 | ||
27668 | C********************************************************************* | |
27669 | ||
27670 | C...PYPDFU | |
27671 | C...Gives electron, muon, tau, photon, pi+, neutron, proton and hyperon | |
27672 | C...parton distributions according to a few different parametrizations. | |
27673 | C...Note that what is coded is x times the probability distribution, | |
27674 | C...i.e. xq(x,Q2) etc. | |
27675 | ||
27676 | SUBROUTINE PYPDFU(KF,X,Q2,XPQ) | |
27677 | ||
27678 | C...Double precision and integer declarations. | |
27679 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
27680 | IMPLICIT INTEGER(I-N) | |
27681 | INTEGER PYK,PYCHGE,PYCOMP | |
27682 | C...Commonblocks. | |
27683 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
27684 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
27685 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
27686 | COMMON/PYINT1/MINT(400),VINT(400) | |
27687 | COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), | |
27688 | &XPDIR(-6:6) | |
27689 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT8/ | |
27690 | C...Local arrays. | |
27691 | DIMENSION XPQ(-25:25),XPEL(-25:25),XPGA(-6:6),VXPGA(-6:6), | |
27692 | &XPPI(-6:6),XPPR(-6:6) | |
27693 | ||
27694 | C...Interface to PDFLIB. | |
81935ff8 | 27695 | COMMON/LW50513/XMIN,XMAX,Q2MIN,Q2MAX |
27696 | SAVE /LW50513/ | |
2dfa57d1 | 27697 | DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU, |
27698 | &VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX | |
27699 | CHARACTER*20 PARM(20) | |
27700 | DATA VALUE/20*0D0/,PARM/20*' '/ | |
27701 | ||
27702 | C...Data related to Schuler-Sjostrand photon distributions. | |
27703 | DATA ALAMGA/0.2D0/, PMCGA/1.3D0/, PMBGA/4.6D0/ | |
27704 | ||
27705 | C...Reset parton distributions. | |
27706 | MINT(92)=0 | |
27707 | DO 100 KFL=-25,25 | |
27708 | XPQ(KFL)=0D0 | |
27709 | 100 CONTINUE | |
27710 | ||
27711 | C...Check x and particle species. | |
27712 | IF(X.LE.0D0.OR.X.GE.1D0) THEN | |
27713 | WRITE(MSTU(11),5000) X | |
27714 | RETURN | |
27715 | ENDIF | |
27716 | KFA=IABS(KF) | |
27717 | IF(KFA.NE.11.AND.KFA.NE.13.AND.KFA.NE.15.AND.KFA.NE.22.AND. | |
27718 | &KFA.NE.211.AND.KFA.NE.2112.AND.KFA.NE.2212.AND.KFA.NE.3122.AND. | |
27719 | &KFA.NE.3112.AND.KFA.NE.3212.AND.KFA.NE.3222.AND.KFA.NE.3312.AND. | |
27720 | &KFA.NE.3322.AND.KFA.NE.3334.AND.KFA.NE.111.AND.KFA.NE.321.AND. | |
27721 | &KFA.NE.310.AND.KFA.NE.130) THEN | |
27722 | WRITE(MSTU(11),5100) KF | |
27723 | RETURN | |
27724 | ENDIF | |
27725 | ||
27726 | C...Electron (or muon or tau) parton distribution call. | |
27727 | IF(KFA.EQ.11.OR.KFA.EQ.13.OR.KFA.EQ.15) THEN | |
27728 | CALL PYPDEL(KFA,X,Q2,XPEL) | |
27729 | DO 110 KFL=-25,25 | |
27730 | XPQ(KFL)=XPEL(KFL) | |
27731 | 110 CONTINUE | |
27732 | ||
27733 | C...Photon parton distribution call (VDM+anomalous). | |
27734 | ELSEIF(KFA.EQ.22.AND.MINT(109).LE.1) THEN | |
27735 | IF(MSTP(56).EQ.1.AND.MSTP(55).EQ.1) THEN | |
27736 | CALL PYPDGA(X,Q2,XPGA) | |
27737 | DO 120 KFL=-6,6 | |
27738 | XPQ(KFL)=XPGA(KFL) | |
27739 | 120 CONTINUE | |
27740 | ELSEIF(MSTP(56).EQ.1.AND.MSTP(55).GE.5.AND.MSTP(55).LE.8) THEN | |
27741 | Q2MX=Q2 | |
27742 | P2MX=0.36D0 | |
27743 | IF(MSTP(55).GE.7) P2MX=4.0D0 | |
27744 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
27745 | P2=0D0 | |
27746 | IF(VINT(120).LT.0D0) P2=VINT(120)**2 | |
27747 | CALL PYGGAM(MSTP(55)-4,X,Q2MX,P2,MSTP(60),F2GAM,XPGA) | |
27748 | DO 130 KFL=-6,6 | |
27749 | XPQ(KFL)=XPGA(KFL) | |
27750 | 130 CONTINUE | |
27751 | VINT(231)=P2MX | |
27752 | ELSEIF(MSTP(56).EQ.1.AND.MSTP(55).GE.9.AND.MSTP(55).LE.12) THEN | |
27753 | Q2MX=Q2 | |
27754 | P2MX=0.36D0 | |
27755 | IF(MSTP(55).GE.11) P2MX=4.0D0 | |
27756 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
27757 | P2=0D0 | |
27758 | IF(VINT(120).LT.0D0) P2=VINT(120)**2 | |
27759 | CALL PYGGAM(MSTP(55)-8,X,Q2MX,P2,MSTP(60),F2GAM,XPGA) | |
27760 | DO 140 KFL=-6,6 | |
27761 | XPQ(KFL)=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) | |
27762 | 140 CONTINUE | |
27763 | VINT(231)=P2MX | |
27764 | ELSEIF(MSTP(56).EQ.2) THEN | |
27765 | C...Call PDFLIB parton distributions. | |
27766 | PARM(1)='NPTYPE' | |
27767 | VALUE(1)=3 | |
27768 | PARM(2)='NGROUP' | |
27769 | VALUE(2)=MSTP(55)/1000 | |
27770 | PARM(3)='NSET' | |
27771 | VALUE(3)=MOD(MSTP(55),1000) | |
27772 | IF(MINT(93).NE.3000000+MSTP(55)) THEN | |
27773 | CALL PDFSET(PARM,VALUE) | |
27774 | MINT(93)=3000000+MSTP(55) | |
27775 | ENDIF | |
27776 | XX=X | |
27777 | QQ2=MAX(0D0,Q2MIN,Q2) | |
27778 | IF(MSTP(57).EQ.0) QQ2=Q2MIN | |
27779 | P2=0D0 | |
27780 | IF(VINT(120).LT.0D0) P2=VINT(120)**2 | |
27781 | IP2=MSTP(60) | |
27782 | IF(MSTP(55).EQ.5004) THEN | |
27783 | IF(5D0*P2.LT.QQ2.AND. | |
27784 | & QQ2.GT.0.6D0.AND.QQ2.LT.5D4.AND. | |
27785 | & P2.GE.0D0.AND.P2.LT.10D0.AND. | |
27786 | & XX.GT.1D-4.AND.XX.LT.1D0) THEN | |
27787 | CALL STRUCTP(XX,QQ2,P2,IP2,UPV,DNV,USEA,DSEA,STR,CHM, | |
27788 | & BOT,TOP,GLU) | |
27789 | ELSE | |
27790 | UPV=0D0 | |
27791 | DNV=0D0 | |
27792 | USEA=0D0 | |
27793 | DSEA=0D0 | |
27794 | STR=0D0 | |
27795 | CHM=0D0 | |
27796 | BOT=0D0 | |
27797 | TOP=0D0 | |
27798 | GLU=0D0 | |
27799 | ENDIF | |
27800 | ELSE | |
27801 | IF(P2.LT.QQ2) THEN | |
27802 | CALL STRUCTP(XX,QQ2,P2,IP2,UPV,DNV,USEA,DSEA,STR,CHM, | |
27803 | & BOT,TOP,GLU) | |
27804 | ELSE | |
27805 | UPV=0D0 | |
27806 | DNV=0D0 | |
27807 | USEA=0D0 | |
27808 | DSEA=0D0 | |
27809 | STR=0D0 | |
27810 | CHM=0D0 | |
27811 | BOT=0D0 | |
27812 | TOP=0D0 | |
27813 | GLU=0D0 | |
27814 | ENDIF | |
27815 | ENDIF | |
27816 | VINT(231)=Q2MIN | |
27817 | XPQ(0)=GLU | |
27818 | XPQ(1)=DNV | |
27819 | XPQ(-1)=DNV | |
27820 | XPQ(2)=UPV | |
27821 | XPQ(-2)=UPV | |
27822 | XPQ(3)=STR | |
27823 | XPQ(-3)=STR | |
27824 | XPQ(4)=CHM | |
27825 | XPQ(-4)=CHM | |
27826 | XPQ(5)=BOT | |
27827 | XPQ(-5)=BOT | |
27828 | XPQ(6)=TOP | |
27829 | XPQ(-6)=TOP | |
27830 | ELSE | |
27831 | WRITE(MSTU(11),5200) KF,MSTP(56),MSTP(55) | |
27832 | ENDIF | |
27833 | ||
27834 | C...Pion/gammaVDM parton distribution call. | |
27835 | ELSEIF(KFA.EQ.211.OR.KFA.EQ.111.OR.KFA.EQ.321.OR.KFA.EQ.130.OR. | |
27836 | &KFA.EQ.310.OR.(KFA.EQ.22.AND.MINT(109).EQ.2)) THEN | |
27837 | IF(KFA.EQ.22.AND.MSTP(56).EQ.1.AND.MSTP(55).GE.5.AND. | |
27838 | & MSTP(55).LE.12) THEN | |
27839 | ISET=1+MOD(MSTP(55)-1,4) | |
27840 | Q2MX=Q2 | |
27841 | P2MX=0.36D0 | |
27842 | IF(ISET.GE.3) P2MX=4.0D0 | |
27843 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
27844 | P2=0D0 | |
27845 | IF(VINT(120).LT.0D0) P2=VINT(120)**2 | |
27846 | CALL PYGGAM(ISET,X,Q2MX,P2,MSTP(60),F2GAM,XPGA) | |
27847 | DO 150 KFL=-6,6 | |
27848 | XPQ(KFL)=XPVMD(KFL) | |
27849 | 150 CONTINUE | |
27850 | VINT(231)=P2MX | |
27851 | ELSEIF(MSTP(54).EQ.1.AND.MSTP(53).GE.1.AND.MSTP(53).LE.3) THEN | |
27852 | CALL PYPDPI(X,Q2,XPPI) | |
27853 | DO 160 KFL=-6,6 | |
27854 | XPQ(KFL)=XPPI(KFL) | |
27855 | 160 CONTINUE | |
27856 | ELSEIF(MSTP(54).EQ.2) THEN | |
27857 | C...Call PDFLIB parton distributions. | |
27858 | PARM(1)='NPTYPE' | |
27859 | VALUE(1)=2 | |
27860 | PARM(2)='NGROUP' | |
27861 | VALUE(2)=MSTP(53)/1000 | |
27862 | PARM(3)='NSET' | |
27863 | VALUE(3)=MOD(MSTP(53),1000) | |
27864 | IF(MINT(93).NE.2000000+MSTP(53)) THEN | |
27865 | CALL PDFSET(PARM,VALUE) | |
27866 | MINT(93)=2000000+MSTP(53) | |
27867 | ENDIF | |
27868 | XX=X | |
27869 | QQ=SQRT(MAX(0D0,Q2MIN,Q2)) | |
27870 | IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN) | |
27871 | CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) | |
27872 | VINT(231)=Q2MIN | |
27873 | XPQ(0)=GLU | |
27874 | XPQ(1)=DSEA | |
27875 | XPQ(-1)=UPV+DSEA | |
27876 | XPQ(2)=UPV+USEA | |
27877 | XPQ(-2)=USEA | |
27878 | XPQ(3)=STR | |
27879 | XPQ(-3)=STR | |
27880 | XPQ(4)=CHM | |
27881 | XPQ(-4)=CHM | |
27882 | XPQ(5)=BOT | |
27883 | XPQ(-5)=BOT | |
27884 | XPQ(6)=TOP | |
27885 | XPQ(-6)=TOP | |
27886 | ELSE | |
27887 | WRITE(MSTU(11),5200) KF,MSTP(54),MSTP(53) | |
27888 | ENDIF | |
27889 | ||
27890 | C...Anomalous photon parton distribution call. | |
27891 | ELSEIF(KFA.EQ.22.AND.MINT(109).EQ.3) THEN | |
27892 | Q2MX=Q2 | |
27893 | P2MX=PARP(15)**2 | |
27894 | IF(MSTP(56).EQ.1.AND.MSTP(55).LE.8) THEN | |
27895 | IF(MSTP(55).EQ.5.OR.MSTP(55).EQ.6) P2MX=0.36D0 | |
27896 | IF(MSTP(55).EQ.7.OR.MSTP(55).EQ.8) P2MX=4.0D0 | |
27897 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
27898 | P2=0D0 | |
27899 | IF(VINT(120).LT.0D0) P2=VINT(120)**2 | |
27900 | CALL PYGGAM(MSTP(55)-4,X,Q2MX,P2,MSTP(60),F2GM,XPGA) | |
27901 | DO 170 KFL=-6,6 | |
27902 | XPQ(KFL)=XPANL(KFL)+XPANH(KFL) | |
27903 | 170 CONTINUE | |
27904 | VINT(231)=P2MX | |
27905 | ELSEIF(MSTP(56).EQ.1) THEN | |
27906 | IF(MSTP(55).EQ.9.OR.MSTP(55).EQ.10) P2MX=0.36D0 | |
27907 | IF(MSTP(55).EQ.11.OR.MSTP(55).EQ.12) P2MX=4.0D0 | |
27908 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
27909 | P2=0D0 | |
27910 | IF(VINT(120).LT.0D0) P2=VINT(120)**2 | |
27911 | CALL PYGGAM(MSTP(55)-8,X,Q2MX,P2,MSTP(60),F2GM,XPGA) | |
27912 | DO 180 KFL=-6,6 | |
27913 | XPQ(KFL)=MAX(0D0,XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL)) | |
27914 | 180 CONTINUE | |
27915 | VINT(231)=P2MX | |
27916 | ELSEIF(MSTP(56).EQ.2) THEN | |
27917 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
27918 | CALL PYGANO(0,X,Q2MX,P2MX,ALAMGA,XPGA,VXPGA) | |
27919 | DO 190 KFL=-6,6 | |
27920 | XPQ(KFL)=XPGA(KFL) | |
27921 | 190 CONTINUE | |
27922 | VINT(231)=P2MX | |
27923 | ELSEIF(MSTP(55).GE.1.AND.MSTP(55).LE.5) THEN | |
27924 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
27925 | CALL PYGVMD(0,MSTP(55),X,Q2MX,P2MX,PARP(1),XPGA,VXPGA) | |
27926 | DO 200 KFL=-6,6 | |
27927 | XPQ(KFL)=XPGA(KFL) | |
27928 | 200 CONTINUE | |
27929 | VINT(231)=P2MX | |
27930 | ELSE | |
27931 | 210 RKF=11D0*PYR(0) | |
27932 | KFR=1 | |
27933 | IF(RKF.GT.1D0) KFR=2 | |
27934 | IF(RKF.GT.5D0) KFR=3 | |
27935 | IF(RKF.GT.6D0) KFR=4 | |
27936 | IF(RKF.GT.10D0) KFR=5 | |
27937 | IF(KFR.EQ.4.AND.Q2.LT.PMCGA**2) GOTO 210 | |
27938 | IF(KFR.EQ.5.AND.Q2.LT.PMBGA**2) GOTO 210 | |
27939 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
27940 | CALL PYGVMD(0,KFR,X,Q2MX,P2MX,PARP(1),XPGA,VXPGA) | |
27941 | DO 220 KFL=-6,6 | |
27942 | XPQ(KFL)=XPGA(KFL) | |
27943 | 220 CONTINUE | |
27944 | VINT(231)=P2MX | |
27945 | ENDIF | |
27946 | ||
27947 | C...Proton parton distribution call. | |
27948 | ELSE | |
27949 | IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.20) THEN | |
27950 | CALL PYPDPR(X,Q2,XPPR) | |
27951 | DO 230 KFL=-6,6 | |
27952 | XPQ(KFL)=XPPR(KFL) | |
27953 | 230 CONTINUE | |
27954 | ELSEIF(MSTP(52).EQ.2) THEN | |
27955 | C...Call PDFLIB parton distributions. | |
27956 | PARM(1)='NPTYPE' | |
27957 | VALUE(1)=1 | |
27958 | PARM(2)='NGROUP' | |
27959 | VALUE(2)=MSTP(51)/1000 | |
27960 | PARM(3)='NSET' | |
27961 | VALUE(3)=MOD(MSTP(51),1000) | |
27962 | IF(MINT(93).NE.1000000+MSTP(51)) THEN | |
27963 | CALL PDFSET_ALICE(PARM,VALUE) | |
27964 | MINT(93)=1000000+MSTP(51) | |
27965 | ENDIF | |
27966 | XX=X | |
27967 | QQ=SQRT(MAX(0D0,Q2MIN,Q2)) | |
27968 | IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN) | |
27969 | CALL STRUCTM_ALICE | |
27970 | + (XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) | |
27971 | VINT(231)=Q2MIN | |
27972 | XPQ(0)=GLU | |
27973 | XPQ(1)=DNV+DSEA | |
27974 | XPQ(-1)=DSEA | |
27975 | XPQ(2)=UPV+USEA | |
27976 | XPQ(-2)=USEA | |
27977 | XPQ(3)=STR | |
27978 | XPQ(-3)=STR | |
27979 | XPQ(4)=CHM | |
27980 | XPQ(-4)=CHM | |
27981 | XPQ(5)=BOT | |
27982 | XPQ(-5)=BOT | |
27983 | XPQ(6)=TOP | |
27984 | XPQ(-6)=TOP | |
27985 | ELSE | |
27986 | WRITE(MSTU(11),5200) KF,MSTP(52),MSTP(51) | |
27987 | ENDIF | |
27988 | ENDIF | |
27989 | ||
27990 | C...Isospin average for pi0/gammaVDM. | |
27991 | IF(KFA.EQ.111.OR.(KFA.EQ.22.AND.MINT(109).EQ.2)) THEN | |
27992 | IF(KFA.EQ.22.AND.MSTP(55).GE.5.AND.MSTP(55).LE.12) THEN | |
27993 | XPV=XPQ(2)-XPQ(1) | |
27994 | XPQ(2)=XPQ(1) | |
27995 | XPQ(-2)=XPQ(-1) | |
27996 | ELSE | |
27997 | XPS=0.5D0*(XPQ(1)+XPQ(-2)) | |
27998 | XPV=0.5D0*(XPQ(2)+XPQ(-1))-XPS | |
27999 | XPQ(2)=XPS | |
28000 | XPQ(-1)=XPS | |
28001 | ENDIF | |
28002 | IF(KFA.EQ.22.AND.MINT(105).LE.223) THEN | |
28003 | XPQ(1)=XPQ(1)+0.2D0*XPV | |
28004 | XPQ(-1)=XPQ(-1)+0.2D0*XPV | |
28005 | XPQ(2)=XPQ(2)+0.8D0*XPV | |
28006 | XPQ(-2)=XPQ(-2)+0.8D0*XPV | |
28007 | ELSEIF(KFA.EQ.22.AND.MINT(105).EQ.333) THEN | |
28008 | XPQ(3)=XPQ(3)+XPV | |
28009 | XPQ(-3)=XPQ(-3)+XPV | |
28010 | ELSEIF(KFA.EQ.22.AND.MINT(105).EQ.443) THEN | |
28011 | XPQ(4)=XPQ(4)+XPV | |
28012 | XPQ(-4)=XPQ(-4)+XPV | |
28013 | IF(MSTP(55).GE.9) THEN | |
28014 | DO 240 KFL=-6,6 | |
28015 | XPQ(KFL)=0D0 | |
28016 | 240 CONTINUE | |
28017 | ENDIF | |
28018 | ELSE | |
28019 | XPQ(1)=XPQ(1)+0.5D0*XPV | |
28020 | XPQ(-1)=XPQ(-1)+0.5D0*XPV | |
28021 | XPQ(2)=XPQ(2)+0.5D0*XPV | |
28022 | XPQ(-2)=XPQ(-2)+0.5D0*XPV | |
28023 | ENDIF | |
28024 | ||
28025 | C...Rescale for gammaVDM by effective gamma -> rho coupling. | |
28026 | C+++Do not rescale? | |
28027 | IF(KFA.EQ.22.AND.MINT(109).EQ.2.AND..NOT.(MSTP(56).EQ.1 | |
28028 | & .AND.MSTP(55).GE.5.AND.MSTP(55).LE.12)) THEN | |
28029 | DO 250 KFL=-6,6 | |
28030 | XPQ(KFL)=VINT(281)*XPQ(KFL) | |
28031 | 250 CONTINUE | |
28032 | VINT(232)=VINT(281)*XPV | |
28033 | ENDIF | |
28034 | ||
28035 | C...Simple recipes for kaons. | |
28036 | ELSEIF(KFA.EQ.321) THEN | |
28037 | XPQ(-3)=XPQ(-3)+XPQ(-1)-XPQ(1) | |
28038 | XPQ(-1)=XPQ(1) | |
28039 | ELSEIF(KFA.EQ.130.OR.KFA.EQ.310) THEN | |
28040 | XPS=0.5D0*(XPQ(1)+XPQ(-2)) | |
28041 | XPV=0.5D0*(XPQ(2)+XPQ(-1))-XPS | |
28042 | XPQ(2)=XPS | |
28043 | XPQ(-1)=XPS | |
28044 | XPQ(1)=XPQ(1)+0.5D0*XPV | |
28045 | XPQ(-1)=XPQ(-1)+0.5D0*XPV | |
28046 | XPQ(3)=XPQ(3)+0.5D0*XPV | |
28047 | XPQ(-3)=XPQ(-3)+0.5D0*XPV | |
28048 | ||
28049 | C...Isospin conjugation for neutron. | |
28050 | ELSEIF(KFA.EQ.2112) THEN | |
28051 | XPS=XPQ(1) | |
28052 | XPQ(1)=XPQ(2) | |
28053 | XPQ(2)=XPS | |
28054 | XPS=XPQ(-1) | |
28055 | XPQ(-1)=XPQ(-2) | |
28056 | XPQ(-2)=XPS | |
28057 | ||
28058 | C...Simple recipes for hyperon (average valence parton distribution). | |
28059 | ELSEIF(KFA.EQ.3122.OR.KFA.EQ.3112.OR.KFA.EQ.3212.OR.KFA.EQ.3222 | |
28060 | & .OR.KFA.EQ.3312.OR.KFA.EQ.3322.OR.KFA.EQ.3334) THEN | |
28061 | XPVAL=(XPQ(1)+XPQ(2)-XPQ(-1)-XPQ(-2))/3D0 | |
28062 | XPSEA=0.5D0*(XPQ(-1)+XPQ(-2)) | |
28063 | XPQ(1)=XPSEA | |
28064 | XPQ(2)=XPSEA | |
28065 | XPQ(-1)=XPSEA | |
28066 | XPQ(-2)=XPSEA | |
28067 | XPQ(KFA/1000)=XPQ(KFA/1000)+XPVAL | |
28068 | XPQ(MOD(KFA/100,10))=XPQ(MOD(KFA/100,10))+XPVAL | |
28069 | XPQ(MOD(KFA/10,10))=XPQ(MOD(KFA/10,10))+XPVAL | |
28070 | ENDIF | |
28071 | ||
28072 | C...Charge conjugation for antiparticle. | |
28073 | IF(KF.LT.0) THEN | |
28074 | DO 260 KFL=1,25 | |
28075 | IF(KFL.EQ.21.OR.KFL.EQ.22.OR.KFL.EQ.23.OR.KFL.EQ.25) GOTO 260 | |
28076 | XPS=XPQ(KFL) | |
28077 | XPQ(KFL)=XPQ(-KFL) | |
28078 | XPQ(-KFL)=XPS | |
28079 | 260 CONTINUE | |
28080 | ENDIF | |
28081 | ||
28082 | C...Allow gluon also in position 21. | |
28083 | XPQ(21)=XPQ(0) | |
28084 | ||
28085 | C...Check positivity and reset above maximum allowed flavour. | |
28086 | DO 270 KFL=-25,25 | |
28087 | XPQ(KFL)=MAX(0D0,XPQ(KFL)) | |
28088 | IF(IABS(KFL).GT.MSTP(58).AND.IABS(KFL).LE.8) XPQ(KFL)=0D0 | |
28089 | 270 CONTINUE | |
28090 | ||
28091 | C...Formats for error printouts. | |
28092 | 5000 FORMAT(' Error: x value outside physical range; x =',1P,D12.3) | |
28093 | 5100 FORMAT(' Error: illegal particle code for parton distribution;', | |
28094 | &' KF =',I5) | |
28095 | 5200 FORMAT(' Error: unknown parton distribution; KF, library, set =', | |
28096 | &3I5) | |
28097 | ||
28098 | RETURN | |
28099 | END | |
28100 | ||
28101 | C********************************************************************* | |
28102 | ||
28103 | C...PYPDFL | |
28104 | C...Gives proton parton distribution at small x and/or Q^2 according to | |
28105 | C...correct limiting behaviour. | |
28106 | ||
28107 | SUBROUTINE PYPDFL(KF,X,Q2,XPQ) | |
28108 | ||
28109 | C...Double precision and integer declarations. | |
28110 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
28111 | IMPLICIT INTEGER(I-N) | |
28112 | INTEGER PYK,PYCHGE,PYCOMP | |
28113 | C...Commonblocks. | |
28114 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
28115 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
28116 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
28117 | COMMON/PYINT1/MINT(400),VINT(400) | |
28118 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ | |
28119 | C...Local arrays. | |
28120 | DIMENSION XPQ(-25:25),XPA(-25:25),XPB(-25:25),WTSB(-3:3) | |
28121 | DATA RMR/0.92D0/,RMP/0.38D0/,WTSB/0.5D0,1D0,1D0,5D0,1D0,1D0,0.5D0/ | |
28122 | ||
28123 | C...Send everything but protons/neutrons/VMD pions directly to PYPDFU. | |
28124 | MINT(92)=0 | |
28125 | KFA=IABS(KF) | |
28126 | IACC=0 | |
28127 | IF((KFA.EQ.2212.OR.KFA.EQ.2112).AND.MSTP(57).GE.2) IACC=1 | |
28128 | IF(KFA.EQ.211.AND.MSTP(57).GE.3) IACC=1 | |
28129 | IF(KFA.EQ.22.AND.MINT(109).EQ.2.AND.MSTP(57).GE.3) IACC=1 | |
28130 | IF(IACC.EQ.0) THEN | |
28131 | CALL PYPDFU(KF,X,Q2,XPQ) | |
28132 | RETURN | |
28133 | ENDIF | |
28134 | ||
28135 | C...Reset. Check x. | |
28136 | DO 100 KFL=-25,25 | |
28137 | XPQ(KFL)=0D0 | |
28138 | 100 CONTINUE | |
28139 | IF(X.LE.0D0.OR.X.GE.1D0) THEN | |
28140 | WRITE(MSTU(11),5000) X | |
28141 | RETURN | |
28142 | ENDIF | |
28143 | ||
28144 | C...Define valence content. | |
28145 | KFC=KF | |
28146 | NV1=2 | |
28147 | NV2=1 | |
28148 | IF(KF.EQ.2212) THEN | |
28149 | KFV1=2 | |
28150 | KFV2=1 | |
28151 | ELSEIF(KF.EQ.-2212) THEN | |
28152 | KFV1=-2 | |
28153 | KFV2=-1 | |
28154 | ELSEIF(KF.EQ.2112) THEN | |
28155 | KFV1=1 | |
28156 | KFV2=2 | |
28157 | ELSEIF(KF.EQ.-2112) THEN | |
28158 | KFV1=-1 | |
28159 | KFV2=-2 | |
28160 | ELSEIF(KF.EQ.211) THEN | |
28161 | NV1=1 | |
28162 | KFV1=2 | |
28163 | KFV2=-1 | |
28164 | ELSEIF(KF.EQ.-211) THEN | |
28165 | NV1=1 | |
28166 | KFV1=-2 | |
28167 | KFV2=1 | |
28168 | ELSEIF(MINT(105).LE.223) THEN | |
28169 | KFV1=1 | |
28170 | WTV1=0.2D0 | |
28171 | KFV2=2 | |
28172 | WTV2=0.8D0 | |
28173 | ELSEIF(MINT(105).EQ.333) THEN | |
28174 | KFV1=3 | |
28175 | WTV1=1.0D0 | |
28176 | KFV2=1 | |
28177 | WTV2=0.0D0 | |
28178 | ELSEIF(MINT(105).EQ.443) THEN | |
28179 | KFV1=4 | |
28180 | WTV1=1.0D0 | |
28181 | KFV2=1 | |
28182 | WTV2=0.0D0 | |
28183 | ENDIF | |
28184 | ||
28185 | C...Do naive evaluation and find min Q^2, boundary Q^2 and x_0. | |
28186 | CALL PYPDFU(KFC,X,Q2,XPA) | |
28187 | Q2MN=MAX(3D0,VINT(231)) | |
28188 | Q2B=2D0+0.052D0**2*EXP(3.56D0*SQRT(MAX(0D0,-LOG(3D0*X)))) | |
28189 | XMN=EXP(-(LOG((Q2MN-2D0)/0.052D0**2)/3.56D0)**2)/3D0 | |
28190 | ||
28191 | C...Large Q2 and large x: naive call is enough. | |
28192 | IF(Q2.GT.Q2MN.AND.Q2.GT.Q2B) THEN | |
28193 | DO 110 KFL=-25,25 | |
28194 | XPQ(KFL)=XPA(KFL) | |
28195 | 110 CONTINUE | |
28196 | MINT(92)=1 | |
28197 | ||
28198 | C...Small Q2 and large x: dampen boundary value. | |
28199 | ELSEIF(X.GT.XMN) THEN | |
28200 | ||
28201 | C...Evaluate at boundary and define dampening factors. | |
28202 | CALL PYPDFU(KFC,X,Q2MN,XPA) | |
28203 | FV=(Q2*(Q2MN+RMR)/(Q2MN*(Q2+RMR)))**(0.55D0*(1D0-X)/(1D0-XMN)) | |
28204 | FS=(Q2*(Q2MN+RMP)/(Q2MN*(Q2+RMP)))**1.08D0 | |
28205 | ||
28206 | C...Separate valence and sea parts of parton distribution. | |
28207 | IF(KFA.NE.22) THEN | |
28208 | XFV1=XPA(KFV1)-XPA(-KFV1) | |
28209 | XPA(KFV1)=XPA(-KFV1) | |
28210 | XFV2=XPA(KFV2)-XPA(-KFV2) | |
28211 | XPA(KFV2)=XPA(-KFV2) | |
28212 | ELSE | |
28213 | XPA(KFV1)=XPA(KFV1)-WTV1*VINT(232) | |
28214 | XPA(-KFV1)=XPA(-KFV1)-WTV1*VINT(232) | |
28215 | XPA(KFV2)=XPA(KFV2)-WTV2*VINT(232) | |
28216 | XPA(-KFV2)=XPA(-KFV2)-WTV2*VINT(232) | |
28217 | ENDIF | |
28218 | ||
28219 | C...Dampen valence and sea separately. Put back together. | |
28220 | DO 120 KFL=-25,25 | |
28221 | XPQ(KFL)=FS*XPA(KFL) | |
28222 | 120 CONTINUE | |
28223 | IF(KFA.NE.22) THEN | |
28224 | XPQ(KFV1)=XPQ(KFV1)+FV*XFV1 | |
28225 | XPQ(KFV2)=XPQ(KFV2)+FV*XFV2 | |
28226 | ELSE | |
28227 | XPQ(KFV1)=XPQ(KFV1)+FV*WTV1*VINT(232) | |
28228 | XPQ(-KFV1)=XPQ(-KFV1)+FV*WTV1*VINT(232) | |
28229 | XPQ(KFV2)=XPQ(KFV2)+FV*WTV2*VINT(232) | |
28230 | XPQ(-KFV2)=XPQ(-KFV2)+FV*WTV2*VINT(232) | |
28231 | ENDIF | |
28232 | MINT(92)=2 | |
28233 | ||
28234 | C...Large Q2 and small x: interpolate behaviour. | |
28235 | ELSEIF(Q2.GT.Q2MN) THEN | |
28236 | ||
28237 | C...Evaluate at extremes and define coefficients for interpolation. | |
28238 | CALL PYPDFU(KFC,XMN,Q2MN,XPA) | |
28239 | VI232A=VINT(232) | |
28240 | CALL PYPDFU(KFC,X,Q2B,XPB) | |
28241 | VI232B=VINT(232) | |
28242 | FLA=LOG(Q2B/Q2)/LOG(Q2B/Q2MN) | |
28243 | FVA=(X/XMN)**0.45D0*FLA | |
28244 | FSA=(X/XMN)**(-0.08D0)*FLA | |
28245 | FB=1D0-FLA | |
28246 | ||
28247 | C...Separate valence and sea parts of parton distribution. | |
28248 | IF(KFA.NE.22) THEN | |
28249 | XFVA1=XPA(KFV1)-XPA(-KFV1) | |
28250 | XPA(KFV1)=XPA(-KFV1) | |
28251 | XFVA2=XPA(KFV2)-XPA(-KFV2) | |
28252 | XPA(KFV2)=XPA(-KFV2) | |
28253 | XFVB1=XPB(KFV1)-XPB(-KFV1) | |
28254 | XPB(KFV1)=XPB(-KFV1) | |
28255 | XFVB2=XPB(KFV2)-XPB(-KFV2) | |
28256 | XPB(KFV2)=XPB(-KFV2) | |
28257 | ELSE | |
28258 | XPA(KFV1)=XPA(KFV1)-WTV1*VI232A | |
28259 | XPA(-KFV1)=XPA(-KFV1)-WTV1*VI232A | |
28260 | XPA(KFV2)=XPA(KFV2)-WTV2*VI232A | |
28261 | XPA(-KFV2)=XPA(-KFV2)-WTV2*VI232A | |
28262 | XPB(KFV1)=XPB(KFV1)-WTV1*VI232B | |
28263 | XPB(-KFV1)=XPB(-KFV1)-WTV1*VI232B | |
28264 | XPB(KFV2)=XPB(KFV2)-WTV2*VI232B | |
28265 | XPB(-KFV2)=XPB(-KFV2)-WTV2*VI232B | |
28266 | ENDIF | |
28267 | ||
28268 | C...Interpolate for valence and sea. Put back together. | |
28269 | DO 130 KFL=-25,25 | |
28270 | XPQ(KFL)=FSA*XPA(KFL)+FB*XPB(KFL) | |
28271 | 130 CONTINUE | |
28272 | IF(KFA.NE.22) THEN | |
28273 | XPQ(KFV1)=XPQ(KFV1)+(FVA*XFVA1+FB*XFVB1) | |
28274 | XPQ(KFV2)=XPQ(KFV2)+(FVA*XFVA2+FB*XFVB2) | |
28275 | ELSE | |
28276 | XPQ(KFV1)=XPQ(KFV1)+WTV1*(FVA*VI232A+FB*VI232B) | |
28277 | XPQ(-KFV1)=XPQ(-KFV1)+WTV1*(FVA*VI232A+FB*VI232B) | |
28278 | XPQ(KFV2)=XPQ(KFV2)+WTV2*(FVA*VI232A+FB*VI232B) | |
28279 | XPQ(-KFV2)=XPQ(-KFV2)+WTV2*(FVA*VI232A+FB*VI232B) | |
28280 | ENDIF | |
28281 | MINT(92)=3 | |
28282 | ||
28283 | C...Small Q2 and small x: dampen boundary value and add term. | |
28284 | ELSE | |
28285 | ||
28286 | C...Evaluate at boundary and define dampening factors. | |
28287 | CALL PYPDFU(KFC,XMN,Q2MN,XPA) | |
28288 | FB=(XMN-X)*(Q2MN-Q2)/(XMN*Q2MN) | |
28289 | FA=1D0-FB | |
28290 | FVC=(X/XMN)**0.45D0*(Q2/(Q2+RMR))**0.55D0 | |
28291 | FVA=FVC*FA*((Q2MN+RMR)/Q2MN)**0.55D0 | |
28292 | FVB=FVC*FB*1.10D0*XMN**0.45D0*0.11D0 | |
28293 | FSC=(X/XMN)**(-0.08D0)*(Q2/(Q2+RMP))**1.08D0 | |
28294 | FSA=FSC*FA*((Q2MN+RMP)/Q2MN)**1.08D0 | |
28295 | FSB=FSC*FB*0.21D0*XMN**(-0.08D0)*0.21D0 | |
28296 | ||
28297 | C...Separate valence and sea parts of parton distribution. | |
28298 | IF(KFA.NE.22) THEN | |
28299 | XFV1=XPA(KFV1)-XPA(-KFV1) | |
28300 | XPA(KFV1)=XPA(-KFV1) | |
28301 | XFV2=XPA(KFV2)-XPA(-KFV2) | |
28302 | XPA(KFV2)=XPA(-KFV2) | |
28303 | ELSE | |
28304 | XPA(KFV1)=XPA(KFV1)-WTV1*VINT(232) | |
28305 | XPA(-KFV1)=XPA(-KFV1)-WTV1*VINT(232) | |
28306 | XPA(KFV2)=XPA(KFV2)-WTV2*VINT(232) | |
28307 | XPA(-KFV2)=XPA(-KFV2)-WTV2*VINT(232) | |
28308 | ENDIF | |
28309 | ||
28310 | C...Dampen valence and sea separately. Add constant terms. | |
28311 | C...Put back together. | |
28312 | DO 140 KFL=-25,25 | |
28313 | XPQ(KFL)=FSA*XPA(KFL) | |
28314 | 140 CONTINUE | |
28315 | IF(KFA.NE.22) THEN | |
28316 | DO 150 KFL=-3,3 | |
28317 | XPQ(KFL)=XPQ(KFL)+FSB*WTSB(KFL) | |
28318 | 150 CONTINUE | |
28319 | XPQ(KFV1)=XPQ(KFV1)+(FVA*XFV1+FVB*NV1) | |
28320 | XPQ(KFV2)=XPQ(KFV2)+(FVA*XFV2+FVB*NV2) | |
28321 | ELSE | |
28322 | DO 160 KFL=-3,3 | |
28323 | XPQ(KFL)=XPQ(KFL)+VINT(281)*FSB*WTSB(KFL) | |
28324 | 160 CONTINUE | |
28325 | XPQ(KFV1)=XPQ(KFV1)+WTV1*(FVA*VINT(232)+FVB*VINT(281)) | |
28326 | XPQ(-KFV1)=XPQ(-KFV1)+WTV1*(FVA*VINT(232)+FVB*VINT(281)) | |
28327 | XPQ(KFV2)=XPQ(KFV2)+WTV2*(FVA*VINT(232)+FVB*VINT(281)) | |
28328 | XPQ(-KFV2)=XPQ(-KFV2)+WTV2*(FVA*VINT(232)+FVB*VINT(281)) | |
28329 | ENDIF | |
28330 | XPQ(21)=XPQ(0) | |
28331 | MINT(92)=4 | |
28332 | ENDIF | |
28333 | ||
28334 | C...Format for error printout. | |
28335 | 5000 FORMAT(' Error: x value outside physical range; x =',1P,D12.3) | |
28336 | ||
28337 | RETURN | |
28338 | END | |
28339 | ||
28340 | C********************************************************************* | |
28341 | ||
28342 | C...PYPDEL | |
28343 | C...Gives electron (or muon, or tau) parton distribution. | |
28344 | ||
28345 | SUBROUTINE PYPDEL(KFA,X,Q2,XPEL) | |
28346 | ||
28347 | C...Double precision and integer declarations. | |
28348 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
28349 | IMPLICIT INTEGER(I-N) | |
28350 | INTEGER PYK,PYCHGE,PYCOMP | |
28351 | C...Commonblocks. | |
28352 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
28353 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
28354 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
28355 | COMMON/PYINT1/MINT(400),VINT(400) | |
28356 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ | |
28357 | C...Local arrays. | |
28358 | DIMENSION XPEL(-25:25),XPGA(-6:6),SXP(0:6) | |
28359 | ||
28360 | C...Interface to PDFLIB. | |
81935ff8 | 28361 | COMMON/LW50513/XMIN,XMAX,Q2MIN,Q2MAX |
28362 | SAVE /LW50513/ | |
2dfa57d1 | 28363 | DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU, |
28364 | &VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX | |
28365 | CHARACTER*20 PARM(20) | |
28366 | DATA VALUE/20*0D0/,PARM/20*' '/ | |
28367 | ||
28368 | C...Some common constants. | |
28369 | DO 100 KFL=-25,25 | |
28370 | XPEL(KFL)=0D0 | |
28371 | 100 CONTINUE | |
28372 | AEM=PARU(101) | |
28373 | PME=PMAS(11,1) | |
28374 | IF(KFA.EQ.13) PME=PMAS(13,1) | |
28375 | IF(KFA.EQ.15) PME=PMAS(15,1) | |
28376 | XL=LOG(MAX(1D-10,X)) | |
28377 | X1L=LOG(MAX(1D-10,1D0-X)) | |
28378 | HLE=LOG(MAX(3D0,Q2/PME**2)) | |
28379 | HBE2=(AEM/PARU(1))*(HLE-1D0) | |
28380 | ||
28381 | C...Electron inside electron, see R. Kleiss et al., in Z physics at | |
28382 | C...LEP 1, CERN 89-08, p. 34 | |
28383 | IF(MSTP(59).LE.1) THEN | |
28384 | HDE=1D0+(AEM/PARU(1))*(1.5D0*HLE+1.289868D0)+(AEM/PARU(1))**2* | |
28385 | & (-2.164868D0*HLE**2+9.840808D0*HLE-10.130464D0) | |
28386 | HEE=HBE2*(1D0-X)**(HBE2-1D0)*SQRT(MAX(0D0,HDE))- | |
28387 | & 0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)*(-4D0*X1L+3D0*XL)- | |
28388 | & 4D0*XL/(1D0-X)-5D0-X) | |
28389 | ELSE | |
28390 | HEE=HBE2*(1D0-X)**(HBE2-1D0)*EXP(0.172784D0*HBE2)/ | |
28391 | & PYGAMM(1D0+HBE2)-0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)* | |
28392 | & (-4D0*X1L+3D0*XL)-4D0*XL/(1D0-X)-5D0-X) | |
28393 | ENDIF | |
28394 | C...Zero distribution for very large x and rescale it for intermediate. | |
28395 | IF(X.GT.1D0-1D-10) THEN | |
28396 | HEE=0D0 | |
28397 | ELSEIF(X.GT.1D0-1D-7) THEN | |
28398 | HEE=HEE*1000D0**HBE2/(1000D0**HBE2-1D0) | |
28399 | ENDIF | |
28400 | XPEL(KFA)=X*HEE | |
28401 | ||
28402 | C...Photon and (transverse) W- inside electron. | |
28403 | AEMP=PYALEM(PME*SQRT(MAX(0D0,Q2)))/PARU(2) | |
28404 | IF(MSTP(13).LE.1) THEN | |
28405 | HLG=HLE | |
28406 | ELSE | |
28407 | HLG=LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-X)/X**2)) | |
28408 | ENDIF | |
28409 | XPEL(22)=AEMP*HLG*(1D0+(1D0-X)**2) | |
28410 | HLW=LOG(1D0+Q2/PMAS(24,1)**2)/(4D0*PARU(102)) | |
28411 | XPEL(-24)=AEMP*HLW*(1D0+(1D0-X)**2) | |
28412 | ||
28413 | C...Electron or positron inside photon inside electron. | |
28414 | IF(KFA.EQ.11.AND.MSTP(12).EQ.1) THEN | |
28415 | XFSEA=0.5D0*(AEMP*(HLE-1D0))**2*(4D0/3D0+X-X**2-4D0*X**3/3D0+ | |
28416 | & 2D0*X*(1D0+X)*XL) | |
28417 | XPEL(11)=XPEL(11)+XFSEA | |
28418 | XPEL(-11)=XFSEA | |
28419 | ||
28420 | C...Initialize PDFLIB photon parton distributions. | |
28421 | IF(MSTP(56).EQ.2) THEN | |
28422 | PARM(1)='NPTYPE' | |
28423 | VALUE(1)=3 | |
28424 | PARM(2)='NGROUP' | |
28425 | VALUE(2)=MSTP(55)/1000 | |
28426 | PARM(3)='NSET' | |
28427 | VALUE(3)=MOD(MSTP(55),1000) | |
28428 | IF(MINT(93).NE.3000000+MSTP(55)) THEN | |
28429 | CALL PDFSET(PARM,VALUE) | |
28430 | MINT(93)=3000000+MSTP(55) | |
28431 | ENDIF | |
28432 | ENDIF | |
28433 | ||
28434 | C...Quarks and gluons inside photon inside electron: | |
28435 | C...numerical convolution required. | |
28436 | DO 110 KFL=0,6 | |
28437 | SXP(KFL)=0D0 | |
28438 | 110 CONTINUE | |
28439 | SUMXPP=0D0 | |
28440 | ITER=-1 | |
28441 | 120 ITER=ITER+1 | |
28442 | SUMXP=SUMXPP | |
28443 | NSTP=2**(ITER-1) | |
28444 | IF(ITER.EQ.0) NSTP=2 | |
28445 | DO 130 KFL=0,6 | |
28446 | SXP(KFL)=0.5D0*SXP(KFL) | |
28447 | 130 CONTINUE | |
28448 | WTSTP=0.5D0/NSTP | |
28449 | IF(ITER.EQ.0) WTSTP=0.5D0 | |
28450 | C...Pick grid of x_{gamma} values logarithmically even. | |
28451 | DO 150 ISTP=1,NSTP | |
28452 | IF(ITER.EQ.0) THEN | |
28453 | XLE=XL*(ISTP-1) | |
28454 | ELSE | |
28455 | XLE=XL*(ISTP-0.5D0)/NSTP | |
28456 | ENDIF | |
28457 | XE=MIN(1D0-1D-10,EXP(XLE)) | |
28458 | XG=MIN(1D0-1D-10,X/XE) | |
28459 | C...Evaluate photon inside electron parton distribution for convolution. | |
28460 | XPGP=1D0+(1D0-XE)**2 | |
28461 | IF(MSTP(13).LE.1) THEN | |
28462 | XPGP=XPGP*HLE | |
28463 | ELSE | |
28464 | XPGP=XPGP*LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-XE)/XE**2)) | |
28465 | ENDIF | |
28466 | C...Evaluate photon parton distributions for convolution. | |
28467 | IF(MSTP(56).EQ.1) THEN | |
28468 | IF(MSTP(55).EQ.1) THEN | |
28469 | CALL PYPDGA(XG,Q2,XPGA) | |
28470 | ELSEIF(MSTP(55).GE.5.AND.MSTP(55).LE.8) THEN | |
28471 | Q2MX=Q2 | |
28472 | P2MX=0.36D0 | |
28473 | IF(MSTP(55).GE.7) P2MX=4.0D0 | |
28474 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
28475 | P2=0D0 | |
28476 | IF(VINT(120).LT.0D0) P2=VINT(120)**2 | |
28477 | CALL PYGGAM(MSTP(55)-4,XG,Q2MX,P2,MSTP(60),F2GAM,XPGA) | |
28478 | VINT(231)=P2MX | |
28479 | ELSEIF(MSTP(55).GE.9.AND.MSTP(55).LE.12) THEN | |
28480 | Q2MX=Q2 | |
28481 | P2MX=0.36D0 | |
28482 | IF(MSTP(55).GE.11) P2MX=4.0D0 | |
28483 | IF(MSTP(57).EQ.0) Q2MX=P2MX | |
28484 | P2=0D0 | |
28485 | IF(VINT(120).LT.0D0) P2=VINT(120)**2 | |
28486 | CALL PYGGAM(MSTP(55)-8,XG,Q2MX,P2,MSTP(60),F2GAM,XPGA) | |
28487 | VINT(231)=P2MX | |
28488 | ENDIF | |
28489 | DO 140 KFL=0,5 | |
28490 | SXP(KFL)=SXP(KFL)+WTSTP*XPGP*XPGA(KFL) | |
28491 | 140 CONTINUE | |
28492 | ELSEIF(MSTP(56).EQ.2) THEN | |
28493 | C...Call PDFLIB parton distributions. | |
28494 | XX=XG | |
28495 | QQ=SQRT(MAX(0D0,Q2MIN,Q2)) | |
28496 | IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN) | |
28497 | CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) | |
28498 | SXP(0)=SXP(0)+WTSTP*XPGP*GLU | |
28499 | SXP(1)=SXP(1)+WTSTP*XPGP*DNV | |
28500 | SXP(2)=SXP(2)+WTSTP*XPGP*UPV | |
28501 | SXP(3)=SXP(3)+WTSTP*XPGP*STR | |
28502 | SXP(4)=SXP(4)+WTSTP*XPGP*CHM | |
28503 | SXP(5)=SXP(5)+WTSTP*XPGP*BOT | |
28504 | SXP(6)=SXP(6)+WTSTP*XPGP*TOP | |
28505 | ENDIF | |
28506 | 150 CONTINUE | |
28507 | SUMXPP=SXP(0)+2D0*SXP(1)+2D0*SXP(2) | |
28508 | IF(ITER.LE.2.OR.(ITER.LE.7.AND.ABS(SUMXPP-SUMXP).GT. | |
28509 | & PARP(14)*(SUMXPP+SUMXP))) GOTO 120 | |
28510 | ||
28511 | C...Put convolution into output arrays. | |
28512 | FCONV=AEMP*(-XL) | |
28513 | XPEL(0)=FCONV*SXP(0) | |
28514 | DO 160 KFL=1,6 | |
28515 | XPEL(KFL)=FCONV*SXP(KFL) | |
28516 | XPEL(-KFL)=XPEL(KFL) | |
28517 | 160 CONTINUE | |
28518 | ENDIF | |
28519 | ||
28520 | RETURN | |
28521 | END | |
28522 | ||
28523 | C********************************************************************* | |
28524 | ||
28525 | C...PYPDGA | |
28526 | C...Gives photon parton distribution. | |
28527 | ||
28528 | SUBROUTINE PYPDGA(X,Q2,XPGA) | |
28529 | ||
28530 | C...Double precision and integer declarations. | |
28531 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
28532 | IMPLICIT INTEGER(I-N) | |
28533 | INTEGER PYK,PYCHGE,PYCOMP | |
28534 | C...Commonblocks. | |
28535 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
28536 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
28537 | COMMON/PYINT1/MINT(400),VINT(400) | |
28538 | SAVE /PYDAT1/,/PYPARS/,/PYINT1/ | |
28539 | C...Local arrays. | |
28540 | DIMENSION XPGA(-6:6),DGAG(4,3),DGBG(4,3),DGCG(4,3),DGAN(4,3), | |
28541 | &DGBN(4,3),DGCN(4,3),DGDN(4,3),DGEN(4,3),DGAS(4,3),DGBS(4,3), | |
28542 | &DGCS(4,3),DGDS(4,3),DGES(4,3) | |
28543 | ||
28544 | C...The following data lines are coefficients needed in the | |
28545 | C...Drees and Grassie photon parton distribution parametrization. | |
28546 | DATA DGAG/-.207D0,.6158D0,1.074D0,0.D0,.8926D-2,.6594D0, | |
28547 | &.4766D0,.1975D-1,.03197D0,1.018D0,.2461D0,.2707D-1/ | |
28548 | DATA DGBG/-.1987D0,.6257D0,8.352D0,5.024D0,.5085D-1,.2774D0, | |
28549 | &-.3906D0,-.3212D0,-.618D-2,.9476D0,-.6094D0,-.1067D-1/ | |
28550 | DATA DGCG/5.119D0,-.2752D0,-6.993D0,2.298D0,-.2313D0,.1382D0, | |
28551 | &6.542D0,.5162D0,-.1216D0,.9047D0,2.653D0,.2003D-2/ | |
28552 | DATA DGAN/2.285D0,-.1526D-1,1330.D0,4.219D0,-.3711D0,1.061D0, | |
28553 | &4.758D0,-.1503D-1,15.8D0,-.9464D0,-.5D0,-.2118D0/ | |
28554 | DATA DGBN/6.073D0,-.8132D0,-41.31D0,3.165D0,-.1717D0,.7815D0, | |
28555 | &1.535D0,.7067D-2,2.742D0,-.7332D0,.7148D0,3.287D0/ | |
28556 | DATA DGCN/-.4202D0,.1778D-1,.9216D0,.18D0,.8766D-1,.2197D-1, | |
28557 | &.1096D0,.204D0,.2917D-1,.4657D-1,.1785D0,.4811D-1/ | |
28558 | DATA DGDN/-.8083D-1,.6346D0,1.208D0,.203D0,-.8915D0,.2857D0, | |
28559 | &2.973D0,.1185D0,-.342D-1,.7196D0,.7338D0,.8139D-1/ | |
28560 | DATA DGEN/.5526D-1,1.136D0,.9512D0,.1163D-1,-.1816D0,.5866D0, | |
28561 | &2.421D0,.4059D0,-.2302D-1,.9229D0,.5873D0,-.79D-4/ | |
28562 | DATA DGAS/16.69D0,-.7916D0,1099.D0,4.428D0,-.1207D0,1.071D0, | |
28563 | &1.977D0,-.8625D-2,6.734D0,-1.008D0,-.8594D-1,.7625D-1/ | |
28564 | DATA DGBS/.176D0,.4794D-1,1.047D0,.25D-1,25.D0,-1.648D0, | |
28565 | &-.1563D-1,6.438D0,59.88D0,-2.983D0,4.48D0,.9686D0/ | |
28566 | DATA DGCS/-.208D-1,.3386D-2,4.853D0,.8404D0,-.123D-1,1.162D0, | |
28567 | &.4824D0,-.11D-1,-.3226D-2,.8432D0,.3616D0,.1383D-2/ | |
28568 | DATA DGDS/-.1685D-1,1.353D0,1.426D0,1.239D0,-.9194D-1,.7912D0, | |
28569 | &.6397D0,2.327D0,-.3321D-1,.9475D0,-.3198D0,.2132D-1/ | |
28570 | DATA DGES/-.1986D0,1.1D0,1.136D0,-.2779D0,.2015D-1,.9869D0, | |
28571 | &-.7036D-1,.1694D-1,.1059D0,.6954D0,-.6663D0,.3683D0/ | |
28572 | ||
28573 | C...Photon parton distribution from Drees and Grassie. | |
28574 | C...Allowed variable range: 1 GeV^2 < Q^2 < 10000 GeV^2. | |
28575 | DO 100 KFL=-6,6 | |
28576 | XPGA(KFL)=0D0 | |
28577 | 100 CONTINUE | |
28578 | VINT(231)=1D0 | |
28579 | IF(MSTP(57).LE.0) THEN | |
28580 | T=LOG(1D0/0.16D0) | |
28581 | ELSE | |
28582 | T=LOG(MIN(1D4,MAX(1D0,Q2))/0.16D0) | |
28583 | ENDIF | |
28584 | X1=1D0-X | |
28585 | NF=3 | |
28586 | IF(Q2.GT.25D0) NF=4 | |
28587 | IF(Q2.GT.300D0) NF=5 | |
28588 | NFE=NF-2 | |
28589 | AEM=PARU(101) | |
28590 | ||
28591 | C...Evaluate gluon content. | |
28592 | DGA=DGAG(1,NFE)*T**DGAG(2,NFE)+DGAG(3,NFE)*T**(-DGAG(4,NFE)) | |
28593 | DGB=DGBG(1,NFE)*T**DGBG(2,NFE)+DGBG(3,NFE)*T**(-DGBG(4,NFE)) | |
28594 | DGC=DGCG(1,NFE)*T**DGCG(2,NFE)+DGCG(3,NFE)*T**(-DGCG(4,NFE)) | |
28595 | XPGL=DGA*X**DGB*X1**DGC | |
28596 | ||
28597 | C...Evaluate up- and down-type quark content. | |
28598 | DGA=DGAN(1,NFE)*T**DGAN(2,NFE)+DGAN(3,NFE)*T**(-DGAN(4,NFE)) | |
28599 | DGB=DGBN(1,NFE)*T**DGBN(2,NFE)+DGBN(3,NFE)*T**(-DGBN(4,NFE)) | |
28600 | DGC=DGCN(1,NFE)*T**DGCN(2,NFE)+DGCN(3,NFE)*T**(-DGCN(4,NFE)) | |
28601 | DGD=DGDN(1,NFE)*T**DGDN(2,NFE)+DGDN(3,NFE)*T**(-DGDN(4,NFE)) | |
28602 | DGE=DGEN(1,NFE)*T**DGEN(2,NFE)+DGEN(3,NFE)*T**(-DGEN(4,NFE)) | |
28603 | XPQN=X*(X**2+X1**2)/(DGA-DGB*LOG(X1))+DGC*X**DGD*X1**DGE | |
28604 | DGA=DGAS(1,NFE)*T**DGAS(2,NFE)+DGAS(3,NFE)*T**(-DGAS(4,NFE)) | |
28605 | DGB=DGBS(1,NFE)*T**DGBS(2,NFE)+DGBS(3,NFE)*T**(-DGBS(4,NFE)) | |
28606 | DGC=DGCS(1,NFE)*T**DGCS(2,NFE)+DGCS(3,NFE)*T**(-DGCS(4,NFE)) | |
28607 | DGD=DGDS(1,NFE)*T**DGDS(2,NFE)+DGDS(3,NFE)*T**(-DGDS(4,NFE)) | |
28608 | DGE=DGES(1,NFE)*T**DGES(2,NFE)+DGES(3,NFE)*T**(-DGES(4,NFE)) | |
28609 | DGF=9D0 | |
28610 | IF(NF.EQ.4) DGF=10D0 | |
28611 | IF(NF.EQ.5) DGF=55D0/6D0 | |
28612 | XPQS=DGF*X*(X**2+X1**2)/(DGA-DGB*LOG(X1))+DGC*X**DGD*X1**DGE | |
28613 | IF(NF.LE.3) THEN | |
28614 | XPQU=(XPQS+9D0*XPQN)/6D0 | |
28615 | XPQD=(XPQS-4.5D0*XPQN)/6D0 | |
28616 | ELSEIF(NF.EQ.4) THEN | |
28617 | XPQU=(XPQS+6D0*XPQN)/8D0 | |
28618 | XPQD=(XPQS-6D0*XPQN)/8D0 | |
28619 | ELSE | |
28620 | XPQU=(XPQS+7.5D0*XPQN)/10D0 | |
28621 | XPQD=(XPQS-5D0*XPQN)/10D0 | |
28622 | ENDIF | |
28623 | ||
28624 | C...Put into output arrays. | |
28625 | XPGA(0)=AEM*XPGL | |
28626 | XPGA(1)=AEM*XPQD | |
28627 | XPGA(2)=AEM*XPQU | |
28628 | XPGA(3)=AEM*XPQD | |
28629 | IF(NF.GE.4) XPGA(4)=AEM*XPQU | |
28630 | IF(NF.GE.5) XPGA(5)=AEM*XPQD | |
28631 | DO 110 KFL=1,6 | |
28632 | XPGA(-KFL)=XPGA(KFL) | |
28633 | 110 CONTINUE | |
28634 | ||
28635 | RETURN | |
28636 | END | |
28637 | ||
28638 | C********************************************************************* | |
28639 | ||
28640 | C...PYGGAM | |
28641 | C...Constructs the F2 and parton distributions of the photon | |
28642 | C...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms. | |
28643 | C...For F2, c and b are included by the Bethe-Heitler formula; | |
28644 | C...in the 'MSbar' scheme additionally a Cgamma term is added. | |
28645 | C...Contains the SaS sets 1D, 1M, 2D and 2M. | |
28646 | C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. | |
28647 | ||
28648 | SUBROUTINE PYGGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM) | |
28649 | ||
28650 | C...Double precision and integer declarations. | |
28651 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
28652 | IMPLICIT INTEGER(I-N) | |
28653 | INTEGER PYK,PYCHGE,PYCOMP | |
28654 | C...Commonblocks. | |
28655 | COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), | |
28656 | &XPDIR(-6:6) | |
28657 | COMMON/PYINT9/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6) | |
28658 | SAVE /PYINT8/,/PYINT9/ | |
28659 | C...Local arrays. | |
28660 | DIMENSION XPDFGM(-6:6),XPGA(-6:6), VXPGA(-6:6) | |
28661 | C...Charm and bottom masses (low to compensate for J/psi etc.). | |
28662 | DATA PMC/1.3D0/, PMB/4.6D0/ | |
28663 | C...alpha_em and alpha_em/(2*pi). | |
28664 | DATA AEM/0.007297D0/, AEM2PI/0.0011614D0/ | |
28665 | C...Lambda value for 4 flavours. | |
28666 | DATA ALAM/0.20D0/ | |
28667 | C...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum. | |
28668 | DATA FRACU/0.8D0/ | |
28669 | C...VMD couplings f_V**2/(4*pi). | |
28670 | DATA FRHO/2.20D0/, FOMEGA/23.6D0/, FPHI/18.4D0/ | |
28671 | C...Masses for rho (=omega) and phi. | |
28672 | DATA PMRHO/0.770D0/, PMPHI/1.020D0/ | |
28673 | C...Number of points in integration for IP2=1. | |
28674 | DATA NSTEP/100/ | |
28675 | ||
28676 | C...Reset output. | |
28677 | F2GM=0D0 | |
28678 | DO 100 KFL=-6,6 | |
28679 | XPDFGM(KFL)=0D0 | |
28680 | XPVMD(KFL)=0D0 | |
28681 | XPANL(KFL)=0D0 | |
28682 | XPANH(KFL)=0D0 | |
28683 | XPBEH(KFL)=0D0 | |
28684 | XPDIR(KFL)=0D0 | |
28685 | VXPVMD(KFL)=0D0 | |
28686 | VXPANL(KFL)=0D0 | |
28687 | VXPANH(KFL)=0D0 | |
28688 | VXPDGM(KFL)=0D0 | |
28689 | 100 CONTINUE | |
28690 | ||
28691 | C...Set Q0 cut-off parameter as function of set used. | |
28692 | IF(ISET.LE.2) THEN | |
28693 | Q0=0.6D0 | |
28694 | ELSE | |
28695 | Q0=2D0 | |
28696 | ENDIF | |
28697 | Q02=Q0**2 | |
28698 | ||
28699 | C...Scale choice for off-shell photon; common factors. | |
28700 | Q2A=Q2 | |
28701 | FACNOR=1D0 | |
28702 | IF(IP2.EQ.1) THEN | |
28703 | P2MX=P2+Q02 | |
28704 | Q2A=Q2+P2*Q02/MAX(Q02,Q2) | |
28705 | FACNOR=LOG(Q2/Q02)/NSTEP | |
28706 | ELSEIF(IP2.EQ.2) THEN | |
28707 | P2MX=MAX(P2,Q02) | |
28708 | ELSEIF(IP2.EQ.3) THEN | |
28709 | P2MX=P2+Q02 | |
28710 | Q2A=Q2+P2*Q02/MAX(Q02,Q2) | |
28711 | ELSEIF(IP2.EQ.4) THEN | |
28712 | P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ | |
28713 | & ((Q2+P2)*(Q02+P2))) | |
28714 | ELSEIF(IP2.EQ.5) THEN | |
28715 | P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ | |
28716 | & ((Q2+P2)*(Q02+P2))) | |
28717 | P2MX=Q0*SQRT(P2MXA) | |
28718 | FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MX) | |
28719 | ELSEIF(IP2.EQ.6) THEN | |
28720 | P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ | |
28721 | & ((Q2+P2)*(Q02+P2))) | |
28722 | P2MX=MAX(0D0,1D0-P2/Q2)*P2MX+MIN(1D0,P2/Q2)*MAX(P2,Q02) | |
28723 | ELSE | |
28724 | P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ | |
28725 | & ((Q2+P2)*(Q02+P2))) | |
28726 | P2MX=Q0*SQRT(P2MXA) | |
28727 | P2MXB=P2MX | |
28728 | P2MX=MAX(0D0,1D0-P2/Q2)*P2MX+MIN(1D0,P2/Q2)*MAX(P2,Q02) | |
28729 | P2MXB=MAX(0D0,1D0-P2/Q2)*P2MXB+MIN(1D0,P2/Q2)*P2MXA | |
28730 | IF(ABS(Q2-Q02).GT.1D-6) THEN | |
28731 | FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MXB) | |
28732 | ELSEIF(P2.LT.Q02) THEN | |
28733 | FACNOR=Q02**3/(Q02+P2)/(Q02**2-P2**2/2D0) | |
28734 | ELSE | |
28735 | FACNOR=1D0 | |
28736 | ENDIF | |
28737 | ENDIF | |
28738 | ||
28739 | C...Call VMD parametrization for d quark and use to give rho, omega, | |
28740 | C...phi. Note dipole dampening for off-shell photon. | |
28741 | CALL PYGVMD(ISET,1,X,Q2A,P2MX,ALAM,XPGA,VXPGA) | |
28742 | XFVAL=VXPGA(1) | |
28743 | XPGA(1)=XPGA(2) | |
28744 | XPGA(-1)=XPGA(-2) | |
28745 | FACUD=AEM*(1D0/FRHO+1D0/FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2 | |
28746 | FACS=AEM*(1D0/FPHI)*(PMPHI**2/(PMPHI**2+P2))**2 | |
28747 | DO 110 KFL=-5,5 | |
28748 | XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL) | |
28749 | 110 CONTINUE | |
28750 | XPVMD(1)=XPVMD(1)+(1D0-FRACU)*FACUD*XFVAL | |
28751 | XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL | |
28752 | XPVMD(3)=XPVMD(3)+FACS*XFVAL | |
28753 | XPVMD(-1)=XPVMD(-1)+(1D0-FRACU)*FACUD*XFVAL | |
28754 | XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL | |
28755 | XPVMD(-3)=XPVMD(-3)+FACS*XFVAL | |
28756 | VXPVMD(1)=(1D0-FRACU)*FACUD*XFVAL | |
28757 | VXPVMD(2)=FRACU*FACUD*XFVAL | |
28758 | VXPVMD(3)=FACS*XFVAL | |
28759 | VXPVMD(-1)=(1D0-FRACU)*FACUD*XFVAL | |
28760 | VXPVMD(-2)=FRACU*FACUD*XFVAL | |
28761 | VXPVMD(-3)=FACS*XFVAL | |
28762 | ||
28763 | IF(IP2.NE.1) THEN | |
28764 | C...Anomalous parametrizations for different strategies | |
28765 | C...for off-shell photons; except full integration. | |
28766 | ||
28767 | C...Call anomalous parametrization for d + u + s. | |
28768 | CALL PYGANO(-3,X,Q2A,P2MX,ALAM,XPGA,VXPGA) | |
28769 | DO 120 KFL=-5,5 | |
28770 | XPANL(KFL)=FACNOR*XPGA(KFL) | |
28771 | VXPANL(KFL)=FACNOR*VXPGA(KFL) | |
28772 | 120 CONTINUE | |
28773 | ||
28774 | C...Call anomalous parametrization for c and b. | |
28775 | CALL PYGANO(4,X,Q2A,P2MX,ALAM,XPGA,VXPGA) | |
28776 | DO 130 KFL=-5,5 | |
28777 | XPANH(KFL)=FACNOR*XPGA(KFL) | |
28778 | VXPANH(KFL)=FACNOR*VXPGA(KFL) | |
28779 | 130 CONTINUE | |
28780 | CALL PYGANO(5,X,Q2A,P2MX,ALAM,XPGA,VXPGA) | |
28781 | DO 140 KFL=-5,5 | |
28782 | XPANH(KFL)=XPANH(KFL)+FACNOR*XPGA(KFL) | |
28783 | VXPANH(KFL)=VXPANH(KFL)+FACNOR*VXPGA(KFL) | |
28784 | 140 CONTINUE | |
28785 | ||
28786 | ELSE | |
28787 | C...Special option: loop over flavours and integrate over k2. | |
28788 | DO 170 KF=1,5 | |
28789 | DO 160 ISTEP=1,NSTEP | |
28790 | Q2STEP=Q02*(Q2/Q02)**((ISTEP-0.5D0)/NSTEP) | |
28791 | IF((KF.EQ.4.AND.Q2STEP.LT.PMC**2).OR. | |
28792 | & (KF.EQ.5.AND.Q2STEP.LT.PMB**2)) GOTO 160 | |
28793 | CALL PYGVMD(0,KF,X,Q2,Q2STEP,ALAM,XPGA,VXPGA) | |
28794 | FACQ=AEM2PI*(Q2STEP/(Q2STEP+P2))**2*FACNOR | |
28795 | IF(MOD(KF,2).EQ.0) FACQ=FACQ*(8D0/9D0) | |
28796 | IF(MOD(KF,2).EQ.1) FACQ=FACQ*(2D0/9D0) | |
28797 | DO 150 KFL=-5,5 | |
28798 | IF(KF.LE.3) XPANL(KFL)=XPANL(KFL)+FACQ*XPGA(KFL) | |
28799 | IF(KF.GE.4) XPANH(KFL)=XPANH(KFL)+FACQ*XPGA(KFL) | |
28800 | IF(KF.LE.3) VXPANL(KFL)=VXPANL(KFL)+FACQ*VXPGA(KFL) | |
28801 | IF(KF.GE.4) VXPANH(KFL)=VXPANH(KFL)+FACQ*VXPGA(KFL) | |
28802 | 150 CONTINUE | |
28803 | 160 CONTINUE | |
28804 | 170 CONTINUE | |
28805 | ENDIF | |
28806 | ||
28807 | C...Call Bethe-Heitler term expression for charm and bottom. | |
28808 | CALL PYGBEH(4,X,Q2,P2,PMC**2,XPBH) | |
28809 | XPBEH(4)=XPBH | |
28810 | XPBEH(-4)=XPBH | |
28811 | CALL PYGBEH(5,X,Q2,P2,PMB**2,XPBH) | |
28812 | XPBEH(5)=XPBH | |
28813 | XPBEH(-5)=XPBH | |
28814 | ||
28815 | C...For MSbar subtraction call C^gamma term expression for d, u, s. | |
28816 | IF(ISET.EQ.2.OR.ISET.EQ.4) THEN | |
28817 | CALL PYGDIR(X,Q2,P2,Q02,XPGA) | |
28818 | DO 180 KFL=-5,5 | |
28819 | XPDIR(KFL)=XPGA(KFL) | |
28820 | 180 CONTINUE | |
28821 | ENDIF | |
28822 | ||
28823 | C...Store result in output array. | |
28824 | DO 190 KFL=-5,5 | |
28825 | CHSQ=1D0/9D0 | |
28826 | IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4D0/9D0 | |
28827 | XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) | |
28828 | IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2 | |
28829 | XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL) | |
28830 | VXPDGM(KFL)=VXPVMD(KFL)+VXPANL(KFL)+VXPANH(KFL) | |
28831 | 190 CONTINUE | |
28832 | ||
28833 | RETURN | |
28834 | END | |
28835 | ||
28836 | C********************************************************************* | |
28837 | ||
28838 | C...PYGVMD | |
28839 | C...Evaluates the VMD parton distributions of a photon, | |
28840 | C...evolved homogeneously from an initial scale P2 to Q2. | |
28841 | C...Does not include dipole suppression factor. | |
28842 | C...ISET is parton distribution set, see above; | |
28843 | C...additionally ISET=0 is used for the evolution of an anomalous photon | |
28844 | C...which branched at a scale P2 and then evolved homogeneously to Q2. | |
28845 | C...ALAM is the 4-flavour Lambda, which is automatically converted | |
28846 | C...to 3- and 5-flavour equivalents as needed. | |
28847 | C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. | |
28848 | ||
28849 | SUBROUTINE PYGVMD(ISET,KF,X,Q2,P2,ALAM,XPGA,VXPGA) | |
28850 | ||
28851 | C...Double precision and integer declarations. | |
28852 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
28853 | IMPLICIT INTEGER(I-N) | |
28854 | INTEGER PYK,PYCHGE,PYCOMP | |
28855 | C...Local arrays and data. | |
28856 | DIMENSION XPGA(-6:6), VXPGA(-6:6) | |
28857 | DATA PMC/1.3D0/, PMB/4.6D0/, AEM/0.007297D0/, AEM2PI/0.0011614D0/ | |
28858 | ||
28859 | C...Reset output. | |
28860 | DO 100 KFL=-6,6 | |
28861 | XPGA(KFL)=0D0 | |
28862 | VXPGA(KFL)=0D0 | |
28863 | 100 CONTINUE | |
28864 | KFA=IABS(KF) | |
28865 | ||
28866 | C...Calculate Lambda; protect against unphysical Q2 and P2 input. | |
28867 | ALAM3=ALAM*(PMC/ALAM)**(2D0/27D0) | |
28868 | ALAM5=ALAM*(ALAM/PMB)**(2D0/23D0) | |
28869 | P2EFF=MAX(P2,1.2D0*ALAM3**2) | |
28870 | IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2) | |
28871 | IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2) | |
28872 | Q2EFF=MAX(Q2,P2EFF) | |
28873 | ||
28874 | C...Find number of flavours at lower and upper scale. | |
28875 | NFP=4 | |
28876 | IF(P2EFF.LT.PMC**2) NFP=3 | |
28877 | IF(P2EFF.GT.PMB**2) NFP=5 | |
28878 | NFQ=4 | |
28879 | IF(Q2EFF.LT.PMC**2) NFQ=3 | |
28880 | IF(Q2EFF.GT.PMB**2) NFQ=5 | |
28881 | ||
28882 | C...Find s as sum of 3-, 4- and 5-flavour parts. | |
28883 | S=0D0 | |
28884 | IF(NFP.EQ.3) THEN | |
28885 | Q2DIV=PMC**2 | |
28886 | IF(NFQ.EQ.3) Q2DIV=Q2EFF | |
28887 | S=S+(6D0/27D0)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2)) | |
28888 | ENDIF | |
28889 | IF(NFP.LE.4.AND.NFQ.GE.4) THEN | |
28890 | P2DIV=P2EFF | |
28891 | IF(NFP.EQ.3) P2DIV=PMC**2 | |
28892 | Q2DIV=Q2EFF | |
28893 | IF(NFQ.EQ.5) Q2DIV=PMB**2 | |
28894 | S=S+(6D0/25D0)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2)) | |
28895 | ENDIF | |
28896 | IF(NFQ.EQ.5) THEN | |
28897 | P2DIV=PMB**2 | |
28898 | IF(NFP.EQ.5) P2DIV=P2EFF | |
28899 | S=S+(6D0/23D0)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2)) | |
28900 | ENDIF | |
28901 | ||
28902 | C...Calculate frequent combinations of x and s. | |
28903 | X1=1D0-X | |
28904 | XL=-LOG(X) | |
28905 | S2=S**2 | |
28906 | S3=S**3 | |
28907 | S4=S**4 | |
28908 | ||
28909 | C...Evaluate homogeneous anomalous parton distributions below or | |
28910 | C...above threshold. | |
28911 | IF(ISET.EQ.0) THEN | |
28912 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
28913 | & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
28914 | XVAL = X * 1.5D0 * (X**2+X1**2) | |
28915 | XGLU = 0D0 | |
28916 | XSEA = 0D0 | |
28917 | ELSE | |
28918 | XVAL = (1.5D0/(1D0-0.197D0*S+4.33D0*S2)*X**2 + | |
28919 | & (1.5D0+2.10D0*S)/(1D0+3.29D0*S)*X1**2 + | |
28920 | & 5.23D0*S/(1D0+1.17D0*S+19.9D0*S3)*X*X1) * | |
28921 | & X**(1D0/(1D0+1.5D0*S)) * (1D0-X**2)**(2.667D0*S) | |
28922 | XGLU = 4D0*S/(1D0+4.76D0*S+15.2D0*S2+29.3D0*S4) * | |
28923 | & X**(-2.03D0*S/(1D0+2.44D0*S)) * (X1*XL)**(1.333D0*S) * | |
28924 | & ((4D0*X**2+7D0*X+4D0)*X1/3D0 - 2D0*X*(1D0+X)*XL) | |
28925 | XSEA = S2/(1D0+4.54D0*S+8.19D0*S2+8.05D0*S3) * | |
28926 | & X**(-1.54D0*S/(1D0+1.29D0*S)) * X1**(2.667D0*S) * | |
28927 | & ((8D0-73D0*X+62D0*X**2)*X1/9D0 + (3D0-8D0*X**2/3D0)*X*XL + | |
28928 | & (2D0*X-1D0)*X*XL**2) | |
28929 | ENDIF | |
28930 | ||
28931 | C...Evaluate set 1D parton distributions below or above threshold. | |
28932 | ELSEIF(ISET.EQ.1) THEN | |
28933 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
28934 | & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
28935 | XVAL = 1.294D0 * X**0.80D0 * X1**0.76D0 | |
28936 | XGLU = 1.273D0 * X**0.40D0 * X1**1.76D0 | |
28937 | XSEA = 0.100D0 * X1**3.76D0 | |
28938 | ELSE | |
28939 | XVAL = 1.294D0/(1D0+0.252D0*S+3.079D0*S2) * | |
28940 | & X**(0.80D0-0.13D0*S) * X1**(0.76D0+0.667D0*S) * XL**(2D0*S) | |
28941 | XGLU = 7.90D0*S/(1D0+5.50D0*S) * EXP(-5.16D0*S) * | |
28942 | & X**(-1.90D0*S/(1D0+3.60D0*S)) * X1**1.30D0 * | |
28943 | & XL**(0.50D0+3D0*S) + 1.273D0 * EXP(-10D0*S) * | |
28944 | & X**0.40D0 * X1**(1.76D0+3D0*S) | |
28945 | XSEA = (0.1D0-0.397D0*S2+1.121D0*S3)/ | |
28946 | & (1D0+5.61D0*S2+5.26D0*S3) * X**(-7.32D0*S2/(1D0+10.3D0*S2)) * | |
28947 | & X1**((3.76D0+15D0*S+12D0*S2)/(1D0+4D0*S)) | |
28948 | XSEA0 = 0.100D0 * X1**3.76D0 | |
28949 | ENDIF | |
28950 | ||
28951 | C...Evaluate set 1M parton distributions below or above threshold. | |
28952 | ELSEIF(ISET.EQ.2) THEN | |
28953 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
28954 | & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
28955 | XVAL = 0.8477D0 * X**0.51D0 * X1**1.37D0 | |
28956 | XGLU = 3.42D0 * X**0.255D0 * X1**2.37D0 | |
28957 | XSEA = 0D0 | |
28958 | ELSE | |
28959 | XVAL = 0.8477D0/(1D0+1.37D0*S+2.18D0*S2+3.73D0*S3) * | |
28960 | & X**(0.51D0+0.21D0*S) * X1**1.37D0 * XL**(2.667D0*S) | |
28961 | XGLU = 24D0*S/(1D0+9.6D0*S+0.92D0*S2+14.34D0*S3) * | |
28962 | & EXP(-5.94D0*S) * X**((-0.013D0-1.80D0*S)/(1D0+3.14D0*S)) * | |
28963 | & X1**(2.37D0+0.4D0*S) * XL**(0.32D0+3.6D0*S) + 3.42D0 * | |
28964 | & EXP(-12D0*S) * X**0.255D0 * X1**(2.37D0+3D0*S) | |
28965 | XSEA = 0.842D0*S/(1D0+21.3D0*S-33.2D0*S2+229D0*S3) * | |
28966 | & X**((0.13D0-2.90D0*S)/(1D0+5.44D0*S)) * X1**(3.45D0+0.5D0*S) * | |
28967 | & XL**(2.8D0*S) | |
28968 | XSEA0 = 0D0 | |
28969 | ENDIF | |
28970 | ||
28971 | C...Evaluate set 2D parton distributions below or above threshold. | |
28972 | ELSEIF(ISET.EQ.3) THEN | |
28973 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
28974 | & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
28975 | XVAL = X**0.46D0 * X1**0.64D0 + 0.76D0 * X | |
28976 | XGLU = 1.925D0 * X1**2 | |
28977 | XSEA = 0.242D0 * X1**4 | |
28978 | ELSE | |
28979 | XVAL = (1D0+0.186D0*S)/(1D0-0.209D0*S+1.495D0*S2) * | |
28980 | & X**(0.46D0+0.25D0*S) * | |
28981 | & X1**((0.64D0+0.14D0*S+5D0*S2)/(1D0+S)) * XL**(1.9D0*S) + | |
28982 | & (0.76D0+0.4D0*S) * X * X1**(2.667D0*S) | |
28983 | XGLU = (1.925D0+5.55D0*S+147D0*S2)/(1D0-3.59D0*S+3.32D0*S2) * | |
28984 | & EXP(-18.67D0*S) * | |
28985 | & X**((-5.81D0*S-5.34D0*S2)/(1D0+29D0*S-4.26D0*S2)) | |
28986 | & * X1**((2D0-5.9D0*S)/(1D0+1.7D0*S)) * | |
28987 | & XL**(9.3D0*S/(1D0+1.7D0*S)) | |
28988 | XSEA = (0.242D0-0.252D0*S+1.19D0*S2)/ | |
28989 | & (1D0-0.607D0*S+21.95D0*S2) * | |
28990 | & X**(-12.1D0*S2/(1D0+2.62D0*S+16.7D0*S2)) * X1**4 * XL**S | |
28991 | XSEA0 = 0.242D0 * X1**4 | |
28992 | ENDIF | |
28993 | ||
28994 | C...Evaluate set 2M parton distributions below or above threshold. | |
28995 | ELSEIF(ISET.EQ.4) THEN | |
28996 | IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. | |
28997 | & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN | |
28998 | XVAL = 1.168D0 * X**0.50D0 * X1**2.60D0 + 0.965D0 * X | |
28999 | XGLU = 1.808D0 * X1**2 | |
29000 | XSEA = 0.209D0 * X1**4 | |
29001 | ELSE | |
29002 | XVAL = (1.168D0+1.771D0*S+29.35D0*S2) * EXP(-5.776D0*S) * | |
29003 | & X**((0.5D0+0.208D0*S)/(1D0-0.794D0*S+1.516D0*S2)) * | |
29004 | & X1**((2.6D0+7.6D0*S)/(1D0+5D0*S)) * | |
29005 | & XL**(5.15D0*S/(1D0+2D0*S)) + | |
29006 | & (0.965D0+22.35D0*S)/(1D0+18.4D0*S) * X * X1**(2.667D0*S) | |
29007 | XGLU = (1.808D0+29.9D0*S)/(1D0+26.4D0*S) * EXP(-5.28D0*S) * | |
29008 | & X**((-5.35D0*S-10.11D0*S2)/(1D0+31.71D0*S)) * | |
29009 | & X1**((2D0-7.3D0*S+4D0*S2)/(1D0+2.5D0*S)) * | |
29010 | & XL**(10.9D0*S/(1D0+2.5D0*S)) | |
29011 | XSEA = (0.209D0+0.644D0*S2)/(1D0+0.319D0*S+17.6D0*S2) * | |
29012 | & X**((-0.373D0*S-7.71D0*S2)/(1D0+0.815D0*S+11.0D0*S2)) * | |
29013 | & X1**(4D0+S) * XL**(0.45D0*S) | |
29014 | XSEA0 = 0.209D0 * X1**4 | |
29015 | ENDIF | |
29016 | ENDIF | |
29017 | ||
29018 | C...Threshold factors for c and b sea. | |
29019 | SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) | |
29020 | XCHM=0D0 | |
29021 | IF(Q2.GT.PMC**2.AND.Q2.GT.1.001D0*P2EFF) THEN | |
29022 | SCH=MAX(0D0,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) | |
29023 | IF(ISET.EQ.0) THEN | |
29024 | XCHM=XSEA*(1D0-(SCH/SLL)**2) | |
29025 | ELSE | |
29026 | XCHM=MAX(0D0,XSEA-XSEA0*X1**(2.667D0*S))*(1D0-SCH/SLL) | |
29027 | ENDIF | |
29028 | ENDIF | |
29029 | XBOT=0D0 | |
29030 | IF(Q2.GT.PMB**2.AND.Q2.GT.1.001D0*P2EFF) THEN | |
29031 | SBT=MAX(0D0,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) | |
29032 | IF(ISET.EQ.0) THEN | |
29033 | XBOT=XSEA*(1D0-(SBT/SLL)**2) | |
29034 | ELSE | |
29035 | XBOT=MAX(0D0,XSEA-XSEA0*X1**(2.667D0*S))*(1D0-SBT/SLL) | |
29036 | ENDIF | |
29037 | ENDIF | |
29038 | ||
29039 | C...Fill parton distributions. | |
29040 | XPGA(0)=XGLU | |
29041 | XPGA(1)=XSEA | |
29042 | XPGA(2)=XSEA | |
29043 | XPGA(3)=XSEA | |
29044 | XPGA(4)=XCHM | |
29045 | XPGA(5)=XBOT | |
29046 | XPGA(KFA)=XPGA(KFA)+XVAL | |
29047 | DO 110 KFL=1,5 | |
29048 | XPGA(-KFL)=XPGA(KFL) | |
29049 | 110 CONTINUE | |
29050 | VXPGA(KFA)=XVAL | |
29051 | VXPGA(-KFA)=XVAL | |
29052 | ||
29053 | RETURN | |
29054 | END | |
29055 | ||
29056 | C********************************************************************* | |
29057 | ||
29058 | C...PYGANO | |
29059 | C...Evaluates the parton distributions of the anomalous photon, | |
29060 | C...inhomogeneously evolved from a scale P2 (where it vanishes) to Q2. | |
29061 | C...KF=0 gives the sum over (up to) 5 flavours, | |
29062 | C...KF<0 limits to flavours up to abs(KF), | |
29063 | C...KF>0 is for flavour KF only. | |
29064 | C...ALAM is the 4-flavour Lambda, which is automatically converted | |
29065 | C...to 3- and 5-flavour equivalents as needed. | |
29066 | C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. | |
29067 | ||
29068 | SUBROUTINE PYGANO(KF,X,Q2,P2,ALAM,XPGA,VXPGA) | |
29069 | ||
29070 | C...Double precision and integer declarations. | |
29071 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
29072 | IMPLICIT INTEGER(I-N) | |
29073 | INTEGER PYK,PYCHGE,PYCOMP | |
29074 | C...Local arrays and data. | |
29075 | DIMENSION XPGA(-6:6), VXPGA(-6:6), ALAMSQ(3:5) | |
29076 | DATA PMC/1.3D0/, PMB/4.6D0/, AEM/0.007297D0/, AEM2PI/0.0011614D0/ | |
29077 | ||
29078 | C...Reset output. | |
29079 | DO 100 KFL=-6,6 | |
29080 | XPGA(KFL)=0D0 | |
29081 | VXPGA(KFL)=0D0 | |
29082 | 100 CONTINUE | |
29083 | IF(Q2.LE.P2) RETURN | |
29084 | KFA=IABS(KF) | |
29085 | ||
29086 | C...Calculate Lambda; protect against unphysical Q2 and P2 input. | |
29087 | ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2D0/27D0))**2 | |
29088 | ALAMSQ(4)=ALAM**2 | |
29089 | ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2D0/23D0))**2 | |
29090 | P2EFF=MAX(P2,1.2D0*ALAMSQ(3)) | |
29091 | IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2) | |
29092 | IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2) | |
29093 | Q2EFF=MAX(Q2,P2EFF) | |
29094 | XL=-LOG(X) | |
29095 | ||
29096 | C...Find number of flavours at lower and upper scale. | |
29097 | NFP=4 | |
29098 | IF(P2EFF.LT.PMC**2) NFP=3 | |
29099 | IF(P2EFF.GT.PMB**2) NFP=5 | |
29100 | NFQ=4 | |
29101 | IF(Q2EFF.LT.PMC**2) NFQ=3 | |
29102 | IF(Q2EFF.GT.PMB**2) NFQ=5 | |
29103 | ||
29104 | C...Define range of flavour loop. | |
29105 | IF(KF.EQ.0) THEN | |
29106 | KFLMN=1 | |
29107 | KFLMX=5 | |
29108 | ELSEIF(KF.LT.0) THEN | |
29109 | KFLMN=1 | |
29110 | KFLMX=KFA | |
29111 | ELSE | |
29112 | KFLMN=KFA | |
29113 | KFLMX=KFA | |
29114 | ENDIF | |
29115 | ||
29116 | C...Loop over flavours the photon can branch into. | |
29117 | DO 110 KFL=KFLMN,KFLMX | |
29118 | ||
29119 | C...Light flavours: calculate t range and (approximate) s range. | |
29120 | IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN | |
29121 | TDIFF=LOG(Q2EFF/P2EFF) | |
29122 | S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ | |
29123 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
29124 | IF(NFQ.GT.NFP) THEN | |
29125 | Q2DIV=PMB**2 | |
29126 | IF(NFQ.EQ.4) Q2DIV=PMC**2 | |
29127 | SNFQ=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ | |
29128 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
29129 | SNFP=(6D0/(33D0-2D0*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ | |
29130 | & LOG(P2EFF/ALAMSQ(NFQ-1))) | |
29131 | S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) | |
29132 | ENDIF | |
29133 | IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN | |
29134 | Q2DIV=PMC**2 | |
29135 | SNF4=(6D0/(33D0-2D0*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/ | |
29136 | & LOG(P2EFF/ALAMSQ(4))) | |
29137 | SNF3=(6D0/(33D0-2D0*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/ | |
29138 | & LOG(P2EFF/ALAMSQ(3))) | |
29139 | S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4) | |
29140 | ENDIF | |
29141 | ||
29142 | C...u and s quark do not need a separate treatment when d has been done. | |
29143 | ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN | |
29144 | ||
29145 | C...Charm: as above, but only include range above c threshold. | |
29146 | ELSEIF(KFL.EQ.4) THEN | |
29147 | IF(Q2.LE.PMC**2) GOTO 110 | |
29148 | P2EFF=MAX(P2EFF,PMC**2) | |
29149 | Q2EFF=MAX(Q2EFF,P2EFF) | |
29150 | TDIFF=LOG(Q2EFF/P2EFF) | |
29151 | S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ | |
29152 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
29153 | IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN | |
29154 | Q2DIV=PMB**2 | |
29155 | SNFQ=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ | |
29156 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
29157 | SNFP=(6D0/(33D0-2D0*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ | |
29158 | & LOG(P2EFF/ALAMSQ(NFQ-1))) | |
29159 | S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) | |
29160 | ENDIF | |
29161 | ||
29162 | C...Bottom: as above, but only include range above b threshold. | |
29163 | ELSEIF(KFL.EQ.5) THEN | |
29164 | IF(Q2.LE.PMB**2) GOTO 110 | |
29165 | P2EFF=MAX(P2EFF,PMB**2) | |
29166 | Q2EFF=MAX(Q2,P2EFF) | |
29167 | TDIFF=LOG(Q2EFF/P2EFF) | |
29168 | S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ | |
29169 | & LOG(P2EFF/ALAMSQ(NFQ))) | |
29170 | ENDIF | |
29171 | ||
29172 | C...Evaluate flavour-dependent prefactor (charge^2 etc.). | |
29173 | CHSQ=1D0/9D0 | |
29174 | IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4D0/9D0 | |
29175 | FAC=AEM2PI*2D0*CHSQ*TDIFF | |
29176 | ||
29177 | C...Evaluate parton distributions (normalized to unit momentum sum). | |
29178 | IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN | |
29179 | XVAL= ((1.5D0+2.49D0*S+26.9D0*S**2)/(1D0+32.3D0*S**2)*X**2 + | |
29180 | & (1.5D0-0.49D0*S+7.83D0*S**2)/(1D0+7.68D0*S**2)*(1D0-X)**2 + | |
29181 | & 1.5D0*S/(1D0-3.2D0*S+7D0*S**2)*X*(1D0-X)) * | |
29182 | & X**(1D0/(1D0+0.58D0*S)) * (1D0-X**2)**(2.5D0*S/(1D0+10D0*S)) | |
29183 | XGLU= 2D0*S/(1D0+4D0*S+7D0*S**2) * | |
29184 | & X**(-1.67D0*S/(1D0+2D0*S)) * (1D0-X**2)**(1.2D0*S) * | |
29185 | & ((4D0*X**2+7D0*X+4D0)*(1D0-X)/3D0 - 2D0*X*(1D0+X)*XL) | |
29186 | XSEA= 0.333D0*S**2/(1D0+4.90D0*S+4.69D0*S**2+21.4D0*S**3) * | |
29187 | & X**(-1.18D0*S/(1D0+1.22D0*S)) * (1D0-X)**(1.2D0*S) * | |
29188 | & ((8D0-73D0*X+62D0*X**2)*(1D0-X)/9D0 + | |
29189 | & (3D0-8D0*X**2/3D0)*X*XL + (2D0*X-1D0)*X*XL**2) | |
29190 | ||
29191 | C...Threshold factors for c and b sea. | |
29192 | SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) | |
29193 | XCHM=0D0 | |
29194 | IF(Q2.GT.PMC**2.AND.Q2.GT.1.001D0*P2EFF) THEN | |
29195 | SCH=MAX(0D0,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) | |
29196 | XCHM=XSEA*(1D0-(SCH/SLL)**3) | |
29197 | ENDIF | |
29198 | XBOT=0D0 | |
29199 | IF(Q2.GT.PMB**2.AND.Q2.GT.1.001D0*P2EFF) THEN | |
29200 | SBT=MAX(0D0,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) | |
29201 | XBOT=XSEA*(1D0-(SBT/SLL)**3) | |
29202 | ENDIF | |
29203 | ENDIF | |
29204 | ||
29205 | C...Add contribution of each valence flavour. | |
29206 | XPGA(0)=XPGA(0)+FAC*XGLU | |
29207 | XPGA(1)=XPGA(1)+FAC*XSEA | |
29208 | XPGA(2)=XPGA(2)+FAC*XSEA | |
29209 | XPGA(3)=XPGA(3)+FAC*XSEA | |
29210 | XPGA(4)=XPGA(4)+FAC*XCHM | |
29211 | XPGA(5)=XPGA(5)+FAC*XBOT | |
29212 | XPGA(KFL)=XPGA(KFL)+FAC*XVAL | |
29213 | VXPGA(KFL)=VXPGA(KFL)+FAC*XVAL | |
29214 | 110 CONTINUE | |
29215 | DO 120 KFL=1,5 | |
29216 | XPGA(-KFL)=XPGA(KFL) | |
29217 | VXPGA(-KFL)=VXPGA(KFL) | |
29218 | 120 CONTINUE | |
29219 | ||
29220 | RETURN | |
29221 | END | |
29222 | ||
29223 | C********************************************************************* | |
29224 | ||
29225 | C...PYGBEH | |
29226 | C...Evaluates the Bethe-Heitler cross section for heavy flavour | |
29227 | C...production. | |
29228 | C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. | |
29229 | ||
29230 | SUBROUTINE PYGBEH(KF,X,Q2,P2,PM2,XPBH) | |
29231 | ||
29232 | C...Double precision and integer declarations. | |
29233 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
29234 | IMPLICIT INTEGER(I-N) | |
29235 | INTEGER PYK,PYCHGE,PYCOMP | |
29236 | ||
29237 | C...Local data. | |
29238 | DATA AEM2PI/0.0011614D0/ | |
29239 | ||
29240 | C...Reset output. | |
29241 | XPBH=0D0 | |
29242 | SIGBH=0D0 | |
29243 | ||
29244 | C...Check kinematics limits. | |
29245 | IF(X.GE.Q2/(4D0*PM2+Q2+P2)) RETURN | |
29246 | W2=Q2*(1D0-X)/X-P2 | |
29247 | BETA2=1D0-4D0*PM2/W2 | |
29248 | IF(BETA2.LT.1D-10) RETURN | |
29249 | BETA=SQRT(BETA2) | |
29250 | RMQ=4D0*PM2/Q2 | |
29251 | ||
29252 | C...Simple case: P2 = 0. | |
29253 | IF(P2.LT.1D-4) THEN | |
29254 | IF(BETA.LT.0.99D0) THEN | |
29255 | XBL=LOG((1D0+BETA)/(1D0-BETA)) | |
29256 | ELSE | |
29257 | XBL=LOG((1D0+BETA)**2*W2/(4D0*PM2)) | |
29258 | ENDIF | |
29259 | SIGBH=BETA*(8D0*X*(1D0-X)-1D0-RMQ*X*(1D0-X))+ | |
29260 | & XBL*(X**2+(1D0-X)**2+RMQ*X*(1D0-3D0*X)-0.5D0*RMQ**2*X**2) | |
29261 | ||
29262 | C...Complicated case: P2 > 0, based on approximation of | |
29263 | C...C.T. Hill and G.G. Ross, Nucl. Phys. B148 (1979) 373 | |
29264 | ELSE | |
29265 | RPQ=1D0-4D0*X**2*P2/Q2 | |
29266 | IF(RPQ.GT.1D-10) THEN | |
29267 | RPBE=SQRT(RPQ*BETA2) | |
29268 | IF(RPBE.LT.0.99D0) THEN | |
29269 | XBL=LOG((1D0+RPBE)/(1D0-RPBE)) | |
29270 | XBI=2D0*RPBE/(1D0-RPBE**2) | |
29271 | ELSE | |
29272 | RPBESN=4D0*PM2/W2+(4D0*X**2*P2/Q2)*BETA2 | |
29273 | XBL=LOG((1D0+RPBE)**2/RPBESN) | |
29274 | XBI=2D0*RPBE/RPBESN | |
29275 | ENDIF | |
29276 | SIGBH=BETA*(6D0*X*(1D0-X)-1D0)+ | |
29277 | & XBL*(X**2+(1D0-X)**2+RMQ*X*(1D0-3D0*X)-0.5D0*RMQ**2*X**2)+ | |
29278 | & XBI*(2D0*X/Q2)*(PM2*X*(2D0-RMQ)-P2*X) | |
29279 | ENDIF | |
29280 | ENDIF | |
29281 | ||
29282 | C...Multiply by charge-squared etc. to get parton distribution. | |
29283 | CHSQ=1D0/9D0 | |
29284 | IF(IABS(KF).EQ.2.OR.IABS(KF).EQ.4) CHSQ=4D0/9D0 | |
29285 | XPBH=3D0*CHSQ*AEM2PI*X*SIGBH | |
29286 | ||
29287 | RETURN | |
29288 | END | |
29289 | ||
29290 | C********************************************************************* | |
29291 | ||
29292 | C...PYGDIR | |
29293 | C...Evaluates the direct contribution, i.e. the C^gamma term, | |
29294 | C...as needed in MSbar parametrizations. | |
29295 | C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. | |
29296 | ||
29297 | SUBROUTINE PYGDIR(X,Q2,P2,Q02,XPGA) | |
29298 | ||
29299 | C...Double precision and integer declarations. | |
29300 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
29301 | IMPLICIT INTEGER(I-N) | |
29302 | INTEGER PYK,PYCHGE,PYCOMP | |
29303 | C...Local array and data. | |
29304 | DIMENSION XPGA(-6:6) | |
29305 | DATA PMC/1.3D0/, PMB/4.6D0/, AEM2PI/0.0011614D0/ | |
29306 | ||
29307 | C...Reset output. | |
29308 | DO 100 KFL=-6,6 | |
29309 | XPGA(KFL)=0D0 | |
29310 | 100 CONTINUE | |
29311 | ||
29312 | C...Evaluate common x-dependent expression. | |
29313 | XTMP = (X**2+(1D0-X)**2) * (-LOG(X)) - 1D0 | |
29314 | CGAM = 3D0*AEM2PI*X * (XTMP*(1D0+P2/(P2+Q02)) + 6D0*X*(1D0-X)) | |
29315 | ||
29316 | C...d, u, s part by simple charge factor. | |
29317 | XPGA(1)=(1D0/9D0)*CGAM | |
29318 | XPGA(2)=(4D0/9D0)*CGAM | |
29319 | XPGA(3)=(1D0/9D0)*CGAM | |
29320 | ||
29321 | C...Also fill for antiquarks. | |
29322 | DO 110 KF=1,5 | |
29323 | XPGA(-KF)=XPGA(KF) | |
29324 | 110 CONTINUE | |
29325 | ||
29326 | RETURN | |
29327 | END | |
29328 | ||
29329 | C********************************************************************* | |
29330 | ||
29331 | C...PYPDPI | |
29332 | C...Gives pi+ parton distribution according to two different | |
29333 | C...parametrizations. | |
29334 | ||
29335 | SUBROUTINE PYPDPI(X,Q2,XPPI) | |
29336 | ||
29337 | C...Double precision and integer declarations. | |
29338 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
29339 | IMPLICIT INTEGER(I-N) | |
29340 | INTEGER PYK,PYCHGE,PYCOMP | |
29341 | C...Commonblocks. | |
29342 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
29343 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
29344 | COMMON/PYINT1/MINT(400),VINT(400) | |
29345 | SAVE /PYDAT1/,/PYPARS/,/PYINT1/ | |
29346 | C...Local arrays. | |
29347 | DIMENSION XPPI(-6:6),COW(3,5,4,2),XQ(9),TS(6) | |
29348 | ||
29349 | C...The following data lines are coefficients needed in the | |
29350 | C...Owens pion parton distribution parametrizations, see below. | |
29351 | C...Expansion coefficients for up and down valence quark distributions. | |
29352 | DATA ((COW(IP,IS,1,1),IS=1,5),IP=1,3)/ | |
29353 | &4.0000D-01, 7.0000D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, | |
29354 | &-6.2120D-02, 6.4780D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, | |
29355 | &-7.1090D-03, 1.3350D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/ | |
29356 | DATA ((COW(IP,IS,1,2),IS=1,5),IP=1,3)/ | |
29357 | &4.0000D-01, 6.2800D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, | |
29358 | &-5.9090D-02, 6.4360D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, | |
29359 | &-6.5240D-03, 1.4510D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/ | |
29360 | C...Expansion coefficients for gluon distribution. | |
29361 | DATA ((COW(IP,IS,2,1),IS=1,5),IP=1,3)/ | |
29362 | &8.8800D-01, 0.0000D+00, 3.1100D+00, 6.0000D+00, 0.0000D+00, | |
29363 | &-1.8020D+00, -1.5760D+00, -1.3170D-01, 2.8010D+00, -1.7280D+01, | |
29364 | &1.8120D+00, 1.2000D+00, 5.0680D-01, -1.2160D+01, 2.0490D+01/ | |
29365 | DATA ((COW(IP,IS,2,2),IS=1,5),IP=1,3)/ | |
29366 | &7.9400D-01, 0.0000D+00, 2.8900D+00, 6.0000D+00, 0.0000D+00, | |
29367 | &-9.1440D-01, -1.2370D+00, 5.9660D-01, -3.6710D+00, -8.1910D+00, | |
29368 | &5.9660D-01, 6.5820D-01, -2.5500D-01, -2.3040D+00, 7.7580D+00/ | |
29369 | C...Expansion coefficients for (up+down+strange) quark sea distribution. | |
29370 | DATA ((COW(IP,IS,3,1),IS=1,5),IP=1,3)/ | |
29371 | &9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00, | |
29372 | &-2.4280D-01, -2.1200D-01, 8.6730D-01, 1.2660D+00, 2.3820D+00, | |
29373 | &1.3860D-01, 3.6710D-03, 4.7470D-02, -2.2150D+00, 3.4820D-01/ | |
29374 | DATA ((COW(IP,IS,3,2),IS=1,5),IP=1,3)/ | |
29375 | &9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00, | |
29376 | &-1.4170D-01, -1.6970D-01, -2.4740D+00, -2.5340D+00, 5.6210D-01, | |
29377 | &-1.7400D-01, -9.6230D-02, 1.5750D+00, 1.3780D+00, -2.7010D-01/ | |
29378 | C...Expansion coefficients for charm quark sea distribution. | |
29379 | DATA ((COW(IP,IS,4,1),IS=1,5),IP=1,3)/ | |
29380 | &0.0000D+00, -2.2120D-02, 2.8940D+00, 0.0000D+00, 0.0000D+00, | |
29381 | &7.9280D-02, -3.7850D-01, 9.4330D+00, 5.2480D+00, 8.3880D+00, | |
29382 | &-6.1340D-02, -1.0880D-01, -1.0852D+01, -7.1870D+00, -1.1610D+01/ | |
29383 | DATA ((COW(IP,IS,4,2),IS=1,5),IP=1,3)/ | |
29384 | &0.0000D+00, -8.8200D-02, 1.9240D+00, 0.0000D+00, 0.0000D+00, | |
29385 | &6.2290D-02, -2.8920D-01, 2.4240D-01, -4.4630D+00, -8.3670D-01, | |
29386 | &-4.0990D-02, -1.0820D-01, 2.0360D+00, 5.2090D+00, -4.8400D-02/ | |
29387 | ||
29388 | C...Euler's beta function, requires ordinary Gamma function | |
29389 | EULBET(X,Y)=PYGAMM(X)*PYGAMM(Y)/PYGAMM(X+Y) | |
29390 | ||
29391 | C...Reset output array. | |
29392 | DO 100 KFL=-6,6 | |
29393 | XPPI(KFL)=0D0 | |
29394 | 100 CONTINUE | |
29395 | ||
29396 | IF(MSTP(53).LE.2) THEN | |
29397 | C...Pion parton distributions from Owens. | |
29398 | C...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2. | |
29399 | ||
29400 | C...Determine set, Lambda and s expansion variable. | |
29401 | NSET=MSTP(53) | |
29402 | IF(NSET.EQ.1) ALAM=0.2D0 | |
29403 | IF(NSET.EQ.2) ALAM=0.4D0 | |
29404 | VINT(231)=4D0 | |
29405 | IF(MSTP(57).LE.0) THEN | |
29406 | SD=0D0 | |
29407 | ELSE | |
29408 | Q2IN=MIN(2D3,MAX(4D0,Q2)) | |
29409 | SD=LOG(LOG(Q2IN/ALAM**2)/LOG(4D0/ALAM**2)) | |
29410 | ENDIF | |
29411 | ||
29412 | C...Calculate parton distributions. | |
29413 | DO 120 KFL=1,4 | |
29414 | DO 110 IS=1,5 | |
29415 | TS(IS)=COW(1,IS,KFL,NSET)+COW(2,IS,KFL,NSET)*SD+ | |
29416 | & COW(3,IS,KFL,NSET)*SD**2 | |
29417 | 110 CONTINUE | |
29418 | IF(KFL.EQ.1) THEN | |
29419 | XQ(KFL)=X**TS(1)*(1D0-X)**TS(2)/EULBET(TS(1),TS(2)+1D0) | |
29420 | ELSE | |
29421 | XQ(KFL)=TS(1)*X**TS(2)*(1D0-X)**TS(3)*(1D0+TS(4)*X+ | |
29422 | & TS(5)*X**2) | |
29423 | ENDIF | |
29424 | 120 CONTINUE | |
29425 | ||
29426 | C...Put into output array. | |
29427 | XPPI(0)=XQ(2) | |
29428 | XPPI(1)=XQ(3)/6D0 | |
29429 | XPPI(2)=XQ(1)+XQ(3)/6D0 | |
29430 | XPPI(3)=XQ(3)/6D0 | |
29431 | XPPI(4)=XQ(4) | |
29432 | XPPI(-1)=XQ(1)+XQ(3)/6D0 | |
29433 | XPPI(-2)=XQ(3)/6D0 | |
29434 | XPPI(-3)=XQ(3)/6D0 | |
29435 | XPPI(-4)=XQ(4) | |
29436 | ||
29437 | C...Leading order pion parton distributions from Glueck, Reya and Vogt. | |
29438 | C...Allowed variable range: 0.25 GeV^2 < Q^2 < 10^8 GeV^2 and | |
29439 | C...10^-5 < x < 1. | |
29440 | ELSE | |
29441 | ||
29442 | C...Determine s expansion variable and some x expressions. | |
29443 | VINT(231)=0.25D0 | |
29444 | IF(MSTP(57).LE.0) THEN | |
29445 | SD=0D0 | |
29446 | ELSE | |
29447 | Q2IN=MIN(1D8,MAX(0.25D0,Q2)) | |
29448 | SD=LOG(LOG(Q2IN/0.232D0**2)/LOG(0.25D0/0.232D0**2)) | |
29449 | ENDIF | |
29450 | SD2=SD**2 | |
29451 | XL=-LOG(X) | |
29452 | XS=SQRT(X) | |
29453 | ||
29454 | C...Evaluate valence, gluon and sea distributions. | |
29455 | XFVAL=(0.519D0+0.180D0*SD-0.011D0*SD2)*X**(0.499D0-0.027D0*SD)* | |
29456 | & (1D0+(0.381D0-0.419D0*SD)*XS)*(1D0-X)**(0.367D0+0.563D0*SD) | |
29457 | XFGLU=(X**(0.482D0+0.341D0*SQRT(SD))*((0.678D0+0.877D0* | |
29458 | & SD-0.175D0*SD2)+ | |
29459 | & (0.338D0-1.597D0*SD)*XS+(-0.233D0*SD+0.406D0*SD2)*X)+ | |
29460 | & SD**0.599D0*EXP(-(0.618D0+2.070D0*SD)+SQRT(3.676D0*SD**1.263D0* | |
29461 | & XL)))* | |
29462 | & (1D0-X)**(0.390D0+1.053D0*SD) | |
29463 | XFSEA=SD**0.55D0*(1D0-0.748D0*XS+(0.313D0+0.935D0*SD)*X)*(1D0- | |
29464 | & X)**3.359D0* | |
29465 | & EXP(-(4.433D0+1.301D0*SD)+SQRT((9.30D0-0.887D0*SD)*SD**0.56D0* | |
29466 | & XL))/ | |
29467 | & XL**(2.538D0-0.763D0*SD) | |
29468 | IF(SD.LE.0.888D0) THEN | |
29469 | XFCHM=0D0 | |
29470 | ELSE | |
29471 | XFCHM=(SD-0.888D0)**1.02D0*(1D0+1.008D0*X)*(1D0-X)**(1.208D0+ | |
29472 | & 0.771D0*SD)* | |
29473 | & EXP(-(4.40D0+1.493D0*SD)+SQRT((2.032D0+1.901D0*SD)*SD**0.39D0* | |
29474 | & XL)) | |
29475 | ENDIF | |
29476 | IF(SD.LE.1.351D0) THEN | |
29477 | XFBOT=0D0 | |
29478 | ELSE | |
29479 | XFBOT=(SD-1.351D0)**1.03D0*(1D0-X)**(0.697D0+0.855D0*SD)* | |
29480 | & EXP(-(4.51D0+1.490D0*SD)+SQRT((3.056D0+1.694D0*SD)*SD**0.39D0* | |
29481 | & XL)) | |
29482 | ENDIF | |
29483 | ||
29484 | C...Put into output array. | |
29485 | XPPI(0)=XFGLU | |
29486 | XPPI(1)=XFSEA | |
29487 | XPPI(2)=XFSEA | |
29488 | XPPI(3)=XFSEA | |
29489 | XPPI(4)=XFCHM | |
29490 | XPPI(5)=XFBOT | |
29491 | DO 130 KFL=1,5 | |
29492 | XPPI(-KFL)=XPPI(KFL) | |
29493 | 130 CONTINUE | |
29494 | XPPI(2)=XPPI(2)+XFVAL | |
29495 | XPPI(-1)=XPPI(-1)+XFVAL | |
29496 | ENDIF | |
29497 | ||
29498 | RETURN | |
29499 | END | |
29500 | ||
29501 | C********************************************************************* | |
29502 | ||
29503 | C...PYPDPR | |
29504 | C...Gives proton parton distributions according to a few different | |
29505 | C...parametrizations. | |
29506 | ||
29507 | SUBROUTINE PYPDPR(X,Q2,XPPR) | |
29508 | ||
29509 | C...Double precision and integer declarations. | |
29510 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
29511 | IMPLICIT INTEGER(I-N) | |
29512 | INTEGER PYK,PYCHGE,PYCOMP | |
29513 | C...Commonblocks. | |
29514 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
29515 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
29516 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
29517 | COMMON/PYINT1/MINT(400),VINT(400) | |
29518 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ | |
29519 | C...Arrays and data. | |
29520 | DIMENSION XPPR(-6:6),Q2MIN(16) | |
29521 | DATA Q2MIN/ 2.56D0, 2.56D0, 2.56D0, 0.4D0, 0.4D0, 0.4D0, | |
29522 | &1.0D0, 1.0D0, 2*0D0, 0.25D0, 5D0, 5D0, 4D0, 4D0, 0D0/ | |
29523 | ||
29524 | C...Reset output array. | |
29525 | DO 100 KFL=-6,6 | |
29526 | XPPR(KFL)=0D0 | |
29527 | 100 CONTINUE | |
29528 | ||
29529 | C...Common preliminaries. | |
29530 | NSET=MAX(1,MIN(16,MSTP(51))) | |
29531 | IF(NSET.EQ.9.OR.NSET.EQ.10) NSET=6 | |
29532 | VINT(231)=Q2MIN(NSET) | |
29533 | IF(MSTP(57).EQ.0) THEN | |
29534 | Q2L=Q2MIN(NSET) | |
29535 | ELSE | |
29536 | Q2L=MAX(Q2MIN(NSET),Q2) | |
29537 | ENDIF | |
29538 | ||
29539 | IF(NSET.GE.1.AND.NSET.LE.3) THEN | |
29540 | C...Interface to the CTEQ 3 parton distributions. | |
29541 | QRT=SQRT(MAX(1D0,Q2L)) | |
29542 | ||
29543 | C...Loop over flavours. | |
29544 | DO 110 I=-6,6 | |
29545 | IF(I.LE.0) THEN | |
29546 | XPPR(I)=PYCTEQ(NSET,I,X,QRT) | |
29547 | ELSEIF(I.LE.2) THEN | |
29548 | XPPR(I)=PYCTEQ(NSET,I,X,QRT)+XPPR(-I) | |
29549 | ELSE | |
29550 | XPPR(I)=XPPR(-I) | |
29551 | ENDIF | |
29552 | 110 CONTINUE | |
29553 | ||
29554 | ELSEIF(NSET.GE.4.AND.NSET.LE.6) THEN | |
29555 | C...Interface to the GRV 94 distributions. | |
29556 | IF(NSET.EQ.4) THEN | |
29557 | CALL PYGRVL (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL) | |
29558 | ELSEIF(NSET.EQ.5) THEN | |
29559 | CALL PYGRVM (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL) | |
29560 | ELSE | |
29561 | CALL PYGRVD (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL) | |
29562 | ENDIF | |
29563 | ||
29564 | C...Put into output array. | |
29565 | XPPR(0)=GL | |
29566 | XPPR(-1)=0.5D0*(UDB+DEL) | |
29567 | XPPR(-2)=0.5D0*(UDB-DEL) | |
29568 | XPPR(-3)=SB | |
29569 | XPPR(-4)=CHM | |
29570 | XPPR(-5)=BOT | |
29571 | XPPR(1)=DV+XPPR(-1) | |
29572 | XPPR(2)=UV+XPPR(-2) | |
29573 | XPPR(3)=SB | |
29574 | XPPR(4)=CHM | |
29575 | XPPR(5)=BOT | |
29576 | ||
29577 | ELSEIF(NSET.EQ.7) THEN | |
29578 | C...Interface to the CTEQ 5L parton distributions. | |
29579 | C...Range of validity 10^-6 < x < 1, 1 < Q < 10^4 extended by | |
29580 | C...freezing x*f(x,Q2) at borders. | |
29581 | QRT=SQRT(MAX(1D0,MIN(1D8,Q2L))) | |
29582 | XIN=MAX(1D-6,MIN(1D0,X)) | |
29583 | ||
29584 | C...Loop over flavours (with u <-> d notation mismatch). | |
29585 | SUMUDB=PYCT5L(-1,XIN,QRT) | |
29586 | RATUDB=PYCT5L(-2,XIN,QRT) | |
29587 | DO 120 I=-5,2 | |
29588 | IF(I.EQ.1) THEN | |
29589 | XPPR(I)=XIN*PYCT5L(2,XIN,QRT) | |
29590 | ELSEIF(I.EQ.2) THEN | |
29591 | XPPR(I)=XIN*PYCT5L(1,XIN,QRT) | |
29592 | ELSEIF(I.EQ.-1) THEN | |
29593 | XPPR(I)=XIN*SUMUDB*RATUDB/(1D0+RATUDB) | |
29594 | ELSEIF(I.EQ.-2) THEN | |
29595 | XPPR(I)=XIN*SUMUDB/(1D0+RATUDB) | |
29596 | ELSE | |
29597 | XPPR(I)=XIN*PYCT5L(I,XIN,QRT) | |
29598 | IF(I.LT.0) XPPR(-I)=XPPR(I) | |
29599 | ENDIF | |
29600 | 120 CONTINUE | |
29601 | ||
29602 | ELSEIF(NSET.EQ.8) THEN | |
29603 | C...Interface to the CTEQ 5M1 parton distributions. | |
29604 | QRT=SQRT(MAX(1D0,MIN(1D8,Q2L))) | |
29605 | XIN=MAX(1D-6,MIN(1D0,X)) | |
29606 | ||
29607 | C...Loop over flavours (with u <-> d notation mismatch). | |
29608 | SUMUDB=PYCT5M(-1,XIN,QRT) | |
29609 | RATUDB=PYCT5M(-2,XIN,QRT) | |
29610 | DO 130 I=-5,2 | |
29611 | IF(I.EQ.1) THEN | |
29612 | XPPR(I)=XIN*PYCT5M(2,XIN,QRT) | |
29613 | ELSEIF(I.EQ.2) THEN | |
29614 | XPPR(I)=XIN*PYCT5M(1,XIN,QRT) | |
29615 | ELSEIF(I.EQ.-1) THEN | |
29616 | XPPR(I)=XIN*SUMUDB*RATUDB/(1D0+RATUDB) | |
29617 | ELSEIF(I.EQ.-2) THEN | |
29618 | XPPR(I)=XIN*SUMUDB/(1D0+RATUDB) | |
29619 | ELSE | |
29620 | XPPR(I)=XIN*PYCT5M(I,XIN,QRT) | |
29621 | IF(I.LT.0) XPPR(-I)=XPPR(I) | |
29622 | ENDIF | |
29623 | 130 CONTINUE | |
29624 | ||
29625 | ELSEIF(NSET.GE.11.AND.NSET.LE.15) THEN | |
29626 | C...GRV92LO, EHLQ1, EHLQ2, DO1 AND DO2 distributions: | |
29627 | C...obsolete but offers backwards compatibility. | |
29628 | CALL PYPDPO(X,Q2L,XPPR) | |
29629 | ||
29630 | C...Symmetric choice for debugging only | |
29631 | ELSEIF(NSET.EQ.16) THEN | |
29632 | XPPR(0)=.5D0/X | |
29633 | XPPR(1)=.05D0/X | |
29634 | XPPR(2)=.05D0/X | |
29635 | XPPR(3)=.05D0/X | |
29636 | XPPR(4)=.05D0/X | |
29637 | XPPR(5)=.05D0/X | |
29638 | XPPR(-1)=.05D0/X | |
29639 | XPPR(-2)=.05D0/X | |
29640 | XPPR(-3)=.05D0/X | |
29641 | XPPR(-4)=.05D0/X | |
29642 | XPPR(-5)=.05D0/X | |
29643 | ||
29644 | ENDIF | |
29645 | ||
29646 | RETURN | |
29647 | END | |
29648 | ||
29649 | C********************************************************************* | |
29650 | ||
29651 | C...PYCTEQ | |
29652 | C...Gives the CTEQ 3 parton distribution function sets in | |
29653 | C...parametrized form, of October 24, 1994. | |
29654 | C...Authors: H.L. Lai, J. Botts, J. Huston, J.G. Morfin, J.F. Owens, | |
29655 | C...J. Qiu, W.K. Tung and H. Weerts. | |
29656 | ||
29657 | FUNCTION PYCTEQ (ISET, IPRT, X, Q) | |
29658 | ||
29659 | C...Double precision declaration. | |
29660 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
29661 | IMPLICIT INTEGER(I-N) | |
29662 | ||
29663 | C...Data on Lambda values of fits, minimum Q and quark masses. | |
29664 | DIMENSION ALM(3), QMS(4:6) | |
29665 | DATA ALM / 0.177D0, 0.239D0, 0.247D0 / | |
29666 | DATA QMN / 1.60D0 /, (QMS(I), I=4,6) / 1.60D0, 5.00D0, 180.0D0 / | |
29667 | ||
29668 | C....Check flavour thresholds. Set up QI for SB. | |
29669 | IP = IABS(IPRT) | |
29670 | IF(IP .GE. 4) THEN | |
29671 | IF(Q .LE. QMS(IP)) THEN | |
29672 | PYCTEQ = 0D0 | |
29673 | RETURN | |
29674 | ENDIF | |
29675 | QI = QMS(IP) | |
29676 | ELSE | |
29677 | QI = QMN | |
29678 | ENDIF | |
29679 | ||
29680 | C...Use "standard lambda" of parametrization program for expansion. | |
29681 | ALAM = ALM (ISET) | |
29682 | SBL = LOG(Q/ALAM) / LOG(QI/ALAM) | |
29683 | SB = LOG (SBL) | |
29684 | SB2 = SB*SB | |
29685 | SB3 = SB2*SB | |
29686 | ||
29687 | C...Expansion for CTEQ3L. | |
29688 | IF(ISET .EQ. 1) THEN | |
29689 | IF(IPRT .EQ. 2) THEN | |
29690 | A0=Exp( 0.1907D+00+0.4205D-01*SB +0.2752D+00*SB2- | |
29691 | & 0.3171D+00*SB3) | |
29692 | A1= 0.4611D+00+0.2331D-01*SB -0.3403D-01*SB2+0.3174D-01*SB3 | |
29693 | A2= 0.3504D+01+0.5739D+00*SB +0.2676D+00*SB2-0.1553D+00*SB3 | |
29694 | A3= 0.7452D+01-0.6742D+01*SB +0.2849D+01*SB2-0.1964D+00*SB3 | |
29695 | A4= 0.1116D+01-0.3435D+00*SB +0.2865D+00*SB2-0.1288D+00*SB3 | |
29696 | A5= 0.6659D-01+0.2714D+00*SB -0.2688D+00*SB2+0.2763D+00*SB3 | |
29697 | ELSEIF(IPRT .EQ. 1) THEN | |
29698 | A0=Exp( 0.1141D+00+0.4764D+00*SB -0.1745D+01*SB2+ | |
29699 | & 0.7728D+00*SB3) | |
29700 | A1= 0.4275D+00-0.1290D+00*SB +0.3609D+00*SB2-0.1689D+00*SB3 | |
29701 | A2= 0.3000D+01+0.2946D+01*SB -0.4117D+01*SB2+0.1989D+01*SB3 | |
29702 | A3=-0.1302D+01+0.2322D+01*SB -0.4258D+01*SB2+0.2109D+01*SB3 | |
29703 | A4= 0.2586D+01-0.1920D+00*SB -0.3754D+00*SB2+0.2731D+00*SB3 | |
29704 | A5=-0.2251D+00-0.5374D+00*SB +0.2245D+01*SB2-0.1034D+01*SB3 | |
29705 | ELSEIF(IPRT .EQ. 0) THEN | |
29706 | A0=Exp(-0.7631D+00-0.7241D+00*SB -0.1170D+01*SB2+ | |
29707 | & 0.5343D+00*SB3) | |
29708 | A1=-0.3573D+00+0.3469D+00*SB -0.3396D+00*SB2+0.9188D-01*SB3 | |
29709 | A2= 0.5604D+01+0.7458D+00*SB -0.5082D+00*SB2+0.1844D+00*SB3 | |
29710 | A3= 0.1549D+02-0.1809D+02*SB +0.1162D+02*SB2-0.3483D+01*SB3 | |
29711 | A4= 0.9881D+00+0.1364D+00*SB -0.4421D+00*SB2+0.2051D+00*SB3 | |
29712 | A5=-0.9505D-01+0.3259D+01*SB -0.1547D+01*SB2+0.2918D+00*SB3 | |
29713 | ELSEIF(IPRT .EQ. -1) THEN | |
29714 | A0=Exp(-0.2449D+01-0.3513D+01*SB +0.4529D+01*SB2- | |
29715 | & 0.2031D+01*SB3) | |
29716 | A1=-0.4050D+00+0.3411D+00*SB -0.3669D+00*SB2+0.1109D+00*SB3 | |
29717 | A2= 0.7470D+01-0.2982D+01*SB +0.5503D+01*SB2-0.2419D+01*SB3 | |
29718 | A3= 0.1503D+02+0.1638D+01*SB -0.8772D+01*SB2+0.3852D+01*SB3 | |
29719 | A4= 0.1137D+01-0.1006D+01*SB +0.1485D+01*SB2-0.6389D+00*SB3 | |
29720 | A5=-0.5299D+00+0.3160D+01*SB -0.3104D+01*SB2+0.1219D+01*SB3 | |
29721 | ELSEIF(IPRT .EQ. -2) THEN | |
29722 | A0=Exp(-0.2740D+01-0.7987D-01*SB -0.9015D+00*SB2- | |
29723 | & 0.9872D-01*SB3) | |
29724 | A1=-0.3909D+00+0.1244D+00*SB -0.4487D-01*SB2+0.1277D-01*SB3 | |
29725 | A2= 0.9163D+01+0.2823D+00*SB -0.7720D+00*SB2-0.9360D-02*SB3 | |
29726 | A3= 0.1080D+02-0.3915D+01*SB -0.1153D+01*SB2+0.2649D+01*SB3 | |
29727 | A4= 0.9894D+00-0.1647D+00*SB -0.9426D-02*SB2+0.2945D-02*SB3 | |
29728 | A5=-0.3395D+00+0.6998D+00*SB +0.7000D+00*SB2-0.6730D-01*SB3 | |
29729 | ELSEIF(IPRT .EQ. -3) THEN | |
29730 | A0=Exp(-0.3640D+01+0.1250D+01*SB -0.2914D+01*SB2+ | |
29731 | & 0.8390D+00*SB3) | |
29732 | A1=-0.3595D+00-0.5259D-01*SB +0.3122D+00*SB2-0.1642D+00*SB3 | |
29733 | A2= 0.7305D+01+0.9727D+00*SB -0.9788D+00*SB2-0.5193D-01*SB3 | |
29734 | A3= 0.1198D+02-0.1799D+02*SB +0.2614D+02*SB2-0.1091D+02*SB3 | |
29735 | A4= 0.9882D+00-0.6101D+00*SB +0.9737D+00*SB2-0.4935D+00*SB3 | |
29736 | A5=-0.1186D+00-0.3231D+00*SB +0.3074D+01*SB2-0.1274D+01*SB3 | |
29737 | ELSEIF(IPRT .EQ. -4) THEN | |
29738 | A0=SB** 0.1122D+01*Exp(-0.3718D+01-0.1335D+01*SB + | |
29739 | & 0.1651D-01*SB2) | |
29740 | A1=-0.4719D+00+0.7509D+00*SB -0.8420D+00*SB2+0.2901D+00*SB3 | |
29741 | A2= 0.6194D+01-0.1641D+01*SB +0.4907D+01*SB2-0.2523D+01*SB3 | |
29742 | A3= 0.4426D+01-0.4270D+01*SB +0.6581D+01*SB2-0.3474D+01*SB3 | |
29743 | A4= 0.2683D+00+0.9876D+00*SB -0.7612D+00*SB2+0.1780D+00*SB3 | |
29744 | A5=-0.4547D+00+0.4410D+01*SB -0.3712D+01*SB2+0.1245D+01*SB3 | |
29745 | ELSEIF(IPRT .EQ. -5) THEN | |
29746 | A0=SB** 0.9838D+00*Exp(-0.2548D+01-0.7660D+01*SB + | |
29747 | & 0.3702D+01*SB2) | |
29748 | A1=-0.3122D+00-0.2120D+00*SB +0.5716D+00*SB2-0.3773D+00*SB3 | |
29749 | A2= 0.6257D+01-0.8214D-01*SB -0.2537D+01*SB2+0.2981D+01*SB3 | |
29750 | A3=-0.6723D+00+0.2131D+01*SB +0.9599D+01*SB2-0.7910D+01*SB3 | |
29751 | A4= 0.9169D-01+0.4295D-01*SB -0.5017D+00*SB2+0.3811D+00*SB3 | |
29752 | A5= 0.2402D+00+0.2656D+01*SB -0.1586D+01*SB2+0.2880D+00*SB3 | |
29753 | ELSEIF(IPRT .EQ. -6) THEN | |
29754 | A0=SB** 0.1001D+01*Exp(-0.6934D+01+0.3050D+01*SB - | |
29755 | & 0.6943D+00*SB2) | |
29756 | A1=-0.1713D+00-0.5167D+00*SB +0.1241D+01*SB2-0.1703D+01*SB3 | |
29757 | A2= 0.6169D+01+0.3023D+01*SB -0.1972D+02*SB2+0.1069D+02*SB3 | |
29758 | A3= 0.4439D+01-0.1746D+02*SB +0.1225D+02*SB2+0.8350D+00*SB3 | |
29759 | A4= 0.5458D+00-0.4586D+00*SB +0.9089D+00*SB2-0.4049D+00*SB3 | |
29760 | A5= 0.3207D+01-0.3362D+01*SB +0.5877D+01*SB2-0.7659D+01*SB3 | |
29761 | ENDIF | |
29762 | ||
29763 | C...Expansion for CTEQ3M. | |
29764 | ELSEIF(ISET .EQ. 2) THEN | |
29765 | IF(IPRT .EQ. 2) THEN | |
29766 | A0=Exp( 0.2259D+00+0.1237D+00*SB +0.3035D+00*SB2- | |
29767 | & 0.2935D+00*SB3) | |
29768 | A1= 0.5085D+00+0.1651D-01*SB -0.3592D-01*SB2+0.2782D-01*SB3 | |
29769 | A2= 0.3732D+01+0.4901D+00*SB +0.2218D+00*SB2-0.1116D+00*SB3 | |
29770 | A3= 0.7011D+01-0.6620D+01*SB +0.2557D+01*SB2-0.1360D+00*SB3 | |
29771 | A4= 0.8969D+00-0.2429D+00*SB +0.1811D+00*SB2-0.6888D-01*SB3 | |
29772 | A5= 0.8636D-01+0.2558D+00*SB -0.3082D+00*SB2+0.2535D+00*SB3 | |
29773 | ELSEIF(IPRT .EQ. 1) THEN | |
29774 | A0=Exp(-0.7266D+00-0.1584D+01*SB +0.1259D+01*SB2- | |
29775 | & 0.4305D-01*SB3) | |
29776 | A1= 0.5285D+00-0.3721D+00*SB +0.5150D+00*SB2-0.1697D+00*SB3 | |
29777 | A2= 0.4075D+01+0.8282D+00*SB -0.4496D+00*SB2+0.2107D+00*SB3 | |
29778 | A3= 0.3279D+01+0.5066D+01*SB -0.9134D+01*SB2+0.2897D+01*SB3 | |
29779 | A4= 0.4399D+00-0.5888D+00*SB +0.4802D+00*SB2-0.1664D+00*SB3 | |
29780 | A5= 0.3678D+00-0.8929D+00*SB +0.1592D+01*SB2-0.5713D+00*SB3 | |
29781 | ELSEIF(IPRT .EQ. 0) THEN | |
29782 | A0=Exp(-0.2318D+00-0.9779D+00*SB -0.3783D+00*SB2+ | |
29783 | & 0.1037D-01*SB3) | |
29784 | A1=-0.2916D+00+0.1754D+00*SB -0.1884D+00*SB2+0.6116D-01*SB3 | |
29785 | A2= 0.5349D+01+0.7460D+00*SB +0.2319D+00*SB2-0.2622D+00*SB3 | |
29786 | A3= 0.6920D+01-0.3454D+01*SB +0.2027D+01*SB2-0.7626D+00*SB3 | |
29787 | A4= 0.1013D+01+0.1423D+00*SB -0.1798D+00*SB2+0.1872D-01*SB3 | |
29788 | A5=-0.5465D-01+0.2303D+01*SB -0.9584D+00*SB2+0.3098D+00*SB3 | |
29789 | ELSEIF(IPRT .EQ. -1) THEN | |
29790 | A0=Exp(-0.2328D+01-0.3061D+01*SB +0.3620D+01*SB2- | |
29791 | & 0.1602D+01*SB3) | |
29792 | A1=-0.3358D+00+0.3198D+00*SB -0.4210D+00*SB2+0.1571D+00*SB3 | |
29793 | A2= 0.8478D+01-0.3112D+01*SB +0.5243D+01*SB2-0.2255D+01*SB3 | |
29794 | A3= 0.1971D+02+0.3389D+00*SB -0.5268D+01*SB2+0.2099D+01*SB3 | |
29795 | A4= 0.1128D+01-0.4701D+00*SB +0.7779D+00*SB2-0.3506D+00*SB3 | |
29796 | A5=-0.4708D+00+0.3341D+01*SB -0.3375D+01*SB2+0.1353D+01*SB3 | |
29797 | ELSEIF(IPRT .EQ. -2) THEN | |
29798 | A0=Exp(-0.2906D+01-0.1069D+00*SB -0.1055D+01*SB2+ | |
29799 | & 0.2496D+00*SB3) | |
29800 | A1=-0.2875D+00+0.6571D-01*SB -0.1987D-01*SB2-0.1800D-02*SB3 | |
29801 | A2= 0.9854D+01-0.2715D+00*SB -0.7407D+00*SB2+0.2888D+00*SB3 | |
29802 | A3= 0.1583D+02-0.7687D+01*SB +0.3428D+01*SB2-0.3327D+00*SB3 | |
29803 | A4= 0.9763D+00+0.7599D-01*SB -0.2128D+00*SB2+0.6852D-01*SB3 | |
29804 | A5=-0.8444D-02+0.9434D+00*SB +0.4152D+00*SB2-0.1481D+00*SB3 | |
29805 | ELSEIF(IPRT .EQ. -3) THEN | |
29806 | A0=Exp(-0.3780D+01+0.2499D+01*SB -0.4962D+01*SB2+ | |
29807 | & 0.1936D+01*SB3) | |
29808 | A1=-0.2639D+00-0.1575D+00*SB +0.3584D+00*SB2-0.1646D+00*SB3 | |
29809 | A2= 0.8082D+01+0.2794D+01*SB -0.5438D+01*SB2+0.2321D+01*SB3 | |
29810 | A3= 0.1811D+02-0.2000D+02*SB +0.1951D+02*SB2-0.6904D+01*SB3 | |
29811 | A4= 0.9822D+00+0.4972D+00*SB -0.8690D+00*SB2+0.3415D+00*SB3 | |
29812 | A5= 0.1772D+00-0.6078D+00*SB +0.3341D+01*SB2-0.1473D+01*SB3 | |
29813 | ELSEIF(IPRT .EQ. -4) THEN | |
29814 | A0=SB** 0.1122D+01*Exp(-0.4232D+01-0.1808D+01*SB + | |
29815 | & 0.5348D+00*SB2) | |
29816 | A1=-0.2824D+00+0.5846D+00*SB -0.7230D+00*SB2+0.2419D+00*SB3 | |
29817 | A2= 0.5683D+01-0.2948D+01*SB +0.5916D+01*SB2-0.2560D+01*SB3 | |
29818 | A3= 0.2051D+01+0.4795D+01*SB -0.4271D+01*SB2+0.4174D+00*SB3 | |
29819 | A4= 0.1737D+00+0.1717D+01*SB -0.1978D+01*SB2+0.6643D+00*SB3 | |
29820 | A5= 0.8689D+00+0.3500D+01*SB -0.3283D+01*SB2+0.1026D+01*SB3 | |
29821 | ELSEIF(IPRT .EQ. -5) THEN | |
29822 | A0=SB** 0.9906D+00*Exp(-0.1496D+01-0.6576D+01*SB + | |
29823 | & 0.1569D+01*SB2) | |
29824 | A1=-0.2140D+00-0.6419D-01*SB -0.2741D-02*SB2+0.3185D-02*SB3 | |
29825 | A2= 0.5781D+01+0.1049D+00*SB -0.3930D+00*SB2+0.5174D+00*SB3 | |
29826 | A3=-0.9420D+00+0.5511D+00*SB +0.8817D+00*SB2+0.1903D+01*SB3 | |
29827 | A4= 0.2418D-01+0.4232D-01*SB -0.1244D-01*SB2-0.2365D-01*SB3 | |
29828 | A5= 0.7664D+00+0.1794D+01*SB -0.4917D+00*SB2-0.1284D+00*SB3 | |
29829 | ELSEIF(IPRT .EQ. -6) THEN | |
29830 | A0=SB** 0.1000D+01*Exp(-0.8460D+01+0.1154D+01*SB + | |
29831 | & 0.8838D+01*SB2) | |
29832 | A1=-0.4316D-01-0.2976D+00*SB +0.3174D+00*SB2-0.1429D+01*SB3 | |
29833 | A2= 0.4910D+01+0.2273D+01*SB +0.5631D+01*SB2-0.1994D+02*SB3 | |
29834 | A3= 0.1190D+02-0.2000D+02*SB -0.2000D+02*SB2+0.1292D+02*SB3 | |
29835 | A4= 0.5771D+00-0.2552D+00*SB +0.7510D+00*SB2+0.6923D+00*SB3 | |
29836 | A5= 0.4402D+01-0.1627D+01*SB -0.2085D+01*SB2-0.6737D+01*SB3 | |
29837 | ENDIF | |
29838 | ||
29839 | C...Expansion for CTEQ3D. | |
29840 | ELSEIF(ISET .EQ. 3) THEN | |
29841 | IF(IPRT .EQ. 2) THEN | |
29842 | A0=Exp( 0.2148D+00+0.5814D-01*SB +0.2734D+00*SB2- | |
29843 | & 0.2902D+00*SB3) | |
29844 | A1= 0.4810D+00+0.1657D-01*SB -0.3800D-01*SB2+0.3125D-01*SB3 | |
29845 | A2= 0.3509D+01+0.3923D+00*SB +0.4010D+00*SB2-0.1932D+00*SB3 | |
29846 | A3= 0.7055D+01-0.6552D+01*SB +0.3466D+01*SB2-0.5657D+00*SB3 | |
29847 | A4= 0.1061D+01-0.3453D+00*SB +0.4089D+00*SB2-0.1817D+00*SB3 | |
29848 | A5= 0.8687D-01+0.2548D+00*SB -0.2967D+00*SB2+0.2647D+00*SB3 | |
29849 | ELSEIF(IPRT .EQ. 1) THEN | |
29850 | A0=Exp( 0.3961D+00+0.4914D+00*SB -0.1728D+01*SB2+ | |
29851 | & 0.7257D+00*SB3) | |
29852 | A1= 0.4162D+00-0.1419D+00*SB +0.3680D+00*SB2-0.1618D+00*SB3 | |
29853 | A2= 0.3248D+01+0.3028D+01*SB -0.4307D+01*SB2+0.1920D+01*SB3 | |
29854 | A3=-0.1100D+01+0.2184D+01*SB -0.3820D+01*SB2+0.1717D+01*SB3 | |
29855 | A4= 0.2082D+01-0.2756D+00*SB +0.3043D+00*SB2-0.1260D+00*SB3 | |
29856 | A5=-0.4822D+00-0.5706D+00*SB +0.2243D+01*SB2-0.9760D+00*SB3 | |
29857 | ELSEIF(IPRT .EQ. 0) THEN | |
29858 | A0=Exp(-0.4665D+00-0.7554D+00*SB -0.3323D+00*SB2- | |
29859 | & 0.2734D-04*SB3) | |
29860 | A1=-0.3359D+00+0.2395D+00*SB -0.2377D+00*SB2+0.7059D-01*SB3 | |
29861 | A2= 0.5451D+01+0.6086D+00*SB +0.8606D-01*SB2-0.1425D+00*SB3 | |
29862 | A3= 0.1026D+02-0.9352D+01*SB +0.4879D+01*SB2-0.1150D+01*SB3 | |
29863 | A4= 0.9935D+00-0.5017D-01*SB -0.1707D-01*SB2-0.1464D-02*SB3 | |
29864 | A5=-0.4160D-01+0.2305D+01*SB -0.1063D+01*SB2+0.3211D+00*SB3 | |
29865 | ELSEIF(IPRT .EQ. -1) THEN | |
29866 | A0=Exp(-0.2714D+01-0.2868D+01*SB +0.3700D+01*SB2- | |
29867 | & 0.1671D+01*SB3) | |
29868 | A1=-0.3893D+00+0.3341D+00*SB -0.3897D+00*SB2+0.1420D+00*SB3 | |
29869 | A2= 0.8359D+01-0.3267D+01*SB +0.5327D+01*SB2-0.2245D+01*SB3 | |
29870 | A3= 0.2359D+02-0.5669D+01*SB -0.4602D+01*SB2+0.3153D+01*SB3 | |
29871 | A4= 0.1106D+01-0.4745D+00*SB +0.7739D+00*SB2-0.3417D+00*SB3 | |
29872 | A5=-0.5557D+00+0.3433D+01*SB -0.3390D+01*SB2+0.1354D+01*SB3 | |
29873 | ELSEIF(IPRT .EQ. -2) THEN | |
29874 | A0=Exp(-0.3323D+01+0.2296D+00*SB -0.1109D+01*SB2+ | |
29875 | & 0.2223D+00*SB3) | |
29876 | A1=-0.3410D+00+0.8847D-01*SB -0.1111D-01*SB2-0.5927D-02*SB3 | |
29877 | A2= 0.9753D+01-0.5182D+00*SB -0.4670D+00*SB2+0.1921D+00*SB3 | |
29878 | A3= 0.1977D+02-0.1600D+02*SB +0.9481D+01*SB2-0.1864D+01*SB3 | |
29879 | A4= 0.9818D+00+0.2839D-02*SB -0.1188D+00*SB2+0.3584D-01*SB3 | |
29880 | A5=-0.7934D-01+0.1004D+01*SB +0.3704D+00*SB2-0.1220D+00*SB3 | |
29881 | ELSEIF(IPRT .EQ. -3) THEN | |
29882 | A0=Exp(-0.3985D+01+0.2855D+01*SB -0.5208D+01*SB2+ | |
29883 | & 0.1937D+01*SB3) | |
29884 | A1=-0.3337D+00-0.1150D+00*SB +0.3691D+00*SB2-0.1709D+00*SB3 | |
29885 | A2= 0.7968D+01+0.3641D+01*SB -0.6599D+01*SB2+0.2642D+01*SB3 | |
29886 | A3= 0.1873D+02-0.1999D+02*SB +0.1734D+02*SB2-0.5813D+01*SB3 | |
29887 | A4= 0.9731D+00+0.5082D+00*SB -0.8780D+00*SB2+0.3231D+00*SB3 | |
29888 | A5=-0.5542D-01-0.4189D+00*SB +0.3309D+01*SB2-0.1439D+01*SB3 | |
29889 | ELSEIF(IPRT .EQ. -4) THEN | |
29890 | A0=SB** 0.1105D+01*Exp(-0.3952D+01-0.1901D+01*SB + | |
29891 | & 0.5137D+00*SB2) | |
29892 | A1=-0.3543D+00+0.6055D+00*SB -0.6941D+00*SB2+0.2278D+00*SB3 | |
29893 | A2= 0.5955D+01-0.2629D+01*SB +0.5337D+01*SB2-0.2300D+01*SB3 | |
29894 | A3= 0.1933D+01+0.4882D+01*SB -0.3810D+01*SB2+0.2290D+00*SB3 | |
29895 | A4= 0.1806D+00+0.1655D+01*SB -0.1893D+01*SB2+0.6395D+00*SB3 | |
29896 | A5= 0.4790D+00+0.3612D+01*SB -0.3152D+01*SB2+0.9684D+00*SB3 | |
29897 | ELSEIF(IPRT .EQ. -5) THEN | |
29898 | A0=SB** 0.9818D+00*Exp(-0.1825D+01-0.7464D+01*SB + | |
29899 | & 0.2143D+01*SB2) | |
29900 | A1=-0.2604D+00-0.1400D+00*SB +0.1702D+00*SB2-0.8476D-01*SB3 | |
29901 | A2= 0.6005D+01+0.6275D+00*SB -0.2535D+01*SB2+0.2219D+01*SB3 | |
29902 | A3=-0.9067D+00+0.1149D+01*SB +0.1974D+01*SB2+0.4716D+01*SB3 | |
29903 | A4= 0.3915D-01+0.5945D-01*SB -0.9844D-01*SB2+0.2783D-01*SB3 | |
29904 | A5= 0.5500D+00+0.1994D+01*SB -0.6727D+00*SB2-0.1510D+00*SB3 | |
29905 | ELSEIF(IPRT .EQ. -6) THEN | |
29906 | A0=SB** 0.1002D+01*Exp(-0.8553D+01+0.3793D+00*SB + | |
29907 | & 0.9998D+01*SB2) | |
29908 | A1=-0.5870D-01-0.2792D+00*SB +0.6526D+00*SB2-0.1984D+01*SB3 | |
29909 | A2= 0.4716D+01+0.4473D+00*SB +0.1128D+02*SB2-0.1937D+02*SB3 | |
29910 | A3= 0.1289D+02-0.1742D+02*SB -0.1983D+02*SB2-0.9274D+00*SB3 | |
29911 | A4= 0.5647D+00-0.2732D+00*SB +0.1074D+01*SB2+0.5981D+00*SB3 | |
29912 | A5= 0.4390D+01-0.1262D+01*SB -0.9026D+00*SB2-0.9394D+01*SB3 | |
29913 | ENDIF | |
29914 | ENDIF | |
29915 | ||
29916 | C...Calculation of x * f(x, Q). | |
29917 | PYCTEQ = MAX(0D0, A0 *(X**A1) *((1D0-X)**A2) *(1D0+A3*(X**A4)) | |
29918 | & *(LOG(1D0+1D0/X))**A5 ) | |
29919 | ||
29920 | RETURN | |
29921 | END | |
29922 | ||
29923 | C********************************************************************* | |
29924 | ||
29925 | C...PYGRVL | |
29926 | C...Gives the GRV 94 L (leading order) parton distribution function set | |
29927 | C...in parametrized form. | |
29928 | C...Authors: M. Glueck, E. Reya and A. Vogt. | |
29929 | ||
29930 | SUBROUTINE PYGRVL (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL) | |
29931 | ||
29932 | C...Double precision declaration. | |
29933 | IMPLICIT DOUBLE PRECISION (A - Z) | |
29934 | ||
29935 | C...Common expressions. | |
29936 | MU2 = 0.23D0 | |
29937 | LAM2 = 0.2322D0 * 0.2322D0 | |
29938 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
29939 | DS = SQRT (S) | |
29940 | S2 = S * S | |
29941 | S3 = S2 * S | |
29942 | ||
29943 | C...uv : | |
29944 | NU = 2.284D0 + 0.802D0 * S + 0.055D0 * S2 | |
29945 | AKU = 0.590D0 - 0.024D0 * S | |
29946 | BKU = 0.131D0 + 0.063D0 * S | |
29947 | AU = -0.449D0 - 0.138D0 * S - 0.076D0 * S2 | |
29948 | BU = 0.213D0 + 2.669D0 * S - 0.728D0 * S2 | |
29949 | CU = 8.854D0 - 9.135D0 * S + 1.979D0 * S2 | |
29950 | DU = 2.997D0 + 0.753D0 * S - 0.076D0 * S2 | |
29951 | UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU) | |
29952 | ||
29953 | C...dv : | |
29954 | ND = 0.371D0 + 0.083D0 * S + 0.039D0 * S2 | |
29955 | AKD = 0.376D0 | |
29956 | BKD = 0.486D0 + 0.062D0 * S | |
29957 | AD = -0.509D0 + 3.310D0 * S - 1.248D0 * S2 | |
29958 | BD = 12.41D0 - 10.52D0 * S + 2.267D0 * S2 | |
29959 | CD = 6.373D0 - 6.208D0 * S + 1.418D0 * S2 | |
29960 | DD = 3.691D0 + 0.799D0 * S - 0.071D0 * S2 | |
29961 | DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD) | |
29962 | ||
29963 | C...del : | |
29964 | NE = 0.082D0 + 0.014D0 * S + 0.008D0 * S2 | |
29965 | AKE = 0.409D0 - 0.005D0 * S | |
29966 | BKE = 0.799D0 + 0.071D0 * S | |
29967 | AE = -38.07D0 + 36.13D0 * S - 0.656D0 * S2 | |
29968 | BE = 90.31D0 - 74.15D0 * S + 7.645D0 * S2 | |
29969 | CE = 0.0D0 | |
29970 | DE = 7.486D0 + 1.217D0 * S - 0.159D0 * S2 | |
29971 | DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE) | |
29972 | ||
29973 | C...udb : | |
29974 | ALX = 1.451D0 | |
29975 | BEX = 0.271D0 | |
29976 | AKX = 0.410D0 - 0.232D0 * S | |
29977 | BKX = 0.534D0 - 0.457D0 * S | |
29978 | AGX = 0.890D0 - 0.140D0 * S | |
29979 | BGX = -0.981D0 | |
29980 | CX = 0.320D0 + 0.683D0 * S | |
29981 | DX = 4.752D0 + 1.164D0 * S + 0.286D0 * S2 | |
29982 | EX = 4.119D0 + 1.713D0 * S | |
29983 | ESX = 0.682D0 + 2.978D0 * S | |
29984 | UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX, | |
29985 | & DX, EX, ESX) | |
29986 | ||
29987 | C...sb : | |
29988 | STS = 0D0 | |
29989 | ALS = 0.914D0 | |
29990 | BES = 0.577D0 | |
29991 | AKS = 1.798D0 - 0.596D0 * S | |
29992 | AS = -5.548D0 + 3.669D0 * DS - 0.616D0 * S | |
29993 | BS = 18.92D0 - 16.73D0 * DS + 5.168D0 * S | |
29994 | DST = 6.379D0 - 0.350D0 * S + 0.142D0 * S2 | |
29995 | EST = 3.981D0 + 1.638D0 * S | |
29996 | ESS = 6.402D0 | |
29997 | SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS) | |
29998 | ||
29999 | C...cb : | |
30000 | STC = 0.888D0 | |
30001 | ALC = 1.01D0 | |
30002 | BEC = 0.37D0 | |
30003 | AKC = 0D0 | |
30004 | AC = 0D0 | |
30005 | BC = 4.24D0 - 0.804D0 * S | |
30006 | DCT = 3.46D0 - 1.076D0 * S | |
30007 | ECT = 4.61D0 + 1.49D0 * S | |
30008 | ESC = 2.555D0 + 1.961D0 * S | |
30009 | CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC) | |
30010 | ||
30011 | C...bb : | |
30012 | STB = 1.351D0 | |
30013 | ALB = 1.00D0 | |
30014 | BEB = 0.51D0 | |
30015 | AKB = 0D0 | |
30016 | AB = 0D0 | |
30017 | BB = 1.848D0 | |
30018 | DBT = 2.929D0 + 1.396D0 * S | |
30019 | EBT = 4.71D0 + 1.514D0 * S | |
30020 | ESB = 4.02D0 + 1.239D0 * S | |
30021 | BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB) | |
30022 | ||
30023 | C...gl : | |
30024 | ALG = 0.524D0 | |
30025 | BEG = 1.088D0 | |
30026 | AKG = 1.742D0 - 0.930D0 * S | |
30027 | BKG = - 0.399D0 * S2 | |
30028 | AG = 7.486D0 - 2.185D0 * S | |
30029 | BG = 16.69D0 - 22.74D0 * S + 5.779D0 * S2 | |
30030 | CG = -25.59D0 + 29.71D0 * S - 7.296D0 * S2 | |
30031 | DG = 2.792D0 + 2.215D0 * S + 0.422D0 * S2 - 0.104D0 * S3 | |
30032 | EG = 0.807D0 + 2.005D0 * S | |
30033 | ESG = 3.841D0 + 0.316D0 * S | |
30034 | GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, | |
30035 | & DG, EG, ESG) | |
30036 | ||
30037 | RETURN | |
30038 | END | |
30039 | ||
30040 | C********************************************************************* | |
30041 | ||
30042 | C...PYGRVM | |
30043 | C...Gives the GRV 94 M (MSbar) parton distribution function set | |
30044 | C...in parametrized form. | |
30045 | C...Authors: M. Glueck, E. Reya and A. Vogt. | |
30046 | ||
30047 | SUBROUTINE PYGRVM (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL) | |
30048 | ||
30049 | C...Double precision declaration. | |
30050 | IMPLICIT DOUBLE PRECISION (A - Z) | |
30051 | ||
30052 | C...Common expressions. | |
30053 | MU2 = 0.34D0 | |
30054 | LAM2 = 0.248D0 * 0.248D0 | |
30055 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
30056 | DS = SQRT (S) | |
30057 | S2 = S * S | |
30058 | S3 = S2 * S | |
30059 | ||
30060 | C...uv : | |
30061 | NU = 1.304D0 + 0.863D0 * S | |
30062 | AKU = 0.558D0 - 0.020D0 * S | |
30063 | BKU = 0.183D0 * S | |
30064 | AU = -0.113D0 + 0.283D0 * S - 0.321D0 * S2 | |
30065 | BU = 6.843D0 - 5.089D0 * S + 2.647D0 * S2 - 0.527D0 * S3 | |
30066 | CU = 7.771D0 - 10.09D0 * S + 2.630D0 * S2 | |
30067 | DU = 3.315D0 + 1.145D0 * S - 0.583D0 * S2 + 0.154D0 * S3 | |
30068 | UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU) | |
30069 | ||
30070 | C...dv : | |
30071 | ND = 0.102D0 - 0.017D0 * S + 0.005D0 * S2 | |
30072 | AKD = 0.270D0 - 0.019D0 * S | |
30073 | BKD = 0.260D0 | |
30074 | AD = 2.393D0 + 6.228D0 * S - 0.881D0 * S2 | |
30075 | BD = 46.06D0 + 4.673D0 * S - 14.98D0 * S2 + 1.331D0 * S3 | |
30076 | CD = 17.83D0 - 53.47D0 * S + 21.24D0 * S2 | |
30077 | DD = 4.081D0 + 0.976D0 * S - 0.485D0 * S2 + 0.152D0 * S3 | |
30078 | DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD) | |
30079 | ||
30080 | C...del : | |
30081 | NE = 0.070D0 + 0.042D0 * S - 0.011D0 * S2 + 0.004D0 * S3 | |
30082 | AKE = 0.409D0 - 0.007D0 * S | |
30083 | BKE = 0.782D0 + 0.082D0 * S | |
30084 | AE = -29.65D0 + 26.49D0 * S + 5.429D0 * S2 | |
30085 | BE = 90.20D0 - 74.97D0 * S + 4.526D0 * S2 | |
30086 | CE = 0.0D0 | |
30087 | DE = 8.122D0 + 2.120D0 * S - 1.088D0 * S2 + 0.231D0 * S3 | |
30088 | DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE) | |
30089 | ||
30090 | C...udb : | |
30091 | ALX = 0.877D0 | |
30092 | BEX = 0.561D0 | |
30093 | AKX = 0.275D0 | |
30094 | BKX = 0.0D0 | |
30095 | AGX = 0.997D0 | |
30096 | BGX = 3.210D0 - 1.866D0 * S | |
30097 | CX = 7.300D0 | |
30098 | DX = 9.010D0 + 0.896D0 * DS + 0.222D0 * S2 | |
30099 | EX = 3.077D0 + 1.446D0 * S | |
30100 | ESX = 3.173D0 - 2.445D0 * DS + 2.207D0 * S | |
30101 | UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX, | |
30102 | & DX, EX, ESX) | |
30103 | ||
30104 | C...sb : | |
30105 | STS = 0D0 | |
30106 | ALS = 0.756D0 | |
30107 | BES = 0.216D0 | |
30108 | AKS = 1.690D0 + 0.650D0 * DS - 0.922D0 * S | |
30109 | AS = -4.329D0 + 1.131D0 * S | |
30110 | BS = 9.568D0 - 1.744D0 * S | |
30111 | DST = 9.377D0 + 1.088D0 * DS - 1.320D0 * S + 0.130D0 * S2 | |
30112 | EST = 3.031D0 + 1.639D0 * S | |
30113 | ESS = 5.837D0 + 0.815D0 * S | |
30114 | SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS) | |
30115 | ||
30116 | C...cb : | |
30117 | STC = 0.820D0 | |
30118 | ALC = 0.98D0 | |
30119 | BEC = 0D0 | |
30120 | AKC = -0.625D0 - 0.523D0 * S | |
30121 | AC = 0D0 | |
30122 | BC = 1.896D0 + 1.616D0 * S | |
30123 | DCT = 4.12D0 + 0.683D0 * S | |
30124 | ECT = 4.36D0 + 1.328D0 * S | |
30125 | ESC = 0.677D0 + 0.679D0 * S | |
30126 | CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC) | |
30127 | ||
30128 | C...bb : | |
30129 | STB = 1.297D0 | |
30130 | ALB = 0.99D0 | |
30131 | BEB = 0D0 | |
30132 | AKB = - 0.193D0 * S | |
30133 | AB = 0D0 | |
30134 | BB = 0D0 | |
30135 | DBT = 3.447D0 + 0.927D0 * S | |
30136 | EBT = 4.68D0 + 1.259D0 * S | |
30137 | ESB = 1.892D0 + 2.199D0 * S | |
30138 | BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB) | |
30139 | ||
30140 | C...gl : | |
30141 | ALG = 1.014D0 | |
30142 | BEG = 1.738D0 | |
30143 | AKG = 1.724D0 + 0.157D0 * S | |
30144 | BKG = 0.800D0 + 1.016D0 * S | |
30145 | AG = 7.517D0 - 2.547D0 * S | |
30146 | BG = 34.09D0 - 52.21D0 * DS + 17.47D0 * S | |
30147 | CG = 4.039D0 + 1.491D0 * S | |
30148 | DG = 3.404D0 + 0.830D0 * S | |
30149 | EG = -1.112D0 + 3.438D0 * S - 0.302D0 * S2 | |
30150 | ESG = 3.256D0 - 0.436D0 * S | |
30151 | GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, DG, EG, ESG) | |
30152 | ||
30153 | RETURN | |
30154 | END | |
30155 | ||
30156 | C********************************************************************* | |
30157 | ||
30158 | C...PYGRVD | |
30159 | C...Gives the GRV 94 D (DIS) parton distribution function set | |
30160 | C...in parametrized form. | |
30161 | C...Authors: M. Glueck, E. Reya and A. Vogt. | |
30162 | ||
30163 | SUBROUTINE PYGRVD (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL) | |
30164 | ||
30165 | C...Double precision declaration. | |
30166 | IMPLICIT DOUBLE PRECISION (A - Z) | |
30167 | ||
30168 | C...Common expressions. | |
30169 | MU2 = 0.34D0 | |
30170 | LAM2 = 0.248D0 * 0.248D0 | |
30171 | S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) | |
30172 | DS = SQRT (S) | |
30173 | S2 = S * S | |
30174 | S3 = S2 * S | |
30175 | ||
30176 | C...uv : | |
30177 | NU = 2.484D0 + 0.116D0 * S + 0.093D0 * S2 | |
30178 | AKU = 0.563D0 - 0.025D0 * S | |
30179 | BKU = 0.054D0 + 0.154D0 * S | |
30180 | AU = -0.326D0 - 0.058D0 * S - 0.135D0 * S2 | |
30181 | BU = -3.322D0 + 8.259D0 * S - 3.119D0 * S2 + 0.291D0 * S3 | |
30182 | CU = 11.52D0 - 12.99D0 * S + 3.161D0 * S2 | |
30183 | DU = 2.808D0 + 1.400D0 * S - 0.557D0 * S2 + 0.119D0 * S3 | |
30184 | UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU) | |
30185 | ||
30186 | C...dv : | |
30187 | ND = 0.156D0 - 0.017D0 * S | |
30188 | AKD = 0.299D0 - 0.022D0 * S | |
30189 | BKD = 0.259D0 - 0.015D0 * S | |
30190 | AD = 3.445D0 + 1.278D0 * S + 0.326D0 * S2 | |
30191 | BD = -6.934D0 + 37.45D0 * S - 18.95D0 * S2 + 1.463D0 * S3 | |
30192 | CD = 55.45D0 - 69.92D0 * S + 20.78D0 * S2 | |
30193 | DD = 3.577D0 + 1.441D0 * S - 0.683D0 * S2 + 0.179D0 * S3 | |
30194 | DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD) | |
30195 | ||
30196 | C...del : | |
30197 | NE = 0.099D0 + 0.019D0 * S + 0.002D0 * S2 | |
30198 | AKE = 0.419D0 - 0.013D0 * S | |
30199 | BKE = 1.064D0 - 0.038D0 * S | |
30200 | AE = -44.00D0 + 98.70D0 * S - 14.79D0 * S2 | |
30201 | BE = 28.59D0 - 40.94D0 * S - 13.66D0 * S2 + 2.523D0 * S3 | |
30202 | CE = 84.57D0 - 108.8D0 * S + 31.52D0 * S2 | |
30203 | DE = 7.469D0 + 2.480D0 * S - 0.866D0 * S2 | |
30204 | DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE) | |
30205 | ||
30206 | C...udb : | |
30207 | ALX = 1.215D0 | |
30208 | BEX = 0.466D0 | |
30209 | AKX = 0.326D0 + 0.150D0 * S | |
30210 | BKX = 0.956D0 + 0.405D0 * S | |
30211 | AGX = 0.272D0 | |
30212 | BGX = 3.794D0 - 2.359D0 * DS | |
30213 | CX = 2.014D0 | |
30214 | DX = 7.941D0 + 0.534D0 * DS - 0.940D0 * S + 0.410D0 * S2 | |
30215 | EX = 3.049D0 + 1.597D0 * S | |
30216 | ESX = 4.396D0 - 4.594D0 * DS + 3.268D0 * S | |
30217 | UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX, | |
30218 | & DX, EX, ESX) | |
30219 | ||
30220 | C...sb : | |
30221 | STS = 0D0 | |
30222 | ALS = 0.175D0 | |
30223 | BES = 0.344D0 | |
30224 | AKS = 1.415D0 - 0.641D0 * DS | |
30225 | AS = 0.580D0 - 9.763D0 * DS + 6.795D0 * S - 0.558D0 * S2 | |
30226 | BS = 5.617D0 + 5.709D0 * DS - 3.972D0 * S | |
30227 | DST = 13.78D0 - 9.581D0 * S + 5.370D0 * S2 - 0.996D0 * S3 | |
30228 | EST = 4.546D0 + 0.372D0 * S2 | |
30229 | ESS = 5.053D0 - 1.070D0 * S + 0.805D0 * S2 | |
30230 | SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS) | |
30231 | ||
30232 | C...cb : | |
30233 | STC = 0.820D0 | |
30234 | ALC = 0.98D0 | |
30235 | BEC = 0D0 | |
30236 | AKC = -0.625D0 - 0.523D0 * S | |
30237 | AC = 0D0 | |
30238 | BC = 1.896D0 + 1.616D0 * S | |
30239 | DCT = 4.12D0 + 0.683D0 * S | |
30240 | ECT = 4.36D0 + 1.328D0 * S | |
30241 | ESC = 0.677D0 + 0.679D0 * S | |
30242 | CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC) | |
30243 | ||
30244 | C...bb : | |
30245 | STB = 1.297D0 | |
30246 | ALB = 0.99D0 | |
30247 | BEB = 0D0 | |
30248 | AKB = - 0.193D0 * S | |
30249 | AB = 0D0 | |
30250 | BB = 0D0 | |
30251 | DBT = 3.447D0 + 0.927D0 * S | |
30252 | EBT = 4.68D0 + 1.259D0 * S | |
30253 | ESB = 1.892D0 + 2.199D0 * S | |
30254 | BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB) | |
30255 | ||
30256 | C...gl : | |
30257 | ALG = 1.258D0 | |
30258 | BEG = 1.846D0 | |
30259 | AKG = 2.423D0 | |
30260 | BKG = 2.427D0 + 1.311D0 * S - 0.153D0 * S2 | |
30261 | AG = 25.09D0 - 7.935D0 * S | |
30262 | BG = -14.84D0 - 124.3D0 * DS + 72.18D0 * S | |
30263 | CG = 590.3D0 - 173.8D0 * S | |
30264 | DG = 5.196D0 + 1.857D0 * S | |
30265 | EG = -1.648D0 + 3.988D0 * S - 0.432D0 * S2 | |
30266 | ESG = 3.232D0 - 0.542D0 * S | |
30267 | GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, DG, EG, ESG) | |
30268 | ||
30269 | RETURN | |
30270 | END | |
30271 | ||
30272 | C********************************************************************* | |
30273 | ||
30274 | C...PYGRVV | |
30275 | C...Auxiliary for the GRV 94 parton distribution functions | |
30276 | C...for u and d valence and d-u sea. | |
30277 | C...Authors: M. Glueck, E. Reya and A. Vogt. | |
30278 | ||
30279 | FUNCTION PYGRVV (X, N, AK, BK, A, B, C, D) | |
30280 | ||
30281 | C...Double precision declaration. | |
30282 | IMPLICIT DOUBLE PRECISION (A - Z) | |
30283 | ||
30284 | C...Evaluation. | |
30285 | DX = SQRT (X) | |
30286 | PYGRVV = N * X**AK * (1D0+ A*X**BK + X * (B + C*DX)) * | |
30287 | & (1D0- X)**D | |
30288 | ||
30289 | RETURN | |
30290 | END | |
30291 | ||
30292 | C********************************************************************* | |
30293 | ||
30294 | C...PYGRVW | |
30295 | C...Auxiliary for the GRV 94 parton distribution functions | |
30296 | C...for d+u sea and gluon. | |
30297 | C...Authors: M. Glueck, E. Reya and A. Vogt. | |
30298 | ||
30299 | FUNCTION PYGRVW (X, S, AL, BE, AK, BK, A, B, C, D, E, ES) | |
30300 | ||
30301 | C...Double precision declaration. | |
30302 | IMPLICIT DOUBLE PRECISION (A - Z) | |
30303 | ||
30304 | C...Evaluation. | |
30305 | LX = LOG (1D0/X) | |
30306 | PYGRVW = (X**AK * (A + X * (B + X*C)) * LX**BK + S**AL | |
30307 | & * EXP (-E + SQRT (ES * S**BE * LX))) * (1D0- X)**D | |
30308 | ||
30309 | RETURN | |
30310 | END | |
30311 | ||
30312 | C********************************************************************* | |
30313 | ||
30314 | C...PYGRVS | |
30315 | C...Auxiliary for the GRV 94 parton distribution functions | |
30316 | C...for s, c and b sea. | |
30317 | C...Authors: M. Glueck, E. Reya and A. Vogt. | |
30318 | ||
30319 | FUNCTION PYGRVS (X, S, STH, AL, BE, AK, AG, B, D, E, ES) | |
30320 | ||
30321 | C...Double precision declaration. | |
30322 | IMPLICIT DOUBLE PRECISION (A - Z) | |
30323 | ||
30324 | C...Evaluation. | |
30325 | IF(S.LE.STH) THEN | |
30326 | PYGRVS = 0D0 | |
30327 | ELSE | |
30328 | DX = SQRT (X) | |
30329 | LX = LOG (1D0/X) | |
30330 | PYGRVS = (S - STH)**AL / LX**AK * (1D0+ AG*DX + B*X) * | |
30331 | & (1D0- X)**D * EXP (-E + SQRT (ES * S**BE * LX)) | |
30332 | ENDIF | |
30333 | ||
30334 | RETURN | |
30335 | END | |
30336 | ||
30337 | C********************************************************************* | |
30338 | ||
30339 | C...PYCT5L | |
30340 | C...Auxiliary function for parametrization of CTEQ5L. | |
30341 | C...Author: J. Pumplin 9/99. | |
30342 | ||
30343 | C...CTEQ5M1 and CTEQ5L Parton Distribution Functions | |
30344 | C...in Parametrized Form | |
30345 | C... September 15, 1999 | |
30346 | C | |
30347 | C...Ref: "GLOBAL QCD ANALYSIS OF PARTON STRUCTURE OF THE NUCLEON: | |
30348 | C... CTEQ5 PPARTON DISTRIBUTIONS" | |
30349 | C...hep-ph/9903282 | |
30350 | ||
30351 | C...The CTEQ5M1 set given here is an updated version of the original | |
30352 | C...CTEQ5M set posted, in the table version, on the Web page of CTEQ. | |
30353 | C...The differences between CTEQ5M and CTEQ5M1 are insignificant for | |
30354 | C...almost all applications. | |
30355 | C...The improvement is in the QCD evolution which is now more | |
30356 | C...accurate, and which agrees completely with the benchmark work | |
30357 | C...of the HERA 96/97 Workshop. | |
30358 | C...The differences between the parametrized and the corresponding | |
30359 | C...table versions (on which it is based) are of similar order as | |
30360 | C...between the two version. | |
30361 | ||
30362 | C...!! Because accurate parametrizations over a wide range of (x,Q) | |
30363 | C...is hard to obtain, only the most widely used sets CTEQ5M and | |
30364 | C...CTEQ5L are available in parametrized form for now. | |
30365 | ||
30366 | C...These parametrizations were obtained by Jon Pumplin. | |
30367 | ||
30368 | C Iset PDF Description Alpha_s(Mz) Lam4 Lam5 | |
30369 | C ------------------------------------------------------------------- | |
30370 | C 1 CTEQ5M1 Standard NLO MSbar scheme 0.118 326 226 | |
30371 | C 3 CTEQ5L Leading Order 0.127 192 146 | |
30372 | C ------------------------------------------------------------------- | |
30373 | C...Note the Qcd-lambda values given for CTEQ5L is for the leading | |
30374 | C...order form of Alpha_s!! Alpha_s(Mz) gives the absolute | |
30375 | C...calibration. | |
30376 | ||
30377 | C...The two Iset value are adopted to agree with the standard table | |
30378 | C...versions. | |
30379 | ||
30380 | C...Range of validity: | |
30381 | C...The range of (x, Q) covered by this parametrization of the QCD | |
30382 | C...evolved parton distributions is 1E-6 < x < 1 ; | |
30383 | C...1.1 GeV < Q < 10 TeV. Of course, the PDF's are constrained by | |
30384 | C...data only in a subset of that region; and the assumed DGLAP | |
30385 | C...evolution is unlikely to be valid for all of it either. | |
30386 | ||
30387 | C...The range of (x, Q) used in the CTEQ5 round of global analysis is | |
30388 | C...approximately 0.01 < x < 0.75 ; and 4 GeV^2 < Q^2 < 400 GeV^2 for | |
30389 | C...fixed target experiments; 0.0001 < x < 0.3 from HERA data; and | |
30390 | C...Q^2 up to 40,000 GeV^2 from Tevatron inclusive Jet data. | |
30391 | ||
30392 | FUNCTION PYCT5L(IFL,X,Q) | |
30393 | ||
30394 | C...Double precision declaration. | |
30395 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
30396 | IMPLICIT INTEGER(I-N) | |
30397 | ||
30398 | PARAMETER (NEX=8, NLF=2) | |
30399 | DIMENSION AM(0:NEX,0:NLF,-5:2) | |
30400 | DIMENSION ALFVEC(-5:2), QMAVEC(-5:2) | |
30401 | DIMENSION MEXVEC(-5:2), MLFVEC(-5:2) | |
30402 | DIMENSION UT1VEC(-5:2), UT2VEC(-5:2) | |
30403 | DIMENSION AF(0:NEX) | |
30404 | ||
30405 | DATA MEXVEC( 2) / 8 / | |
30406 | DATA MLFVEC( 2) / 2 / | |
30407 | DATA UT1VEC( 2) / 0.4971265E+01 / | |
30408 | DATA UT2VEC( 2) / -0.1105128E+01 / | |
30409 | DATA ALFVEC( 2) / 0.2987216E+00 / | |
30410 | DATA QMAVEC( 2) / 0.0000000E+00 / | |
30411 | DATA (AM( 0,K, 2),K=0, 2) | |
30412 | & / 0.5292616E+01, -0.2751910E+01, -0.2488990E+01 / | |
30413 | DATA (AM( 1,K, 2),K=0, 2) | |
30414 | & / 0.9714424E+00, 0.1011827E-01, -0.1023660E-01 / | |
30415 | DATA (AM( 2,K, 2),K=0, 2) | |
30416 | & / -0.1651006E+02, 0.7959721E+01, 0.8810563E+01 / | |
30417 | DATA (AM( 3,K, 2),K=0, 2) | |
30418 | & / -0.1643394E+02, 0.5892854E+01, 0.9348874E+01 / | |
30419 | DATA (AM( 4,K, 2),K=0, 2) | |
30420 | & / 0.3067422E+02, 0.4235796E+01, -0.5112136E+00 / | |
30421 | DATA (AM( 5,K, 2),K=0, 2) | |
30422 | & / 0.2352526E+02, -0.5305168E+01, -0.1169174E+02 / | |
30423 | DATA (AM( 6,K, 2),K=0, 2) | |
30424 | & / -0.1095451E+02, 0.3006577E+01, 0.5638136E+01 / | |
30425 | DATA (AM( 7,K, 2),K=0, 2) | |
30426 | & / -0.1172251E+02, -0.2183624E+01, 0.4955794E+01 / | |
30427 | DATA (AM( 8,K, 2),K=0, 2) | |
30428 | & / 0.1662533E-01, 0.7622870E-02, -0.4895887E-03 / | |
30429 | ||
30430 | DATA MEXVEC( 1) / 8 / | |
30431 | DATA MLFVEC( 1) / 2 / | |
30432 | DATA UT1VEC( 1) / 0.2612618E+01 / | |
30433 | DATA UT2VEC( 1) / -0.1258304E+06 / | |
30434 | DATA ALFVEC( 1) / 0.3407552E+00 / | |
30435 | DATA QMAVEC( 1) / 0.0000000E+00 / | |
30436 | DATA (AM( 0,K, 1),K=0, 2) | |
30437 | & / 0.9905300E+00, -0.4502235E+00, 0.1624441E+00 / | |
30438 | DATA (AM( 1,K, 1),K=0, 2) | |
30439 | & / 0.8867534E+00, 0.1630829E-01, -0.4049085E-01 / | |
30440 | DATA (AM( 2,K, 1),K=0, 2) | |
30441 | & / 0.8547974E+00, 0.3336301E+00, 0.1371388E+00 / | |
30442 | DATA (AM( 3,K, 1),K=0, 2) | |
30443 | & / 0.2941113E+00, -0.1527905E+01, 0.2331879E+00 / | |
30444 | DATA (AM( 4,K, 1),K=0, 2) | |
30445 | & / 0.3384235E+02, 0.3715315E+01, 0.8276930E+00 / | |
30446 | DATA (AM( 5,K, 1),K=0, 2) | |
30447 | & / 0.6230115E+01, 0.3134639E+01, -0.1729099E+01 / | |
30448 | DATA (AM( 6,K, 1),K=0, 2) | |
30449 | & / -0.1186928E+01, -0.3282460E+00, 0.1052020E+00 / | |
30450 | DATA (AM( 7,K, 1),K=0, 2) | |
30451 | & / -0.8545702E+01, -0.6247947E+01, 0.3692561E+01 / | |
30452 | DATA (AM( 8,K, 1),K=0, 2) | |
30453 | & / 0.1724598E-01, 0.7120465E-02, 0.4003646E-04 / | |
30454 | ||
30455 | DATA MEXVEC( 0) / 8 / | |
30456 | DATA MLFVEC( 0) / 2 / | |
30457 | DATA UT1VEC( 0) / -0.4656819E+00 / | |
30458 | DATA UT2VEC( 0) / -0.2742390E+03 / | |
30459 | DATA ALFVEC( 0) / 0.4491863E+00 / | |
30460 | DATA QMAVEC( 0) / 0.0000000E+00 / | |
30461 | DATA (AM( 0,K, 0),K=0, 2) | |
30462 | & / 0.1193572E+03, -0.3886845E+01, -0.1133965E+01 / | |
30463 | DATA (AM( 1,K, 0),K=0, 2) | |
30464 | & / -0.9421449E+02, 0.3995885E+01, 0.1607363E+01 / | |
30465 | DATA (AM( 2,K, 0),K=0, 2) | |
30466 | & / 0.4206383E+01, 0.2485954E+00, 0.2497468E+00 / | |
30467 | DATA (AM( 3,K, 0),K=0, 2) | |
30468 | & / 0.1210557E+03, -0.3015765E+01, -0.1423651E+01 / | |
30469 | DATA (AM( 4,K, 0),K=0, 2) | |
30470 | & / -0.1013897E+03, -0.7113478E+00, 0.2621865E+00 / | |
30471 | DATA (AM( 5,K, 0),K=0, 2) | |
30472 | & / -0.1312404E+01, -0.9297691E+00, -0.1562531E+00 / | |
30473 | DATA (AM( 6,K, 0),K=0, 2) | |
30474 | & / 0.1627137E+01, 0.4954111E+00, -0.6387009E+00 / | |
30475 | DATA (AM( 7,K, 0),K=0, 2) | |
30476 | & / 0.1537698E+00, -0.2487878E+00, 0.8305947E+00 / | |
30477 | DATA (AM( 8,K, 0),K=0, 2) | |
30478 | & / 0.2496448E-01, 0.2457823E-02, 0.8234276E-03 / | |
30479 | ||
30480 | DATA MEXVEC(-1) / 8 / | |
30481 | DATA MLFVEC(-1) / 2 / | |
30482 | DATA UT1VEC(-1) / 0.3862583E+01 / | |
30483 | DATA UT2VEC(-1) / -0.1265969E+01 / | |
30484 | DATA ALFVEC(-1) / 0.2457668E+00 / | |
30485 | DATA QMAVEC(-1) / 0.0000000E+00 / | |
30486 | DATA (AM( 0,K,-1),K=0, 2) | |
30487 | & / 0.2647441E+02, 0.1059277E+02, -0.9176654E+00 / | |
30488 | DATA (AM( 1,K,-1),K=0, 2) | |
30489 | & / 0.1990636E+01, 0.8558918E-01, 0.4248667E-01 / | |
30490 | DATA (AM( 2,K,-1),K=0, 2) | |
30491 | & / -0.1476095E+02, -0.3276255E+02, 0.1558110E+01 / | |
30492 | DATA (AM( 3,K,-1),K=0, 2) | |
30493 | & / -0.2966889E+01, -0.3649037E+02, 0.1195914E+01 / | |
30494 | DATA (AM( 4,K,-1),K=0, 2) | |
30495 | & / -0.1000519E+03, -0.2464635E+01, 0.1964849E+00 / | |
30496 | DATA (AM( 5,K,-1),K=0, 2) | |
30497 | & / 0.3718331E+02, 0.4700389E+02, -0.2772142E+01 / | |
30498 | DATA (AM( 6,K,-1),K=0, 2) | |
30499 | & / -0.1872722E+02, -0.2291189E+02, 0.1089052E+01 / | |
30500 | DATA (AM( 7,K,-1),K=0, 2) | |
30501 | & / -0.1628146E+02, -0.1823993E+02, 0.2537369E+01 / | |
30502 | DATA (AM( 8,K,-1),K=0, 2) | |
30503 | & / -0.1156300E+01, -0.1280495E+00, 0.5153245E-01 / | |
30504 | ||
30505 | DATA MEXVEC(-2) / 7 / | |
30506 | DATA MLFVEC(-2) / 2 / | |
30507 | DATA UT1VEC(-2) / 0.1895615E+00 / | |
30508 | DATA UT2VEC(-2) / -0.3069097E+01 / | |
30509 | DATA ALFVEC(-2) / 0.5293999E+00 / | |
30510 | DATA QMAVEC(-2) / 0.0000000E+00 / | |
30511 | DATA (AM( 0,K,-2),K=0, 2) | |
30512 | & / -0.6556775E+00, 0.2490190E+00, 0.3966485E-01 / | |
30513 | DATA (AM( 1,K,-2),K=0, 2) | |
30514 | & / 0.1305102E+01, -0.1188925E+00, -0.4600870E-02 / | |
30515 | DATA (AM( 2,K,-2),K=0, 2) | |
30516 | & / -0.2371436E+01, 0.3566814E+00, -0.2834683E+00 / | |
30517 | DATA (AM( 3,K,-2),K=0, 2) | |
30518 | & / -0.6152826E+01, 0.8339877E+00, -0.7233230E+00 / | |
30519 | DATA (AM( 4,K,-2),K=0, 2) | |
30520 | & / -0.8346558E+01, 0.2892168E+01, 0.2137099E+00 / | |
30521 | DATA (AM( 5,K,-2),K=0, 2) | |
30522 | & / 0.1279530E+02, 0.1021114E+00, 0.5787439E+00 / | |
30523 | DATA (AM( 6,K,-2),K=0, 2) | |
30524 | & / 0.5858816E+00, -0.1940375E+01, -0.4029269E+00 / | |
30525 | DATA (AM( 7,K,-2),K=0, 2) | |
30526 | & / -0.2795725E+02, -0.5263392E+00, 0.1290229E+01 / | |
30527 | ||
30528 | DATA MEXVEC(-3) / 7 / | |
30529 | DATA MLFVEC(-3) / 2 / | |
30530 | DATA UT1VEC(-3) / 0.3753257E+01 / | |
30531 | DATA UT2VEC(-3) / -0.1113085E+01 / | |
30532 | DATA ALFVEC(-3) / 0.3713141E+00 / | |
30533 | DATA QMAVEC(-3) / 0.0000000E+00 / | |
30534 | DATA (AM( 0,K,-3),K=0, 2) | |
30535 | & / 0.1580931E+01, -0.2273826E+01, -0.1822245E+01 / | |
30536 | DATA (AM( 1,K,-3),K=0, 2) | |
30537 | & / 0.2702644E+01, 0.6763243E+00, 0.7231586E-02 / | |
30538 | DATA (AM( 2,K,-3),K=0, 2) | |
30539 | & / -0.1857924E+02, 0.3907500E+01, 0.5850109E+01 / | |
30540 | DATA (AM( 3,K,-3),K=0, 2) | |
30541 | & / -0.3044793E+02, 0.2639332E+01, 0.5566644E+01 / | |
30542 | DATA (AM( 4,K,-3),K=0, 2) | |
30543 | & / -0.4258011E+01, -0.5429244E+01, 0.4418946E+00 / | |
30544 | DATA (AM( 5,K,-3),K=0, 2) | |
30545 | & / 0.3465259E+02, -0.5532604E+01, -0.4904153E+01 / | |
30546 | DATA (AM( 6,K,-3),K=0, 2) | |
30547 | & / -0.1658858E+02, 0.2923275E+01, 0.2266286E+01 / | |
30548 | DATA (AM( 7,K,-3),K=0, 2) | |
30549 | & / -0.1149263E+02, 0.2877475E+01, -0.7999105E+00 / | |
30550 | ||
30551 | DATA MEXVEC(-4) / 7 / | |
30552 | DATA MLFVEC(-4) / 2 / | |
30553 | DATA UT1VEC(-4) / 0.4400772E+01 / | |
30554 | DATA UT2VEC(-4) / -0.1356116E+01 / | |
30555 | DATA ALFVEC(-4) / 0.3712017E-01 / | |
30556 | DATA QMAVEC(-4) / 0.1300000E+01 / | |
30557 | DATA (AM( 0,K,-4),K=0, 2) | |
30558 | & / -0.8293661E+00, -0.3982375E+01, -0.6494283E-01 / | |
30559 | DATA (AM( 1,K,-4),K=0, 2) | |
30560 | & / 0.2754618E+01, 0.8338636E+00, -0.6885160E-01 / | |
30561 | DATA (AM( 2,K,-4),K=0, 2) | |
30562 | & / -0.1657987E+02, 0.1439143E+02, -0.6887240E+00 / | |
30563 | DATA (AM( 3,K,-4),K=0, 2) | |
30564 | & / -0.2800703E+02, 0.1535966E+02, -0.7377693E+00 / | |
30565 | DATA (AM( 4,K,-4),K=0, 2) | |
30566 | & / -0.6460216E+01, -0.4783019E+01, 0.4913297E+00 / | |
30567 | DATA (AM( 5,K,-4),K=0, 2) | |
30568 | & / 0.3141830E+02, -0.3178031E+02, 0.7136013E+01 / | |
30569 | DATA (AM( 6,K,-4),K=0, 2) | |
30570 | & / -0.1802509E+02, 0.1862163E+02, -0.4632843E+01 / | |
30571 | DATA (AM( 7,K,-4),K=0, 2) | |
30572 | & / -0.1240412E+02, 0.2565386E+02, -0.1066570E+02 / | |
30573 | ||
30574 | DATA MEXVEC(-5) / 6 / | |
30575 | DATA MLFVEC(-5) / 2 / | |
30576 | DATA UT1VEC(-5) / 0.5562568E+01 / | |
30577 | DATA UT2VEC(-5) / -0.1801317E+01 / | |
30578 | DATA ALFVEC(-5) / 0.4952010E-02 / | |
30579 | DATA QMAVEC(-5) / 0.4500000E+01 / | |
30580 | DATA (AM( 0,K,-5),K=0, 2) | |
30581 | & / -0.6031237E+01, 0.1992727E+01, -0.1076331E+01 / | |
30582 | DATA (AM( 1,K,-5),K=0, 2) | |
30583 | & / 0.2933912E+01, 0.5839674E+00, 0.7509435E-01 / | |
30584 | DATA (AM( 2,K,-5),K=0, 2) | |
30585 | & / -0.8284919E+01, 0.1488593E+01, -0.8251678E+00 / | |
30586 | DATA (AM( 3,K,-5),K=0, 2) | |
30587 | & / -0.1925986E+02, 0.2805753E+01, -0.3015446E+01 / | |
30588 | DATA (AM( 4,K,-5),K=0, 2) | |
30589 | & / -0.9480483E+01, -0.9767837E+00, -0.1165544E+01 / | |
30590 | DATA (AM( 5,K,-5),K=0, 2) | |
30591 | & / 0.2193195E+02, -0.1788518E+02, 0.9460908E+01 / | |
30592 | DATA (AM( 6,K,-5),K=0, 2) | |
30593 | & / -0.1327377E+02, 0.1201754E+02, -0.6277844E+01 / | |
30594 | ||
30595 | IF(Q .LE. QMAVEC(IFL)) THEN | |
30596 | PYCT5L = 0.D0 | |
30597 | RETURN | |
30598 | ENDIF | |
30599 | ||
30600 | IF(X .GE. 1.D0) THEN | |
30601 | PYCT5L = 0.D0 | |
30602 | RETURN | |
30603 | ENDIF | |
30604 | ||
30605 | TMP = LOG(Q/ALFVEC(IFL)) | |
30606 | IF(TMP .LE. 0.D0) THEN | |
30607 | PYCT5L = 0.D0 | |
30608 | RETURN | |
30609 | ENDIF | |
30610 | ||
30611 | SB = LOG(TMP) | |
30612 | SB1 = SB - 1.2D0 | |
30613 | SB2 = SB1*SB1 | |
30614 | ||
30615 | DO 110 I = 0, NEX | |
30616 | AF(I) = 0.D0 | |
30617 | SBX = 1.D0 | |
30618 | DO 100 K = 0, MLFVEC(IFL) | |
30619 | AF(I) = AF(I) + SBX*AM(I,K,IFL) | |
30620 | SBX = SB1*SBX | |
30621 | 100 CONTINUE | |
30622 | 110 CONTINUE | |
30623 | ||
30624 | Y = -LOG(X) | |
30625 | U = LOG(X/0.00001D0) | |
30626 | ||
30627 | PART1 = AF(1)*Y**(1.D0+0.01D0*AF(4))*(1.D0+ AF(8)*U) | |
30628 | PART2 = AF(0)*(1.D0 - X) + AF(3)*X | |
30629 | PART3 = X*(1.D0-X)*(AF(5)+AF(6)*(1.D0-X)+AF(7)*X*(1.D0-X)) | |
30630 | PART4 = UT1VEC(IFL)*LOG(1.D0-X) + | |
30631 | & AF(2)*LOG(1.D0+EXP(UT2VEC(IFL))-X) | |
30632 | ||
30633 | PYCT5L = EXP(LOG(X) + PART1 + PART2 + PART3 + PART4) | |
30634 | ||
30635 | C...Include threshold factor. | |
30636 | PYCT5L = PYCT5L * (1.D0 - QMAVEC(IFL)/Q) | |
30637 | ||
30638 | RETURN | |
30639 | END | |
30640 | ||
30641 | C********************************************************************* | |
30642 | ||
30643 | C...PYCT5M | |
30644 | C...Auxiliary function for parametrization of CTEQ5M1. | |
30645 | C...Author: J. Pumplin 9/99. | |
30646 | ||
30647 | FUNCTION PYCT5M(IFL,X,Q) | |
30648 | ||
30649 | C...Double precision declaration. | |
30650 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
30651 | IMPLICIT INTEGER(I-N) | |
30652 | ||
30653 | PARAMETER (NEX=8, NLF=2) | |
30654 | DIMENSION AM(0:NEX,0:NLF,-5:2) | |
30655 | DIMENSION ALFVEC(-5:2), QMAVEC(-5:2) | |
30656 | DIMENSION MEXVEC(-5:2), MLFVEC(-5:2) | |
30657 | DIMENSION UT1VEC(-5:2), UT2VEC(-5:2) | |
30658 | DIMENSION AF(0:NEX) | |
30659 | ||
30660 | DATA MEXVEC( 2) / 8 / | |
30661 | DATA MLFVEC( 2) / 2 / | |
30662 | DATA UT1VEC( 2) / 0.5141718E+01 / | |
30663 | DATA UT2VEC( 2) / -0.1346944E+01 / | |
30664 | DATA ALFVEC( 2) / 0.5260555E+00 / | |
30665 | DATA QMAVEC( 2) / 0.0000000E+00 / | |
30666 | DATA (AM( 0,K, 2),K=0, 2) | |
30667 | & / 0.4289071E+01, -0.2536870E+01, -0.1259948E+01 / | |
30668 | DATA (AM( 1,K, 2),K=0, 2) | |
30669 | & / 0.9839410E+00, 0.4168426E-01, -0.5018952E-01 / | |
30670 | DATA (AM( 2,K, 2),K=0, 2) | |
30671 | & / -0.1651961E+02, 0.9246261E+01, 0.5996400E+01 / | |
30672 | DATA (AM( 3,K, 2),K=0, 2) | |
30673 | & / -0.2077936E+02, 0.9786469E+01, 0.7656465E+01 / | |
30674 | DATA (AM( 4,K, 2),K=0, 2) | |
30675 | & / 0.3054926E+02, 0.1889536E+01, 0.1380541E+01 / | |
30676 | DATA (AM( 5,K, 2),K=0, 2) | |
30677 | & / 0.3084695E+02, -0.1212303E+02, -0.1053551E+02 / | |
30678 | DATA (AM( 6,K, 2),K=0, 2) | |
30679 | & / -0.1426778E+02, 0.6239537E+01, 0.5254819E+01 / | |
30680 | DATA (AM( 7,K, 2),K=0, 2) | |
30681 | & / -0.1909811E+02, 0.3695678E+01, 0.5495729E+01 / | |
30682 | DATA (AM( 8,K, 2),K=0, 2) | |
30683 | & / 0.1889751E-01, 0.5027193E-02, 0.6624896E-03 / | |
30684 | ||
30685 | DATA MEXVEC( 1) / 8 / | |
30686 | DATA MLFVEC( 1) / 2 / | |
30687 | DATA UT1VEC( 1) / 0.4138426E+01 / | |
30688 | DATA UT2VEC( 1) / -0.3221374E+01 / | |
30689 | DATA ALFVEC( 1) / 0.4960962E+00 / | |
30690 | DATA QMAVEC( 1) / 0.0000000E+00 / | |
30691 | DATA (AM( 0,K, 1),K=0, 2) | |
30692 | & / 0.1332497E+01, -0.3703718E+00, 0.1288638E+00 / | |
30693 | DATA (AM( 1,K, 1),K=0, 2) | |
30694 | & / 0.7544687E+00, 0.3255075E-01, -0.4706680E-01 / | |
30695 | DATA (AM( 2,K, 1),K=0, 2) | |
30696 | & / -0.7638814E+00, 0.5008313E+00, -0.9237374E-01 / | |
30697 | DATA (AM( 3,K, 1),K=0, 2) | |
30698 | & / -0.3689889E+00, -0.1055098E+01, -0.4645065E+00 / | |
30699 | DATA (AM( 4,K, 1),K=0, 2) | |
30700 | & / 0.3991610E+02, 0.1979881E+01, 0.1775814E+01 / | |
30701 | DATA (AM( 5,K, 1),K=0, 2) | |
30702 | & / 0.6201080E+01, 0.2046288E+01, 0.3804571E+00 / | |
30703 | DATA (AM( 6,K, 1),K=0, 2) | |
30704 | & / -0.8027900E+00, -0.7011688E+00, -0.8049612E+00 / | |
30705 | DATA (AM( 7,K, 1),K=0, 2) | |
30706 | & / -0.8631305E+01, -0.3981200E+01, 0.6970153E+00 / | |
30707 | DATA (AM( 8,K, 1),K=0, 2) | |
30708 | & / 0.2371230E-01, 0.5372683E-02, 0.1118701E-02 / | |
30709 | ||
30710 | DATA MEXVEC( 0) / 8 / | |
30711 | DATA MLFVEC( 0) / 2 / | |
30712 | DATA UT1VEC( 0) / -0.1026789E+01 / | |
30713 | DATA UT2VEC( 0) / -0.9051707E+01 / | |
30714 | DATA ALFVEC( 0) / 0.9462977E+00 / | |
30715 | DATA QMAVEC( 0) / 0.0000000E+00 / | |
30716 | DATA (AM( 0,K, 0),K=0, 2) | |
30717 | & / 0.1191990E+03, -0.8548739E+00, -0.1963040E+01 / | |
30718 | DATA (AM( 1,K, 0),K=0, 2) | |
30719 | & / -0.9449972E+02, 0.1074771E+01, 0.2056055E+01 / | |
30720 | DATA (AM( 2,K, 0),K=0, 2) | |
30721 | & / 0.3701064E+01, -0.1167947E-02, 0.1933573E+00 / | |
30722 | DATA (AM( 3,K, 0),K=0, 2) | |
30723 | & / 0.1171345E+03, -0.1064540E+01, -0.1875312E+01 / | |
30724 | DATA (AM( 4,K, 0),K=0, 2) | |
30725 | & / -0.1014453E+03, -0.5707427E+00, 0.4511242E-01 / | |
30726 | DATA (AM( 5,K, 0),K=0, 2) | |
30727 | & / 0.6365168E+01, 0.1275354E+01, -0.4964081E+00 / | |
30728 | DATA (AM( 6,K, 0),K=0, 2) | |
30729 | & / -0.3370693E+01, -0.1122020E+01, 0.5947751E-01 / | |
30730 | DATA (AM( 7,K, 0),K=0, 2) | |
30731 | & / -0.5327270E+01, -0.9293556E+00, 0.6629940E+00 / | |
30732 | DATA (AM( 8,K, 0),K=0, 2) | |
30733 | & / 0.2437513E-01, 0.1600939E-02, 0.6855336E-03 / | |
30734 | ||
30735 | DATA MEXVEC(-1) / 8 / | |
30736 | DATA MLFVEC(-1) / 2 / | |
30737 | DATA UT1VEC(-1) / 0.5243571E+01 / | |
30738 | DATA UT2VEC(-1) / -0.2870513E+01 / | |
30739 | DATA ALFVEC(-1) / 0.6701448E+00 / | |
30740 | DATA QMAVEC(-1) / 0.0000000E+00 / | |
30741 | DATA (AM( 0,K,-1),K=0, 2) | |
30742 | & / 0.2428863E+02, 0.1907035E+01, -0.4606457E+00 / | |
30743 | DATA (AM( 1,K,-1),K=0, 2) | |
30744 | & / 0.2006810E+01, -0.1265915E+00, 0.7153556E-02 / | |
30745 | DATA (AM( 2,K,-1),K=0, 2) | |
30746 | & / -0.1884546E+02, -0.2339471E+01, 0.5740679E+01 / | |
30747 | DATA (AM( 3,K,-1),K=0, 2) | |
30748 | & / -0.2527892E+02, -0.2044124E+01, 0.1280470E+02 / | |
30749 | DATA (AM( 4,K,-1),K=0, 2) | |
30750 | & / -0.1013824E+03, -0.1594199E+01, 0.2216401E+00 / | |
30751 | DATA (AM( 5,K,-1),K=0, 2) | |
30752 | & / 0.8070930E+02, 0.1792072E+01, -0.2164364E+02 / | |
30753 | DATA (AM( 6,K,-1),K=0, 2) | |
30754 | & / -0.4641050E+02, 0.1977338E+00, 0.1273014E+02 / | |
30755 | DATA (AM( 7,K,-1),K=0, 2) | |
30756 | & / -0.3910568E+02, 0.1719632E+01, 0.1086525E+02 / | |
30757 | DATA (AM( 8,K,-1),K=0, 2) | |
30758 | & / -0.1185496E+01, -0.1905847E+00, -0.8744118E-03 / | |
30759 | ||
30760 | DATA MEXVEC(-2) / 7 / | |
30761 | DATA MLFVEC(-2) / 2 / | |
30762 | DATA UT1VEC(-2) / 0.4782210E+01 / | |
30763 | DATA UT2VEC(-2) / -0.1976856E+02 / | |
30764 | DATA ALFVEC(-2) / 0.7558374E+00 / | |
30765 | DATA QMAVEC(-2) / 0.0000000E+00 / | |
30766 | DATA (AM( 0,K,-2),K=0, 2) | |
30767 | & / -0.6216935E+00, 0.2369963E+00, -0.7909949E-02 / | |
30768 | DATA (AM( 1,K,-2),K=0, 2) | |
30769 | & / 0.1245440E+01, -0.1031510E+00, 0.4916523E-02 / | |
30770 | DATA (AM( 2,K,-2),K=0, 2) | |
30771 | & / -0.7060824E+01, -0.3875283E-01, 0.1784981E+00 / | |
30772 | DATA (AM( 3,K,-2),K=0, 2) | |
30773 | & / -0.7430595E+01, 0.1964572E+00, -0.1284999E+00 / | |
30774 | DATA (AM( 4,K,-2),K=0, 2) | |
30775 | & / -0.6897810E+01, 0.2620543E+01, 0.8012553E-02 / | |
30776 | DATA (AM( 5,K,-2),K=0, 2) | |
30777 | & / 0.1507713E+02, 0.2340307E-01, 0.2482535E+01 / | |
30778 | DATA (AM( 6,K,-2),K=0, 2) | |
30779 | & / -0.1815341E+01, -0.1538698E+01, -0.2014208E+01 / | |
30780 | DATA (AM( 7,K,-2),K=0, 2) | |
30781 | & / -0.2571932E+02, 0.2903941E+00, -0.2848206E+01 / | |
30782 | ||
30783 | DATA MEXVEC(-3) / 7 / | |
30784 | DATA MLFVEC(-3) / 2 / | |
30785 | DATA UT1VEC(-3) / 0.4518239E+01 / | |
30786 | DATA UT2VEC(-3) / -0.2690590E+01 / | |
30787 | DATA ALFVEC(-3) / 0.6124079E+00 / | |
30788 | DATA QMAVEC(-3) / 0.0000000E+00 / | |
30789 | DATA (AM( 0,K,-3),K=0, 2) | |
30790 | & / -0.2734458E+01, -0.7245673E+00, -0.6351374E+00 / | |
30791 | DATA (AM( 1,K,-3),K=0, 2) | |
30792 | & / 0.2927174E+01, 0.4822709E+00, -0.1088787E-01 / | |
30793 | DATA (AM( 2,K,-3),K=0, 2) | |
30794 | & / -0.1771017E+02, -0.1416635E+01, 0.8467622E+01 / | |
30795 | DATA (AM( 3,K,-3),K=0, 2) | |
30796 | & / -0.4972782E+02, -0.3348547E+01, 0.1767061E+02 / | |
30797 | DATA (AM( 4,K,-3),K=0, 2) | |
30798 | & / -0.7102770E+01, -0.3205337E+01, 0.4101704E+00 / | |
30799 | DATA (AM( 5,K,-3),K=0, 2) | |
30800 | & / 0.7169698E+02, -0.2205985E+01, -0.2463931E+02 / | |
30801 | DATA (AM( 6,K,-3),K=0, 2) | |
30802 | & / -0.4090347E+02, 0.2103486E+01, 0.1416507E+02 / | |
30803 | DATA (AM( 7,K,-3),K=0, 2) | |
30804 | & / -0.2952639E+02, 0.5376136E+01, 0.7825585E+01 / | |
30805 | ||
30806 | DATA MEXVEC(-4) / 7 / | |
30807 | DATA MLFVEC(-4) / 2 / | |
30808 | DATA UT1VEC(-4) / 0.2783230E+01 / | |
30809 | DATA UT2VEC(-4) / -0.1746328E+01 / | |
30810 | DATA ALFVEC(-4) / 0.1115653E+01 / | |
30811 | DATA QMAVEC(-4) / 0.1300000E+01 / | |
30812 | DATA (AM( 0,K,-4),K=0, 2) | |
30813 | & / -0.1743872E+01, -0.1128921E+01, -0.2841969E+00 / | |
30814 | DATA (AM( 1,K,-4),K=0, 2) | |
30815 | & / 0.3345755E+01, 0.3187765E+00, 0.1378124E+00 / | |
30816 | DATA (AM( 2,K,-4),K=0, 2) | |
30817 | & / -0.2037615E+02, 0.4121687E+01, 0.2236520E+00 / | |
30818 | DATA (AM( 3,K,-4),K=0, 2) | |
30819 | & / -0.4703104E+02, 0.5353087E+01, -0.1455347E+01 / | |
30820 | DATA (AM( 4,K,-4),K=0, 2) | |
30821 | & / -0.1060230E+02, -0.1551122E+01, -0.1078863E+01 / | |
30822 | DATA (AM( 5,K,-4),K=0, 2) | |
30823 | & / 0.5088892E+02, -0.8197304E+01, 0.8083451E+01 / | |
30824 | DATA (AM( 6,K,-4),K=0, 2) | |
30825 | & / -0.2819070E+02, 0.4554086E+01, -0.5890995E+01 / | |
30826 | DATA (AM( 7,K,-4),K=0, 2) | |
30827 | & / -0.1098238E+02, 0.2590096E+01, -0.8062879E+01 / | |
30828 | ||
30829 | DATA MEXVEC(-5) / 6 / | |
30830 | DATA MLFVEC(-5) / 2 / | |
30831 | DATA UT1VEC(-5) / 0.1619654E+02 / | |
30832 | DATA UT2VEC(-5) / -0.3367346E+01 / | |
30833 | DATA ALFVEC(-5) / 0.5109891E-02 / | |
30834 | DATA QMAVEC(-5) / 0.4500000E+01 / | |
30835 | DATA (AM( 0,K,-5),K=0, 2) | |
30836 | & / -0.6800138E+01, 0.2493627E+01, -0.1075724E+01 / | |
30837 | DATA (AM( 1,K,-5),K=0, 2) | |
30838 | & / 0.3036555E+01, 0.3324733E+00, 0.2008298E+00 / | |
30839 | DATA (AM( 2,K,-5),K=0, 2) | |
30840 | & / -0.5203879E+01, -0.8493476E+01, -0.4523208E+01 / | |
30841 | DATA (AM( 3,K,-5),K=0, 2) | |
30842 | & / -0.1524239E+01, -0.3411912E+01, -0.1771867E+02 / | |
30843 | DATA (AM( 4,K,-5),K=0, 2) | |
30844 | & / -0.1099444E+02, 0.1320930E+01, -0.2353831E+01 / | |
30845 | DATA (AM( 5,K,-5),K=0, 2) | |
30846 | & / 0.1699299E+02, -0.3565802E+02, 0.3566872E+02 / | |
30847 | DATA (AM( 6,K,-5),K=0, 2) | |
30848 | & / -0.1465793E+02, 0.2703365E+02, -0.2176372E+02 / | |
30849 | ||
30850 | IF(Q .LE. QMAVEC(IFL)) THEN | |
30851 | PYCT5M = 0.D0 | |
30852 | RETURN | |
30853 | ENDIF | |
30854 | ||
30855 | IF(X .GE. 1.D0) THEN | |
30856 | PYCT5M = 0.D0 | |
30857 | RETURN | |
30858 | ENDIF | |
30859 | ||
30860 | TMP = LOG(Q/ALFVEC(IFL)) | |
30861 | IF(TMP .LE. 0.D0) THEN | |
30862 | PYCT5M = 0.D0 | |
30863 | RETURN | |
30864 | ENDIF | |
30865 | ||
30866 | SB = LOG(TMP) | |
30867 | SB1 = SB - 1.2D0 | |
30868 | SB2 = SB1*SB1 | |
30869 | ||
30870 | DO 110 I = 0, NEX | |
30871 | AF(I) = 0.D0 | |
30872 | SBX = 1.D0 | |
30873 | DO 100 K = 0, MLFVEC(IFL) | |
30874 | AF(I) = AF(I) + SBX*AM(I,K,IFL) | |
30875 | SBX = SB1*SBX | |
30876 | 100 CONTINUE | |
30877 | 110 CONTINUE | |
30878 | ||
30879 | Y = -LOG(X) | |
30880 | U = LOG(X/0.00001D0) | |
30881 | ||
30882 | PART1 = AF(1)*Y**(1.D0+0.01D0*AF(4))*(1.D0+ AF(8)*U) | |
30883 | PART2 = AF(0)*(1.D0 - X) + AF(3)*X | |
30884 | PART3 = X*(1.D0-X)*(AF(5)+AF(6)*(1.D0-X)+AF(7)*X*(1.D0-X)) | |
30885 | PART4 = UT1VEC(IFL)*LOG(1.D0-X) + | |
30886 | & AF(2)*LOG(1.D0+EXP(UT2VEC(IFL))-X) | |
30887 | ||
30888 | PYCT5M = EXP(LOG(X) + PART1 + PART2 + PART3 + PART4) | |
30889 | ||
30890 | C...Include threshold factor. | |
30891 | PYCT5M = PYCT5M * (1.D0 - QMAVEC(IFL)/Q) | |
30892 | ||
30893 | RETURN | |
30894 | END | |
30895 | ||
30896 | C********************************************************************* | |
30897 | ||
30898 | C...PYPDPO | |
30899 | C...Auxiliary to PYPDPR. Gives proton parton distributions according to | |
30900 | C...a few older parametrizations, now obsolete but convenient for | |
30901 | C...backwards checks. | |
30902 | ||
30903 | SUBROUTINE PYPDPO(X,Q2,XPPR) | |
30904 | ||
30905 | C...Double precision and integer declarations. | |
30906 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
30907 | IMPLICIT INTEGER(I-N) | |
30908 | INTEGER PYK,PYCHGE,PYCOMP | |
30909 | C...Commonblocks. | |
30910 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
30911 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
30912 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
30913 | COMMON/PYINT1/MINT(400),VINT(400) | |
30914 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ | |
30915 | DIMENSION XPPR(-6:6),XQ(9),TX(6),TT(6),TS(6),NEHLQ(8,2), | |
30916 | &CEHLQ(6,6,2,8,2),CDO(3,6,5,2) | |
30917 | ||
30918 | ||
30919 | C...The following data lines are coefficients needed in the | |
30920 | C...Eichten, Hinchliffe, Lane, Quigg proton structure function | |
30921 | C...parametrizations, see below. | |
30922 | C...Powers of 1-x in different cases. | |
30923 | DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/ | |
30924 | C...Expansion coefficients for up valence quark distribution. | |
30925 | DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/ | |
30926 | 1 7.677D-01,-2.087D-01,-3.303D-01,-2.517D-02,-1.570D-02,-1.000D-04, | |
30927 | 2-5.326D-01,-2.661D-01, 3.201D-01, 1.192D-01, 2.434D-02, 7.620D-03, | |
30928 | 3 2.162D-01, 1.881D-01,-8.375D-02,-6.515D-02,-1.743D-02,-5.040D-03, | |
30929 | 4-9.211D-02,-9.952D-02, 1.373D-02, 2.506D-02, 8.770D-03, 2.550D-03, | |
30930 | 5 3.670D-02, 4.409D-02, 9.600D-04,-7.960D-03,-3.420D-03,-1.050D-03, | |
30931 | 6-1.549D-02,-2.026D-02,-3.060D-03, 2.220D-03, 1.240D-03, 4.100D-04, | |
30932 | 1 2.395D-01, 2.905D-01, 9.778D-02, 2.149D-02, 3.440D-03, 5.000D-04, | |
30933 | 2 1.751D-02,-6.090D-03,-2.687D-02,-1.916D-02,-7.970D-03,-2.750D-03, | |
30934 | 3-5.760D-03,-5.040D-03, 1.080D-03, 2.490D-03, 1.530D-03, 7.500D-04, | |
30935 | 4 1.740D-03, 1.960D-03, 3.000D-04,-3.400D-04,-2.900D-04,-1.800D-04, | |
30936 | 5-5.300D-04,-6.400D-04,-1.700D-04, 4.000D-05, 6.000D-05, 4.000D-05, | |
30937 | 6 1.700D-04, 2.200D-04, 8.000D-05, 1.000D-05,-1.000D-05,-1.000D-05/ | |
30938 | DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/ | |
30939 | 1 7.237D-01,-2.189D-01,-2.995D-01,-1.909D-02,-1.477D-02, 2.500D-04, | |
30940 | 2-5.314D-01,-2.425D-01, 3.283D-01, 1.119D-01, 2.223D-02, 7.070D-03, | |
30941 | 3 2.289D-01, 1.890D-01,-9.859D-02,-6.900D-02,-1.747D-02,-5.080D-03, | |
30942 | 4-1.041D-01,-1.084D-01, 2.108D-02, 2.975D-02, 9.830D-03, 2.830D-03, | |
30943 | 5 4.394D-02, 5.116D-02,-1.410D-03,-1.055D-02,-4.230D-03,-1.270D-03, | |
30944 | 6-1.991D-02,-2.539D-02,-2.780D-03, 3.430D-03, 1.720D-03, 5.500D-04, | |
30945 | 1 2.410D-01, 2.884D-01, 9.369D-02, 1.900D-02, 2.530D-03, 2.400D-04, | |
30946 | 2 1.765D-02,-9.220D-03,-3.037D-02,-2.085D-02,-8.440D-03,-2.810D-03, | |
30947 | 3-6.450D-03,-5.260D-03, 1.720D-03, 3.110D-03, 1.830D-03, 8.700D-04, | |
30948 | 4 2.120D-03, 2.320D-03, 2.600D-04,-4.900D-04,-3.900D-04,-2.300D-04, | |
30949 | 5-6.900D-04,-8.200D-04,-2.000D-04, 7.000D-05, 9.000D-05, 6.000D-05, | |
30950 | 6 2.400D-04, 3.100D-04, 1.100D-04, 0.000D+00,-2.000D-05,-2.000D-05/ | |
30951 | C...Expansion coefficients for down valence quark distribution. | |
30952 | DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/ | |
30953 | 1 3.813D-01,-8.090D-02,-1.634D-01,-2.185D-02,-8.430D-03,-6.200D-04, | |
30954 | 2-2.948D-01,-1.435D-01, 1.665D-01, 6.638D-02, 1.473D-02, 4.080D-03, | |
30955 | 3 1.252D-01, 1.042D-01,-4.722D-02,-3.683D-02,-1.038D-02,-2.860D-03, | |
30956 | 4-5.478D-02,-5.678D-02, 8.900D-03, 1.484D-02, 5.340D-03, 1.520D-03, | |
30957 | 5 2.220D-02, 2.567D-02,-3.000D-05,-4.970D-03,-2.160D-03,-6.500D-04, | |
30958 | 6-9.530D-03,-1.204D-02,-1.510D-03, 1.510D-03, 8.300D-04, 2.700D-04, | |
30959 | 1 1.261D-01, 1.354D-01, 3.958D-02, 8.240D-03, 1.660D-03, 4.500D-04, | |
30960 | 2 3.890D-03,-1.159D-02,-1.625D-02,-9.610D-03,-3.710D-03,-1.260D-03, | |
30961 | 3-1.910D-03,-5.600D-04, 1.590D-03, 1.590D-03, 8.400D-04, 3.900D-04, | |
30962 | 4 6.400D-04, 4.900D-04,-1.500D-04,-2.900D-04,-1.800D-04,-1.000D-04, | |
30963 | 5-2.000D-04,-1.900D-04, 0.000D+00, 6.000D-05, 4.000D-05, 3.000D-05, | |
30964 | 6 7.000D-05, 8.000D-05, 2.000D-05,-1.000D-05,-1.000D-05,-1.000D-05/ | |
30965 | DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/ | |
30966 | 1 3.578D-01,-8.622D-02,-1.480D-01,-1.840D-02,-7.820D-03,-4.500D-04, | |
30967 | 2-2.925D-01,-1.304D-01, 1.696D-01, 6.243D-02, 1.353D-02, 3.750D-03, | |
30968 | 3 1.318D-01, 1.041D-01,-5.486D-02,-3.872D-02,-1.038D-02,-2.850D-03, | |
30969 | 4-6.162D-02,-6.143D-02, 1.303D-02, 1.740D-02, 5.940D-03, 1.670D-03, | |
30970 | 5 2.643D-02, 2.957D-02,-1.490D-03,-6.450D-03,-2.630D-03,-7.700D-04, | |
30971 | 6-1.218D-02,-1.497D-02,-1.260D-03, 2.240D-03, 1.120D-03, 3.500D-04, | |
30972 | 1 1.263D-01, 1.334D-01, 3.732D-02, 7.070D-03, 1.260D-03, 3.400D-04, | |
30973 | 2 3.660D-03,-1.357D-02,-1.795D-02,-1.031D-02,-3.880D-03,-1.280D-03, | |
30974 | 3-2.100D-03,-3.600D-04, 2.050D-03, 1.920D-03, 9.800D-04, 4.400D-04, | |
30975 | 4 7.700D-04, 5.400D-04,-2.400D-04,-3.900D-04,-2.400D-04,-1.300D-04, | |
30976 | 5-2.600D-04,-2.300D-04, 2.000D-05, 9.000D-05, 6.000D-05, 4.000D-05, | |
30977 | 6 9.000D-05, 1.000D-04, 2.000D-05,-2.000D-05,-2.000D-05,-1.000D-05/ | |
30978 | C...Expansion coefficients for up and down sea quark distributions. | |
30979 | DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/ | |
30980 | 1 6.870D-02,-6.861D-02, 2.973D-02,-5.400D-03, 3.780D-03,-9.700D-04, | |
30981 | 2-1.802D-02, 1.400D-04, 6.490D-03,-8.540D-03, 1.220D-03,-1.750D-03, | |
30982 | 3-4.650D-03, 1.480D-03,-5.930D-03, 6.000D-04,-1.030D-03,-8.000D-05, | |
30983 | 4 6.440D-03, 2.570D-03, 2.830D-03, 1.150D-03, 7.100D-04, 3.300D-04, | |
30984 | 5-3.930D-03,-2.540D-03,-1.160D-03,-7.700D-04,-3.600D-04,-1.900D-04, | |
30985 | 6 2.340D-03, 1.930D-03, 5.300D-04, 3.700D-04, 1.600D-04, 9.000D-05, | |
30986 | 1 1.014D+00,-1.106D+00, 3.374D-01,-7.444D-02, 8.850D-03,-8.700D-04, | |
30987 | 2 9.233D-01,-1.285D+00, 4.475D-01,-9.786D-02, 1.419D-02,-1.120D-03, | |
30988 | 3 4.888D-02,-1.271D-01, 8.606D-02,-2.608D-02, 4.780D-03,-6.000D-04, | |
30989 | 4-2.691D-02, 4.887D-02,-1.771D-02, 1.620D-03, 2.500D-04,-6.000D-05, | |
30990 | 5 7.040D-03,-1.113D-02, 1.590D-03, 7.000D-04,-2.000D-04, 0.000D+00, | |
30991 | 6-1.710D-03, 2.290D-03, 3.800D-04,-3.500D-04, 4.000D-05, 1.000D-05/ | |
30992 | DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/ | |
30993 | 1 1.008D-01,-7.100D-02, 1.973D-02,-5.710D-03, 2.930D-03,-9.900D-04, | |
30994 | 2-5.271D-02,-1.823D-02, 1.792D-02,-6.580D-03, 1.750D-03,-1.550D-03, | |
30995 | 3 1.220D-02, 1.763D-02,-8.690D-03,-8.800D-04,-1.160D-03,-2.100D-04, | |
30996 | 4-1.190D-03,-7.180D-03, 2.360D-03, 1.890D-03, 7.700D-04, 4.100D-04, | |
30997 | 5-9.100D-04, 2.040D-03,-3.100D-04,-1.050D-03,-4.000D-04,-2.400D-04, | |
30998 | 6 1.190D-03,-1.700D-04,-2.000D-04, 4.200D-04, 1.700D-04, 1.000D-04, | |
30999 | 1 1.081D+00,-1.189D+00, 3.868D-01,-8.617D-02, 1.115D-02,-1.180D-03, | |
31000 | 2 9.917D-01,-1.396D+00, 4.998D-01,-1.159D-01, 1.674D-02,-1.720D-03, | |
31001 | 3 5.099D-02,-1.338D-01, 9.173D-02,-2.885D-02, 5.890D-03,-6.500D-04, | |
31002 | 4-3.178D-02, 5.703D-02,-2.070D-02, 2.440D-03, 1.100D-04,-9.000D-05, | |
31003 | 5 8.970D-03,-1.392D-02, 2.050D-03, 6.500D-04,-2.300D-04, 2.000D-05, | |
31004 | 6-2.340D-03, 3.010D-03, 5.000D-04,-3.900D-04, 6.000D-05, 1.000D-05/ | |
31005 | C...Expansion coefficients for gluon distribution. | |
31006 | DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/ | |
31007 | 1 9.482D-01,-9.578D-01, 1.009D-01,-1.051D-01, 3.456D-02,-3.054D-02, | |
31008 | 2-9.627D-01, 5.379D-01, 3.368D-01,-9.525D-02, 1.488D-02,-2.051D-02, | |
31009 | 3 4.300D-01,-8.306D-02,-3.372D-01, 4.902D-02,-9.160D-03, 1.041D-02, | |
31010 | 4-1.925D-01,-1.790D-02, 2.183D-01, 7.490D-03, 4.140D-03,-1.860D-03, | |
31011 | 5 8.183D-02, 1.926D-02,-1.072D-01,-1.944D-02,-2.770D-03,-5.200D-04, | |
31012 | 6-3.884D-02,-1.234D-02, 5.410D-02, 1.879D-02, 3.350D-03, 1.040D-03, | |
31013 | 1 2.948D+01,-3.902D+01, 1.464D+01,-3.335D+00, 5.054D-01,-5.915D-02, | |
31014 | 2 2.559D+01,-3.955D+01, 1.661D+01,-4.299D+00, 6.904D-01,-8.243D-02, | |
31015 | 3-1.663D+00, 1.176D+00, 1.118D+00,-7.099D-01, 1.948D-01,-2.404D-02, | |
31016 | 4-2.168D-01, 8.170D-01,-7.169D-01, 1.851D-01,-1.924D-02,-3.250D-03, | |
31017 | 5 2.088D-01,-4.355D-01, 2.239D-01,-2.446D-02,-3.620D-03, 1.910D-03, | |
31018 | 6-9.097D-02, 1.601D-01,-5.681D-02,-2.500D-03, 2.580D-03,-4.700D-04/ | |
31019 | DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/ | |
31020 | 1 2.367D+00, 4.453D-01, 3.660D-01, 9.467D-02, 1.341D-01, 1.661D-02, | |
31021 | 2-3.170D+00,-1.795D+00, 3.313D-02,-2.874D-01,-9.827D-02,-7.119D-02, | |
31022 | 3 1.823D+00, 1.457D+00,-2.465D-01, 3.739D-02, 6.090D-03, 1.814D-02, | |
31023 | 4-1.033D+00,-9.827D-01, 2.136D-01, 1.169D-01, 5.001D-02, 1.684D-02, | |
31024 | 5 5.133D-01, 5.259D-01,-1.173D-01,-1.139D-01,-4.988D-02,-2.021D-02, | |
31025 | 6-2.881D-01,-3.145D-01, 5.667D-02, 9.161D-02, 4.568D-02, 1.951D-02, | |
31026 | 1 3.036D+01,-4.062D+01, 1.578D+01,-3.699D+00, 6.020D-01,-7.031D-02, | |
31027 | 2 2.700D+01,-4.167D+01, 1.770D+01,-4.804D+00, 7.862D-01,-1.060D-01, | |
31028 | 3-1.909D+00, 1.357D+00, 1.127D+00,-7.181D-01, 2.232D-01,-2.481D-02, | |
31029 | 4-2.488D-01, 9.781D-01,-8.127D-01, 2.094D-01,-2.997D-02,-4.710D-03, | |
31030 | 5 2.506D-01,-5.427D-01, 2.672D-01,-3.103D-02,-1.800D-03, 2.870D-03, | |
31031 | 6-1.128D-01, 2.087D-01,-6.972D-02,-2.480D-03, 2.630D-03,-8.400D-04/ | |
31032 | C...Expansion coefficients for strange sea quark distribution. | |
31033 | DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/ | |
31034 | 1 4.968D-02,-4.173D-02, 2.102D-02,-3.270D-03, 3.240D-03,-6.700D-04, | |
31035 | 2-6.150D-03,-1.294D-02, 6.740D-03,-6.890D-03, 9.000D-04,-1.510D-03, | |
31036 | 3-8.580D-03, 5.050D-03,-4.900D-03,-1.600D-04,-9.400D-04,-1.500D-04, | |
31037 | 4 7.840D-03, 1.510D-03, 2.220D-03, 1.400D-03, 7.000D-04, 3.500D-04, | |
31038 | 5-4.410D-03,-2.220D-03,-8.900D-04,-8.500D-04,-3.600D-04,-2.000D-04, | |
31039 | 6 2.520D-03, 1.840D-03, 4.100D-04, 3.900D-04, 1.600D-04, 9.000D-05, | |
31040 | 1 9.235D-01,-1.085D+00, 3.464D-01,-7.210D-02, 9.140D-03,-9.100D-04, | |
31041 | 2 9.315D-01,-1.274D+00, 4.512D-01,-9.775D-02, 1.380D-02,-1.310D-03, | |
31042 | 3 4.739D-02,-1.296D-01, 8.482D-02,-2.642D-02, 4.760D-03,-5.700D-04, | |
31043 | 4-2.653D-02, 4.953D-02,-1.735D-02, 1.750D-03, 2.800D-04,-6.000D-05, | |
31044 | 5 6.940D-03,-1.132D-02, 1.480D-03, 6.500D-04,-2.100D-04, 0.000D+00, | |
31045 | 6-1.680D-03, 2.340D-03, 4.200D-04,-3.400D-04, 5.000D-05, 1.000D-05/ | |
31046 | DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/ | |
31047 | 1 6.478D-02,-4.537D-02, 1.643D-02,-3.490D-03, 2.710D-03,-6.700D-04, | |
31048 | 2-2.223D-02,-2.126D-02, 1.247D-02,-6.290D-03, 1.120D-03,-1.440D-03, | |
31049 | 3-1.340D-03, 1.362D-02,-6.130D-03,-7.900D-04,-9.000D-04,-2.000D-04, | |
31050 | 4 5.080D-03,-3.610D-03, 1.700D-03, 1.830D-03, 6.800D-04, 4.000D-04, | |
31051 | 5-3.580D-03, 6.000D-05,-2.600D-04,-1.050D-03,-3.800D-04,-2.300D-04, | |
31052 | 6 2.420D-03, 9.300D-04,-1.000D-04, 4.500D-04, 1.700D-04, 1.100D-04, | |
31053 | 1 9.868D-01,-1.171D+00, 3.940D-01,-8.459D-02, 1.124D-02,-1.250D-03, | |
31054 | 2 1.001D+00,-1.383D+00, 5.044D-01,-1.152D-01, 1.658D-02,-1.830D-03, | |
31055 | 3 4.928D-02,-1.368D-01, 9.021D-02,-2.935D-02, 5.800D-03,-6.600D-04, | |
31056 | 4-3.133D-02, 5.785D-02,-2.023D-02, 2.630D-03, 1.600D-04,-8.000D-05, | |
31057 | 5 8.840D-03,-1.416D-02, 1.900D-03, 5.800D-04,-2.500D-04, 1.000D-05, | |
31058 | 6-2.300D-03, 3.080D-03, 5.500D-04,-3.700D-04, 7.000D-05, 1.000D-05/ | |
31059 | C...Expansion coefficients for charm sea quark distribution. | |
31060 | DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/ | |
31061 | 1 9.270D-03,-1.817D-02, 9.590D-03,-6.390D-03, 1.690D-03,-1.540D-03, | |
31062 | 2 5.710D-03,-1.188D-02, 6.090D-03,-4.650D-03, 1.240D-03,-1.310D-03, | |
31063 | 3-3.960D-03, 7.100D-03,-3.590D-03, 1.840D-03,-3.900D-04, 3.400D-04, | |
31064 | 4 1.120D-03,-1.960D-03, 1.120D-03,-4.800D-04, 1.000D-04,-4.000D-05, | |
31065 | 5 4.000D-05,-3.000D-05,-1.800D-04, 9.000D-05,-5.000D-05,-2.000D-05, | |
31066 | 6-4.200D-04, 7.300D-04,-1.600D-04, 5.000D-05, 5.000D-05, 5.000D-05, | |
31067 | 1 8.098D-01,-1.042D+00, 3.398D-01,-6.824D-02, 8.760D-03,-9.000D-04, | |
31068 | 2 8.961D-01,-1.217D+00, 4.339D-01,-9.287D-02, 1.304D-02,-1.290D-03, | |
31069 | 3 3.058D-02,-1.040D-01, 7.604D-02,-2.415D-02, 4.600D-03,-5.000D-04, | |
31070 | 4-2.451D-02, 4.432D-02,-1.651D-02, 1.430D-03, 1.200D-04,-1.000D-04, | |
31071 | 5 1.122D-02,-1.457D-02, 2.680D-03, 5.800D-04,-1.200D-04, 3.000D-05, | |
31072 | 6-7.730D-03, 7.330D-03,-7.600D-04,-2.400D-04, 1.000D-05, 0.000D+00/ | |
31073 | DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/ | |
31074 | 1 9.980D-03,-1.945D-02, 1.055D-02,-6.870D-03, 1.860D-03,-1.560D-03, | |
31075 | 2 5.700D-03,-1.203D-02, 6.250D-03,-4.860D-03, 1.310D-03,-1.370D-03, | |
31076 | 3-4.490D-03, 7.990D-03,-4.170D-03, 2.050D-03,-4.400D-04, 3.300D-04, | |
31077 | 4 1.470D-03,-2.480D-03, 1.460D-03,-5.700D-04, 1.200D-04,-1.000D-05, | |
31078 | 5-9.000D-05, 1.500D-04,-3.200D-04, 1.200D-04,-6.000D-05,-4.000D-05, | |
31079 | 6-4.200D-04, 7.600D-04,-1.400D-04, 4.000D-05, 7.000D-05, 5.000D-05, | |
31080 | 1 8.698D-01,-1.131D+00, 3.836D-01,-8.111D-02, 1.048D-02,-1.300D-03, | |
31081 | 2 9.626D-01,-1.321D+00, 4.854D-01,-1.091D-01, 1.583D-02,-1.700D-03, | |
31082 | 3 3.057D-02,-1.088D-01, 8.022D-02,-2.676D-02, 5.590D-03,-5.600D-04, | |
31083 | 4-2.845D-02, 5.164D-02,-1.918D-02, 2.210D-03,-4.000D-05,-1.500D-04, | |
31084 | 5 1.311D-02,-1.751D-02, 3.310D-03, 5.100D-04,-1.200D-04, 5.000D-05, | |
31085 | 6-8.590D-03, 8.380D-03,-9.200D-04,-2.600D-04, 1.000D-05,-1.000D-05/ | |
31086 | C...Expansion coefficients for bottom sea quark distribution. | |
31087 | DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/ | |
31088 | 1 9.010D-03,-1.401D-02, 7.150D-03,-4.130D-03, 1.260D-03,-1.040D-03, | |
31089 | 2 6.280D-03,-9.320D-03, 4.780D-03,-2.890D-03, 9.100D-04,-8.200D-04, | |
31090 | 3-2.930D-03, 4.090D-03,-1.890D-03, 7.600D-04,-2.300D-04, 1.400D-04, | |
31091 | 4 3.900D-04,-1.200D-03, 4.400D-04,-2.500D-04, 2.000D-05,-2.000D-05, | |
31092 | 5 2.600D-04, 1.400D-04,-8.000D-05, 1.000D-04, 1.000D-05, 1.000D-05, | |
31093 | 6-2.600D-04, 3.200D-04, 1.000D-05,-1.000D-05, 1.000D-05,-1.000D-05, | |
31094 | 1 8.029D-01,-1.075D+00, 3.792D-01,-7.843D-02, 1.007D-02,-1.090D-03, | |
31095 | 2 7.903D-01,-1.099D+00, 4.153D-01,-9.301D-02, 1.317D-02,-1.410D-03, | |
31096 | 3-1.704D-02,-1.130D-02, 2.882D-02,-1.341D-02, 3.040D-03,-3.600D-04, | |
31097 | 4-7.200D-04, 7.230D-03,-5.160D-03, 1.080D-03,-5.000D-05,-4.000D-05, | |
31098 | 5 3.050D-03,-4.610D-03, 1.660D-03,-1.300D-04,-1.000D-05, 1.000D-05, | |
31099 | 6-4.360D-03, 5.230D-03,-1.610D-03, 2.000D-04,-2.000D-05, 0.000D+00/ | |
31100 | DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/ | |
31101 | 1 8.980D-03,-1.459D-02, 7.510D-03,-4.410D-03, 1.310D-03,-1.070D-03, | |
31102 | 2 5.970D-03,-9.440D-03, 4.800D-03,-3.020D-03, 9.100D-04,-8.500D-04, | |
31103 | 3-3.050D-03, 4.440D-03,-2.100D-03, 8.500D-04,-2.400D-04, 1.400D-04, | |
31104 | 4 5.300D-04,-1.300D-03, 5.600D-04,-2.700D-04, 3.000D-05,-2.000D-05, | |
31105 | 5 2.000D-04, 1.400D-04,-1.100D-04, 1.000D-04, 0.000D+00, 0.000D+00, | |
31106 | 6-2.600D-04, 3.200D-04, 0.000D+00,-3.000D-05, 1.000D-05,-1.000D-05, | |
31107 | 1 8.672D-01,-1.174D+00, 4.265D-01,-9.252D-02, 1.244D-02,-1.460D-03, | |
31108 | 2 8.500D-01,-1.194D+00, 4.630D-01,-1.083D-01, 1.614D-02,-1.830D-03, | |
31109 | 3-2.241D-02,-5.630D-03, 2.815D-02,-1.425D-02, 3.520D-03,-4.300D-04, | |
31110 | 4-7.300D-04, 8.030D-03,-5.780D-03, 1.380D-03,-1.300D-04,-4.000D-05, | |
31111 | 5 3.460D-03,-5.380D-03, 1.960D-03,-2.100D-04, 1.000D-05, 1.000D-05, | |
31112 | 6-4.850D-03, 5.950D-03,-1.890D-03, 2.600D-04,-3.000D-05, 0.000D+00/ | |
31113 | C...Expansion coefficients for top sea quark distribution. | |
31114 | DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/ | |
31115 | 1 4.410D-03,-7.480D-03, 3.770D-03,-2.580D-03, 7.300D-04,-7.100D-04, | |
31116 | 2 3.840D-03,-6.050D-03, 3.030D-03,-2.030D-03, 5.800D-04,-5.900D-04, | |
31117 | 3-8.800D-04, 1.660D-03,-7.500D-04, 4.700D-04,-1.000D-04, 1.000D-04, | |
31118 | 4-8.000D-05,-1.500D-04, 1.200D-04,-9.000D-05, 3.000D-05, 0.000D+00, | |
31119 | 5 1.300D-04,-2.200D-04,-2.000D-05,-2.000D-05,-2.000D-05,-2.000D-05, | |
31120 | 6-7.000D-05, 1.900D-04,-4.000D-05, 2.000D-05, 0.000D+00, 0.000D+00, | |
31121 | 1 6.623D-01,-9.248D-01, 3.519D-01,-7.930D-02, 1.110D-02,-1.180D-03, | |
31122 | 2 6.380D-01,-9.062D-01, 3.582D-01,-8.479D-02, 1.265D-02,-1.390D-03, | |
31123 | 3-2.581D-02, 2.125D-02, 4.190D-03,-4.980D-03, 1.490D-03,-2.100D-04, | |
31124 | 4 7.100D-04, 5.300D-04,-1.270D-03, 3.900D-04,-5.000D-05,-1.000D-05, | |
31125 | 5 3.850D-03,-5.060D-03, 1.860D-03,-3.500D-04, 4.000D-05, 0.000D+00, | |
31126 | 6-3.530D-03, 4.460D-03,-1.500D-03, 2.700D-04,-3.000D-05, 0.000D+00/ | |
31127 | DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/ | |
31128 | 1 4.260D-03,-7.530D-03, 3.830D-03,-2.680D-03, 7.600D-04,-7.300D-04, | |
31129 | 2 3.640D-03,-6.050D-03, 3.030D-03,-2.090D-03, 5.900D-04,-6.000D-04, | |
31130 | 3-9.200D-04, 1.710D-03,-8.200D-04, 5.000D-04,-1.200D-04, 1.000D-04, | |
31131 | 4-5.000D-05,-1.600D-04, 1.300D-04,-9.000D-05, 3.000D-05, 0.000D+00, | |
31132 | 5 1.300D-04,-2.100D-04,-1.000D-05,-2.000D-05,-2.000D-05,-1.000D-05, | |
31133 | 6-8.000D-05, 1.800D-04,-5.000D-05, 2.000D-05, 0.000D+00, 0.000D+00, | |
31134 | 1 7.146D-01,-1.007D+00, 3.932D-01,-9.246D-02, 1.366D-02,-1.540D-03, | |
31135 | 2 6.856D-01,-9.828D-01, 3.977D-01,-9.795D-02, 1.540D-02,-1.790D-03, | |
31136 | 3-3.053D-02, 2.758D-02, 2.150D-03,-4.880D-03, 1.640D-03,-2.500D-04, | |
31137 | 4 9.200D-04, 4.200D-04,-1.340D-03, 4.600D-04,-8.000D-05,-1.000D-05, | |
31138 | 5 4.230D-03,-5.660D-03, 2.140D-03,-4.300D-04, 6.000D-05, 0.000D+00, | |
31139 | 6-3.890D-03, 5.000D-03,-1.740D-03, 3.300D-04,-4.000D-05, 0.000D+00/ | |
31140 | ||
31141 | C...The following data lines are coefficients needed in the | |
31142 | C...Duke, Owens proton structure function parametrizations, see below. | |
31143 | C...Expansion coefficients for (up+down) valence quark distribution. | |
31144 | DATA ((CDO(IP,IS,1,1),IS=1,6),IP=1,3)/ | |
31145 | 1 4.190D-01, 3.460D+00, 4.400D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31146 | 2 4.000D-03, 7.240D-01,-4.860D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31147 | 3-7.000D-03,-6.600D-02, 1.330D+00, 0.000D+00, 0.000D+00, 0.000D+00/ | |
31148 | DATA ((CDO(IP,IS,1,2),IS=1,6),IP=1,3)/ | |
31149 | 1 3.740D-01, 3.330D+00, 6.030D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31150 | 2 1.400D-02, 7.530D-01,-6.220D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31151 | 3 0.000D+00,-7.600D-02, 1.560D+00, 0.000D+00, 0.000D+00, 0.000D+00/ | |
31152 | C...Expansion coefficients for down valence quark distribution. | |
31153 | DATA ((CDO(IP,IS,2,1),IS=1,6),IP=1,3)/ | |
31154 | 1 7.630D-01, 4.000D+00, 0.000D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31155 | 2-2.370D-01, 6.270D-01,-4.210D-01, 0.000D+00, 0.000D+00, 0.000D+00, | |
31156 | 3 2.600D-02,-1.900D-02, 3.300D-02, 0.000D+00, 0.000D+00, 0.000D+00/ | |
31157 | DATA ((CDO(IP,IS,2,2),IS=1,6),IP=1,3)/ | |
31158 | 1 7.610D-01, 3.830D+00, 0.000D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31159 | 2-2.320D-01, 6.270D-01,-4.180D-01, 0.000D+00, 0.000D+00, 0.000D+00, | |
31160 | 3 2.300D-02,-1.900D-02, 3.600D-02, 0.000D+00, 0.000D+00, 0.000D+00/ | |
31161 | C...Expansion coefficients for (up+down+strange) sea quark distribution. | |
31162 | DATA ((CDO(IP,IS,3,1),IS=1,6),IP=1,3)/ | |
31163 | 1 1.265D+00, 0.000D+00, 8.050D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31164 | 2-1.132D+00,-3.720D-01, 1.590D+00, 6.310D+00,-1.050D+01, 1.470D+01, | |
31165 | 3 2.930D-01,-2.900D-02,-1.530D-01,-2.730D-01,-3.170D+00, 9.800D+00/ | |
31166 | DATA ((CDO(IP,IS,3,2),IS=1,6),IP=1,3)/ | |
31167 | 1 1.670D+00, 0.000D+00, 9.150D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31168 | 2-1.920D+00,-2.730D-01, 5.300D-01, 1.570D+01,-1.010D+02, 2.230D+02, | |
31169 | 3 5.820D-01,-1.640D-01,-7.630D-01,-2.830D+00, 4.470D+01,-1.170D+02/ | |
31170 | C...Expansion coefficients for charm sea quark distribution. | |
31171 | DATA ((CDO(IP,IS,4,1),IS=1,6),IP=1,3)/ | |
31172 | 1 0.000D+00,-3.600D-02, 6.350D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31173 | 2 1.350D-01,-2.220D-01, 3.260D+00,-3.030D+00, 1.740D+01,-1.790D+01, | |
31174 | 3-7.500D-02,-5.800D-02,-9.090D-01, 1.500D+00,-1.130D+01, 1.560D+01/ | |
31175 | DATA ((CDO(IP,IS,4,2),IS=1,6),IP=1,3)/ | |
31176 | 1 0.000D+00,-1.200D-01, 3.510D+00, 0.000D+00, 0.000D+00, 0.000D+00, | |
31177 | 2 6.700D-02,-2.330D-01, 3.660D+00,-4.740D-01, 9.500D+00,-1.660D+01, | |
31178 | 3-3.100D-02,-2.300D-02,-4.530D-01, 3.580D-01,-5.430D+00, 1.550D+01/ | |
31179 | C...Expansion coefficients for gluon distribution. | |
31180 | DATA ((CDO(IP,IS,5,1),IS=1,6),IP=1,3)/ | |
31181 | 1 1.560D+00, 0.000D+00, 6.000D+00, 9.000D+00, 0.000D+00, 0.000D+00, | |
31182 | 2-1.710D+00,-9.490D-01, 1.440D+00,-7.190D+00,-1.650D+01, 1.530D+01, | |
31183 | 3 6.380D-01, 3.250D-01,-1.050D+00, 2.550D-01, 1.090D+01,-1.010D+01/ | |
31184 | DATA ((CDO(IP,IS,5,2),IS=1,6),IP=1,3)/ | |
31185 | 1 8.790D-01, 0.000D+00, 4.000D+00, 9.000D+00, 0.000D+00, 0.000D+00, | |
31186 | 2-9.710D-01,-1.160D+00, 1.230D+00,-5.640D+00,-7.540D+00,-5.960D-01, | |
31187 | 3 4.340D-01, 4.760D-01,-2.540D-01,-8.170D-01, 5.500D+00, 1.260D-01/ | |
31188 | ||
31189 | C...Euler's beta function, requires ordinary Gamma function | |
31190 | EULBET(X,Y)=PYGAMM(X)*PYGAMM(Y)/PYGAMM(X+Y) | |
31191 | ||
31192 | C...Leading order proton parton distributions from Glueck, Reya and | |
31193 | C...Vogt. Allowed variable range: 0.25 GeV^2 < Q^2 < 10^8 GeV^2 and | |
31194 | C...10^-5 < x < 1. | |
31195 | IF(MSTP(51).EQ.11) THEN | |
31196 | ||
31197 | C...Determine s expansion variable and some x expressions. | |
31198 | Q2IN=MIN(1D8,MAX(0.25D0,Q2)) | |
31199 | SD=LOG(LOG(Q2IN/0.232D0**2)/LOG(0.25D0/0.232D0**2)) | |
31200 | SD2=SD**2 | |
31201 | XL=-LOG(X) | |
31202 | XS=SQRT(X) | |
31203 | ||
31204 | C...Evaluate valence, gluon and sea distributions. | |
31205 | XFVUD=(0.663D0+0.191D0*SD-0.041D0*SD2+0.031D0*SD**3)* | |
31206 | & X**0.326D0*(1D0+(-1.97D0+6.74D0*SD-1.96D0*SD2)*XS+ | |
31207 | & (24.4D0-20.7D0*SD+4.08D0*SD2)*X)* | |
31208 | & (1D0-X)**(2.86D0+0.70D0*SD-0.02D0*SD2) | |
31209 | XFVDD=(0.579D0+0.283D0*SD+0.047D0*SD2)*X**(0.523D0-0.015D0*SD)* | |
31210 | & (1D0+(2.22D0-0.59D0*SD-0.27D0*SD2)*XS+(5.95D0-6.19D0*SD+ | |
31211 | & 1.55D0*SD2)*X)*(1D0-X)**(3.57D0+0.94D0*SD-0.16D0*SD2) | |
31212 | XFGLU=(X**(1.00D0-0.17D0*SD)*((4.879D0*SD-1.383D0*SD2)+ | |
31213 | & (25.92D0-28.97D0*SD+5.596D0*SD2)*X+(-25.69D0+23.68D0*SD- | |
31214 | & 1.975D0*SD2)*X**2)+SD**0.558D0*EXP(-(0.595D0+2.138D0*SD)+ | |
31215 | & SQRT(4.066D0*SD**1.218D0*XL)))* | |
31216 | & (1D0-X)**(2.537D0+1.718D0*SD+0.353D0*SD2) | |
31217 | XFSEA=(X**(0.412D0-0.171D0*SD)*(0.363D0-1.196D0*X+(1.029D0+ | |
31218 | & 1.785D0*SD-0.459D0*SD2)*X**2)*XL**(0.566D0-0.496D0*SD)+ | |
31219 | & SD**1.396D0*EXP(-(3.838D0+1.944D0*SD)+SQRT(2.845D0*SD**1.331D0* | |
31220 | & XL)))*(1D0-X)**(4.696D0+2.109D0*SD) | |
31221 | XFSTR=SD**0.803D0*(1D0+(-3.055D0+1.024D0*SD**0.67D0)*XS+ | |
31222 | & (27.4D0-20.0D0*SD**0.154D0)*X)*(1D0-X)**6.22D0* | |
31223 | & EXP(-(4.33D0+1.408D0*SD)+SQRT((8.27D0-0.437D0*SD)* | |
31224 | & SD**0.563D0*XL))/XL**(2.082D0-0.577D0*SD) | |
31225 | IF(SD.LE.0.888D0) THEN | |
31226 | XFCHM=0D0 | |
31227 | ELSE | |
31228 | XFCHM=(SD-0.888D0)**1.01D0*(1.+(4.24D0-0.804D0*SD)*X)* | |
31229 | & (1D0-X)**(3.46D0+1.076D0*SD)*EXP(-(4.61D0+1.49D0*SD)+ | |
31230 | & SQRT((2.555D0+1.961D0*SD)*SD**0.37D0*XL)) | |
31231 | ENDIF | |
31232 | IF(SD.LE.1.351D0) THEN | |
31233 | XFBOT=0D0 | |
31234 | ELSE | |
31235 | XFBOT=(SD-1.351D0)*(1D0+1.848D0*X)*(1D0-X)**(2.929D0+ | |
31236 | & 1.396D0*SD)*EXP(-(4.71D0+1.514D0*SD)+ | |
31237 | & SQRT((4.02D0+1.239D0*SD)*SD**0.51D0*XL)) | |
31238 | ENDIF | |
31239 | ||
31240 | C...Put into output array. | |
31241 | XPPR(0)=XFGLU | |
31242 | XPPR(1)=XFVDD+XFSEA | |
31243 | XPPR(2)=XFVUD-XFVDD+XFSEA | |
31244 | XPPR(3)=XFSTR | |
31245 | XPPR(4)=XFCHM | |
31246 | XPPR(5)=XFBOT | |
31247 | XPPR(-1)=XFSEA | |
31248 | XPPR(-2)=XFSEA | |
31249 | XPPR(-3)=XFSTR | |
31250 | XPPR(-4)=XFCHM | |
31251 | XPPR(-5)=XFBOT | |
31252 | ||
31253 | C...Proton parton distributions from Eichten, Hinchliffe, Lane, Quigg. | |
31254 | C...Allowed variable range: 5 GeV^2 < Q^2 < 1E8 GeV^2; 1E-4 < x < 1 | |
31255 | ELSEIF(MSTP(51).EQ.12.OR.MSTP(51).EQ.13) THEN | |
31256 | ||
31257 | C...Determine set, Lambda and x and t expansion variables. | |
31258 | NSET=MSTP(51)-11 | |
31259 | IF(NSET.EQ.1) ALAM=0.2D0 | |
31260 | IF(NSET.EQ.2) ALAM=0.29D0 | |
31261 | TMIN=LOG(5D0/ALAM**2) | |
31262 | TMAX=LOG(1D8/ALAM**2) | |
31263 | T=LOG(MAX(1D0,Q2/ALAM**2)) | |
31264 | VT=MAX(-1D0,MIN(1D0,(2D0*T-TMAX-TMIN)/(TMAX-TMIN))) | |
31265 | NX=1 | |
31266 | IF(X.LE.0.1D0) NX=2 | |
31267 | IF(NX.EQ.1) VX=(2D0*X-1.1D0)/0.9D0 | |
31268 | IF(NX.EQ.2) VX=MAX(-1D0,(2D0*LOG(X)+11.51293D0)/6.90776D0) | |
31269 | ||
31270 | C...Chebyshev polynomials for x and t expansion. | |
31271 | TX(1)=1D0 | |
31272 | TX(2)=VX | |
31273 | TX(3)=2D0*VX**2-1D0 | |
31274 | TX(4)=4D0*VX**3-3D0*VX | |
31275 | TX(5)=8D0*VX**4-8D0*VX**2+1D0 | |
31276 | TX(6)=16D0*VX**5-20D0*VX**3+5D0*VX | |
31277 | TT(1)=1D0 | |
31278 | TT(2)=VT | |
31279 | TT(3)=2D0*VT**2-1D0 | |
31280 | TT(4)=4D0*VT**3-3D0*VT | |
31281 | TT(5)=8D0*VT**4-8D0*VT**2+1D0 | |
31282 | TT(6)=16D0*VT**5-20D0*VT**3+5D0*VT | |
31283 | ||
31284 | C...Calculate structure functions. | |
31285 | DO 120 KFL=1,6 | |
31286 | XQSUM=0D0 | |
31287 | DO 110 IT=1,6 | |
31288 | DO 100 IX=1,6 | |
31289 | XQSUM=XQSUM+CEHLQ(IX,IT,NX,KFL,NSET)*TX(IX)*TT(IT) | |
31290 | 100 CONTINUE | |
31291 | 110 CONTINUE | |
31292 | XQ(KFL)=XQSUM*(1D0-X)**NEHLQ(KFL,NSET) | |
31293 | 120 CONTINUE | |
31294 | ||
31295 | C...Put into output array. | |
31296 | XPPR(0)=XQ(4) | |
31297 | XPPR(1)=XQ(2)+XQ(3) | |
31298 | XPPR(2)=XQ(1)+XQ(3) | |
31299 | XPPR(3)=XQ(5) | |
31300 | XPPR(4)=XQ(6) | |
31301 | XPPR(-1)=XQ(3) | |
31302 | XPPR(-2)=XQ(3) | |
31303 | XPPR(-3)=XQ(5) | |
31304 | XPPR(-4)=XQ(6) | |
31305 | ||
31306 | C...Special expansion for bottom (threshold effects). | |
31307 | IF(MSTP(58).GE.5) THEN | |
31308 | IF(NSET.EQ.1) TMIN=8.1905D0 | |
31309 | IF(NSET.EQ.2) TMIN=7.4474D0 | |
31310 | IF(T.GT.TMIN) THEN | |
31311 | VT=MAX(-1D0,MIN(1D0,(2D0*T-TMAX-TMIN)/(TMAX-TMIN))) | |
31312 | TT(1)=1D0 | |
31313 | TT(2)=VT | |
31314 | TT(3)=2D0*VT**2-1D0 | |
31315 | TT(4)=4D0*VT**3-3D0*VT | |
31316 | TT(5)=8D0*VT**4-8D0*VT**2+1D0 | |
31317 | TT(6)=16D0*VT**5-20D0*VT**3+5D0*VT | |
31318 | XQSUM=0D0 | |
31319 | DO 140 IT=1,6 | |
31320 | DO 130 IX=1,6 | |
31321 | XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,NSET)*TX(IX)*TT(IT) | |
31322 | 130 CONTINUE | |
31323 | 140 CONTINUE | |
31324 | XPPR(5)=XQSUM*(1D0-X)**NEHLQ(7,NSET) | |
31325 | XPPR(-5)=XPPR(5) | |
31326 | ENDIF | |
31327 | ENDIF | |
31328 | ||
31329 | C...Special expansion for top (threshold effects). | |
31330 | IF(MSTP(58).GE.6) THEN | |
31331 | IF(NSET.EQ.1) TMIN=11.5528D0 | |
31332 | IF(NSET.EQ.2) TMIN=10.8097D0 | |
31333 | TMIN=TMIN+2D0*LOG(PMAS(6,1)/30D0) | |
31334 | TMAX=TMAX+2D0*LOG(PMAS(6,1)/30D0) | |
31335 | IF(T.GT.TMIN) THEN | |
31336 | VT=MAX(-1D0,MIN(1D0,(2D0*T-TMAX-TMIN)/(TMAX-TMIN))) | |
31337 | TT(1)=1D0 | |
31338 | TT(2)=VT | |
31339 | TT(3)=2D0*VT**2-1D0 | |
31340 | TT(4)=4D0*VT**3-3D0*VT | |
31341 | TT(5)=8D0*VT**4-8D0*VT**2+1D0 | |
31342 | TT(6)=16D0*VT**5-20D0*VT**3+5D0*VT | |
31343 | XQSUM=0D0 | |
31344 | DO 160 IT=1,6 | |
31345 | DO 150 IX=1,6 | |
31346 | XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,NSET)*TX(IX)*TT(IT) | |
31347 | 150 CONTINUE | |
31348 | 160 CONTINUE | |
31349 | XPPR(6)=XQSUM*(1D0-X)**NEHLQ(8,NSET) | |
31350 | XPPR(-6)=XPPR(6) | |
31351 | ENDIF | |
31352 | ENDIF | |
31353 | ||
31354 | C...Proton parton distributions from Duke, Owens. | |
31355 | C...Allowed variable range: 4 GeV^2 < Q^2 < approx 1E6 GeV^2. | |
31356 | ELSEIF(MSTP(51).EQ.14.OR.MSTP(51).EQ.15) THEN | |
31357 | ||
31358 | C...Determine set, Lambda and s expansion parameter. | |
31359 | NSET=MSTP(51)-13 | |
31360 | IF(NSET.EQ.1) ALAM=0.2D0 | |
31361 | IF(NSET.EQ.2) ALAM=0.4D0 | |
31362 | Q2IN=MIN(1D6,MAX(4D0,Q2)) | |
31363 | SD=LOG(LOG(Q2IN/ALAM**2)/LOG(4D0/ALAM**2)) | |
31364 | ||
31365 | C...Calculate structure functions. | |
31366 | DO 180 KFL=1,5 | |
31367 | DO 170 IS=1,6 | |
31368 | TS(IS)=CDO(1,IS,KFL,NSET)+CDO(2,IS,KFL,NSET)*SD+ | |
31369 | & CDO(3,IS,KFL,NSET)*SD**2 | |
31370 | 170 CONTINUE | |
31371 | IF(KFL.LE.2) THEN | |
31372 | XQ(KFL)=X**TS(1)*(1D0-X)**TS(2)*(1D0+TS(3)*X)/(EULBET(TS(1), | |
31373 | & TS(2)+1D0)*(1D0+TS(3)*TS(1)/(TS(1)+TS(2)+1D0))) | |
31374 | ELSE | |
31375 | XQ(KFL)=TS(1)*X**TS(2)*(1D0-X)**TS(3)*(1D0+TS(4)*X+ | |
31376 | & TS(5)*X**2+TS(6)*X**3) | |
31377 | ENDIF | |
31378 | 180 CONTINUE | |
31379 | ||
31380 | C...Put into output arrays. | |
31381 | XPPR(0)=XQ(5) | |
31382 | XPPR(1)=XQ(2)+XQ(3)/6D0 | |
31383 | XPPR(2)=3D0*XQ(1)-XQ(2)+XQ(3)/6D0 | |
31384 | XPPR(3)=XQ(3)/6D0 | |
31385 | XPPR(4)=XQ(4) | |
31386 | XPPR(-1)=XQ(3)/6D0 | |
31387 | XPPR(-2)=XQ(3)/6D0 | |
31388 | XPPR(-3)=XQ(3)/6D0 | |
31389 | XPPR(-4)=XQ(4) | |
31390 | ||
31391 | ENDIF | |
31392 | ||
31393 | RETURN | |
31394 | END | |
31395 | ||
31396 | C********************************************************************* | |
31397 | ||
31398 | C...PYHFTH | |
31399 | C...Gives threshold attractive/repulsive factor for heavy flavour | |
31400 | C...production. | |
31401 | ||
31402 | FUNCTION PYHFTH(SH,SQM,FRATT) | |
31403 | ||
31404 | C...Double precision and integer declarations. | |
31405 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
31406 | IMPLICIT INTEGER(I-N) | |
31407 | INTEGER PYK,PYCHGE,PYCOMP | |
31408 | C...Commonblocks. | |
31409 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
31410 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
31411 | COMMON/PYINT1/MINT(400),VINT(400) | |
31412 | SAVE /PYDAT1/,/PYPARS/,/PYINT1/ | |
31413 | ||
31414 | C...Value for alpha_strong. | |
31415 | IF(MSTP(35).LE.1) THEN | |
31416 | ALSSG=PARP(35) | |
31417 | ELSE | |
31418 | MST115=MSTU(115) | |
31419 | MSTU(115)=MSTP(36) | |
31420 | Q2BN=SQRT(MAX(1D0,SQM*((SQRT(SH)-2D0*SQRT(SQM))**2+ | |
31421 | & PARP(36)**2))) | |
31422 | ALSSG=PYALPS(Q2BN) | |
31423 | MSTU(115)=MST115 | |
31424 | ENDIF | |
31425 | ||
31426 | C...Evaluate attractive and repulsive factors. | |
31427 | XATTR=4D0*PARU(1)*ALSSG/(3D0*SQRT(MAX(1D-20,1D0-4D0*SQM/SH))) | |
31428 | FATTR=XATTR/(1D0-EXP(-MIN(50D0,XATTR))) | |
31429 | XREPU=PARU(1)*ALSSG/(6D0*SQRT(MAX(1D-20,1D0-4D0*SQM/SH))) | |
31430 | FREPU=XREPU/(EXP(MIN(50D0,XREPU))-1D0) | |
31431 | PYHFTH=FRATT*FATTR+(1D0-FRATT)*FREPU | |
31432 | VINT(138)=PYHFTH | |
31433 | ||
31434 | RETURN | |
31435 | END | |
31436 | ||
31437 | C********************************************************************* | |
31438 | ||
31439 | C...PYSPLI | |
31440 | C...Splits a hadron remnant into two (partons or hadron + parton) | |
31441 | C...in case it is more complicated than just a quark or a diquark. | |
31442 | ||
31443 | SUBROUTINE PYSPLI(KF,KFLIN,KFLCH,KFLSP) | |
31444 | ||
31445 | C...Double precision and integer declarations. | |
31446 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
31447 | IMPLICIT INTEGER(I-N) | |
31448 | INTEGER PYK,PYCHGE,PYCOMP | |
31449 | C...Commonblocks. PYDAT1 temporary | |
31450 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
31451 | COMMON/PYINT1/MINT(400),VINT(400) | |
31452 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
31453 | SAVE /PYPARS/,/PYINT1/,/PYDAT1/ | |
31454 | C...Local array. | |
31455 | DIMENSION KFL(3) | |
31456 | ||
31457 | C...Preliminaries. Parton composition. | |
31458 | KFA=IABS(KF) | |
31459 | KFS=ISIGN(1,KF) | |
31460 | KFL(1)=MOD(KFA/1000,10) | |
31461 | KFL(2)=MOD(KFA/100,10) | |
31462 | KFL(3)=MOD(KFA/10,10) | |
31463 | IF(KFA.EQ.22.AND.MINT(109).EQ.2) THEN | |
31464 | KFL(2)=INT(1.5D0+PYR(0)) | |
31465 | IF(MINT(105).EQ.333) KFL(2)=3 | |
31466 | IF(MINT(105).EQ.443) KFL(2)=4 | |
31467 | KFL(3)=KFL(2) | |
31468 | ELSEIF((KFA.EQ.111.OR.KFA.EQ.113).AND.PYR(0).GT.0.5D0) THEN | |
31469 | KFL(2)=2 | |
31470 | KFL(3)=2 | |
31471 | ELSEIF(KFA.EQ.223.AND.PYR(0).GT.0.5D0) THEN | |
31472 | KFL(2)=1 | |
31473 | KFL(3)=1 | |
31474 | ELSEIF((KFA.EQ.130.OR.KFA.EQ.310).AND.PYR(0).GT.0.5D0) THEN | |
31475 | KFL(2)=MOD(KFA/10,10) | |
31476 | KFL(3)=MOD(KFA/100,10) | |
31477 | ENDIF | |
31478 | IF(KFLIN.NE.21.AND.KFLIN.NE.22.AND.KFLIN.NE.23) THEN | |
31479 | KFLR=KFLIN*KFS | |
31480 | ELSE | |
31481 | KFLR=KFLIN | |
31482 | ENDIF | |
31483 | KFLCH=0 | |
31484 | ||
31485 | C...Subdivide lepton. | |
31486 | IF(KFA.GE.11.AND.KFA.LE.18) THEN | |
31487 | IF(KFLR.EQ.KFA) THEN | |
31488 | KFLSP=KFS*22 | |
31489 | ELSEIF(KFLR.EQ.22) THEN | |
31490 | KFLSP=KFA | |
31491 | ELSEIF(KFLR.EQ.-24.AND.MOD(KFA,2).EQ.1) THEN | |
31492 | KFLSP=KFA+1 | |
31493 | ELSEIF(KFLR.EQ.24.AND.MOD(KFA,2).EQ.0) THEN | |
31494 | KFLSP=KFA-1 | |
31495 | ELSEIF(KFLR.EQ.21) THEN | |
31496 | KFLSP=KFA | |
31497 | KFLCH=KFS*21 | |
31498 | ELSE | |
31499 | KFLSP=KFA | |
31500 | KFLCH=-KFLR | |
31501 | ENDIF | |
31502 | ||
31503 | C...Subdivide photon. | |
31504 | ELSEIF(KFA.EQ.22.AND.MINT(109).NE.2) THEN | |
31505 | IF(KFLR.NE.21) THEN | |
31506 | KFLSP=-KFLR | |
31507 | ELSE | |
31508 | RAGR=0.75D0*PYR(0) | |
31509 | KFLSP=1 | |
31510 | IF(RAGR.GT.0.125D0) KFLSP=2 | |
31511 | IF(RAGR.GT.0.625D0) KFLSP=3 | |
31512 | IF(PYR(0).GT.0.5D0) KFLSP=-KFLSP | |
31513 | KFLCH=-KFLSP | |
31514 | ENDIF | |
31515 | ||
31516 | C...Subdivide Reggeon or Pomeron. | |
31517 | ELSEIF(KFA.EQ.110.OR.KFA.EQ.990) THEN | |
31518 | IF(KFLIN.EQ.21) THEN | |
31519 | KFLSP=KFS*21 | |
31520 | ELSE | |
31521 | KFLSP=-KFLIN | |
31522 | ENDIF | |
31523 | ||
31524 | C...Subdivide meson. | |
31525 | ELSEIF(KFL(1).EQ.0) THEN | |
31526 | KFL(2)=KFL(2)*(-1)**KFL(2) | |
31527 | KFL(3)=-KFL(3)*(-1)**IABS(KFL(2)) | |
31528 | IF(KFLR.EQ.KFL(2)) THEN | |
31529 | KFLSP=KFL(3) | |
31530 | ELSEIF(KFLR.EQ.KFL(3)) THEN | |
31531 | KFLSP=KFL(2) | |
31532 | ELSEIF(KFLR.EQ.21.AND.PYR(0).GT.0.5D0) THEN | |
31533 | KFLSP=KFL(2) | |
31534 | KFLCH=KFL(3) | |
31535 | ELSEIF(KFLR.EQ.21) THEN | |
31536 | KFLSP=KFL(3) | |
31537 | KFLCH=KFL(2) | |
31538 | ELSEIF(KFLR*KFL(2).GT.0) THEN | |
31539 | NTRY=0 | |
31540 | 100 NTRY=NTRY+1 | |
31541 | CALL PYKFDI(-KFLR,KFL(2),KFDUMP,KFLCH) | |
31542 | IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN | |
31543 | GOTO 100 | |
31544 | ELSEIF(KFLCH.EQ.0) THEN | |
31545 | CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') | |
31546 | MINT(51)=1 | |
31547 | RETURN | |
31548 | ENDIF | |
31549 | KFLSP=KFL(3) | |
31550 | ELSE | |
31551 | NTRY=0 | |
31552 | 110 NTRY=NTRY+1 | |
31553 | CALL PYKFDI(-KFLR,KFL(3),KFDUMP,KFLCH) | |
31554 | IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN | |
31555 | GOTO 110 | |
31556 | ELSEIF(KFLCH.EQ.0) THEN | |
31557 | CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') | |
31558 | MINT(51)=1 | |
31559 | RETURN | |
31560 | ENDIF | |
31561 | KFLSP=KFL(2) | |
31562 | ENDIF | |
31563 | ||
31564 | C...Subdivide baryon. | |
31565 | ELSE | |
31566 | NAGR=0 | |
31567 | DO 120 J=1,3 | |
31568 | IF(KFLR.EQ.KFL(J)) NAGR=NAGR+1 | |
31569 | 120 CONTINUE | |
31570 | IF(NAGR.GE.1) THEN | |
31571 | RAGR=0.00001D0+(NAGR-0.00002D0)*PYR(0) | |
31572 | IAGR=0 | |
31573 | DO 130 J=1,3 | |
31574 | IF(KFLR.EQ.KFL(J)) RAGR=RAGR-1D0 | |
31575 | IF(IAGR.EQ.0.AND.RAGR.LE.0D0) IAGR=J | |
31576 | 130 CONTINUE | |
31577 | ELSE | |
31578 | IAGR=1.00001D0+2.99998D0*PYR(0) | |
31579 | ENDIF | |
31580 | ID1=1 | |
31581 | IF(IAGR.EQ.1) ID1=2 | |
31582 | IF(IAGR.EQ.1.AND.KFL(3).GT.KFL(2)) ID1=3 | |
31583 | ID2=6-IAGR-ID1 | |
31584 | KSP=3 | |
31585 | IF(MOD(KFA,10).EQ.2.AND.KFL(1).EQ.KFL(2)) THEN | |
31586 | IF(IAGR.NE.3.AND.PYR(0).GT.0.25D0) KSP=1 | |
31587 | ELSEIF(MOD(KFA,10).EQ.2.AND.KFL(2).GE.KFL(3)) THEN | |
31588 | IF(IAGR.NE.1.AND.PYR(0).GT.0.25D0) KSP=1 | |
31589 | ELSEIF(MOD(KFA,10).EQ.2) THEN | |
31590 | IF(IAGR.EQ.1) KSP=1 | |
31591 | IF(IAGR.NE.1.AND.PYR(0).GT.0.75D0) KSP=1 | |
31592 | ENDIF | |
31593 | KFLSP=1000*KFL(ID1)+100*KFL(ID2)+KSP | |
31594 | IF(KFLR.EQ.21) THEN | |
31595 | KFLCH=KFL(IAGR) | |
31596 | ELSEIF(NAGR.EQ.0.AND.KFLR.GT.0) THEN | |
31597 | NTRY=0 | |
31598 | 140 NTRY=NTRY+1 | |
31599 | CALL PYKFDI(-KFLR,KFL(IAGR),KFDUMP,KFLCH) | |
31600 | IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN | |
31601 | GOTO 140 | |
31602 | ELSEIF(KFLCH.EQ.0) THEN | |
31603 | CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') | |
31604 | MINT(51)=1 | |
31605 | RETURN | |
31606 | ENDIF | |
31607 | ELSEIF(NAGR.EQ.0) THEN | |
31608 | NTRY=0 | |
31609 | 150 NTRY=NTRY+1 | |
31610 | CALL PYKFDI(10000*KFL(ID1)+KFLSP,-KFLR,KFDUMP,KFLCH) | |
31611 | IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN | |
31612 | GOTO 150 | |
31613 | ELSEIF(KFLCH.EQ.0) THEN | |
31614 | CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') | |
31615 | MINT(51)=1 | |
31616 | RETURN | |
31617 | ENDIF | |
31618 | KFLSP=KFL(IAGR) | |
31619 | ENDIF | |
31620 | ENDIF | |
31621 | ||
31622 | C...Add on correct sign for result. | |
31623 | KFLCH=KFLCH*KFS | |
31624 | KFLSP=KFLSP*KFS | |
31625 | ||
31626 | RETURN | |
31627 | END | |
31628 | ||
31629 | C********************************************************************* | |
31630 | ||
31631 | C...PYGAMM | |
31632 | C...Gives ordinary Gamma function Gamma(x) for positive, real arguments; | |
31633 | C...see M. Abramowitz, I. A. Stegun: Handbook of Mathematical Functions | |
31634 | C...(Dover, 1965) 6.1.36. | |
31635 | ||
31636 | FUNCTION PYGAMM(X) | |
31637 | ||
31638 | C...Double precision and integer declarations. | |
31639 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
31640 | IMPLICIT INTEGER(I-N) | |
31641 | INTEGER PYK,PYCHGE,PYCOMP | |
31642 | C...Local array and data. | |
31643 | DIMENSION B(8) | |
31644 | DATA B/-0.577191652D0,0.988205891D0,-0.897056937D0,0.918206857D0, | |
31645 | &-0.756704078D0,0.482199394D0,-0.193527818D0,0.035868343D0/ | |
31646 | ||
31647 | NX=INT(X) | |
31648 | DX=X-NX | |
31649 | ||
31650 | PYGAMM=1D0 | |
31651 | DXP=1D0 | |
31652 | DO 100 I=1,8 | |
31653 | DXP=DXP*DX | |
31654 | PYGAMM=PYGAMM+B(I)*DXP | |
31655 | 100 CONTINUE | |
31656 | IF(X.LT.1D0) THEN | |
31657 | PYGAMM=PYGAMM/X | |
31658 | ELSE | |
31659 | DO 110 IX=1,NX-1 | |
31660 | PYGAMM=(X-IX)*PYGAMM | |
31661 | 110 CONTINUE | |
31662 | ENDIF | |
31663 | ||
31664 | RETURN | |
31665 | END | |
31666 | ||
31667 | C*********************************************************************** | |
31668 | ||
31669 | C...PYWAUX | |
31670 | C...Calculates real and imaginary parts of the auxiliary functions W1 | |
31671 | C...and W2; see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van | |
31672 | C...der Bij, Nucl. Phys. B297 (1988) 221. | |
31673 | ||
31674 | SUBROUTINE PYWAUX(IAUX,EPS,WRE,WIM) | |
31675 | ||
31676 | C...Double precision and integer declarations. | |
31677 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
31678 | IMPLICIT INTEGER(I-N) | |
31679 | INTEGER PYK,PYCHGE,PYCOMP | |
31680 | C...Commonblocks. | |
31681 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
31682 | SAVE /PYDAT1/ | |
31683 | ||
31684 | ASINH(X)=LOG(X+SQRT(X**2+1D0)) | |
31685 | ACOSH(X)=LOG(X+SQRT(X**2-1D0)) | |
31686 | ||
31687 | IF(EPS.LT.0D0) THEN | |
31688 | IF(IAUX.EQ.1) WRE=2D0*SQRT(1D0-EPS)*ASINH(SQRT(-1D0/EPS)) | |
31689 | IF(IAUX.EQ.2) WRE=4D0*(ASINH(SQRT(-1D0/EPS)))**2 | |
31690 | WIM=0D0 | |
31691 | ELSEIF(EPS.LT.1D0) THEN | |
31692 | IF(IAUX.EQ.1) WRE=2D0*SQRT(1D0-EPS)*ACOSH(SQRT(1D0/EPS)) | |
31693 | IF(IAUX.EQ.2) WRE=4D0*(ACOSH(SQRT(1D0/EPS)))**2-PARU(1)**2 | |
31694 | IF(IAUX.EQ.1) WIM=-PARU(1)*SQRT(1D0-EPS) | |
31695 | IF(IAUX.EQ.2) WIM=-4D0*PARU(1)*ACOSH(SQRT(1D0/EPS)) | |
31696 | ELSE | |
31697 | IF(IAUX.EQ.1) WRE=2D0*SQRT(EPS-1D0)*ASIN(SQRT(1D0/EPS)) | |
31698 | IF(IAUX.EQ.2) WRE=-4D0*(ASIN(SQRT(1D0/EPS)))**2 | |
31699 | WIM=0D0 | |
31700 | ENDIF | |
31701 | ||
31702 | RETURN | |
31703 | END | |
31704 | ||
31705 | C*********************************************************************** | |
31706 | ||
31707 | C...PYI3AU | |
31708 | C...Calculates real and imaginary parts of the auxiliary function I3; | |
31709 | C...see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van der Bij, | |
31710 | C...Nucl. Phys. B297 (1988) 221. | |
31711 | ||
31712 | SUBROUTINE PYI3AU(EPS,RAT,Y3RE,Y3IM) | |
31713 | ||
31714 | C...Double precision and integer declarations. | |
31715 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
31716 | IMPLICIT INTEGER(I-N) | |
31717 | INTEGER PYK,PYCHGE,PYCOMP | |
31718 | C...Commonblocks. | |
31719 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
31720 | SAVE /PYDAT1/ | |
31721 | ||
31722 | BE=0.5D0*(1D0+SQRT(1D0+RAT*EPS)) | |
31723 | IF(EPS.LT.1D0) GA=0.5D0*(1D0+SQRT(1D0-EPS)) | |
31724 | ||
31725 | IF(EPS.LT.0D0) THEN | |
31726 | IF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN | |
31727 | F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)- | |
31728 | & PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+ | |
31729 | & PYSPEN(0.25D0*(RAT+1D0)*EPS/(1D0+0.25D0*RAT*EPS),0D0,1)- | |
31730 | & PYSPEN((RAT+1D0)/RAT,0D0,1)+0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2- | |
31731 | & LOG(0.25D0*RAT*EPS)**2)+LOG(1D0-0.25D0*EPS)* | |
31732 | & LOG((1D0+0.25D0*(RAT-1D0)*EPS)/(1D0+0.25D0*RAT*EPS))+ | |
31733 | & LOG(-0.25D0*EPS)*LOG(0.25D0*RAT*EPS/(1D0+0.25D0*(RAT-1D0)* | |
31734 | & EPS)) | |
31735 | ELSEIF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).GE.1D-4) THEN | |
31736 | F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)- | |
31737 | & PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+ | |
31738 | & PYSPEN((BE-1D0+0.25D0*EPS)/BE,0D0,1)- | |
31739 | & PYSPEN((BE-1D0+0.25D0*EPS)/(BE-1D0),0D0,1)+ | |
31740 | & 0.5D0*(LOG(BE)**2-LOG(BE-1D0)**2)+ | |
31741 | & LOG(1D0-0.25D0*EPS)*LOG((BE-0.25D0*EPS)/BE)+ | |
31742 | & LOG(-0.25D0*EPS)*LOG((BE-1D0)/(BE-0.25D0*EPS)) | |
31743 | ELSEIF(ABS(EPS).GE.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN | |
31744 | F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)- | |
31745 | & PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+ | |
31746 | & PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(1D0+0.25D0*RAT*EPS),0D0,1)- | |
31747 | & PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(0.25D0*RAT*EPS),0D0,1)+ | |
31748 | & 0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2-LOG(0.25D0*RAT*EPS)**2)+ | |
31749 | & LOG(GA)*LOG((GA+0.25D0*RAT*EPS)/(1D0+0.25D0*RAT*EPS))+ | |
31750 | & LOG(GA-1D0)*LOG(0.25D0*RAT*EPS/(GA+0.25D0*RAT*EPS)) | |
31751 | ELSE | |
31752 | F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)- | |
31753 | & PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN((BE-GA)/BE,0D0,1)- | |
31754 | & PYSPEN((BE-GA)/(BE-1D0),0D0,1)+0.5D0*(LOG(BE)**2- | |
31755 | & LOG(BE-1D0)**2)+LOG(GA)*LOG((GA+BE-1D0)/BE)+ | |
31756 | & LOG(GA-1D0)*LOG((BE-1D0)/(GA+BE-1D0)) | |
31757 | ENDIF | |
31758 | F3IM=0D0 | |
31759 | ELSEIF(EPS.LT.1D0) THEN | |
31760 | IF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN | |
31761 | F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)- | |
31762 | & PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+ | |
31763 | & PYSPEN((1D0-0.25D0*EPS)/(-0.25D0*(RAT+1D0)*EPS),0D0,1)- | |
31764 | & PYSPEN(1D0/(RAT+1D0),0D0,1)+LOG((1D0-0.25D0*EPS)/ | |
31765 | & (0.25D0*EPS))*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/ | |
31766 | & (0.25D0*(RAT+1D0)*EPS)) | |
31767 | F3IM=-PARU(1)*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/ | |
31768 | & (0.25D0*(RAT+1D0)*EPS)) | |
31769 | ELSEIF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).GE.1D-4) THEN | |
31770 | F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)- | |
31771 | & PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+ | |
31772 | & PYSPEN((1D0-0.25D0*EPS)/(1D0-0.25D0*EPS-BE),0D0,1)- | |
31773 | & PYSPEN(-0.25D0*EPS/(1D0-0.25D0*EPS-BE),0D0,1)+ | |
31774 | & LOG((1D0-0.25D0*EPS)/(0.25D0*EPS))* | |
31775 | & LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS)) | |
31776 | F3IM=-PARU(1)*LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS)) | |
31777 | ELSEIF(ABS(EPS).GE.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN | |
31778 | F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)- | |
31779 | & PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+ | |
31780 | & PYSPEN(GA/(GA-1D0-0.25D0*RAT*EPS),0D0,1)- | |
31781 | & PYSPEN((GA-1D0)/(GA-1D0-0.25D0*RAT*EPS),0D0,1)+ | |
31782 | & LOG(GA/(1D0-GA))*LOG((GA+0.25D0*RAT*EPS)/ | |
31783 | & (1D0+0.25D0*RAT*EPS-GA)) | |
31784 | F3IM=-PARU(1)*LOG((GA+0.25D0*RAT*EPS)/ | |
31785 | & (1D0+0.25D0*RAT*EPS-GA)) | |
31786 | ELSE | |
31787 | F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)- | |
31788 | & PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN(GA/(GA-BE),0D0,1)- | |
31789 | & PYSPEN((GA-1D0)/(GA-BE),0D0,1)+LOG(GA/(1D0-GA))* | |
31790 | & LOG((GA+BE-1D0)/(BE-GA)) | |
31791 | F3IM=-PARU(1)*LOG((GA+BE-1D0)/(BE-GA)) | |
31792 | ENDIF | |
31793 | ELSE | |
31794 | RSQ=EPS/(EPS-1D0+(2D0*BE-1D0)**2) | |
31795 | RCTHE=RSQ*(1D0-2D0*BE/EPS) | |
31796 | RSTHE=SQRT(MAX(0D0,RSQ-RCTHE**2)) | |
31797 | RCPHI=RSQ*(1D0+2D0*(BE-1D0)/EPS) | |
31798 | RSPHI=SQRT(MAX(0D0,RSQ-RCPHI**2)) | |
31799 | R=SQRT(RSQ) | |
31800 | THE=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCTHE/R))) | |
31801 | PHI=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCPHI/R))) | |
31802 | F3RE=PYSPEN(RCTHE,RSTHE,1)+PYSPEN(RCTHE,-RSTHE,1)- | |
31803 | & PYSPEN(RCPHI,RSPHI,1)-PYSPEN(RCPHI,-RSPHI,1)+ | |
31804 | & (PHI-THE)*(PHI+THE-PARU(1)) | |
31805 | F3IM=PYSPEN(RCTHE,RSTHE,2)+PYSPEN(RCTHE,-RSTHE,2)- | |
31806 | & PYSPEN(RCPHI,RSPHI,2)-PYSPEN(RCPHI,-RSPHI,2) | |
31807 | ENDIF | |
31808 | ||
31809 | Y3RE=2D0/(2D0*BE-1D0)*F3RE | |
31810 | Y3IM=2D0/(2D0*BE-1D0)*F3IM | |
31811 | ||
31812 | RETURN | |
31813 | END | |
31814 | ||
31815 | C*********************************************************************** | |
31816 | ||
31817 | C...PYSPEN | |
31818 | C...Calculates real and imaginary part of Spence function; see | |
31819 | C...G. 't Hooft and M. Veltman, Nucl. Phys. B153 (1979) 365. | |
31820 | ||
31821 | FUNCTION PYSPEN(XREIN,XIMIN,IREIM) | |
31822 | ||
31823 | C...Double precision and integer declarations. | |
31824 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
31825 | IMPLICIT INTEGER(I-N) | |
31826 | INTEGER PYK,PYCHGE,PYCOMP | |
31827 | C...Commonblocks. | |
31828 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
31829 | SAVE /PYDAT1/ | |
31830 | C...Local array and data. | |
31831 | DIMENSION B(0:14) | |
31832 | DATA B/ | |
31833 | &1.000000D+00, -5.000000D-01, 1.666667D-01, | |
31834 | &0.000000D+00, -3.333333D-02, 0.000000D+00, | |
31835 | &2.380952D-02, 0.000000D+00, -3.333333D-02, | |
31836 | &0.000000D+00, 7.575757D-02, 0.000000D+00, | |
31837 | &-2.531135D-01, 0.000000D+00, 1.166667D+00/ | |
31838 | ||
31839 | XRE=XREIN | |
31840 | XIM=XIMIN | |
31841 | IF(ABS(1D0-XRE).LT.1D-6.AND.ABS(XIM).LT.1D-6) THEN | |
31842 | IF(IREIM.EQ.1) PYSPEN=PARU(1)**2/6D0 | |
31843 | IF(IREIM.EQ.2) PYSPEN=0D0 | |
31844 | RETURN | |
31845 | ENDIF | |
31846 | ||
31847 | XMOD=SQRT(XRE**2+XIM**2) | |
31848 | IF(XMOD.LT.1D-6) THEN | |
31849 | IF(IREIM.EQ.1) PYSPEN=0D0 | |
31850 | IF(IREIM.EQ.2) PYSPEN=0D0 | |
31851 | RETURN | |
31852 | ENDIF | |
31853 | ||
31854 | XARG=SIGN(ACOS(XRE/XMOD),XIM) | |
31855 | SP0RE=0D0 | |
31856 | SP0IM=0D0 | |
31857 | SGN=1D0 | |
31858 | IF(XMOD.GT.1D0) THEN | |
31859 | ALGXRE=LOG(XMOD) | |
31860 | ALGXIM=XARG-SIGN(PARU(1),XARG) | |
31861 | SP0RE=-PARU(1)**2/6D0-(ALGXRE**2-ALGXIM**2)/2D0 | |
31862 | SP0IM=-ALGXRE*ALGXIM | |
31863 | SGN=-1D0 | |
31864 | XMOD=1D0/XMOD | |
31865 | XARG=-XARG | |
31866 | XRE=XMOD*COS(XARG) | |
31867 | XIM=XMOD*SIN(XARG) | |
31868 | ENDIF | |
31869 | IF(XRE.GT.0.5D0) THEN | |
31870 | ALGXRE=LOG(XMOD) | |
31871 | ALGXIM=XARG | |
31872 | XRE=1D0-XRE | |
31873 | XIM=-XIM | |
31874 | XMOD=SQRT(XRE**2+XIM**2) | |
31875 | XARG=SIGN(ACOS(XRE/XMOD),XIM) | |
31876 | ALGYRE=LOG(XMOD) | |
31877 | ALGYIM=XARG | |
31878 | SP0RE=SP0RE+SGN*(PARU(1)**2/6D0-(ALGXRE*ALGYRE-ALGXIM*ALGYIM)) | |
31879 | SP0IM=SP0IM-SGN*(ALGXRE*ALGYIM+ALGXIM*ALGYRE) | |
31880 | SGN=-SGN | |
31881 | ENDIF | |
31882 | ||
31883 | XRE=1D0-XRE | |
31884 | XIM=-XIM | |
31885 | XMOD=SQRT(XRE**2+XIM**2) | |
31886 | XARG=SIGN(ACOS(XRE/XMOD),XIM) | |
31887 | ZRE=-LOG(XMOD) | |
31888 | ZIM=-XARG | |
31889 | ||
31890 | SPRE=0D0 | |
31891 | SPIM=0D0 | |
31892 | SAVERE=1D0 | |
31893 | SAVEIM=0D0 | |
31894 | DO 100 I=0,14 | |
31895 | IF(MAX(ABS(SAVERE),ABS(SAVEIM)).LT.1D-30) GOTO 110 | |
31896 | TERMRE=(SAVERE*ZRE-SAVEIM*ZIM)/DBLE(I+1) | |
31897 | TERMIM=(SAVERE*ZIM+SAVEIM*ZRE)/DBLE(I+1) | |
31898 | SAVERE=TERMRE | |
31899 | SAVEIM=TERMIM | |
31900 | SPRE=SPRE+B(I)*TERMRE | |
31901 | SPIM=SPIM+B(I)*TERMIM | |
31902 | 100 CONTINUE | |
31903 | ||
31904 | 110 IF(IREIM.EQ.1) PYSPEN=SP0RE+SGN*SPRE | |
31905 | IF(IREIM.EQ.2) PYSPEN=SP0IM+SGN*SPIM | |
31906 | ||
31907 | RETURN | |
31908 | END | |
31909 | ||
31910 | C*********************************************************************** | |
31911 | ||
31912 | C...PYQQBH | |
31913 | C...Calculates the matrix element for the processes | |
31914 | C...g + g or q + qbar -> Q + Qbar + H (normally with Q = t). | |
31915 | C...REDUCE output and part of the rest courtesy Z. Kunszt, see | |
31916 | C...Z. Kunszt, Nucl. Phys. B247 (1984) 339. | |
31917 | ||
31918 | SUBROUTINE PYQQBH(WTQQBH) | |
31919 | ||
31920 | C...Double precision and integer declarations. | |
31921 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
31922 | IMPLICIT INTEGER(I-N) | |
31923 | INTEGER PYK,PYCHGE,PYCOMP | |
31924 | C...Commonblocks. | |
31925 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
31926 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
31927 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
31928 | COMMON/PYINT1/MINT(400),VINT(400) | |
31929 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
31930 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/ | |
31931 | C...Local arrays and function. | |
31932 | DIMENSION PP(15,4),CLR(8,8),FM(10,10),RM(8,8),DX(8) | |
31933 | DOT(I,J)=PP(I,4)*PP(J,4)-PP(I,1)*PP(J,1)-PP(I,2)*PP(J,2)- | |
31934 | &PP(I,3)*PP(J,3) | |
31935 | ||
31936 | C...Mass parameters. | |
31937 | WTQQBH=0D0 | |
31938 | ISUB=MINT(1) | |
31939 | SHPR=SQRT(VINT(26))*VINT(1) | |
31940 | PQ=PMAS(PYCOMP(KFPR(ISUB,2)),1) | |
31941 | PH=SQRT(VINT(21))*VINT(1) | |
31942 | SPQ=PQ**2 | |
31943 | SPH=PH**2 | |
31944 | ||
31945 | C...Set up outgoing kinematics: 1=t, 2=tbar, 3=H. | |
31946 | DO 100 I=1,2 | |
31947 | PT=SQRT(MAX(0D0,VINT(197+5*I))) | |
31948 | PP(I,1)=PT*COS(VINT(198+5*I)) | |
31949 | PP(I,2)=PT*SIN(VINT(198+5*I)) | |
31950 | 100 CONTINUE | |
31951 | PP(3,1)=-PP(1,1)-PP(2,1) | |
31952 | PP(3,2)=-PP(1,2)-PP(2,2) | |
31953 | PMS1=SPQ+PP(1,1)**2+PP(1,2)**2 | |
31954 | PMS2=SPQ+PP(2,1)**2+PP(2,2)**2 | |
31955 | PMS3=SPH+PP(3,1)**2+PP(3,2)**2 | |
31956 | PMT3=SQRT(PMS3) | |
31957 | PP(3,3)=PMT3*SINH(VINT(211)) | |
31958 | PP(3,4)=PMT3*COSH(VINT(211)) | |
31959 | PMS12=(SHPR-PP(3,4))**2-PP(3,3)**2 | |
31960 | PP(1,3)=(-PP(3,3)*(PMS12+PMS1-PMS2)+ | |
31961 | &VINT(213)*(SHPR-PP(3,4))*VINT(220))/(2D0*PMS12) | |
31962 | PP(2,3)=-PP(1,3)-PP(3,3) | |
31963 | PP(1,4)=SQRT(PMS1+PP(1,3)**2) | |
31964 | PP(2,4)=SQRT(PMS2+PP(2,3)**2) | |
31965 | ||
31966 | C...Set up incoming kinematics and derived momentum combinations. | |
31967 | DO 110 I=4,5 | |
31968 | PP(I,1)=0D0 | |
31969 | PP(I,2)=0D0 | |
31970 | PP(I,3)=-0.5D0*SHPR*(-1)**I | |
31971 | PP(I,4)=-0.5D0*SHPR | |
31972 | 110 CONTINUE | |
31973 | DO 120 J=1,4 | |
31974 | PP(6,J)=PP(1,J)+PP(2,J) | |
31975 | PP(7,J)=PP(1,J)+PP(3,J) | |
31976 | PP(8,J)=PP(1,J)+PP(4,J) | |
31977 | PP(9,J)=PP(1,J)+PP(5,J) | |
31978 | PP(10,J)=-PP(2,J)-PP(3,J) | |
31979 | PP(11,J)=-PP(2,J)-PP(4,J) | |
31980 | PP(12,J)=-PP(2,J)-PP(5,J) | |
31981 | PP(13,J)=-PP(4,J)-PP(5,J) | |
31982 | 120 CONTINUE | |
31983 | ||
31984 | C...Derived kinematics invariants. | |
31985 | X1=DOT(1,2) | |
31986 | X2=DOT(1,3) | |
31987 | X3=DOT(1,4) | |
31988 | X4=DOT(1,5) | |
31989 | X5=DOT(2,3) | |
31990 | X6=DOT(2,4) | |
31991 | X7=DOT(2,5) | |
31992 | X8=DOT(3,4) | |
31993 | X9=DOT(3,5) | |
31994 | X10=DOT(4,5) | |
31995 | ||
31996 | C...Propagators. | |
31997 | SS1=DOT(7,7)-SPQ | |
31998 | SS2=DOT(8,8)-SPQ | |
31999 | SS3=DOT(9,9)-SPQ | |
32000 | SS4=DOT(10,10)-SPQ | |
32001 | SS5=DOT(11,11)-SPQ | |
32002 | SS6=DOT(12,12)-SPQ | |
32003 | SS7=DOT(13,13) | |
32004 | DX(1)=SS1*SS6 | |
32005 | DX(2)=SS2*SS6 | |
32006 | DX(3)=SS2*SS4 | |
32007 | DX(4)=SS1*SS5 | |
32008 | DX(5)=SS3*SS5 | |
32009 | DX(6)=SS3*SS4 | |
32010 | DX(7)=SS7*SS1 | |
32011 | DX(8)=SS7*SS4 | |
32012 | ||
32013 | C...Define colour coefficients for g + g -> Q + Qbar + H. | |
32014 | IF(ISUB.EQ.121.OR.ISUB.EQ.181.OR.ISUB.EQ.186) THEN | |
32015 | DO 140 I=1,3 | |
32016 | DO 130 J=1,3 | |
32017 | CLR(I,J)=16D0/3D0 | |
32018 | CLR(I+3,J+3)=16D0/3D0 | |
32019 | CLR(I,J+3)=-2D0/3D0 | |
32020 | CLR(I+3,J)=-2D0/3D0 | |
32021 | 130 CONTINUE | |
32022 | 140 CONTINUE | |
32023 | DO 160 L=1,2 | |
32024 | DO 150 I=1,3 | |
32025 | CLR(I,6+L)=-6D0 | |
32026 | CLR(I+3,6+L)=6D0 | |
32027 | CLR(6+L,I)=-6D0 | |
32028 | CLR(6+L,I+3)=6D0 | |
32029 | 150 CONTINUE | |
32030 | 160 CONTINUE | |
32031 | DO 180 K1=1,2 | |
32032 | DO 170 K2=1,2 | |
32033 | CLR(6+K1,6+K2)=12D0 | |
32034 | 170 CONTINUE | |
32035 | 180 CONTINUE | |
32036 | ||
32037 | C...Evaluate matrix elements for g + g -> Q + Qbar + H. | |
32038 | FM(1,1)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+2*X2+X4+X9+2* | |
32039 | & X7+X5)+8*PQ**2*PH**2*(-X1-X4+2*X7)+16*PQ**2*(X2*X9+4*X2* | |
32040 | & X7+X2*X5-2*X4*X7-2*X9*X7)+8*PH**2*X4*X7-16*X2*X9*X7 | |
32041 | FM(1,2)=16*PQ**6+8*PQ**4*(-2*X1+X2-2*X3-2*X4-4*X10+X9-X8+2 | |
32042 | & *X7-4*X6+X5)+8*PQ**2*(-2*X1*X2-2*X2*X4-2*X2*X10+X2*X7-2* | |
32043 | & X2*X6-2*X3*X7+2*X4*X7+4*X10*X7-X9*X7-X8*X7)+16*X2*X7*(X4+ | |
32044 | & X10) | |
32045 | FM(1,3)=16*PQ**6-4*PQ**4*PH**2+8*PQ**4*(-2*X1+2*X2-2*X3-4* | |
32046 | & X4-8*X10+X9+X8-2*X7-4*X6+2*X5)-(4*PQ**2*PH**2)*(X1+X4+X10 | |
32047 | & +X6)+8*PQ**2*(-2*X1*X2-2*X1*X10+X1*X9+X1*X8-2*X1*X5+X2**2 | |
32048 | & -4*X2*X4-5*X2*X10+X2*X8-X2*X7-3*X2*X6+X2*X5+X3*X9+2*X3*X7 | |
32049 | & -X3*X5+X4*X8+2*X4*X6-3*X4*X5-5*X10*X5+X9*X8+X9*X6+X9*X5+ | |
32050 | & X8*X7-4*X6*X5+X5**2)-(16*X2*X5)*(X1+X4+X10+X6) | |
32051 | FM(1,4)=16*PQ**6+4*PQ**4*PH**2+16*PQ**4*(-X1+X2-X3-X4+X10- | |
32052 | & X9-X8+2*X7+2*X6-X5)+4*PQ**2*PH**2*(X1+X3+X4+X10+2*X7+2*X6 | |
32053 | & )+8*PQ**2*(4*X1*X10+4*X1*X7+4*X1*X6+2*X2*X10-X2*X9-X2*X8+ | |
32054 | & 4*X2*X7+4*X2*X6-X2*X5+4*X10*X5+4*X7*X5+4*X6*X5)-(8*PH**2* | |
32055 | & X1)*(X10+X7+X6)+16*X2*X5*(X10+X7+X6) | |
32056 | FM(1,5)=8*PQ**4*(-2*X1-2*X4+X10-X9)+4*PQ**2*(4*X1**2-2*X1* | |
32057 | & X2+8*X1*X3+6*X1*X10-2*X1*X9+4*X1*X8+4*X1*X7+4*X1*X6+2*X1* | |
32058 | & X5+X2*X10+4*X3*X4-X3*X9+2*X3*X7+3*X4*X8-2*X4*X6+2*X4*X5-4 | |
32059 | & *X10*X7+3*X10*X5-3*X9*X6+3*X8*X7-4*X7**2+4*X7*X5)+8*(X1** | |
32060 | & 2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9+X1*X3*X5-X1*X4* | |
32061 | & X8-X1*X4*X5+X1*X10*X9+X1*X9*X7+X1*X9*X6-X1*X8*X7-X2*X3*X7 | |
32062 | & +X2*X4*X6-X2*X10*X7-X2*X7**2+X3*X7*X5-X4*X10*X5-X4*X7*X5- | |
32063 | & X4*X6*X5) | |
32064 | FM(1,6)=16*PQ**4*(-4*X1-X4+X9-X7)+4*PQ**2*PH**2*(-2*X1-X4- | |
32065 | & X7)+16*PQ**2*(-2*X1**2-3*X1*X2-2*X1*X4-3*X1*X9-2*X1*X7-3* | |
32066 | & X1*X5-2*X2*X4-2*X7*X5)-8*PH**2*X4*X7+8*(-X1*X2*X9-2*X1*X2 | |
32067 | & *X5-X1*X9**2-X1*X9*X5+X2**2*X7-X2*X4*X5+X2*X9*X7-X2*X7*X5 | |
32068 | & +X4*X9*X5+X4*X5**2) | |
32069 | FM(1,7)=8*PQ**4*(2*X3+X4+3*X10+X9+2*X8+3*X7+6*X6)+2*PQ**2* | |
32070 | & PH**2*(-2*X3-X4+3*X10+3*X7+6*X6)+4*PQ**2*(4*X1*X10+4*X1* | |
32071 | & X7+8*X1*X6+6*X2*X10+X2*X9+2*X2*X8+6*X2*X7+12*X2*X6-8*X3* | |
32072 | & X7+4*X4*X7+4*X4*X6+4*X10*X5+4*X9*X7+4*X9*X6-8*X8*X7+4*X7* | |
32073 | & X5+8*X6*X5)+4*PH**2*(-X1*X10-X1*X7-2*X1*X6+2*X3*X7-X4*X7- | |
32074 | & X4*X6)+8*X2*(X10*X5+X9*X7+X9*X6-2*X8*X7+X7*X5+2*X6*X5) | |
32075 | FM(1,8)=8*PQ**4*(2*X3+X4+3*X10+2*X9+X8+3*X7+6*X6)+2*PQ**2* | |
32076 | & PH**2*(-2*X3-X4+2*X10+X7+2*X6)+4*PQ**2*(4*X1*X10-2*X1*X9+ | |
32077 | & 2*X1*X8+4*X1*X7+8*X1*X6+5*X2*X10+2*X2*X9+X2*X8+4*X2*X7+8* | |
32078 | & X2*X6-X3*X9-8*X3*X7+2*X3*X5+2*X4*X9-X4*X8+4*X4*X7+4*X4*X6 | |
32079 | & +4*X4*X5+5*X10*X5+X9**2-X9*X8+2*X9*X7+5*X9*X6+X9*X5-7*X8* | |
32080 | & X7+2*X8*X5+2*X7*X5+10*X6*X5)+2*PH**2*(-X1*X10+X3*X7-2*X4* | |
32081 | & X7+X4*X6)+4*(-X1*X9**2+X1*X9*X8-2*X1*X9*X5-X1*X8*X5+2*X2* | |
32082 | & X10*X5+X2*X9*X7+X2*X9*X6-2*X2*X8*X7+3*X2*X6*X5+X3*X9*X5+ | |
32083 | & X3*X5**2+X4*X9*X5-2*X4*X8*X5+2*X4*X5**2) | |
32084 | FM(2,2)=16*PQ**6+16*PQ**4*(-X1+X3-X4-X10+X7-X6)+16*PQ**2*( | |
32085 | & X3*X10+X3*X7+X3*X6+X4*X7+X10*X7)-16*X3*X10*X7 | |
32086 | FM(2,3)=16*PQ**6+8*PQ**4*(-2*X1+X2+2*X3-4*X4-4*X10-X9+X8-2 | |
32087 | & *X7-2*X6+X5)+8*PQ**2*(-2*X1*X5+4*X3*X10-X3*X9-X3*X8-2*X3* | |
32088 | & X7+2*X3*X6+X3*X5-2*X4*X5-2*X10*X5-2*X6*X5)+16*X3*X5*(X10+ | |
32089 | & X6) | |
32090 | FM(2,4)=8*PQ**4*(-2*X1-2*X3+X10-X8)+4*PQ**2*(4*X1**2-2*X1* | |
32091 | & X2+8*X1*X4+6*X1*X10+4*X1*X9-2*X1*X8+4*X1*X7+4*X1*X6+2*X1* | |
32092 | & X5+X2*X10+4*X3*X4+3*X3*X9-2*X3*X7+2*X3*X5-X4*X8+2*X4*X6-4 | |
32093 | & *X10*X6+3*X10*X5+3*X9*X6-3*X8*X7-4*X6**2+4*X6*X5)+8*(-X1 | |
32094 | & **2*X9+X1**2*X8+X1*X2*X7-X1*X2*X6-X1*X3*X9-X1*X3*X5+X1*X4 | |
32095 | & *X8+X1*X4*X5+X1*X10*X8-X1*X9*X6+X1*X8*X7+X1*X8*X6+X2*X3* | |
32096 | & X7-X2*X4*X6-X2*X10*X6-X2*X6**2-X3*X10*X5-X3*X7*X5-X3*X6* | |
32097 | & X5+X4*X6*X5) | |
32098 | FM(2,5)=16*PQ**4*X10+8*PQ**2*(2*X1**2+2*X1*X3+2*X1*X4+2*X1 | |
32099 | & *X10+2*X1*X7+2*X1*X6+X3*X7+X4*X6)+8*(-2*X1**3-2*X1**2*X3- | |
32100 | & 2*X1**2*X4-2*X1**2*X10-2*X1**2*X7-2*X1**2*X6-2*X1*X3*X4- | |
32101 | & X1*X3*X10-2*X1*X3*X6-X1*X4*X10-2*X1*X4*X7-X1*X10**2-X1* | |
32102 | & X10*X7-X1*X10*X6-2*X1*X7*X6+X3**2*X7-X3*X4*X7-X3*X4*X6+X3 | |
32103 | & *X10*X7+X3*X7**2-X3*X7*X6+X4**2*X6+X4*X10*X6-X4*X7*X6+X4* | |
32104 | & X6**2) | |
32105 | FM(2,6)=8*PQ**4*(-2*X1+X10-X9-2*X7)+4*PQ**2*(4*X1**2+2*X1* | |
32106 | & X2+4*X1*X3+4*X1*X4+6*X1*X10-2*X1*X9+4*X1*X8+8*X1*X6-2*X1* | |
32107 | & X5+4*X2*X4+3*X2*X10+2*X2*X7-3*X3*X9-2*X3*X7-4*X4**2-4*X4* | |
32108 | & X10+3*X4*X8+2*X4*X6+X10*X5-X9*X6+3*X8*X7+4*X7*X6)+8*(X1** | |
32109 | & 2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9+X1*X3*X5+X1*X4* | |
32110 | & X9-X1*X4*X8-X1*X4*X5+X1*X10*X9+X1*X9*X6-X1*X8*X7-X2*X3*X7 | |
32111 | & -X2*X4*X7+X2*X4*X6-X2*X10*X7+X3*X7*X5-X4**2*X5-X4*X10*X5- | |
32112 | & X4*X6*X5) | |
32113 | FM(2,7)=8*PQ**4*(X3+2*X4+3*X10+X7+2*X6)+4*PQ**2*(-4*X1*X3- | |
32114 | & 2*X1*X4-2*X1*X10+X1*X9-X1*X8-4*X1*X7-2*X1*X6+X2*X3+2*X2* | |
32115 | & X4+3*X2*X10+X2*X7+2*X2*X6-6*X3*X4-6*X3*X10-2*X3*X9-2*X3* | |
32116 | & X7-4*X3*X6-X3*X5-6*X4**2-6*X4*X10-3*X4*X9-X4*X8-4*X4*X7-2 | |
32117 | & *X4*X6-2*X4*X5-3*X10*X9-3*X10*X8-6*X10*X7-6*X10*X6+X10*X5 | |
32118 | & +X9*X7-2*X8*X7-2*X8*X6-6*X7*X6+X7*X5-6*X6**2+2*X6*X5)+4*( | |
32119 | & -X1**2*X9+X1**2*X8-2*X1*X2*X10-3*X1*X2*X7-3*X1*X2*X6+X1* | |
32120 | & X3*X9-X1*X3*X5+X1*X4*X9+X1*X4*X8+X1*X4*X5+X1*X10*X9+X1* | |
32121 | & X10*X8-X1*X9*X6+X1*X8*X6+X2*X3*X7-3*X2*X4*X7-X2*X4*X6-3* | |
32122 | & X2*X10*X7-3*X2*X10*X6-3*X2*X7*X6-3*X2*X6**2-2*X3*X4*X5-X3 | |
32123 | & *X10*X5-X3*X6*X5-X4**2*X5-X4*X10*X5+X4*X6*X5) | |
32124 | FM(2,8)=8*PQ**4*(X3+2*X4+3*X10+X7+2*X6)+4*PQ**2*(-4*X1*X3- | |
32125 | & 2*X1*X4-2*X1*X10-X1*X9+X1*X8-4*X1*X7-2*X1*X6+X2*X3+2*X2* | |
32126 | & X4+X2*X10-X2*X7-2*X2*X6-6*X3*X4-6*X3*X10-2*X3*X9+X3*X8-2* | |
32127 | & X3*X7-4*X3*X6+X3*X5-6*X4**2-6*X4*X10-2*X4*X9-4*X4*X7-2*X4 | |
32128 | & *X6+2*X4*X5-3*X10*X9-3*X10*X8-6*X10*X7-6*X10*X6+3*X10*X5- | |
32129 | & X9*X6-2*X8*X7-3*X8*X6-6*X7*X6+X7*X5-6*X6**2+2*X6*X5)+4*( | |
32130 | & X1**2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6-3*X1*X3*X5+X1*X4*X9- | |
32131 | & X1*X4*X8-3*X1*X4*X5+X1*X10*X9+X1*X10*X8-2*X1*X10*X5+X1*X9 | |
32132 | & *X6+X1*X8*X7+X1*X8*X6-X2*X4*X7+X2*X4*X6-X2*X10*X7-X2*X10* | |
32133 | & X6-2*X2*X7*X6-X2*X6**2-3*X3*X4*X5-3*X3*X10*X5+X3*X7*X5-3* | |
32134 | & X3*X6*X5-3*X4**2*X5-3*X4*X10*X5-X4*X6*X5) | |
32135 | FM(3,3)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+X2+2*X3+X8+X6 | |
32136 | & +2*X5)+8*PQ**2*PH**2*(-X1+2*X3-X6)+16*PQ**2*(X2*X5-2*X3* | |
32137 | & X8-2*X3*X6+4*X3*X5+X8*X5)+8*PH**2*X3*X6-16*X3*X8*X5 | |
32138 | FM(3,4)=16*PQ**4*(-4*X1-X3+X8-X6)+4*PQ**2*PH**2*(-2*X1-X3- | |
32139 | & X6)+16*PQ**2*(-2*X1**2-3*X1*X2-2*X1*X3-3*X1*X8-2*X1*X6-3* | |
32140 | & X1*X5-2*X2*X3-2*X6*X5)-8*PH**2*X3*X6+8*(-X1*X2*X8-2*X1*X2 | |
32141 | & *X5-X1*X8**2-X1*X8*X5+X2**2*X6-X2*X3*X5+X2*X8*X6-X2*X6*X5 | |
32142 | & +X3*X8*X5+X3*X5**2) | |
32143 | FM(3,5)=8*PQ**4*(-2*X1+X10-X8-2*X6)+4*PQ**2*(4*X1**2+2*X1* | |
32144 | & X2+4*X1*X3+4*X1*X4+6*X1*X10+4*X1*X9-2*X1*X8+8*X1*X7-2*X1* | |
32145 | & X5+4*X2*X3+3*X2*X10+2*X2*X6-4*X3**2-4*X3*X10+3*X3*X9+2*X3 | |
32146 | & *X7-3*X4*X8-2*X4*X6+X10*X5+3*X9*X6-X8*X7+4*X7*X6)+8*(-X1 | |
32147 | & **2*X9+X1**2*X8+X1*X2*X7-X1*X2*X6-X1*X3*X9+X1*X3*X8-X1*X3 | |
32148 | & *X5+X1*X4*X8+X1*X4*X5+X1*X10*X8-X1*X9*X6+X1*X8*X7+X2*X3* | |
32149 | & X7-X2*X3*X6-X2*X4*X6-X2*X10*X6-X3**2*X5-X3*X10*X5-X3*X7* | |
32150 | & X5+X4*X6*X5) | |
32151 | FM(3,6)=16*PQ**6+4*PQ**4*PH**2+16*PQ**4*(-X1-X2+2*X3+2*X4+ | |
32152 | & X10-X9-X8-X7-X6+X5)+4*PQ**2*PH**2*(X1+2*X3+2*X4+X10+X7+X6 | |
32153 | & )+8*PQ**2*(4*X1*X3+4*X1*X4+4*X1*X10+4*X2*X3+4*X2*X4+4*X2* | |
32154 | & X10-X2*X5+4*X3*X5+4*X4*X5+2*X10*X5-X9*X5-X8*X5)-(8*PH**2* | |
32155 | & X1)*(X3+X4+X10)+16*X2*X5*(X3+X4+X10) | |
32156 | FM(3,7)=8*PQ**4*(3*X3+6*X4+3*X10+X9+2*X8+2*X7+X6)+2*PQ**2* | |
32157 | & PH**2*(X3+2*X4+2*X10-2*X7-X6)+4*PQ**2*(4*X1*X3+8*X1*X4+4* | |
32158 | & X1*X10+2*X1*X9-2*X1*X8+2*X2*X3+10*X2*X4+5*X2*X10+2*X2*X9+ | |
32159 | & X2*X8+2*X2*X7+4*X2*X6-7*X3*X9+2*X3*X8-8*X3*X7+4*X3*X6+4* | |
32160 | & X3*X5+5*X4*X8+4*X4*X6+8*X4*X5+5*X10*X5-X9*X8-X9*X6+X9*X5+ | |
32161 | & X8**2-X8*X7+2*X8*X6+2*X8*X5)+2*PH**2*(-X1*X10+X3*X7-2*X3* | |
32162 | & X6+X4*X6)+4*(-X1*X2*X9-2*X1*X2*X8+X1*X9*X8-X1*X8**2+X2**2 | |
32163 | & *X7+2*X2**2*X6+3*X2*X4*X5+2*X2*X10*X5-2*X2*X9*X6+X2*X8*X7 | |
32164 | & +X2*X8*X6-2*X3*X9*X5+X3*X8*X5+X4*X8*X5) | |
32165 | FM(3,8)=8*PQ**4*(3*X3+6*X4+3*X10+2*X9+X8+2*X7+X6)+2*PQ**2* | |
32166 | & PH**2*(3*X3+6*X4+3*X10-2*X7-X6)+4*PQ**2*(4*X1*X3+8*X1*X4+ | |
32167 | & 4*X1*X10+4*X2*X3+8*X2*X4+4*X2*X10-8*X3*X9+4*X3*X8-8*X3*X7 | |
32168 | & +4*X3*X6+6*X3*X5+4*X4*X8+4*X4*X6+12*X4*X5+6*X10*X5+2*X9* | |
32169 | & X5+X8*X5)+4*PH**2*(-X1*X3-2*X1*X4-X1*X10+2*X3*X7-X3*X6-X4 | |
32170 | & *X6)+8*X5*(X2*X3+2*X2*X4+X2*X10-2*X3*X9+X3*X8+X4*X8) | |
32171 | FM(4,4)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+2*X2+X3+X8+2* | |
32172 | & X6+X5)+8*PQ**2*PH**2*(-X1-X3+2*X6)+16*PQ**2*(X2*X8+4*X2* | |
32173 | & X6+X2*X5-2*X3*X6-2*X8*X6)+8*PH**2*X3*X6-16*X2*X8*X6 | |
32174 | FM(4,5)=16*PQ**6+8*PQ**4*(-2*X1+X2-2*X3-2*X4-4*X10-X9+X8-4 | |
32175 | & *X7+2*X6+X5)+8*PQ**2*(-2*X1*X2-2*X2*X3-2*X2*X10-2*X2*X7+ | |
32176 | & X2*X6+2*X3*X6-2*X4*X6+4*X10*X6-X9*X6-X8*X6)+16*X2*X6*(X3+ | |
32177 | & X10) | |
32178 | FM(4,6)=16*PQ**6-4*PQ**4*PH**2+8*PQ**4*(-2*X1+2*X2-4*X3-2* | |
32179 | & X4-8*X10+X9+X8-4*X7-2*X6+2*X5)-(4*PQ**2*PH**2)*(X1+X3+X10 | |
32180 | & +X7)+8*PQ**2*(-2*X1*X2-2*X1*X10+X1*X9+X1*X8-2*X1*X5+X2**2 | |
32181 | & -4*X2*X3-5*X2*X10+X2*X9-3*X2*X7-X2*X6+X2*X5+X3*X9+2*X3*X7 | |
32182 | & -3*X3*X5+X4*X8+2*X4*X6-X4*X5-5*X10*X5+X9*X8+X9*X6+X8*X7+ | |
32183 | & X8*X5-4*X7*X5+X5**2)-(16*X2*X5)*(X1+X3+X10+X7) | |
32184 | FM(4,7)=8*PQ**4*(-X3-2*X4-3*X10-2*X9-X8-6*X7-3*X6)+2*PQ**2 | |
32185 | & *PH**2*(X3+2*X4-3*X10-6*X7-3*X6)+4*PQ**2*(-4*X1*X10-8*X1* | |
32186 | & X7-4*X1*X6-6*X2*X10-2*X2*X9-X2*X8-12*X2*X7-6*X2*X6-4*X3* | |
32187 | & X7-4*X3*X6+8*X4*X6-4*X10*X5+8*X9*X6-4*X8*X7-4*X8*X6-8*X7* | |
32188 | & X5-4*X6*X5)+4*PH**2*(X1*X10+2*X1*X7+X1*X6+X3*X7+X3*X6-2* | |
32189 | & X4*X6)+8*X2*(-X10*X5+2*X9*X6-X8*X7-X8*X6-2*X7*X5-X6*X5) | |
32190 | FM(4,8)=8*PQ**4*(-X3-2*X4-3*X10-X9-2*X8-6*X7-3*X6)+2*PQ**2 | |
32191 | & *PH**2*(X3+2*X4-2*X10-2*X7-X6)+4*PQ**2*(-4*X1*X10-2*X1*X9 | |
32192 | & +2*X1*X8-8*X1*X7-4*X1*X6-5*X2*X10-X2*X9-2*X2*X8-8*X2*X7-4 | |
32193 | & *X2*X6+X3*X9-2*X3*X8-4*X3*X7-4*X3*X6-4*X3*X5+X4*X8+8*X4* | |
32194 | & X6-2*X4*X5-5*X10*X5+X9*X8+7*X9*X6-2*X9*X5-X8**2-5*X8*X7-2 | |
32195 | & *X8*X6-X8*X5-10*X7*X5-2*X6*X5)+2*PH**2*(X1*X10-X3*X7+2*X3 | |
32196 | & *X6-X4*X6)+4*(-X1*X9*X8+X1*X9*X5+X1*X8**2+2*X1*X8*X5-2*X2 | |
32197 | & *X10*X5+2*X2*X9*X6-X2*X8*X7-X2*X8*X6-3*X2*X7*X5+2*X3*X9* | |
32198 | & X5-X3*X8*X5-2*X3*X5**2-X4*X8*X5-X4*X5**2) | |
32199 | FM(5,5)=16*PQ**6+16*PQ**4*(-X1-X3+X4-X10-X7+X6)+16*PQ**2*( | |
32200 | & X3*X6+X4*X10+X4*X7+X4*X6+X10*X6)-16*X4*X10*X6 | |
32201 | FM(5,6)=16*PQ**6+8*PQ**4*(-2*X1+X2-4*X3+2*X4-4*X10+X9-X8-2 | |
32202 | & *X7-2*X6+X5)+8*PQ**2*(-2*X1*X5-2*X3*X5+4*X4*X10-X4*X9-X4* | |
32203 | & X8+2*X4*X7-2*X4*X6+X4*X5-2*X10*X5-2*X7*X5)+16*X4*X5*(X10+ | |
32204 | & X7) | |
32205 | FM(5,7)=8*PQ**4*(-2*X3-X4-3*X10-2*X7-X6)+4*PQ**2*(2*X1*X3+ | |
32206 | & 4*X1*X4+2*X1*X10+X1*X9-X1*X8+2*X1*X7+4*X1*X6-2*X2*X3-X2* | |
32207 | & X4-3*X2*X10-2*X2*X7-X2*X6+6*X3**2+6*X3*X4+6*X3*X10+X3*X9+ | |
32208 | & 3*X3*X8+2*X3*X7+4*X3*X6+2*X3*X5+6*X4*X10+2*X4*X8+4*X4*X7+ | |
32209 | & 2*X4*X6+X4*X5+3*X10*X9+3*X10*X8+6*X10*X7+6*X10*X6-X10*X5+ | |
32210 | & 2*X9*X7+2*X9*X6-X8*X6+6*X7**2+6*X7*X6-2*X7*X5-X6*X5)+4*(- | |
32211 | & X1**2*X9+X1**2*X8+2*X1*X2*X10+3*X1*X2*X7+3*X1*X2*X6-X1*X3 | |
32212 | & *X9-X1*X3*X8-X1*X3*X5-X1*X4*X8+X1*X4*X5-X1*X10*X9-X1*X10* | |
32213 | & X8-X1*X9*X7+X1*X8*X7+X2*X3*X7+3*X2*X3*X6-X2*X4*X6+3*X2* | |
32214 | & X10*X7+3*X2*X10*X6+3*X2*X7**2+3*X2*X7*X6+X3**2*X5+2*X3*X4 | |
32215 | & *X5+X3*X10*X5-X3*X7*X5+X4*X10*X5+X4*X7*X5) | |
32216 | FM(5,8)=8*PQ**4*(-2*X3-X4-3*X10-2*X7-X6)+4*PQ**2*(2*X1*X3+ | |
32217 | & 4*X1*X4+2*X1*X10-X1*X9+X1*X8+2*X1*X7+4*X1*X6-2*X2*X3-X2* | |
32218 | & X4-X2*X10+2*X2*X7+X2*X6+6*X3**2+6*X3*X4+6*X3*X10+2*X3*X8+ | |
32219 | & 2*X3*X7+4*X3*X6-2*X3*X5+6*X4*X10-X4*X9+2*X4*X8+4*X4*X7+2* | |
32220 | & X4*X6-X4*X5+3*X10*X9+3*X10*X8+6*X10*X7+6*X10*X6-3*X10*X5+ | |
32221 | & 3*X9*X7+2*X9*X6+X8*X7+6*X7**2+6*X7*X6-2*X7*X5-X6*X5)+4*( | |
32222 | & X1**2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9-X1*X3*X8+3* | |
32223 | & X1*X3*X5+3*X1*X4*X5-X1*X10*X9-X1*X10*X8+2*X1*X10*X5-X1*X9 | |
32224 | & *X7-X1*X9*X6-X1*X8*X7-X2*X3*X7+X2*X3*X6+X2*X10*X7+X2*X10* | |
32225 | & X6+X2*X7**2+2*X2*X7*X6+3*X3**2*X5+3*X3*X4*X5+3*X3*X10*X5+ | |
32226 | & X3*X7*X5+3*X4*X10*X5+3*X4*X7*X5-X4*X6*X5) | |
32227 | FM(6,6)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+X2+2*X4+X9+X7 | |
32228 | & +2*X5)+8*PQ**2*PH**2*(-X1+2*X4-X7)+16*PQ**2*(X2*X5-2*X4* | |
32229 | & X9-2*X4*X7+4*X4*X5+X9*X5)+8*PH**2*X4*X7-16*X4*X9*X5 | |
32230 | FM(6,7)=8*PQ**4*(-6*X3-3*X4-3*X10-2*X9-X8-X7-2*X6)+2*PQ**2 | |
32231 | & *PH**2*(-2*X3-X4-2*X10+X7+2*X6)+4*PQ**2*(-8*X1*X3-4*X1*X4 | |
32232 | & -4*X1*X10+2*X1*X9-2*X1*X8-10*X2*X3-2*X2*X4-5*X2*X10-X2*X9 | |
32233 | & -2*X2*X8-4*X2*X7-2*X2*X6-5*X3*X9-4*X3*X7-8*X3*X5-2*X4*X9+ | |
32234 | & 7*X4*X8-4*X4*X7+8*X4*X6-4*X4*X5-5*X10*X5-X9**2+X9*X8-2*X9 | |
32235 | & *X7+X9*X6-2*X9*X5+X8*X7-X8*X5)+2*PH**2*(X1*X10-X3*X7+2*X4 | |
32236 | & *X7-X4*X6)+4*(2*X1*X2*X9+X1*X2*X8+X1*X9**2-X1*X9*X8-2*X2 | |
32237 | & **2*X7-X2**2*X6-3*X2*X3*X5-2*X2*X10*X5-X2*X9*X7-X2*X9*X6+ | |
32238 | & 2*X2*X8*X7-X3*X9*X5-X4*X9*X5+2*X4*X8*X5) | |
32239 | FM(6,8)=8*PQ**4*(-6*X3-3*X4-3*X10-X9-2*X8-X7-2*X6)+2*PQ**2 | |
32240 | & *PH**2*(-6*X3-3*X4-3*X10+X7+2*X6)+4*PQ**2*(-8*X1*X3-4*X1* | |
32241 | & X4-4*X1*X10-8*X2*X3-4*X2*X4-4*X2*X10-4*X3*X9-4*X3*X7-12* | |
32242 | & X3*X5-4*X4*X9+8*X4*X8-4*X4*X7+8*X4*X6-6*X4*X5-6*X10*X5-X9 | |
32243 | & *X5-2*X8*X5)+4*PH**2*(2*X1*X3+X1*X4+X1*X10+X3*X7+X4*X7-2* | |
32244 | & X4*X6)+8*X5*(-2*X2*X3-X2*X4-X2*X10-X3*X9-X4*X9+2*X4*X8) | |
32245 | FM(7,7)=72*PQ**4*X10+18*PQ**2*PH**2*X10+8*PQ**2*(X1*X10+9* | |
32246 | & X2*X10+7*X3*X7+2*X3*X6+2*X4*X7+7*X4*X6+X10*X5+2*X9*X7+7* | |
32247 | & X9*X6+7*X8*X7+2*X8*X6)+2*PH**2*(-X1*X10-7*X3*X7-2*X3*X6-2 | |
32248 | & *X4*X7-7*X4*X6)+4*X2*(X10*X5+2*X9*X7+7*X9*X6+7*X8*X7+2*X8 | |
32249 | & *X6) | |
32250 | FM(7,8)=72*PQ**4*X10+2*PQ**2*PH**2*X10+4*PQ**2*(2*X1*X10+ | |
32251 | & 10*X2*X10+7*X3*X9+2*X3*X8+14*X3*X7+4*X3*X6+2*X4*X9+7*X4* | |
32252 | & X8+4*X4*X7+14*X4*X6+10*X10*X5+X9**2+7*X9*X8+2*X9*X7+7*X9* | |
32253 | & X6+X8**2+7*X8*X7+2*X8*X6)+2*PH**2*(7*X1*X10-7*X3*X7-2*X3* | |
32254 | & X6-2*X4*X7-7*X4*X6)+2*(-2*X1*X9**2-14*X1*X9*X8-2*X1*X8**2 | |
32255 | & +2*X2*X10*X5+2*X2*X9*X7+7*X2*X9*X6+7*X2*X8*X7+2*X2*X8*X6+ | |
32256 | & 7*X3*X9*X5+2*X3*X8*X5+2*X4*X9*X5+7*X4*X8*X5) | |
32257 | FM(8,8)=72*PQ**4*X10+18*PQ**2*PH**2*X10+8*PQ**2*(X1*X10+X2 | |
32258 | & *X10+7*X3*X9+2*X3*X8+7*X3*X7+2*X3*X6+2*X4*X9+7*X4*X8+2*X4 | |
32259 | & *X7+7*X4*X6+9*X10*X5)+2*PH**2*(-X1*X10-7*X3*X7-2*X3*X6-2* | |
32260 | & X4*X7-7*X4*X6)+4*X5*(X2*X10+7*X3*X9+2*X3*X8+2*X4*X9+7*X4* | |
32261 | & X8) | |
32262 | FM(9,9)=-4*PQ**4*X10-PQ**2*PH**2*X10+4*PQ**2*(-X1*X10-X2*X10+ | |
32263 | & X3*X7+X4*X6-X10*X5+X9*X6+X8*X7)+PH**2*(X1*X10-X3*X7-X4*X6 | |
32264 | & )+2*X2*(-X10*X5+X9*X6+X8*X7) | |
32265 | FM(9,10)=-4*PQ**4*X10-PQ**2*PH**2*X10+2*PQ**2*(-2*X1*X10-2*X2* | |
32266 | & X10+2*X3*X9+2*X3*X7+2*X4*X6-2*X10*X5+X9*X8+2*X8*X7)+PH**2 | |
32267 | & *(X1*X10-X3*X7-X4*X6)+2*(-X1*X9*X8-X2*X10*X5+X2*X8*X7+X3* | |
32268 | & X9*X5) | |
32269 | FMXX=-4*PQ**4*X10-PQ**2*PH**2*X10+2*PQ**2*(-2*X1*X10-2*X2* | |
32270 | & X10+2*X4*X8+2*X4*X6+2*X3*X7-2*X10*X5+X9*X8+2*X9*X6)+PH**2 | |
32271 | & *(X1*X10-X3*X7-X4*X6)+2*(-X1*X9*X8-X2*X10*X5+X2*X9*X6+X4* | |
32272 | & X8*X5) | |
32273 | FM(9,10)=0.5D0*(FMXX+FM(9,10)) | |
32274 | FM(10,10)=-4*PQ**4*X10-PQ**2*PH**2*X10+4*PQ**2*(-X1*X10-X2*X10+ | |
32275 | & X3*X7+X4*X6-X10*X5+X9*X3+X8*X4)+PH**2*(X1*X10-X3*X7-X4*X6 | |
32276 | & )+2*X5*(-X10*X2+X9*X3+X8*X4) | |
32277 | ||
32278 | C...Repackage matrix elements. | |
32279 | DO 200 I=1,8 | |
32280 | DO 190 J=1,8 | |
32281 | RM(I,J)=FM(I,J) | |
32282 | 190 CONTINUE | |
32283 | 200 CONTINUE | |
32284 | RM(7,7)=FM(7,7)-2D0*FM(9,9) | |
32285 | RM(7,8)=FM(7,8)-2D0*FM(9,10) | |
32286 | RM(8,8)=FM(8,8)-2D0*FM(10,10) | |
32287 | ||
32288 | C...Produce final result: matrix elements * colours * propagators. | |
32289 | DO 220 I=1,8 | |
32290 | DO 210 J=I,8 | |
32291 | FAC=8D0 | |
32292 | IF(I.EQ.J)FAC=4D0 | |
32293 | WTQQBH=WTQQBH+RM(I,J)*FAC*CLR(I,J)/(DX(I)*DX(J)) | |
32294 | 210 CONTINUE | |
32295 | 220 CONTINUE | |
32296 | WTQQBH=-WTQQBH/256D0 | |
32297 | ||
32298 | ELSE | |
32299 | C...Evaluate matrix elements for q + qbar -> Q + Qbar + H. | |
32300 | A11=-8D0*PQ**4*X10-2D0*PQ**2*PH**2*X10-(8D0*PQ**2)*(X2*X10+X3 | |
32301 | & *X7+X4*X6+X9*X6+X8*X7)+2D0*PH**2*(X3*X7+X4*X6)-(4D0*X2)*(X9 | |
32302 | & *X6+X8*X7) | |
32303 | A12=-8D0*PQ**4*X10+4D0*PQ**2*(-X2*X10-X3*X9-2D0*X3*X7-X4*X8- | |
32304 | & 2D0*X4*X6-X10*X5-X9*X8-X9*X6-X8*X7)+2D0*PH**2*(-X1*X10+X3*X7 | |
32305 | & +X4*X6)+2D0*(2D0*X1*X9*X8-X2*X9*X6-X2*X8*X7-X3*X9*X5-X4*X8* | |
32306 | & X5) | |
32307 | A22=-8D0*PQ**4*X10-2D0*PQ**2*PH**2*X10-(8D0*PQ**2)*(X3*X9+X3* | |
32308 | & X7+X4*X8+X4*X6+X10*X5)+2D0*PH**2*(X3*X7+X4*X6)-(4D0*X5)*(X3 | |
32309 | & *X9+X4*X8) | |
32310 | ||
32311 | C...Produce final result: matrix elements * propagators. | |
32312 | A11=A11/DX(7)**2 | |
32313 | A12=A12/(DX(7)*DX(8)) | |
32314 | A22=A22/DX(8)**2 | |
32315 | WTQQBH=-(A11+A22+2D0*A12)*8D0/9D0 | |
32316 | ENDIF | |
32317 | ||
32318 | RETURN | |
32319 | END | |
32320 | ||
32321 | C********************************************************************* | |
32322 | ||
32323 | C...PYMSIN | |
32324 | C...Initializes supersymmetry: finds sparticle masses and | |
32325 | C...branching ratios and stores this information. | |
32326 | C...AUTHOR: STEPHEN MRENNA | |
32327 | C...Baryon- and lepton-number violating parameters by P. Z. Skands. | |
32328 | ||
32329 | SUBROUTINE PYMSIN | |
32330 | ||
32331 | C...Double precision and integer declarations. | |
32332 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
32333 | IMPLICIT INTEGER(I-N) | |
32334 | INTEGER PYK,PYCHGE,PYCOMP | |
32335 | C...Parameter statement to help give large particle numbers. | |
32336 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
32337 | &KEXCIT=4000000,KDIMEN=5000000) | |
32338 | C...Commonblocks. | |
32339 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
32340 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
32341 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
32342 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
32343 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
32344 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
32345 | COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) | |
32346 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
32347 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
32348 | COMMON/PYHTRI/HHH(7) | |
32349 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT4/,/PYMSSM/, | |
32350 | &/PYMSRV/,/PYSSMT/ | |
32351 | ||
32352 | C...Local variables. | |
32353 | DOUBLE PRECISION ALFA,BETA | |
32354 | DOUBLE PRECISION TANB,AL,BE,COSA,COSB,SINA,SINB,XW | |
32355 | INTEGER I,J,J1,I1,K1 | |
32356 | INTEGER KC,LKNT,IDLAM(400,3) | |
32357 | DOUBLE PRECISION XLAM(0:400) | |
32358 | DOUBLE PRECISION WDTP(0:400),WDTE(0:400,0:5) | |
32359 | DOUBLE PRECISION XARG,COS2B,XMW2,XMZ2 | |
32360 | DOUBLE PRECISION DELM,XMDIF | |
32361 | DOUBLE PRECISION DX,DY,DS,DMU2,DMA2,DQ2,DU2,DD2,DL2,DE2,DHU2,DHD2 | |
32362 | DOUBLE PRECISION ARG,SGNMU,R | |
32363 | INTEGER IMSSM | |
32364 | INTEGER IRPRTY | |
32365 | INTEGER KFSUSY(36),MWIDSU(36),MDCYSU(36) | |
32366 | SAVE MWIDSU,MDCYSU | |
32367 | DATA KFSUSY/ | |
32368 | &1000001,2000001,1000002,2000002,1000003,2000003, | |
32369 | &1000004,2000004,1000005,2000005,1000006,2000006, | |
32370 | &1000011,2000011,1000012,2000012,1000013,2000013, | |
32371 | &1000014,2000014,1000015,2000015,1000016,2000016, | |
32372 | &1000021,1000022,1000023,1000025,1000035,1000024, | |
32373 | &1000037,1000039, 25, 35, 36, 37/ | |
32374 | DATA INIT/0/ | |
32375 | ||
32376 | C...Do nothing if SUSY not requested. | |
32377 | IMSSM=IMSS(1) | |
32378 | IF(IMSSM.EQ.0) RETURN | |
32379 | ||
32380 | C...Save copy of MWID(KC) and MDCY(KC,1) values before | |
32381 | C...they are set to zero for the LSP. | |
32382 | IF(INIT.EQ.0) THEN | |
32383 | INIT=1 | |
32384 | DO 100 I=1,36 | |
32385 | KF=KFSUSY(I) | |
32386 | KC=PYCOMP(KF) | |
32387 | MWIDSU(I)=MWID(KC) | |
32388 | MDCYSU(I)=MDCY(KC,1) | |
32389 | 100 CONTINUE | |
32390 | ENDIF | |
32391 | ||
32392 | C...Restore MWID(KC) and MDCY(KC,1) values previously zeroed for LSP. | |
32393 | DO 110 I=1,36 | |
32394 | KF=KFSUSY(I) | |
32395 | KC=PYCOMP(KF) | |
32396 | IF(MDCY(KC,1).EQ.0.AND.MDCYSU(I).NE.0) THEN | |
32397 | MWID(KC)=MWIDSU(I) | |
32398 | MDCY(KC,1)=MDCYSU(I) | |
32399 | ENDIF | |
32400 | 110 CONTINUE | |
32401 | ||
32402 | C...First part of routine: set masses and couplings. | |
32403 | ||
32404 | C...Reset mixing values in sfermion sector to pure left/right. | |
32405 | DO 120 I=1,16 | |
32406 | SFMIX(I,1)=1D0 | |
32407 | SFMIX(I,4)=1D0 | |
32408 | SFMIX(I,2)=0D0 | |
32409 | SFMIX(I,3)=0D0 | |
32410 | 120 CONTINUE | |
32411 | ||
32412 | C...Common couplings. | |
32413 | TANB=RMSS(5) | |
32414 | BETA=ATAN(TANB) | |
32415 | COSB=COS(BETA) | |
32416 | SINB=TANB*COSB | |
32417 | COS2B=COS(2D0*BETA) | |
32418 | ALFA=RMSS(18) | |
32419 | XMW2=PMAS(24,1)**2 | |
32420 | XMZ2=PMAS(23,1)**2 | |
32421 | XW=PARU(102) | |
32422 | ||
32423 | C...Define sparticle masses for a general MSSM simulation. | |
32424 | IF(IMSSM.EQ.1) THEN | |
32425 | IF(IMSS(9).EQ.0) RMSS(22)=RMSS(9) | |
32426 | DO 130 I=1,5,2 | |
32427 | KC=PYCOMP(KSUSY1+I) | |
32428 | PMAS(KC,1)=SQRT(RMSS(8)**2-(2D0*XMW2+XMZ2)*COS2B/6D0) | |
32429 | KC=PYCOMP(KSUSY2+I) | |
32430 | PMAS(KC,1)=SQRT(RMSS(9)**2+(XMW2-XMZ2)*COS2B/3D0) | |
32431 | KC=PYCOMP(KSUSY1+I+1) | |
32432 | PMAS(KC,1)=SQRT(RMSS(8)**2+(4D0*XMW2-XMZ2)*COS2B/6D0) | |
32433 | KC=PYCOMP(KSUSY2+I+1) | |
32434 | PMAS(KC,1)=SQRT(RMSS(22)**2-(XMW2-XMZ2)*COS2B*2D0/3D0) | |
32435 | 130 CONTINUE | |
32436 | XARG=RMSS(6)**2-PMAS(24,1)**2*ABS(COS(2D0*BETA)) | |
32437 | IF(XARG.LT.0D0) THEN | |
32438 | WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'// | |
32439 | & ' FROM THE SUM RULE. ' | |
32440 | WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). ' | |
32441 | RETURN | |
32442 | ELSE | |
32443 | XARG=SQRT(XARG) | |
32444 | ENDIF | |
32445 | DO 140 I=11,15,2 | |
32446 | PMAS(PYCOMP(KSUSY1+I),1)=RMSS(6) | |
32447 | PMAS(PYCOMP(KSUSY2+I),1)=RMSS(7) | |
32448 | PMAS(PYCOMP(KSUSY1+I+1),1)=XARG | |
32449 | PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0 | |
32450 | 140 CONTINUE | |
32451 | IF(IMSS(8).EQ.1) THEN | |
32452 | RMSS(13)=RMSS(6) | |
32453 | RMSS(14)=RMSS(7) | |
32454 | ENDIF | |
32455 | ||
32456 | C...Alternatively derive masses from SUGRA relations. | |
32457 | ELSEIF(IMSSM.EQ.2) THEN | |
32458 | CALL PYAPPS | |
32459 | C...Or use ISASUSY | |
32460 | ELSEIF(IMSSM.EQ.12) THEN | |
32461 | CALL PYSUGI | |
32462 | ALFA=RMSS(18) | |
32463 | GOTO 170 | |
32464 | ENDIF | |
32465 | ||
32466 | C...Add in extra D-term contributions. | |
32467 | IF(IMSS(7).EQ.1) THEN | |
32468 | R=0.43D0 | |
32469 | DX=RMSS(23) | |
32470 | DY=RMSS(24) | |
32471 | DS=RMSS(25) | |
32472 | WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' | |
32473 | WRITE(MSTU(11),*) 'C NEW DTERMS ADDED TO SCALAR MASSES ' | |
32474 | WRITE(MSTU(11),*) 'C IN A U(B-L) THEORY ' | |
32475 | WRITE(MSTU(11),*) 'C DX = ',DX | |
32476 | WRITE(MSTU(11),*) 'C DY = ',DY | |
32477 | WRITE(MSTU(11),*) 'C DS = ',DS | |
32478 | WRITE(MSTU(11),*) 'C ' | |
32479 | DY=R*DY-4D0/33D0*(1D0-R)*DX+(1D0-R)/33D0*DS | |
32480 | WRITE(MSTU(11),*) 'C DY AT THE WEAK SCALE = ',DY | |
32481 | WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' | |
32482 | DQ2=DY/6D0-DX/3D0-DS/3D0 | |
32483 | DU2=-2D0*DY/3D0-DX/3D0-DS/3D0 | |
32484 | DD2=DY/3D0+DX-2D0*DS/3D0 | |
32485 | DL2=-DY/2D0+DX-2D0*DS/3D0 | |
32486 | DE2=DY-DX/3D0-DS/3D0 | |
32487 | DHU2=DY/2D0+2D0*DX/3D0+2D0*DS/3D0 | |
32488 | DHD2=-DY/2D0-2D0*DX/3D0+DS | |
32489 | DMU2=(-DY/2D0-2D0/3D0*DX+(COSB**2-2D0*SINB**2/3D0)*DS) | |
32490 | & /ABS(COS2B) | |
32491 | DMA2 = 2D0*DMU2+DHU2+DHD2 | |
32492 | DO 150 I=1,5,2 | |
32493 | KC=PYCOMP(KSUSY1+I) | |
32494 | PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DQ2) | |
32495 | KC=PYCOMP(KSUSY2+I) | |
32496 | PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DD2) | |
32497 | KC=PYCOMP(KSUSY1+I+1) | |
32498 | PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DQ2) | |
32499 | KC=PYCOMP(KSUSY2+I+1) | |
32500 | PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DU2) | |
32501 | 150 CONTINUE | |
32502 | DO 160 I=11,15,2 | |
32503 | KC=PYCOMP(KSUSY1+I) | |
32504 | PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DL2) | |
32505 | KC=PYCOMP(KSUSY2+I) | |
32506 | PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DE2) | |
32507 | KC=PYCOMP(KSUSY1+I+1) | |
32508 | PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DL2) | |
32509 | 160 CONTINUE | |
32510 | IF(RMSS(4)**2+DMU2.LT.0D0) THEN | |
32511 | WRITE(MSTU(11),*) ' MU2 DRIVEN NEGATIVE ' | |
32512 | STOP | |
32513 | ENDIF | |
32514 | SGNMU=SIGN(1D0,RMSS(4)) | |
32515 | RMSS(4)=SGNMU*SQRT(RMSS(4)**2+DMU2) | |
32516 | ARG=RMSS(10)**2*SIGN(1D0,RMSS(10))+DQ2 | |
32517 | RMSS(10)=SIGN(SQRT(ABS(ARG)),ARG) | |
32518 | ARG=RMSS(11)**2*SIGN(1D0,RMSS(11))+DD2 | |
32519 | RMSS(11)=SIGN(SQRT(ABS(ARG)),ARG) | |
32520 | ARG=RMSS(12)**2*SIGN(1D0,RMSS(12))+DU2 | |
32521 | RMSS(12)=SIGN(SQRT(ABS(ARG)),ARG) | |
32522 | ARG=RMSS(13)**2*SIGN(1D0,RMSS(13))+DL2 | |
32523 | RMSS(13)=SIGN(SQRT(ABS(ARG)),ARG) | |
32524 | ARG=RMSS(14)**2*SIGN(1D0,RMSS(14))+DE2 | |
32525 | RMSS(14)=SIGN(SQRT(ABS(ARG)),ARG) | |
32526 | IF( RMSS(19)**2 + DMA2 .LE. 50D0 ) THEN | |
32527 | WRITE(MSTU(11),*) ' MA DRIVEN TOO LOW ' | |
32528 | STOP | |
32529 | ENDIF | |
32530 | RMSS(19)=SQRT(RMSS(19)**2+DMA2) | |
32531 | RMSS(6)=SQRT(RMSS(6)**2+DL2) | |
32532 | RMSS(7)=SQRT(RMSS(7)**2+DE2) | |
32533 | WRITE(MSTU(11),*) ' MTL = ',RMSS(10) | |
32534 | WRITE(MSTU(11),*) ' MBR = ',RMSS(11) | |
32535 | WRITE(MSTU(11),*) ' MTR = ',RMSS(12) | |
32536 | WRITE(MSTU(11),*) ' SEL = ',RMSS(6),RMSS(13) | |
32537 | WRITE(MSTU(11),*) ' SER = ',RMSS(7),RMSS(14) | |
32538 | ENDIF | |
32539 | ||
32540 | C...Fix the third generation sfermions. | |
32541 | CALL PYTHRG | |
32542 | ||
32543 | C...Fix the neutralino--chargino--gluino sector. | |
32544 | CALL PYINOM | |
32545 | ||
32546 | C...Fix the Higgs sector. | |
32547 | CALL PYHGGM(ALFA) | |
32548 | ||
32549 | C...Choose the Gunion-Haber convention. | |
32550 | ALFA=-ALFA | |
32551 | RMSS(18)=ALFA | |
32552 | ||
32553 | C...Print information on mass parameters. | |
32554 | IF(IMSSM.EQ.2.AND.MSTP(122).GT.0) THEN | |
32555 | WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' | |
32556 | WRITE(MSTU(11),*) ' USING APPROXIMATE SUGRA RELATIONS ' | |
32557 | WRITE(MSTU(11),*) ' M0 = ',RMSS(8) | |
32558 | WRITE(MSTU(11),*) ' M1/2=',RMSS(1) | |
32559 | WRITE(MSTU(11),*) ' TANB=',RMSS(5) | |
32560 | WRITE(MSTU(11),*) ' MU = ',RMSS(4) | |
32561 | WRITE(MSTU(11),*) ' AT = ',RMSS(16) | |
32562 | WRITE(MSTU(11),*) ' MA = ',RMSS(19) | |
32563 | WRITE(MSTU(11),*) ' MTOP=',PMAS(6,1) | |
32564 | WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' | |
32565 | ENDIF | |
32566 | IF(IMSS(20).EQ.1) THEN | |
32567 | WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' | |
32568 | WRITE(MSTU(11),*) ' DEBUG MODE ' | |
32569 | WRITE(MSTU(11),*) ' UMIX = ',UMIX(1,1),UMIX(1,2), | |
32570 | & UMIX(2,1),UMIX(2,2) | |
32571 | WRITE(MSTU(11),*) ' UMIXI = ',UMIXI(1,1),UMIXI(1,2), | |
32572 | & UMIXI(2,1),UMIXI(2,2) | |
32573 | WRITE(MSTU(11),*) ' VMIX = ',VMIX(1,1),VMIX(1,2), | |
32574 | & VMIX(2,1),VMIX(2,2) | |
32575 | WRITE(MSTU(11),*) ' VMIXI = ',VMIXI(1,1),VMIXI(1,2), | |
32576 | & VMIXI(2,1),VMIXI(2,2) | |
32577 | WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(1,I),I=1,4) | |
32578 | WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(1,I),I=1,4) | |
32579 | WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(2,I),I=1,4) | |
32580 | WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(2,I),I=1,4) | |
32581 | WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(3,I),I=1,4) | |
32582 | WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(3,I),I=1,4) | |
32583 | WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(4,I),I=1,4) | |
32584 | WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(4,I),I=1,4) | |
32585 | WRITE(MSTU(11),*) ' ALFA = ',ALFA | |
32586 | WRITE(MSTU(11),*) ' BETA = ',BETA | |
32587 | WRITE(MSTU(11),*) ' STOP = ',(SFMIX(6,I),I=1,4) | |
32588 | WRITE(MSTU(11),*) ' SBOT = ',(SFMIX(5,I),I=1,4) | |
32589 | WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' | |
32590 | ENDIF | |
32591 | ||
32592 | C...Set up the Higgs couplings - needed here since initialization | |
32593 | C...in PYINRE did not yet occur when PYWIDT is called below. | |
32594 | 170 AL=ALFA | |
32595 | BE=BETA | |
32596 | SINA=SIN(AL) | |
32597 | COSA=COS(AL) | |
32598 | COSB=COS(BE) | |
32599 | SINB=TANB*COSB | |
32600 | SBMA=SIN(BE-AL) | |
32601 | SAPB=SIN(AL+BE) | |
32602 | CAPB=COS(AL+BE) | |
32603 | CBMA=COS(BE-AL) | |
32604 | C2A=COS(2D0*AL) | |
32605 | C2B=COSB**2-SINB**2 | |
32606 | C...tanb (used for H+) | |
32607 | PARU(141)=TANB | |
32608 | ||
32609 | C...Firstly: h | |
32610 | C...Coupling to d-type quarks | |
32611 | PARU(161)=SINA/COSB | |
32612 | C...Coupling to u-type quarks | |
32613 | PARU(162)=-COSA/SINB | |
32614 | C...Coupling to leptons | |
32615 | PARU(163)=PARU(161) | |
32616 | C...Coupling to Z | |
32617 | PARU(164)=SBMA | |
32618 | C...Coupling to W | |
32619 | PARU(165)=PARU(164) | |
32620 | ||
32621 | C...Secondly: H | |
32622 | C...Coupling to d-type quarks | |
32623 | PARU(171)=-COSA/COSB | |
32624 | C...Coupling to u-type quarks | |
32625 | PARU(172)=-SINA/SINB | |
32626 | C...Coupling to leptons | |
32627 | PARU(173)=PARU(171) | |
32628 | C...Coupling to Z | |
32629 | PARU(174)=CBMA | |
32630 | C...Coupling to W | |
32631 | PARU(175)=PARU(174) | |
32632 | C...Coupling to h | |
32633 | IF(IMSS(4).EQ.2) THEN | |
32634 | PARU(176)=COS(2D0*AL)*COS(BE+AL)-2D0*SIN(2D0*AL)*SIN(BE+AL) | |
32635 | ELSE | |
32636 | HHH(3)=HHH(3)+HHH(4)+HHH(5) | |
32637 | PARU(176)=-3D0/HHH(1)*(HHH(1)*SINA**2*COSB*COSA+ | |
32638 | 1 HHH(2)*COSA**2*SINB*SINA+HHH(3)*(SINA**3*SINB+COSA**3*COSB- | |
32639 | 2 2D0/3D0*CBMA)-HHH(6)*SINA*(COSB*C2A+COSA*CAPB)+ | |
32640 | 3 HHH(7)*COSA*(SINB*C2A+SINA*CAPB)) | |
32641 | ENDIF | |
32642 | C...Coupling to H+ | |
32643 | C...Define later | |
32644 | IF(IMSS(4).EQ.2) THEN | |
32645 | PARU(168)=-SBMA-COS(2D0*BE)*SAPB/2D0/(1D0-XW) | |
32646 | ELSE | |
32647 | PARU(168)=1D0/HHH(1)*(HHH(1)*SINB**2*COSB*SINA- | |
32648 | 1 HHH(2)*COSB**2*SINB*COSA-HHH(3)*(SINB**3*COSA-COSB**3*SINA)+ | |
32649 | 2 2D0*HHH(5)*SBMA-HHH(6)*SINB*(COSB*SAPB+SINA*C2B)- | |
32650 | 3 HHH(7)*COSB*(COSA*C2B-SINB*SAPB)-(HHH(5)-HHH(4))*SBMA) | |
32651 | ENDIF | |
32652 | C...Coupling to A | |
32653 | IF(IMSS(4).EQ.2) THEN | |
32654 | PARU(177)=COS(2D0*BE)*COS(BE+AL) | |
32655 | ELSE | |
32656 | PARU(177)=-1D0/HHH(1)*(HHH(1)*SINB**2*COSB*COSA+ | |
32657 | 1 HHH(2)*COSB**2*SINB*SINA+HHH(3)*(SINB**3*SINA+COSB**3*COSA)- | |
32658 | 2 2D0*HHH(5)*CBMA-HHH(6)*SINB*(COSB*CAPB+COSA*C2B)+ | |
32659 | 3 HHH(7)*COSB*(SINB*CAPB+SINA*C2B)) | |
32660 | ENDIF | |
32661 | C...Coupling to H+ | |
32662 | IF(IMSS(4).EQ.2) THEN | |
32663 | PARU(178)=PARU(177) | |
32664 | ELSE | |
32665 | PARU(178)=PARU(177)-(HHH(5)-HHH(4))/HHH(1)*CBMA | |
32666 | ENDIF | |
32667 | C...Thirdly, A | |
32668 | C...Coupling to d-type quarks | |
32669 | PARU(181)=TANB | |
32670 | C...Coupling to u-type quarks | |
32671 | PARU(182)=1D0/PARU(181) | |
32672 | C...Coupling to leptons | |
32673 | PARU(183)=PARU(181) | |
32674 | PARU(184)=0D0 | |
32675 | PARU(185)=0D0 | |
32676 | C...Coupling to Z h | |
32677 | PARU(186)=COS(BE-AL) | |
32678 | C...Coupling to Z H | |
32679 | PARU(187)=SIN(BE-AL) | |
32680 | PARU(188)=0D0 | |
32681 | PARU(189)=0D0 | |
32682 | PARU(190)=0D0 | |
32683 | ||
32684 | C...Finally: H+ | |
32685 | C...Coupling to W h | |
32686 | PARU(195)=COS(BE-AL) | |
32687 | ||
32688 | C...Tell that all Higgs couplings have been set. | |
32689 | MSTP(4)=1 | |
32690 | ||
32691 | C...Set R-Violating couplings. | |
32692 | C...Set lambda couplings to common value or "natural values". | |
32693 | IF ((IMSS(51).NE.3).AND.(IMSS(51).NE.0)) THEN | |
32694 | VIR3=1D0/(126D0)**3 | |
32695 | DO 200 IRK=1,3 | |
32696 | DO 190 IRI=1,3 | |
32697 | DO 180 IRJ=1,3 | |
32698 | IF (IRI.NE.IRJ) THEN | |
32699 | IF (IRI.LT.IRJ) THEN | |
32700 | RVLAM(IRI,IRJ,IRK)=RMSS(51) | |
32701 | IF (IMSS(51).EQ.2) RVLAM(IRI,IRJ,IRK)=RMSS(51)* | |
32702 | & SQRT(PMAS(9+2*IRI,1)*PMAS(9+2*IRJ,1)* | |
32703 | & PMAS(9+2*IRK,1)*VIR3) | |
32704 | ELSE | |
32705 | RVLAM(IRI,IRJ,IRK)=-RVLAM(IRJ,IRI,IRK) | |
32706 | ENDIF | |
32707 | ELSE | |
32708 | RVLAM(IRI,IRJ,IRK)=0D0 | |
32709 | ENDIF | |
32710 | 180 CONTINUE | |
32711 | 190 CONTINUE | |
32712 | 200 CONTINUE | |
32713 | ENDIF | |
32714 | C...Set lambda' couplings to common value or "natural values". | |
32715 | IF ((IMSS(52).NE.3).AND.(IMSS(52).NE.0)) THEN | |
32716 | VIR3=1D0/(126D0)**3 | |
32717 | DO 230 IRI=1,3 | |
32718 | DO 220 IRJ=1,3 | |
32719 | DO 210 IRK=1,3 | |
32720 | RVLAMP(IRI,IRJ,IRK)=RMSS(52) | |
32721 | IF (IMSS(52).EQ.2) RVLAMP(IRI,IRJ,IRK)=RMSS(52)* | |
32722 | & SQRT(PMAS(9+2*IRI,1)*0.5D0*(PMAS(2*IRJ,1)+ | |
32723 | & PMAS(2*IRJ-1,1))*PMAS(2*IRK-1,1)*VIR3) | |
32724 | 210 CONTINUE | |
32725 | 220 CONTINUE | |
32726 | 230 CONTINUE | |
32727 | ENDIF | |
32728 | C...Set lambda'' couplings to common value or "natural values". | |
32729 | IF ((IMSS(53).NE.3).AND.(IMSS(53).NE.0)) THEN | |
32730 | VIR3=1D0/(126D0)**3 | |
32731 | DO 260 IRI=1,3 | |
32732 | DO 250 IRJ=1,3 | |
32733 | DO 240 IRK=1,3 | |
32734 | IF (IRJ.NE.IRK) THEN | |
32735 | IF (IRJ.LT.IRK) THEN | |
32736 | RVLAMB(IRI,IRJ,IRK)=RMSS(53) | |
32737 | IF (IMSS(53).EQ.2) RVLAMB(IRI,IRJ,IRK)= | |
32738 | & RMSS(53)*SQRT(PMAS(2*IRI,1)*PMAS(2*IRJ-1,1)* | |
32739 | & PMAS(2*IRK-1,1)*VIR3) | |
32740 | ELSE | |
32741 | RVLAMB(IRI,IRJ,IRK)=-RVLAMB(IRI,IRK,IRJ) | |
32742 | ENDIF | |
32743 | ELSE | |
32744 | RVLAMB(IRI,IRJ,IRK) = 0D0 | |
32745 | ENDIF | |
32746 | 240 CONTINUE | |
32747 | 250 CONTINUE | |
32748 | 260 CONTINUE | |
32749 | ENDIF | |
32750 | ||
32751 | C...Antisymmetrize couplings set by user | |
32752 | IF (IMSS(51).EQ.3.OR.IMSS(53).EQ.3) THEN | |
32753 | DO 290 IRI=1,3 | |
32754 | DO 280 IRJ=1,3 | |
32755 | DO 270 IRK=1,3 | |
32756 | IF (RVLAM(IRI,IRJ,IRK).NE.-RVLAM(IRJ,IRI,IRK)) THEN | |
32757 | RVLAM(IRJ,IRI,IRK)=-RVLAM(IRI,IRJ,IRK) | |
32758 | IF (IRI.EQ.IRJ) RVLAM(IRI,IRJ,IRK)=0D0 | |
32759 | ENDIF | |
32760 | IF (RVLAMB(IRI,IRJ,IRK).NE.-RVLAMB(IRI,IRK,IRJ)) THEN | |
32761 | RVLAMB(IRI,IRK,IRJ)=-RVLAMB(IRI,IRJ,IRK) | |
32762 | IF (IRJ.EQ.IRK) RVLAMB(IRI,IRJ,IRK)=0D0 | |
32763 | ENDIF | |
32764 | 270 CONTINUE | |
32765 | 280 CONTINUE | |
32766 | 290 CONTINUE | |
32767 | ENDIF | |
32768 | ||
32769 | C...Second part of routine: set decay modes and branching ratios. | |
32770 | ||
32771 | C...Allow chi10 -> gravitino + gamma or not. | |
32772 | KC=PYCOMP(KSUSY1+39) | |
32773 | IF( IMSS(11) .NE. 0 ) THEN | |
32774 | PMAS(KC,1)=RMSS(21)/1000000000D0 | |
32775 | PMAS(KC,2)=0.0001D0 | |
32776 | IRPRTY=0 | |
32777 | WRITE(MSTU(11),*) ' ALLOWING DECAYS TO GRAVITINOS ' | |
32778 | ELSE IF (IMSS(51).GE.1.OR.IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN | |
32779 | IRPRTY=0 | |
32780 | IF (IMSS(51).GE.1) WRITE(MSTU(11),*) | |
32781 | & ' ALLOWING SUSY LLE DECAYS' | |
32782 | IF (IMSS(52).GE.1) WRITE(MSTU(11),*) | |
32783 | & ' ALLOWING SUSY LQD DECAYS' | |
32784 | IF (IMSS(53).GE.1) WRITE(MSTU(11),*) | |
32785 | & ' ALLOWING SUSY UDD DECAYS' | |
32786 | IF (IMSS(53).GE.1.AND.IMSS(52).GE.1) WRITE(MSTU(11),*) | |
32787 | & ' --- Warning: R-Violating couplings possibly', | |
32788 | & ' incompatible with proton decay' | |
32789 | ELSE | |
32790 | PMAS(KC,1)=9999D0 | |
32791 | IRPRTY=1 | |
32792 | ENDIF | |
32793 | ||
32794 | C...Loop over sparticle and Higgs species. | |
32795 | PMCHI1=PMAS(PYCOMP(KSUSY1+22),1) | |
32796 | C...Find the LSP or NLSP for a gravitino LSP | |
32797 | ILSP=0 | |
32798 | PMLSP=1D20 | |
32799 | DO 300 I=1,36 | |
32800 | KF=KFSUSY(I) | |
32801 | IF(KF.EQ.1000039) GOTO 300 | |
32802 | KC=PYCOMP(KF) | |
32803 | IF(PMAS(KC,1).LT.PMLSP) THEN | |
32804 | ILSP=I | |
32805 | PMLSP=PMAS(KC,1) | |
32806 | ENDIF | |
32807 | 300 CONTINUE | |
32808 | DO 370 I=1,36 | |
32809 | KF=KFSUSY(I) | |
32810 | KC=PYCOMP(KF) | |
32811 | LKNT=0 | |
32812 | ||
32813 | C...Sfermion decays. | |
32814 | IF(I.LE.24) THEN | |
32815 | C...First check to see if sneutrino is lighter than chi10. | |
32816 | IF((I.EQ.15.OR.I.EQ.19.OR.I.EQ.23).AND. | |
32817 | & PMAS(KC,1).LT.PMCHI1) THEN | |
32818 | ELSE | |
32819 | CALL PYSFDC(KF,XLAM,IDLAM,LKNT) | |
32820 | ENDIF | |
32821 | ||
32822 | C...Gluino decays. | |
32823 | ELSEIF(I.EQ.25) THEN | |
32824 | CALL PYGLUI(KF,XLAM,IDLAM,LKNT) | |
32825 | IF(I.EQ.ILSP.AND.IRPRTY.EQ.1) LKNT=0 | |
32826 | ||
32827 | C...Neutralino decays. | |
32828 | ELSEIF(I.GE.26.AND.I.LE.29) THEN | |
32829 | CALL PYNJDC(KF,XLAM,IDLAM,LKNT) | |
32830 | C...chi10 stable or chi10 -> gravitino + gamma. | |
32831 | IF(I.EQ.26.AND.IRPRTY.EQ.1) THEN | |
32832 | PMAS(KC,2)=1D-6 | |
32833 | MDCY(KC,1)=0 | |
32834 | MWID(KC)=0 | |
32835 | ENDIF | |
32836 | ||
32837 | C...Chargino decays. | |
32838 | ELSEIF(I.GE.30.AND.I.LE.31) THEN | |
32839 | CALL PYCJDC(KF,XLAM,IDLAM,LKNT) | |
32840 | ||
32841 | C...Gravitino is stable. | |
32842 | ELSEIF(I.EQ.32) THEN | |
32843 | MDCY(KC,1)=0 | |
32844 | MWID(KC)=0 | |
32845 | ||
32846 | C...Higgs decays. | |
32847 | ELSEIF(I.GE.33.AND.I.LE.36) THEN | |
32848 | C...Calculate decays to non-SUSY particles. | |
32849 | CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE) | |
32850 | LKNT=0 | |
32851 | DO 310 I1=0,100 | |
32852 | XLAM(I1)=0D0 | |
32853 | 310 CONTINUE | |
32854 | DO 330 I1=1,MDCY(KC,3) | |
32855 | K1=MDCY(KC,2)+I1-1 | |
32856 | IF(IABS(KFDP(K1,1)).GT.KSUSY1.OR. | |
32857 | & IABS(KFDP(K1,2)).GT.KSUSY1) GOTO 330 | |
32858 | XLAM(I1)=WDTP(I1) | |
32859 | XLAM(0)=XLAM(0)+XLAM(I1) | |
32860 | DO 320 J1=1,3 | |
32861 | IDLAM(I1,J1)=KFDP(K1,J1) | |
32862 | 320 CONTINUE | |
32863 | LKNT=LKNT+1 | |
32864 | 330 CONTINUE | |
32865 | C...Add the decays to SUSY particles. | |
32866 | CALL PYHEXT(KF,XLAM,IDLAM,LKNT) | |
32867 | ENDIF | |
32868 | C...Zero the branching ratios for use in loop mode | |
32869 | C...thanks to K. Matchev (FNAL) | |
32870 | DO 340 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 | |
32871 | BRAT(IDC)=0D0 | |
32872 | 340 CONTINUE | |
32873 | ||
32874 | C...Set stable particles. | |
32875 | IF(LKNT.EQ.0) THEN | |
32876 | MDCY(KC,1)=0 | |
32877 | MWID(KC)=0 | |
32878 | PMAS(KC,2)=1D-6 | |
32879 | PMAS(KC,3)=1D-5 | |
32880 | PMAS(KC,4)=0D0 | |
32881 | ||
32882 | C...Store branching ratios in the standard tables. | |
32883 | ELSE | |
32884 | IDC=MDCY(KC,2)+MDCY(KC,3)-1 | |
32885 | DELM=1D6 | |
32886 | DO 360 IL=1,LKNT | |
32887 | IDCSV=IDC | |
32888 | 350 IDC=IDC+1 | |
32889 | BRAT(IDC)=0D0 | |
32890 | IF(IDC.EQ.MDCY(KC,2)+MDCY(KC,3)) IDC=MDCY(KC,2) | |
32891 | IF(IDLAM(IL,1).EQ.KFDP(IDC,1).AND.IDLAM(IL,2).EQ. | |
32892 | & KFDP(IDC,2).AND.IDLAM(IL,3).EQ.KFDP(IDC,3)) THEN | |
32893 | BRAT(IDC)=XLAM(IL)/XLAM(0) | |
32894 | XMDIF=PMAS(KC,1) | |
32895 | IF(MDME(IDC,1).GE.1) THEN | |
32896 | XMDIF=XMDIF-PMAS(PYCOMP(KFDP(IDC,1)),1)- | |
32897 | & PMAS(PYCOMP(KFDP(IDC,2)),1) | |
32898 | IF(KFDP(IDC,3).NE.0) XMDIF=XMDIF- | |
32899 | & PMAS(PYCOMP(KFDP(IDC,3)),1) | |
32900 | ENDIF | |
32901 | IF(I.LE.32) THEN | |
32902 | IF(XMDIF.GE.0D0) THEN | |
32903 | DELM=MIN(DELM,XMDIF) | |
32904 | ELSE | |
32905 | WRITE(MSTU(11),*) ' ERROR WITH DELM ',DELM,XMDIF | |
32906 | WRITE(MSTU(11),*) ' KF = ',KF | |
32907 | WRITE(MSTU(11),*) ' KF(decay) = ',(KFDP(IDC,J),J=1,3) | |
32908 | ENDIF | |
32909 | ENDIF | |
32910 | GOTO 360 | |
32911 | ELSEIF(IDC.EQ.IDCSV) THEN | |
32912 | WRITE(MSTU(11),*) ' Error in PYMSIN: SUSY decay ', | |
32913 | & 'channel not recognized:' | |
32914 | WRITE(MSTU(11),*) KF,' -> ',(IDLAM(I,J),J=1,3) | |
32915 | GOTO 360 | |
32916 | ELSE | |
32917 | GOTO 350 | |
32918 | ENDIF | |
32919 | 360 CONTINUE | |
32920 | ||
32921 | C...Store width, cutoff and lifetime. | |
32922 | PMAS(KC,2)=XLAM(0) | |
32923 | IF(PMAS(KC,2).LT.0.1D0*DELM) THEN | |
32924 | PMAS(KC,3)=PMAS(KC,2)*10D0 | |
32925 | ELSE | |
32926 | PMAS(KC,3)=0.95D0*DELM | |
32927 | ENDIF | |
32928 | IF(PMAS(KC,2).NE.0D0) THEN | |
32929 | PMAS(KC,4)=PARU(3)/PMAS(KC,2)*1D-12 | |
32930 | ENDIF | |
32931 | ENDIF | |
32932 | 370 CONTINUE | |
32933 | ||
32934 | RETURN | |
32935 | END | |
32936 | ||
32937 | C********************************************************************* | |
32938 | ||
32939 | C...PYAPPS | |
32940 | C...Uses approximate analytical formulae to determine the full set of | |
32941 | C...MSSM parameters from SUGRA input. | |
32942 | C...See M. Drees and S.P. Martin, hep-ph/9504124 | |
32943 | ||
32944 | SUBROUTINE PYAPPS | |
32945 | ||
32946 | C...Double precision and integer declarations. | |
32947 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
32948 | IMPLICIT INTEGER(I-N) | |
32949 | INTEGER PYK,PYCHGE,PYCOMP | |
32950 | C...Parameter statement to help give large particle numbers. | |
32951 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
32952 | &KEXCIT=4000000,KDIMEN=5000000) | |
32953 | C...Commonblocks. | |
32954 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
32955 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
32956 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
32957 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/ | |
32958 | ||
32959 | IMSS(5)=0 | |
32960 | IMSS(8)=0 | |
32961 | XMT=PMAS(6,1) | |
32962 | XMZ2=PMAS(23,1)**2 | |
32963 | XMW2=PMAS(24,1)**2 | |
32964 | TANB=RMSS(5) | |
32965 | BETA=ATAN(TANB) | |
32966 | XW=PARU(102) | |
32967 | XMG=RMSS(1) | |
32968 | XMG2=XMG*XMG | |
32969 | XM0=RMSS(8) | |
32970 | XM02=XM0*XM0 | |
32971 | AT=-RMSS(16) | |
32972 | RMSS(15)=AT | |
32973 | RMSS(17)=AT | |
32974 | SINB=TANB/SQRT(TANB**2+1D0) | |
32975 | COSB=SINB/TANB | |
32976 | ||
32977 | DTERM=XMZ2*COS(2D0*BETA) | |
32978 | XMER=SQRT(XM02+0.15D0*XMG2-XW*DTERM) | |
32979 | XMEL=SQRT(XM02+0.52D0*XMG2-(0.5D0-XW)*DTERM) | |
32980 | RMSS(6)=XMEL | |
32981 | RMSS(7)=XMER | |
32982 | XMUR=SQRT(PYRNMQ(2,2D0/3D0*XW*DTERM)) | |
32983 | XMDR=SQRT(PYRNMQ(3,-1D0/3D0*XW*DTERM)) | |
32984 | XMUL=SQRT(PYRNMQ(1,(0.5D0-2D0/3D0*XW)*DTERM)) | |
32985 | XMDL=SQRT(PYRNMQ(1,-(0.5D0-1D0/3D0*XW)*DTERM)) | |
32986 | DO 100 I=1,5,2 | |
32987 | PMAS(PYCOMP(KSUSY1+I),1)=XMDL | |
32988 | PMAS(PYCOMP(KSUSY2+I),1)=XMDR | |
32989 | PMAS(PYCOMP(KSUSY1+I+1),1)=XMUL | |
32990 | PMAS(PYCOMP(KSUSY2+I+1),1)=XMUR | |
32991 | 100 CONTINUE | |
32992 | XARG=XMEL**2-XMW2*ABS(COS(2D0*BETA)) | |
32993 | IF(XARG.LT.0D0) THEN | |
32994 | WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'// | |
32995 | & ' FROM THE SUM RULE. ' | |
32996 | WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). ' | |
32997 | RETURN | |
32998 | ELSE | |
32999 | XARG=SQRT(XARG) | |
33000 | ENDIF | |
33001 | DO 110 I=11,15,2 | |
33002 | PMAS(PYCOMP(KSUSY1+I),1)=XMEL | |
33003 | PMAS(PYCOMP(KSUSY2+I),1)=XMER | |
33004 | PMAS(PYCOMP(KSUSY1+I+1),1)=XARG | |
33005 | PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0 | |
33006 | 110 CONTINUE | |
33007 | RMT=PYMRUN(6,PMAS(6,1)**2) | |
33008 | XTOP=(RMT/150D0/SINB)**2*(.9D0*XM02+2.1D0*XMG2+ | |
33009 | &(1D0-(RMT/190D0/SINB)**3)*(.24D0*AT**2+AT*XMG)) | |
33010 | RMB=PYMRUN(5,PMAS(6,1)**2) | |
33011 | XBOT=(RMB/150D0/COSB)**2*(.9D0*XM02+2.1D0*XMG2+ | |
33012 | &(1D0-(RMB/190D0/COSB)**3)*(.24D0*AT**2+AT*XMG)) | |
33013 | XTAU=1D-4/COSB**2*(XM02+0.15D0*XMG2+AT**2/3D0) | |
33014 | ATP=AT*(1D0-(RMT/190D0/SINB)**2)+XMG*(3.47D0-1.9D0*(RMT/190D0/ | |
33015 | &SINB)**2) | |
33016 | RMSS(16)=-ATP | |
33017 | XMU2=-.5D0*XMZ2+(SINB**2*(XM02+.52D0*XMG2-XTOP)- | |
33018 | &COSB**2*(XM02+.52D0*XMG2-XBOT-XTAU/3D0))/(COSB**2-SINB**2) | |
33019 | XMA2=2D0*(XM02+.52D0*XMG2+XMU2)-XTOP-XBOT-XTAU/3D0 | |
33020 | XMU=SIGN(SQRT(XMU2),RMSS(4)) | |
33021 | RMSS(4)=XMU | |
33022 | IF(XMA2.GT.0D0) THEN | |
33023 | RMSS(19)=SQRT(XMA2) | |
33024 | ELSE | |
33025 | WRITE(MSTU(11),*) ' PYAPPS:: PSEUDOSCALAR MASS**2 < 0 ' | |
33026 | STOP | |
33027 | ENDIF | |
33028 | ARG=XM02+0.15D0*XMG2-2D0*XTAU/3D0-XW*DTERM | |
33029 | IF(ARG.GT.0D0) THEN | |
33030 | RMSS(14)=SQRT(ARG) | |
33031 | ELSE | |
33032 | WRITE(MSTU(11),*) ' PYAPPS:: RIGHT STAU MASS**2 < 0 ' | |
33033 | STOP | |
33034 | ENDIF | |
33035 | ARG=XM02+0.52D0*XMG2-XTAU/3D0-(0.5D0-XW)*DTERM | |
33036 | IF(ARG.GT.0D0) THEN | |
33037 | RMSS(13)=SQRT(ARG) | |
33038 | ELSE | |
33039 | WRITE(MSTU(11),*) ' PYAPPS:: LEFT STAU MASS**2 < 0 ' | |
33040 | STOP | |
33041 | ENDIF | |
33042 | ARG=PYRNMQ(1,-(XBOT+XTOP)/3D0) | |
33043 | IF(ARG.GT.0D0) THEN | |
33044 | RMSS(10)=SQRT(ARG) | |
33045 | ELSE | |
33046 | RMSS(10)=-SQRT(-ARG) | |
33047 | ENDIF | |
33048 | ARG=PYRNMQ(2,-2D0*XTOP/3D0) | |
33049 | IF(ARG.GT.0D0) THEN | |
33050 | RMSS(12)=SQRT(ARG) | |
33051 | ELSE | |
33052 | RMSS(12)=-SQRT(-ARG) | |
33053 | ENDIF | |
33054 | ARG=PYRNMQ(3,-2D0*XBOT/3D0) | |
33055 | IF(ARG.GT.0D0) THEN | |
33056 | RMSS(11)=SQRT(ARG) | |
33057 | ELSE | |
33058 | RMSS(11)=-SQRT(-ARG) | |
33059 | ENDIF | |
33060 | ||
33061 | RETURN | |
33062 | END | |
33063 | ||
33064 | C********************************************************************* | |
33065 | ||
33066 | C...PYSUGI | |
33067 | C...Interface to ISASUSY version 7.61. | |
33068 | C...Warning: if you use earlier versions, change dimension to | |
33069 | C...SUPER(66) in /SSPAR/ and remove MHPNEG and ASM3 from /SUGPAS/. | |
33070 | C...Calls SUGRA (in ISAJET) to perform RGE evolution. | |
33071 | C...Then converts to Gunion-Haber conventions. | |
33072 | ||
33073 | SUBROUTINE PYSUGI | |
33074 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
33075 | ||
33076 | INTEGER PYK,PYCHGE,PYCOMP | |
33077 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
33078 | &KEXCIT=4000000,KDIMEN=5000000) | |
33079 | ||
33080 | C...Date of Change | |
33081 | CHARACTER DOC*11 | |
33082 | PARAMETER (DOC='22 Nov 2002') | |
33083 | ||
33084 | C...ISASUGRA Input: | |
33085 | REAL MZERO,MHLF,AZERO,TANB,SGNMU,MTOP | |
33086 | C...ISASUGRA Output | |
33087 | CHARACTER*40 ISAVER,VISAJE | |
33088 | REAL SUPER | |
33089 | COMMON /SSPAR/ SUPER(69) | |
33090 | COMMON /SUGMG/ MSS(32),GSS(29),MGUTSS,GGUTSS,AGUTSS,FTGUT, | |
33091 | $FBGUT,FTAGUT,FNGUT | |
33092 | REAL MSS,GSS,MGUTSS,GGUTSS,AGUTSS,FTGUT,FBGUT,FTAGUT,FNGUT | |
33093 | COMMON /SUGPAS/ XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, | |
33094 | $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ, | |
33095 | $FNMZ,AMNRMJ,NOGOOD,IAL3UN,ITACHY,MHPNEG,ASM3 | |
33096 | REAL XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, | |
33097 | $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ, | |
33098 | $FNMZ,AMNRMJ,ASM3 | |
33099 | INTEGER NOGOOD,IAL3UN,ITACHY,MHPNEG | |
33100 | C SUPER: Filled by ISASUGRA. | |
33101 | C SUPER(1) = mass of ~g | |
33102 | C SUPER(2:17) = mass of ~u_L,~u_R,~d_L,~d_R,~s_L,~s_R,~c_L,~c_R,~b_L | |
33103 | C ,~b_R,~b_1,~b_2,~t_L,~t_R,~t_1,~t_2 | |
33104 | C SUPER(18:25) = mass of ~e_L,~e_R,~mu_L,~mu_R,~tau_L,~tau_R,~tau_1 | |
33105 | C ,~tau_2 | |
33106 | C SUPER(26:28) = mass of ~nu_e,~nu_mu,~nu_tau | |
33107 | C SUPER(29) = Higgsino mass = - mu | |
33108 | C SUPER(30) = ratio v2/v1 of vev's | |
33109 | C SUPER(31:34) = Signed neutralino masses | |
33110 | C SUPER(35:50) = Neutralino mixing matrix | |
33111 | C SUPER(51:52) = Signed chargino masses | |
33112 | C SUPER(53:54) = Chargino left, right mixing angles | |
33113 | C SUPER(55:58) = mass of h0, H0, A0, H+ | |
33114 | C SUPER(59) = Higgs mixing angle alpha | |
33115 | C SUPER(60:65) = A_t, theta_t, A_b, theta_b, A_tau, theta_tau | |
33116 | C SUPER(66) = Gravitino mass | |
33117 | C GSS: Filled by ISASUGRA | |
33118 | C GSS( 1) = g_1 GSS( 2) = g_2 GSS( 3) = g_3 | |
33119 | C GSS( 4) = y_tau GSS( 5) = y_b GSS( 6) = y_t | |
33120 | C GSS( 7) = M_1 GSS( 8) = M_2 GSS( 9) = M_3 | |
33121 | C GSS(10) = A_tau GSS(11) = A_b GSS(12) = A_t | |
33122 | C GSS(13) = M_h1^2 GSS(14) = M_h2^2 GSS(15) = M_er^2 | |
33123 | C GSS(16) = M_el^2 GSS(17) = M_dnr^2 GSS(18) = M_upr^2 | |
33124 | C GSS(19) = M_upl^2 GSS(20) = M_taur^2 GSS(21) = M_taul^2 | |
33125 | C GSS(22) = M_btr^2 GSS(23) = M_tpr^2 GSS(24) = M_tpl^2 | |
33126 | C GSS(25) = mu GSS(26) = B GSS(27) = Y_N | |
33127 | C GSS(28) = M_nr GSS(29) = A_n | |
33128 | C MSS: Filled by ISASUGRA | |
33129 | C MSS( 1) = glss MSS( 2) = upl MSS( 3) = upr | |
33130 | C MSS( 4) = dnl MSS( 5) = dnr MSS( 6) = stl | |
33131 | C MSS( 7) = str MSS( 8) = chl MSS( 9) = chr | |
33132 | C MSS(10) = b1 MSS(11) = b2 MSS(12) = t1 | |
33133 | C MSS(13) = t2 MSS(14) = nuel MSS(15) = numl | |
33134 | C MSS(16) = nutl MSS(17) = el- MSS(18) = er- | |
33135 | C MSS(19) = mul- MSS(20) = mur- MSS(21) = tau1 | |
33136 | C MSS(22) = tau2 MSS(23) = z1ss MSS(24) = z2ss | |
33137 | C MSS(25) = z3ss MSS(26) = z4ss MSS(27) = w1ss | |
33138 | C MSS(28) = w2ss MSS(29) = hl0 MSS(30) = hh0 | |
33139 | C MSS(31) = ha0 MSS(32) = h+ | |
33140 | C Unification, filled by ISASUGRA if applicable. | |
33141 | C MGUTSS = M_GUT GGUTSS = g_GUT AGUTSS = alpha_GUTC | |
33142 | C...SPYTHIA Input/Output: | |
33143 | INTEGER IMSS | |
33144 | DOUBLE PRECISION RMSS | |
33145 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
33146 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
33147 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
33148 | SAVE /SUGMG/,/SSPAR/ | |
33149 | C | |
33150 | C...PYTHIA common blocks | |
33151 | C...Parameters. | |
33152 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
33153 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
33154 | C...Particle properties + some flavour parameters. | |
33155 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
33156 | SAVE /PYDAT2/,/PYSSMT/ | |
33157 | ||
33158 | C...Start by checking for incompatibilities/inconsistencies: | |
33159 | DO 100 ICHK=2,9 | |
33160 | IF (ICHK.NE.8.AND.ICHK.NE.4.AND.IMSS(ICHK).NE.0) THEN | |
33161 | WRITE (MSTU(11),*) '(PYSUGI:) IMSS(',ICHK,')=',IMSS(ICHK) | |
33162 | & ,' option not used by PYSUGI' | |
33163 | ENDIF | |
33164 | 100 CONTINUE | |
33165 | C...ISAJET works with REAL numbers. | |
33166 | MZERO=REAL(RMSS(8)) | |
33167 | MHLF=REAL(RMSS(1)) | |
33168 | AZERO=REAL(RMSS(16)) | |
33169 | TANB=REAL(RMSS(5)) | |
33170 | SGNMU=REAL(RMSS(4)) | |
33171 | MTOP=REAL(PMAS(6,1)) | |
33172 | C...Initialize MSSM parameter array | |
33173 | DO 110 IPAR=1,66 | |
33174 | SUPER(IPAR)=0.0 | |
33175 | 110 CONTINUE | |
33176 | C...Call ISASUGRA | |
33177 | CALL SUGRA(MZERO,MHLF,AZERO,TANB,SGNMU,MTOP,1) | |
33178 | C...Check whether ISASUSY thought the model was OK. | |
33179 | IF (NOGOOD.NE.0) THEN | |
33180 | IF (NOGOOD.EQ.1) CALL PYERRM(26 | |
33181 | & ,'(PYSUGI:) SUSY parameters give tachyonic particles.') | |
33182 | IF (NOGOOD.EQ.2) CALL PYERRM(26 | |
33183 | & ,'(PYSUGI:) SUSY parameters give no EWSB.') | |
33184 | IF (NOGOOD.EQ.3) CALL PYERRM(26 | |
33185 | & ,'(PYSUGI:) SUSY parameters give m(A0) < 0.') | |
33186 | IF (NOGOOD.EQ.4) CALL PYERRM(26 | |
33187 | & ,'(PYSUGI:) SUSY parameters give Yukawa > 100.') | |
33188 | IF (NOGOOD.EQ.7) CALL PYERRM(26 | |
33189 | & ,'(PYSUGI:) SUSY parameters give x_T EWSB bad.') | |
33190 | IF (NOGOOD.EQ.8) CALL PYERRM(26 | |
33191 | & ,'(PYSUGI:) SUSY parameters give m(h0)^2 < 0.') | |
33192 | C...Give warning, but don't stop, if LSP not ~chi_10. | |
33193 | IF (NOGOOD.EQ.5) CALL PYERRM(16 | |
33194 | & ,'(PYSUGI:) SUSY parameters give ~chi_10 not LSP.') | |
33195 | ENDIF | |
33196 | C...Warn about possible GUT scale tachyons. | |
33197 | IF (ITACHY.NE.0) CALL PYERRM(16, | |
33198 | & '(PYSUGI:) Tachyonic sleptons at GUT scale.') | |
33199 | ||
33200 | C...M1 and M2. | |
33201 | RMSS(1)=GSS(7) | |
33202 | RMSS(2)=GSS(8) | |
33203 | C...Gluino Mass. | |
33204 | RMSS(3)=SUPER(1) | |
33205 | C...Mu = - Higgsino mass. | |
33206 | RMSS(4)=-SUPER(29) | |
33207 | RMSS(5)=TANB | |
33208 | C...Slepton and squark masses. 2 first generations. | |
33209 | RMSS(6)=0.5*(SUPER(18)+SUPER(20)) | |
33210 | RMSS(7)=0.5*(SUPER(19)+SUPER(21)) | |
33211 | RMSS(8)=0.25*(SUPER(2)+SUPER(4)+SUPER(6)+SUPER(8)) | |
33212 | RMSS(9)=0.25*(SUPER(3)+SUPER(5)+SUPER(7)+SUPER(9)) | |
33213 | C...Third generation. | |
33214 | RMSS(10)=0.5*(SUPER(14)+SUPER(10)) | |
33215 | RMSS(11)=SUPER(11) | |
33216 | RMSS(12)=SUPER(15) | |
33217 | RMSS(13)=SUPER(22) | |
33218 | RMSS(14)=SUPER(23) | |
33219 | C...~b, ~t, and ~tau trilinear couplings and mixing angles. | |
33220 | RMSS(15)=SUPER(62) | |
33221 | RMSS(16)=SUPER(60) | |
33222 | RMSS(17)=SUPER(64) | |
33223 | RMSS(26)=SUPER(63) | |
33224 | RMSS(27)=SUPER(61) | |
33225 | RMSS(28)=SUPER(65) | |
33226 | C...Higgs mixing angle alpha (Gunion-Haber convention). | |
33227 | RMSS(18)=-SUPER(59) | |
33228 | C...A0 mass. | |
33229 | RMSS(19)=SUPER(57) | |
33230 | C...GUT scale coupling | |
33231 | RMSS(20)=AGUTSS | |
33232 | C...Gravitino mass (for future compatibility) | |
33233 | RMSS(21)=SUPER(66) | |
33234 | ||
33235 | C...Now we're done with RMSS. Time to fill PMAS (m > 0 required). | |
33236 | C...Higgs sector. | |
33237 | PMAS(PYCOMP(25),1)=ABS(SUPER(55)) | |
33238 | PMAS(PYCOMP(35),1)=ABS(SUPER(56)) | |
33239 | PMAS(PYCOMP(36),1)=ABS(SUPER(57)) | |
33240 | PMAS(PYCOMP(37),1)=ABS(SUPER(58)) | |
33241 | C...Gluino. | |
33242 | PMAS(PYCOMP(KSUSY1+21),1)=ABS(SUPER(1)) | |
33243 | C...Squarks and Sleptons. | |
33244 | DO 120 ILR=1,2 | |
33245 | ILRM=ILR-1 | |
33246 | PMAS(PYCOMP(ILR*KSUSY1+1),1)=ABS(SUPER(4+ILRM)) | |
33247 | PMAS(PYCOMP(ILR*KSUSY1+2),1)=ABS(SUPER(2+ILRM)) | |
33248 | PMAS(PYCOMP(ILR*KSUSY1+3),1)=ABS(SUPER(6+ILRM)) | |
33249 | PMAS(PYCOMP(ILR*KSUSY1+4),1)=ABS(SUPER(8+ILRM)) | |
33250 | PMAS(PYCOMP(ILR*KSUSY1+5),1)=ABS(SUPER(12+ILRM)) | |
33251 | PMAS(PYCOMP(ILR*KSUSY1+6),1)=ABS(SUPER(16+ILRM)) | |
33252 | PMAS(PYCOMP(ILR*KSUSY1+11),1)=ABS(SUPER(18+ILRM)) | |
33253 | PMAS(PYCOMP(ILR*KSUSY1+13),1)=ABS(SUPER(20+ILRM)) | |
33254 | PMAS(PYCOMP(ILR*KSUSY1+15),1)=ABS(SUPER(24+ILRM)) | |
33255 | 120 CONTINUE | |
33256 | PMAS(PYCOMP(KSUSY1+12),1)=ABS(SUPER(26)) | |
33257 | PMAS(PYCOMP(KSUSY1+14),1)=ABS(SUPER(27)) | |
33258 | PMAS(PYCOMP(KSUSY1+16),1)=ABS(SUPER(28)) | |
33259 | C...Neutralinos. | |
33260 | PMAS(PYCOMP(KSUSY1+22),1)=ABS(SUPER(31)) | |
33261 | PMAS(PYCOMP(KSUSY1+23),1)=ABS(SUPER(32)) | |
33262 | PMAS(PYCOMP(KSUSY1+25),1)=ABS(SUPER(33)) | |
33263 | PMAS(PYCOMP(KSUSY1+35),1)=ABS(SUPER(34)) | |
33264 | C...Signed masses (extra minus from going to G-H convention). | |
33265 | SMZ(1)=-SUPER(31) | |
33266 | SMZ(2)=-SUPER(32) | |
33267 | SMZ(3)=-SUPER(33) | |
33268 | SMZ(4)=-SUPER(34) | |
33269 | C...Charginos | |
33270 | PMAS(PYCOMP(KSUSY1+24),1)=ABS(SUPER(51)) | |
33271 | PMAS(PYCOMP(KSUSY1+37),1)=ABS(SUPER(52)) | |
33272 | C...Signed masses (extra minus from going to G-H convention). | |
33273 | SMW(1)=-SUPER(51) | |
33274 | SMW(2)=-SUPER(52) | |
33275 | ||
33276 | C... Neutralino Mixing. | |
33277 | DO 130 IN=1,4 | |
33278 | ZMIX(IN,1)= SUPER(38+4*(IN-1)) | |
33279 | ZMIX(IN,2)= SUPER(37+4*(IN-1)) | |
33280 | ZMIX(IN,3)=-SUPER(36+4*(IN-1)) | |
33281 | ZMIX(IN,4)=-SUPER(35+4*(IN-1)) | |
33282 | 130 CONTINUE | |
33283 | C...Chargino Mixing (PYTHIA same angle as HERWIG). | |
33284 | THX=1D0 | |
33285 | THY=1D0 | |
33286 | IF (SUPER(53).GT.0) THX=-1D0 | |
33287 | IF (SUPER(54).GT.0) THY=-1D0 | |
33288 | UMIX(1,1) = -SIN(SUPER(53)) | |
33289 | UMIX(1,2) = -COS(SUPER(53)) | |
33290 | UMIX(2,1) = -THX*COS(SUPER(53)) | |
33291 | UMIX(2,2) = THX*SIN(SUPER(53)) | |
33292 | VMIX(1,1) = -SIN(SUPER(54)) | |
33293 | VMIX(1,2) = -COS(SUPER(54)) | |
33294 | VMIX(2,1) = -THY*COS(SUPER(54)) | |
33295 | VMIX(2,2) = THY*SIN(SUPER(54)) | |
33296 | C...Sfermion mixing (PYTHIA same angle as ISAJET) | |
33297 | SFMIX(5,1)=COS(SUPER(63)) | |
33298 | SFMIX(5,2)=SIN(SUPER(63)) | |
33299 | SFMIX(5,3)=-SIN(SUPER(63)) | |
33300 | SFMIX(5,4)=COS(SUPER(63)) | |
33301 | SFMIX(6,1)=COS(SUPER(61)) | |
33302 | SFMIX(6,2)=SIN(SUPER(61)) | |
33303 | SFMIX(6,3)=-SIN(SUPER(61)) | |
33304 | SFMIX(6,4)=COS(SUPER(61)) | |
33305 | SFMIX(15,1)=COS(SUPER(65)) | |
33306 | SFMIX(15,2)=SIN(SUPER(65)) | |
33307 | SFMIX(15,3)=-SIN(SUPER(65)) | |
33308 | SFMIX(15,4)=COS(SUPER(65)) | |
33309 | ||
33310 | IF (MSTP(122).NE.0) THEN | |
33311 | C...Print a few lines to make the user know what's happening | |
33312 | ISAVER=VISAJE() | |
33313 | WRITE(MSTU(11),5000) DOC, ISAVER | |
33314 | WRITE(MSTU(11),5100) | |
33315 | WRITE(MSTU(11),5200) MZERO, MHLF, AZERO, TANB, NINT(SGNMU), MTOP | |
33316 | WRITE(MSTU(11),5300) | |
33317 | WRITE(MSTU(11),5500) 'EW scale masses' | |
33318 | WRITE(MSTU(11),5700) (SUPER(IP),IP=2,16,2),(SUPER(IP),IP=3,17,2) | |
33319 | WRITE(MSTU(11),5800) (SUPER(IP),IP=18,24,2),(SUPER(IP),IP=26,28) | |
33320 | & ,(SUPER(IP),IP=19,25,2) | |
33321 | WRITE(MSTU(11),5900) SUPER(1),(SMZ(IP),IP=1,4), (SMW(IP) | |
33322 | & ,IP=1,2) | |
33323 | WRITE(MSTU(11),6000) (SUPER(IP),IP=55,58) | |
33324 | WRITE(MSTU(11),5400) | |
33325 | WRITE(MSTU(11),5500) 'Mixing structure' | |
33326 | WRITE(MSTU(11),6100) ((ZMIX(I,J), J=1,4),I=1,4) | |
33327 | WRITE(MSTU(11),6200) (UMIX(1,J), J=1,2),(VMIX(1,J),J=1,2) | |
33328 | & ,(UMIX(2,J), J=1,2),(VMIX(2,J),J=1,2) | |
33329 | WRITE(MSTU(11),6300) (SFMIX(5,J), J=1,2),(SFMIX(6,J),J=1,2) | |
33330 | & ,(SFMIX(15,J), J=1,2),(SFMIX(5,J),J=3,4),(SFMIX(6,J), J=3,4 | |
33331 | & ),(SFMIX(15,J),J=3,4) | |
33332 | WRITE(MSTU(11),5400) | |
33333 | WRITE(MSTU(11),5500) 'Couplings' | |
33334 | WRITE(MSTU(11),6400) RMSS(15),RMSS(16),RMSS(17),RMSS(20) | |
33335 | WRITE(MSTU(11),5400) | |
33336 | WRITE(MSTU(11),6500) | |
33337 | ENDIF | |
33338 | ||
33339 | C...Fix the higgs sector (in PYMSIN) using the masses and mixing angle | |
33340 | C...output by ISASUGRA. | |
33341 | IMSS(4)=2 | |
33342 | ||
33343 | 5000 FORMAT(1x,19('*'),1x,'PYSUGI v1.1: PYTHIA/ISASUGRA ' | |
33344 | & ,'INTERFACE',1x,19('*')/1x,'*',3x,'PYSUGI: Last Change',1x,A | |
33345 | & ,1x,'-',1x,'P.Z. Skands'/1x,'*',2x,A/1x,'*') | |
33346 | 5100 FORMAT(1x,'*',1x,'ISASUGRA Input:'/1x,'*',1x,'----------------') | |
33347 | 5200 FORMAT(1x,'*',1x,3x,'M_0',6x,'M_1/2',5x,'A_0',3x,'Tan(beta)', | |
33348 | & 3x,'Sgn(mu)',3x,'M_t'/1x,'*',1x,4(F8.2,1x),I8,2x,F8.2) | |
33349 | 5300 FORMAT(1x,'*'/1x,'*',1x,'ISASUGRA Output:'/1x,'*',1x | |
33350 | & ,'----------------') | |
33351 | 5400 FORMAT(1x,'*',1x,A) | |
33352 | 5500 FORMAT(1x,'*',1x,A,':') | |
33353 | 5600 FORMAT(1x,'*',2x,2x,'M_GUT',2x,2x,'g_GUT',2x,1x,'alpha_GUT'/ | |
33354 | & 1x,'*',2x,1P,2(1x,E8.2),2x,E8.2) | |
33355 | 5700 FORMAT(1x,'*',4x,4x,'~u',2x,1x,4x,'~d',2x,1x,4x,'~s',2x,1x, | |
33356 | & 4x,'~c',2x,1x,4x,'~b',2x,1x,2x,'~b(12)',1x,4x,'~t',2x,1x, 2x, | |
33357 | & '~t(12)'/1x,'*',2x,'L',1x,8(F8.2,1x)/1x,'*',2x,'R',1x,8(F8.2 | |
33358 | & ,1x)) | |
33359 | 5800 FORMAT(1x,'*'/1x,'*',4x,4x,'~e',2x,1x,3x,'~mu',2x,1x,3x,'~tau',1x | |
33360 | & ,1x,'~tau(12)',1x,2x,'~nu_e',1x,1x,1x,'~nu_mu',1x,1x,1x | |
33361 | & ,'~nu_tau'/1x,'*',2x,'L',1x,7(F8.2,1x)/1x,'*',2x,'R',1x,4(F8 | |
33362 | & .2,1x)) | |
33363 | 5900 FORMAT(1x,'*'/1x,'*',4x,4x,'~g',2x,1x,1x,'~chi_10',1x,1x,'~chi_20' | |
33364 | & ,1x,1x,'~chi_30',1x,1x,'~chi_40',1x,1x,'~chi_1+',1x | |
33365 | & ,1x,'~chi_2+'/1x,'*',3x,1x,7(F8.2,1x)) | |
33366 | 6000 FORMAT(1x,'*'/1x,'*',4x,4x,'h0',2x,1x,4x,'H0',2x,1x,4x,'A0',2x | |
33367 | & ,1x,4x,'H+'/1x,'*',3x,1x,5(F8.2,1x)) | |
33368 | 6100 FORMAT(1x,'*',11x,'|',3x,'~B',3x,'|',2x,'~W_3',2x,'|',2x | |
33369 | & ,'~H_1',2x,'|',2x,'~H_2',2x,'|'/1x,'*',3x,'~chi_10',1x,4('|' | |
33370 | & ,1x,F6.3,1x),'|'/1x,'*',3x,'~chi_20',1x,4('|' | |
33371 | & ,1x,F6.3,1x),'|'/1x,'*',3x,'~chi_30',1x,4('|' | |
33372 | & ,1x,F6.3,1x),'|'/1x,'*',3x,'~chi_40',1x,4('|' | |
33373 | & ,1x,F6.3,1x),'|') | |
33374 | 6200 FORMAT(1x,'*'/1x,'*',6x,'L',4x,'|',3x,'~W',3x,'|',3x,'~H',3x,'|' | |
33375 | & ,12x,'R',4x,'|',3x,'~W',3x,'|',3x,'~H',3x,'|'/1x,'*',3x | |
33376 | & ,'~chi_1+',1x,2('|',1x,F6.3,1x),'|',9x,'~chi_1+',1x,2('|',1x | |
33377 | & ,F6.3,1x),'|'/1x,'*',3x,'~chi_2+',1x,2('|',1x,F6.3,1x),'|',9x | |
33378 | & ,'~chi_2+',1x,2('|',1x,F6.3,1x),'|') | |
33379 | 6300 FORMAT(1x,'*'/1x,'*',8x,'|',2x,'~b_L',2x,'|',2x,'~b_R',2x,'|',8x | |
33380 | & ,'|',2x,'~t_L',2x,'|',2x,'~t_R',2x,'|',10x | |
33381 | & ,'|',1x,'~tau_L',1x,'|',1x,'~tau_R',1x,'|'/ | |
33382 | & 1x,'*',3x,'~b_1',1x,2('|',1x,F6.3,1x),'|',3x,'~t_1',1x,2('|' | |
33383 | & ,1x,F6.3,1x),'|',3x,'~tau_1',1x,2('|',1x,F6.3,1x),'|'/ | |
33384 | & 1x,'*',3x,'~b_2',1x,2('|',1x,F6.3,1x),'|',3x,'~t_2',1x,2('|' | |
33385 | & ,1x,F6.3,1x),'|',3x,'~tau_2',1x,2('|',1x,F6.3,1x),'|') | |
33386 | 6400 FORMAT(1x,'*',3x,'A_b = ',F8.2,4x,'A_t = ',F8.2,4x,'A_tau = ',F8.2 | |
33387 | & ,4x,'Alpha_GUT = ',F8.2) | |
33388 | 6500 FORMAT(1x,32('*'),1x,'END OF PYSUGI',1x,31('*')) | |
33389 | END | |
33390 | ||
33391 | C********************************************************************* | |
33392 | ||
33393 | C...PYRNMQ | |
33394 | C...Determines the running mass of Squarks. | |
33395 | ||
33396 | FUNCTION PYRNMQ(ID,DTERM) | |
33397 | ||
33398 | C...Double precision and integer declarations. | |
33399 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
33400 | IMPLICIT INTEGER(I-N) | |
33401 | INTEGER PYK,PYCHGE,PYCOMP | |
33402 | C...Commonblock. | |
33403 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
33404 | SAVE /PYMSSM/ | |
33405 | ||
33406 | C...Local variables. | |
33407 | DOUBLE PRECISION PI,R | |
33408 | DOUBLE PRECISION TOL | |
33409 | DOUBLE PRECISION CI(3) | |
33410 | EXTERNAL PYALPS | |
33411 | DOUBLE PRECISION PYALPS | |
33412 | DATA TOL/0.001D0/ | |
33413 | DATA PI,R/3.141592654D0,.61803399D0/ | |
33414 | DATA CI/0.47D0,0.07D0,0.02D0/ | |
33415 | ||
33416 | C=1D0-R | |
33417 | CA=CI(ID) | |
33418 | AG=(0.71D0)**2/4D0/PI | |
33419 | AG=RMSS(20) | |
33420 | XM0=RMSS(8) | |
33421 | XMG=RMSS(1) | |
33422 | XM02=XM0*XM0 | |
33423 | XMG2=XMG*XMG | |
33424 | ||
33425 | AS=PYALPS(XM02+6D0*XMG2) | |
33426 | CG=8D0/9D0*((AS/AG)**2-1D0) | |
33427 | BX=XM02+(CA+CG)*XMG2+DTERM | |
33428 | AX=MIN(50D0**2,0.5D0*BX) | |
33429 | CX=MAX(2000D0**2,2D0*BX) | |
33430 | ||
33431 | X0=AX | |
33432 | X3=CX | |
33433 | IF(ABS(CX-BX).GT.ABS(BX-AX))THEN | |
33434 | X1=BX | |
33435 | X2=BX+C*(CX-BX) | |
33436 | ELSE | |
33437 | X2=BX | |
33438 | X1=BX-C*(BX-AX) | |
33439 | ENDIF | |
33440 | AS1=PYALPS(X1) | |
33441 | CG=8D0/9D0*((AS1/AG)**2-1D0) | |
33442 | F1=ABS(XM02+(CA+CG)*XMG2+DTERM-X1) | |
33443 | AS2=PYALPS(X2) | |
33444 | CG=8D0/9D0*((AS2/AG)**2-1D0) | |
33445 | F2=ABS(XM02+(CA+CG)*XMG2+DTERM-X2) | |
33446 | 100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN | |
33447 | IF(F2.LT.F1) THEN | |
33448 | X0=X1 | |
33449 | X1=X2 | |
33450 | X2=R*X1+C*X3 | |
33451 | F1=F2 | |
33452 | AS2=PYALPS(X2) | |
33453 | CG=8D0/9D0*((AS2/AG)**2-1D0) | |
33454 | F2=ABS(XM02+(CA+CG)*XMG2+DTERM-X2) | |
33455 | ELSE | |
33456 | X3=X2 | |
33457 | X2=X1 | |
33458 | X1=R*X2+C*X0 | |
33459 | F2=F1 | |
33460 | AS1=PYALPS(X1) | |
33461 | CG=8D0/9D0*((AS1/AG)**2-1D0) | |
33462 | F1=ABS(XM02+(CA+CG)*XMG2+DTERM-X1) | |
33463 | ENDIF | |
33464 | GOTO 100 | |
33465 | ENDIF | |
33466 | IF(F1.LT.F2) THEN | |
33467 | PYRNMQ=X1 | |
33468 | XMIN=X1 | |
33469 | ELSE | |
33470 | PYRNMQ=X2 | |
33471 | XMIN=X2 | |
33472 | ENDIF | |
33473 | ||
33474 | RETURN | |
33475 | END | |
33476 | ||
33477 | C********************************************************************* | |
33478 | ||
33479 | C...PYTHRG | |
33480 | C...Calculates the mass eigenstates of the third generation sfermions. | |
33481 | C...Created: 5-31-96 | |
33482 | ||
33483 | SUBROUTINE PYTHRG | |
33484 | ||
33485 | C...Double precision and integer declarations. | |
33486 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
33487 | IMPLICIT INTEGER(I-N) | |
33488 | INTEGER PYK,PYCHGE,PYCOMP | |
33489 | C...Parameter statement to help give large particle numbers. | |
33490 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
33491 | &KEXCIT=4000000,KDIMEN=5000000) | |
33492 | C...Commonblocks. | |
33493 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
33494 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
33495 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
33496 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
33497 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
33498 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ | |
33499 | ||
33500 | C...Local variables. | |
33501 | DOUBLE PRECISION BETA | |
33502 | DOUBLE PRECISION AM2(2,2),RT(2,2),DI(2,2) | |
33503 | DOUBLE PRECISION XMZ2,XMW2,TANB,XMU,COS2B,XMQL2,XMQR2 | |
33504 | DOUBLE PRECISION XMF,XMF2,DIFF,SAME,XMF12,XMF22,SMALL | |
33505 | DOUBLE PRECISION ATR,AMQR,AMQL | |
33506 | INTEGER ID1(3),ID2(3),ID3(3),ID4(3) | |
33507 | INTEGER IF,I,J,II,JJ,IT,L | |
33508 | LOGICAL DTERM | |
33509 | DATA SMALL/1D-3/ | |
33510 | DATA ID1/10,10,13/ | |
33511 | DATA ID2/5,6,15/ | |
33512 | DATA ID3/15,16,17/ | |
33513 | DATA ID4/11,12,14/ | |
33514 | DATA DTERM/.TRUE./ | |
33515 | ||
33516 | XMZ2=PMAS(23,1)**2 | |
33517 | XMW2=PMAS(24,1)**2 | |
33518 | TANB=RMSS(5) | |
33519 | XMU=-RMSS(4) | |
33520 | BETA=ATAN(TANB) | |
33521 | COS2B=COS(2D0*BETA) | |
33522 | ||
33523 | C...OPTION TO FIX T1, T2, B1 MASSES AND MIXINGS | |
33524 | ||
33525 | IOPT=IMSS(5) | |
33526 | IF(IOPT.EQ.1) THEN | |
33527 | CTT=DCOS(RMSS(27)) | |
33528 | CTT2=CTT**2 | |
33529 | STT=DSIN(RMSS(27)) | |
33530 | STT2=STT**2 | |
33531 | XM12=RMSS(10)**2 | |
33532 | XM22=RMSS(12)**2 | |
33533 | XMQL2=CTT2*XM12+STT2*XM22 | |
33534 | XMQR2=STT2*XM12+CTT2*XM22 | |
33535 | XMF2=PYMRUN(6,PMAS(6,1)**2)**2 | |
33536 | ATOP=-XMU/TANB+CTT*STT*(XM12-XM22)/SQRT(XMF2) | |
33537 | RMSS(16)=ATOP | |
33538 | C......SUBTRACT OUT D-TERM AND FERMION MASS | |
33539 | XMQL2=XMQL2-XMF2-(4D0*XMW2-XMZ2)*COS2B/6D0 | |
33540 | XMQR2=XMQR2-XMF2+(XMW2-XMZ2)*COS2B*2D0/3D0 | |
33541 | IF(XMQL2.GE.0D0) THEN | |
33542 | RMSS(10)=SQRT(XMQL2) | |
33543 | ELSE | |
33544 | RMSS(10)=-SQRT(-XMQL2) | |
33545 | ENDIF | |
33546 | IF(XMQR2.GE.0D0) THEN | |
33547 | RMSS(12)=SQRT(XMQR2) | |
33548 | ELSE | |
33549 | RMSS(12)=-SQRT(-XMQR2) | |
33550 | ENDIF | |
33551 | ||
33552 | C SAME FOR BOTTOM SQUARK | |
33553 | CTT=DCOS(RMSS(26)) | |
33554 | CTT2=CTT**2 | |
33555 | STT=DSIN(RMSS(26)) | |
33556 | STT2=STT**2 | |
33557 | XM22=RMSS(11)**2 | |
33558 | XMF2=PYMRUN(5,PMAS(6,1)**2)**2 | |
33559 | XMQL2=SIGN(RMSS(10)**2,RMSS(10))-(2D0*XMW2+XMZ2)*COS2B/6D0+XMF2 | |
33560 | IF(ABS(CTT).GE..9999D0) THEN | |
33561 | ABOT=-XMU*TANB | |
33562 | XMQR2=RMSS(11)**2 | |
33563 | ELSEIF(ABS(CTT).LE.1D-4) THEN | |
33564 | ABOT=-XMU*TANB | |
33565 | XMQR2=RMSS(11)**2 | |
33566 | ELSE | |
33567 | XM12=(XMQL2-STT2*XM22)/CTT2 | |
33568 | XMQR2=STT2*XM12+CTT2*XM22 | |
33569 | ABOT=-XMU*TANB+CTT*STT*(XM12-XM22)/SQRT(XMF2) | |
33570 | ENDIF | |
33571 | RMSS(15)=ABOT | |
33572 | C......SUBTRACT OUT D-TERM AND FERMION MASS | |
33573 | XMQR2=XMQR2-(XMW2-XMZ2)*COS2B/3D0-XMF2 | |
33574 | IF(XMQR2.GE.0D0) THEN | |
33575 | RMSS(11)=SQRT(XMQR2) | |
33576 | ELSE | |
33577 | RMSS(11)=-SQRT(-XMQR2) | |
33578 | ENDIF | |
33579 | C SAME FOR TAU SLEPTON | |
33580 | CTT=DCOS(RMSS(28)) | |
33581 | CTT2=CTT**2 | |
33582 | STT=DSIN(RMSS(28)) | |
33583 | STT2=STT**2 | |
33584 | XM12=RMSS(13)**2 | |
33585 | XM22=RMSS(14)**2 | |
33586 | XMQL2=CTT2*XM12+STT2*XM22 | |
33587 | XMQR2=STT2*XM12+CTT2*XM22 | |
33588 | XMFR=PMAS(15,1) | |
33589 | XMF2=XMFR**2 | |
33590 | ATAU=-XMU*TANB+CTT*STT*(XM12-XM22)/SQRT(XMF2) | |
33591 | RMSS(17)=ATAU | |
33592 | C......SUBTRACT OUT D-TERM AND FERMION MASS | |
33593 | XMQL2=XMQL2-XMF2+(-.5D0*XMZ2+XMW2)*COS2B | |
33594 | XMQR2=XMQR2-XMF2+(XMZ2-XMW2)*COS2B | |
33595 | IF(XMQL2.GE.0D0) THEN | |
33596 | RMSS(13)=SQRT(XMQL2) | |
33597 | ELSE | |
33598 | RMSS(13)=-SQRT(-XMQL2) | |
33599 | ENDIF | |
33600 | IF(XMQR2.GE.0D0) THEN | |
33601 | RMSS(14)=SQRT(XMQR2) | |
33602 | ELSE | |
33603 | RMSS(14)=-SQRT(-XMQR2) | |
33604 | ENDIF | |
33605 | ENDIF | |
33606 | DO 170 L=1,3 | |
33607 | AMQL=RMSS(ID1(L)) | |
33608 | IF(AMQL.LT.0D0) THEN | |
33609 | XMQL2=-AMQL**2 | |
33610 | ELSE | |
33611 | XMQL2=AMQL**2 | |
33612 | ENDIF | |
33613 | ATR=RMSS(ID3(L)) | |
33614 | AMQR=RMSS(ID4(L)) | |
33615 | IF(AMQR.LT.0D0) THEN | |
33616 | XMQR2=-AMQR**2 | |
33617 | ELSE | |
33618 | XMQR2=AMQR**2 | |
33619 | ENDIF | |
33620 | IF=ID2(L) | |
33621 | XMF=PYMRUN(IF,PMAS(6,1)**2) | |
33622 | XMF2=XMF**2 | |
33623 | AM2(1,1)=XMQL2+XMF2 | |
33624 | AM2(2,2)=XMQR2+XMF2 | |
33625 | IF(AM2(1,1).EQ.AM2(2,2)) AM2(2,2)=AM2(2,2)*1.00001D0 | |
33626 | IF(DTERM) THEN | |
33627 | IF(L.EQ.1) THEN | |
33628 | AM2(1,1)=AM2(1,1)-(2D0*XMW2+XMZ2)*COS2B/6D0 | |
33629 | AM2(2,2)=AM2(2,2)+(XMW2-XMZ2)*COS2B/3D0 | |
33630 | AM2(1,2)=XMF*(ATR+XMU*TANB) | |
33631 | ELSEIF(L.EQ.2) THEN | |
33632 | AM2(1,1)=AM2(1,1)+(4D0*XMW2-XMZ2)*COS2B/6D0 | |
33633 | AM2(2,2)=AM2(2,2)-(XMW2-XMZ2)*COS2B*2D0/3D0 | |
33634 | AM2(1,2)=XMF*(ATR+XMU/TANB) | |
33635 | ELSEIF(L.EQ.3) THEN | |
33636 | IF(IMSS(8).EQ.1) THEN | |
33637 | AM2(1,1)=RMSS(6)**2 | |
33638 | AM2(2,2)=RMSS(7)**2 | |
33639 | AM2(1,2)=0D0 | |
33640 | RMSS(13)=RMSS(6) | |
33641 | RMSS(14)=RMSS(7) | |
33642 | ELSE | |
33643 | AM2(1,1)=AM2(1,1)-(-.5D0*XMZ2+XMW2)*COS2B | |
33644 | AM2(2,2)=AM2(2,2)-(XMZ2-XMW2)*COS2B | |
33645 | AM2(1,2)=XMF*(ATR+XMU*TANB) | |
33646 | ENDIF | |
33647 | ENDIF | |
33648 | ENDIF | |
33649 | AM2(2,1)=AM2(1,2) | |
33650 | DETM=AM2(1,1)*AM2(2,2)-AM2(2,1)**2 | |
33651 | IF(DETM.LT.0D0) THEN | |
33652 | WRITE(MSTU(11),*) ID2(L),DETM,AM2 | |
33653 | CALL PYERRM(30,' NEGATIVE**2 MASS FOR SFERMION IN PYTHRG ') | |
33654 | ENDIF | |
33655 | SAME=0.5D0*(AM2(1,1)+AM2(2,2)) | |
33656 | DIFF=0.5D0*SQRT((AM2(1,1)-AM2(2,2))**2+4D0*AM2(1,2)*AM2(2,1)) | |
33657 | XMF12=SAME-DIFF | |
33658 | XMF22=SAME+DIFF | |
33659 | IT=0 | |
33660 | IF(XMF22-XMF12.GT.0D0) THEN | |
33661 | RT(1,1) = SQRT(MAX(0D0,(XMF22-AM2(1,1))/(XMF22-XMF12))) | |
33662 | RT(2,2) = RT(1,1) | |
33663 | RT(1,2) = -SIGN(SQRT(MAX(0D0,1D0-RT(1,1)**2)), | |
33664 | & AM2(1,2)/(XMF22-XMF12)) | |
33665 | RT(2,1) = -RT(1,2) | |
33666 | ELSE | |
33667 | RT(1,1) = 1D0 | |
33668 | RT(2,2) = RT(1,1) | |
33669 | RT(1,2) = 0D0 | |
33670 | RT(2,1) = -RT(1,2) | |
33671 | ENDIF | |
33672 | 100 CONTINUE | |
33673 | IT=IT+1 | |
33674 | ||
33675 | DO 140 I=1,2 | |
33676 | DO 130 JJ=1,2 | |
33677 | DI(I,JJ)=0D0 | |
33678 | DO 120 II=1,2 | |
33679 | DO 110 J=1,2 | |
33680 | DI(I,JJ)=DI(I,JJ)+RT(I,J)*AM2(J,II)*RT(JJ,II) | |
33681 | 110 CONTINUE | |
33682 | 120 CONTINUE | |
33683 | 130 CONTINUE | |
33684 | 140 CONTINUE | |
33685 | ||
33686 | IF(DI(1,1).GT.DI(2,2)) THEN | |
33687 | WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION ' | |
33688 | WRITE(MSTU(11),*) L,SQRT(XMF12),SQRT(XMF22) | |
33689 | WRITE(MSTU(11),*) AM2 | |
33690 | WRITE(MSTU(11),*) DI | |
33691 | WRITE(MSTU(11),*) RT | |
33692 | DI(1,1)=-RT(2,1) | |
33693 | DI(2,2)=RT(1,2) | |
33694 | DI(1,2)=-RT(2,2) | |
33695 | DI(2,1)=RT(1,1) | |
33696 | DO 160 I=1,2 | |
33697 | DO 150 J=1,2 | |
33698 | RT(I,J)=DI(I,J) | |
33699 | 150 CONTINUE | |
33700 | 160 CONTINUE | |
33701 | GOTO 100 | |
33702 | ELSEIF(ABS(DI(1,2)*DI(2,1)/DI(1,1)/DI(2,2)).GT.SMALL) THEN | |
33703 | WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION,'// | |
33704 | & ' OFF DIAGONAL ELEMENTS ' | |
33705 | WRITE(MSTU(11),*) 'MASSES = ',L,SQRT(XMF12),SQRT(XMF22) | |
33706 | WRITE(MSTU(11),*) DI | |
33707 | WRITE(MSTU(11),*) ' ROTATION = ',RT | |
33708 | C...STOP | |
33709 | ELSEIF(DI(1,1).LT.0D0.OR.DI(2,2).LT.0D0) THEN | |
33710 | WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION,'// | |
33711 | & ' NEGATIVE MASSES ' | |
33712 | STOP | |
33713 | ENDIF | |
33714 | PMAS(PYCOMP(KSUSY1+IF),1)=SQRT(XMF12) | |
33715 | PMAS(PYCOMP(KSUSY2+IF),1)=SQRT(XMF22) | |
33716 | SFMIX(IF,1)=RT(1,1) | |
33717 | SFMIX(IF,2)=RT(1,2) | |
33718 | SFMIX(IF,3)=RT(2,1) | |
33719 | SFMIX(IF,4)=RT(2,2) | |
33720 | 170 CONTINUE | |
33721 | ||
33722 | C.....TAU SNEUTRINO MASS...L=3 | |
33723 | ||
33724 | XARG=AM2(1,1)+XMW2*COS2B | |
33725 | IF(XARG.LT.0D0) THEN | |
33726 | WRITE(MSTU(11),*) ' PYTHRG:: TAU SNEUTRINO MASS IS NEGATIVE'// | |
33727 | & ' FROM THE SUM RULE. ' | |
33728 | WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). ' | |
33729 | RETURN | |
33730 | ELSE | |
33731 | PMAS(PYCOMP(KSUSY1+16),1)=SQRT(XARG) | |
33732 | ENDIF | |
33733 | ||
33734 | RETURN | |
33735 | END | |
33736 | ||
33737 | C********************************************************************* | |
33738 | ||
33739 | C...PYINOM | |
33740 | C...Finds the mass eigenstates and mixing matrices for neutralinos | |
33741 | C...and charginos. | |
33742 | ||
33743 | SUBROUTINE PYINOM | |
33744 | ||
33745 | C...Double precision and integer declarations. | |
33746 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
33747 | IMPLICIT INTEGER(I-N) | |
33748 | INTEGER PYCOMP | |
33749 | C...Parameter statement to help give large particle numbers. | |
33750 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
33751 | &KEXCIT=4000000,KDIMEN=5000000) | |
33752 | C...Commonblocks. | |
33753 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
33754 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
33755 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
33756 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
33757 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
33758 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ | |
33759 | ||
33760 | C...Local variables. | |
33761 | DOUBLE PRECISION XMW,XMZ,XM(4) | |
33762 | DOUBLE PRECISION AR(4,4),WR(4),ZR(4,4),ZI(4,4),AI(4,4) | |
33763 | DOUBLE PRECISION WI(4),FV1(4),FV2(4),FV3(4) | |
33764 | DOUBLE PRECISION COSW,SINW | |
33765 | DOUBLE PRECISION XMU | |
33766 | DOUBLE PRECISION TANB,COSB,SINB | |
33767 | DOUBLE PRECISION XM1,XM2,XM3,BETA | |
33768 | DOUBLE PRECISION Q2,AEM,A1,A2,AQ,RM1,RM2 | |
33769 | DOUBLE PRECISION ARG,X0,X1,AX0,AX1,AT,BT | |
33770 | DOUBLE PRECISION Y0,Y1,AMGX0,AM1X0,AMGX1,AM1X1 | |
33771 | DOUBLE PRECISION ARGX0,AR1X0,ARGX1,AR1X1 | |
33772 | DOUBLE PRECISION PYALPS,PYALEM | |
33773 | DOUBLE PRECISION PYRNM3 | |
33774 | COMPLEX*16 CAR(4,4),CAI(4,4),CA1,CA2 | |
33775 | INTEGER IERR,INDEX(4),I,J,K,IOPT,ILR,KFNCHI(4) | |
33776 | DATA KFNCHI/1000022,1000023,1000025,1000035/ | |
33777 | ||
33778 | IOPT=IMSS(2) | |
33779 | IF(IMSS(1).EQ.2) THEN | |
33780 | IOPT=1 | |
33781 | ENDIF | |
33782 | C...M1, M2, AND M3 ARE INDEPENDENT | |
33783 | IF(IOPT.EQ.0) THEN | |
33784 | XM1=RMSS(1) | |
33785 | XM2=RMSS(2) | |
33786 | XM3=RMSS(3) | |
33787 | ELSEIF(IOPT.GE.1) THEN | |
33788 | Q2=PMAS(23,1)**2 | |
33789 | AEM=PYALEM(Q2) | |
33790 | A2=AEM/PARU(102) | |
33791 | A1=AEM/(1D0-PARU(102)) | |
33792 | XM1=RMSS(1) | |
33793 | XM2=RMSS(2) | |
33794 | IF(IMSS(1).EQ.2) XM1=RMSS(1)/RMSS(20)*A1*5D0/3D0 | |
33795 | IF(IOPT.EQ.1) THEN | |
33796 | XM2=XM1*A2/A1*3D0/5D0 | |
33797 | RMSS(2)=XM2 | |
33798 | ELSEIF(IOPT.EQ.3) THEN | |
33799 | XM1=XM2*5D0/3D0*A1/A2 | |
33800 | RMSS(1)=XM1 | |
33801 | ENDIF | |
33802 | XM3=PYRNM3(XM2/A2) | |
33803 | RMSS(3)=XM3 | |
33804 | IF(XM3.LE.0D0) THEN | |
33805 | WRITE(MSTU(11),*) ' ERROR WITH M3 = ',XM3 | |
33806 | STOP | |
33807 | ENDIF | |
33808 | ENDIF | |
33809 | ||
33810 | C...GLUINO MASS | |
33811 | IF(IMSS(3).EQ.1) THEN | |
33812 | PMAS(PYCOMP(KSUSY1+21),1)=ABS(XM3) | |
33813 | ELSE | |
33814 | AQ=0D0 | |
33815 | DO 110 I=1,4 | |
33816 | DO 100 ILR=1,2 | |
33817 | RM1=PMAS(PYCOMP(ILR*KSUSY1+I),1)**2/XM3**2 | |
33818 | AQ=AQ+0.5D0*((2D0-RM1)*(RM1*LOG(RM1)-1D0) | |
33819 | & +(1D0-RM1)**2*LOG(ABS(1D0-RM1))) | |
33820 | 100 CONTINUE | |
33821 | 110 CONTINUE | |
33822 | ||
33823 | DO 130 I=5,6 | |
33824 | DO 120 ILR=1,2 | |
33825 | RM1=PMAS(PYCOMP(ILR*KSUSY1+I),1)**2/XM3**2 | |
33826 | RM2=PMAS(I,1)**2/XM3**2 | |
33827 | ARG=(RM1-RM2-1D0)**2-4D0*RM2**2 | |
33828 | IF(ARG.GE.0D0) THEN | |
33829 | X0=0.5D0*(1D0+RM2-RM1-SQRT(ARG)) | |
33830 | AX0=ABS(X0) | |
33831 | X1=0.5D0*(1D0+RM2-RM1+SQRT(ARG)) | |
33832 | AX1=ABS(X1) | |
33833 | IF(X0.EQ.1D0) THEN | |
33834 | AT=-1D0 | |
33835 | BT=0.25D0 | |
33836 | ELSEIF(X0.EQ.0D0) THEN | |
33837 | AT=0D0 | |
33838 | BT=-0.25D0 | |
33839 | ELSE | |
33840 | AT=0.5D0*LOG(ABS(1D0-X0))*(1D0-X0**2)+ | |
33841 | & 0.5D0*X0**2*LOG(AX0) | |
33842 | BT=(-1D0-2D0*X0)/4D0 | |
33843 | ENDIF | |
33844 | IF(X1.EQ.1D0) THEN | |
33845 | AT=-1D0+AT | |
33846 | BT=0.25D0+BT | |
33847 | ELSEIF(X1.EQ.0D0) THEN | |
33848 | AT=0D0+AT | |
33849 | BT=-0.25D0+BT | |
33850 | ELSE | |
33851 | AT=0.5D0*LOG(ABS(1D0-X1))*(1D0-X1**2)+0.5D0* | |
33852 | & X1**2*LOG(AX1)+AT | |
33853 | BT=(-1D0-2D0*X1)/4D0+BT | |
33854 | ENDIF | |
33855 | AQ=AQ+AT+BT | |
33856 | ELSE | |
33857 | X0=0.5D0*(1D0+RM2-RM1) | |
33858 | Y0=-0.5D0*SQRT(-ARG) | |
33859 | AMGX0=SQRT(X0**2+Y0**2) | |
33860 | AM1X0=SQRT((1D0-X0)**2+Y0**2) | |
33861 | ARGX0=ATAN2(-X0,-Y0) | |
33862 | AR1X0=ATAN2(1D0-X0,Y0) | |
33863 | X1=X0 | |
33864 | Y1=-Y0 | |
33865 | AMGX1=AMGX0 | |
33866 | AM1X1=AM1X0 | |
33867 | ARGX1=ATAN2(-X1,-Y1) | |
33868 | AR1X1=ATAN2(1D0-X1,Y1) | |
33869 | AT=0.5D0*LOG(AM1X0)*(1D0-X0**2+3D0*Y0**2) | |
33870 | & +0.5D0*(X0**2-Y0**2)*LOG(AMGX0) | |
33871 | BT=(-1D0-2D0*X0)/4D0+X0*Y0*( AR1X0-ARGX0 ) | |
33872 | AT=AT+0.5D0*LOG(AM1X1)*(1D0-X1**2+3D0*Y1**2) | |
33873 | & +0.5D0*(X1**2-Y1**2)*LOG(AMGX1) | |
33874 | BT=BT+(-1D0-2D0*X1)/4D0+X1*Y1*( AR1X1-ARGX1 ) | |
33875 | AQ=AQ+AT+BT | |
33876 | ENDIF | |
33877 | 120 CONTINUE | |
33878 | 130 CONTINUE | |
33879 | PMAS(PYCOMP(KSUSY1+21),1)=ABS(XM3)*(1D0+PYALPS(XM3**2) | |
33880 | & /(2D0*PARU(2))*(15D0+AQ)) | |
33881 | ENDIF | |
33882 | ||
33883 | C...NEUTRALINO MASSES | |
33884 | DO 150 I=1,4 | |
33885 | DO 140 J=1,4 | |
33886 | AI(I,J)=0D0 | |
33887 | 140 CONTINUE | |
33888 | 150 CONTINUE | |
33889 | XMZ=PMAS(23,1) | |
33890 | XMW=PMAS(24,1) | |
33891 | XMU=RMSS(4) | |
33892 | SINW=SQRT(PARU(102)) | |
33893 | COSW=SQRT(1D0-PARU(102)) | |
33894 | TANB=RMSS(5) | |
33895 | BETA=ATAN(TANB) | |
33896 | COSB=COS(BETA) | |
33897 | SINB=TANB*COSB | |
33898 | ||
33899 | C... Definitions: | |
33900 | C... psi^0 =(-i bino^0, -i wino^0, h_d^0(=H_1^0), h_u^0(=H_2^0)) | |
33901 | C... => L_neutralino = -1/2*(psi^0)^T * [AR] * psi^0 + h.c. | |
33902 | AR(1,1) = XM1*COS(RMSS(30)) | |
33903 | AI(1,1) = XM1*SIN(RMSS(30)) | |
33904 | AR(2,2) = XM2*COS(RMSS(31)) | |
33905 | AI(2,2) = XM2*SIN(RMSS(31)) | |
33906 | AR(3,3) = 0D0 | |
33907 | AR(4,4) = 0D0 | |
33908 | AR(1,2) = 0D0 | |
33909 | AR(2,1) = 0D0 | |
33910 | AR(1,3) = -XMZ*SINW*COSB | |
33911 | AR(3,1) = AR(1,3) | |
33912 | AR(1,4) = XMZ*SINW*SINB | |
33913 | AR(4,1) = AR(1,4) | |
33914 | AR(2,3) = XMZ*COSW*COSB | |
33915 | AR(3,2) = AR(2,3) | |
33916 | AR(2,4) = -XMZ*COSW*SINB | |
33917 | AR(4,2) = AR(2,4) | |
33918 | AR(3,4) = -XMU*COS(RMSS(33)) | |
33919 | AI(3,4) = -XMU*SIN(RMSS(33)) | |
33920 | AR(4,3) = -XMU*COS(RMSS(33)) | |
33921 | AI(4,3) = -XMU*SIN(RMSS(33)) | |
33922 | C CALL PYEIG4(AR,WR,ZR) | |
33923 | CALL PYEICG(4,4,AR,AI,WR,WI,1,ZR,ZI,FV1,FV2,FV3,IERR) | |
33924 | IF(IERR.NE.0) THEN | |
33925 | WRITE(MSTU(11),*) ' PROBLEM WITH PYEICG IN PYINOM ' | |
33926 | ENDIF | |
33927 | DO 160 I=1,4 | |
33928 | INDEX(I)=I | |
33929 | XM(I)=ABS(WR(I)) | |
33930 | 160 CONTINUE | |
33931 | DO 180 I=2,4 | |
33932 | K=I | |
33933 | DO 170 J=I-1,1,-1 | |
33934 | IF(XM(K).LT.XM(J)) THEN | |
33935 | ITMP=INDEX(J) | |
33936 | XTMP=XM(J) | |
33937 | INDEX(J)=INDEX(K) | |
33938 | XM(J)=XM(K) | |
33939 | INDEX(K)=ITMP | |
33940 | XM(K)=XTMP | |
33941 | K=K-1 | |
33942 | ELSE | |
33943 | GOTO 180 | |
33944 | ENDIF | |
33945 | 170 CONTINUE | |
33946 | 180 CONTINUE | |
33947 | ||
33948 | ||
33949 | DO 210 I=1,4 | |
33950 | K=INDEX(I) | |
33951 | SMZ(I)=WR(K) | |
33952 | PMAS(PYCOMP(KFNCHI(I)),1)=ABS(SMZ(I)) | |
33953 | S=0D0 | |
33954 | DO 190 J=1,4 | |
33955 | S=S+ZR(J,K)**2+ZI(J,K)**2 | |
33956 | 190 CONTINUE | |
33957 | DO 200 J=1,4 | |
33958 | ZMIX(I,J)=ZR(J,K)/SQRT(S) | |
33959 | ZMIXI(I,J)=ZI(J,K)/SQRT(S) | |
33960 | IF(ABS(ZMIX(I,J)).LT.1D-6) ZMIX(I,J)=0D0 | |
33961 | IF(ABS(ZMIXI(I,J)).LT.1D-6) ZMIXI(I,J)=0D0 | |
33962 | 200 CONTINUE | |
33963 | 210 CONTINUE | |
33964 | ||
33965 | C...CHARGINO MASSES | |
33966 | C.....Find eigenvectors of X X^* | |
33967 | AI(1,1) = 0D0 | |
33968 | AI(2,2) = 0D0 | |
33969 | AR(1,1) = XM2**2+2D0*XMW**2*SINB**2 | |
33970 | AR(2,2) = XMU**2+2D0*XMW**2*COSB**2 | |
33971 | AR(1,2) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*COSB+ | |
33972 | &XMU*COS(RMSS(33))*SINB) | |
33973 | AI(1,2) = SQRT(2D0)*XMW*(XM2*SIN(RMSS(31))*COSB- | |
33974 | &XMU*SIN(RMSS(33))*SINB) | |
33975 | AR(2,1) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*COSB+ | |
33976 | &XMU*COS(RMSS(33))*SINB) | |
33977 | AI(2,1) = SQRT(2D0)*XMW*(-XM2*SIN(RMSS(31))*COSB+ | |
33978 | &XMU*SIN(RMSS(33))*SINB) | |
33979 | CALL PYEICG(4,2,AR,AI,WR,WI,1,ZR,ZI,FV1,FV2,FV3,IERR) | |
33980 | IF(IERR.NE.0) THEN | |
33981 | WRITE(MSTU(11),*) ' PROBLEM WITH PYEICG IN PYINOM ' | |
33982 | ENDIF | |
33983 | INDEX(1)=1 | |
33984 | INDEX(2)=2 | |
33985 | IF(WR(2).LT.WR(1)) THEN | |
33986 | INDEX(1)=2 | |
33987 | INDEX(2)=1 | |
33988 | ENDIF | |
33989 | ||
33990 | DO 240 I=1,2 | |
33991 | K=INDEX(I) | |
33992 | SMW(I)=SQRT(WR(K)) | |
33993 | S=0D0 | |
33994 | DO 220 J=1,2 | |
33995 | S=S+ZR(J,K)**2+ZI(J,K)**2 | |
33996 | 220 CONTINUE | |
33997 | DO 230 J=1,2 | |
33998 | UMIX(I,J)=ZR(J,K)/SQRT(S) | |
33999 | UMIXI(I,J)=-ZI(J,K)/SQRT(S) | |
34000 | IF(ABS(UMIX(I,J)).LT.1D-6) UMIX(I,J)=0D0 | |
34001 | IF(ABS(UMIXI(I,J)).LT.1D-6) UMIXI(I,J)=0D0 | |
34002 | 230 CONTINUE | |
34003 | 240 CONTINUE | |
34004 | IF(ABS(SMW(1)).LT.ABS(SMZ(1))) THEN | |
34005 | SMW(1)=SIGN(ABS(SMZ(1))+2D0*PMAS(PYCOMP(111),1),SMW(1)) | |
34006 | ENDIF | |
34007 | PMAS(PYCOMP(KSUSY1+24),1)=SMW(1) | |
34008 | PMAS(PYCOMP(KSUSY1+37),1)=SMW(2) | |
34009 | ||
34010 | C.....Find eigenvectors of X^* X | |
34011 | AI(1,1) = 0D0 | |
34012 | AI(2,2) = 0D0 | |
34013 | AR(1,1) = XM2**2+2D0*XMW**2*COSB**2 | |
34014 | AR(2,2) = XMU**2+2D0*XMW**2*SINB**2 | |
34015 | AR(1,2) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*SINB+ | |
34016 | &XMU*COS(RMSS(33))*COSB) | |
34017 | AI(1,2) = SQRT(2D0)*XMW*(-XM2*SIN(RMSS(31))*SINB+ | |
34018 | &XMU*SIN(RMSS(33))*COSB) | |
34019 | AR(2,1) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*SINB+ | |
34020 | &XMU*COS(RMSS(33))*COSB) | |
34021 | AI(2,1) = SQRT(2D0)*XMW*(XM2*SIN(RMSS(31))*SINB- | |
34022 | &XMU*SIN(RMSS(33))*COSB) | |
34023 | CALL PYEICG(4,2,AR,AI,WR,WI,1,ZR,ZI,FV1,FV2,FV3,IERR) | |
34024 | IF(IERR.NE.0) THEN | |
34025 | WRITE(MSTU(11),*) ' PROBLEM WITH PYEICG IN PYINOM ' | |
34026 | ENDIF | |
34027 | INDEX(1)=1 | |
34028 | INDEX(2)=2 | |
34029 | IF(WR(2).LT.WR(1)) THEN | |
34030 | INDEX(1)=2 | |
34031 | INDEX(2)=1 | |
34032 | ENDIF | |
34033 | ||
34034 | DO 270 I=1,2 | |
34035 | K=INDEX(I) | |
34036 | S=0D0 | |
34037 | DO 250 J=1,2 | |
34038 | S=S+ZR(J,K)**2+ZI(J,K)**2 | |
34039 | 250 CONTINUE | |
34040 | DO 260 J=1,2 | |
34041 | VMIX(I,J)=ZR(J,K)/SQRT(S) | |
34042 | VMIXI(I,J)=-ZI(J,K)/SQRT(S) | |
34043 | IF(ABS(VMIX(I,J)).LT.1D-6) VMIX(I,J)=0D0 | |
34044 | IF(ABS(VMIXI(I,J)).LT.1D-6) VMIXI(I,J)=0D0 | |
34045 | 260 CONTINUE | |
34046 | 270 CONTINUE | |
34047 | ||
34048 | ||
34049 | RETURN | |
34050 | END | |
34051 | ||
34052 | C********************************************************************* | |
34053 | ||
34054 | C...PYRNM3 | |
34055 | C...Calculates the running of M3, the SU(3) gluino mass parameter. | |
34056 | ||
34057 | FUNCTION PYRNM3(RGUT) | |
34058 | ||
34059 | C...Double precision and integer declarations. | |
34060 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
34061 | IMPLICIT INTEGER(I-N) | |
34062 | INTEGER PYK,PYCHGE,PYCOMP | |
34063 | ||
34064 | C...Local variables. | |
34065 | DOUBLE PRECISION R | |
34066 | DOUBLE PRECISION TOL | |
34067 | EXTERNAL PYALPS | |
34068 | DOUBLE PRECISION PYALPS | |
34069 | DATA TOL/0.001D0/ | |
34070 | DATA R/0.61803399D0/ | |
34071 | ||
34072 | C=1D0-R | |
34073 | ||
34074 | BX=RGUT*PYALPS(RGUT**2) | |
34075 | AX=MIN(50D0,BX*0.5D0) | |
34076 | CX=MAX(2000D0,2D0*BX) | |
34077 | ||
34078 | X0=AX | |
34079 | X3=CX | |
34080 | IF(ABS(CX-BX).GT.ABS(BX-AX))THEN | |
34081 | X1=BX | |
34082 | X2=BX+C*(CX-BX) | |
34083 | ELSE | |
34084 | X2=BX | |
34085 | X1=BX-C*(BX-AX) | |
34086 | ENDIF | |
34087 | AS1=PYALPS(X1**2) | |
34088 | F1=ABS(X1-RGUT*AS1) | |
34089 | AS2=PYALPS(X2**2) | |
34090 | F2=ABS(X2-RGUT*AS2) | |
34091 | 100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN | |
34092 | IF(F2.LT.F1) THEN | |
34093 | X0=X1 | |
34094 | X1=X2 | |
34095 | X2=R*X1+C*X3 | |
34096 | F1=F2 | |
34097 | AS2=PYALPS(X2**2) | |
34098 | F2=ABS(X2-RGUT*AS2) | |
34099 | ELSE | |
34100 | X3=X2 | |
34101 | X2=X1 | |
34102 | X1=R*X2+C*X0 | |
34103 | F2=F1 | |
34104 | AS1=PYALPS(X1**2) | |
34105 | F1=ABS(X1-RGUT*AS1) | |
34106 | ENDIF | |
34107 | GOTO 100 | |
34108 | ENDIF | |
34109 | IF(F1.LT.F2) THEN | |
34110 | PYRNM3=X1 | |
34111 | XMIN=X1 | |
34112 | ELSE | |
34113 | PYRNM3=X2 | |
34114 | XMIN=X2 | |
34115 | ENDIF | |
34116 | ||
34117 | RETURN | |
34118 | END | |
34119 | ||
34120 | C********************************************************************* | |
34121 | ||
34122 | C...PYEIG4 | |
34123 | C...Finds eigenvalues and eigenvectors to a 4 * 4 matrix. | |
34124 | C...Specific application: mixing in neutralino sector. | |
34125 | ||
34126 | SUBROUTINE PYEIG4(A,W,Z) | |
34127 | ||
34128 | C...Double precision and integer declarations. | |
34129 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
34130 | IMPLICIT INTEGER(I-N) | |
34131 | INTEGER PYK,PYCHGE,PYCOMP | |
34132 | ||
34133 | C...Arrays: in call and local. | |
34134 | DIMENSION A(4,4),W(4),Z(4,4),X(4),D(4,4),E(4) | |
34135 | ||
34136 | C...Coefficients of fourth-degree equation from matrix. | |
34137 | C...x**4 + b3 * x**3 + b2 * x**2 + b1 * x + b0 = 0. | |
34138 | B3=-(A(1,1)+A(2,2)+A(3,3)+A(4,4)) | |
34139 | B2=0D0 | |
34140 | DO 110 I=1,3 | |
34141 | DO 100 J=I+1,4 | |
34142 | B2=B2+A(I,I)*A(J,J)-A(I,J)*A(J,I) | |
34143 | 100 CONTINUE | |
34144 | 110 CONTINUE | |
34145 | B1=0D0 | |
34146 | B0=0D0 | |
34147 | DO 120 I=1,4 | |
34148 | I1=MOD(I,4)+1 | |
34149 | I2=MOD(I+1,4)+1 | |
34150 | I3=MOD(I+2,4)+1 | |
34151 | B1=B1+A(I,I)*(-A(I1,I1)*A(I2,I2)+A(I1,I2)*A(I2,I1)+ | |
34152 | & A(I1,I3)*A(I3,I1)+A(I2,I3)*A(I3,I2))- | |
34153 | & A(I,I1)*A(I1,I2)*A(I2,I)-A(I,I2)*A(I2,I1)*A(I1,I) | |
34154 | B0=B0+(-1D0)**(I+1)*A(1,I)*( | |
34155 | & A(2,I1)*(A(3,I2)*A(4,I3)-A(3,I3)*A(4,I2))+ | |
34156 | & A(2,I2)*(A(3,I3)*A(4,I1)-A(3,I1)*A(4,I3))+ | |
34157 | & A(2,I3)*(A(3,I1)*A(4,I2)-A(3,I2)*A(4,I1))) | |
34158 | 120 CONTINUE | |
34159 | ||
34160 | C...Coefficients of third-degree equation needed for | |
34161 | C...separation into two second-degree equations. | |
34162 | C...u**3 + c2 * u**2 + c1 * u + c0 = 0. | |
34163 | C2=-B2 | |
34164 | C1=B1*B3-4D0*B0 | |
34165 | C0=-B1**2-B0*B3**2+4D0*B0*B2 | |
34166 | CQ=C1/3D0-C2**2/9D0 | |
34167 | CR=C1*C2/6D0-C0/2D0-C2**3/27D0 | |
34168 | CQR=CQ**3+CR**2 | |
34169 | ||
34170 | C...Cases with one or three real roots. | |
34171 | IF(CQR.GE.0D0) THEN | |
34172 | S1=(CR+SQRT(CQR))**(1D0/3D0) | |
34173 | S2=(CR-SQRT(CQR))**(1D0/3D0) | |
34174 | U=S1+S2-C2/3D0 | |
34175 | ELSE | |
34176 | SABS=SQRT(-CQ) | |
34177 | THE=ACOS(CR/SABS**3)/3D0 | |
34178 | SRE=SABS*COS(THE) | |
34179 | U=2D0*SRE-C2/3D0 | |
34180 | ENDIF | |
34181 | ||
34182 | C...Find and solve two second-degree equations. | |
34183 | P1=B3/2D0-SQRT(B3**2/4D0+U-B2) | |
34184 | P2=B3/2D0+SQRT(B3**2/4D0+U-B2) | |
34185 | Q1=U/2D0+SQRT(U**2/4D0-B0) | |
34186 | Q2=U/2D0-SQRT(U**2/4D0-B0) | |
34187 | IF(ABS(P1*Q1+P2*Q2-B1).LT.ABS(P1*Q2+P2*Q1-B1)) THEN | |
34188 | QSAV=Q1 | |
34189 | Q1=Q2 | |
34190 | Q2=QSAV | |
34191 | ENDIF | |
34192 | X(1)=-P1/2D0+SQRT(P1**2/4D0-Q1) | |
34193 | X(2)=-P1/2D0-SQRT(P1**2/4D0-Q1) | |
34194 | X(3)=-P2/2D0+SQRT(P2**2/4D0-Q2) | |
34195 | X(4)=-P2/2D0-SQRT(P2**2/4D0-Q2) | |
34196 | ||
34197 | C...Order eigenvalues in asceding mass. | |
34198 | W(1)=X(1) | |
34199 | DO 150 I1=2,4 | |
34200 | DO 130 I2=I1-1,1,-1 | |
34201 | IF(ABS(X(I1)).GE.ABS(W(I2))) GOTO 140 | |
34202 | W(I2+1)=W(I2) | |
34203 | 130 CONTINUE | |
34204 | 140 W(I2+1)=X(I1) | |
34205 | 150 CONTINUE | |
34206 | ||
34207 | C...Find equation system for eigenvectors. | |
34208 | DO 250 I=1,4 | |
34209 | DO 170 J1=1,4 | |
34210 | D(J1,J1)=A(J1,J1)-W(I) | |
34211 | DO 160 J2=J1+1,4 | |
34212 | D(J1,J2)=A(J1,J2) | |
34213 | D(J2,J1)=A(J2,J1) | |
34214 | 160 CONTINUE | |
34215 | 170 CONTINUE | |
34216 | ||
34217 | C...Find largest element in matrix. | |
34218 | DAMAX=0D0 | |
34219 | DO 190 J1=1,4 | |
34220 | DO 180 J2=1,4 | |
34221 | IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 180 | |
34222 | JA=J1 | |
34223 | JB=J2 | |
34224 | DAMAX=ABS(D(J1,J2)) | |
34225 | 180 CONTINUE | |
34226 | 190 CONTINUE | |
34227 | ||
34228 | C...Subtract others by multiple of row selected above. | |
34229 | DAMAX=0D0 | |
34230 | DO 210 J3=JA+1,JA+3 | |
34231 | J1=J3-4*((J3-1)/4) | |
34232 | RL=D(J1,JB)/D(JA,JB) | |
34233 | DO 200 J2=1,4 | |
34234 | D(J1,J2)=D(J1,J2)-RL*D(JA,J2) | |
34235 | IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 200 | |
34236 | JC=J1 | |
34237 | JD=J2 | |
34238 | DAMAX=ABS(D(J1,J2)) | |
34239 | 200 CONTINUE | |
34240 | 210 CONTINUE | |
34241 | ||
34242 | C...Do one more subtraction of a row. | |
34243 | DAMAX=0D0 | |
34244 | DO 230 J3=JC+1,JC+3 | |
34245 | J1=J3-4*((J3-1)/4) | |
34246 | IF(J1.EQ.JA) GOTO 230 | |
34247 | RL=D(J1,JD)/D(JC,JD) | |
34248 | DO 220 J2=1,4 | |
34249 | IF(J2.EQ.JB) GOTO 220 | |
34250 | D(J1,J2)=D(J1,J2)-RL*D(JC,J2) | |
34251 | IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 220 | |
34252 | JE=J1 | |
34253 | DAMAX=ABS(D(J1,J2)) | |
34254 | 220 CONTINUE | |
34255 | 230 CONTINUE | |
34256 | ||
34257 | C...Construct unnormalized eigenvector. | |
34258 | JF1=JD+1-4*(JD/4) | |
34259 | JF2=JD+2-4*((JD+1)/4) | |
34260 | IF(JF1.EQ.JB) JF1=JD+3-4*((JD+2)/4) | |
34261 | IF(JF2.EQ.JB) JF2=JD+3-4*((JD+2)/4) | |
34262 | E(JF1)=-D(JE,JF2) | |
34263 | E(JF2)=D(JE,JF1) | |
34264 | E(JD)=-(D(JC,JF1)*E(JF1)+D(JC,JF2)*E(JF2))/D(JC,JD) | |
34265 | E(JB)=-(D(JA,JF1)*E(JF1)+D(JA,JF2)*E(JF2)+D(JA,JD)*E(JD))/ | |
34266 | & D(JA,JB) | |
34267 | ||
34268 | C...Normalize and fill in final array. | |
34269 | EA=SQRT(E(1)**2+E(2)**2+E(3)**2+E(4)**2) | |
34270 | SGN=(-1D0)**INT(PYR(0)+0.5D0) | |
34271 | DO 240 J=1,4 | |
34272 | Z(I,J)=SGN*E(J)/EA | |
34273 | 240 CONTINUE | |
34274 | 250 CONTINUE | |
34275 | ||
34276 | RETURN | |
34277 | END | |
34278 | ||
34279 | C********************************************************************* | |
34280 | ||
34281 | C...PYHGGM | |
34282 | C...Determines the Higgs boson mass spectrum using several inputs. | |
34283 | ||
34284 | SUBROUTINE PYHGGM(ALPHA) | |
34285 | ||
34286 | C...Double precision and integer declarations. | |
34287 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
34288 | IMPLICIT INTEGER(I-N) | |
34289 | INTEGER PYK,PYCHGE,PYCOMP | |
34290 | C...Parameter statement to help give large particle numbers. | |
34291 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
34292 | &KEXCIT=4000000,KDIMEN=5000000) | |
34293 | C...Commonblocks. | |
34294 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
34295 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
34296 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
34297 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
34298 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYMSSM/ | |
34299 | ||
34300 | C...Local variables. | |
34301 | DOUBLE PRECISION AT,AB,XMU,TANB | |
34302 | DOUBLE PRECISION ALPHA | |
34303 | INTEGER IHOPT | |
34304 | DOUBLE PRECISION DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD | |
34305 | DOUBLE PRECISION DMU,DMH,DHM,DMHCH,DSA,DCA,DTANBA | |
34306 | DOUBLE PRECISION DMC,DMDR,DMHP,DHMP,DAMP | |
34307 | DOUBLE PRECISION DSTOP1,DSTOP2,DSBOT1,DSBOT2 | |
34308 | ||
34309 | IHOPT=IMSS(4) | |
34310 | IF(IHOPT.EQ.2) THEN | |
34311 | ALPHA=RMSS(18) | |
34312 | RETURN | |
34313 | ENDIF | |
34314 | AT=RMSS(16) | |
34315 | AB=RMSS(15) | |
34316 | DMGL=RMSS(3) | |
34317 | XMU=RMSS(4) | |
34318 | TANB=RMSS(5) | |
34319 | ||
34320 | DMA=RMSS(19) | |
34321 | DTANB=TANB | |
34322 | DMQ=RMSS(10) | |
34323 | DMUR=RMSS(12) | |
34324 | DMDR=RMSS(11) | |
34325 | DMTOP=PMAS(6,1) | |
34326 | DMC=PMAS(PYCOMP(KSUSY1+37),1) | |
34327 | DAU=AT | |
34328 | DAD=AB | |
34329 | DMU=XMU | |
34330 | RMSS(40)=0D0 | |
34331 | RMSS(41)=0D0 | |
34332 | ||
34333 | IF(IHOPT.EQ.0) THEN | |
34334 | CALL PYSUBH (DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD,DMU,DMH,DHM, | |
34335 | & DMHCH,DSA,DCA,DTANBA) | |
34336 | ELSEIF(IHOPT.EQ.1) THEN | |
34337 | CALL PYSUBH (DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD,DMU,DMH,DHM, | |
34338 | & DMHCH,DSA,DCA,DTANBA) | |
34339 | CALL PYPOLE(3,DMC,DMA,DTANB,DMQ,DMUR,DMDR,DMTOP,DAU,DAD,DMU, | |
34340 | & DMH,DMHP,DHM,DHMP,DAMP,DSA,DCA, | |
34341 | & DSTOP1,DSTOP2,DSBOT1,DSBOT2,DTANBA,DMGL,DDT,DDB) | |
34342 | RMSS(40)=DDT | |
34343 | RMSS(41)=DDB | |
34344 | DMH=DMHP | |
34345 | DHM=DHMP | |
34346 | DMA=DAMP | |
34347 | IF(ABS(PMAS(PYCOMP(1000006),1)-DSTOP2).GT.5D-1) THEN | |
34348 | WRITE(MSTU(11),*) ' STOP1 MASS DOES NOT MATCH IN PYHGGM ' | |
34349 | WRITE(MSTU(11),*) ' STOP1 MASSES = ', | |
34350 | & PMAS(PYCOMP(1000006),1),DSTOP2 | |
34351 | ENDIF | |
34352 | IF(ABS(PMAS(PYCOMP(2000006),1)-DSTOP1).GT.5D-1) THEN | |
34353 | WRITE(MSTU(11),*) ' STOP2 MASS DOES NOT MATCH IN PYHGGM ' | |
34354 | WRITE(MSTU(11),*) ' STOP2 MASSES = ', | |
34355 | & PMAS(PYCOMP(2000006),1),DSTOP1 | |
34356 | ENDIF | |
34357 | IF(ABS(PMAS(PYCOMP(1000005),1)-DSBOT2).GT.5D-1) THEN | |
34358 | WRITE(MSTU(11),*) ' SBOT1 MASS DOES NOT MATCH IN PYHGGM ' | |
34359 | WRITE(MSTU(11),*) ' SBOT1 MASSES = ', | |
34360 | & PMAS(PYCOMP(1000005),1),DSBOT2 | |
34361 | ENDIF | |
34362 | IF(ABS(PMAS(PYCOMP(2000005),1)-DSBOT1).GT.5D-1) THEN | |
34363 | WRITE(MSTU(11),*) ' SBOT2 MASS DOES NOT MATCH IN PYHGGM ' | |
34364 | WRITE(MSTU(11),*) ' SBOT2 MASSES = ', | |
34365 | & PMAS(PYCOMP(2000005),1),DSBOT1 | |
34366 | ENDIF | |
34367 | ||
34368 | ENDIF | |
34369 | ||
34370 | ALPHA=ACOS(DCA) | |
34371 | ||
34372 | PMAS(25,1)=DMH | |
34373 | PMAS(35,1)=DHM | |
34374 | PMAS(36,1)=DMA | |
34375 | PMAS(37,1)=DMHCH | |
34376 | ||
34377 | RETURN | |
34378 | END | |
34379 | ||
34380 | C********************************************************************* | |
34381 | ||
34382 | C...PYSUBH | |
34383 | C...This routine computes the renormalization group improved | |
34384 | C...values of Higgs masses and couplings in the MSSM. | |
34385 | ||
34386 | C...Program based on the work by M. Carena, J.R. Espinosa, | |
34387 | c...M. Quiros and C.E.M. Wagner, CERN-preprint CERN-TH/95-45 | |
34388 | ||
34389 | C...Input: MA,TANB = TAN(BETA),MQ,MUR,MTOP,AU,AD,MU | |
34390 | C...All masses in GeV units. MA is the CP-odd Higgs mass, | |
34391 | C...MTOP is the physical top mass, MQ and MUR are the soft | |
34392 | C...supersymmetry breaking mass parameters of left handed | |
34393 | C...and right handed stops respectively, AU and AD are the | |
34394 | C...stop and sbottom trilinear soft breaking terms, | |
34395 | C...respectively, and MU is the supersymmetric | |
34396 | C...Higgs mass parameter. We use the conventions from | |
34397 | C...the physics report of Haber and Kane: left right | |
34398 | C...stop mixing term proportional to (AU - MU/TANB) | |
34399 | C...We use as input TANB defined at the scale MTOP | |
34400 | ||
34401 | C...Output: MH,HM,MHCH, SA = SIN(ALPHA), CA= COS(ALPHA), TANBA | |
34402 | C...where MH and HM are the lightest and heaviest CP-even | |
34403 | C...Higgs masses, MHCH is the charged Higgs mass and | |
34404 | C...ALPHA is the Higgs mixing angle | |
34405 | C...TANBA is the angle TANB at the CP-odd Higgs mass scale | |
34406 | ||
34407 | C...Range of validity: | |
34408 | C...(STOP1**2 - STOP2**2)/(STOP2**2 + STOP1**2) < 0.5 | |
34409 | C...(SBOT1**2 - SBOT2**2)/(SBOT2**2 + SBOT2**2) < 0.5 | |
34410 | C...where STOP1, STOP2, SBOT1 and SBOT2 are the stop and | |
34411 | C...are the sbottom mass eigenvalues, respectively. This | |
34412 | C...range automatically excludes the existence of tachyons. | |
34413 | C...For the charged Higgs mass computation, the method is | |
34414 | C...valid if | |
34415 | C...2 * |MB * AD* TANB| < M_SUSY**2, 2 * |MTOP * AU| < M_SUSY**2 | |
34416 | C...2 * |MB * MU * TANB| < M_SUSY**2, 2 * |MTOP * MU| < M_SUSY**2 | |
34417 | C...where M_SUSY**2 is the average of the squared stop mass | |
34418 | C...eigenvalues, M_SUSY**2 = (STOP1**2 + STOP2**2)/2. The sbottom | |
34419 | C...masses have been assumed to be of order of the stop ones | |
34420 | C...M_SUSY**2 = (MQ**2 + MUR**2)*0.5 + MTOP**2 | |
34421 | ||
34422 | SUBROUTINE PYSUBH (XMA,TANB,XMQ,XMUR,XMTOP,AU,AD,XMU,XMH,XHM, | |
34423 | &XMHCH,SA,CA,TANBA) | |
34424 | ||
34425 | C...Double precision and integer declarations. | |
34426 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
34427 | IMPLICIT INTEGER(I-N) | |
34428 | INTEGER PYK,PYCHGE,PYCOMP | |
34429 | C...Parameter statement to help give large particle numbers. | |
34430 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
34431 | &KEXCIT=4000000,KDIMEN=5000000) | |
34432 | C...Commonblocks. | |
34433 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
34434 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
34435 | COMMON/PYHTRI/HHH(7) | |
34436 | SAVE /PYDAT1/,/PYDAT2/ | |
34437 | ||
34438 | C...Local variables. | |
34439 | DOUBLE PRECISION PYALEM,PYALPS | |
34440 | DOUBLE PRECISION TANB,XMQ,XMUR,XMTOP,AU,AD,XMU,XMH,XHM | |
34441 | DOUBLE PRECISION XMHCH,SA,CA | |
34442 | DOUBLE PRECISION XMA,AEM,ALP1,ALP2,ALPH3Z,V,PI | |
34443 | DOUBLE PRECISION Q02 | |
34444 | DOUBLE PRECISION TANBA,TANBT,XMB,ALP3 | |
34445 | DOUBLE PRECISION RMTOP,XMS,T,SINB,COSB | |
34446 | DOUBLE PRECISION XLAM1,XLAM2,XLAM3,XLAM4,XLAM5,XLAM6 | |
34447 | DOUBLE PRECISION XLAM7,XAU,XAD,G1,G2,G3,HU,HD,HU2 | |
34448 | DOUBLE PRECISION HD2,HU4,HD4,SINBT,COSBT | |
34449 | DOUBLE PRECISION TRM2,DETM2,XMH2,XHM2,XMHCH2 | |
34450 | DOUBLE PRECISION SINALP,COSALP,AUD,PI2,XMS2,XMS4,AD2 | |
34451 | DOUBLE PRECISION AU2,XMU2,XMZ,XMS3 | |
34452 | ||
34453 | XMZ = PMAS(23,1) | |
34454 | Q02=XMZ**2 | |
34455 | AEM=PYALEM(Q02) | |
34456 | ALP1=AEM/(1D0-PARU(102)) | |
34457 | ALP2=AEM/PARU(102) | |
34458 | ALPH3Z=PYALPS(Q02) | |
34459 | ||
34460 | ALP1 = 0.0101D0 | |
34461 | ALP2 = 0.0337D0 | |
34462 | ALPH3Z = 0.12D0 | |
34463 | ||
34464 | V = 174.1D0 | |
34465 | PI = PARU(1) | |
34466 | TANBA = TANB | |
34467 | TANBT = TANB | |
34468 | ||
34469 | C...MBOTTOM(MTOP) = 3. GEV | |
34470 | XMB = PYMRUN(5,XMTOP**2) | |
34471 | ALP3 = ALPH3Z/(1D0 +(11D0 - 10D0/3D0)/4D0/PI*ALPH3Z* | |
34472 | &LOG(XMTOP**2/XMZ**2)) | |
34473 | ||
34474 | C...RMTOP= RUNNING TOP QUARK MASS | |
34475 | RMTOP = XMTOP/(1D0+4D0*ALP3/3D0/PI) | |
34476 | XMS = ((XMQ**2 + XMUR**2)/2D0 + XMTOP**2)**0.5D0 | |
34477 | T = LOG(XMS**2/XMTOP**2) | |
34478 | SINB = TANB/((1D0 + TANB**2)**0.5D0) | |
34479 | COSB = SINB/TANB | |
34480 | C...IF(MA.LE.XMTOP) TANBA = TANBT | |
34481 | IF(XMA.GT.XMTOP) | |
34482 | &TANBA = TANBT*(1D0-3D0/32D0/PI**2* | |
34483 | &(RMTOP**2/V**2/SINB**2-XMB**2/V**2/COSB**2)* | |
34484 | &LOG(XMA**2/XMTOP**2)) | |
34485 | ||
34486 | SINBT = TANBT/SQRT(1D0 + TANBT**2) | |
34487 | COSBT = 1D0/SQRT(1D0 + TANBT**2) | |
34488 | C COS2BT = (TANBT**2 - 1D0)/(TANBT**2 + 1D0) | |
34489 | G1 = SQRT(ALP1*4D0*PI) | |
34490 | G2 = SQRT(ALP2*4D0*PI) | |
34491 | G3 = SQRT(ALP3*4D0*PI) | |
34492 | HU = RMTOP/V/SINBT | |
34493 | HD = XMB/V/COSBT | |
34494 | HU2=HU*HU | |
34495 | HD2=HD*HD | |
34496 | HU4=HU2*HU2 | |
34497 | HD4=HD2*HD2 | |
34498 | AU2=AU**2 | |
34499 | AD2=AD**2 | |
34500 | XMS2=XMS**2 | |
34501 | XMS3=XMS**3 | |
34502 | XMS4=XMS2*XMS2 | |
34503 | XMU2=XMU*XMU | |
34504 | PI2=PI*PI | |
34505 | ||
34506 | XAU = (2D0*AU2/XMS2)*(1D0 - AU2/12D0/XMS2) | |
34507 | XAD = (2D0*AD2/XMS2)*(1D0 - AD2/12D0/XMS2) | |
34508 | AUD = (-6D0*XMU2/XMS2 - ( XMU2- AD*AU)**2/XMS4 | |
34509 | &+ 3D0*(AU + AD)**2/XMS2)/6D0 | |
34510 | XLAM1 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HD2*T/8D0/PI2) | |
34511 | &+(3D0*HD4/8D0/PI2) * (T + XAD/2D0 + (3D0*HD2/2D0 + HU2/2D0 | |
34512 | &- 8D0*G3**2) * (XAD*T + T**2)/16D0/PI2) | |
34513 | &-(3D0*HU4* XMU**4/96D0/PI2/XMS4) * (1+ (9D0*HU2 -5D0* HD2 | |
34514 | &- 16D0*G3**2) *T/16D0/PI2) | |
34515 | XLAM2 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HU2*T/8D0/PI2) | |
34516 | &+(3D0*HU4/8D0/PI2) * (T + XAU/2D0 + (3D0*HU2/2D0 + HD2/2D0 | |
34517 | &- 8D0*G3**2) * (XAU*T + T**2)/16D0/PI2) | |
34518 | &-(3D0*HD4* XMU**4/96D0/PI2/XMS4) * (1+ (9D0*HD2 -5D0* HU2 | |
34519 | &- 16D0*G3**2) *T/16D0/PI2) | |
34520 | XLAM3 = ((G2**2 - G1**2)/4D0)*(1D0-3D0* | |
34521 | &(HU2 + HD2)*T/16D0/PI2) | |
34522 | &+(6D0*HU2*HD2/16D0/PI2) * (T + AUD/2D0 + (HU2 + HD2 | |
34523 | &- 8D0*G3**2) * (AUD*T + T**2)/16D0/PI2) | |
34524 | &+(3D0*HU4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AU2/ | |
34525 | &XMS4)* (1D0+ (6D0*HU2 -2D0* HD2/2D0 | |
34526 | &- 16D0*G3**2) *T/16D0/PI2) | |
34527 | &+(3D0*HD4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AD2/ | |
34528 | &XMS4)*(1D0+ (6D0*HD2 -2D0* HU2 | |
34529 | &- 16D0*G3**2) *T/16D0/PI2) | |
34530 | XLAM4 = (- G2**2/2D0)*(1D0-3D0*(HU2 + HD2)*T/16D0/PI2) | |
34531 | &-(6D0*HU2*HD2/16D0/PI2) * (T + AUD/2D0 + (HU2 + HD2 | |
34532 | &- 8D0*G3**2) * (AUD*T + T**2)/16D0/PI2) | |
34533 | &+(3D0*HU4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AU2/ | |
34534 | &XMS4)* | |
34535 | &(1+ (6D0*HU2 -2D0* HD2 | |
34536 | &- 16D0*G3**2) *T/16D0/PI2) | |
34537 | &+(3D0*HD4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AD2/ | |
34538 | &XMS4)* | |
34539 | &(1+ (6D0*HD2 -2D0* HU2/2D0 | |
34540 | &- 16D0*G3**2) *T/16D0/PI2) | |
34541 | XLAM5 = -(3D0*HU4* XMU2*AU2/96D0/PI2/XMS4) * | |
34542 | &(1- (2D0*HD2 -6D0* HU2 + 16D0*G3**2) *T/16D0/PI2) | |
34543 | &-(3D0*HD4* XMU2*AD2/96D0/PI2/XMS4) * | |
34544 | &(1- (2D0*HU2 -6D0* HD2 + 16D0*G3**2) *T/16D0/PI2) | |
34545 | XLAM6 = (3D0*HU4* XMU**3*AU/96D0/PI2/XMS4) * | |
34546 | &(1- (7D0*HD2/2D0 -15D0* HU2/2D0 + 16D0*G3**2) *T/16D0/PI2) | |
34547 | &+(3D0*HD4* XMU *(AD**3/XMS3 - 6D0*AD/XMS )/96D0/PI2/XMS) * | |
34548 | &(1- (HU2/2D0 -9D0* HD2/2D0 + 16D0*G3**2) *T/16D0/PI2) | |
34549 | XLAM7 = (3D0*HD4* XMU**3*AD/96D0/PI2/XMS4) * | |
34550 | &(1- (7D0*HU2/2D0 -15D0* HD2/2D0 + 16D0*G3**2) *T/16D0/PI2) | |
34551 | &+(3D0*HU4* XMU *(AU**3/XMS3 - 6D0*AU/XMS )/96D0/PI2/XMS) * | |
34552 | &(1- (HD2/2D0 -9D0* HU2/2D0 + 16D0*G3**2) *T/16D0/PI2) | |
34553 | HHH(1)=XLAM1 | |
34554 | HHH(2)=XLAM2 | |
34555 | HHH(3)=XLAM3 | |
34556 | HHH(4)=XLAM4 | |
34557 | HHH(5)=XLAM5 | |
34558 | HHH(6)=XLAM6 | |
34559 | HHH(7)=XLAM7 | |
34560 | TRM2 = XMA**2 + 2D0*V**2* (XLAM1* COSBT**2 + | |
34561 | &2D0* XLAM6*SINBT*COSBT | |
34562 | &+ XLAM5*SINBT**2 + XLAM2* SINBT**2 + 2D0* XLAM7*SINBT*COSBT | |
34563 | &+ XLAM5*COSBT**2) | |
34564 | DETM2 = 4D0*V**4*(-(SINBT*COSBT*(XLAM3 + XLAM4) + | |
34565 | &XLAM6*COSBT**2 | |
34566 | &+ XLAM7* SINBT**2)**2 + (XLAM1* COSBT**2 + | |
34567 | &2D0* XLAM6* COSBT*SINBT | |
34568 | &+ XLAM5*SINBT**2)*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT | |
34569 | &+ XLAM5*COSBT**2)) + XMA**2*2D0*V**2 * | |
34570 | &((XLAM1* COSBT**2 +2D0* | |
34571 | &XLAM6* COSBT*SINBT + XLAM5*SINBT**2)*COSBT**2 + | |
34572 | &(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT + XLAM5*COSBT**2) | |
34573 | &*SINBT**2 | |
34574 | &+2D0*SINBT*COSBT* (SINBT*COSBT*(XLAM3 | |
34575 | &+ XLAM4) + XLAM6*COSBT**2 | |
34576 | &+ XLAM7* SINBT**2)) | |
34577 | ||
34578 | XMH2 = (TRM2 - SQRT(TRM2**2 - 4D0* DETM2))/2D0 | |
34579 | XHM2 = (TRM2 + SQRT(TRM2**2 - 4D0* DETM2))/2D0 | |
34580 | XHM = SQRT(XHM2) | |
34581 | XMH = SQRT(XMH2) | |
34582 | XMHCH2 = XMA**2 + (XLAM5 - XLAM4)* V**2 | |
34583 | XMHCH = SQRT(XMHCH2) | |
34584 | ||
34585 | SINALP = SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0) - | |
34586 | &((2D0*V**2*(XLAM1* COSBT**2 + 2D0* | |
34587 | &XLAM6* COSBT*SINBT | |
34588 | &+ XLAM5*SINBT**2) + XMA**2*SINBT**2) | |
34589 | &- (2D0*V**2*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT | |
34590 | &+ XLAM5*COSBT**2) + XMA**2*COSBT**2)))/ | |
34591 | &SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0))/2D0**0.5D0 | |
34592 | ||
34593 | COSALP = (2D0*(2D0*V**2*(SINBT*COSBT*(XLAM3 + XLAM4) + | |
34594 | &XLAM6*COSBT**2 + XLAM7* SINBT**2) - | |
34595 | &XMA**2*SINBT*COSBT))/2D0**0.5D0/ | |
34596 | &SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0)* | |
34597 | &(((TRM2**2 - 4D0* DETM2)**0.5D0) - | |
34598 | &((2D0*V**2*(XLAM1* COSBT**2 + 2D0* | |
34599 | &XLAM6* COSBT*SINBT | |
34600 | &+ XLAM5*SINBT**2) + XMA**2*SINBT**2) | |
34601 | &- (2D0*V**2*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT | |
34602 | &+ XLAM5*COSBT**2) + XMA**2*COSBT**2)))) | |
34603 | ||
34604 | SA = -SINALP | |
34605 | CA = -COSALP | |
34606 | ||
34607 | 100 CONTINUE | |
34608 | ||
34609 | RETURN | |
34610 | END | |
34611 | ||
34612 | C********************************************************************* | |
34613 | ||
34614 | C...PYPOLE | |
34615 | C...This subroutine computes the CP-even higgs and CP-odd pole | |
34616 | c...Higgs masses and mixing angles. | |
34617 | ||
34618 | C...Program based on the work by M. Carena, M. Quiros | |
34619 | C...and C.E.M. Wagner, "Effective potential methods and | |
34620 | C...the Higgs mass spectrum in the MSSM", CERN-TH/95-157 | |
34621 | ||
34622 | C...Inputs: IHIGGS(explained below),MCHI,MA,TANB,MQ,MUR,MDR,MTOP, | |
34623 | C...AT,AB,MU | |
34624 | C...where MCHI is the largest chargino mass, MA is the running | |
34625 | C...CP-odd higgs mass, TANB is the value of the ratio of vacuum | |
34626 | C...expectaion values at the scale MTOP, MQ is the third generation | |
34627 | C...left handed squark mass parameter, MUR is the third generation | |
34628 | C...right handed stop mass parameter, MDR is the third generation | |
34629 | C...right handed sbottom mass parameter, MTOP is the pole top quark | |
34630 | C...mass; AT,AB are the soft supersymmetry breaking trilinear | |
34631 | C...couplings of the stop and sbottoms, respectively, and MU is the | |
34632 | C...supersymmetric mass parameter | |
34633 | ||
34634 | C...The parameter IHIGGS=0,1,2,3 corresponds to the number of | |
34635 | C...Higgses whose pole mass is computed. If IHIGGS=0 only running | |
34636 | C...masses are given, what makes the running of the program | |
34637 | c...much faster and it is quite generally a good approximation | |
34638 | c...(for a theoretical discussion see ref. above). If IHIGGS=1, | |
34639 | C...only the pole mass for H is computed. If IHIGGS=2, then h and H, | |
34640 | c...and if IHIGGS=3, then h,H,A polarizations are computed | |
34641 | ||
34642 | C...Output: MH and MHP which are the lightest CP-even Higgs running | |
34643 | C...and pole masses, respectively; HM and HMP are the heaviest CP-even | |
34644 | C...Higgs running and pole masses, repectively; SA and CA are the | |
34645 | C...SIN(ALPHA) and COS(ALPHA) where ALPHA is the Higgs mixing angle | |
34646 | C...AMP is the CP-odd Higgs pole mass. STOP1,STOP2,SBOT1 and SBOT2 | |
34647 | C...are the stop and sbottom mass eigenvalues. Finally, TANBA is | |
34648 | C...the value of TANB at the CP-odd Higgs mass scale | |
34649 | ||
34650 | C...This subroutine makes use of CERN library subroutine | |
34651 | C...integration package, which makes the computation of the | |
34652 | C...pole Higgs masses somewhat faster. We thank P. Janot for this | |
34653 | C...improvement. Those who are not able to call the CERN | |
34654 | C...libraries, please use the subroutine SUBHPOLE2.F, which | |
34655 | C...although somewhat slower, gives identical results | |
34656 | ||
34657 | SUBROUTINE PYPOLE(IHIGGS,XMC,XMA,TANB,XMQ,XMUR,XMDR,XMT,AT,AB,XMU, | |
34658 | &XMH,XMHP,HM,HMP,AMP,SA,CA,STOP1,STOP2,SBOT1,SBOT2,TANBA,XMG,DT,DB) | |
34659 | ||
34660 | C...Double precision and integer declarations. | |
34661 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
34662 | IMPLICIT INTEGER(I-N) | |
34663 | ||
34664 | C...Parameters. | |
34665 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
34666 | SAVE /PYDAT1/ | |
34667 | INTEGER PYK,PYCHGE,PYCOMP | |
34668 | ||
34669 | C...Local variables. | |
34670 | DIMENSION DELTA(2,2),COUPT(2,2),T(2,2),SSTOP2(2), | |
34671 | &SSBOT2(2),B(2,2),COUPB(2,2), | |
34672 | &HCOUPT(2,2),HCOUPB(2,2), | |
34673 | &ACOUPT(2,2),ACOUPB(2,2),PR(3), POLAR(3) | |
34674 | ||
34675 | DELTA(1,1) = 1D0 | |
34676 | DELTA(2,2) = 1D0 | |
34677 | DELTA(1,2) = 0D0 | |
34678 | DELTA(2,1) = 0D0 | |
34679 | V = 174.1D0 | |
34680 | XMZ=91.18D0 | |
34681 | PI=PARU(1) | |
34682 | RXMT=PYMRUN(6,XMT**2) | |
34683 | CALL PYRGHM(XMC,XMA,TANB,XMQ,XMUR,XMDR,XMT,AT,AB, | |
34684 | &XMU,XMH,HM,XMCH,SA,CA,SAB,CAB,TANBA,XMG,DT,DB) | |
34685 | ||
34686 | SINB = TANB/(TANB**2+1D0)**0.5D0 | |
34687 | COSB = 1D0/(TANB**2+1D0)**0.5D0 | |
34688 | COS2B = SINB**2 - COSB**2 | |
34689 | SINBPA = SINB*CA + COSB*SA | |
34690 | COSBPA = COSB*CA - SINB*SA | |
34691 | RMBOT = PYMRUN(5,XMT**2) | |
34692 | XMQ2 = XMQ**2 | |
34693 | XMUR2 = XMUR**2 | |
34694 | IF(XMUR.LT.0D0) XMUR2=-XMUR2 | |
34695 | XMDR2 = XMDR**2 | |
34696 | XMST11 = RXMT**2 + XMQ2 - 0.35D0*XMZ**2*COS2B | |
34697 | XMST22 = RXMT**2 + XMUR2 - 0.15D0*XMZ**2*COS2B | |
34698 | IF(XMST11.LT.0D0) GOTO 500 | |
34699 | IF(XMST22.LT.0D0) GOTO 500 | |
34700 | XMSB11 = RMBOT**2 + XMQ2 + 0.42D0*XMZ**2*COS2B | |
34701 | XMSB22 = RMBOT**2 + XMDR2 + 0.08D0*XMZ**2*COS2B | |
34702 | IF(XMSB11.LT.0D0) GOTO 500 | |
34703 | IF(XMSB22.LT.0D0) GOTO 500 | |
34704 | C WMST11 = RXMT**2 + XMQ2 | |
34705 | C WMST22 = RXMT**2 + XMUR2 | |
34706 | XMST12 = RXMT*(AT - XMU/TANB) | |
34707 | XMSB12 = RMBOT*(AB - XMU*TANB) | |
34708 | ||
34709 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34710 | C...STOP EIGENVALUES CALCULATION | |
34711 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34712 | ||
34713 | STOP12 = 0.5D0*(XMST11+XMST22) + | |
34714 | &0.5D0*((XMST11+XMST22)**2 - | |
34715 | &4D0*(XMST11*XMST22 - XMST12**2))**0.5D0 | |
34716 | STOP22 = 0.5D0*(XMST11+XMST22) - | |
34717 | &0.5D0*((XMST11+XMST22)**2 - 4D0*(XMST11*XMST22 - | |
34718 | &XMST12**2))**0.5D0 | |
34719 | ||
34720 | IF(STOP22.LT.0D0) GOTO 500 | |
34721 | SSTOP2(1) = STOP12 | |
34722 | SSTOP2(2) = STOP22 | |
34723 | STOP1 = STOP12**0.5D0 | |
34724 | STOP2 = STOP22**0.5D0 | |
34725 | C STOP1W = STOP1 | |
34726 | C STOP2W = STOP2 | |
34727 | ||
34728 | IF(XMST12.EQ.0D0) XST11 = 1D0 | |
34729 | IF(XMST12.EQ.0D0) XST12 = 0D0 | |
34730 | IF(XMST12.EQ.0D0) XST21 = 0D0 | |
34731 | IF(XMST12.EQ.0D0) XST22 = 1D0 | |
34732 | ||
34733 | IF(XMST12.EQ.0D0) GOTO 110 | |
34734 | ||
34735 | 100 XST11 = XMST12/(XMST12**2+(XMST11-STOP12)**2)**0.5D0 | |
34736 | XST12 = - (XMST11-STOP12)/(XMST12**2+(XMST11-STOP12)**2)**0.5D0 | |
34737 | XST21 = XMST12/(XMST12**2+(XMST11-STOP22)**2)**0.5D0 | |
34738 | XST22 = - (XMST11-STOP22)/(XMST12**2+(XMST11-STOP22)**2)**0.5D0 | |
34739 | ||
34740 | 110 T(1,1) = XST11 | |
34741 | T(2,2) = XST22 | |
34742 | T(1,2) = XST12 | |
34743 | T(2,1) = XST21 | |
34744 | ||
34745 | SBOT12 = 0.5D0*(XMSB11+XMSB22) + | |
34746 | &0.5D0*((XMSB11+XMSB22)**2 - | |
34747 | &4D0*(XMSB11*XMSB22 - XMSB12**2))**0.5D0 | |
34748 | SBOT22 = 0.5D0*(XMSB11+XMSB22) - | |
34749 | &0.5D0*((XMSB11+XMSB22)**2 - 4D0*(XMSB11*XMSB22 - | |
34750 | &XMSB12**2))**0.5D0 | |
34751 | IF(SBOT22.LT.0D0) GOTO 500 | |
34752 | SBOT1 = SBOT12**0.5D0 | |
34753 | SBOT2 = SBOT22**0.5D0 | |
34754 | ||
34755 | SSBOT2(1) = SBOT12 | |
34756 | SSBOT2(2) = SBOT22 | |
34757 | ||
34758 | IF(XMSB12.EQ.0D0) XSB11 = 1D0 | |
34759 | IF(XMSB12.EQ.0D0) XSB12 = 0D0 | |
34760 | IF(XMSB12.EQ.0D0) XSB21 = 0D0 | |
34761 | IF(XMSB12.EQ.0D0) XSB22 = 1D0 | |
34762 | ||
34763 | IF(XMSB12.EQ.0D0) GOTO 130 | |
34764 | ||
34765 | 120 XSB11 = XMSB12/(XMSB12**2+(XMSB11-SBOT12)**2)**0.5D0 | |
34766 | XSB12 = - (XMSB11-SBOT12)/(XMSB12**2+(XMSB11-SBOT12)**2)**0.5D0 | |
34767 | XSB21 = XMSB12/(XMSB12**2+(XMSB11-SBOT22)**2)**0.5D0 | |
34768 | XSB22 = - (XMSB11-SBOT22)/(XMSB12**2+(XMSB11-SBOT22)**2)**0.5D0 | |
34769 | ||
34770 | 130 B(1,1) = XSB11 | |
34771 | B(2,2) = XSB22 | |
34772 | B(1,2) = XSB12 | |
34773 | B(2,1) = XSB21 | |
34774 | ||
34775 | ||
34776 | SINT = 0.2320D0 | |
34777 | SQR = DSQRT(2D0) | |
34778 | VP = 174.1D0*SQR | |
34779 | ||
34780 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34781 | C...STARTING OF LIGHT HIGGS | |
34782 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34783 | ||
34784 | IF(IHIGGS.EQ.0) GOTO 490 | |
34785 | ||
34786 | DO 150 I = 1,2 | |
34787 | DO 140 J = 1,2 | |
34788 | COUPT(I,J) = | |
34789 | & SINT*XMZ**2*2D0*SQR/174.1D0/3D0*SINBPA*(DELTA(I,J) + | |
34790 | & (3D0 - 8D0*SINT)/4D0/SINT*T(1,I)*T(1,J)) | |
34791 | & -RXMT**2/174.1D0**2*VP/SINB*CA*DELTA(I,J) | |
34792 | & -RXMT/VP/SINB*(AT*CA + XMU*SA)*(T(1,I)*T(2,J) + | |
34793 | & T(1,J)*T(2,I)) | |
34794 | 140 CONTINUE | |
34795 | 150 CONTINUE | |
34796 | ||
34797 | ||
34798 | DO 170 I = 1,2 | |
34799 | DO 160 J = 1,2 | |
34800 | COUPB(I,J) = | |
34801 | & -SINT*XMZ**2*2D0*SQR/174.1D0/6D0*SINBPA*(DELTA(I,J) + | |
34802 | & (3D0 - 4D0*SINT)/2D0/SINT*B(1,I)*B(1,J)) | |
34803 | & +RMBOT**2/174.1D0**2*VP/COSB*SA*DELTA(I,J) | |
34804 | & +RMBOT/VP/COSB*(AB*SA + XMU*CA)*(B(1,I)*B(2,J) + | |
34805 | & B(1,J)*B(2,I)) | |
34806 | 160 CONTINUE | |
34807 | 170 CONTINUE | |
34808 | ||
34809 | PRUN = XMH | |
34810 | EPS = 1D-4*PRUN | |
34811 | ITER = 0 | |
34812 | 180 ITER = ITER + 1 | |
34813 | DO 230 I3 = 1,3 | |
34814 | ||
34815 | PR(I3)=PRUN+(I3-2)*EPS/2 | |
34816 | P2=PR(I3)**2 | |
34817 | POLT = 0D0 | |
34818 | DO 200 I = 1,2 | |
34819 | DO 190 J = 1,2 | |
34820 | POLT = POLT + COUPT(I,J)**2*3D0* | |
34821 | & PYFINT(P2,SSTOP2(I),SSTOP2(J))/16D0/PI**2 | |
34822 | 190 CONTINUE | |
34823 | 200 CONTINUE | |
34824 | ||
34825 | POLB = 0D0 | |
34826 | DO 220 I = 1,2 | |
34827 | DO 210 J = 1,2 | |
34828 | POLB = POLB + COUPB(I,J)**2*3D0* | |
34829 | & PYFINT(P2,SSBOT2(I),SSBOT2(J))/16D0/PI**2 | |
34830 | 210 CONTINUE | |
34831 | 220 CONTINUE | |
34832 | C RXMT2 = RXMT**2 | |
34833 | XMT2=XMT**2 | |
34834 | ||
34835 | POLTT = | |
34836 | & 3D0*RXMT**2/8D0/PI**2/ V **2* | |
34837 | & CA**2/SINB**2 * | |
34838 | & (-2D0*XMT**2+0.5D0*P2)* | |
34839 | & PYFINT(P2,XMT2,XMT2) | |
34840 | ||
34841 | POL = POLT + POLB + POLTT | |
34842 | POLAR(I3) = P2 - XMH**2 - POL | |
34843 | 230 CONTINUE | |
34844 | DERIV = (POLAR(3)-POLAR(1))/EPS | |
34845 | DRUN = - POLAR(2)/DERIV | |
34846 | PRUN = PRUN + DRUN | |
34847 | P2 = PRUN**2 | |
34848 | IF( ABS(DRUN) .LT. 1D-4 .OR.ITER.GT.500) GOTO 240 | |
34849 | GOTO 180 | |
34850 | 240 CONTINUE | |
34851 | ||
34852 | XMHP = DSQRT(P2) | |
34853 | ||
34854 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34855 | C...END OF LIGHT HIGGS | |
34856 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34857 | ||
34858 | 250 IF(IHIGGS.EQ.1) GOTO 490 | |
34859 | ||
34860 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34861 | C... STARTING OF HEAVY HIGGS | |
34862 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34863 | ||
34864 | DO 270 I = 1,2 | |
34865 | DO 260 J = 1,2 | |
34866 | HCOUPT(I,J) = | |
34867 | & -SINT*XMZ**2*2D0*SQR/174.1D0/3D0*COSBPA*(DELTA(I,J) + | |
34868 | & (3D0 - 8D0*SINT)/4D0/SINT*T(1,I)*T(1,J)) | |
34869 | & -RXMT**2/174.1D0**2*VP/SINB*SA*DELTA(I,J) | |
34870 | & -RXMT/VP/SINB*(AT*SA - XMU*CA)*(T(1,I)*T(2,J) + | |
34871 | & T(1,J)*T(2,I)) | |
34872 | 260 CONTINUE | |
34873 | 270 CONTINUE | |
34874 | ||
34875 | DO 290 I = 1,2 | |
34876 | DO 280 J = 1,2 | |
34877 | HCOUPB(I,J) = | |
34878 | & SINT*XMZ**2*2D0*SQR/174.1D0/6D0*COSBPA*(DELTA(I,J) + | |
34879 | & (3D0 - 4D0*SINT)/2D0/SINT*B(1,I)*B(1,J)) | |
34880 | & -RMBOT**2/174.1D0**2*VP/COSB*CA*DELTA(I,J) | |
34881 | & -RMBOT/VP/COSB*(AB*CA - XMU*SA)*(B(1,I)*B(2,J) + | |
34882 | & B(1,J)*B(2,I)) | |
34883 | HCOUPB(I,J)=0D0 | |
34884 | 280 CONTINUE | |
34885 | 290 CONTINUE | |
34886 | ||
34887 | PRUN = HM | |
34888 | EPS = 1D-4*PRUN | |
34889 | ITER = 0 | |
34890 | 300 ITER = ITER + 1 | |
34891 | DO 350 I3 = 1,3 | |
34892 | PR(I3)=PRUN+(I3-2)*EPS/2 | |
34893 | HP2=PR(I3)**2 | |
34894 | ||
34895 | HPOLT = 0D0 | |
34896 | DO 320 I = 1,2 | |
34897 | DO 310 J = 1,2 | |
34898 | HPOLT = HPOLT + HCOUPT(I,J)**2*3D0* | |
34899 | & PYFINT(HP2,SSTOP2(I),SSTOP2(J))/16D0/PI**2 | |
34900 | 310 CONTINUE | |
34901 | 320 CONTINUE | |
34902 | ||
34903 | HPOLB = 0D0 | |
34904 | DO 340 I = 1,2 | |
34905 | DO 330 J = 1,2 | |
34906 | HPOLB = HPOLB + HCOUPB(I,J)**2*3D0* | |
34907 | & PYFINT(HP2,SSBOT2(I),SSBOT2(J))/16D0/PI**2 | |
34908 | 330 CONTINUE | |
34909 | 340 CONTINUE | |
34910 | ||
34911 | C RXMT2 = RXMT**2 | |
34912 | XMT2 = XMT**2 | |
34913 | ||
34914 | HPOLTT = | |
34915 | & 3D0*RXMT**2/8D0/PI**2/ V **2* | |
34916 | & SA**2/SINB**2 * | |
34917 | & (-2D0*XMT**2+0.5D0*HP2)* | |
34918 | & PYFINT(HP2,XMT2,XMT2) | |
34919 | ||
34920 | HPOL = HPOLT + HPOLB + HPOLTT | |
34921 | POLAR(I3) =HP2-HM**2-HPOL | |
34922 | 350 CONTINUE | |
34923 | DERIV = (POLAR(3)-POLAR(1))/EPS | |
34924 | DRUN = - POLAR(2)/DERIV | |
34925 | PRUN = PRUN + DRUN | |
34926 | HP2 = PRUN**2 | |
34927 | IF( ABS(DRUN) .LT. 1D-4 .OR.ITER.GT.500) GOTO 360 | |
34928 | GOTO 300 | |
34929 | 360 CONTINUE | |
34930 | ||
34931 | ||
34932 | 370 CONTINUE | |
34933 | HMP = HP2**0.5D0 | |
34934 | ||
34935 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34936 | C... END OF HEAVY HIGGS | |
34937 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34938 | ||
34939 | IF(IHIGGS.EQ.2) GOTO 490 | |
34940 | ||
34941 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34942 | C...BEGINNING OF PSEUDOSCALAR HIGGS | |
34943 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
34944 | ||
34945 | DO 390 I = 1,2 | |
34946 | DO 380 J = 1,2 | |
34947 | ACOUPT(I,J) = | |
34948 | & -RXMT/VP/SINB*(AT*COSB + XMU*SINB)* | |
34949 | & (T(1,I)*T(2,J) -T(1,J)*T(2,I)) | |
34950 | 380 CONTINUE | |
34951 | 390 CONTINUE | |
34952 | DO 410 I = 1,2 | |
34953 | DO 400 J = 1,2 | |
34954 | ACOUPB(I,J) = | |
34955 | & RMBOT/VP/COSB*(AB*SINB + XMU*COSB)* | |
34956 | & (B(1,I)*B(2,J) -B(1,J)*B(2,I)) | |
34957 | 400 CONTINUE | |
34958 | 410 CONTINUE | |
34959 | ||
34960 | PRUN = XMA | |
34961 | EPS = 1D-4*PRUN | |
34962 | ITER = 0 | |
34963 | 420 ITER = ITER + 1 | |
34964 | DO 470 I3 = 1,3 | |
34965 | PR(I3)=PRUN+(I3-2)*EPS/2 | |
34966 | AP2=PR(I3)**2 | |
34967 | APOLT = 0D0 | |
34968 | DO 440 I = 1,2 | |
34969 | DO 430 J = 1,2 | |
34970 | APOLT = APOLT + ACOUPT(I,J)**2*3D0* | |
34971 | & PYFINT(AP2,SSTOP2(I),SSTOP2(J))/16D0/PI**2 | |
34972 | 430 CONTINUE | |
34973 | 440 CONTINUE | |
34974 | APOLB = 0D0 | |
34975 | DO 460 I = 1,2 | |
34976 | DO 450 J = 1,2 | |
34977 | APOLB = APOLB + ACOUPB(I,J)**2*3D0* | |
34978 | & PYFINT(AP2,SSBOT2(I),SSBOT2(J))/16D0/PI**2 | |
34979 | 450 CONTINUE | |
34980 | 460 CONTINUE | |
34981 | C RXMT2 = RXMT**2 | |
34982 | XMT2=XMT**2 | |
34983 | APOLTT = | |
34984 | & 3D0*RXMT**2/8D0/PI**2/ V **2* | |
34985 | & COSB**2/SINB**2 * | |
34986 | & (-0.5D0*AP2)* | |
34987 | & PYFINT(AP2,XMT2,XMT2) | |
34988 | APOL = APOLT + APOLB + APOLTT | |
34989 | POLAR(I3) = AP2 - XMA**2 -APOL | |
34990 | 470 CONTINUE | |
34991 | DERIV = (POLAR(3)-POLAR(1))/EPS | |
34992 | DRUN = - POLAR(2)/DERIV | |
34993 | PRUN = PRUN + DRUN | |
34994 | AP2 = PRUN**2 | |
34995 | IF( ABS(DRUN) .LT. 1D-4 .OR.ITER.GT.500) GOTO 480 | |
34996 | GOTO 420 | |
34997 | 480 CONTINUE | |
34998 | ||
34999 | AMP = DSQRT(AP2) | |
35000 | ||
35001 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35002 | C...END OF PSEUDOSCALAR HIGGS | |
35003 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35004 | ||
35005 | IF(IHIGGS.EQ.3) GOTO 490 | |
35006 | ||
35007 | 490 CONTINUE | |
35008 | RETURN | |
35009 | 500 CONTINUE | |
35010 | WRITE(MSTU(11),*) ' EXITING IN PYPOLE ' | |
35011 | WRITE(MSTU(11),*) ' XMST11,XMST22 = ',XMST11,XMST22 | |
35012 | WRITE(MSTU(11),*) ' XMSB11,XMSB22 = ',XMSB11,XMSB22 | |
35013 | WRITE(MSTU(11),*) ' STOP22,SBOT22 = ',STOP22,SBOT22 | |
35014 | STOP | |
35015 | END | |
35016 | ||
35017 | C********************************************************************* | |
35018 | ||
35019 | C...PYRGHM | |
35020 | C...Auxiliary to PYPOLE. | |
35021 | ||
35022 | SUBROUTINE PYRGHM(MCHI,MA,TANB,MQ,MUR,MD,MTOP,AU,AD,MU, | |
35023 | * MHP,HMP,MCH,SA,CA,SAB,CAB,TANBA,MGLU,DELTAMT,DELTAMB) | |
35024 | IMPLICIT DOUBLE PRECISION(A-H,L,M,O-Z) | |
35025 | DIMENSION VH(2,2),M2(2,2),M2P(2,2) | |
35026 | C...Parameters. | |
35027 | INTEGER MSTU,MSTJ | |
35028 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
35029 | SAVE /PYDAT1/ | |
35030 | ||
35031 | MZ = 91.18D0 | |
35032 | PI = PARU(1) | |
35033 | V = 174.1D0 | |
35034 | ALPHA1 = 0.0101D0 | |
35035 | ALPHA2 = 0.0337D0 | |
35036 | ALPHA3Z = 0.12D0 | |
35037 | TANBA = TANB | |
35038 | TANBT = TANB | |
35039 | C MBOTTOM(MTOP) = 3. GEV | |
35040 | MB = PYMRUN(5,MTOP**2) | |
35041 | ALPHA3 = ALPHA3Z/(1D0 +(11D0 - 10D0/3D0)/4D0/PI*ALPHA3Z* | |
35042 | *LOG(MTOP**2/MZ**2)) | |
35043 | C RMTOP= RUNNING TOP QUARK MASS | |
35044 | RMTOP = MTOP/(1D0+4D0*ALPHA3/3D0/PI) | |
35045 | TQ = LOG((MQ**2+MTOP**2)/MTOP**2) | |
35046 | TU = LOG((MUR**2 + MTOP**2)/MTOP**2) | |
35047 | TD = LOG((MD**2 + MTOP**2)/MTOP**2) | |
35048 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35049 | C | |
35050 | C NEW DEFINITION, TGLU. | |
35051 | C | |
35052 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35053 | TGLU = LOG(MGLU**2/MTOP**2) | |
35054 | SINB = TANB/DSQRT(1D0 + TANB**2) | |
35055 | COSB = SINB/TANB | |
35056 | IF(MA.GT.MTOP) | |
35057 | *TANBA = TANB*(1D0-3D0/32D0/PI**2* | |
35058 | *(RMTOP**2/V**2/SINB**2-MB**2/V**2/COSB**2)* | |
35059 | *LOG(MA**2/MTOP**2)) | |
35060 | IF(MA.LT.MTOP.OR.MA.EQ.MTOP) TANBT = TANBA | |
35061 | SINB = TANBT/SQRT(1D0 + TANBT**2) | |
35062 | COSB = 1D0/DSQRT(1D0 + TANBT**2) | |
35063 | G1 = SQRT(ALPHA1*4D0*PI) | |
35064 | G2 = SQRT(ALPHA2*4D0*PI) | |
35065 | G3 = SQRT(ALPHA3*4D0*PI) | |
35066 | HU = RMTOP/V/SINB | |
35067 | HD = MB/V/COSB | |
35068 | CALL PYGFXX(MA,TANBA,MQ,MUR,MD,MTOP,AU,AD,MU,MGLU,VH,STOP1,STOP2, | |
35069 | *SBOT1,SBOT2,DELTAMT,DELTAMB) | |
35070 | IF(MQ.GT.MUR) TP = TQ - TU | |
35071 | IF(MQ.LT.MUR.OR.MQ.EQ.MUR) TP = TU - TQ | |
35072 | IF(MQ.GT.MUR) TDP = TU | |
35073 | IF(MQ.LT.MUR.OR.MQ.EQ.MUR) TDP = TQ | |
35074 | IF(MQ.GT.MD) TPD = TQ - TD | |
35075 | IF(MQ.LT.MD.OR.MQ.EQ.MD) TPD = TD - TQ | |
35076 | IF(MQ.GT.MD) TDPD = TD | |
35077 | IF(MQ.LT.MD.OR.MQ.EQ.MD) TDPD = TQ | |
35078 | ||
35079 | IF(MQ.GT.MD) DLAMBDA1 = 6D0/96D0/PI**2*G1**2*HD**2*TPD | |
35080 | IF(MQ.LT.MD.OR.MQ.EQ.MD) DLAMBDA1 = 3D0/32D0/PI**2* | |
35081 | * HD**2*(G1**2/3D0+G2**2)*TPD | |
35082 | ||
35083 | IF(MQ.GT.MUR) DLAMBDA2 =12D0/96D0/PI**2*G1**2*HU**2*TP | |
35084 | IF(MQ.LT.MUR.OR.MQ.EQ.MUR) DLAMBDA2 = 3D0/32D0/PI**2* | |
35085 | * HU**2*(-G1**2/3D0+G2**2)*TP | |
35086 | ||
35087 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35088 | C | |
35089 | C DLAMBDAP1 AND DLAMBDAP2 ARE THE NEW LOG CORRECTIONS DUE TO | |
35090 | C THE PRESENCE OF THE GLUINO MASS. THEY ARE IN GENERAL VERY SMALL, | |
35091 | C AND ONLY PRESENT IF THERE IS A HIERARCHY OF MASSES BETWEEN THE | |
35092 | C TWO STOPS. | |
35093 | C | |
35094 | C | |
35095 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35096 | ||
35097 | DLAMBDAP2 = 0D0 | |
35098 | IF(MGLU.LT.MUR.OR.MGLU.LT.MQ) THEN | |
35099 | IF(MQ.GT.MUR.AND.MGLU.GT.MUR) THEN | |
35100 | DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TGLU**2) | |
35101 | ENDIF | |
35102 | ||
35103 | IF(MQ.GT.MUR.AND.MGLU.LT.MUR) THEN | |
35104 | DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TU**2) | |
35105 | ENDIF | |
35106 | ||
35107 | IF(MQ.GT.MUR.AND.MGLU.EQ.MUR) THEN | |
35108 | DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TU**2) | |
35109 | ENDIF | |
35110 | ||
35111 | IF(MUR.GT.MQ.AND.MGLU.GT.MQ) THEN | |
35112 | DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TGLU**2) | |
35113 | ENDIF | |
35114 | ||
35115 | IF(MUR.GT.MQ.AND.MGLU.LT.MQ) THEN | |
35116 | DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TQ**2) | |
35117 | ENDIF | |
35118 | ||
35119 | IF(MUR.GT.MQ.AND.MGLU.EQ.MQ) THEN | |
35120 | DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TQ**2) | |
35121 | ENDIF | |
35122 | ENDIF | |
35123 | DLAMBDA3 = 0D0 | |
35124 | DLAMBDA4 = 0D0 | |
35125 | IF(MQ.GT.MD) DLAMBDA3 = -1D0/32D0/PI**2*G1**2*HD**2*TPD | |
35126 | IF(MQ.LT.MD.OR.MQ.EQ.MD) DLAMBDA3 = 3D0/64D0/PI**2*HD**2* | |
35127 | *(G2**2-G1**2/3D0)*TPD | |
35128 | IF(MQ.GT.MUR) DLAMBDA3 = DLAMBDA3 - | |
35129 | *1D0/16D0/PI**2*G1**2*HU**2*TP | |
35130 | IF(MQ.LT.MUR.OR.MQ.EQ.MUR) DLAMBDA3 = DLAMBDA3 + | |
35131 | * 3D0/64D0/PI**2*HU**2*(G2**2+G1**2/3D0)*TP | |
35132 | IF(MQ.LT.MUR) DLAMBDA4 = -3D0/32D0/PI**2*G2**2*HU**2*TP | |
35133 | IF(MQ.LT.MD) DLAMBDA4 = DLAMBDA4 - 3D0/32D0/PI**2*G2**2* | |
35134 | *HD**2*TPD | |
35135 | LAMBDA1 = ((G1**2 + G2**2)/4D0)* | |
35136 | * (1D0-3D0*HD**2*(TPD + TDPD)/8D0/PI**2) | |
35137 | *+(3D0*HD**4D0/16D0/PI**2) *TPD*(1D0 | |
35138 | *+ (3D0*HD**2/2D0 + HU**2/2D0 | |
35139 | *- 8D0*G3**2) * (TPD + 2D0*TDPD)/16D0/PI**2) | |
35140 | *+(3D0*HD**4D0/8D0/PI**2) *TDPD*(1D0 + (3D0*HD**2/2D0 + HU**2/2D0 | |
35141 | *- 8D0*G3**2) * TDPD/16D0/PI**2) + DLAMBDA1 | |
35142 | LAMBDA2 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HU**2* | |
35143 | *(TP + TDP)/8D0/PI**2) | |
35144 | *+(3D0*HU**4D0/16D0/PI**2) *TP*(1D0 | |
35145 | *+ (3D0*HU**2/2D0 + HD**2/2D0 | |
35146 | *- 8D0*G3**2) * (TP + 2D0*TDP)/16D0/PI**2) | |
35147 | *+(3D0*HU**4D0/8D0/PI**2) *TDP*(1D0 + (3D0*HU**2/2D0 + HD**2/2D0 | |
35148 | *- 8D0*G3**2) * TDP/16D0/PI**2) + DLAMBDA2 + DLAMBDAP2 | |
35149 | LAMBDA3 = ((G2**2 - G1**2)/4D0)*(1D0-3D0* | |
35150 | *(HU**2)*(TP + TDP)/16D0/PI**2 -3D0* | |
35151 | *(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAMBDA3 | |
35152 | LAMBDA4 = (- G2**2/2D0)*(1D0 | |
35153 | *-3D0*(HU**2)*(TP + TDP)/16D0/PI**2 | |
35154 | *-3D0*(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAMBDA4 | |
35155 | ||
35156 | LAMBDA5 = 0D0 | |
35157 | LAMBDA6 = 0D0 | |
35158 | LAMBDA7 = 0D0 | |
35159 | ||
35160 | M2(1,1) = 2D0*V**2*(LAMBDA1*COSB**2+2D0*LAMBDA6* | |
35161 | *COSB*SINB + LAMBDA5*SINB**2) + MA**2*SINB**2 | |
35162 | ||
35163 | M2(2,2) = 2D0*V**2*(LAMBDA5*COSB**2+2D0*LAMBDA7* | |
35164 | *COSB*SINB + LAMBDA2*SINB**2) + MA**2*COSB**2 | |
35165 | M2(1,2) = 2D0*V**2*(LAMBDA6*COSB**2+(LAMBDA3+LAMBDA4)* | |
35166 | *COSB*SINB + LAMBDA7*SINB**2) - MA**2*SINB*COSB | |
35167 | ||
35168 | M2(2,1) = M2(1,2) | |
35169 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35170 | CCC THIS IS THE CONTRIBUTION FROM LIGHT CHARGINOS/NEUTRALINOS | |
35171 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35172 | ||
35173 | MSSUSY=DSQRT(.5D0*(MQ**2+MUR**2)+MTOP**2) | |
35174 | ||
35175 | IF(MCHI.GT.MSSUSY) GOTO 100 | |
35176 | IF(MCHI.LT.MTOP) MCHI=MTOP | |
35177 | ||
35178 | TCHAR=LOG(MSSUSY**2/MCHI**2) | |
35179 | ||
35180 | DELTAL12=(9D0/64D0/PI**2*G2**4+5D0/192D0/PI**2*G1**4)*TCHAR | |
35181 | DELTAL3P4=(3D0/64D0/PI**2*G2**4+7D0/192D0/PI**2*G1**4 | |
35182 | *+4D0/32D0/PI**2*G1**2*G2**2)*TCHAR | |
35183 | ||
35184 | DELTAM112=2D0*DELTAL12*V**2*COSB**2 | |
35185 | DELTAM222=2D0*DELTAL12*V**2*SINB**2 | |
35186 | DELTAM122=2D0*DELTAL3P4*V**2*SINB*COSB | |
35187 | ||
35188 | M2(1,1)=M2(1,1)+DELTAM112 | |
35189 | M2(2,2)=M2(2,2)+DELTAM222 | |
35190 | M2(1,2)=M2(1,2)+DELTAM122 | |
35191 | M2(2,1)=M2(2,1)+DELTAM122 | |
35192 | ||
35193 | 100 CONTINUE | |
35194 | ||
35195 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35196 | CCC END OF CHARGINOS/NEUTRALINOS | |
35197 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35198 | ||
35199 | DO 120 I = 1,2 | |
35200 | DO 110 J = 1,2 | |
35201 | M2P(I,J) = M2(I,J) + VH(I,J) | |
35202 | 110 CONTINUE | |
35203 | 120 CONTINUE | |
35204 | TRM2P = M2P(1,1) + M2P(2,2) | |
35205 | DETM2P = M2P(1,1)*M2P(2,2) - M2P(1,2)*M2P(2,1) | |
35206 | MH2P = (TRM2P - DSQRT(TRM2P**2 - 4D0* DETM2P))/2D0 | |
35207 | HM2P = (TRM2P + DSQRT(TRM2P**2 - 4D0* DETM2P))/2D0 | |
35208 | HMP = DSQRT(HM2P) | |
35209 | MCH2=MA**2+(LAMBDA5-LAMBDA4)*V**2 | |
35210 | MCH=DSQRT(MCH2) | |
35211 | IF(MH2P.LT.0.) GOTO 130 | |
35212 | MHP = SQRT(MH2P) | |
35213 | SIN2ALPHA = 2D0*M2P(1,2)/SQRT(TRM2P**2-4D0*DETM2P) | |
35214 | COS2ALPHA = (M2P(1,1)-M2P(2,2))/SQRT(TRM2P**2-4D0*DETM2P) | |
35215 | IF(COS2ALPHA.GE.0.) THEN | |
35216 | ALPHA = ASIN(SIN2ALPHA)/2D0 | |
35217 | ELSE | |
35218 | ALPHA = -PI/2D0-ASIN(SIN2ALPHA)/2D0 | |
35219 | ENDIF | |
35220 | SA = SIN(ALPHA) | |
35221 | CA = COS(ALPHA) | |
35222 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35223 | C | |
35224 | C HERE THE VALUES OF SAB AND CAB ARE DEFINED, IN ORDER | |
35225 | C TO DEFINE THE NEW COUPLINGS OF THE LIGHTEST AND | |
35226 | C HEAVY CP-EVEN HIGGS TO THE BOTTOM QUARK. | |
35227 | C | |
35228 | C | |
35229 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35230 | SAB = SA*(1D0-DELTAMB/(1D0+DELTAMB)*(1D0+CA/SA/TANB)) | |
35231 | CAB = CA*(1D0-DELTAMB/(1D0+DELTAMB)*(1D0-SA/CA/TANB)) | |
35232 | 130 CONTINUE | |
35233 | RETURN | |
35234 | END | |
35235 | ||
35236 | C********************************************************************* | |
35237 | ||
35238 | C...PYGFXX | |
35239 | C...Auxiliary to PYRGHM. | |
35240 | ||
35241 | SUBROUTINE PYGFXX(MA,TANB,MQ,MUR,MD,MTOP,AT,AB,XMU,XMGL,VH, | |
35242 | * STOP1,STOP2,SBOT1,SBOT2,DELTAMT,DELTAMB) | |
35243 | IMPLICIT DOUBLE PRECISION(A-H,M,O-Z) | |
35244 | DIMENSION VH(2,2),VH3T(2,2),VH3B(2,2),AL(2,2) | |
35245 | C...Commonblocks. | |
35246 | INTEGER MSTU,MSTJ,KCHG | |
35247 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
35248 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
35249 | SAVE /PYDAT1/,/PYDAT2/ | |
35250 | ||
35251 | G(X,Y) = 2.D0 - (X+Y)/(X-Y)*DLOG(X/Y) | |
35252 | ||
35253 | T(X,Y,Z) = (X**2*Y**2*LOG(X**2/Y**2) + X**2*Z**2*LOG(Z**2/X**2) | |
35254 | * + Y**2*Z**2*LOG(Y**2/Z**2))/((X**2-Y**2)*(Y**2-Z**2)*(X**2-Z**2)) | |
35255 | ||
35256 | IF(DABS(XMU).LT.0.000001D0) XMU = 0.000001D0 | |
35257 | MQ2 = MQ**2 | |
35258 | MUR2 = MUR**2 | |
35259 | MD2 = MD**2 | |
35260 | TANBA = TANB | |
35261 | SINBA = TANBA/DSQRT(TANBA**2+1D0) | |
35262 | COSBA = SINBA/TANBA | |
35263 | ||
35264 | SINB = TANB/DSQRT(TANB**2+1D0) | |
35265 | COSB = SINB/TANB | |
35266 | ||
35267 | PI = PARU(1) | |
35268 | MZ = PMAS(23,1) | |
35269 | MW = PMAS(24,1) | |
35270 | SW = 1D0-MW**2/MZ**2 | |
35271 | V = 174.1D0 | |
35272 | ||
35273 | ALPHA3 = 0.12D0/(1D0+23/12D0/PI*0.12D0*LOG(MTOP**2/MZ**2)) | |
35274 | G2 = DSQRT(0.0336D0*4D0*PI) | |
35275 | G1 = DSQRT(0.0101D0*4D0*PI) | |
35276 | ||
35277 | IF(MQ.GT.MUR) MST = MQ | |
35278 | IF(MUR.GT.MQ.OR.MUR.EQ.MQ) MST = MUR | |
35279 | ||
35280 | MSUSYT = DSQRT(MST**2 + MTOP**2) | |
35281 | ||
35282 | IF(MQ.GT.MD) MSB = MQ | |
35283 | IF(MD.GT.MQ.OR.MD.EQ.MQ) MSB = MD | |
35284 | ||
35285 | MB = PYMRUN(5,MSB**2) | |
35286 | MSUSYB = DSQRT(MSB**2 + MB**2) | |
35287 | TT = LOG(MSUSYT**2/MTOP**2) | |
35288 | TB = LOG(MSUSYB**2/MTOP**2) | |
35289 | ||
35290 | RMTOP = MTOP/(1D0+4D0*ALPHA3/3D0/PI) | |
35291 | HT = RMTOP/(V*SINB) | |
35292 | HTST = RMTOP/V | |
35293 | HB = MB/V/COSB | |
35294 | G32 = ALPHA3*4D0*PI | |
35295 | BT2 = -(8D0*G32 - 9D0*HT**2/2D0 - HB**2/2D0)/(4D0*PI)**2 | |
35296 | BB2 = -(8D0*G32 - 9D0*HB**2/2D0 - HT**2/2D0)/(4D0*PI)**2 | |
35297 | AL2 = 3D0/8D0/PI**2*HT**2 | |
35298 | C BT2ST = -(8.*G32 - 9.*HTST**2/2.)/(4.*PI)**2 | |
35299 | C ALST = 3./8./PI**2*HTST**2 | |
35300 | AL1 = 3D0/8D0/PI**2*HB**2 | |
35301 | ||
35302 | AL(1,1) = AL1 | |
35303 | AL(1,2) = (AL2+AL1)/2D0 | |
35304 | AL(2,1) = (AL2+AL1)/2D0 | |
35305 | AL(2,2) = AL2 | |
35306 | ||
35307 | IF(MA.GT.MTOP) THEN | |
35308 | VI = V*(1D0 + 3D0/32D0/PI**2*HTST**2* | |
35309 | * LOG(MTOP**2/MA**2)) | |
35310 | H1I = VI* COSBA | |
35311 | H2I = VI*SINBA | |
35312 | H1T = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MA**2/MSUSYT**2))**.25D0 | |
35313 | H2T = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MA**2/MSUSYT**2))**.25D0 | |
35314 | H1B = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MA**2/MSUSYB**2))**.25D0 | |
35315 | H2B = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MA**2/MSUSYB**2))**.25D0 | |
35316 | ELSE | |
35317 | VI = V | |
35318 | H1I = VI*COSB | |
35319 | H2I = VI*SINB | |
35320 | H1T=H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MTOP**2/MSUSYT**2))**.25D0 | |
35321 | H2T=H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MTOP**2/MSUSYT**2))**.25D0 | |
35322 | H1B=H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MTOP**2/MSUSYB**2))**.25D0 | |
35323 | H2B=H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MTOP**2/MSUSYB**2))**.25D0 | |
35324 | ENDIF | |
35325 | ||
35326 | TANBST = H2T/H1T | |
35327 | SINBT = TANBST/DSQRT(1D0+TANBST**2) | |
35328 | ||
35329 | TANBSB = H2B/H1B | |
35330 | SINBB = TANBSB/DSQRT(1D0+TANBSB**2) | |
35331 | COSBB = SINBB/TANBSB | |
35332 | ||
35333 | DELTAMT = 0D0 | |
35334 | DELTAMB = 0D0 | |
35335 | ||
35336 | MTOP4 = RMTOP**4*(1D0+2D0*BT2*TT- AL2*TT - 4D0*DELTAMT) | |
35337 | MTOP2 = DSQRT(MTOP4) | |
35338 | MBOT4 = MB**4*(1D0+2D0*BB2*TB - AL1*TB) | |
35339 | * /(1D0+DELTAMB)**4 | |
35340 | MBOT2 = DSQRT(MBOT4) | |
35341 | ||
35342 | STOP12 = (MQ2 + MUR2)*.5D0 + MTOP2 | |
35343 | * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) | |
35344 | * +SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + | |
35345 | * MQ2 - MUR2)**2*0.25D0 + MTOP2*(AT-XMU/TANBST)**2) | |
35346 | STOP22 = (MQ2 + MUR2)*.5D0 + MTOP2 | |
35347 | * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) | |
35348 | * - SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + | |
35349 | * MQ2 - MUR2)**2*0.25D0 | |
35350 | * + MTOP2*(AT-XMU/TANBST)**2) | |
35351 | IF(STOP22.LT.0.) GOTO 120 | |
35352 | SBOT12 = (MQ2 + MD2)*.5D0 | |
35353 | * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) | |
35354 | * + SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + | |
35355 | * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) | |
35356 | SBOT22 = (MQ2 + MD2)*.5D0 | |
35357 | * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) | |
35358 | * - SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + | |
35359 | * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) | |
35360 | IF(SBOT22.LT.0.) SBOT22 = 10000D0 | |
35361 | ||
35362 | STOP1 = DSQRT(STOP12) | |
35363 | STOP2 = DSQRT(STOP22) | |
35364 | SBOT1 = DSQRT(SBOT12) | |
35365 | SBOT2 = DSQRT(SBOT22) | |
35366 | ||
35367 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35368 | C | |
35369 | C HERE IS THE DEFINITION OF DELTAMB AND DELTAMT, WHICH | |
35370 | C ARE THE VERTEX CORRECTIONS TO THE BOTTOM AND TOP QUARK | |
35371 | C MASS, KEEPING THE DOMINANT QCD AND TOP YUKAWA COUPLING | |
35372 | C INDUCED CORRECTIONS. | |
35373 | C | |
35374 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35375 | ||
35376 | X=SBOT1 | |
35377 | Y=SBOT2 | |
35378 | Z=XMGL | |
35379 | IF(X.EQ.Y) X = X - 0.00001D0 | |
35380 | IF(X.EQ.Z) X = X - 0.00002D0 | |
35381 | IF(Y.EQ.Z) Y = Y - 0.00003D0 | |
35382 | ||
35383 | T1=T(X,Y,Z) | |
35384 | X=STOP1 | |
35385 | Y=STOP2 | |
35386 | Z=XMU | |
35387 | IF(X.EQ.Y) X = X - 0.00001D0 | |
35388 | IF(X.EQ.Z) X = X - 0.00002D0 | |
35389 | IF(Y.EQ.Z) Y = Y - 0.00003D0 | |
35390 | T2=T(X,Y,Z) | |
35391 | DELTAMB = -2*ALPHA3/3D0/PI*XMGL*(AB-XMU*TANB)*T1 | |
35392 | * + HT**2/(4D0*PI)**2*(AT-XMU/TANB)*XMU*TANB*T2 | |
35393 | X=STOP1 | |
35394 | Y=STOP2 | |
35395 | Z=XMGL | |
35396 | IF(X.EQ.Y) X = X - 0.00001D0 | |
35397 | IF(X.EQ.Z) X = X - 0.00002D0 | |
35398 | IF(Y.EQ.Z) Y = Y - 0.00003D0 | |
35399 | T3=T(X,Y,Z) | |
35400 | DELTAMT = -2D0*ALPHA3/3D0/PI*(AT-XMU/TANB)*XMGL*T3 | |
35401 | ||
35402 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35403 | C | |
35404 | C HERE THE NEW VALUES OF THE TOP AND BOTTOM QUARK MASSES AT | |
35405 | C THE SCALE MS ARE DEFINED, TO BE USED IN THE EFFECTIVE | |
35406 | C POTENTIAL APPROXIMATION. THEY ARE JUST THE OLD ONES, BUT | |
35407 | C INCLUDING THE FINITE CORRECTIONS DELTAMT AND DELTAMB. | |
35408 | C THE DELTAMB CORRECTIONS CAN BECOME LARGE AND ARE RESUMMED | |
35409 | C TO ALL ORDERS, AS SUGGESTED IN THE TWO RECENT WORKS BY M. CARENA, | |
35410 | C S. MRENNA AND C.E.M. WAGNER, AS WELL AS IN THE WORK BY M. CARENA, | |
35411 | C D. GARCIA, U. NIERSTE AND C.E.M. WAGNER, TO APPEAR. THE TOP | |
35412 | C QUARK MASS CORRECTIONS ARE SMALL AND ARE KEPT IN THE PERTURBATIVE | |
35413 | C FORMULATION. THE FUNCTION T(X,Y,Z) IS NECESSARY FOR THE | |
35414 | C CALCULATION. THE ENTRIES ARE MASSES AND NOT THEIR SQUARES ! | |
35415 | C | |
35416 | C | |
35417 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35418 | ||
35419 | MTOP4 = RMTOP**4*(1D0+2D0*BT2*TT- AL2*TT - 4D0*DELTAMT) | |
35420 | MTOP2 = DSQRT(MTOP4) | |
35421 | MBOT4 = MB**4*(1D0+2D0*BB2*TB - AL1*TB) | |
35422 | * /(1D0+DELTAMB)**4 | |
35423 | MBOT2 = DSQRT(MBOT4) | |
35424 | ||
35425 | STOP12 = (MQ2 + MUR2)*.5D0 + MTOP2 | |
35426 | * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) | |
35427 | * +SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + | |
35428 | * MQ2 - MUR2)**2*0.25D0 + MTOP2*(AT-XMU/TANBST)**2) | |
35429 | STOP22 = (MQ2 + MUR2)*.5D0 + MTOP2 | |
35430 | * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) | |
35431 | * - SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + | |
35432 | * MQ2 - MUR2)**2*0.25D0 | |
35433 | * + MTOP2*(AT-XMU/TANBST)**2) | |
35434 | ||
35435 | IF(STOP22.LT.0.) GOTO 120 | |
35436 | SBOT12 = (MQ2 + MD2)*.5D0 | |
35437 | * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) | |
35438 | * + SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + | |
35439 | * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) | |
35440 | SBOT22 = (MQ2 + MD2)*.5D0 | |
35441 | * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) | |
35442 | * - SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + | |
35443 | * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) | |
35444 | IF(SBOT22.LT.0.) GOTO 120 | |
35445 | ||
35446 | ||
35447 | STOP1 = DSQRT(STOP12) | |
35448 | STOP2 = DSQRT(STOP22) | |
35449 | SBOT1 = DSQRT(SBOT12) | |
35450 | SBOT2 = DSQRT(SBOT22) | |
35451 | ||
35452 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35453 | CCC D-TERMS | |
35454 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC | |
35455 | STW=SW | |
35456 | ||
35457 | F1T=(MQ2-MUR2)/(STOP12-STOP22)*(.5D0-4D0/3D0*STW)* | |
35458 | * LOG(STOP1/STOP2) | |
35459 | * +(.5D0-2D0/3D0*STW)*LOG(STOP1*STOP2/(MQ2+MTOP2)) | |
35460 | * + 2D0/3D0*STW*LOG(STOP1*STOP2/(MUR2+MTOP2)) | |
35461 | ||
35462 | F1B=(MQ2-MD2)/(SBOT12-SBOT22)*(-.5D0+2D0/3D0*STW)* | |
35463 | * LOG(SBOT1/SBOT2) | |
35464 | * +(-.5D0+1D0/3D0*STW)*LOG(SBOT1*SBOT2/(MQ2+MBOT2)) | |
35465 | * - 1D0/3D0*STW*LOG(SBOT1*SBOT2/(MD2+MBOT2)) | |
35466 | ||
35467 | F2T=DSQRT(MTOP2)*(AT-XMU/TANBST)/(STOP12-STOP22)* | |
35468 | * (-.5D0*LOG(STOP12/STOP22) | |
35469 | * +(4D0/3D0*STW-.5D0)*(MQ2-MUR2)/(STOP12-STOP22)* | |
35470 | * G(STOP12,STOP22)) | |
35471 | ||
35472 | F2B=DSQRT(MBOT2)*(AB-XMU*TANBSB)/(SBOT12-SBOT22)* | |
35473 | * (.5D0*LOG(SBOT12/SBOT22) | |
35474 | * +(-2D0/3D0*STW+.5D0)*(MQ2-MD2)/(SBOT12-SBOT22)* | |
35475 | * G(SBOT12,SBOT22)) | |
35476 | ||
35477 | VH3B(1,1) = MBOT4/(COSBB**2)*(LOG(SBOT1**2*SBOT2**2/ | |
35478 | * (MQ2+MBOT2)/(MD2+MBOT2)) | |
35479 | * + 2D0*(AB*(AB-XMU*TANBSB)/(SBOT1**2-SBOT2**2))* | |
35480 | * LOG(SBOT1**2/SBOT2**2)) + | |
35481 | * MBOT4/(COSBB**2)*(AB*(AB-XMU*TANBSB)/ | |
35482 | * (SBOT1**2-SBOT2**2))**2*G(SBOT12,SBOT22) | |
35483 | ||
35484 | VH3T(1,1) = | |
35485 | * MTOP4/(SINBT**2)*(XMU*(-AT+XMU/TANBST)/(STOP1**2 | |
35486 | * -STOP2**2))**2*G(STOP12,STOP22) | |
35487 | ||
35488 | VH3B(1,1)=VH3B(1,1)+ | |
35489 | * MZ**2*(2*MBOT2*F1B-DSQRT(MBOT2)*AB*F2B) | |
35490 | ||
35491 | VH3T(1,1) = VH3T(1,1) + | |
35492 | * MZ**2*(DSQRT(MTOP2)*XMU/TANBST*F2T) | |
35493 | ||
35494 | VH3T(2,2) = MTOP4/(SINBT**2)*(LOG(STOP1**2*STOP2**2/ | |
35495 | * (MQ2+MTOP2)/(MUR2+MTOP2)) | |
35496 | * + 2D0*(AT*(AT-XMU/TANBST)/(STOP1**2-STOP2**2))* | |
35497 | * LOG(STOP1**2/STOP2**2)) + | |
35498 | * MTOP4/(SINBT**2)*(AT*(AT-XMU/TANBST)/ | |
35499 | * (STOP1**2-STOP2**2))**2*G(STOP12,STOP22) | |
35500 | ||
35501 | VH3B(2,2) = | |
35502 | * MBOT4/(COSBB**2)*(XMU*(-AB+XMU*TANBSB)/(SBOT1**2 | |
35503 | * -SBOT2**2))**2*G(SBOT12,SBOT22) | |
35504 | ||
35505 | VH3T(2,2)=VH3T(2,2)+ | |
35506 | * MZ**2*(-2*MTOP2*F1T+DSQRT(MTOP2)*AT*F2T) | |
35507 | VH3B(2,2) = VH3B(2,2) -MZ**2*DSQRT(MBOT2)*XMU*TANBSB*F2B | |
35508 | VH3T(1,2) = - | |
35509 | * MTOP4/(SINBT**2)*XMU*(AT-XMU/TANBST)/ | |
35510 | * (STOP1**2-STOP2**2)*(LOG(STOP1**2/STOP2**2) + AT* | |
35511 | * (AT - XMU/TANBST)/(STOP1**2-STOP2**2)*G(STOP12,STOP22)) | |
35512 | ||
35513 | VH3B(1,2) = | |
35514 | * - MBOT4/(COSBB**2)*XMU*(AB-XMU*TANBSB)/ | |
35515 | * (SBOT1**2-SBOT2**2)*(LOG(SBOT1**2/SBOT2**2) + AB* | |
35516 | * (AB - XMU*TANBSB)/(SBOT1**2-SBOT2**2)*G(SBOT12,SBOT22)) | |
35517 | ||
35518 | ||
35519 | VH3T(1,2)=VH3T(1,2) + | |
35520 | *MZ**2*(MTOP2/TANBST*F1T-DSQRT(MTOP2)*(AT/TANBST+XMU)/2D0*F2T) | |
35521 | ||
35522 | VH3B(1,2)=VH3B(1,2) + | |
35523 | *MZ**2*(-MBOT2*TANBSB*F1B+DSQRT(MBOT2)*(AB*TANBSB+XMU)/2D0*F2B) | |
35524 | ||
35525 | VH3T(2,1) = VH3T(1,2) | |
35526 | VH3B(2,1) = VH3B(1,2) | |
35527 | ||
35528 | C TQ = LOG((MQ2 + MTOP2)/MTOP2) | |
35529 | C TU = LOG((MUR2+MTOP2)/MTOP2) | |
35530 | C TQD = LOG((MQ2 + MB**2)/MB**2) | |
35531 | C TD = LOG((MD2+MB**2)/MB**2) | |
35532 | ||
35533 | DO 110 I = 1,2 | |
35534 | DO 100 J = 1,2 | |
35535 | VH(I,J) = | |
35536 | * 6D0/(8D0*PI**2*(H1T**2+H2T**2)) | |
35537 | * *VH3T(I,J)*0.5D0*(1D0-AL(I,J)*TT/2D0) + | |
35538 | * 6D0/(8D0*PI**2*(H1B**2+H2B**2)) | |
35539 | * *VH3B(I,J)*0.5D0*(1D0-AL(I,J)*TB/2D0) | |
35540 | 100 CONTINUE | |
35541 | 110 CONTINUE | |
35542 | ||
35543 | GOTO 150 | |
35544 | 120 DO 140 I =1,2 | |
35545 | DO 130 J = 1,2 | |
35546 | VH(I,J) = -1D15 | |
35547 | 130 CONTINUE | |
35548 | 140 CONTINUE | |
35549 | ||
35550 | ||
35551 | 150 RETURN | |
35552 | END | |
35553 | ||
35554 | ||
35555 | ||
35556 | ||
35557 | ||
35558 | C********************************************************************* | |
35559 | ||
35560 | C...PYFINT | |
35561 | C...Auxiliary routine to PYPOLE for SUSY Higgs calculations. | |
35562 | ||
35563 | FUNCTION PYFINT(A,B,C) | |
35564 | ||
35565 | C...Double precision and integer declarations. | |
35566 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
35567 | IMPLICIT INTEGER(I-N) | |
35568 | INTEGER PYK,PYCHGE,PYCOMP | |
35569 | C...Commonblock. | |
35570 | COMMON/PYINTS/XXM(20) | |
35571 | SAVE/PYINTS/ | |
35572 | ||
35573 | C...Local variables. | |
35574 | EXTERNAL PYFISB | |
35575 | DOUBLE PRECISION PYFISB | |
35576 | ||
35577 | XXM(1)=A | |
35578 | XXM(2)=B | |
35579 | XXM(3)=C | |
35580 | XLO=0D0 | |
35581 | XHI=1D0 | |
35582 | PYFINT = PYGAUS(PYFISB,XLO,XHI,1D-3) | |
35583 | ||
35584 | RETURN | |
35585 | END | |
35586 | ||
35587 | C********************************************************************* | |
35588 | ||
35589 | C...PYFISB | |
35590 | C...Auxiliary routine to PYFINT for SUSY Higgs calculations. | |
35591 | ||
35592 | FUNCTION PYFISB(X) | |
35593 | ||
35594 | C...Double precision and integer declarations. | |
35595 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
35596 | IMPLICIT INTEGER(I-N) | |
35597 | INTEGER PYK,PYCHGE,PYCOMP | |
35598 | C...Commonblock. | |
35599 | COMMON/PYINTS/XXM(20) | |
35600 | SAVE/PYINTS/ | |
35601 | ||
35602 | PYFISB = LOG(ABS(X*XXM(2)+(1-X)*XXM(3)-X*(1-X)*XXM(1))/ | |
35603 | &(X*(XXM(2)-XXM(3))+XXM(3))) | |
35604 | ||
35605 | RETURN | |
35606 | END | |
35607 | ||
35608 | C********************************************************************* | |
35609 | ||
35610 | C...PYSFDC | |
35611 | C...Calculates decays of sfermions. | |
35612 | ||
35613 | SUBROUTINE PYSFDC(KFIN,XLAM,IDLAM,IKNT) | |
35614 | ||
35615 | C...Double precision and integer declarations. | |
35616 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
35617 | IMPLICIT INTEGER(I-N) | |
35618 | INTEGER PYK,PYCHGE,PYCOMP | |
35619 | C...Parameter statement to help give large particle numbers. | |
35620 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
35621 | &KEXCIT=4000000,KDIMEN=5000000) | |
35622 | C...Commonblocks. | |
35623 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
35624 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
35625 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
35626 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
35627 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
35628 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ | |
35629 | ||
35630 | C...Local variables. | |
35631 | COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2) | |
35632 | COMPLEX*16 CAL,CAR,CBL,CBR,CALP,CARP,CBLP,CBRP,CA,CB | |
35633 | INTEGER KFIN,KCIN | |
35634 | DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2,XMZ,AXMJ | |
35635 | DOUBLE PRECISION XMI2,XMI3,XMA2,XMB2,XMFP | |
35636 | DOUBLE PRECISION PYLAMF,XL | |
35637 | DOUBLE PRECISION TANW,XW,AEM,C1,AS | |
35638 | DOUBLE PRECISION AL,AR,BL,BR | |
35639 | DOUBLE PRECISION CH1,CH2,CH3,CH4 | |
35640 | DOUBLE PRECISION XMBOT,XMTOP | |
35641 | DOUBLE PRECISION XLAM(0:400) | |
35642 | INTEGER IDLAM(400,3) | |
35643 | INTEGER LKNT,IX,ILR,IDU,J,I,IKNT,IFL,II | |
35644 | DOUBLE PRECISION SR2 | |
35645 | DOUBLE PRECISION CBETA,SBETA | |
35646 | DOUBLE PRECISION CW | |
35647 | DOUBLE PRECISION BETA,ALFA,XMU,AT,AB,ATRIT,ATRIB,ATRIL | |
35648 | DOUBLE PRECISION COSA,SINA,TANB | |
35649 | DOUBLE PRECISION PYALEM,PI,PYALPS,EI | |
35650 | DOUBLE PRECISION GHRR,GHLL,GHLR,XMB,BLR | |
35651 | INTEGER IG,KF1,KF2 | |
35652 | INTEGER IGG(4),KFNCHI(4),KFCCHI(2) | |
35653 | DATA IGG/23,25,35,36/ | |
35654 | DATA PI/3.141592654D0/ | |
35655 | DATA SR2/1.4142136D0/ | |
35656 | DATA KFNCHI/1000022,1000023,1000025,1000035/ | |
35657 | DATA KFCCHI/1000024,1000037/ | |
35658 | ||
35659 | C...COUNT THE NUMBER OF DECAY MODES | |
35660 | LKNT=0 | |
35661 | ||
35662 | C...NO NU_R DECAYS | |
35663 | IF(KFIN.EQ.KSUSY2+12.OR.KFIN.EQ.KSUSY2+14.OR. | |
35664 | &KFIN.EQ.KSUSY2+16) RETURN | |
35665 | ||
35666 | XMW=PMAS(24,1) | |
35667 | XMW2=XMW**2 | |
35668 | XMZ=PMAS(23,1) | |
35669 | XW=PARU(102) | |
35670 | TANW = SQRT(XW/(1D0-XW)) | |
35671 | CW=SQRT(1D0-XW) | |
35672 | ||
35673 | DO 110 I=1,4 | |
35674 | DO 100 J=1,4 | |
35675 | ZMIXC(J,I)=DCMPLX(ZMIX(J,I),ZMIXI(J,I)) | |
35676 | 100 CONTINUE | |
35677 | 110 CONTINUE | |
35678 | DO 130 I=1,2 | |
35679 | DO 120 J=1,2 | |
35680 | VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) | |
35681 | UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) | |
35682 | 120 CONTINUE | |
35683 | 130 CONTINUE | |
35684 | ||
35685 | C...KCIN | |
35686 | KCIN=PYCOMP(KFIN) | |
35687 | C...ILR is 1 for left and 2 for right. | |
35688 | ILR=KFIN/KSUSY1 | |
35689 | C...IFL is matching non-SUSY flavour. | |
35690 | IFL=MOD(KFIN,KSUSY1) | |
35691 | C...IDU is weak isospin, 1 for down and 2 for up. | |
35692 | IDU=2-MOD(IFL,2) | |
35693 | ||
35694 | XMI=PMAS(KCIN,1) | |
35695 | XMI2=XMI**2 | |
35696 | AEM=PYALEM(XMI2) | |
35697 | AS =PYALPS(XMI2) | |
35698 | C1=AEM/XW | |
35699 | XMI3=XMI**3 | |
35700 | EI=KCHG(IFL,1)/3D0 | |
35701 | ||
35702 | XMBOT=PYMRUN(5,XMI2) | |
35703 | XMTOP=PYMRUN(6,XMI2) | |
35704 | ||
35705 | TANB=RMSS(5) | |
35706 | BETA=ATAN(TANB) | |
35707 | ALFA=RMSS(18) | |
35708 | CBETA=COS(BETA) | |
35709 | SBETA=TANB*CBETA | |
35710 | SINA=SIN(ALFA) | |
35711 | COSA=COS(ALFA) | |
35712 | XMU=-RMSS(4) | |
35713 | ATRIT=RMSS(16) | |
35714 | ATRIB=RMSS(15) | |
35715 | ATRIL=RMSS(17) | |
35716 | ||
35717 | C...2-BODY DECAYS OF SFERMION -> GRAVITINO + FERMION | |
35718 | ||
35719 | IF(IMSS(11).EQ.1) THEN | |
35720 | XMP=RMSS(29) | |
35721 | IDG=39+KSUSY1 | |
35722 | XMGR=PMAS(PYCOMP(IDG),1) | |
35723 | XFAC=(XMI2/(XMP*XMGR))**2*XMI/48D0/PI | |
35724 | IF(IFL.EQ.5) THEN | |
35725 | XMF=XMBOT | |
35726 | ELSEIF(IFL.EQ.6) THEN | |
35727 | XMF=XMTOP | |
35728 | ELSE | |
35729 | XMF=PMAS(IFL,1) | |
35730 | ENDIF | |
35731 | IF(XMI.GT.XMGR+XMF) THEN | |
35732 | LKNT=LKNT+1 | |
35733 | IDLAM(LKNT,1)=IDG | |
35734 | IDLAM(LKNT,2)=IFL | |
35735 | IDLAM(LKNT,3)=0 | |
35736 | XLAM(LKNT)=XFAC*(1D0-XMF**2/XMI2)**4 | |
35737 | ENDIF | |
35738 | ENDIF | |
35739 | ||
35740 | C...2-BODY DECAYS OF SFERMION -> FERMION + GAUGE/GAUGINO | |
35741 | ||
35742 | C...CHARGED DECAYS: | |
35743 | DO 140 IX=1,2 | |
35744 | C...DI -> U CHI1-,CHI2- | |
35745 | IF(IDU.EQ.1) THEN | |
35746 | XMFP=PMAS(IFL+1,1) | |
35747 | XMF =PMAS(IFL,1) | |
35748 | C...UI -> D CHI1+,CHI2+ | |
35749 | ELSE | |
35750 | XMFP=PMAS(IFL-1,1) | |
35751 | XMF =PMAS(IFL,1) | |
35752 | ENDIF | |
35753 | XMJ=SMW(IX) | |
35754 | AXMJ=ABS(XMJ) | |
35755 | IF(XMI.GE.AXMJ+XMFP) THEN | |
35756 | XMA2=XMJ**2 | |
35757 | XMB2=XMFP**2 | |
35758 | IF(IDU.EQ.2) THEN | |
35759 | IF(IFL.EQ.6) THEN | |
35760 | XMFP=XMBOT | |
35761 | XMF =XMTOP | |
35762 | ELSEIF(IFL.LT.6) THEN | |
35763 | XMF=0D0 | |
35764 | XMFP=0D0 | |
35765 | ENDIF | |
35766 | CBL=VMIXC(IX,1) | |
35767 | CAL=-XMFP*UMIXC(IX,2)/SR2/XMW/CBETA | |
35768 | CBR=-XMF*VMIXC(IX,2)/SR2/XMW/SBETA | |
35769 | CAR=0D0 | |
35770 | ELSE | |
35771 | IF(IFL.EQ.5) THEN | |
35772 | XMF =XMBOT | |
35773 | XMFP=XMTOP | |
35774 | ELSEIF(IFL.LT.5) THEN | |
35775 | XMF=0D0 | |
35776 | XMFP=0D0 | |
35777 | ENDIF | |
35778 | CBL=UMIXC(IX,1) | |
35779 | CAL=-XMFP*VMIXC(IX,2)/SR2/XMW/SBETA | |
35780 | CBR=-XMF*UMIXC(IX,2)/SR2/XMW/CBETA | |
35781 | CAR=0D0 | |
35782 | ENDIF | |
35783 | ||
35784 | CALP=SFMIX(IFL,1)*CAL + SFMIX(IFL,2)*CAR | |
35785 | CBLP=SFMIX(IFL,1)*CBL + SFMIX(IFL,2)*CBR | |
35786 | CARP=SFMIX(IFL,4)*CAR + SFMIX(IFL,3)*CAL | |
35787 | CBRP=SFMIX(IFL,4)*CBR + SFMIX(IFL,3)*CBL | |
35788 | CAL=CALP | |
35789 | CBL=CBLP | |
35790 | CAR=CARP | |
35791 | CBR=CBRP | |
35792 | ||
35793 | C...F1 -> F` CHI | |
35794 | IF(ILR.EQ.1) THEN | |
35795 | CA=CAL | |
35796 | CB=CBL | |
35797 | C...F2 -> F` CHI | |
35798 | ELSE | |
35799 | CA=CAR | |
35800 | CB=CBR | |
35801 | ENDIF | |
35802 | LKNT=LKNT+1 | |
35803 | XL=PYLAMF(XMI2,XMA2,XMB2) | |
35804 | C...SPIN AVERAGE = 1/1 NOT 1/2....NO COLOR ENHANCEMENT | |
35805 | XLAM(LKNT)=2D0*C1/8D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)* | |
35806 | & (ABS(CA)**2+ABS(CB)**2)-4D0*DBLE(CA*DCONJG(CB))*XMJ*XMFP) | |
35807 | IDLAM(LKNT,3)=0 | |
35808 | IF(IDU.EQ.1) THEN | |
35809 | IDLAM(LKNT,1)=-KFCCHI(IX) | |
35810 | IDLAM(LKNT,2)=IFL+1 | |
35811 | ELSE | |
35812 | IDLAM(LKNT,1)=KFCCHI(IX) | |
35813 | IDLAM(LKNT,2)=IFL-1 | |
35814 | ENDIF | |
35815 | ENDIF | |
35816 | 140 CONTINUE | |
35817 | ||
35818 | C...NEUTRAL DECAYS | |
35819 | DO 150 IX=1,4 | |
35820 | C...DI -> D CHI10 | |
35821 | XMF=PMAS(IFL,1) | |
35822 | XMJ=SMZ(IX) | |
35823 | AXMJ=ABS(XMJ) | |
35824 | IF(XMI.GE.AXMJ+XMF) THEN | |
35825 | XMA2=XMJ**2 | |
35826 | XMB2=XMF**2 | |
35827 | IF(IDU.EQ.1) THEN | |
35828 | IF(IFL.EQ.5) THEN | |
35829 | XMF=XMBOT | |
35830 | ELSEIF(IFL.LT.5) THEN | |
35831 | XMF=0D0 | |
35832 | ENDIF | |
35833 | CBL=-ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI+1) | |
35834 | CAL=XMF*ZMIXC(IX,3)/XMW/CBETA | |
35835 | CAR=-2D0*EI*TANW*ZMIXC(IX,1) | |
35836 | CBR=CAL | |
35837 | ELSE | |
35838 | IF(IFL.EQ.6) THEN | |
35839 | XMF=XMTOP | |
35840 | ELSEIF(IFL.LT.5) THEN | |
35841 | XMF=0D0 | |
35842 | ENDIF | |
35843 | CBL=ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI-1) | |
35844 | CAL=XMF*ZMIXC(IX,4)/XMW/SBETA | |
35845 | CAR=-2D0*EI*TANW*ZMIXC(IX,1) | |
35846 | CBR=CAL | |
35847 | ENDIF | |
35848 | ||
35849 | CALP=SFMIX(IFL,1)*CAL + SFMIX(IFL,2)*CAR | |
35850 | CBLP=SFMIX(IFL,1)*CBL + SFMIX(IFL,2)*CBR | |
35851 | CARP=SFMIX(IFL,4)*CAR + SFMIX(IFL,3)*CAL | |
35852 | CBRP=SFMIX(IFL,4)*CBR + SFMIX(IFL,3)*CBL | |
35853 | CAL=CALP | |
35854 | CBL=CBLP | |
35855 | CAR=CARP | |
35856 | CBR=CBRP | |
35857 | ||
35858 | C...F1 -> F CHI | |
35859 | IF(ILR.EQ.1) THEN | |
35860 | CA=CAL | |
35861 | CB=CBL | |
35862 | C...F2 -> F CHI | |
35863 | ELSE | |
35864 | CA=CAR | |
35865 | CB=CBR | |
35866 | ENDIF | |
35867 | LKNT=LKNT+1 | |
35868 | XL=PYLAMF(XMI2,XMA2,XMB2) | |
35869 | C...SPIN AVERAGE = 1/1 NOT 1/2....NO COLOR ENHANCEMENT | |
35870 | XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)* | |
35871 | & (ABS(CA)**2+ABS(CB)**2)-4D0*DBLE(CA*DCONJG(CB))*XMJ*XMF) | |
35872 | IDLAM(LKNT,1)=KFNCHI(IX) | |
35873 | IDLAM(LKNT,2)=IFL | |
35874 | IDLAM(LKNT,3)=0 | |
35875 | ENDIF | |
35876 | 150 CONTINUE | |
35877 | ||
35878 | C...2-BODY DECAYS TO SM GAUGE AND HIGGS BOSONS | |
35879 | C...IG=23,25,35,36 | |
35880 | DO 160 II=1,4 | |
35881 | IG=IGG(II) | |
35882 | IF(ILR.EQ.1) GOTO 160 | |
35883 | XMB=PMAS(IG,1) | |
35884 | XMSF1=PMAS(PYCOMP(KFIN-KSUSY1),1) | |
35885 | IF(XMI.LT.XMSF1+XMB) GOTO 160 | |
35886 | IF(IG.EQ.23) THEN | |
35887 | BL=-SIGN(.5D0,EI)/CW+EI*XW/CW | |
35888 | BR=EI*XW/CW | |
35889 | BLR=0D0 | |
35890 | ELSEIF(IG.EQ.25) THEN | |
35891 | IF(IFL.EQ.5) THEN | |
35892 | XMF=XMBOT | |
35893 | ELSEIF(IFL.EQ.6) THEN | |
35894 | XMF=XMTOP | |
35895 | ELSEIF(IFL.LT.5) THEN | |
35896 | XMF=0D0 | |
35897 | ELSE | |
35898 | XMF=PMAS(IFL,1) | |
35899 | ENDIF | |
35900 | IF(IDU.EQ.2) THEN | |
35901 | GHLL=XMZ/CW*(0.5D0-EI*XW)*(-SIN(ALFA+BETA))+ | |
35902 | & XMF**2/XMW*COSA/SBETA | |
35903 | GHRR=XMZ/CW*(EI*XW)*(-SIN(ALFA+BETA))+ | |
35904 | & XMF**2/XMW*COSA/SBETA | |
35905 | ELSE | |
35906 | GHLL=XMZ/CW*(0.5D0-EI*XW)*(-SIN(ALFA+BETA))+ | |
35907 | & XMF**2/XMW*(-SINA)/CBETA | |
35908 | GHRR=XMZ/CW*(EI*XW)*(-SIN(ALFA+BETA))+ | |
35909 | & XMF**2/XMW*(-SINA)/CBETA | |
35910 | ENDIF | |
35911 | IF(IFL.EQ.5) THEN | |
35912 | AT=ATRIB | |
35913 | ELSEIF(IFL.EQ.6) THEN | |
35914 | AT=ATRIT | |
35915 | ELSEIF(IFL.EQ.15) THEN | |
35916 | AT=ATRIL | |
35917 | ELSE | |
35918 | AT=0D0 | |
35919 | ENDIF | |
35920 | C.........need to complexify | |
35921 | IF(IDU.EQ.2) THEN | |
35922 | GHLR=XMF/2D0/XMW/SBETA*(-XMU*SINA+ | |
35923 | & AT*COSA) | |
35924 | ELSE | |
35925 | GHLR=XMF/2D0/XMW/CBETA*(XMU*COSA- | |
35926 | & AT*SINA) | |
35927 | ENDIF | |
35928 | BL=GHLL | |
35929 | BR=GHRR | |
35930 | BLR=-GHLR | |
35931 | ELSEIF(IG.EQ.35) THEN | |
35932 | IF(IFL.EQ.5) THEN | |
35933 | XMF=XMBOT | |
35934 | ELSEIF(IFL.EQ.6) THEN | |
35935 | XMF=XMTOP | |
35936 | ELSEIF(IFL.LT.5) THEN | |
35937 | XMF=0D0 | |
35938 | ELSE | |
35939 | XMF=PMAS(IFL,1) | |
35940 | ENDIF | |
35941 | IF(IDU.EQ.2) THEN | |
35942 | GHLL=XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)+ | |
35943 | & XMF**2/XMW*SINA/SBETA | |
35944 | GHRR=XMZ/CW*(EI*XW)*COS(ALFA+BETA)+ | |
35945 | & XMF**2/XMW*SINA/SBETA | |
35946 | ELSE | |
35947 | GHLL=XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)+ | |
35948 | & XMF**2/XMW*COSA/CBETA | |
35949 | GHRR=XMZ/CW*(EI*XW)*COS(ALFA+BETA)+ | |
35950 | & XMF**2/XMW*COSA/CBETA | |
35951 | ENDIF | |
35952 | IF(IFL.EQ.5) THEN | |
35953 | AT=ATRIB | |
35954 | ELSEIF(IFL.EQ.6) THEN | |
35955 | AT=ATRIT | |
35956 | ELSEIF(IFL.EQ.15) THEN | |
35957 | AT=ATRIL | |
35958 | ELSE | |
35959 | AT=0D0 | |
35960 | ENDIF | |
35961 | C.........Need to complexify | |
35962 | IF(IDU.EQ.2) THEN | |
35963 | GHLR=XMF/2D0/XMW/SBETA*(XMU*COSA+ | |
35964 | & AT*SINA) | |
35965 | ELSE | |
35966 | GHLR=XMF/2D0/XMW/CBETA*(XMU*SINA+ | |
35967 | & AT*COSA) | |
35968 | ENDIF | |
35969 | BL=GHLL | |
35970 | BR=GHRR | |
35971 | BLR=GHLR | |
35972 | ELSEIF(IG.EQ.36) THEN | |
35973 | GHLL=0D0 | |
35974 | GHRR=0D0 | |
35975 | IF(IFL.EQ.5) THEN | |
35976 | XMF=XMBOT | |
35977 | ELSEIF(IFL.EQ.6) THEN | |
35978 | XMF=XMTOP | |
35979 | ELSEIF(IFL.LT.5) THEN | |
35980 | XMF=0D0 | |
35981 | ELSE | |
35982 | XMF=PMAS(IFL,1) | |
35983 | ENDIF | |
35984 | IF(IFL.EQ.5) THEN | |
35985 | AT=ATRIB | |
35986 | ELSEIF(IFL.EQ.6) THEN | |
35987 | AT=ATRIT | |
35988 | ELSEIF(IFL.EQ.15) THEN | |
35989 | AT=ATRIL | |
35990 | ELSE | |
35991 | AT=0D0 | |
35992 | ENDIF | |
35993 | C.........Need to complexify | |
35994 | IF(IDU.EQ.2) THEN | |
35995 | GHLR=XMF/2D0/XMW*(-XMU+AT/TANB) | |
35996 | ELSE | |
35997 | GHLR=XMF/2D0/XMW/(-XMU+AT*TANB) | |
35998 | ENDIF | |
35999 | BL=GHLL | |
36000 | BR=GHRR | |
36001 | BLR=GHLR | |
36002 | ENDIF | |
36003 | AL=SFMIX(IFL,1)*SFMIX(IFL,3)*BL+ | |
36004 | & SFMIX(IFL,2)*SFMIX(IFL,4)*BR+ | |
36005 | & (SFMIX(IFL,1)*SFMIX(IFL,4)+SFMIX(IFL,3)*SFMIX(IFL,2))*BLR | |
36006 | XL=PYLAMF(XMI2,XMSF1**2,XMB**2) | |
36007 | LKNT=LKNT+1 | |
36008 | IF(IG.EQ.23) THEN | |
36009 | XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2 | |
36010 | ELSE | |
36011 | XLAM(LKNT)=C1/4D0/XMI3*SQRT(XL)*AL**2 | |
36012 | ENDIF | |
36013 | IDLAM(LKNT,3)=0 | |
36014 | IDLAM(LKNT,1)=KFIN-KSUSY1 | |
36015 | IDLAM(LKNT,2)=IG | |
36016 | 160 CONTINUE | |
36017 | ||
36018 | C...SF -> SF' + W | |
36019 | XMB=PMAS(24,1) | |
36020 | IF(MOD(IFL,2).EQ.0) THEN | |
36021 | KF1=KSUSY1+IFL-1 | |
36022 | ELSE | |
36023 | KF1=KSUSY1+IFL+1 | |
36024 | ENDIF | |
36025 | KF2=KF1+KSUSY1 | |
36026 | XMSF1=PMAS(PYCOMP(KF1),1) | |
36027 | XMSF2=PMAS(PYCOMP(KF2),1) | |
36028 | IF(XMI.GT.XMB+XMSF1) THEN | |
36029 | IF(MOD(IFL,2).EQ.0) THEN | |
36030 | IF(ILR.EQ.1) THEN | |
36031 | AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL-1,1) | |
36032 | ELSE | |
36033 | AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL-1,1) | |
36034 | ENDIF | |
36035 | ELSE | |
36036 | IF(ILR.EQ.1) THEN | |
36037 | AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL+1,1) | |
36038 | ELSE | |
36039 | AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL+1,1) | |
36040 | ENDIF | |
36041 | ENDIF | |
36042 | XL=PYLAMF(XMI2,XMSF1**2,XMB**2) | |
36043 | LKNT=LKNT+1 | |
36044 | XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2 | |
36045 | IDLAM(LKNT,3)=0 | |
36046 | IDLAM(LKNT,1)=KF1 | |
36047 | IDLAM(LKNT,2)=SIGN(24,KCHG(IFL,1)) | |
36048 | ENDIF | |
36049 | IF(XMI.GT.XMB+XMSF2) THEN | |
36050 | IF(MOD(IFL,2).EQ.0) THEN | |
36051 | IF(ILR.EQ.1) THEN | |
36052 | AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL-1,3) | |
36053 | ELSE | |
36054 | AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL-1,3) | |
36055 | ENDIF | |
36056 | ELSE | |
36057 | IF(ILR.EQ.1) THEN | |
36058 | AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL+1,3) | |
36059 | ELSE | |
36060 | AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL+1,3) | |
36061 | ENDIF | |
36062 | ENDIF | |
36063 | XL=PYLAMF(XMI2,XMSF2**2,XMB**2) | |
36064 | LKNT=LKNT+1 | |
36065 | XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2 | |
36066 | IDLAM(LKNT,3)=0 | |
36067 | IDLAM(LKNT,1)=KF2 | |
36068 | IDLAM(LKNT,2)=SIGN(24,KCHG(IFL,1)) | |
36069 | ENDIF | |
36070 | ||
36071 | C...SF -> SF' + HC | |
36072 | XMB=PMAS(37,1) | |
36073 | IF(MOD(IFL,2).EQ.0) THEN | |
36074 | KF1=KSUSY1+IFL-1 | |
36075 | ELSE | |
36076 | KF1=KSUSY1+IFL+1 | |
36077 | ENDIF | |
36078 | KF2=KF1+KSUSY1 | |
36079 | XMSF1=PMAS(PYCOMP(KF1),1) | |
36080 | XMSF2=PMAS(PYCOMP(KF2),1) | |
36081 | IF(XMI.GT.XMB+XMSF1) THEN | |
36082 | XMF=0D0 | |
36083 | XMFP=0D0 | |
36084 | AT=0D0 | |
36085 | AB=0D0 | |
36086 | IF(MOD(IFL,2).EQ.0) THEN | |
36087 | C...T1-> B1 HC | |
36088 | IF(ILR.EQ.1) THEN | |
36089 | CH1=-SFMIX(IFL,1)*SFMIX(IFL-1,1) | |
36090 | CH2= SFMIX(IFL,2)*SFMIX(IFL-1,2) | |
36091 | CH3=-SFMIX(IFL,1)*SFMIX(IFL-1,2) | |
36092 | CH4=-SFMIX(IFL,2)*SFMIX(IFL-1,1) | |
36093 | C...T2-> B1 HC | |
36094 | ELSE | |
36095 | CH1= SFMIX(IFL,3)*SFMIX(IFL-1,1) | |
36096 | CH2=-SFMIX(IFL,4)*SFMIX(IFL-1,2) | |
36097 | CH3= SFMIX(IFL,3)*SFMIX(IFL-1,2) | |
36098 | CH4= SFMIX(IFL,4)*SFMIX(IFL-1,1) | |
36099 | ENDIF | |
36100 | IF(IFL.EQ.6) THEN | |
36101 | XMF=XMTOP | |
36102 | XMFP=XMBOT | |
36103 | AT=ATRIT | |
36104 | AB=ATRIB | |
36105 | ENDIF | |
36106 | ELSE | |
36107 | C...B1 -> T1 HC | |
36108 | IF(ILR.EQ.1) THEN | |
36109 | CH1=-SFMIX(IFL+1,1)*SFMIX(IFL,1) | |
36110 | CH2= SFMIX(IFL+1,2)*SFMIX(IFL,2) | |
36111 | CH3=-SFMIX(IFL+1,1)*SFMIX(IFL,2) | |
36112 | CH4=-SFMIX(IFL+1,2)*SFMIX(IFL,1) | |
36113 | C...B2-> T1 HC | |
36114 | ELSE | |
36115 | CH1= SFMIX(IFL,3)*SFMIX(IFL+1,1) | |
36116 | CH2=-SFMIX(IFL,4)*SFMIX(IFL+1,2) | |
36117 | CH3= SFMIX(IFL,4)*SFMIX(IFL+1,1) | |
36118 | CH4= SFMIX(IFL,3)*SFMIX(IFL+1,2) | |
36119 | ENDIF | |
36120 | IF(IFL.EQ.5) THEN | |
36121 | XMF=XMTOP | |
36122 | XMFP=XMBOT | |
36123 | AT=ATRIT | |
36124 | AB=ATRIB | |
36125 | ENDIF | |
36126 | ENDIF | |
36127 | XL=PYLAMF(XMI2,XMSF1**2,XMB**2) | |
36128 | LKNT=LKNT+1 | |
36129 | C.......Need to complexify | |
36130 | AL=CH1*(XMW2*2D0*CBETA*SBETA-XMFP**2*TANB-XMF**2/TANB)+ | |
36131 | & CH2*2D0*XMF*XMFP/(2D0*CBETA*SBETA)+ | |
36132 | & CH3*XMFP*(-XMU+AB*TANB)+CH4*XMF*(-XMU+AT/TANB) | |
36133 | XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)/XMW2*AL**2 | |
36134 | IDLAM(LKNT,3)=0 | |
36135 | IDLAM(LKNT,1)=KF1 | |
36136 | IDLAM(LKNT,2)=SIGN(37,KCHG(IFL,1)) | |
36137 | ENDIF | |
36138 | IF(XMI.GT.XMB+XMSF2) THEN | |
36139 | XMF=0D0 | |
36140 | XMFP=0D0 | |
36141 | AT=0D0 | |
36142 | AB=0D0 | |
36143 | IF(MOD(IFL,2).EQ.0) THEN | |
36144 | C...T1-> B2 HC | |
36145 | IF(ILR.EQ.1) THEN | |
36146 | CH1= SFMIX(IFL-1,3)*SFMIX(IFL,1) | |
36147 | CH2=-SFMIX(IFL-1,4)*SFMIX(IFL,2) | |
36148 | CH3= SFMIX(IFL-1,4)*SFMIX(IFL,1) | |
36149 | CH4= SFMIX(IFL-1,3)*SFMIX(IFL,2) | |
36150 | C...T2-> B2 HC | |
36151 | ELSE | |
36152 | CH1= -SFMIX(IFL,3)*SFMIX(IFL-1,3) | |
36153 | CH2= SFMIX(IFL,4)*SFMIX(IFL-1,4) | |
36154 | CH3= -SFMIX(IFL,3)*SFMIX(IFL-1,4) | |
36155 | CH4= -SFMIX(IFL,4)*SFMIX(IFL-1,3) | |
36156 | ENDIF | |
36157 | IF(IFL.EQ.6) THEN | |
36158 | XMF=XMTOP | |
36159 | XMFP=XMBOT | |
36160 | AT=ATRIT | |
36161 | AB=ATRIB | |
36162 | ENDIF | |
36163 | ELSE | |
36164 | C...B1 -> T2 HC | |
36165 | IF(ILR.EQ.1) THEN | |
36166 | CH1= SFMIX(IFL+1,3)*SFMIX(IFL,1) | |
36167 | CH2=-SFMIX(IFL+1,4)*SFMIX(IFL,2) | |
36168 | CH3= SFMIX(IFL+1,3)*SFMIX(IFL,2) | |
36169 | CH4= SFMIX(IFL+1,4)*SFMIX(IFL,1) | |
36170 | C...B2-> T2 HC | |
36171 | ELSE | |
36172 | CH1= -SFMIX(IFL+1,3)*SFMIX(IFL,3) | |
36173 | CH2= SFMIX(IFL+1,4)*SFMIX(IFL,4) | |
36174 | CH3= -SFMIX(IFL+1,3)*SFMIX(IFL,4) | |
36175 | CH4= -SFMIX(IFL+1,4)*SFMIX(IFL,3) | |
36176 | ENDIF | |
36177 | IF(IFL.EQ.5) THEN | |
36178 | XMF=XMTOP | |
36179 | XMFP=XMBOT | |
36180 | AT=ATRIT | |
36181 | AB=ATRIB | |
36182 | ENDIF | |
36183 | ENDIF | |
36184 | XL=PYLAMF(XMI2,XMSF1**2,XMB**2) | |
36185 | LKNT=LKNT+1 | |
36186 | C.......Need to complexify | |
36187 | AL=CH1*(XMW2*2D0*CBETA*SBETA-XMFP**2*TANB-XMF**2/TANB)+ | |
36188 | & CH2*2D0*XMF*XMFP/(2D0*CBETA*SBETA)+ | |
36189 | & CH3*XMFP*(-XMU+AB*TANB)+CH4*XMF*(-XMU+AT/TANB) | |
36190 | XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)/XMW2*AL**2 | |
36191 | IDLAM(LKNT,3)=0 | |
36192 | IDLAM(LKNT,1)=KF2 | |
36193 | IDLAM(LKNT,2)=SIGN(37,KCHG(IFL,1)) | |
36194 | ENDIF | |
36195 | ||
36196 | C...2-BODY DECAYS OF SQUARK -> QUARK GLUINO | |
36197 | ||
36198 | IF(IFL.LE.6) THEN | |
36199 | XMFP=0D0 | |
36200 | XMF=0D0 | |
36201 | IF(IFL.EQ.6) XMF=PMAS(6,1) | |
36202 | IF(IFL.EQ.5) XMF=PMAS(5,1) | |
36203 | XMJ=PMAS(PYCOMP(KSUSY1+21),1) | |
36204 | AXMJ=ABS(XMJ) | |
36205 | IF(XMI.GE.AXMJ+XMF) THEN | |
36206 | AL=-SFMIX(IFL,3) | |
36207 | BL=SFMIX(IFL,1) | |
36208 | AR=-SFMIX(IFL,4) | |
36209 | BR=SFMIX(IFL,2) | |
36210 | C...F1 -> F CHI | |
36211 | IF(ILR.EQ.1) THEN | |
36212 | XCA=AL | |
36213 | XCB=BL | |
36214 | C...F2 -> F CHI | |
36215 | ELSE | |
36216 | XCA=AR | |
36217 | XCB=BR | |
36218 | ENDIF | |
36219 | LKNT=LKNT+1 | |
36220 | XMA2=XMJ**2 | |
36221 | XMB2=XMF**2 | |
36222 | XL=PYLAMF(XMI2,XMA2,XMB2) | |
36223 | XLAM(LKNT)=4D0/3D0*AS/2D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)* | |
36224 | & (XCA**2+XCB**2)+4D0*XCA*XCB*XMJ*XMF) | |
36225 | IDLAM(LKNT,1)=KSUSY1+21 | |
36226 | IDLAM(LKNT,2)=IFL | |
36227 | IDLAM(LKNT,3)=0 | |
36228 | ENDIF | |
36229 | ENDIF | |
36230 | ||
36231 | C...IF NOTHING ELSE FOR T1, THEN T1* -> C+CHI0 | |
36232 | IF(KFIN.EQ.KSUSY1+6.AND.PMAS(KCIN,1).GT. | |
36233 | &PMAS(PYCOMP(KSUSY1+22),1)+PMAS(4,1)) THEN | |
36234 | C...THIS IS A BACK-OF-THE-ENVELOPE ESTIMATE | |
36235 | C...M = 1/(16PI**2)G**3 = G*2/(4PI) G/(4PI) = C1 * G/(4PI) | |
36236 | C...M*M = C1**2 * G**2/(16PI**2) | |
36237 | C...G = 1/(8PI)P/MI**2 * M*M = C1**3/(32PI**2)*LAM/(2*MI**3) | |
36238 | LKNT=LKNT+1 | |
36239 | XL=PYLAMF(XMI2,0D0,PMAS(PYCOMP(KSUSY1+22),1)**2) | |
36240 | XLAM(LKNT)=C1**3/64D0/PI**2/XMI3*SQRT(XL) | |
36241 | IF(XLAM(LKNT).EQ.0) XLAM(LKNT)=1D-3 | |
36242 | IDLAM(LKNT,1)=KSUSY1+22 | |
36243 | IDLAM(LKNT,2)=4 | |
36244 | IDLAM(LKNT,3)=0 | |
36245 | ENDIF | |
36246 | ||
36247 | C...R-violating sfermion decays (SKANDS). | |
36248 | CALL PYRVSF(KFIN,XLAM,IDLAM,LKNT) | |
36249 | ||
36250 | IKNT=LKNT | |
36251 | XLAM(0)=0D0 | |
36252 | DO 170 I=1,IKNT | |
36253 | IF(XLAM(I).LT.0D0) XLAM(I)=0D0 | |
36254 | XLAM(0)=XLAM(0)+XLAM(I) | |
36255 | 170 CONTINUE | |
36256 | IF(XLAM(0).EQ.0D0) XLAM(0)=1D-3 | |
36257 | ||
36258 | RETURN | |
36259 | END | |
36260 | ||
36261 | C********************************************************************* | |
36262 | ||
36263 | C...PYGLUI | |
36264 | C...Calculates gluino decay modes. | |
36265 | ||
36266 | SUBROUTINE PYGLUI(KFIN,XLAM,IDLAM,IKNT) | |
36267 | ||
36268 | C...Double precision and integer declarations. | |
36269 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
36270 | IMPLICIT INTEGER(I-N) | |
36271 | INTEGER PYK,PYCHGE,PYCOMP | |
36272 | C...Parameter statement to help give large particle numbers. | |
36273 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
36274 | &KEXCIT=4000000,KDIMEN=5000000) | |
36275 | C...Commonblocks. | |
36276 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
36277 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
36278 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
36279 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
36280 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
36281 | CC &SFMIX(16,4), | |
36282 | C COMMON/PYINTS/XXM(20) | |
36283 | COMPLEX*16 CXC | |
36284 | COMMON/PYINTC/XXC(10),CXC(8) | |
36285 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTC/ | |
36286 | ||
36287 | C...Local variables | |
36288 | COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP,GLIJ,GRIJ | |
36289 | DOUBLE PRECISION XMI,XMJ,XMF,AXMJ,AXMI | |
36290 | DOUBLE PRECISION XMI2,XMI3,XMA2,XMB2,XMFP | |
36291 | DOUBLE PRECISION PYLAMF,XL | |
36292 | DOUBLE PRECISION TANW,XW,AEM,C1,AS,S12MAX,S12MIN | |
36293 | DOUBLE PRECISION CA,CB,AL,AR,BL,BR | |
36294 | DOUBLE PRECISION XLAM(0:400) | |
36295 | INTEGER IDLAM(400,3) | |
36296 | INTEGER LKNT,IX,ILR,I,IKNT,IFL | |
36297 | DOUBLE PRECISION SR2 | |
36298 | DOUBLE PRECISION GAM | |
36299 | DOUBLE PRECISION PYALEM,PI,PYALPS,EI,T3I | |
36300 | EXTERNAL PYGAUS,PYXXZ6 | |
36301 | DOUBLE PRECISION PYGAUS,PYXXZ6 | |
36302 | DOUBLE PRECISION PREC | |
36303 | INTEGER KFNCHI(4),KFCCHI(2) | |
36304 | DATA PI/3.141592654D0/ | |
36305 | DATA SR2/1.4142136D0/ | |
36306 | DATA PREC/1D-2/ | |
36307 | DATA KFNCHI/1000022,1000023,1000025,1000035/ | |
36308 | DATA KFCCHI/1000024,1000037/ | |
36309 | ||
36310 | C...COUNT THE NUMBER OF DECAY MODES | |
36311 | LKNT=0 | |
36312 | IF(KFIN.NE.KSUSY1+21) RETURN | |
36313 | KCIN=PYCOMP(KFIN) | |
36314 | ||
36315 | XW=PARU(102) | |
36316 | TANW = SQRT(XW/(1D0-XW)) | |
36317 | ||
36318 | XMI=PMAS(KCIN,1) | |
36319 | AXMI=ABS(XMI) | |
36320 | XMI2=XMI**2 | |
36321 | AEM=PYALEM(XMI2) | |
36322 | AS =PYALPS(XMI2) | |
36323 | C1=AEM/XW | |
36324 | XMI3=AXMI**3 | |
36325 | ||
36326 | XMI=SIGN(XMI,RMSS(3)) | |
36327 | ||
36328 | C...2-BODY DECAYS OF GLUINO -> GRAVITINO GLUON | |
36329 | ||
36330 | IF(IMSS(11).EQ.1) THEN | |
36331 | XMP=RMSS(29) | |
36332 | IDG=39+KSUSY1 | |
36333 | XMGR=PMAS(PYCOMP(IDG),1) | |
36334 | XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI | |
36335 | IF(AXMI.GT.XMGR) THEN | |
36336 | LKNT=LKNT+1 | |
36337 | IDLAM(LKNT,1)=IDG | |
36338 | IDLAM(LKNT,2)=21 | |
36339 | IDLAM(LKNT,3)=0 | |
36340 | XLAM(LKNT)=XFAC | |
36341 | ENDIF | |
36342 | ENDIF | |
36343 | ||
36344 | C...2-BODY DECAYS OF GLUINO -> QUARK SQUARK | |
36345 | ||
36346 | DO 110 IFL=1,6 | |
36347 | DO 100 ILR=1,2 | |
36348 | XMJ=PMAS(PYCOMP(ILR*KSUSY1+IFL),1) | |
36349 | AXMJ=ABS(XMJ) | |
36350 | XMF=PMAS(IFL,1) | |
36351 | IF(AXMI.GE.AXMJ+XMF) THEN | |
36352 | C...Minus sign difference from gluino-quark-squark feynman rules | |
36353 | AL=SFMIX(IFL,1) | |
36354 | BL=-SFMIX(IFL,3) | |
36355 | AR=SFMIX(IFL,2) | |
36356 | BR=-SFMIX(IFL,4) | |
36357 | C...F1 -> F CHI | |
36358 | IF(ILR.EQ.1) THEN | |
36359 | CA=AL | |
36360 | CB=BL | |
36361 | C...F2 -> F CHI | |
36362 | ELSE | |
36363 | CA=AR | |
36364 | CB=BR | |
36365 | ENDIF | |
36366 | LKNT=LKNT+1 | |
36367 | XMA2=XMJ**2 | |
36368 | XMB2=XMF**2 | |
36369 | XL=PYLAMF(XMI2,XMA2,XMB2) | |
36370 | XLAM(LKNT)=4D0/8D0*AS/4D0/XMI3*SQRT(XL)*((XMI2+XMB2-XMA2)* | |
36371 | & (CA**2+CB**2)-4D0*CA*CB*XMI*XMF) | |
36372 | IDLAM(LKNT,1)=ILR*KSUSY1+IFL | |
36373 | IDLAM(LKNT,2)=-IFL | |
36374 | IDLAM(LKNT,3)=0 | |
36375 | LKNT=LKNT+1 | |
36376 | XLAM(LKNT)=XLAM(LKNT-1) | |
36377 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
36378 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
36379 | IDLAM(LKNT,3)=0 | |
36380 | ENDIF | |
36381 | 100 CONTINUE | |
36382 | 110 CONTINUE | |
36383 | ||
36384 | C...3-BODY DECAYS TO GAUGINO FERMION-FERMION | |
36385 | C...GLUINO -> NI Q QBAR | |
36386 | DO 170 IX=1,4 | |
36387 | XMJ=SMZ(IX) | |
36388 | AXMJ=ABS(XMJ) | |
36389 | IF(AXMI.GE.AXMJ) THEN | |
36390 | DO 120 I=1,4 | |
36391 | ZMIXC(IX,I)=DCMPLX(ZMIX(IX,I),ZMIXI(IX,I)) | |
36392 | 120 CONTINUE | |
36393 | OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32)))/SR2 | |
36394 | ORPP=DCONJG(OLPP) | |
36395 | XXC(1)=0D0 | |
36396 | XXC(2)=XMJ | |
36397 | XXC(3)=0D0 | |
36398 | XXC(4)=XMI | |
36399 | IA=1 | |
36400 | XXC(5)=PMAS(PYCOMP(KSUSY1+IA),1) | |
36401 | XXC(6)=PMAS(PYCOMP(KSUSY2+IA),1) | |
36402 | XXC(7)=XXC(5) | |
36403 | XXC(8)=XXC(6) | |
36404 | XXC(9)=1D6 | |
36405 | XXC(10)=0D0 | |
36406 | EI=KCHG(IA,1)/3D0 | |
36407 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
36408 | GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP | |
36409 | GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP | |
36410 | CXC(1)=0D0 | |
36411 | CXC(2)=-GLIJ | |
36412 | CXC(3)=0D0 | |
36413 | CXC(4)=DCONJG(GLIJ) | |
36414 | CXC(5)=0D0 | |
36415 | CXC(6)=GRIJ | |
36416 | CXC(7)=0D0 | |
36417 | CXC(8)=-DCONJG(GRIJ) | |
36418 | S12MIN=0D0 | |
36419 | S12MAX=(AXMI-AXMJ)**2 | |
36420 | IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 130 | |
36421 | IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN | |
36422 | LKNT=LKNT+1 | |
36423 | XLAM(LKNT)=C1*AS/XMI3/(16D0*PI)* | |
36424 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-2) | |
36425 | IDLAM(LKNT,1)=KFNCHI(IX) | |
36426 | IDLAM(LKNT,2)=1 | |
36427 | IDLAM(LKNT,3)=-1 | |
36428 | ENDIF | |
36429 | IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN | |
36430 | LKNT=LKNT+1 | |
36431 | XLAM(LKNT)=XLAM(LKNT-1) | |
36432 | IDLAM(LKNT,1)=KFNCHI(IX) | |
36433 | IDLAM(LKNT,2)=3 | |
36434 | IDLAM(LKNT,3)=-3 | |
36435 | ENDIF | |
36436 | 130 CONTINUE | |
36437 | IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN | |
36438 | PMOLD=PMAS(PYCOMP(KSUSY1+5),1) | |
36439 | IF(AXMI.GT.PMAS(PYCOMP(KSUSY2+5),1)+PMAS(5,1)) THEN | |
36440 | GOTO 140 | |
36441 | ELSEIF(AXMI.GT.PMAS(PYCOMP(KSUSY1+5),1)+PMAS(5,1)) THEN | |
36442 | PMAS(PYCOMP(KSUSY1+5),1)=100D0*XMI | |
36443 | ENDIF | |
36444 | CALL PYTBBN(IX,100,-1D0/3D0,XMI,GAM) | |
36445 | LKNT=LKNT+1 | |
36446 | XLAM(LKNT)=GAM | |
36447 | IDLAM(LKNT,1)=KFNCHI(IX) | |
36448 | IDLAM(LKNT,2)=5 | |
36449 | IDLAM(LKNT,3)=-5 | |
36450 | PMAS(PYCOMP(KSUSY1+5),1)=PMOLD | |
36451 | ENDIF | |
36452 | C...U-TYPE QUARKS | |
36453 | 140 CONTINUE | |
36454 | IA=2 | |
36455 | XXC(5)=PMAS(PYCOMP(KSUSY1+IA),1) | |
36456 | XXC(6)=PMAS(PYCOMP(KSUSY2+IA),1) | |
36457 | C IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 290 | |
36458 | XXC(7)=XXC(5) | |
36459 | XXC(8)=XXC(6) | |
36460 | EI=KCHG(IA,1)/3D0 | |
36461 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
36462 | GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP | |
36463 | GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP | |
36464 | CXC(2)=-GLIJ | |
36465 | CXC(4)=DCONJG(GLIJ) | |
36466 | CXC(6)=GRIJ | |
36467 | CXC(8)=-DCONJG(GRIJ) | |
36468 | IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 150 | |
36469 | IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN | |
36470 | LKNT=LKNT+1 | |
36471 | XLAM(LKNT)=C1*AS/XMI3/(16D0*PI)* | |
36472 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-2) | |
36473 | IDLAM(LKNT,1)=KFNCHI(IX) | |
36474 | IDLAM(LKNT,2)=2 | |
36475 | IDLAM(LKNT,3)=-2 | |
36476 | ENDIF | |
36477 | IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN | |
36478 | LKNT=LKNT+1 | |
36479 | XLAM(LKNT)=XLAM(LKNT-1) | |
36480 | IDLAM(LKNT,1)=KFNCHI(IX) | |
36481 | IDLAM(LKNT,2)=4 | |
36482 | IDLAM(LKNT,3)=-4 | |
36483 | ENDIF | |
36484 | 150 CONTINUE | |
36485 | C...INCLUDE THE DECAY GLUINO -> NJ + T + T~ | |
36486 | C...IF THE DECAY GLUINO -> ST + T CANNOT OCCUR | |
36487 | XMF=PMAS(6,1) | |
36488 | IF(AXMI.GE.AXMJ+2D0*XMF) THEN | |
36489 | PMOLD=PMAS(PYCOMP(KSUSY1+6),1) | |
36490 | IF(AXMI.GT.PMAS(PYCOMP(KSUSY2+6),1)+XMF) THEN | |
36491 | GOTO 160 | |
36492 | ELSEIF(AXMI.GT.PMAS(PYCOMP(KSUSY1+6),1)+XMF) THEN | |
36493 | PMAS(PYCOMP(KSUSY1+6),1)=100D0*XMI | |
36494 | ENDIF | |
36495 | CALL PYTBBN(IX,100,2D0/3D0,XMI,GAM) | |
36496 | LKNT=LKNT+1 | |
36497 | XLAM(LKNT)=GAM | |
36498 | IDLAM(LKNT,1)=KFNCHI(IX) | |
36499 | IDLAM(LKNT,2)=6 | |
36500 | IDLAM(LKNT,3)=-6 | |
36501 | PMAS(PYCOMP(KSUSY1+6),1)=PMOLD | |
36502 | ENDIF | |
36503 | 160 CONTINUE | |
36504 | ENDIF | |
36505 | 170 CONTINUE | |
36506 | ||
36507 | C...GLUINO -> CI Q QBAR' | |
36508 | DO 210 IX=1,2 | |
36509 | XMJ=SMW(IX) | |
36510 | AXMJ=ABS(XMJ) | |
36511 | IF(AXMI.GE.AXMJ) THEN | |
36512 | DO 180 I=1,2 | |
36513 | VMIXC(IX,I)=DCMPLX(VMIX(IX,I),VMIXI(IX,I)) | |
36514 | UMIXC(IX,I)=DCMPLX(UMIX(IX,I),UMIXI(IX,I)) | |
36515 | 180 CONTINUE | |
36516 | S12MIN=0D0 | |
36517 | S12MAX=(AXMI-AXMJ)**2 | |
36518 | XXC(1)=0D0 | |
36519 | XXC(2)=XMJ | |
36520 | XXC(3)=0D0 | |
36521 | XXC(4)=XMI | |
36522 | XXC(5)=PMAS(PYCOMP(KSUSY1+1),1) | |
36523 | XXC(6)=PMAS(PYCOMP(KSUSY1+2),1) | |
36524 | XXC(9)=1D6 | |
36525 | XXC(10)=0D0 | |
36526 | OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32))) | |
36527 | ORPP=DCONJG(OLPP) | |
36528 | CXC(1)=DCMPLX(0D0,0D0) | |
36529 | CXC(3)=DCMPLX(0D0,0D0) | |
36530 | CXC(5)=DCMPLX(0D0,0D0) | |
36531 | CXC(7)=DCMPLX(0D0,0D0) | |
36532 | CXC(2)=UMIXC(IX,1)*OLPP/SR2 | |
36533 | CXC(4)=-DCONJG(VMIXC(IX,1))*ORPP/SR2 | |
36534 | CXC(6)=DCMPLX(0D0,0D0) | |
36535 | CXC(8)=DCMPLX(0D0,0D0) | |
36536 | IF(XXC(5).LT.AXMI) THEN | |
36537 | XXC(5)=1D6 | |
36538 | ELSEIF(XXC(6).LT.AXMI) THEN | |
36539 | XXC(6)=1D6 | |
36540 | ENDIF | |
36541 | XXC(7)=XXC(6) | |
36542 | XXC(8)=XXC(5) | |
36543 | IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 190 | |
36544 | IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN | |
36545 | LKNT=LKNT+1 | |
36546 | XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)* | |
36547 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
36548 | IDLAM(LKNT,1)=KFCCHI(IX) | |
36549 | IDLAM(LKNT,2)=1 | |
36550 | IDLAM(LKNT,3)=-2 | |
36551 | LKNT=LKNT+1 | |
36552 | XLAM(LKNT)=XLAM(LKNT-1) | |
36553 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
36554 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
36555 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
36556 | ENDIF | |
36557 | IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN | |
36558 | LKNT=LKNT+1 | |
36559 | XLAM(LKNT)=XLAM(LKNT-1) | |
36560 | IDLAM(LKNT,1)=KFCCHI(IX) | |
36561 | IDLAM(LKNT,2)=3 | |
36562 | IDLAM(LKNT,3)=-4 | |
36563 | LKNT=LKNT+1 | |
36564 | XLAM(LKNT)=XLAM(LKNT-1) | |
36565 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
36566 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
36567 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
36568 | ENDIF | |
36569 | 190 CONTINUE | |
36570 | ||
36571 | XMF=PMAS(6,1) | |
36572 | XMFP=PMAS(5,1) | |
36573 | IF(AXMI.GE.AXMJ+XMF+XMFP) THEN | |
36574 | IF(XMI.GT.MIN(PMAS(PYCOMP(KSUSY1+5),1)+XMFP, | |
36575 | $ PMAS(PYCOMP(KSUSY2+6),1)+XMF)) GOTO 200 | |
36576 | PMOLT2=PMAS(PYCOMP(KSUSY2+6),1) | |
36577 | PMOLB2=PMAS(PYCOMP(KSUSY2+5),1) | |
36578 | PMOLT1=PMAS(PYCOMP(KSUSY1+6),1) | |
36579 | PMOLB1=PMAS(PYCOMP(KSUSY1+5),1) | |
36580 | IF(XMI.GT.PMOLT2+XMF) PMOLT2=100D0*AXMI | |
36581 | IF(XMI.GT.PMOLT1+XMF) PMOLT1=100D0*AXMI | |
36582 | IF(XMI.GT.PMOLB2+XMFP) PMOLB2=100D0*AXMI | |
36583 | IF(XMI.GT.PMOLB1+XMFP) PMOLB1=100D0*AXMI | |
36584 | CALL PYTBBC(IX,100,XMI,GAM) | |
36585 | LKNT=LKNT+1 | |
36586 | XLAM(LKNT)=GAM | |
36587 | IDLAM(LKNT,1)=KFCCHI(IX) | |
36588 | IDLAM(LKNT,2)=5 | |
36589 | IDLAM(LKNT,3)=-6 | |
36590 | LKNT=LKNT+1 | |
36591 | XLAM(LKNT)=XLAM(LKNT-1) | |
36592 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
36593 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
36594 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
36595 | PMAS(PYCOMP(KSUSY2+6),1)=PMOLT2 | |
36596 | PMAS(PYCOMP(KSUSY2+5),1)=PMOLB2 | |
36597 | PMAS(PYCOMP(KSUSY1+6),1)=PMOLT1 | |
36598 | PMAS(PYCOMP(KSUSY1+5),1)=PMOLB1 | |
36599 | ENDIF | |
36600 | 200 CONTINUE | |
36601 | ENDIF | |
36602 | 210 CONTINUE | |
36603 | ||
36604 | C...R-parity violating (3-body) decays. | |
36605 | CALL PYRVGL(KFIN,XLAM,IDLAM,LKNT) | |
36606 | ||
36607 | IKNT=LKNT | |
36608 | XLAM(0)=0D0 | |
36609 | DO 220 I=1,IKNT | |
36610 | IF(XLAM(I).LT.0D0) XLAM(I)=0D0 | |
36611 | XLAM(0)=XLAM(0)+XLAM(I) | |
36612 | 220 CONTINUE | |
36613 | IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6 | |
36614 | ||
36615 | RETURN | |
36616 | END | |
36617 | ||
36618 | C********************************************************************* | |
36619 | ||
36620 | C...PYTBBN | |
36621 | C...Calculates the three-body decay of gluinos into | |
36622 | C...neutralinos and third generation fermions. | |
36623 | ||
36624 | SUBROUTINE PYTBBN(I,NN,E,XMGLU,GAM) | |
36625 | ||
36626 | C...Double precision and integer declarations. | |
36627 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
36628 | IMPLICIT INTEGER(I-N) | |
36629 | INTEGER PYK,PYCHGE,PYCOMP | |
36630 | C...Parameter statement to help give large particle numbers. | |
36631 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
36632 | &KEXCIT=4000000,KDIMEN=5000000) | |
36633 | C...Commonblocks. | |
36634 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
36635 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
36636 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
36637 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
36638 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
36639 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ | |
36640 | ||
36641 | C...Local variables. | |
36642 | EXTERNAL PYSIMP,PYLAMF | |
36643 | DOUBLE PRECISION PYSIMP,PYLAMF | |
36644 | INTEGER LIN,NN | |
36645 | DOUBLE PRECISION COSD,SIND,COSD2,SIND2,COS2D,SIN2D | |
36646 | DOUBLE PRECISION HL,HR,FL,FR,HL2,HR2,FL2,FR2 | |
36647 | DOUBLE PRECISION XMS2(2),XM,XM2,XMG,XMG2,XMR,XMR2 | |
36648 | DOUBLE PRECISION SBAR,SMIN,SMAX,XMQA,W,GRS,G(0:6),SUMME(0:100) | |
36649 | DOUBLE PRECISION FF,HH,HFL,HFR,HRFL,HLFR,XMQ4,XM24 | |
36650 | DOUBLE PRECISION XLN1,XLN2,B1,B2 | |
36651 | DOUBLE PRECISION E,XMGLU,GAM | |
36652 | DOUBLE PRECISION HRB(4),HLB(4),FLB(4),FRB(4) | |
36653 | SAVE HRB,HLB,FLB,FRB | |
36654 | DOUBLE PRECISION ALPHAW,ALPHAS | |
36655 | DOUBLE PRECISION HLT(4),HRT(4),FLT(4),FRT(4) | |
36656 | SAVE HLT,HRT,FLT,FRT | |
36657 | DOUBLE PRECISION AMN(4),AN(4,4),ZN(3) | |
36658 | SAVE AMN,AN,ZN | |
36659 | DOUBLE PRECISION AMBOT,SINC,COSC | |
36660 | DOUBLE PRECISION AMTOP,SINA,COSA | |
36661 | DOUBLE PRECISION SINW,COSW,TANW | |
36662 | DOUBLE PRECISION ROT1(4,4) | |
36663 | LOGICAL IFIRST | |
36664 | SAVE IFIRST | |
36665 | DATA IFIRST/.TRUE./ | |
36666 | ||
36667 | TANB=RMSS(5) | |
36668 | SINB=TANB/SQRT(1D0+TANB**2) | |
36669 | COSB=SINB/TANB | |
36670 | XW=PARU(102) | |
36671 | SINW=SQRT(XW) | |
36672 | COSW=SQRT(1D0-XW) | |
36673 | TANW=SINW/COSW | |
36674 | AMW=PMAS(24,1) | |
36675 | COSC=SFMIX(5,1) | |
36676 | SINC=SFMIX(5,3) | |
36677 | COSA=SFMIX(6,1) | |
36678 | SINA=SFMIX(6,3) | |
36679 | AMBOT=PYMRUN(5,XMGLU**2) | |
36680 | AMTOP=PYMRUN(6,XMGLU**2) | |
36681 | W2=SQRT(2D0) | |
36682 | FAKT1=AMBOT/W2/AMW/COSB | |
36683 | FAKT2=AMTOP/W2/AMW/SINB | |
36684 | IF(IFIRST) THEN | |
36685 | DO 110 II=1,4 | |
36686 | AMN(II)=SMZ(II) | |
36687 | DO 100 J=1,4 | |
36688 | ROT1(II,J)=0D0 | |
36689 | AN(II,J)=0D0 | |
36690 | 100 CONTINUE | |
36691 | 110 CONTINUE | |
36692 | ROT1(1,1)=COSW | |
36693 | ROT1(1,2)=-SINW | |
36694 | ROT1(2,1)=-ROT1(1,2) | |
36695 | ROT1(2,2)=ROT1(1,1) | |
36696 | ROT1(3,3)=COSB | |
36697 | ROT1(3,4)=SINB | |
36698 | ROT1(4,3)=-ROT1(3,4) | |
36699 | ROT1(4,4)=ROT1(3,3) | |
36700 | DO 140 II=1,4 | |
36701 | DO 130 J=1,4 | |
36702 | DO 120 JJ=1,4 | |
36703 | AN(II,J)=AN(II,J)+ZMIX(II,JJ)*ROT1(JJ,J) | |
36704 | 120 CONTINUE | |
36705 | 130 CONTINUE | |
36706 | 140 CONTINUE | |
36707 | DO 150 J=1,4 | |
36708 | ZN(1)=-FAKT2*(-SINB*AN(J,3)+COSB*AN(J,4)) | |
36709 | ZN(2)=-2D0*W2/3D0*SINW*(TANW*AN(J,2)-AN(J,1)) | |
36710 | ZN(3)=-2*W2/3D0*SINW*AN(J,1)-W2*(0.5D0-2D0/3D0* | |
36711 | & XW)*AN(J,2)/COSW | |
36712 | HRT(J)=ZN(1)*COSA-ZN(3)*SINA | |
36713 | HLT(J)=ZN(1)*COSA+ZN(2)*SINA | |
36714 | FLT(J)=ZN(3)*COSA+ZN(1)*SINA | |
36715 | FRT(J)=ZN(2)*COSA-ZN(1)*SINA | |
36716 | C FLU(J)=ZN(3) | |
36717 | C FRU(J)=ZN(2) | |
36718 | ZN(1)=-FAKT1*(COSB*AN(J,3)+SINB*AN(J,4)) | |
36719 | ZN(2)=W2/3D0*SINW*(TANW*AN(J,2)-AN(J,1)) | |
36720 | ZN(3)=W2/3D0*SINW*AN(J,1)+W2*(0.5D0-XW/3D0)*AN(J,2)/COSW | |
36721 | HRB(J)=ZN(1)*COSC-ZN(3)*SINC | |
36722 | HLB(J)=ZN(1)*COSC+ZN(2)*SINC | |
36723 | FLB(J)=ZN(3)*COSC+ZN(1)*SINC | |
36724 | FRB(J)=ZN(2)*COSC-ZN(1)*SINC | |
36725 | C FLD(J)=ZN(3) | |
36726 | C FRD(J)=ZN(2) | |
36727 | 150 CONTINUE | |
36728 | C AMST(1)=PMAS(PYCOMP(KSUSY1+6),1) | |
36729 | C AMST(2)=PMAS(PYCOMP(KSUSY2+6),1) | |
36730 | C AMSB(1)=PMAS(PYCOMP(KSUSY1+5),1) | |
36731 | C AMSB(2)=PMAS(PYCOMP(KSUSY2+5),1) | |
36732 | IFIRST=.FALSE. | |
36733 | ENDIF | |
36734 | ||
36735 | IF(NINT(3D0*E).EQ.2) THEN | |
36736 | HL=HLT(I) | |
36737 | HR=HRT(I) | |
36738 | FL=FLT(I) | |
36739 | FR=FRT(I) | |
36740 | COSD=SFMIX(6,1) | |
36741 | SIND=SFMIX(6,3) | |
36742 | XMS2(1)=PMAS(PYCOMP(KSUSY1+6),1)**2 | |
36743 | XMS2(2)=PMAS(PYCOMP(KSUSY2+6),1)**2 | |
36744 | XM=PMAS(6,1) | |
36745 | ELSE | |
36746 | HL=HLB(I) | |
36747 | HR=HRB(I) | |
36748 | FL=FLB(I) | |
36749 | FR=FRB(I) | |
36750 | COSD=SFMIX(5,1) | |
36751 | SIND=SFMIX(5,3) | |
36752 | XMS2(1)=PMAS(PYCOMP(KSUSY1+5),1)**2 | |
36753 | XMS2(2)=PMAS(PYCOMP(KSUSY2+5),1)**2 | |
36754 | XM=PMAS(5,1) | |
36755 | ENDIF | |
36756 | COSD2=COSD*COSD | |
36757 | SIND2=SIND*SIND | |
36758 | COS2D=COSD2-SIND2 | |
36759 | SIN2D=SIND*COSD*2D0 | |
36760 | HL2=HL*HL | |
36761 | HR2=HR*HR | |
36762 | FL2=FL*FL | |
36763 | FR2=FR*FR | |
36764 | FF=FL*FR | |
36765 | HH=HL*HR | |
36766 | HFL=HL*FL | |
36767 | HFR=HR*FR | |
36768 | HRFL=HR*FL | |
36769 | HLFR=HL*FR | |
36770 | XM2=XM*XM | |
36771 | XMG=XMGLU | |
36772 | XMG2=XMG*XMG | |
36773 | ALPHAW=PYALEM(XMG2) | |
36774 | ALPHAS=PYALPS(XMG2) | |
36775 | XMR=AMN(I) | |
36776 | XMR2=XMR*XMR | |
36777 | XMQ4=XMG*XM2*XMR | |
36778 | XM24=(XMG2+XM2)*(XM2+XMR2) | |
36779 | SMIN=4D0*XM2 | |
36780 | SMAX=(XMG-ABS(XMR))**2 | |
36781 | XMQA=XMG2+2D0*XM2+XMR2 | |
36782 | DO 170 LIN=1,NN-1 | |
36783 | SBAR=SMIN+DBLE(LIN)*(SMAX-SMIN)/DBLE(NN) | |
36784 | GRS=SBAR-XMQA | |
36785 | W=PYLAMF(XMG2,XMR2,SBAR)*(0.25D0-XM2/SBAR) | |
36786 | W=DSQRT(W) | |
36787 | XLN1=LOG(ABS((GRS/2D0+XMS2(1)-W)/(GRS/2D0+XMS2(1)+W))) | |
36788 | XLN2=LOG(ABS((GRS/2D0+XMS2(2)-W)/(GRS/2D0+XMS2(2)+W))) | |
36789 | B1=1D0/(GRS/2D0+XMS2(1)-W)-1D0/(GRS/2D0+XMS2(1)+W) | |
36790 | B2=1D0/(GRS/2D0+XMS2(2)-W)-1D0/(GRS/2D0+XMS2(2)+W) | |
36791 | G(0)=-2D0*(HL2+FL2+HR2+FR2+(HFR-HFL)*SIN2D | |
36792 | & +2D0*(FF*SIND2-HH*COSD2))*W | |
36793 | G(1)=((HL2+FL2)*(XMQA-2D0*XMS2(1)-2D0*XM*XMG*SIN2D) | |
36794 | & +4D0*HFL*XM*XMR)*XLN1 | |
36795 | & +((HL2+FL2)*((XMQA-XMS2(1))*XMS2(1)-XM24 | |
36796 | & +2D0*XM*XMG*(XM2+XMR2-XMS2(1))*SIN2D) | |
36797 | & -4D0*HFL*XMR*XM*(XMG2+XM2-XMS2(1)) | |
36798 | & +8D0*HFL*XMQ4*SIN2D)*B1 | |
36799 | G(2)=((HR2+FR2)*(XMQA-2D0*XMS2(2)+2D0*XM*XMG*SIN2D) | |
36800 | & +4D0*HFR*XMR*XM)*XLN2 | |
36801 | & +((HR2+FR2)*((XMQA-XMS2(2))*XMS2(2)-XM24 | |
36802 | & +2D0*XMG*XM*SIN2D*(XMS2(2)-XM2-XMR2)) | |
36803 | & +4D0*HFR*XM*XMR*(XMS2(2)-XMG2-XM2) | |
36804 | & -8D0*HFR*XMQ4*SIN2D)*B2 | |
36805 | G(3)=(2D0*HFL*SIN2D*(XMS2(1)*(GRS+XMS2(1))+XM2*(SBAR-XMG2-XMR2) | |
36806 | & +XMG2*XMR2+XM2*XM2)-2D0*XMR*XMG*(HL2*SIND2+FL2*COSD2)*SBAR | |
36807 | & -2D0*XMG*XM*HFL*(SBAR+XMR2-XMG2) | |
36808 | & +XMR*XM*(HL2+FL2)*SIN2D*(SBAR+XMG2-XMR2) | |
36809 | & -4D0*XMQ4*(HL2-FL2)*COS2D)/(GRS+2D0*XMS2(1))*XLN1 | |
36810 | G(4)=4D0*COS2D*XM*XMG/(XMS2(1)-XMS2(2))* | |
36811 | & (((HLFR+HRFL)*(XM2+XMR2)+2D0*XM*XMR*(HH+FF))*(XLN1-XLN2) | |
36812 | & +(HLFR+HRFL)*(XMS2(2)*XLN2-XMS2(1)*XLN1)) | |
36813 | G(5)=(2D0*(HH*COSD2-FF*SIND2) | |
36814 | & *((XMS2(2)*(XMS2(2)+GRS)+XM2*XM2+XMG2*XMR2)*XLN2 | |
36815 | & +(XMS2(1)*(XMS2(1)+GRS)+XM2*XM2+XMG2*XMR2)*XLN1) | |
36816 | & +XM*((HH-FF)*SIN2D*XMG-(HRFL-HLFR)*XMR) | |
36817 | & *((GRS+XMS2(1)*2D0)*XLN1-(GRS+XMS2(2)*2D0)*XLN2) | |
36818 | & +((HRFL-HLFR)*XMR*(SIN2D*XMG*(SBAR-4D0*XM2) | |
36819 | & +COS2D*XM*(SBAR+XMG2-XMR2)) | |
36820 | & +2D0*(FF*COSD2-HH*SIND2)*XM2*(SBAR-XMG2-XMR2)) | |
36821 | & *(XLN1+XLN2))/(GRS+XMS2(1)+XMS2(2)) | |
36822 | G(6)=(-2D0*HFR*SIN2D*(XMS2(2)*(GRS+XMS2(2))+XM2*(SBAR-XMG2-XMR2) | |
36823 | & +XMG2*XMR2+XM2*XM2)-2D0*XMR*XMG*(HR2*SIND2+FR2*COSD2)*SBAR | |
36824 | & -2D0*XMG*XM*HFR*(SBAR+XMR2-XMG2) | |
36825 | & -XMR*XM*(HR2+FR2)*SIN2D*(SBAR+XMG2-XMR2) | |
36826 | & -4D0*XMQ4*(HR2-FR2)*COS2D)/(GRS+2D0*XMS2(2))*XLN2 | |
36827 | SUMME(LIN)=0D0 | |
36828 | DO 160 J=0,6 | |
36829 | SUMME(LIN)=SUMME(LIN)+G(J) | |
36830 | 160 CONTINUE | |
36831 | 170 CONTINUE | |
36832 | SUMME(0)=0D0 | |
36833 | SUMME(NN)=0D0 | |
36834 | GAM = ALPHAW * ALPHAS * PYSIMP(SUMME,SMIN,SMAX,NN) | |
36835 | &/ (16D0 * PARU(1) * PARU(102) * XMGLU**3) | |
36836 | ||
36837 | RETURN | |
36838 | END | |
36839 | ||
36840 | C********************************************************************* | |
36841 | ||
36842 | C...PYTBBC | |
36843 | C...Calculates the three-body decay of gluinos into | |
36844 | C...charginos and third generation fermions. | |
36845 | ||
36846 | SUBROUTINE PYTBBC(I,NN,XMGLU,GAM) | |
36847 | ||
36848 | C...Double precision and integer declarations. | |
36849 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
36850 | IMPLICIT INTEGER(I-N) | |
36851 | INTEGER PYK,PYCHGE,PYCOMP | |
36852 | C...Parameter statement to help give large particle numbers. | |
36853 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
36854 | &KEXCIT=4000000,KDIMEN=5000000) | |
36855 | C...Commonblocks. | |
36856 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
36857 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
36858 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
36859 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
36860 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
36861 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ | |
36862 | ||
36863 | C...Local variables. | |
36864 | EXTERNAL PYSIMP,PYLAMF | |
36865 | DOUBLE PRECISION PYSIMP,PYLAMF | |
36866 | INTEGER I,NN,LIN | |
36867 | DOUBLE PRECISION XMG,XMG2,XMB,XMB2,XMR,XMR2 | |
36868 | DOUBLE PRECISION XMT,XMT2,XMST(4),XMSB(4) | |
36869 | DOUBLE PRECISION ULR(2),VLR(2),XMQ2,XMQ4,AM,W,SBAR,SMIN,SMAX | |
36870 | DOUBLE PRECISION SUMME(0:100),A(4,8) | |
36871 | DOUBLE PRECISION COS2A,SIN2A,COS2C,SIN2C | |
36872 | DOUBLE PRECISION GRS,XMQ3,XMGBTR,XMGTBR,ANT1,ANT2,ANB1,ANB2 | |
36873 | DOUBLE PRECISION XMGLU,GAM | |
36874 | DOUBLE PRECISION XX1(2),XX2(2),AAA(2),BBB(2),CCC(2), | |
36875 | &DDD(2),EEE(2),FFF(2) | |
36876 | SAVE XX1,XX2,AAA,BBB,CCC,DDD,EEE,FFF | |
36877 | DOUBLE PRECISION ALPHAW,ALPHAS | |
36878 | DOUBLE PRECISION AMC(2) | |
36879 | SAVE AMC | |
36880 | DOUBLE PRECISION AMBOT,AMSB(2),SINC,COSC | |
36881 | DOUBLE PRECISION AMTOP,AMST(2),SINA,COSA | |
36882 | SAVE AMSB,AMST | |
36883 | LOGICAL IFIRST | |
36884 | SAVE IFIRST | |
36885 | DATA IFIRST/.TRUE./ | |
36886 | ||
36887 | TANB=RMSS(5) | |
36888 | SINB=TANB/SQRT(1D0+TANB**2) | |
36889 | COSB=SINB/TANB | |
36890 | XW=PARU(102) | |
36891 | AMW=PMAS(24,1) | |
36892 | COSC=SFMIX(5,1) | |
36893 | SINC=SFMIX(5,3) | |
36894 | COSA=SFMIX(6,1) | |
36895 | SINA=SFMIX(6,3) | |
36896 | AMBOT=PYMRUN(5,XMGLU**2) | |
36897 | AMTOP=PYMRUN(6,XMGLU**2) | |
36898 | W2=SQRT(2D0) | |
36899 | AMW=PMAS(24,1) | |
36900 | FAKT1=AMBOT/W2/AMW/COSB | |
36901 | FAKT2=AMTOP/W2/AMW/SINB | |
36902 | IF(IFIRST) THEN | |
36903 | AMC(1)=SMW(1) | |
36904 | AMC(2)=SMW(2) | |
36905 | DO 100 JJ=1,2 | |
36906 | CCC(JJ)=FAKT1*UMIX(JJ,2)*SINC-UMIX(JJ,1)*COSC | |
36907 | EEE(JJ)=FAKT2*VMIX(JJ,2)*COSC | |
36908 | DDD(JJ)=FAKT1*UMIX(JJ,2)*COSC+UMIX(JJ,1)*SINC | |
36909 | FFF(JJ)=FAKT2*VMIX(JJ,2)*SINC | |
36910 | XX1(JJ)=FAKT2*VMIX(JJ,2)*SINA-VMIX(JJ,1)*COSA | |
36911 | AAA(JJ)=FAKT1*UMIX(JJ,2)*COSA | |
36912 | XX2(JJ)=FAKT2*VMIX(JJ,2)*COSA+VMIX(JJ,1)*SINA | |
36913 | BBB(JJ)=FAKT1*UMIX(JJ,2)*SINA | |
36914 | 100 CONTINUE | |
36915 | AMST(1)=PMAS(PYCOMP(KSUSY1+6),1) | |
36916 | AMST(2)=PMAS(PYCOMP(KSUSY2+6),1) | |
36917 | AMSB(1)=PMAS(PYCOMP(KSUSY1+5),1) | |
36918 | AMSB(2)=PMAS(PYCOMP(KSUSY2+5),1) | |
36919 | IFIRST=.FALSE. | |
36920 | ENDIF | |
36921 | ||
36922 | ULR(1)=XX1(I)*XX1(I)+AAA(I)*AAA(I) | |
36923 | ULR(2)=XX2(I)*XX2(I)+BBB(I)*BBB(I) | |
36924 | VLR(1)=CCC(I)*CCC(I)+EEE(I)*EEE(I) | |
36925 | VLR(2)=DDD(I)*DDD(I)+FFF(I)*FFF(I) | |
36926 | ||
36927 | COS2A=COSA**2-SINA**2 | |
36928 | SIN2A=SINA*COSA*2D0 | |
36929 | COS2C=COSC**2-SINC**2 | |
36930 | SIN2C=SINC*COSC*2D0 | |
36931 | ||
36932 | XMG=XMGLU | |
36933 | XMT=PMAS(6,1) | |
36934 | XMB=PMAS(5,1) | |
36935 | XMR=AMC(I) | |
36936 | XMG2=XMG*XMG | |
36937 | ALPHAW=PYALEM(XMG2) | |
36938 | ALPHAS=PYALPS(XMG2) | |
36939 | XMT2=XMT*XMT | |
36940 | XMB2=XMB*XMB | |
36941 | XMR2=XMR*XMR | |
36942 | XMQ2=XMG2+XMT2+XMB2+XMR2 | |
36943 | XMQ4=XMG*XMT*XMB*XMR | |
36944 | XMQ3=XMG2*XMR2+XMT2*XMB2 | |
36945 | XMGBTR=(XMG2+XMB2)*(XMT2+XMR2) | |
36946 | XMGTBR=(XMG2+XMT2)*(XMB2+XMR2) | |
36947 | ||
36948 | XMST(1)=AMST(1)*AMST(1) | |
36949 | XMST(2)=AMST(1)*AMST(1) | |
36950 | XMST(3)=AMST(2)*AMST(2) | |
36951 | XMST(4)=AMST(2)*AMST(2) | |
36952 | XMSB(1)=AMSB(1)*AMSB(1) | |
36953 | XMSB(2)=AMSB(2)*AMSB(2) | |
36954 | XMSB(3)=AMSB(1)*AMSB(1) | |
36955 | XMSB(4)=AMSB(2)*AMSB(2) | |
36956 | ||
36957 | A(1,1)=-COSA*SINC*CCC(I)*AAA(I)-SINA*COSC*EEE(I)*XX1(I) | |
36958 | A(1,2)=XMG*XMB*(COSA*COSC*CCC(I)*AAA(I)+SINA*SINC*EEE(I)*XX1(I)) | |
36959 | A(1,3)=-XMG*XMR*(COSA*COSC*CCC(I)*XX1(I)+SINA*SINC*EEE(I)*AAA(I)) | |
36960 | A(1,4)=XMB*XMR*(COSA*SINC*CCC(I)*XX1(I)+SINA*COSC*EEE(I)*AAA(I)) | |
36961 | A(1,5)=XMG*XMT*(COSA*COSC*EEE(I)*XX1(I)+SINA*SINC*CCC(I)*AAA(I)) | |
36962 | A(1,6)=-XMT*XMB*(COSA*SINC*EEE(I)*XX1(I)+SINA*COSC*CCC(I)*AAA(I)) | |
36963 | A(1,7)=XMT*XMR*(COSA*SINC*EEE(I)*AAA(I)+SINA*COSC*CCC(I)*XX1(I)) | |
36964 | A(1,8)=-XMQ4*(COSA*COSC*EEE(I)*AAA(I)+SINA*SINC*CCC(I)*XX1(I)) | |
36965 | ||
36966 | A(2,1)=-COSA*COSC*DDD(I)*AAA(I)-SINA*SINC*FFF(I)*XX1(I) | |
36967 | A(2,2)=-XMG*XMB*(COSA*SINC*DDD(I)*AAA(I)+SINA*COSC*FFF(I)*XX1(I)) | |
36968 | A(2,3)=XMG*XMR*(COSA*SINC*DDD(I)*XX1(I)+SINA*COSC*FFF(I)*AAA(I)) | |
36969 | A(2,4)=XMB*XMR*(COSA*COSC*DDD(I)*XX1(I)+SINA*SINC*FFF(I)*AAA(I)) | |
36970 | A(2,5)=XMG*XMT*(COSA*SINC*FFF(I)*XX1(I)+SINA*COSC*DDD(I)*AAA(I)) | |
36971 | A(2,6)=XMT*XMB*(COSA*COSC*FFF(I)*XX1(I)+SINA*SINC*DDD(I)*AAA(I)) | |
36972 | A(2,7)=-XMT*XMR*(COSA*COSC*FFF(I)*AAA(I)+SINA*SINC*DDD(I)*XX1(I)) | |
36973 | A(2,8)=-XMQ4*(COSA*SINC*FFF(I)*AAA(I)+SINA*COSC*DDD(I)*XX1(I)) | |
36974 | ||
36975 | A(3,1)=-COSA*COSC*EEE(I)*XX2(I)-SINA*SINC*CCC(I)*BBB(I) | |
36976 | A(3,2)=XMG*XMB*(COSA*SINC*EEE(I)*XX2(I)+SINA*COSC*CCC(I)*BBB(I)) | |
36977 | A(3,3)=XMG*XMR*(COSA*SINC*EEE(I)*BBB(I)+SINA*COSC*CCC(I)*XX2(I)) | |
36978 | A(3,4)=-XMB*XMR*(COSA*COSC*EEE(I)*BBB(I)+SINA*SINC*CCC(I)*XX2(I)) | |
36979 | A(3,5)=-XMG*XMT*(COSA*SINC*CCC(I)*BBB(I)+SINA*COSC*EEE(I)*XX2(I)) | |
36980 | A(3,6)=XMT*XMB*(COSA*COSC*CCC(I)*BBB(I)+SINA*SINC*EEE(I)*XX2(I)) | |
36981 | A(3,7)=XMT*XMR*(COSA*COSC*CCC(I)*XX2(I)+SINA*SINC*EEE(I)*BBB(I)) | |
36982 | A(3,8)=-XMQ4*(COSA*SINC*CCC(I)*XX2(I)+SINA*COSC*EEE(I)*BBB(I)) | |
36983 | ||
36984 | A(4,1)=-COSA*SINC*FFF(I)*XX2(I)-SINA*COSC*DDD(I)*BBB(I) | |
36985 | A(4,2)=-XMG*XMB*(COSA*COSC*FFF(I)*XX2(I)+SINA*SINC*DDD(I)*BBB(I)) | |
36986 | A(4,3)=-XMG*XMR*(COSA*COSC*FFF(I)*BBB(I)+SINA*SINC*DDD(I)*XX2(I)) | |
36987 | A(4,4)=-XMB*XMR*(COSA*SINC*FFF(I)*BBB(I)+SINA*COSC*DDD(I)*XX2(I)) | |
36988 | A(4,5)=-XMG*XMT*(COSA*COSC*DDD(I)*BBB(I)+SINA*SINC*FFF(I)*XX2(I)) | |
36989 | A(4,6)=-XMT*XMB*(COSA*SINC*DDD(I)*BBB(I)+SINA*COSC*FFF(I)*XX2(I)) | |
36990 | A(4,7)=-XMT*XMR*(COSA*SINC*DDD(I)*XX2(I)+SINA*COSC*FFF(I)*BBB(I)) | |
36991 | A(4,8)=-XMQ4*(COSA*COSC*DDD(I)*XX2(I)+SINA*SINC*FFF(I)*BBB(I)) | |
36992 | ||
36993 | SMAX=(XMG-ABS(XMR))**2 | |
36994 | SMIN=(XMB+XMT)**2+0.1D0 | |
36995 | ||
36996 | DO 120 LIN=0,NN-1 | |
36997 | SBAR=SMIN+DBLE(LIN)*(SMAX-SMIN)/DBLE(NN) | |
36998 | AM=(XMG2-XMR2)*(XMT2-XMB2)/2D0/SBAR | |
36999 | GRS=SBAR-XMQ2 | |
37000 | W=PYLAMF(SBAR,XMB2,XMT2)*PYLAMF(SBAR,XMG2,XMR2) | |
37001 | W=DSQRT(W)/2D0/SBAR | |
37002 | ANT1=LOG(ABS((GRS/2D0+AM+XMST(1)-W)/(GRS/2D0+AM+XMST(1)+W))) | |
37003 | ANT2=LOG(ABS((GRS/2D0+AM+XMST(3)-W)/(GRS/2D0+AM+XMST(3)+W))) | |
37004 | ANB1=LOG(ABS((GRS/2D0-AM+XMSB(1)-W)/(GRS/2D0-AM+XMSB(1)+W))) | |
37005 | ANB2=LOG(ABS((GRS/2D0-AM+XMSB(2)-W)/(GRS/2D0-AM+XMSB(2)+W))) | |
37006 | SUMME(LIN)=-ULR(1)*W+(ULR(1)*(XMQ2/2D0-XMST(1)-XMG*XMT*SIN2A) | |
37007 | & +2D0*XX1(I)*AAA(I)*XMR*XMB)*ANT1 | |
37008 | & +(ULR(1)/2D0*(XMST(1)*(XMQ2-XMST(1))-XMGTBR | |
37009 | & -2D0*XMG*XMT*SIN2A*(XMST(1)-XMB2-XMR2)) | |
37010 | & +2D0*XX1(I)*AAA(I)*XMR*XMB*(XMST(1)-XMG2-XMT2) | |
37011 | & +4D0*SIN2A*XX1(I)*AAA(I)*XMQ4) | |
37012 | & *(1D0/(GRS/2D0+AM+XMST(1)-W)-1D0/(GRS/2D0+AM+XMST(1)+W)) | |
37013 | SUMME(LIN)=SUMME(LIN)-ULR(2)*W | |
37014 | & +(ULR(2)*(XMQ2/2D0-XMST(3)+XMG*XMT*SIN2A) | |
37015 | & -2D0*XX2(I)*BBB(I)*XMR*XMB)*ANT2 | |
37016 | & +(ULR(2)/2D0*(XMST(3)*(XMQ2-XMST(3))-XMGTBR | |
37017 | & +2D0*XMG*XMT*SIN2A*(XMST(3)-XMB2-XMR2)) | |
37018 | & -2D0*XX2(I)*BBB(I)*XMR*XMB*(XMST(3)-XMG2-XMT2) | |
37019 | & +4D0*SIN2A*XX2(I)*BBB(I)*XMQ4) | |
37020 | & *(1D0/(GRS/2D0+AM+XMST(3)-W)-1D0/(GRS/2D0+AM+XMST(3)+W)) | |
37021 | SUMME(LIN)=SUMME(LIN)-VLR(1)*W | |
37022 | & +(VLR(1)*(XMQ2/2D0-XMSB(1)-XMG*XMB*SIN2C) | |
37023 | & +2D0*CCC(I)*EEE(I)*XMR*XMT)*ANB1 | |
37024 | & +(VLR(1)/2D0*(XMSB(1)*(XMQ2-XMSB(1))-XMGBTR | |
37025 | & -2D0*XMG*XMB*SIN2C*(XMSB(1)-XMT2-XMR2)) | |
37026 | & +2D0*CCC(I)*EEE(I)*XMR*XMT*(XMSB(1)-XMG2-XMB2) | |
37027 | & +4D0*SIN2C*CCC(I)*EEE(I)*XMQ4) | |
37028 | & *(1D0/(GRS/2D0-AM+XMSB(1)-W)-1D0/(GRS/2D0-AM+XMSB(1)+W)) | |
37029 | SUMME(LIN)=SUMME(LIN)-VLR(2)*W | |
37030 | & +(VLR(2)*(XMQ2/2D0-XMSB(2)+XMG*XMB*SIN2C) | |
37031 | & -2D0*DDD(I)*FFF(I)*XMR*XMT)*ANB2 | |
37032 | & +(VLR(2)/2D0*(XMSB(2)*(XMQ2-XMSB(2))-XMGBTR | |
37033 | & +2D0*XMG*XMB*SIN2C*(XMSB(2)-XMT2-XMR2)) | |
37034 | & -2D0*DDD(I)*FFF(I)*XMR*XMT*(XMSB(2)-XMG2-XMB2) | |
37035 | & +4D0*SIN2C*DDD(I)*FFF(I)*XMQ4) | |
37036 | & *(1D0/(GRS/2D0-AM+XMSB(2)-W)-1D0/(GRS/2D0-AM+XMSB(2)+W)) | |
37037 | SUMME(LIN)=SUMME(LIN)+2D0*XMG*XMT*COS2A/(XMST(3)-XMST(1)) | |
37038 | & *((AAA(I)*BBB(I)-XX1(I)*XX2(I)) | |
37039 | & *((XMST(3)-XMB2-XMR2)*ANT2-(XMST(1)-XMB2-XMR2)*ANT1) | |
37040 | & +2D0*(AAA(I)*XX2(I)-XX1(I)*BBB(I))*XMB*XMR*(ANT2-ANT1)) | |
37041 | SUMME(LIN)=SUMME(LIN)+2D0*XMG*XMB*COS2C/(XMSB(2)-XMSB(1)) | |
37042 | & *((EEE(I)*FFF(I)-CCC(I)*DDD(I)) | |
37043 | & *((XMSB(2)-XMT2-XMR2)*ANB2-(XMSB(1)-XMT2-XMR2)*ANB1) | |
37044 | & +2D0*(EEE(I)*DDD(I)-CCC(I)*FFF(I))*XMT*XMR*(ANB2-ANB1)) | |
37045 | DO 110 J=1,4 | |
37046 | SUMME(LIN)=SUMME(LIN)-2D0*A(J,1)*W | |
37047 | & +((-A(J,1)*(XMSB(J)*(GRS+XMSB(J))+XMQ3) | |
37048 | & +A(J,2)*(XMSB(J)-XMT2-XMR2)+A(J,3)*(SBAR-XMB2-XMT2) | |
37049 | & +A(J,4)*(XMSB(J)+SBAR-XMB2-XMR2) | |
37050 | & -A(J,5)*(XMSB(J)+SBAR-XMG2-XMT2)+A(J,6)*(XMG2+XMR2-SBAR) | |
37051 | & -A(J,7)*(XMSB(J)-XMG2-XMB2)+2D0*A(J,8)) | |
37052 | & *LOG(ABS((GRS/2D0+XMSB(J)-AM-W)/(GRS/2D0+XMSB(J)-AM+W))) | |
37053 | & -(A(J,1)*(XMST(J)*(GRS+XMST(J))+XMQ3) | |
37054 | & +A(J,2)*(XMST(J)+SBAR-XMG2-XMB2)-A(J,3)*(SBAR-XMB2-XMT2) | |
37055 | & +A(J,4)*(XMST(J)-XMG2-XMT2)-A(J,5)*(XMST(J)-XMR2-XMB2) | |
37056 | & -A(J,6)*(XMG2+XMR2-SBAR) | |
37057 | & -A(J,7)*(XMST(J)+SBAR-XMT2-XMR2)-2D0*A(J,8)) | |
37058 | & *LOG(ABS((GRS/2D0+XMST(J)+AM-W)/(GRS/2D0+XMST(J)+AM+W)))) | |
37059 | & /(GRS+XMSB(J)+XMST(J)) | |
37060 | 110 CONTINUE | |
37061 | 120 CONTINUE | |
37062 | SUMME(NN)=0D0 | |
37063 | GAM= ALPHAW * ALPHAS * PYSIMP(SUMME,SMIN,SMAX,NN) | |
37064 | &/ (16D0 * PARU(1) * PARU(102) * XMGLU**3) | |
37065 | ||
37066 | RETURN | |
37067 | END | |
37068 | ||
37069 | C********************************************************************* | |
37070 | ||
37071 | C...PYNJDC | |
37072 | C...Calculates decay widths for the neutralinos (admixtures of | |
37073 | C...Bino, W3-ino, Higgs1-ino, Higgs2-ino) | |
37074 | ||
37075 | C...Input: KCIN = KF code for particle | |
37076 | C...Output: XLAM = widths | |
37077 | C... IDLAM = KF codes for decay particles | |
37078 | C... IKNT = number of decay channels defined | |
37079 | C...AUTHOR: STEPHEN MRENNA | |
37080 | C...Last change: | |
37081 | C...10-15-95: force decay chi^0_2 -> chi^0_1 + gamma | |
37082 | C...when CHIGAMMA .NE. 0 | |
37083 | C...10 FEB 96: Calculate this decay for small tan(beta) | |
37084 | ||
37085 | SUBROUTINE PYNJDC(KFIN,XLAM,IDLAM,IKNT) | |
37086 | ||
37087 | C...Double precision and integer declarations. | |
37088 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
37089 | IMPLICIT INTEGER(I-N) | |
37090 | INTEGER PYK,PYCHGE,PYCOMP | |
37091 | C...Parameter statement to help give large particle numbers. | |
37092 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
37093 | &KEXCIT=4000000,KDIMEN=5000000) | |
37094 | C...Commonblocks. | |
37095 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
37096 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
37097 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
37098 | c COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
37099 | c &SFMIX(16,4) | |
37100 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
37101 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
37102 | C COMMON/PYINTS/XXM(20) | |
37103 | COMPLEX*16 CXC | |
37104 | COMMON/PYINTC/XXC(10),CXC(8) | |
37105 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTC/ | |
37106 | ||
37107 | C...Local variables. | |
37108 | COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP,GLIJ,GRIJ | |
37109 | COMPLEX*16 QIJ,RIJ,F21K,F12K,CAL,CAR,CBL,CBR,CA,CB | |
37110 | INTEGER KFIN | |
37111 | DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2, | |
37112 | &XMZ,XMZ2,AXMJ,AXMI | |
37113 | DOUBLE PRECISION S12MIN,S12MAX | |
37114 | DOUBLE PRECISION XMI2,XMI3,XMJ2,XMH,XMH2,XMHP,XMA2,XMB2 | |
37115 | DOUBLE PRECISION PYLAMF,XL | |
37116 | DOUBLE PRECISION TANW,XW,AEM,C1,AS,EI,T3I | |
37117 | DOUBLE PRECISION PYX2XH,PYX2XG | |
37118 | DOUBLE PRECISION XLAM(0:400) | |
37119 | INTEGER IDLAM(400,3) | |
37120 | INTEGER LKNT,IX,IH,J,IJ,I,IKNT,FID | |
37121 | INTEGER ITH(3),KF1,KF2 | |
37122 | INTEGER ITHC | |
37123 | DOUBLE PRECISION DH(3),EH(3) | |
37124 | DOUBLE PRECISION SR2 | |
37125 | DOUBLE PRECISION CBETA,SBETA | |
37126 | DOUBLE PRECISION GAMCON,XMT1,XMT2 | |
37127 | DOUBLE PRECISION PYALEM,PI,PYALPS | |
37128 | DOUBLE PRECISION RAT1,RAT2 | |
37129 | DOUBLE PRECISION T3T,FCOL | |
37130 | DOUBLE PRECISION ALFA,BETA,TANB | |
37131 | DOUBLE PRECISION PYXXGA | |
37132 | EXTERNAL PYGAUS,PYXXZ6 | |
37133 | DOUBLE PRECISION PYGAUS,PYXXZ6 | |
37134 | DOUBLE PRECISION PREC | |
37135 | INTEGER KFNCHI(4),KFCCHI(2) | |
37136 | DATA ITH/25,35,36/ | |
37137 | DATA ITHC/37/ | |
37138 | DATA PREC/1D-2/ | |
37139 | DATA PI/3.141592654D0/ | |
37140 | DATA SR2/1.4142136D0/ | |
37141 | DATA KFNCHI/1000022,1000023,1000025,1000035/ | |
37142 | DATA KFCCHI/1000024,1000037/ | |
37143 | ||
37144 | C...COUNT THE NUMBER OF DECAY MODES | |
37145 | LKNT=0 | |
37146 | ||
37147 | XMW=PMAS(24,1) | |
37148 | XMW2=XMW**2 | |
37149 | XMZ=PMAS(23,1) | |
37150 | XMZ2=XMZ**2 | |
37151 | XW=1D0-XMW2/XMZ2 | |
37152 | XW1=1D0-XW | |
37153 | TANW = SQRT(XW/XW1) | |
37154 | ||
37155 | C...IX IS 1 - 4 DEPENDING ON SEQUENCE NUMBER | |
37156 | IX=1 | |
37157 | IF(KFIN.EQ.KFNCHI(2)) IX=2 | |
37158 | IF(KFIN.EQ.KFNCHI(3)) IX=3 | |
37159 | IF(KFIN.EQ.KFNCHI(4)) IX=4 | |
37160 | ||
37161 | XMI=SMZ(IX) | |
37162 | XMI2=XMI**2 | |
37163 | AXMI=ABS(XMI) | |
37164 | AEM=PYALEM(XMI2) | |
37165 | AS =PYALPS(XMI2) | |
37166 | C1=AEM/XW | |
37167 | XMI3=ABS(XMI**3) | |
37168 | ||
37169 | TANB=RMSS(5) | |
37170 | BETA=ATAN(TANB) | |
37171 | ALFA=RMSS(18) | |
37172 | CBETA=COS(BETA) | |
37173 | SBETA=TANB*CBETA | |
37174 | CALFA=COS(ALFA) | |
37175 | SALFA=SIN(ALFA) | |
37176 | ||
37177 | DO 110 I=1,4 | |
37178 | DO 100 J=1,4 | |
37179 | ZMIXC(J,I)=DCMPLX(ZMIX(J,I),ZMIXI(J,I)) | |
37180 | 100 CONTINUE | |
37181 | 110 CONTINUE | |
37182 | DO 130 I=1,2 | |
37183 | DO 120 J=1,2 | |
37184 | VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) | |
37185 | UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) | |
37186 | 120 CONTINUE | |
37187 | 130 CONTINUE | |
37188 | ||
37189 | C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS | |
37190 | IF(IX.EQ.1.AND.IMSS(11).EQ.0) GOTO 300 | |
37191 | ||
37192 | C...FORCE CHI0_2 -> CHI0_1 + GAMMA | |
37193 | IF(IX.EQ.2 .AND. IMSS(10).NE.0 ) THEN | |
37194 | XMJ=SMZ(1) | |
37195 | AXMJ=ABS(XMJ) | |
37196 | LKNT=LKNT+1 | |
37197 | GAMCON=AEM**3/8D0/PI/XMW2/XW | |
37198 | XMT1=(PMAS(PYCOMP(KSUSY1+6),1)/PMAS(6,1))**2 | |
37199 | XMT2=(PMAS(PYCOMP(KSUSY2+6),1)/PMAS(6,1))**2 | |
37200 | XLAM(LKNT)=PYXXGA(GAMCON,AXMI,AXMJ,XMT1,XMT2) | |
37201 | IDLAM(LKNT,1)=KSUSY1+22 | |
37202 | IDLAM(LKNT,2)=22 | |
37203 | IDLAM(LKNT,3)=0 | |
37204 | WRITE(MSTU(11),*) 'FORCED N2 -> N1 + GAMMA ',XLAM(LKNT) | |
37205 | GOTO 340 | |
37206 | ENDIF | |
37207 | ||
37208 | C...GRAVITINO DECAY MODES | |
37209 | ||
37210 | IF(IMSS(11).EQ.1) THEN | |
37211 | XMP=RMSS(29) | |
37212 | IDG=39+KSUSY1 | |
37213 | XMGR=PMAS(PYCOMP(IDG),1) | |
37214 | SINW=SQRT(XW) | |
37215 | COSW=SQRT(1D0-XW) | |
37216 | XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI | |
37217 | IF(AXMI.GT.XMGR+PMAS(22,1)) THEN | |
37218 | LKNT=LKNT+1 | |
37219 | IDLAM(LKNT,1)=IDG | |
37220 | IDLAM(LKNT,2)=22 | |
37221 | IDLAM(LKNT,3)=0 | |
37222 | XLAM(LKNT)=XFAC*ABS(ZMIXC(IX,1)*COSW+ZMIXC(IX,2)*SINW)**2 | |
37223 | ENDIF | |
37224 | IF(AXMI.GT.XMGR+XMZ) THEN | |
37225 | LKNT=LKNT+1 | |
37226 | IDLAM(LKNT,1)=IDG | |
37227 | IDLAM(LKNT,2)=23 | |
37228 | IDLAM(LKNT,3)=0 | |
37229 | XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,1)*SINW-ZMIXC(IX,2)*COSW)**2 + | |
37230 | $ .5D0*ABS(ZMIXC(IX,3)*CBETA-ZMIXC(IX,4)*SBETA)**2)* | |
37231 | & (1D0-XMZ2/XMI2)**4 | |
37232 | ENDIF | |
37233 | IF(AXMI.GT.XMGR+PMAS(25,1)) THEN | |
37234 | LKNT=LKNT+1 | |
37235 | IDLAM(LKNT,1)=IDG | |
37236 | IDLAM(LKNT,2)=25 | |
37237 | IDLAM(LKNT,3)=0 | |
37238 | XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,3)*SALFA-ZMIXC(IX,4)*CALFA)**2)* | |
37239 | $ .5D0*(1D0-PMAS(25,1)**2/XMI2)**4 | |
37240 | ENDIF | |
37241 | IF(AXMI.GT.XMGR+PMAS(35,1)) THEN | |
37242 | LKNT=LKNT+1 | |
37243 | IDLAM(LKNT,1)=IDG | |
37244 | IDLAM(LKNT,2)=35 | |
37245 | IDLAM(LKNT,3)=0 | |
37246 | XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,3)*CALFA+ZMIXC(IX,4)*SALFA)**2)* | |
37247 | $ .5D0*(1D0-PMAS(35,1)**2/XMI2)**4 | |
37248 | ENDIF | |
37249 | IF(AXMI.GT.XMGR+PMAS(36,1)) THEN | |
37250 | LKNT=LKNT+1 | |
37251 | IDLAM(LKNT,1)=IDG | |
37252 | IDLAM(LKNT,2)=36 | |
37253 | IDLAM(LKNT,3)=0 | |
37254 | XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,3)*SBETA+ZMIXC(IX,4)*CBETA)**2)* | |
37255 | $ .5D0*(1D0-PMAS(36,1)**2/XMI2)**4 | |
37256 | ENDIF | |
37257 | IF(IX.EQ.1) GOTO 300 | |
37258 | ENDIF | |
37259 | ||
37260 | DO 220 IJ=1,IX-1 | |
37261 | XMJ=SMZ(IJ) | |
37262 | AXMJ=ABS(XMJ) | |
37263 | XMJ2=XMJ**2 | |
37264 | ||
37265 | C...CHI0_I -> CHI0_J + GAMMA | |
37266 | IF(AXMI.GE.AXMJ.AND.SBETA/CBETA.LE.2D0) THEN | |
37267 | RAT1=ABS(ZMIXC(IJ,1))**2+ABS(ZMIXC(IJ,2))**2 | |
37268 | RAT1=RAT1/( 1D-6+ABS(ZMIXC(IX,3))**2+ABS(ZMIXC(IX,4))**2 ) | |
37269 | RAT2=ABS(ZMIXC(IX,1))**2+ABS(ZMIXC(IX,2))**2 | |
37270 | RAT2=RAT2/( 1D-6+ABS(ZMIXC(IJ,3))**2+ABS(ZMIXC(IJ,4))**2 ) | |
37271 | IF((RAT1.GT. 0.90D0 .AND. RAT1.LT. 1.10D0) .OR. | |
37272 | & (RAT2.GT. 0.90D0 .AND. RAT2.LT. 1.10D0)) THEN | |
37273 | LKNT=LKNT+1 | |
37274 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37275 | IDLAM(LKNT,2)=22 | |
37276 | IDLAM(LKNT,3)=0 | |
37277 | GAMCON=AEM**3/8D0/PI/XMW2/XW | |
37278 | XMT1=(PMAS(PYCOMP(KSUSY1+6),1)/PMAS(6,1))**2 | |
37279 | XMT2=(PMAS(PYCOMP(KSUSY2+6),1)/PMAS(6,1))**2 | |
37280 | XLAM(LKNT)=PYXXGA(GAMCON,AXMI,AXMJ,XMT1,XMT2) | |
37281 | ENDIF | |
37282 | ENDIF | |
37283 | ||
37284 | C...CHI0_I -> CHI0_J + Z0 | |
37285 | IF(AXMI.GE.AXMJ+XMZ) THEN | |
37286 | LKNT=LKNT+1 | |
37287 | OLPP=(ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,3))- | |
37288 | & ZMIXC(IX,4)*DCONJG(ZMIXC(IJ,4)))/2D0 | |
37289 | ORPP=-DCONJG(OLPP) | |
37290 | GX2=ABS(OLPP)**2+ABS(ORPP)**2 | |
37291 | GLR=DBLE(OLPP*DCONJG(ORPP)) | |
37292 | XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMZ,GX2,GLR) | |
37293 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37294 | IDLAM(LKNT,2)=23 | |
37295 | IDLAM(LKNT,3)=0 | |
37296 | ELSEIF(AXMI.GE.AXMJ) THEN | |
37297 | XXC(1)=0D0 | |
37298 | XXC(2)=XMJ | |
37299 | XXC(3)=0D0 | |
37300 | XXC(4)=XMI | |
37301 | XXC(9)=XMZ | |
37302 | XXC(10)=PMAS(23,2) | |
37303 | OLPP=(ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,3))- | |
37304 | & ZMIXC(IX,4)*DCONJG(ZMIXC(IJ,4)))/2D0 | |
37305 | ORPP=DCONJG(OLPP) | |
37306 | C...CHARGED LEPTONS | |
37307 | FID=11 | |
37308 | XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) | |
37309 | XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) | |
37310 | EI=KCHG(FID,1)/3D0 | |
37311 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
37312 | GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* | |
37313 | & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) | |
37314 | GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 | |
37315 | CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP | |
37316 | CXC(2)=-GLIJ | |
37317 | CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP | |
37318 | CXC(4)=DCONJG(GLIJ) | |
37319 | CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP | |
37320 | CXC(6)=GRIJ | |
37321 | CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP | |
37322 | CXC(8)=-DCONJG(GRIJ) | |
37323 | S12MIN=0D0 | |
37324 | S12MAX=(AXMI-AXMJ)**2 | |
37325 | IF( XXC(5).LT.AXMI ) THEN | |
37326 | XXC(5)=1D6 | |
37327 | ENDIF | |
37328 | IF(XXC(6).LT.AXMI ) THEN | |
37329 | XXC(6)=1D6 | |
37330 | ENDIF | |
37331 | XXC(7)=XXC(5) | |
37332 | XXC(8)=XXC(6) | |
37333 | ||
37334 | IF(AXMI.GE.AXMJ+2D0*PMAS(11,1)) THEN | |
37335 | LKNT=LKNT+1 | |
37336 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
37337 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) | |
37338 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37339 | IDLAM(LKNT,2)=FID | |
37340 | IDLAM(LKNT,3)=-FID | |
37341 | IF(AXMI.GE.AXMJ+2D0*PMAS(13,1)) THEN | |
37342 | LKNT=LKNT+1 | |
37343 | XLAM(LKNT)=XLAM(LKNT-1) | |
37344 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37345 | IDLAM(LKNT,2)=13 | |
37346 | IDLAM(LKNT,3)=-13 | |
37347 | ENDIF | |
37348 | ENDIF | |
37349 | 140 CONTINUE | |
37350 | IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN | |
37351 | XXC(5)=PMAS(PYCOMP(KSUSY1+15),1) | |
37352 | XXC(6)=PMAS(PYCOMP(KSUSY2+15),1) | |
37353 | ELSE | |
37354 | XXC(6)=PMAS(PYCOMP(KSUSY1+15),1) | |
37355 | XXC(5)=PMAS(PYCOMP(KSUSY2+15),1) | |
37356 | ENDIF | |
37357 | IF( XXC(5).LT.AXMI ) THEN | |
37358 | XXC(5)=1D6 | |
37359 | ENDIF | |
37360 | IF(XXC(6).LT.AXMI ) THEN | |
37361 | XXC(6)=1D6 | |
37362 | ENDIF | |
37363 | XXC(7)=XXC(5) | |
37364 | XXC(8)=XXC(6) | |
37365 | ||
37366 | IF(AXMI.GE.AXMJ+2D0*PMAS(15,1)) THEN | |
37367 | LKNT=LKNT+1 | |
37368 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
37369 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) | |
37370 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37371 | IDLAM(LKNT,2)=15 | |
37372 | IDLAM(LKNT,3)=-15 | |
37373 | ENDIF | |
37374 | ||
37375 | C...NEUTRINOS | |
37376 | 150 CONTINUE | |
37377 | FID=12 | |
37378 | XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) | |
37379 | XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) | |
37380 | EI=KCHG(FID,1)/3D0 | |
37381 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
37382 | GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* | |
37383 | & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) | |
37384 | GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 | |
37385 | CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP | |
37386 | CXC(2)=-GLIJ | |
37387 | CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP | |
37388 | CXC(4)=DCONJG(GLIJ) | |
37389 | CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP | |
37390 | CXC(6)=GRIJ | |
37391 | CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP | |
37392 | CXC(8)=-DCONJG(GRIJ) | |
37393 | S12MIN=0D0 | |
37394 | S12MAX=(AXMI-AXMJ)**2 | |
37395 | IF( XXC(5).LT.AXMI ) THEN | |
37396 | XXC(5)=1D6 | |
37397 | ENDIF | |
37398 | IF( XXC(6).LT.AXMI ) THEN | |
37399 | XXC(6)=1D6 | |
37400 | ENDIF | |
37401 | XXC(7)=XXC(5) | |
37402 | XXC(8)=XXC(6) | |
37403 | ||
37404 | LKNT=LKNT+1 | |
37405 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
37406 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) | |
37407 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37408 | IDLAM(LKNT,2)=12 | |
37409 | IDLAM(LKNT,3)=-12 | |
37410 | LKNT=LKNT+1 | |
37411 | XLAM(LKNT)=XLAM(LKNT-1) | |
37412 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37413 | IDLAM(LKNT,2)=14 | |
37414 | IDLAM(LKNT,3)=-14 | |
37415 | 160 CONTINUE | |
37416 | ||
37417 | IF(PMAS(PYCOMP(KSUSY1+16),1).NE.PMAS(PYCOMP(KSUSY1+12),1)) | |
37418 | & THEN | |
37419 | XXC(5)=PMAS(PYCOMP(KSUSY1+16),1) | |
37420 | IF( XXC(5).LT.AXMI ) THEN | |
37421 | XXC(5)=1D6 | |
37422 | ENDIF | |
37423 | XXC(7)=XXC(5) | |
37424 | LKNT=LKNT+1 | |
37425 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
37426 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) | |
37427 | ELSE | |
37428 | LKNT=LKNT+1 | |
37429 | XLAM(LKNT)=XLAM(LKNT-1) | |
37430 | ENDIF | |
37431 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37432 | IDLAM(LKNT,2)=16 | |
37433 | IDLAM(LKNT,3)=-16 | |
37434 | C...D-TYPE QUARKS | |
37435 | 170 CONTINUE | |
37436 | FID=1 | |
37437 | XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) | |
37438 | XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) | |
37439 | EI=KCHG(FID,1)/3D0 | |
37440 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
37441 | GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* | |
37442 | & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) | |
37443 | GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 | |
37444 | CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP | |
37445 | CXC(2)=-GLIJ | |
37446 | CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP | |
37447 | CXC(4)=DCONJG(GLIJ) | |
37448 | CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP | |
37449 | CXC(6)=GRIJ | |
37450 | CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP | |
37451 | CXC(8)=-DCONJG(GRIJ) | |
37452 | S12MIN=0D0 | |
37453 | S12MAX=(AXMI-AXMJ)**2 | |
37454 | IF( XXC(5).LT.AXMI ) THEN | |
37455 | XXC(5)=1D6 | |
37456 | ENDIF | |
37457 | IF( XXC(6).LT.AXMI ) THEN | |
37458 | XXC(6)=1D6 | |
37459 | ENDIF | |
37460 | XXC(7)=XXC(5) | |
37461 | XXC(8)=XXC(6) | |
37462 | ||
37463 | IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN | |
37464 | LKNT=LKNT+1 | |
37465 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
37466 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3)*3D0 | |
37467 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37468 | IDLAM(LKNT,2)=1 | |
37469 | IDLAM(LKNT,3)=-1 | |
37470 | IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN | |
37471 | LKNT=LKNT+1 | |
37472 | XLAM(LKNT)=XLAM(LKNT-1) | |
37473 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37474 | IDLAM(LKNT,2)=3 | |
37475 | IDLAM(LKNT,3)=-3 | |
37476 | ENDIF | |
37477 | ENDIF | |
37478 | 180 CONTINUE | |
37479 | IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN | |
37480 | XXC(5)=PMAS(PYCOMP(KSUSY1+5),1) | |
37481 | XXC(6)=PMAS(PYCOMP(KSUSY2+5),1) | |
37482 | ELSE | |
37483 | XXC(6)=PMAS(PYCOMP(KSUSY1+5),1) | |
37484 | XXC(5)=PMAS(PYCOMP(KSUSY2+5),1) | |
37485 | ENDIF | |
37486 | IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 190 | |
37487 | IF(XXC(5).LT.AXMI) THEN | |
37488 | XXC(5)=1D6 | |
37489 | ELSEIF(XXC(6).LT.AXMI) THEN | |
37490 | XXC(6)=1D6 | |
37491 | ENDIF | |
37492 | XXC(7)=XXC(5) | |
37493 | XXC(8)=XXC(6) | |
37494 | IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN | |
37495 | LKNT=LKNT+1 | |
37496 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
37497 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3)*3D0 | |
37498 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37499 | IDLAM(LKNT,2)=5 | |
37500 | IDLAM(LKNT,3)=-5 | |
37501 | ENDIF | |
37502 | ||
37503 | C...U-TYPE QUARKS | |
37504 | 190 CONTINUE | |
37505 | FID=2 | |
37506 | XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) | |
37507 | XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) | |
37508 | EI=KCHG(FID,1)/3D0 | |
37509 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
37510 | GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* | |
37511 | & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) | |
37512 | GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 | |
37513 | CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP | |
37514 | CXC(2)=-GLIJ | |
37515 | CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP | |
37516 | CXC(4)=DCONJG(GLIJ) | |
37517 | CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP | |
37518 | CXC(6)=GRIJ | |
37519 | CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP | |
37520 | CXC(8)=-DCONJG(GRIJ) | |
37521 | ||
37522 | IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 200 | |
37523 | IF(XXC(5).LT.AXMI) THEN | |
37524 | XXC(5)=1D6 | |
37525 | ELSEIF(XXC(6).LT.AXMI) THEN | |
37526 | XXC(6)=1D6 | |
37527 | ENDIF | |
37528 | XXC(7)=XXC(5) | |
37529 | XXC(8)=XXC(6) | |
37530 | ||
37531 | IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN | |
37532 | LKNT=LKNT+1 | |
37533 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
37534 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3)*3D0 | |
37535 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37536 | IDLAM(LKNT,2)=2 | |
37537 | IDLAM(LKNT,3)=-2 | |
37538 | IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN | |
37539 | LKNT=LKNT+1 | |
37540 | XLAM(LKNT)=XLAM(LKNT-1) | |
37541 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37542 | IDLAM(LKNT,2)=4 | |
37543 | IDLAM(LKNT,3)=-4 | |
37544 | ENDIF | |
37545 | ENDIF | |
37546 | 200 CONTINUE | |
37547 | ENDIF | |
37548 | ||
37549 | C...CHI0_I -> CHI0_J + H0_K | |
37550 | EH(1)=SIN(ALFA) | |
37551 | EH(2)=COS(ALFA) | |
37552 | EH(3)=-SIN(BETA) | |
37553 | DH(1)=COS(ALFA) | |
37554 | DH(2)=-SIN(ALFA) | |
37555 | DH(3)=COS(BETA) | |
37556 | QIJ=ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,2))+ | |
37557 | & DCONJG(ZMIXC(IJ,3))*ZMIXC(IX,2)- | |
37558 | & TANW*(ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,1))+ | |
37559 | & DCONJG(ZMIXC(IJ,3))*ZMIXC(IX,1)) | |
37560 | RIJ=DCONJG(ZMIXC(IX,4))*ZMIXC(IJ,2)+ | |
37561 | & ZMIXC(IJ,4)*DCONJG(ZMIXC(IX,2))- | |
37562 | & TANW*(DCONJG(ZMIXC(IX,4))*ZMIXC(IJ,1)+ | |
37563 | & ZMIXC(IJ,4)*DCONJG(ZMIXC(IX,1))) | |
37564 | DO 210 IH=1,3 | |
37565 | XMH=PMAS(ITH(IH),1) | |
37566 | XMH2=XMH**2 | |
37567 | IF(AXMI.GE.AXMJ+XMH) THEN | |
37568 | LKNT=LKNT+1 | |
37569 | XL=PYLAMF(XMI2,XMJ2,XMH2) | |
37570 | F21K=0.5D0*(QIJ*EH(IH)+RIJ*DH(IH)) | |
37571 | F12K=F21K | |
37572 | C...SIGN OF MASSES I,J | |
37573 | XMK=XMJ | |
37574 | IF(IH.EQ.3) XMK=-XMK | |
37575 | GX2=ABS(F21K)**2+ABS(F12K)**2 | |
37576 | GLR=DBLE(F21K*DCONJG(F12K)) | |
37577 | XLAM(LKNT)=PYX2XH(C1,XMI,XMK,XMH,GX2,GLR) | |
37578 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
37579 | IDLAM(LKNT,2)=ITH(IH) | |
37580 | IDLAM(LKNT,3)=0 | |
37581 | ENDIF | |
37582 | 210 CONTINUE | |
37583 | 220 CONTINUE | |
37584 | ||
37585 | C...CHI0_I -> CHI+_J + W- | |
37586 | DO 260 IJ=1,2 | |
37587 | XMJ=SMW(IJ) | |
37588 | AXMJ=ABS(XMJ) | |
37589 | XMJ2=XMJ**2 | |
37590 | IF(AXMI.GE.AXMJ+XMW) THEN | |
37591 | LKNT=LKNT+1 | |
37592 | CXC(1)=(DCONJG(ZMIXC(IX,2))*VMIXC(IJ,1)- | |
37593 | & DCONJG(ZMIXC(IX,4))*VMIXC(IJ,2)/SR2) | |
37594 | CXC(3)=(ZMIXC(IX,2)*DCONJG(UMIXC(IJ,1))+ | |
37595 | & ZMIXC(IX,3)*DCONJG(UMIXC(IJ,2))/SR2) | |
37596 | GX2=ABS(CXC(1))**2+ABS(CXC(3))**2 | |
37597 | GLR=DBLE(CXC(1)*DCONJG(CXC(3))) | |
37598 | XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMW,GX2,GLR) | |
37599 | IDLAM(LKNT,1)=KFCCHI(IJ) | |
37600 | IDLAM(LKNT,2)=-24 | |
37601 | IDLAM(LKNT,3)=0 | |
37602 | LKNT=LKNT+1 | |
37603 | XLAM(LKNT)=XLAM(LKNT-1) | |
37604 | IDLAM(LKNT,1)=-KFCCHI(IJ) | |
37605 | IDLAM(LKNT,2)=24 | |
37606 | IDLAM(LKNT,3)=0 | |
37607 | ELSEIF(AXMI.GE.AXMJ) THEN | |
37608 | S12MIN=0D0 | |
37609 | S12MAX=(AXMI-AXMJ)**2 | |
37610 | RT2I = 1D0/SQRT(2D0) | |
37611 | CXC(1)=(DCONJG(ZMIXC(IX,2))*VMIXC(IJ,1)- | |
37612 | & DCONJG(ZMIXC(IX,4))*VMIXC(IJ,2)*RT2I)*RT2I | |
37613 | CXC(3)=(ZMIXC(IX,2)*DCONJG(UMIXC(IJ,1))+ | |
37614 | & ZMIXC(IX,3)*DCONJG(UMIXC(IJ,2))*RT2I)*RT2I | |
37615 | CXC(5)=DCMPLX(0D0,0D0) | |
37616 | CXC(7)=DCMPLX(0D0,0D0) | |
37617 | IA=11 | |
37618 | JA=12 | |
37619 | EI=KCHG(IA,1)/3D0 | |
37620 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
37621 | EJ=KCHG(JA,1)/3D0 | |
37622 | T3J=SIGN(1D0,EJ+1D-6)/2D0 | |
37623 | CXC(2)=VMIXC(IJ,1)*DCONJG(ZMIXC(IX,1)*(EJ-T3J)* | |
37624 | & TANW+ZMIXC(IX,2)*T3J)*RT2I | |
37625 | CXC(4)=-DCONJG(UMIXC(IJ,1))*( | |
37626 | & ZMIXC(IX,1)*(EI-T3I)*TANW+ZMIXC(IX,2)*T3I)*RT2I | |
37627 | CXC(6)=DCMPLX(0D0,0D0) | |
37628 | CXC(8)=DCMPLX(0D0,0D0) | |
37629 | XXC(1)=0D0 | |
37630 | XXC(2)=XMJ | |
37631 | XXC(3)=0D0 | |
37632 | XXC(4)=XMI | |
37633 | XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) | |
37634 | XXC(6)=PMAS(PYCOMP(KSUSY1+IA),1) | |
37635 | XXC(9)=PMAS(24,1) | |
37636 | XXC(10)=PMAS(24,2) | |
37637 | IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 230 | |
37638 | IF(XXC(5).LT.AXMI) THEN | |
37639 | XXC(5)=1D6 | |
37640 | ELSEIF(XXC(6).LT.AXMI) THEN | |
37641 | XXC(6)=1D6 | |
37642 | ENDIF | |
37643 | XXC(7)=XXC(6) | |
37644 | XXC(8)=XXC(5) | |
37645 | IF(AXMI.GE.AXMJ+PMAS(11,1)+PMAS(12,1)) THEN | |
37646 | LKNT=LKNT+1 | |
37647 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
37648 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
37649 | IDLAM(LKNT,1)=KFCCHI(IJ) | |
37650 | IDLAM(LKNT,2)=11 | |
37651 | IDLAM(LKNT,3)=-12 | |
37652 | LKNT=LKNT+1 | |
37653 | XLAM(LKNT)=XLAM(LKNT-1) | |
37654 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
37655 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
37656 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
37657 | IF(AXMI.GE.AXMJ+PMAS(13,1)+PMAS(14,1)) THEN | |
37658 | LKNT=LKNT+1 | |
37659 | XLAM(LKNT)=XLAM(LKNT-1) | |
37660 | IDLAM(LKNT,1)=KFCCHI(IJ) | |
37661 | IDLAM(LKNT,2)=13 | |
37662 | IDLAM(LKNT,3)=-14 | |
37663 | LKNT=LKNT+1 | |
37664 | XLAM(LKNT)=XLAM(LKNT-1) | |
37665 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
37666 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
37667 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
37668 | ENDIF | |
37669 | ENDIF | |
37670 | 230 CONTINUE | |
37671 | IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN | |
37672 | XXC(5)=PMAS(PYCOMP(KSUSY1+15),1) | |
37673 | XXC(6)=PMAS(PYCOMP(KSUSY1+16),1) | |
37674 | ELSE | |
37675 | XXC(5)=PMAS(PYCOMP(KSUSY2+15),1) | |
37676 | XXC(6)=PMAS(PYCOMP(KSUSY1+16),1) | |
37677 | ENDIF | |
37678 | IF(XXC(5).LT.AXMI) THEN | |
37679 | XXC(5)=1D6 | |
37680 | ENDIF | |
37681 | IF(XXC(6).LT.AXMI) THEN | |
37682 | XXC(6)=1D6 | |
37683 | ENDIF | |
37684 | XXC(7)=XXC(6) | |
37685 | XXC(8)=XXC(5) | |
37686 | IF(AXMI.GE.AXMJ+PMAS(15,1)+PMAS(16,1)) THEN | |
37687 | LKNT=LKNT+1 | |
37688 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
37689 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
37690 | XLAM(LKNT)=XLAM(LKNT-1) | |
37691 | IDLAM(LKNT,1)=KFCCHI(IJ) | |
37692 | IDLAM(LKNT,2)=15 | |
37693 | IDLAM(LKNT,3)=-16 | |
37694 | LKNT=LKNT+1 | |
37695 | XLAM(LKNT)=XLAM(LKNT-1) | |
37696 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
37697 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
37698 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
37699 | ENDIF | |
37700 | ||
37701 | C...NOW, DO THE QUARKS | |
37702 | 240 CONTINUE | |
37703 | IA=1 | |
37704 | JA=2 | |
37705 | EI=KCHG(IA,1)/3D0 | |
37706 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
37707 | EJ=KCHG(JA,1)/3D0 | |
37708 | T3J=SIGN(1D0,EJ+1D-6)/2D0 | |
37709 | CXC(2)=VMIXC(IJ,1)*DCONJG(ZMIXC(IX,1)*(EJ-T3J)* | |
37710 | & TANW+ZMIXC(IX,2)*T3J) | |
37711 | CXC(4)=-DCONJG(UMIXC(IJ,1))*( | |
37712 | & ZMIXC(IX,1)*(EI-T3I)*TANW+ZMIXC(IX,2)*T3I) | |
37713 | XXC(5)=PMAS(PYCOMP(KSUSY1+IA),1) | |
37714 | XXC(6)=PMAS(PYCOMP(KSUSY1+JA),1) | |
37715 | IF(XXC(5).LT.AXMI) THEN | |
37716 | XXC(5)=1D6 | |
37717 | ENDIF | |
37718 | IF(XXC(6).LT.AXMI) THEN | |
37719 | XXC(6)=1D6 | |
37720 | ENDIF | |
37721 | XXC(7)=XXC(6) | |
37722 | XXC(8)=XXC(5) | |
37723 | IF(AXMI.GE.AXMJ+PMAS(2,1)+PMAS(1,1)) THEN | |
37724 | LKNT=LKNT+1 | |
37725 | XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* | |
37726 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
37727 | IDLAM(LKNT,1)=KFCCHI(IJ) | |
37728 | IDLAM(LKNT,2)=1 | |
37729 | IDLAM(LKNT,3)=-2 | |
37730 | LKNT=LKNT+1 | |
37731 | XLAM(LKNT)=XLAM(LKNT-1) | |
37732 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
37733 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
37734 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
37735 | IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN | |
37736 | LKNT=LKNT+1 | |
37737 | XLAM(LKNT)=XLAM(LKNT-1) | |
37738 | IDLAM(LKNT,1)=KFCCHI(IJ) | |
37739 | IDLAM(LKNT,2)=3 | |
37740 | IDLAM(LKNT,3)=-4 | |
37741 | LKNT=LKNT+1 | |
37742 | XLAM(LKNT)=XLAM(LKNT-1) | |
37743 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
37744 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
37745 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
37746 | ENDIF | |
37747 | ENDIF | |
37748 | 250 CONTINUE | |
37749 | ENDIF | |
37750 | 260 CONTINUE | |
37751 | 270 CONTINUE | |
37752 | ||
37753 | C...CHI0_I -> CHI+_I + H- | |
37754 | DO 280 IJ=1,2 | |
37755 | XMJ=SMW(IJ) | |
37756 | AXMJ=ABS(XMJ) | |
37757 | XMJ2=XMJ**2 | |
37758 | XMHP=PMAS(ITHC,1) | |
37759 | IF(AXMI.GE.AXMJ+XMHP) THEN | |
37760 | LKNT=LKNT+1 | |
37761 | OLPP=CBETA*(ZMIXC(IX,4)*DCONJG(VMIXC(IJ,1))+(ZMIXC(IX,2)+ | |
37762 | & ZMIXC(IX,1)*TANW)*DCONJG(VMIXC(IJ,2))/SR2) | |
37763 | ORPP=SBETA*(DCONJG(ZMIXC(IX,3))*UMIXC(IJ,1)- | |
37764 | & (DCONJG(ZMIXC(IX,2))+DCONJG(ZMIXC(IX,1))*TANW)* | |
37765 | & UMIXC(IJ,2)/SR2) | |
37766 | GX2=ABS(OLPP)**2+ABS(ORPP)**2 | |
37767 | GLR=DBLE(OLPP*DCONJG(ORPP)) | |
37768 | XLAM(LKNT)=PYX2XH(C1,XMI,XMJ,XMHP,GX2,GLR) | |
37769 | IDLAM(LKNT,1)=KFCCHI(IJ) | |
37770 | IDLAM(LKNT,2)=-ITHC | |
37771 | IDLAM(LKNT,3)=0 | |
37772 | LKNT=LKNT+1 | |
37773 | XLAM(LKNT)=XLAM(LKNT-1) | |
37774 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
37775 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
37776 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
37777 | ELSE | |
37778 | ||
37779 | ENDIF | |
37780 | 280 CONTINUE | |
37781 | ||
37782 | C...2-BODY DECAYS TO FERMION SFERMION | |
37783 | DO 290 J=1,16 | |
37784 | IF(J.GE.7.AND.J.LE.10) GOTO 290 | |
37785 | KF1=KSUSY1+J | |
37786 | KF2=KSUSY2+J | |
37787 | XMSF1=PMAS(PYCOMP(KF1),1) | |
37788 | XMSF2=PMAS(PYCOMP(KF2),1) | |
37789 | XMF=PMAS(J,1) | |
37790 | IF(J.LE.6) THEN | |
37791 | FCOL=3D0 | |
37792 | ELSE | |
37793 | FCOL=1D0 | |
37794 | ENDIF | |
37795 | ||
37796 | EI=KCHG(J,1)/3D0 | |
37797 | T3T=SIGN(1D0,EI) | |
37798 | IF(J.EQ.12.OR.J.EQ.14.OR.J.EQ.16) T3T=1D0 | |
37799 | IF(MOD(J,2).EQ.0) THEN | |
37800 | CBL=T3T*ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI-T3T) | |
37801 | CAL=XMF*ZMIXC(IX,4)/XMW/SBETA | |
37802 | CAR=-2D0*EI*TANW*ZMIXC(IX,1) | |
37803 | CBR=CAL | |
37804 | ELSE | |
37805 | CBL=T3T*ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI-T3T) | |
37806 | CAL=XMF*ZMIXC(IX,3)/XMW/CBETA | |
37807 | CAR=-2D0*EI*TANW*ZMIXC(IX,1) | |
37808 | CBR=CAL | |
37809 | ENDIF | |
37810 | ||
37811 | C...D~ D_L | |
37812 | IF(AXMI.GE.XMF+XMSF1) THEN | |
37813 | LKNT=LKNT+1 | |
37814 | XMA2=XMSF1**2 | |
37815 | XMB2=XMF**2 | |
37816 | XL=PYLAMF(XMI2,XMA2,XMB2) | |
37817 | CA=CAL*SFMIX(J,1)+CAR*SFMIX(J,2) | |
37818 | CB=CBL*SFMIX(J,1)+CBR*SFMIX(J,2) | |
37819 | XLAM(LKNT)=0.5D0*FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* | |
37820 | & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) | |
37821 | IDLAM(LKNT,1)=KF1 | |
37822 | IDLAM(LKNT,2)=-J | |
37823 | IDLAM(LKNT,3)=0 | |
37824 | LKNT=LKNT+1 | |
37825 | XLAM(LKNT)=XLAM(LKNT-1) | |
37826 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
37827 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
37828 | IDLAM(LKNT,3)=0 | |
37829 | ENDIF | |
37830 | ||
37831 | C...D~ D_R | |
37832 | IF(AXMI.GE.XMF+XMSF2) THEN | |
37833 | LKNT=LKNT+1 | |
37834 | XMA2=XMSF2**2 | |
37835 | XMB2=XMF**2 | |
37836 | CA=CAL*SFMIX(J,3)+CAR*SFMIX(J,4) | |
37837 | CB=CBL*SFMIX(J,3)+CBR*SFMIX(J,4) | |
37838 | XL=PYLAMF(XMI2,XMA2,XMB2) | |
37839 | XLAM(LKNT)=0.5D0*FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* | |
37840 | & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) | |
37841 | IDLAM(LKNT,1)=KF2 | |
37842 | IDLAM(LKNT,2)=-J | |
37843 | IDLAM(LKNT,3)=0 | |
37844 | LKNT=LKNT+1 | |
37845 | XLAM(LKNT)=XLAM(LKNT-1) | |
37846 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
37847 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
37848 | IDLAM(LKNT,3)=0 | |
37849 | ENDIF | |
37850 | 290 CONTINUE | |
37851 | 300 CONTINUE | |
37852 | C...3-BODY DECAY TO Q Q~ GLUINO | |
37853 | XMJ=PMAS(PYCOMP(KSUSY1+21),1) | |
37854 | IF(AXMI.GE.XMJ) THEN | |
37855 | RT2I = 1D0/SQRT(2D0) | |
37856 | OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32)))*RT2I | |
37857 | ORPP=DCONJG(OLPP) | |
37858 | AXMJ=ABS(XMJ) | |
37859 | XXC(1)=0D0 | |
37860 | XXC(2)=XMJ | |
37861 | XXC(3)=0D0 | |
37862 | XXC(4)=XMI | |
37863 | FID=1 | |
37864 | XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) | |
37865 | XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) | |
37866 | IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 310 | |
37867 | XXC(7)=XXC(5) | |
37868 | XXC(8)=XXC(6) | |
37869 | XXC(9)=1D6 | |
37870 | XXC(10)=0D0 | |
37871 | EI=KCHG(FID,1)/3D0 | |
37872 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
37873 | GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP | |
37874 | GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP | |
37875 | CXC(1)=0D0 | |
37876 | CXC(2)=-GLIJ | |
37877 | CXC(3)=0D0 | |
37878 | CXC(4)=DCONJG(GLIJ) | |
37879 | CXC(5)=0D0 | |
37880 | CXC(6)=GRIJ | |
37881 | CXC(7)=0D0 | |
37882 | CXC(8)=-DCONJG(GRIJ) | |
37883 | S12MIN=0D0 | |
37884 | S12MAX=(AXMI-AXMJ)**2 | |
37885 | C...ALL QUARKS BUT T | |
37886 | IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN | |
37887 | LKNT=LKNT+1 | |
37888 | XLAM(LKNT)=4D0*C1*AS/XMI3/(16D0*PI)* | |
37889 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) | |
37890 | IDLAM(LKNT,1)=KSUSY1+21 | |
37891 | IDLAM(LKNT,2)=1 | |
37892 | IDLAM(LKNT,3)=-1 | |
37893 | IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN | |
37894 | LKNT=LKNT+1 | |
37895 | XLAM(LKNT)=XLAM(LKNT-1) | |
37896 | IDLAM(LKNT,1)=KSUSY1+21 | |
37897 | IDLAM(LKNT,2)=3 | |
37898 | IDLAM(LKNT,3)=-3 | |
37899 | ENDIF | |
37900 | ENDIF | |
37901 | 310 CONTINUE | |
37902 | IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN | |
37903 | XXC(5)=PMAS(PYCOMP(KSUSY1+5),1) | |
37904 | XXC(6)=PMAS(PYCOMP(KSUSY2+5),1) | |
37905 | ELSE | |
37906 | XXC(6)=PMAS(PYCOMP(KSUSY1+5),1) | |
37907 | XXC(5)=PMAS(PYCOMP(KSUSY2+5),1) | |
37908 | ENDIF | |
37909 | IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 320 | |
37910 | XXC(7)=XXC(5) | |
37911 | XXC(8)=XXC(6) | |
37912 | IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN | |
37913 | LKNT=LKNT+1 | |
37914 | XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)* | |
37915 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) | |
37916 | IDLAM(LKNT,1)=KSUSY1+21 | |
37917 | IDLAM(LKNT,2)=5 | |
37918 | IDLAM(LKNT,3)=-5 | |
37919 | ENDIF | |
37920 | C...U-TYPE QUARKS | |
37921 | 320 CONTINUE | |
37922 | FID=2 | |
37923 | XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) | |
37924 | XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) | |
37925 | IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 330 | |
37926 | XXC(7)=XXC(5) | |
37927 | XXC(8)=XXC(6) | |
37928 | EI=KCHG(FID,1)/3D0 | |
37929 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
37930 | GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP | |
37931 | GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP | |
37932 | CXC(2)=-GLIJ | |
37933 | CXC(4)=DCONJG(GLIJ) | |
37934 | CXC(6)=GRIJ | |
37935 | CXC(8)=-DCONJG(GRIJ) | |
37936 | IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN | |
37937 | LKNT=LKNT+1 | |
37938 | XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)* | |
37939 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) | |
37940 | IDLAM(LKNT,1)=KSUSY1+21 | |
37941 | IDLAM(LKNT,2)=2 | |
37942 | IDLAM(LKNT,3)=-2 | |
37943 | IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN | |
37944 | LKNT=LKNT+1 | |
37945 | XLAM(LKNT)=XLAM(LKNT-1) | |
37946 | IDLAM(LKNT,1)=KSUSY1+21 | |
37947 | IDLAM(LKNT,2)=4 | |
37948 | IDLAM(LKNT,3)=-4 | |
37949 | ENDIF | |
37950 | ENDIF | |
37951 | 330 CONTINUE | |
37952 | ENDIF | |
37953 | ||
37954 | C...R-violating decay modes (SKANDS). | |
37955 | CALL PYRVNE(KFIN,XLAM,IDLAM,LKNT) | |
37956 | ||
37957 | 340 IKNT=LKNT | |
37958 | XLAM(0)=0D0 | |
37959 | DO 350 I=1,IKNT | |
37960 | IF(XLAM(I).LT.0D0) XLAM(I)=0D0 | |
37961 | XLAM(0)=XLAM(0)+XLAM(I) | |
37962 | 350 CONTINUE | |
37963 | IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6 | |
37964 | ||
37965 | RETURN | |
37966 | END | |
37967 | ||
37968 | C********************************************************************* | |
37969 | ||
37970 | C...PYCJDC | |
37971 | C...Calculate decay widths for the charginos (admixtures of | |
37972 | C...charged Wino and charged Higgsino. | |
37973 | ||
37974 | C...Input: KCIN = KF code for particle | |
37975 | C...Output: XLAM = widths | |
37976 | C... IDLAM = KF codes for decay particles | |
37977 | C... IKNT = number of decay channels defined | |
37978 | C...AUTHOR: STEPHEN MRENNA | |
37979 | C...Last change: | |
37980 | C...10-16-95: force decay chi^+_1 -> chi^0_1 e+ nu_e | |
37981 | C...when CHIENU .NE. 0 | |
37982 | ||
37983 | SUBROUTINE PYCJDC(KFIN,XLAM,IDLAM,IKNT) | |
37984 | ||
37985 | C...Double precision and integer declarations. | |
37986 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
37987 | IMPLICIT INTEGER(I-N) | |
37988 | INTEGER PYK,PYCHGE,PYCOMP | |
37989 | C...Parameter statement to help give large particle numbers. | |
37990 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
37991 | &KEXCIT=4000000,KDIMEN=5000000) | |
37992 | C...Commonblocks. | |
37993 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
37994 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
37995 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
37996 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
37997 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
37998 | CC &SFMIX(16,4), | |
37999 | C COMMON/PYINTS/XXM(20) | |
38000 | COMPLEX*16 CXC | |
38001 | COMMON/PYINTC/XXC(10),CXC(8) | |
38002 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTC/ | |
38003 | ||
38004 | C...Local variables | |
38005 | COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP | |
38006 | COMPLEX*16 CAL,CBL,CAR,CBR,CA,CB | |
38007 | INTEGER KFIN,KCIN | |
38008 | DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2, | |
38009 | &XMZ,XMZ2,AXMJ,AXMI | |
38010 | DOUBLE PRECISION S12MIN,S12MAX | |
38011 | DOUBLE PRECISION XMI2,XMI3,XMJ2,XMH,XMH2,XMHP,XMA2,XMB2,XMK | |
38012 | DOUBLE PRECISION PYLAMF,XL | |
38013 | DOUBLE PRECISION TANW,XW,AEM,C1,AS,EI,T3I,BETA,ALFA | |
38014 | DOUBLE PRECISION PYX2XH,PYX2XG | |
38015 | DOUBLE PRECISION XLAM(0:400) | |
38016 | INTEGER IDLAM(400,3) | |
38017 | INTEGER LKNT,IX,IH,J,IJ,I,IKNT | |
38018 | INTEGER ITH(3) | |
38019 | INTEGER ITHC | |
38020 | DOUBLE PRECISION ETAH(3),DH(3),EH(3) | |
38021 | DOUBLE PRECISION SR2 | |
38022 | DOUBLE PRECISION CBETA,SBETA,TANB | |
38023 | ||
38024 | DOUBLE PRECISION PYALEM,PI,PYALPS | |
38025 | DOUBLE PRECISION FCOL | |
38026 | INTEGER KF1,KF2,ISF | |
38027 | INTEGER KFNCHI(4),KFCCHI(2) | |
38028 | ||
38029 | DOUBLE PRECISION TEMP | |
38030 | EXTERNAL PYGAUS,PYXXZ6 | |
38031 | DOUBLE PRECISION PYGAUS,PYXXZ6 | |
38032 | DOUBLE PRECISION PREC | |
38033 | DATA ITH/25,35,36/ | |
38034 | DATA ITHC/37/ | |
38035 | DATA ETAH/1D0,1D0,-1D0/ | |
38036 | DATA SR2/1.4142136D0/ | |
38037 | DATA PI/3.141592654D0/ | |
38038 | DATA PREC/1D-2/ | |
38039 | DATA KFNCHI/1000022,1000023,1000025,1000035/ | |
38040 | DATA KFCCHI/1000024,1000037/ | |
38041 | ||
38042 | C...COUNT THE NUMBER OF DECAY MODES | |
38043 | LKNT=0 | |
38044 | XMW=PMAS(24,1) | |
38045 | XMW2=XMW**2 | |
38046 | XMZ=PMAS(23,1) | |
38047 | XMZ2=XMZ**2 | |
38048 | XW=1D0-XMW2/XMZ2 | |
38049 | XW1=1D0-XW | |
38050 | TANW = SQRT(XW/XW1) | |
38051 | ||
38052 | C...1 OR 2 DEPENDING ON CHARGINO TYPE | |
38053 | IX=1 | |
38054 | IF(KFIN.EQ.KFCCHI(2)) IX=2 | |
38055 | KCIN=PYCOMP(KFIN) | |
38056 | ||
38057 | XMI=SMW(IX) | |
38058 | XMI2=XMI**2 | |
38059 | AXMI=ABS(XMI) | |
38060 | AEM=PYALEM(XMI2) | |
38061 | AS =PYALPS(XMI2) | |
38062 | C1=AEM/XW | |
38063 | XMI3=ABS(XMI**3) | |
38064 | TANB=RMSS(5) | |
38065 | BETA=ATAN(TANB) | |
38066 | CBETA=COS(BETA) | |
38067 | SBETA=TANB*CBETA | |
38068 | ALFA=RMSS(18) | |
38069 | ||
38070 | DO 110 I=1,2 | |
38071 | DO 100 J=1,2 | |
38072 | VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) | |
38073 | UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) | |
38074 | 100 CONTINUE | |
38075 | 110 CONTINUE | |
38076 | ||
38077 | C...GRAVITINO DECAY MODES | |
38078 | ||
38079 | IF(IMSS(11).EQ.1) THEN | |
38080 | XMP=RMSS(29) | |
38081 | IDG=39+KSUSY1 | |
38082 | XMGR=PMAS(PYCOMP(IDG),1) | |
38083 | C SINW=SQRT(XW) | |
38084 | C COSW=SQRT(1D0-XW) | |
38085 | XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI | |
38086 | IF(AXMI.GT.XMGR+XMW) THEN | |
38087 | LKNT=LKNT+1 | |
38088 | IDLAM(LKNT,1)=IDG | |
38089 | IDLAM(LKNT,2)=24 | |
38090 | IDLAM(LKNT,3)=0 | |
38091 | XLAM(LKNT)=XFAC*( | |
38092 | & .5D0*(ABS(VMIXC(IX,1))**2+ABS(UMIXC(IX,1))**2)+ | |
38093 | & .5D0*((ABS(VMIXC(IX,2))*SBETA)**2+(ABS(UMIXC(IX,2))*CBETA)**2))* | |
38094 | & (1D0-XMW2/XMI2)**4 | |
38095 | ENDIF | |
38096 | IF(AXMI.GT.XMGR+PMAS(37,1)) THEN | |
38097 | LKNT=LKNT+1 | |
38098 | IDLAM(LKNT,1)=IDG | |
38099 | IDLAM(LKNT,2)=37 | |
38100 | IDLAM(LKNT,3)=0 | |
38101 | XLAM(LKNT)=XFAC*(.5D0*((ABS(VMIXC(IX,2))*CBETA)**2+ | |
38102 | & (ABS(UMIXC(IX,2))*SBETA)**2)) | |
38103 | & *(1D0-PMAS(37,1)**2/XMI2)**4 | |
38104 | ENDIF | |
38105 | ENDIF | |
38106 | ||
38107 | C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS | |
38108 | IF(IX.EQ.1) GOTO 170 | |
38109 | XMJ=SMW(1) | |
38110 | AXMJ=ABS(XMJ) | |
38111 | XMJ2=XMJ**2 | |
38112 | ||
38113 | C...CHI_2+ -> CHI_1+ + Z0 | |
38114 | IF(AXMI.GE.AXMJ+XMZ) THEN | |
38115 | LKNT=LKNT+1 | |
38116 | IJ=1 | |
38117 | OLPP=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))- | |
38118 | & VMIXC(IJ,2)*DCONJG(VMIXC(IX,2))/2D0 | |
38119 | ORPP=-UMIXC(IX,1)*DCONJG(UMIXC(IJ,1))- | |
38120 | & UMIXC(IX,2)*DCONJG(UMIXC(IJ,2))/2D0 | |
38121 | GX2=ABS(OLPP)**2+ABS(ORPP)**2 | |
38122 | GLR=DBLE(OLPP*DCONJG(ORPP)) | |
38123 | XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMZ,GX2,GLR) | |
38124 | IDLAM(LKNT,1)=KFCCHI(1) | |
38125 | IDLAM(LKNT,2)=23 | |
38126 | IDLAM(LKNT,3)=0 | |
38127 | ||
38128 | C...CHARGED LEPTONS | |
38129 | ELSEIF(AXMI.GE.AXMJ) THEN | |
38130 | S12MIN=0D0 | |
38131 | S12MAX=(AXMI-AXMJ)**2 | |
38132 | IA=11 | |
38133 | JA=12 | |
38134 | EI=KCHG(IABS(IA),1)/3D0 | |
38135 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
38136 | XXC(1)=0D0 | |
38137 | XXC(2)=XMJ | |
38138 | XXC(3)=0D0 | |
38139 | XXC(4)=XMI | |
38140 | XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) | |
38141 | XXC(6)=1D6 | |
38142 | XXC(9)=PMAS(23,1) | |
38143 | XXC(10)=PMAS(23,2) | |
38144 | IJ=1 | |
38145 | OLPP=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))- | |
38146 | & VMIXC(IJ,2)*DCONJG(VMIXC(IX,2))/2D0 | |
38147 | ORPP=-UMIXC(IX,1)*DCONJG(UMIXC(IJ,1))- | |
38148 | & UMIXC(IX,2)*DCONJG(UMIXC(IJ,2))/2D0 | |
38149 | CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP | |
38150 | CXC(2)=DCMPLX(0D0,0D0) | |
38151 | CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP | |
38152 | CXC(4)=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))*DCMPLX(T3I/XW) | |
38153 | CXC(5)=-DCMPLX(EI/XW1)*ORPP | |
38154 | CXC(6)=DCMPLX(0D0,0D0) | |
38155 | CXC(7)=-DCMPLX(EI/XW1)*OLPP | |
38156 | CXC(8)=DCMPLX(0D0,0D0) | |
38157 | IF( XXC(5).LT.AXMI ) THEN | |
38158 | XXC(5)=1D6 | |
38159 | ENDIF | |
38160 | XXC(7)=XXC(5) | |
38161 | XXC(8)=XXC(6) | |
38162 | IF(AXMI.GE.AXMJ+2D0*PMAS(11,1)) THEN | |
38163 | LKNT=LKNT+1 | |
38164 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
38165 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38166 | IDLAM(LKNT,1)=KFCCHI(1) | |
38167 | IDLAM(LKNT,2)=11 | |
38168 | IDLAM(LKNT,3)=-11 | |
38169 | IF(AXMI.GE.AXMJ+2D0*PMAS(13,1)) THEN | |
38170 | LKNT=LKNT+1 | |
38171 | XLAM(LKNT)=XLAM(LKNT-1) | |
38172 | IDLAM(LKNT,1)=KFCCHI(1) | |
38173 | IDLAM(LKNT,2)=13 | |
38174 | IDLAM(LKNT,3)=-13 | |
38175 | ENDIF | |
38176 | IF(AXMI.GE.AXMJ+2D0*PMAS(15,1)) THEN | |
38177 | LKNT=LKNT+1 | |
38178 | XLAM(LKNT)=XLAM(LKNT-1) | |
38179 | IDLAM(LKNT,1)=KFCCHI(1) | |
38180 | IDLAM(LKNT,2)=15 | |
38181 | IDLAM(LKNT,3)=-15 | |
38182 | ENDIF | |
38183 | ENDIF | |
38184 | ||
38185 | C...NEUTRINOS | |
38186 | 120 CONTINUE | |
38187 | IA=12 | |
38188 | JA=11 | |
38189 | EI=KCHG(IABS(IA),1)/3D0 | |
38190 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
38191 | XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) | |
38192 | XXC(6)=1D6 | |
38193 | CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP | |
38194 | CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP | |
38195 | CXC(4)=-UMIXC(IJ,1)*DCONJG(UMIXC(IX,1))*DCMPLX(T3I/XW) | |
38196 | CXC(5)=-DCMPLX(EI/XW1)*ORPP | |
38197 | CXC(7)=-DCMPLX(EI/XW1)*OLPP | |
38198 | IF( XXC(5).LT.AXMI ) THEN | |
38199 | XXC(5)=1D6 | |
38200 | ENDIF | |
38201 | XXC(7)=XXC(5) | |
38202 | XXC(8)=XXC(6) | |
38203 | IF(AXMI.GE.AXMJ+2D0*PMAS(12,1)) THEN | |
38204 | LKNT=LKNT+1 | |
38205 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
38206 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38207 | IDLAM(LKNT,1)=KFCCHI(1) | |
38208 | IDLAM(LKNT,2)=12 | |
38209 | IDLAM(LKNT,3)=-12 | |
38210 | LKNT=LKNT+1 | |
38211 | XLAM(LKNT)=XLAM(LKNT-1) | |
38212 | IDLAM(LKNT,1)=KFCCHI(1) | |
38213 | IDLAM(LKNT,2)=14 | |
38214 | IDLAM(LKNT,3)=-14 | |
38215 | ENDIF | |
38216 | IF(AXMI.GE.AXMJ+2D0*PMAS(16,1)) THEN | |
38217 | IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN | |
38218 | XXC(5)=PMAS(PYCOMP(KSUSY1+15),1) | |
38219 | ELSE | |
38220 | XXC(5)=PMAS(PYCOMP(KSUSY2+15),1) | |
38221 | ENDIF | |
38222 | IF( XXC(5).LT.AXMI ) THEN | |
38223 | XXC(5)=1D6 | |
38224 | ENDIF | |
38225 | XXC(7)=XXC(5) | |
38226 | LKNT=LKNT+1 | |
38227 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* | |
38228 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38229 | IDLAM(LKNT,1)=KFCCHI(1) | |
38230 | IDLAM(LKNT,2)=16 | |
38231 | IDLAM(LKNT,3)=-16 | |
38232 | ENDIF | |
38233 | ||
38234 | C...D-TYPE QUARKS | |
38235 | 130 CONTINUE | |
38236 | IA=1 | |
38237 | JA=2 | |
38238 | EI=KCHG(IABS(IA),1)/3D0 | |
38239 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
38240 | XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) | |
38241 | XXC(6)=1D6 | |
38242 | CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP | |
38243 | CXC(2)=DCMPLX(0D0,0D0) | |
38244 | CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP | |
38245 | CXC(4)=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))*DCMPLX(T3I/XW) | |
38246 | CXC(5)=-DCMPLX(EI/XW1)*ORPP | |
38247 | CXC(6)=DCMPLX(0D0,0D0) | |
38248 | CXC(7)=-DCMPLX(EI/XW1)*OLPP | |
38249 | CXC(8)=DCMPLX(0D0,0D0) | |
38250 | IF( XXC(5).LT.AXMI ) THEN | |
38251 | XXC(5)=1D6 | |
38252 | ENDIF | |
38253 | XXC(7)=XXC(5) | |
38254 | XXC(8)=XXC(6) | |
38255 | IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN | |
38256 | LKNT=LKNT+1 | |
38257 | XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* | |
38258 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38259 | IDLAM(LKNT,1)=KFCCHI(1) | |
38260 | IDLAM(LKNT,2)=1 | |
38261 | IDLAM(LKNT,3)=-1 | |
38262 | IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN | |
38263 | LKNT=LKNT+1 | |
38264 | XLAM(LKNT)=XLAM(LKNT-1) | |
38265 | IDLAM(LKNT,1)=KFCCHI(1) | |
38266 | IDLAM(LKNT,2)=3 | |
38267 | IDLAM(LKNT,3)=-3 | |
38268 | ENDIF | |
38269 | ENDIF | |
38270 | IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN | |
38271 | IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN | |
38272 | XXC(5)=PMAS(PYCOMP(KSUSY1+5),1) | |
38273 | ELSE | |
38274 | XXC(5)=PMAS(PYCOMP(KSUSY2+5),1) | |
38275 | ENDIF | |
38276 | IF( XXC(5).LT.AXMI ) THEN | |
38277 | XXC(5)=1D6 | |
38278 | ENDIF | |
38279 | XXC(7)=XXC(5) | |
38280 | LKNT=LKNT+1 | |
38281 | XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* | |
38282 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38283 | IDLAM(LKNT,1)=KFCCHI(1) | |
38284 | IDLAM(LKNT,2)=5 | |
38285 | IDLAM(LKNT,3)=-5 | |
38286 | ENDIF | |
38287 | ||
38288 | C...U-TYPE QUARKS | |
38289 | 140 CONTINUE | |
38290 | IA=2 | |
38291 | JA=1 | |
38292 | EI=KCHG(IABS(IA),1)/3D0 | |
38293 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
38294 | XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) | |
38295 | XXC(6)=1D6 | |
38296 | CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP | |
38297 | CXC(2)=DCMPLX(0D0,0D0) | |
38298 | CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP | |
38299 | CXC(4)=-UMIXC(IJ,1)*DCONJG(UMIXC(IX,1))*DCMPLX(T3I/XW) | |
38300 | CXC(5)=-DCMPLX(EI/XW1)*ORPP | |
38301 | CXC(6)=DCMPLX(0D0,0D0) | |
38302 | CXC(7)=-DCMPLX(EI/XW1)*OLPP | |
38303 | CXC(8)=DCMPLX(0D0,0D0) | |
38304 | IF( XXC(5).LT.AXMI ) THEN | |
38305 | XXC(5)=1D6 | |
38306 | ENDIF | |
38307 | XXC(7)=XXC(5) | |
38308 | XXC(8)=XXC(6) | |
38309 | IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN | |
38310 | LKNT=LKNT+1 | |
38311 | XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* | |
38312 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38313 | IDLAM(LKNT,1)=KFCCHI(1) | |
38314 | IDLAM(LKNT,2)=2 | |
38315 | IDLAM(LKNT,3)=-2 | |
38316 | IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN | |
38317 | LKNT=LKNT+1 | |
38318 | XLAM(LKNT)=XLAM(LKNT-1) | |
38319 | IDLAM(LKNT,1)=KFCCHI(1) | |
38320 | IDLAM(LKNT,2)=4 | |
38321 | IDLAM(LKNT,3)=-4 | |
38322 | ENDIF | |
38323 | ENDIF | |
38324 | 150 CONTINUE | |
38325 | ENDIF | |
38326 | ||
38327 | C...CHI_2+ -> CHI_1+ + H0_K | |
38328 | EH(2)=COS(ALFA) | |
38329 | EH(1)=SIN(ALFA) | |
38330 | EH(3)=-SBETA | |
38331 | DH(2)=-SIN(ALFA) | |
38332 | DH(1)=COS(ALFA) | |
38333 | DH(3)=COS(BETA) | |
38334 | DO 160 IH=1,3 | |
38335 | XMH=PMAS(ITH(IH),1) | |
38336 | XMH2=XMH**2 | |
38337 | C...NO 3-BODY OPTION | |
38338 | IF(AXMI.GE.AXMJ+XMH) THEN | |
38339 | LKNT=LKNT+1 | |
38340 | XL=PYLAMF(XMI2,XMJ2,XMH2) | |
38341 | OLPP=(VMIXC(2,1)*DCONJG(UMIXC(1,2))*EH(IH) - | |
38342 | & VMIXC(2,2)*DCONJG(UMIXC(1,1))*DH(IH))/SR2 | |
38343 | ORPP=(DCONJG(VMIXC(1,1))*UMIXC(2,2)*EH(IH) - | |
38344 | & DCONJG(VMIXC(1,2))*UMIXC(2,1)*DH(IH))/SR2 | |
38345 | XMK=XMJ*ETAH(IH) | |
38346 | GX2=ABS(OLPP)**2+ABS(ORPP)**2 | |
38347 | GLR=DBLE(OLPP*DCONJG(ORPP)) | |
38348 | XLAM(LKNT)=PYX2XH(C1,XMI,XMK,XMH,GX2,GLR) | |
38349 | IDLAM(LKNT,1)=KFCCHI(1) | |
38350 | IDLAM(LKNT,2)=ITH(IH) | |
38351 | IDLAM(LKNT,3)=0 | |
38352 | ENDIF | |
38353 | 160 CONTINUE | |
38354 | ||
38355 | C...CHI1 JUMPS TO HERE | |
38356 | 170 CONTINUE | |
38357 | ||
38358 | C...CHI+_I -> CHI0_J + W+ | |
38359 | DO 220 IJ=1,4 | |
38360 | XMJ=SMZ(IJ) | |
38361 | AXMJ=ABS(XMJ) | |
38362 | XMJ2=XMJ**2 | |
38363 | IF(AXMI.GE.AXMJ+XMW) THEN | |
38364 | LKNT=LKNT+1 | |
38365 | DO 180 I=1,4 | |
38366 | ZMIXC(IJ,I)=DCMPLX(ZMIX(IJ,I),ZMIXI(IJ,I)) | |
38367 | 180 CONTINUE | |
38368 | CXC(1)=(DCONJG(ZMIXC(IJ,2))*VMIXC(IX,1)- | |
38369 | & DCONJG(ZMIXC(IJ,4))*VMIXC(IX,2)/SR2) | |
38370 | CXC(3)=(ZMIXC(IJ,2)*DCONJG(UMIXC(IX,1))+ | |
38371 | & ZMIXC(IJ,3)*DCONJG(UMIXC(IX,2))/SR2) | |
38372 | GX2=ABS(CXC(1))**2+ABS(CXC(3))**2 | |
38373 | GLR=DBLE(CXC(1)*DCONJG(CXC(3))) | |
38374 | XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMW,GX2,GLR) | |
38375 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
38376 | IDLAM(LKNT,2)=24 | |
38377 | IDLAM(LKNT,3)=0 | |
38378 | C...LEPTONS | |
38379 | ELSEIF(AXMI.GE.AXMJ) THEN | |
38380 | S12MIN=0D0 | |
38381 | S12MAX=(AXMI-AXMJ)**2 | |
38382 | DO 190 I=1,4 | |
38383 | ZMIXC(IJ,I)=DCMPLX(ZMIX(IJ,I),ZMIXI(IJ,I)) | |
38384 | 190 CONTINUE | |
38385 | CXC(1)=(DCONJG(ZMIXC(IJ,2))*VMIXC(IX,1)- | |
38386 | & DCONJG(ZMIXC(IJ,4))*VMIXC(IX,2)/SR2)/SR2 | |
38387 | CXC(3)=(ZMIXC(IJ,2)*DCONJG(UMIXC(IX,1))+ | |
38388 | & ZMIXC(IJ,3)*DCONJG(UMIXC(IX,2))/SR2)/SR2 | |
38389 | CXC(5)=DCMPLX(0D0,0D0) | |
38390 | CXC(7)=DCMPLX(0D0,0D0) | |
38391 | IA=11 | |
38392 | JA=12 | |
38393 | EI=KCHG(IA,1)/3D0 | |
38394 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
38395 | EJ=KCHG(JA,1)/3D0 | |
38396 | T3J=SIGN(1D0,EJ+1D-6)/2D0 | |
38397 | CXC(2)=VMIXC(IX,1)*DCONJG(ZMIXC(IJ,1)*(EJ-T3J)* | |
38398 | & TANW+ZMIXC(IJ,2)*T3J)/SR2 | |
38399 | CXC(4)=-DCONJG(UMIXC(IX,1))*( | |
38400 | & ZMIXC(IJ,1)*(EI-T3I)*TANW+ZMIXC(IJ,2)*T3I)/SR2 | |
38401 | CXC(6)=DCMPLX(0D0,0D0) | |
38402 | CXC(8)=DCMPLX(0D0,0D0) | |
38403 | XXC(1)=0D0 | |
38404 | XXC(2)=XMJ | |
38405 | XXC(3)=0D0 | |
38406 | XXC(4)=XMI | |
38407 | XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) | |
38408 | XXC(6)=PMAS(PYCOMP(KSUSY1+IA),1) | |
38409 | XXC(9)=PMAS(24,1) | |
38410 | XXC(10)=PMAS(24,2) | |
38411 | CCC IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 190 | |
38412 | IF(XXC(5).LT.AXMI) THEN | |
38413 | XXC(5)=1D6 | |
38414 | ELSEIF(XXC(6).LT.AXMI) THEN | |
38415 | XXC(6)=1D6 | |
38416 | ENDIF | |
38417 | XXC(7)=XXC(6) | |
38418 | XXC(8)=XXC(5) | |
38419 | C...1/(2PI)**3*/(32*M**3)*G^4, G^2/(4*PI)= AEM/XW, | |
38420 | C...--> 1/(16PI)/M**3*(AEM/XW)**2 | |
38421 | IF(AXMI.GE.AXMJ+PMAS(11,1)+PMAS(12,1)) THEN | |
38422 | LKNT=LKNT+1 | |
38423 | TEMP=PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38424 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*TEMP | |
38425 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
38426 | IDLAM(LKNT,2)=-11 | |
38427 | IDLAM(LKNT,3)=12 | |
38428 | C...ONLY DECAY CHI+1 -> E+ NU_E | |
38429 | IF( IMSS(12).NE. 0 ) GOTO 260 | |
38430 | IF(AXMI.GE.AXMJ+PMAS(13,1)+PMAS(14,1)) THEN | |
38431 | LKNT=LKNT+1 | |
38432 | XLAM(LKNT)=XLAM(LKNT-1) | |
38433 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
38434 | IDLAM(LKNT,2)=-13 | |
38435 | IDLAM(LKNT,3)=14 | |
38436 | ENDIF | |
38437 | ENDIF | |
38438 | IF(AXMI.GE.AXMJ+PMAS(15,1)+PMAS(16,1)) THEN | |
38439 | LKNT=LKNT+1 | |
38440 | IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN | |
38441 | XXC(6)=PMAS(PYCOMP(KSUSY1+15),1) | |
38442 | ELSE | |
38443 | XXC(6)=PMAS(PYCOMP(KSUSY2+15),1) | |
38444 | ENDIF | |
38445 | XXC(5)=PMAS(PYCOMP(KSUSY1+16),1) | |
38446 | IF(XXC(5).LT.AXMI) THEN | |
38447 | XXC(5)=1D6 | |
38448 | ELSEIF(XXC(6).LT.AXMI) THEN | |
38449 | XXC(6)=1D6 | |
38450 | ENDIF | |
38451 | XXC(7)=XXC(6) | |
38452 | XXC(8)=XXC(5) | |
38453 | TEMP=PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38454 | XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*TEMP | |
38455 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
38456 | IDLAM(LKNT,2)=-15 | |
38457 | IDLAM(LKNT,3)=16 | |
38458 | ENDIF | |
38459 | ||
38460 | C...NOW, DO THE QUARKS | |
38461 | 200 CONTINUE | |
38462 | IA=1 | |
38463 | JA=2 | |
38464 | EI=KCHG(IA,1)/3D0 | |
38465 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
38466 | EJ=KCHG(JA,1)/3D0 | |
38467 | T3J=SIGN(1D0,EJ+1D-6)/2D0 | |
38468 | CXC(2)=VMIXC(IJ,1)*DCONJG(ZMIXC(IX,1)*(EJ-T3J)* | |
38469 | & TANW+ZMIXC(IX,2)*T3J) | |
38470 | CXC(4)=-DCONJG(UMIXC(IJ,1))*( | |
38471 | & ZMIXC(IX,1)*(EI-T3I)*TANW+ZMIXC(IX,2)*T3I) | |
38472 | XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) | |
38473 | XXC(6)=PMAS(PYCOMP(KSUSY1+IA),1) | |
38474 | IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 210 | |
38475 | IF(XXC(5).LT.AXMI) THEN | |
38476 | XXC(5)=1D6 | |
38477 | ENDIF | |
38478 | IF(XXC(6).LT.AXMI) THEN | |
38479 | XXC(6)=1D6 | |
38480 | ENDIF | |
38481 | XXC(7)=XXC(6) | |
38482 | XXC(8)=XXC(5) | |
38483 | IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN | |
38484 | LKNT=LKNT+1 | |
38485 | XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* | |
38486 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38487 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
38488 | IDLAM(LKNT,2)=-1 | |
38489 | IDLAM(LKNT,3)=2 | |
38490 | IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN | |
38491 | LKNT=LKNT+1 | |
38492 | XLAM(LKNT)=XLAM(LKNT-1) | |
38493 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
38494 | IDLAM(LKNT,2)=-3 | |
38495 | IDLAM(LKNT,3)=4 | |
38496 | ENDIF | |
38497 | ENDIF | |
38498 | 210 CONTINUE | |
38499 | ENDIF | |
38500 | 220 CONTINUE | |
38501 | ||
38502 | C...CHI+_I -> CHI0_J + H+ | |
38503 | DO 230 IJ=1,4 | |
38504 | XMJ=SMZ(IJ) | |
38505 | AXMJ=ABS(XMJ) | |
38506 | XMJ2=XMJ**2 | |
38507 | XMHP=PMAS(ITHC,1) | |
38508 | IF(AXMI.GE.AXMJ+XMHP) THEN | |
38509 | LKNT=LKNT+1 | |
38510 | OLPP=CBETA*(ZMIXC(IJ,4)*DCONJG(VMIXC(IX,1))+(ZMIXC(IJ,2)+ | |
38511 | & ZMIXC(IJ,1)*TANW)*DCONJG(VMIXC(IX,2))/SR2) | |
38512 | ORPP=SBETA*(DCONJG(ZMIXC(IJ,3))*UMIXC(IX,1)- | |
38513 | & (DCONJG(ZMIXC(IJ,2))+DCONJG(ZMIXC(IJ,1))*TANW)* | |
38514 | & UMIXC(IX,2)/SR2) | |
38515 | GX2=ABS(OLPP)**2+ABS(ORPP)**2 | |
38516 | GLR=DBLE(OLPP*DCONJG(ORPP)) | |
38517 | XLAM(LKNT)=PYX2XH(C1,XMI,XMJ,XMHP,GX2,GLR) | |
38518 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
38519 | IDLAM(LKNT,2)=ITHC | |
38520 | IDLAM(LKNT,3)=0 | |
38521 | ELSE | |
38522 | ||
38523 | ENDIF | |
38524 | 230 CONTINUE | |
38525 | ||
38526 | C...2-BODY DECAYS TO FERMION SFERMION | |
38527 | DO 240 J=1,16 | |
38528 | IF(J.GE.7.AND.J.LE.10) GOTO 240 | |
38529 | IF(MOD(J,2).EQ.0) THEN | |
38530 | KF1=KSUSY1+J-1 | |
38531 | ELSE | |
38532 | KF1=KSUSY1+J+1 | |
38533 | ENDIF | |
38534 | KF2=KF1+KSUSY1 | |
38535 | XMSF1=PMAS(PYCOMP(KF1),1) | |
38536 | XMSF2=PMAS(PYCOMP(KF2),1) | |
38537 | XMF=PMAS(J,1) | |
38538 | IF(J.LE.6) THEN | |
38539 | FCOL=3D0 | |
38540 | ELSE | |
38541 | FCOL=1D0 | |
38542 | ENDIF | |
38543 | ||
38544 | C...U~ D_L | |
38545 | IF(MOD(J,2).EQ.0) THEN | |
38546 | XMFP=PMAS(J-1,1) | |
38547 | CAL=UMIXC(IX,1) | |
38548 | CBL=-XMF*VMIXC(IX,2)/XMW/SBETA/SR2 | |
38549 | CAR=-XMFP*UMIXC(IX,2)/XMW/CBETA/SR2 | |
38550 | CBR=0D0 | |
38551 | ISF=J-1 | |
38552 | ELSE | |
38553 | XMFP=PMAS(J+1,1) | |
38554 | CAL=VMIXC(IX,1) | |
38555 | CBL=-XMF*UMIXC(IX,2)/XMW/CBETA/SR2 | |
38556 | CBR=0D0 | |
38557 | CAR=-XMFP*VMIXC(IX,2)/XMW/SBETA/SR2 | |
38558 | ISF=J+1 | |
38559 | ENDIF | |
38560 | ||
38561 | C...~U_L D | |
38562 | IF(AXMI.GE.XMF+XMSF1) THEN | |
38563 | LKNT=LKNT+1 | |
38564 | XMA2=XMSF1**2 | |
38565 | XMB2=XMF**2 | |
38566 | XL=PYLAMF(XMI2,XMA2,XMB2) | |
38567 | CA=CAL*SFMIX(ISF,1)+CAR*SFMIX(ISF,2) | |
38568 | CB=CBL*SFMIX(ISF,1)+CBR*SFMIX(ISF,2) | |
38569 | XLAM(LKNT)=FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* | |
38570 | & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) | |
38571 | IDLAM(LKNT,3)=0 | |
38572 | IF(MOD(J,2).EQ.0) THEN | |
38573 | IDLAM(LKNT,1)=-KF1 | |
38574 | IDLAM(LKNT,2)=J | |
38575 | ELSE | |
38576 | IDLAM(LKNT,1)=KF1 | |
38577 | IDLAM(LKNT,2)=-J | |
38578 | ENDIF | |
38579 | ENDIF | |
38580 | ||
38581 | C...U~ D_R | |
38582 | IF(AXMI.GE.XMF+XMSF2) THEN | |
38583 | LKNT=LKNT+1 | |
38584 | XMA2=XMSF2**2 | |
38585 | XMB2=XMF**2 | |
38586 | CA=CAL*SFMIX(ISF,3)+CAR*SFMIX(ISF,4) | |
38587 | CB=CBL*SFMIX(ISF,3)+CBR*SFMIX(ISF,4) | |
38588 | XL=PYLAMF(XMI2,XMA2,XMB2) | |
38589 | XLAM(LKNT)=FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* | |
38590 | & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) | |
38591 | IDLAM(LKNT,3)=0 | |
38592 | IF(MOD(J,2).EQ.0) THEN | |
38593 | IDLAM(LKNT,1)=-KF2 | |
38594 | IDLAM(LKNT,2)=J | |
38595 | ELSE | |
38596 | IDLAM(LKNT,1)=KF2 | |
38597 | IDLAM(LKNT,2)=-J | |
38598 | ENDIF | |
38599 | ENDIF | |
38600 | 240 CONTINUE | |
38601 | ||
38602 | C...3-BODY DECAY TO Q Q~' GLUINO, ONLY IF IT CANNOT PROCEED THROUGH | |
38603 | C...A 2-BODY -- 2-BODY CHAIN | |
38604 | XMJ=PMAS(PYCOMP(KSUSY1+21),1) | |
38605 | IF(AXMI.GE.XMJ) THEN | |
38606 | AXMJ=ABS(XMJ) | |
38607 | S12MIN=0D0 | |
38608 | S12MAX=(AXMI-AXMJ)**2 | |
38609 | XXC(1)=0D0 | |
38610 | XXC(2)=XMJ | |
38611 | XXC(3)=0D0 | |
38612 | XXC(4)=XMI | |
38613 | XXC(5)=PMAS(PYCOMP(KSUSY1+1),1) | |
38614 | XXC(6)=PMAS(PYCOMP(KSUSY1+2),1) | |
38615 | XXC(9)=1D6 | |
38616 | XXC(10)=0D0 | |
38617 | OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32))) | |
38618 | ORPP=DCONJG(OLPP) | |
38619 | CXC(1)=DCMPLX(0D0,0D0) | |
38620 | CXC(3)=DCMPLX(0D0,0D0) | |
38621 | CXC(5)=DCMPLX(0D0,0D0) | |
38622 | CXC(7)=DCMPLX(0D0,0D0) | |
38623 | CXC(2)=UMIXC(IX,1)*OLPP/SR2 | |
38624 | CXC(4)=-DCONJG(VMIXC(IX,1))*ORPP/SR2 | |
38625 | CXC(6)=DCMPLX(0D0,0D0) | |
38626 | CXC(8)=DCMPLX(0D0,0D0) | |
38627 | IF(XXC(5).LT.AXMI) THEN | |
38628 | XXC(5)=1D6 | |
38629 | ELSEIF(XXC(6).LT.AXMI) THEN | |
38630 | XXC(6)=1D6 | |
38631 | ENDIF | |
38632 | XXC(7)=XXC(6) | |
38633 | XXC(8)=XXC(5) | |
38634 | IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 250 | |
38635 | IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN | |
38636 | LKNT=LKNT+1 | |
38637 | XLAM(LKNT)=4D0*C1*AS/XMI3/(16D0*PI)* | |
38638 | & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) | |
38639 | IDLAM(LKNT,1)=KSUSY1+21 | |
38640 | IDLAM(LKNT,2)=-1 | |
38641 | IDLAM(LKNT,3)=2 | |
38642 | IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN | |
38643 | LKNT=LKNT+1 | |
38644 | XLAM(LKNT)=XLAM(LKNT-1) | |
38645 | IDLAM(LKNT,1)=KSUSY1+21 | |
38646 | IDLAM(LKNT,2)=-3 | |
38647 | IDLAM(LKNT,3)=4 | |
38648 | ENDIF | |
38649 | ENDIF | |
38650 | 250 CONTINUE | |
38651 | ENDIF | |
38652 | ||
38653 | C...R-violating decay modes (SKANDS). | |
38654 | CALL PYRVCH(KFIN,XLAM,IDLAM,LKNT) | |
38655 | ||
38656 | 260 IKNT=LKNT | |
38657 | XLAM(0)=0D0 | |
38658 | DO 270 I=1,IKNT | |
38659 | XLAM(0)=XLAM(0)+XLAM(I) | |
38660 | IF(XLAM(I).LT.0D0) THEN | |
38661 | WRITE(MSTU(11),*) ' XLAM(I) = ',XLAM(I),KCIN, | |
38662 | & (IDLAM(I,J),J=1,3) | |
38663 | XLAM(I)=0D0 | |
38664 | ENDIF | |
38665 | 270 CONTINUE | |
38666 | IF(XLAM(0).EQ.0D0) THEN | |
38667 | XLAM(0)=1D-6 | |
38668 | WRITE(MSTU(11),*) ' XLAM(0) = ',XLAM(0) | |
38669 | WRITE(MSTU(11),*) LKNT | |
38670 | WRITE(MSTU(11),*) (XLAM(J),J=1,LKNT) | |
38671 | ENDIF | |
38672 | ||
38673 | RETURN | |
38674 | END | |
38675 | ||
38676 | C********************************************************************* | |
38677 | ||
38678 | C...PYXXZ6 | |
38679 | C...Used in the calculation of inoi -> inoj + f + ~f. | |
38680 | ||
38681 | FUNCTION PYXXZ6(X) | |
38682 | ||
38683 | C...Double precision and integer declarations. | |
38684 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
38685 | IMPLICIT INTEGER(I-N) | |
38686 | INTEGER PYK,PYCHGE,PYCOMP | |
38687 | C...Parameter statement to help give large particle numbers. | |
38688 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
38689 | &KEXCIT=4000000,KDIMEN=5000000) | |
38690 | C...Commonblocks. | |
38691 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
38692 | C COMMON/PYINTS/XXM(20) | |
38693 | COMPLEX*16 CXC | |
38694 | COMMON/PYINTC/XXC(10),CXC(8) | |
38695 | SAVE /PYDAT1/,/PYINTC/ | |
38696 | ||
38697 | C...Local variables. | |
38698 | COMPLEX*16 QLLS,QRRS,QRLS,QLRS,QLLU,QRRU,QLRT,QRLT | |
38699 | DOUBLE PRECISION PYXXZ6,X | |
38700 | DOUBLE PRECISION XM12,XM22,XM32,S,S13,WPROP2 | |
38701 | DOUBLE PRECISION WW,WF1,WF2,WFL1,WFL2 | |
38702 | DOUBLE PRECISION SIJ | |
38703 | DOUBLE PRECISION XMV,XMG,XMSU1,XMSU2,XMSD1,XMSD2 | |
38704 | DOUBLE PRECISION OL2 | |
38705 | DOUBLE PRECISION S23MIN,S23MAX,S23AVE,S23DEL | |
38706 | INTEGER I | |
38707 | ||
38708 | C...Statement functions. | |
38709 | C...Integral from x to y of (t-a)(b-t) dt. | |
38710 | TINT(X,Y,A,B)=(X-Y)*(-(X**2+X*Y+Y**2)/3D0+(B+A)*(X+Y)/2D0-A*B) | |
38711 | C...Integral from x to y of (t-a)(b-t)/(t-c) dt. | |
38712 | TINT2(X,Y,A,B,C)=(X-Y)*(-0.5D0*(X+Y)+(B+A-C))- | |
38713 | &LOG(ABS((X-C)/(Y-C)))*(C-B)*(C-A) | |
38714 | C...Integral from x to y of (t-a)(b-t)/(t-c)**2 dt. | |
38715 | TINT3(X,Y,A,B,C)=-(X-Y)+(C-A)*(C-B)*(Y-X)/(X-C)/(Y-C)+ | |
38716 | &(B+A-2D0*C)*LOG(ABS((X-C)/(Y-C))) | |
38717 | C...Integral from x to y of (t-a)/(b-t) dt. | |
38718 | UTINT(X,Y,A,B)=LOG(ABS((X-A)/(B-X)*(B-Y)/(Y-A)))/(B-A) | |
38719 | C...Integral from x to y of 1/(t-a) dt. | |
38720 | TPROP(X,Y,A)=LOG(ABS((X-A)/(Y-A))) | |
38721 | ||
38722 | XM12=XXC(1)**2 | |
38723 | XM22=XXC(2)**2 | |
38724 | XM32=XXC(3)**2 | |
38725 | S=XXC(4)**2 | |
38726 | S13=X | |
38727 | ||
38728 | S23AVE=XM22+XM32-0.5D0/X*(X+XM32-XM12)*(X+XM22-S) | |
38729 | S23DEL=0.5D0/X*SQRT( ( (X-XM12-XM32)**2-4D0*XM12*XM32)* | |
38730 | &( (X-XM22-S)**2 -4D0*XM22*S ) ) | |
38731 | ||
38732 | S23MIN=(S23AVE-S23DEL) | |
38733 | S23MAX=(S23AVE+S23DEL) | |
38734 | ||
38735 | XMSD1=XXC(5)**2 | |
38736 | XMSD2=XXC(7)**2 | |
38737 | XMSU1=XXC(6)**2 | |
38738 | XMSU2=XXC(8)**2 | |
38739 | ||
38740 | XMV=XXC(9) | |
38741 | XMG=XXC(10) | |
38742 | QLLS=CXC(1) | |
38743 | QLLU=CXC(2) | |
38744 | QLRS=CXC(3) | |
38745 | QLRT=CXC(4) | |
38746 | QRLS=CXC(5) | |
38747 | QRLT=CXC(6) | |
38748 | QRRS=CXC(7) | |
38749 | QRRU=CXC(8) | |
38750 | WPROP2=(S13-XMV**2)**2+(XMV*XMG)**2 | |
38751 | SIJ=2D0*XXC(2)*XXC(4)*S13 | |
38752 | IF(XMV.LE.1000D0) THEN | |
38753 | OL2=ABS(QLLS)**2+ABS(QRRS)**2+ABS(QLRS)**2+ABS(QRLS)**2 | |
38754 | OLR=-2D0*DBLE(QLRS*DCONJG(QLLS)+QRLS*DCONJG(QRRS)) | |
38755 | WW=(OL2*2D0*TINT(S23MAX,S23MIN,XM22,S) | |
38756 | & +OLR*SIJ*(S23MAX-S23MIN))/WPROP2 | |
38757 | IF(XXC(5).LE.10000D0) THEN | |
38758 | WFL1=4D0*(DBLE(QLLS*DCONJG(QLLU))* | |
38759 | & TINT2(S23MAX,S23MIN,XM22,S,XMSD1)- | |
38760 | & .5D0*DBLE(QLLS*DCONJG(QLRT))*SIJ*TPROP(S23MAX,S23MIN,XMSD2)+ | |
38761 | & DBLE(QLRS*DCONJG(QLRT))*TINT2(S23MAX,S23MIN,XM22,S,XMSD2)- | |
38762 | & .5D0*DBLE(QLRS*DCONJG(QLLU))*SIJ*TPROP(S23MAX,S23MIN,XMSD1)) | |
38763 | & *(S13-XMV**2)/WPROP2 | |
38764 | ELSE | |
38765 | WFL1=0D0 | |
38766 | ENDIF | |
38767 | ||
38768 | IF(XXC(6).LE.10000D0) THEN | |
38769 | WFL2=4D0*(DBLE(QRRS*DCONJG(QRRU))* | |
38770 | & TINT2(S23MAX,S23MIN,XM22,S,XMSU1)- | |
38771 | & .5D0*DBLE(QRRS*DCONJG(QRLT))*SIJ*TPROP(S23MAX,S23MIN,XMSU2)+ | |
38772 | & DBLE(QRLS*DCONJG(QRLT))*TINT2(S23MAX,S23MIN,XM22,S,XMSU2)- | |
38773 | & .5D0*DBLE(QRLS*DCONJG(QRRU))*SIJ*TPROP(S23MAX,S23MIN,XMSU1)) | |
38774 | & *(S13-XMV**2)/WPROP2 | |
38775 | ELSE | |
38776 | WFL2=0D0 | |
38777 | ENDIF | |
38778 | ELSE | |
38779 | WW=0D0 | |
38780 | WFL1=0D0 | |
38781 | WFL2=0D0 | |
38782 | ENDIF | |
38783 | IF(XXC(5).LE.10000D0) THEN | |
38784 | WF1=2D0*ABS(QLLU)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSD1) | |
38785 | & +2D0*ABS(QLRT)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSD2) | |
38786 | & - 2D0*DBLE(QLRT*DCONJG(QLLU))* | |
38787 | & SIJ*UTINT(S23MAX,S23MIN,XMSD1,XM22+S-S13-XMSD2) | |
38788 | ELSE | |
38789 | WF1=0D0 | |
38790 | ENDIF | |
38791 | IF(XXC(6).LE.10000D0) THEN | |
38792 | WF2=2D0*ABS(QRRU)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSU1) | |
38793 | & +2D0*ABS(QRLT)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSU2) | |
38794 | & - 2D0*DBLE(QRLT*DCONJG(QRRU))* | |
38795 | & SIJ*UTINT(S23MAX,S23MIN,XMSU1,XM22+S-S13-XMSU2) | |
38796 | ELSE | |
38797 | WF2=0D0 | |
38798 | ENDIF | |
38799 | ||
38800 | PYXXZ6=(WW+WF1+WF2+WFL1+WFL2) | |
38801 | ||
38802 | IF(PYXXZ6.LT.0D0) THEN | |
38803 | WRITE(MSTU(11),*) ' NEGATIVE WT IN PYXXZ6 ' | |
38804 | WRITE(MSTU(11),*) XXc(1),XXc(2),XXc(3),XXc(4) | |
38805 | WRITE(MSTU(11),*) (XXc(I),I=5,8) | |
38806 | WRITE(MSTU(11),*) (XXc(I),I=9,12) | |
38807 | WRITE(MSTU(11),*) (XXc(I),I=13,16) | |
38808 | WRITE(MSTU(11),*) WW,WF1,WF2,WFL1,WFL2 | |
38809 | WRITE(MSTU(11),*) S23MIN,S23MAX | |
38810 | PYXXZ6=0D0 | |
38811 | ENDIF | |
38812 | ||
38813 | RETURN | |
38814 | END | |
38815 | ||
38816 | ||
38817 | C********************************************************************* | |
38818 | ||
38819 | C...PYXXGA | |
38820 | C...Calculates chi0_i -> chi0_j + gamma. | |
38821 | ||
38822 | FUNCTION PYXXGA(C0,XM1,XM2,XMTR,XMTL) | |
38823 | ||
38824 | C...Double precision and integer declarations. | |
38825 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
38826 | IMPLICIT INTEGER(I-N) | |
38827 | INTEGER PYK,PYCHGE,PYCOMP | |
38828 | ||
38829 | C...Local variables. | |
38830 | DOUBLE PRECISION PYXXGA,C0,XM1,XM2,XMTR,XMTL | |
38831 | DOUBLE PRECISION F1,F2 | |
38832 | ||
38833 | F1=(1D0+XMTR/(1D0-XMTR)*LOG(XMTR))/(1D0-XMTR) | |
38834 | F2=(1D0+XMTL/(1D0-XMTL)*LOG(XMTL))/(1D0-XMTL) | |
38835 | PYXXGA=C0*((XM1**2-XM2**2)/XM1)**3 | |
38836 | PYXXGA=PYXXGA*(2D0/3D0*(F1+F2)-13D0/12D0)**2 | |
38837 | ||
38838 | RETURN | |
38839 | END | |
38840 | ||
38841 | C********************************************************************* | |
38842 | ||
38843 | C...PYX2XG | |
38844 | C...Calculates the decay rate for ino -> ino + gauge boson. | |
38845 | ||
38846 | FUNCTION PYX2XG(C1,XM1,XM2,XM3,GX2,GLR) | |
38847 | ||
38848 | C...Double precision and integer declarations. | |
38849 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
38850 | IMPLICIT INTEGER(I-N) | |
38851 | INTEGER PYK,PYCHGE,PYCOMP | |
38852 | ||
38853 | C...Local variables. | |
38854 | DOUBLE PRECISION PYX2XG,XM1,XM2,XM3,GX2,GLR | |
38855 | DOUBLE PRECISION XL,PYLAMF,C1 | |
38856 | DOUBLE PRECISION XMI2,XMJ2,XMV2,XMI3 | |
38857 | ||
38858 | XMI2=XM1**2 | |
38859 | XMI3=ABS(XM1**3) | |
38860 | XMJ2=XM2**2 | |
38861 | XMV2=XM3**2 | |
38862 | XL=PYLAMF(XMI2,XMJ2,XMV2) | |
38863 | PYX2XG=C1/8D0/XMI3*SQRT(XL) | |
38864 | &*(GX2*(XL+3D0*XMV2*(XMI2+XMJ2-XMV2))- | |
38865 | &12D0*GLR*XM1*XM2*XMV2) | |
38866 | ||
38867 | RETURN | |
38868 | END | |
38869 | ||
38870 | C********************************************************************* | |
38871 | ||
38872 | C...PYX2XH | |
38873 | C...Calculates the decay rate for ino -> ino + H. | |
38874 | ||
38875 | FUNCTION PYX2XH(C1,XM1,XM2,XM3,GX2,GLR) | |
38876 | ||
38877 | C...Double precision and integer declarations. | |
38878 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
38879 | IMPLICIT INTEGER(I-N) | |
38880 | INTEGER PYK,PYCHGE,PYCOMP | |
38881 | ||
38882 | C...Local variables. | |
38883 | DOUBLE PRECISION PYX2XH,XM1,XM2,XM3 | |
38884 | DOUBLE PRECISION XL,PYLAMF,C1 | |
38885 | DOUBLE PRECISION XMI2,XMJ2,XMV2,XMI3 | |
38886 | ||
38887 | XMI2=XM1**2 | |
38888 | XMI3=ABS(XM1**3) | |
38889 | XMJ2=XM2**2 | |
38890 | XMV2=XM3**2 | |
38891 | XL=PYLAMF(XMI2,XMJ2,XMV2) | |
38892 | PYX2XH=C1/8D0/XMI3*SQRT(XL) | |
38893 | &*(GX2*(XMI2+XMJ2-XMV2)+ | |
38894 | &4D0*GLR*XM1*XM2) | |
38895 | ||
38896 | RETURN | |
38897 | END | |
38898 | ||
38899 | C********************************************************************* | |
38900 | ||
38901 | C...PYHEXT | |
38902 | C...Calculates the non-standard decay modes of the Higgs boson. | |
38903 | C... | |
38904 | C...Author: Stephen Mrenna | |
38905 | C...Last Update: April 2001 | |
38906 | C......Allow complex values for Z,U, and V | |
38907 | ||
38908 | SUBROUTINE PYHEXT(KFIN,XLAM,IDLAM,IKNT) | |
38909 | ||
38910 | C...Double precision and integer declarations. | |
38911 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
38912 | IMPLICIT INTEGER(I-N) | |
38913 | INTEGER PYK,PYCHGE,PYCOMP | |
38914 | C...Parameter statement to help give large particle numbers. | |
38915 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
38916 | &KEXCIT=4000000,KDIMEN=5000000) | |
38917 | C...Commonblocks. | |
38918 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
38919 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
38920 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
38921 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
38922 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
38923 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
38924 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYMSSM/,/PYSSMT/ | |
38925 | ||
38926 | C...Local variables. | |
38927 | COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP | |
38928 | COMPLEX*16 QIJ,RIJ,F21K,F12K | |
38929 | INTEGER KFIN | |
38930 | DOUBLE PRECISION XMI,XMJ,XMF,XMW,XMW2,XMZ,AXMJ,AXMI | |
38931 | DOUBLE PRECISION XMI2,XMI3,XMJ2 | |
38932 | DOUBLE PRECISION PYLAMF,XL,CF,EI | |
38933 | INTEGER IDU,IFL | |
38934 | DOUBLE PRECISION TANW,XW,AEM,C1,AS | |
38935 | DOUBLE PRECISION PYH2XX,GHLL,GHRR,GHLR | |
38936 | DOUBLE PRECISION XLAM(0:400) | |
38937 | INTEGER IDLAM(400,3) | |
38938 | INTEGER LKNT,IH,J,IJ,I,IKNT,IK | |
38939 | INTEGER ITH(4) | |
38940 | INTEGER KFNCHI(4),KFCCHI(2) | |
38941 | DOUBLE PRECISION ETAH(3),CH(3),DH(3),EH(3) | |
38942 | DOUBLE PRECISION SR2 | |
38943 | DOUBLE PRECISION BETA,ALFA | |
38944 | DOUBLE PRECISION CBETA,SBETA,GR,GL,TANB | |
38945 | DOUBLE PRECISION PYALEM | |
38946 | DOUBLE PRECISION AL,AR,ALR | |
38947 | DOUBLE PRECISION XMK,AXMK,COSA,SINA,CW,XML | |
38948 | DOUBLE PRECISION XMUZ,ATRIT,ATRIB,ATRIL | |
38949 | DOUBLE PRECISION XMJL,XMJR,XM1,XM2 | |
38950 | DATA ITH/25,35,36,37/ | |
38951 | DATA ETAH/1D0,1D0,-1D0/ | |
38952 | DATA SR2/1.4142136D0/ | |
38953 | DATA KFNCHI/1000022,1000023,1000025,1000035/ | |
38954 | DATA KFCCHI/1000024,1000037/ | |
38955 | ||
38956 | C...COUNT THE NUMBER OF DECAY MODES | |
38957 | LKNT=IKNT | |
38958 | ||
38959 | XMW=PMAS(24,1) | |
38960 | XMW2=XMW**2 | |
38961 | XMZ=PMAS(23,1) | |
38962 | XW=PARU(102) | |
38963 | TANW = SQRT(XW/(1D0-XW)) | |
38964 | CW=SQRT(1D0-XW) | |
38965 | ||
38966 | C...1 - 4 DEPENDING ON Higgs species. | |
38967 | IH=1 | |
38968 | IF(KFIN.EQ.ITH(2)) IH=2 | |
38969 | IF(KFIN.EQ.ITH(3)) IH=3 | |
38970 | IF(KFIN.EQ.ITH(4)) IH=4 | |
38971 | ||
38972 | XMI=PMAS(KFIN,1) | |
38973 | XMI2=XMI**2 | |
38974 | AXMI=ABS(XMI) | |
38975 | AEM=PYALEM(XMI2) | |
38976 | C1=AEM/XW | |
38977 | XMI3=ABS(XMI**3) | |
38978 | ||
38979 | TANB=RMSS(5) | |
38980 | BETA=ATAN(TANB) | |
38981 | CBETA=COS(BETA) | |
38982 | SBETA=TANB*CBETA | |
38983 | ALFA=RMSS(18) | |
38984 | COSA=COS(ALFA) | |
38985 | SINA=SIN(ALFA) | |
38986 | ATRIT=RMSS(16) | |
38987 | ATRIB=RMSS(15) | |
38988 | ATRIL=RMSS(17) | |
38989 | XMUZ=-RMSS(4) | |
38990 | ||
38991 | DO 110 I=1,4 | |
38992 | DO 100 J=1,4 | |
38993 | ZMIXC(J,I)=DCMPLX(ZMIX(J,I),ZMIXI(J,I)) | |
38994 | 100 CONTINUE | |
38995 | 110 CONTINUE | |
38996 | DO 130 I=1,2 | |
38997 | DO 120 J=1,2 | |
38998 | VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) | |
38999 | UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) | |
39000 | 120 CONTINUE | |
39001 | 130 CONTINUE | |
39002 | ||
39003 | ||
39004 | IF(IH.EQ.4) GOTO 220 | |
39005 | ||
39006 | C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS | |
39007 | C...H0_K -> CHI0_I + CHI0_J | |
39008 | EH(2)=SINA | |
39009 | EH(1)=COSA | |
39010 | EH(3)=CBETA | |
39011 | DH(2)=COSA | |
39012 | DH(1)=-SINA | |
39013 | DH(3)=SBETA | |
39014 | DO 150 IJ=1,4 | |
39015 | XMJ=SMZ(IJ) | |
39016 | AXMJ=ABS(XMJ) | |
39017 | DO 140 IK=1,IJ | |
39018 | XMK=SMZ(IK) | |
39019 | AXMK=ABS(XMK) | |
39020 | IF(AXMI.GE.AXMJ+AXMK) THEN | |
39021 | LKNT=LKNT+1 | |
39022 | QIJ=ZMIXC(IK,3)*ZMIXC(IJ,2)+ | |
39023 | & ZMIXC(IJ,3)*ZMIXC(IK,2)- | |
39024 | & TANW*(ZMIXC(IK,3)*ZMIXC(IJ,1)+ | |
39025 | & ZMIXC(IJ,3)*ZMIXC(IK,1)) | |
39026 | RIJ=ZMIXC(IK,4)*ZMIXC(IJ,2)+ | |
39027 | & ZMIXC(IJ,4)*ZMIXC(IK,2)- | |
39028 | & TANW*(ZMIXC(IK,4)*ZMIXC(IJ,1)+ | |
39029 | & ZMIXC(IJ,4)*ZMIXC(IK,1)) | |
39030 | F21K=0.5D0*DCONJG(QIJ*DH(IH)-RIJ*EH(IH)) | |
39031 | F12K=0.5D0*(QIJ*DH(IH)-RIJ*EH(IH)) | |
39032 | C...SIGN OF MASSES I,J | |
39033 | XML=XMK*ETAH(IH) | |
39034 | GX2=ABS(F12K)**2+ABS(F21K)**2 | |
39035 | GLR=DBLE(F12K*DCONJG(F21K)) | |
39036 | XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,XML,GX2,GLR) | |
39037 | IF(IJ.EQ.IK) XLAM(LKNT)=XLAM(LKNT)*0.5D0 | |
39038 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
39039 | IDLAM(LKNT,2)=KFNCHI(IK) | |
39040 | IDLAM(LKNT,3)=0 | |
39041 | ENDIF | |
39042 | 140 CONTINUE | |
39043 | 150 CONTINUE | |
39044 | ||
39045 | C...H0_K -> CHI+_I CHI-_J | |
39046 | DO 170 IJ=1,2 | |
39047 | XMJ=SMW(IJ) | |
39048 | AXMJ=ABS(XMJ) | |
39049 | DO 160 IK=1,2 | |
39050 | XMK=SMW(IK) | |
39051 | AXMK=ABS(XMK) | |
39052 | IF(AXMI.GE.AXMJ+AXMK) THEN | |
39053 | LKNT=LKNT+1 | |
39054 | OLPP=DCONJG(VMIXC(IJ,1)*UMIXC(IK,2)*DH(IH) + | |
39055 | & VMIXC(IJ,2)*UMIXC(IK,1)*EH(IH))/SR2 | |
39056 | ORPP=(VMIXC(IK,1)*UMIXC(IJ,2)*DH(IH) + | |
39057 | & VMIXC(IK,2)*UMIXC(IJ,1)*EH(IH))/SR2 | |
39058 | GX2=ABS(OLPP)**2+ABS(ORPP)**2 | |
39059 | GLR=DBLE(OLPP*DCONJG(ORPP)) | |
39060 | XML=XMK*ETAH(IH) | |
39061 | XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,XML,GX2,GLR) | |
39062 | IDLAM(LKNT,1)=KFCCHI(IJ) | |
39063 | IDLAM(LKNT,2)=-KFCCHI(IK) | |
39064 | IDLAM(LKNT,3)=0 | |
39065 | ENDIF | |
39066 | 160 CONTINUE | |
39067 | 170 CONTINUE | |
39068 | ||
39069 | C...HIGGS TO SFERMION SFERMION | |
39070 | DO 200 IFL=1,16 | |
39071 | IF(IFL.GE.7.AND.IFL.LE.10) GOTO 200 | |
39072 | IJ=KSUSY1+IFL | |
39073 | XMJL=PMAS(PYCOMP(IJ),1) | |
39074 | XMJR=PMAS(PYCOMP(IJ+KSUSY1),1) | |
39075 | IF(AXMI.GE.2D0*MIN(XMJL,XMJR)) THEN | |
39076 | XMJ=XMJL | |
39077 | XMJ2=XMJ**2 | |
39078 | XL=PYLAMF(XMI2,XMJ2,XMJ2) | |
39079 | XMF=PMAS(IFL,1) | |
39080 | EI=KCHG(IFL,1)/3D0 | |
39081 | IDU=2-MOD(IFL,2) | |
39082 | ||
39083 | IF(IH.EQ.1) THEN | |
39084 | IF(IDU.EQ.1) THEN | |
39085 | GHLL=-XMZ/CW*(0.5D0+EI*XW)*SIN(ALFA+BETA)+ | |
39086 | & XMF**2/XMW*SINA/CBETA | |
39087 | GHRR=XMZ/CW*(EI*XW)*SIN(ALFA+BETA)+ | |
39088 | & XMF**2/XMW*SINA/CBETA | |
39089 | IF(IFL.EQ.5) THEN | |
39090 | GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*COSA- | |
39091 | & ATRIB*SINA) | |
39092 | ELSEIF(IFL.EQ.15) THEN | |
39093 | GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*COSA- | |
39094 | & ATRIL*SINA) | |
39095 | ELSE | |
39096 | GHLR=0D0 | |
39097 | ENDIF | |
39098 | ELSE | |
39099 | GHLL=XMZ/CW*(0.5D0-EI*XW)*SIN(ALFA+BETA)- | |
39100 | & XMF**2/XMW*COSA/SBETA | |
39101 | GHRR=XMZ/CW*(EI*XW)*SIN(ALFA+BETA)- | |
39102 | & XMF**2/XMW*COSA/SBETA | |
39103 | IF(IFL.EQ.6) THEN | |
39104 | GHLR=XMF/2D0/XMW/SBETA*(XMUZ*SINA- | |
39105 | & ATRIT*COSA) | |
39106 | ELSE | |
39107 | GHLR=0D0 | |
39108 | ENDIF | |
39109 | ENDIF | |
39110 | ||
39111 | ELSEIF(IH.EQ.2) THEN | |
39112 | IF(IDU.EQ.1) THEN | |
39113 | GHLL=XMZ/CW*(0.5D0+EI*XW)*COS(ALFA+BETA)- | |
39114 | & XMF**2/XMW*COSA/CBETA | |
39115 | GHRR=-XMZ/CW*(EI*XW)*COS(ALFA+BETA)- | |
39116 | & XMF**2/XMW*COSA/CBETA | |
39117 | IF(IFL.EQ.5) THEN | |
39118 | GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*SINA+ | |
39119 | & ATRIB*COSA) | |
39120 | ELSEIF(IFL.EQ.15) THEN | |
39121 | GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*SINA+ | |
39122 | & ATRIL*COSA) | |
39123 | ELSE | |
39124 | GHLR=0D0 | |
39125 | ENDIF | |
39126 | ELSE | |
39127 | GHLL=-XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)- | |
39128 | & XMF**2/XMW*SINA/SBETA | |
39129 | GHRR=-XMZ/CW*(EI*XW)*COS(ALFA+BETA)- | |
39130 | & XMF**2/XMW*SINA/SBETA | |
39131 | IF(IFL.EQ.6) THEN | |
39132 | GHLR=-XMF/2D0/XMW/SBETA*(XMUZ*COSA+ | |
39133 | & ATRIT*SINA) | |
39134 | ELSE | |
39135 | GHLR=0D0 | |
39136 | ENDIF | |
39137 | ENDIF | |
39138 | ||
39139 | ELSEIF(IH.EQ.3) THEN | |
39140 | GHLL=0D0 | |
39141 | GHRR=0D0 | |
39142 | GHLR=0D0 | |
39143 | IF(IDU.EQ.1) THEN | |
39144 | IF(IFL.EQ.5) THEN | |
39145 | GHLR=XMF/2D0/XMW*(ATRIB*TANB-XMUZ) | |
39146 | ELSEIF(IFL.EQ.15) THEN | |
39147 | GHLR=XMF/2D0/XMW*(ATRIL*TANB-XMUZ) | |
39148 | ENDIF | |
39149 | ELSE | |
39150 | IF(IFL.EQ.6) THEN | |
39151 | GHLR=XMF/2D0/XMW*(ATRIT/TANB-XMUZ) | |
39152 | ENDIF | |
39153 | ENDIF | |
39154 | ENDIF | |
39155 | IF(IH.EQ.3) GOTO 180 | |
39156 | ||
39157 | AL=SFMIX(IFL,1)**2 | |
39158 | AR=SFMIX(IFL,2)**2 | |
39159 | ALR=SFMIX(IFL,1)*SFMIX(IFL,2) | |
39160 | IF(IFL.LE.6) THEN | |
39161 | CF=3D0 | |
39162 | ELSE | |
39163 | CF=1D0 | |
39164 | ENDIF | |
39165 | ||
39166 | IF(AXMI.GE.2D0*XMJ) THEN | |
39167 | LKNT=LKNT+1 | |
39168 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* | |
39169 | & (GHLL*AL+GHRR*AR | |
39170 | & +2D0*GHLR*ALR)**2 | |
39171 | IDLAM(LKNT,1)=IJ | |
39172 | IDLAM(LKNT,2)=-IJ | |
39173 | IDLAM(LKNT,3)=0 | |
39174 | ENDIF | |
39175 | ||
39176 | IF(AXMI.GE.2D0*XMJR) THEN | |
39177 | LKNT=LKNT+1 | |
39178 | AL=SFMIX(IFL,3)**2 | |
39179 | AR=SFMIX(IFL,4)**2 | |
39180 | ALR=SFMIX(IFL,3)*SFMIX(IFL,4) | |
39181 | XMJ=XMJR | |
39182 | XMJ2=XMJ**2 | |
39183 | XL=PYLAMF(XMI2,XMJ2,XMJ2) | |
39184 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* | |
39185 | & (GHLL*AL+GHRR*AR | |
39186 | & +2D0*GHLR*ALR)**2 | |
39187 | IDLAM(LKNT,1)=IJ+KSUSY1 | |
39188 | IDLAM(LKNT,2)=-(IJ+KSUSY1) | |
39189 | IDLAM(LKNT,3)=0 | |
39190 | ENDIF | |
39191 | 180 CONTINUE | |
39192 | ||
39193 | IF(AXMI.GE.XMJL+XMJR) THEN | |
39194 | LKNT=LKNT+1 | |
39195 | AL=SFMIX(IFL,1)*SFMIX(IFL,3) | |
39196 | AR=SFMIX(IFL,2)*SFMIX(IFL,4) | |
39197 | ALR=SFMIX(IFL,1)*SFMIX(IFL,4)+SFMIX(IFL,2)*SFMIX(IFL,3) | |
39198 | XMJ=XMJR | |
39199 | XMJ2=XMJ**2 | |
39200 | XL=PYLAMF(XMI2,XMJ2,XMJL**2) | |
39201 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* | |
39202 | & (GHLL*AL+GHRR*AR)**2 | |
39203 | IDLAM(LKNT,1)=IJ | |
39204 | IDLAM(LKNT,2)=-(IJ+KSUSY1) | |
39205 | IDLAM(LKNT,3)=0 | |
39206 | LKNT=LKNT+1 | |
39207 | IDLAM(LKNT,1)=-IJ | |
39208 | IDLAM(LKNT,2)=IJ+KSUSY1 | |
39209 | IDLAM(LKNT,3)=0 | |
39210 | XLAM(LKNT)=XLAM(LKNT-1) | |
39211 | ENDIF | |
39212 | ENDIF | |
39213 | 190 CONTINUE | |
39214 | 200 CONTINUE | |
39215 | 210 CONTINUE | |
39216 | ||
39217 | GOTO 270 | |
39218 | 220 CONTINUE | |
39219 | ||
39220 | C...H+ -> CHI+_I + CHI0_J | |
39221 | DO 240 IJ=1,4 | |
39222 | XMJ=SMZ(IJ) | |
39223 | AXMJ=ABS(XMJ) | |
39224 | XMJ2=XMJ**2 | |
39225 | DO 230 IK=1,2 | |
39226 | XMK=SMW(IK) | |
39227 | AXMK=ABS(XMK) | |
39228 | IF(AXMI.GE.AXMJ+AXMK) THEN | |
39229 | LKNT=LKNT+1 | |
39230 | OLPP=CBETA*DCONJG(ZMIXC(IJ,4)*VMIXC(IK,1)+(ZMIXC(IJ,2)+ | |
39231 | & ZMIXC(IJ,1)*TANW)*VMIXC(IK,2)/SR2) | |
39232 | ORPP=SBETA*(ZMIXC(IJ,3)*UMIXC(IK,1)- | |
39233 | & (ZMIXC(IJ,2)+ZMIXC(IJ,1)*TANW)*UMIXC(IK,2)/SR2) | |
39234 | GX2=ABS(OLPP)**2+ABS(ORPP)**2 | |
39235 | GLR=DBLE(OLPP*DCONJG(ORPP)) | |
39236 | XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,-XMK,GX2,GLR) | |
39237 | IDLAM(LKNT,1)=KFNCHI(IJ) | |
39238 | IDLAM(LKNT,2)=KFCCHI(IK) | |
39239 | IDLAM(LKNT,3)=0 | |
39240 | ENDIF | |
39241 | 230 CONTINUE | |
39242 | 240 CONTINUE | |
39243 | ||
39244 | GL=-XMW/SR2*(SIN(2D0*BETA)-PMAS(6,1)**2/TANB/XMW2) | |
39245 | GR=-PMAS(6,1)/SR2/XMW*(XMUZ-ATRIT/TANB) | |
39246 | AL=0D0 | |
39247 | AR=0D0 | |
39248 | CF=3D0 | |
39249 | ||
39250 | C...H+ -> T_1 B_1~ | |
39251 | XM1=PMAS(PYCOMP(KSUSY1+6),1) | |
39252 | XM2=PMAS(PYCOMP(KSUSY1+5),1) | |
39253 | IF(XMI.GE.XM1+XM2) THEN | |
39254 | XL=PYLAMF(XMI2,XM1**2,XM2**2) | |
39255 | LKNT=LKNT+1 | |
39256 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* | |
39257 | & (GL*SFMIX(6,1)*SFMIX(5,1)+GR*SFMIX(6,2)*SFMIX(5,1))**2 | |
39258 | IDLAM(LKNT,1)=KSUSY1+6 | |
39259 | IDLAM(LKNT,2)=-(KSUSY1+5) | |
39260 | IDLAM(LKNT,3)=0 | |
39261 | ENDIF | |
39262 | ||
39263 | C...H+ -> T_2 B_1~ | |
39264 | XM1=PMAS(PYCOMP(KSUSY2+6),1) | |
39265 | XM2=PMAS(PYCOMP(KSUSY1+5),1) | |
39266 | IF(XMI.GE.XM1+XM2) THEN | |
39267 | XL=PYLAMF(XMI2,XM1**2,XM2**2) | |
39268 | LKNT=LKNT+1 | |
39269 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* | |
39270 | & (GL*SFMIX(6,3)*SFMIX(5,1)+GR*SFMIX(6,4)*SFMIX(5,1))**2 | |
39271 | IDLAM(LKNT,1)=KSUSY2+6 | |
39272 | IDLAM(LKNT,2)=-(KSUSY1+5) | |
39273 | IDLAM(LKNT,3)=0 | |
39274 | ENDIF | |
39275 | ||
39276 | C...H+ -> T_1 B_2~ | |
39277 | XM1=PMAS(PYCOMP(KSUSY1+6),1) | |
39278 | XM2=PMAS(PYCOMP(KSUSY2+5),1) | |
39279 | IF(XMI.GE.XM1+XM2) THEN | |
39280 | XL=PYLAMF(XMI2,XM1**2,XM2**2) | |
39281 | LKNT=LKNT+1 | |
39282 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* | |
39283 | & (GL*SFMIX(6,1)*SFMIX(5,3)+GR*SFMIX(6,2)*SFMIX(5,3))**2 | |
39284 | IDLAM(LKNT,1)=KSUSY1+6 | |
39285 | IDLAM(LKNT,2)=-(KSUSY2+5) | |
39286 | IDLAM(LKNT,3)=0 | |
39287 | ENDIF | |
39288 | ||
39289 | C...H+ -> T_2 B_2~ | |
39290 | XM1=PMAS(PYCOMP(KSUSY2+6),1) | |
39291 | XM2=PMAS(PYCOMP(KSUSY2+5),1) | |
39292 | IF(XMI.GE.XM1+XM2) THEN | |
39293 | XL=PYLAMF(XMI2,XM1**2,XM2**2) | |
39294 | LKNT=LKNT+1 | |
39295 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* | |
39296 | & (GL*SFMIX(6,3)*SFMIX(5,3)+GR*SFMIX(6,4)*SFMIX(5,3))**2 | |
39297 | IDLAM(LKNT,1)=KSUSY2+6 | |
39298 | IDLAM(LKNT,2)=-(KSUSY2+5) | |
39299 | IDLAM(LKNT,3)=0 | |
39300 | ENDIF | |
39301 | ||
39302 | C...H+ -> UL DL~ | |
39303 | GL=-XMW/SR2*SIN(2D0*BETA) | |
39304 | DO 250 IJ=1,3,2 | |
39305 | XM1=PMAS(PYCOMP(KSUSY1+IJ),1) | |
39306 | XM2=PMAS(PYCOMP(KSUSY1+IJ+1),1) | |
39307 | IF(XMI.GE.XM1+XM2) THEN | |
39308 | XL=PYLAMF(XMI2,XM1**2,XM2**2) | |
39309 | LKNT=LKNT+1 | |
39310 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2 | |
39311 | IDLAM(LKNT,1)=-(KSUSY1+IJ) | |
39312 | IDLAM(LKNT,2)=KSUSY1+IJ+1 | |
39313 | IDLAM(LKNT,3)=0 | |
39314 | ENDIF | |
39315 | 250 CONTINUE | |
39316 | ||
39317 | C...H+ -> EL~ NUL | |
39318 | CF=1D0 | |
39319 | DO 260 IJ=11,13,2 | |
39320 | XM1=PMAS(PYCOMP(KSUSY1+IJ),1) | |
39321 | XM2=PMAS(PYCOMP(KSUSY1+IJ+1),1) | |
39322 | IF(XMI.GE.XM1+XM2) THEN | |
39323 | XL=PYLAMF(XMI2,XM1**2,XM2**2) | |
39324 | LKNT=LKNT+1 | |
39325 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2 | |
39326 | IDLAM(LKNT,1)=-(KSUSY1+IJ) | |
39327 | IDLAM(LKNT,2)=KSUSY1+IJ+1 | |
39328 | IDLAM(LKNT,3)=0 | |
39329 | ENDIF | |
39330 | 260 CONTINUE | |
39331 | ||
39332 | C...H+ -> TAU1 NUTAUL | |
39333 | XM1=PMAS(PYCOMP(KSUSY1+15),1) | |
39334 | XM2=PMAS(PYCOMP(KSUSY1+16),1) | |
39335 | IF(XMI.GE.XM1+XM2) THEN | |
39336 | XL=PYLAMF(XMI2,XM1**2,XM2**2) | |
39337 | LKNT=LKNT+1 | |
39338 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2*SFMIX(15,1)**2 | |
39339 | IDLAM(LKNT,1)=-(KSUSY1+15) | |
39340 | IDLAM(LKNT,2)= KSUSY1+16 | |
39341 | IDLAM(LKNT,3)=0 | |
39342 | ENDIF | |
39343 | ||
39344 | C...H+ -> TAU2 NUTAUL | |
39345 | XM1=PMAS(PYCOMP(KSUSY2+15),1) | |
39346 | XM2=PMAS(PYCOMP(KSUSY1+16),1) | |
39347 | IF(XMI.GE.XM1+XM2) THEN | |
39348 | XL=PYLAMF(XMI2,XM1**2,XM2**2) | |
39349 | LKNT=LKNT+1 | |
39350 | XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2*SFMIX(15,3)**2 | |
39351 | IDLAM(LKNT,1)=-(KSUSY2+15) | |
39352 | IDLAM(LKNT,2)= KSUSY1+16 | |
39353 | IDLAM(LKNT,3)=0 | |
39354 | ENDIF | |
39355 | ||
39356 | 270 CONTINUE | |
39357 | IKNT=LKNT | |
39358 | XLAM(0)=0D0 | |
39359 | DO 280 I=1,IKNT | |
39360 | IF(XLAM(I).LE.0D0) XLAM(I)=0D0 | |
39361 | XLAM(0)=XLAM(0)+XLAM(I) | |
39362 | 280 CONTINUE | |
39363 | IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6 | |
39364 | ||
39365 | RETURN | |
39366 | END | |
39367 | ||
39368 | C********************************************************************* | |
39369 | ||
39370 | C...PYH2XX | |
39371 | C...Calculates the decay rate for a Higgs to an ino pair. | |
39372 | ||
39373 | FUNCTION PYH2XX(C1,XM1,XM2,XM3,GX2,GLR) | |
39374 | ||
39375 | C...Double precision and integer declarations. | |
39376 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
39377 | IMPLICIT INTEGER(I-N) | |
39378 | INTEGER PYK,PYCHGE,PYCOMP | |
39379 | C...Commonblocks. | |
39380 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
39381 | SAVE /PYDAT1/ | |
39382 | ||
39383 | C...Local variables. | |
39384 | DOUBLE PRECISION PYH2XX,XM1,XM2,XM3,GL,GR | |
39385 | DOUBLE PRECISION XL,PYLAMF,C1 | |
39386 | DOUBLE PRECISION XMI2,XMJ2,XMK2,XMI3 | |
39387 | ||
39388 | XMI2=XM1**2 | |
39389 | XMI3=ABS(XM1**3) | |
39390 | XMJ2=XM2**2 | |
39391 | XMK2=XM3**2 | |
39392 | XL=PYLAMF(XMI2,XMJ2,XMK2) | |
39393 | PYH2XX=C1/4D0/XMI3*SQRT(XL) | |
39394 | &*(GX2*(XMI2-XMJ2-XMK2)- | |
39395 | &4D0*GLR*XM3*XM2) | |
39396 | IF(PYH2XX.LT.0D0) THEN | |
39397 | WRITE(MSTU(11),*) ' NEGATIVE WIDTH IN PYH2XX ' | |
39398 | WRITE(MSTU(11),*) XMI2,XMJ2,XMK2,GX2,GLR,XM1,XM2,XM3 | |
39399 | STOP | |
39400 | ENDIF | |
39401 | ||
39402 | RETURN | |
39403 | END | |
39404 | ||
39405 | C********************************************************************* | |
39406 | ||
39407 | C...PYGAUS | |
39408 | C...Integration by adaptive Gaussian quadrature. | |
39409 | C...Adapted from the CERNLIB DGAUSS routine by K.S. Kolbig. | |
39410 | ||
39411 | FUNCTION PYGAUS(F, A, B, EPS) | |
39412 | ||
39413 | C...Double precision and integer declarations. | |
39414 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
39415 | IMPLICIT INTEGER(I-N) | |
39416 | INTEGER PYK,PYCHGE,PYCOMP | |
39417 | ||
39418 | C...Local declarations. | |
39419 | EXTERNAL F | |
39420 | DOUBLE PRECISION F,W(12), X(12) | |
39421 | DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/ | |
39422 | DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/ | |
39423 | DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/ | |
39424 | DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/ | |
39425 | DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/ | |
39426 | DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/ | |
39427 | DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/ | |
39428 | DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/ | |
39429 | DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/ | |
39430 | DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/ | |
39431 | DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/ | |
39432 | DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/ | |
39433 | ||
39434 | C...The Gaussian quadrature algorithm. | |
39435 | H = 0D0 | |
39436 | IF(B .EQ. A) GOTO 140 | |
39437 | CONST = 5D-3 / ABS(B-A) | |
39438 | BB = A | |
39439 | 100 CONTINUE | |
39440 | AA = BB | |
39441 | BB = B | |
39442 | 110 CONTINUE | |
39443 | C1 = 0.5D0*(BB+AA) | |
39444 | C2 = 0.5D0*(BB-AA) | |
39445 | S8 = 0D0 | |
39446 | DO 120 I = 1, 4 | |
39447 | U = C2*X(I) | |
39448 | S8 = S8 + W(I) * (F(C1+U) + F(C1-U)) | |
39449 | 120 CONTINUE | |
39450 | S16 = 0D0 | |
39451 | DO 130 I = 5, 12 | |
39452 | U = C2*X(I) | |
39453 | S16 = S16 + W(I) * (F(C1+U) + F(C1-U)) | |
39454 | 130 CONTINUE | |
39455 | S16 = C2*S16 | |
39456 | IF(DABS(S16-C2*S8) .LE. EPS*(1D0+DABS(S16))) THEN | |
39457 | H = H + S16 | |
39458 | IF(BB .NE. B) GOTO 100 | |
39459 | ELSE | |
39460 | BB = C1 | |
39461 | IF(1D0 + CONST*ABS(C2) .NE. 1D0) GOTO 110 | |
39462 | H = 0D0 | |
39463 | CALL PYERRM(18,'(PYGAUS:) too high accuracy required') | |
39464 | GOTO 140 | |
39465 | ENDIF | |
39466 | 140 CONTINUE | |
39467 | PYGAUS = H | |
39468 | ||
39469 | RETURN | |
39470 | END | |
39471 | ||
39472 | C********************************************************************* | |
39473 | ||
39474 | C...PYGAU2 | |
39475 | C...Integration by adaptive Gaussian quadrature. | |
39476 | C...Adapted from the CERNLIB DGAUSS routine by K.S. Kolbig. | |
39477 | C...Carbon copy of PYGAUS, but avoids having to use it recursively. | |
39478 | ||
39479 | FUNCTION PYGAU2(F, A, B, EPS) | |
39480 | ||
39481 | C...Double precision and integer declarations. | |
39482 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
39483 | IMPLICIT INTEGER(I-N) | |
39484 | INTEGER PYK,PYCHGE,PYCOMP | |
39485 | ||
39486 | C...Local declarations. | |
39487 | EXTERNAL F | |
39488 | DOUBLE PRECISION F,W(12), X(12) | |
39489 | DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/ | |
39490 | DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/ | |
39491 | DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/ | |
39492 | DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/ | |
39493 | DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/ | |
39494 | DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/ | |
39495 | DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/ | |
39496 | DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/ | |
39497 | DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/ | |
39498 | DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/ | |
39499 | DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/ | |
39500 | DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/ | |
39501 | ||
39502 | C...The Gaussian quadrature algorithm. | |
39503 | H = 0D0 | |
39504 | IF(B .EQ. A) GOTO 140 | |
39505 | CONST = 5D-3 / ABS(B-A) | |
39506 | BB = A | |
39507 | 100 CONTINUE | |
39508 | AA = BB | |
39509 | BB = B | |
39510 | 110 CONTINUE | |
39511 | C1 = 0.5D0*(BB+AA) | |
39512 | C2 = 0.5D0*(BB-AA) | |
39513 | S8 = 0D0 | |
39514 | DO 120 I = 1, 4 | |
39515 | U = C2*X(I) | |
39516 | S8 = S8 + W(I) * (F(C1+U) + F(C1-U)) | |
39517 | 120 CONTINUE | |
39518 | S16 = 0D0 | |
39519 | DO 130 I = 5, 12 | |
39520 | U = C2*X(I) | |
39521 | S16 = S16 + W(I) * (F(C1+U) + F(C1-U)) | |
39522 | 130 CONTINUE | |
39523 | S16 = C2*S16 | |
39524 | IF(DABS(S16-C2*S8) .LE. EPS*(1D0+DABS(S16))) THEN | |
39525 | H = H + S16 | |
39526 | IF(BB .NE. B) GOTO 100 | |
39527 | ELSE | |
39528 | BB = C1 | |
39529 | IF(1D0 + CONST*ABS(C2) .NE. 1D0) GOTO 110 | |
39530 | H = 0D0 | |
39531 | CALL PYERRM(18,'(PYGAU2:) too high accuracy required') | |
39532 | GOTO 140 | |
39533 | ENDIF | |
39534 | 140 CONTINUE | |
39535 | PYGAU2 = H | |
39536 | ||
39537 | RETURN | |
39538 | END | |
39539 | ||
39540 | C********************************************************************* | |
39541 | ||
39542 | C...PYSIMP | |
39543 | C...Simpson formula for an integral. | |
39544 | ||
39545 | FUNCTION PYSIMP(Y,X0,X1,N) | |
39546 | ||
39547 | C...Double precision and integer declarations. | |
39548 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
39549 | IMPLICIT INTEGER(I-N) | |
39550 | INTEGER PYK,PYCHGE,PYCOMP | |
39551 | ||
39552 | C...Local variables. | |
39553 | DOUBLE PRECISION Y,X0,X1,H,S | |
39554 | DIMENSION Y(0:N) | |
39555 | ||
39556 | S=0D0 | |
39557 | H=(X1-X0)/N | |
39558 | DO 100 I=0,N-2,2 | |
39559 | S=S+Y(I)+4D0*Y(I+1)+Y(I+2) | |
39560 | 100 CONTINUE | |
39561 | PYSIMP=S*H/3D0 | |
39562 | ||
39563 | RETURN | |
39564 | END | |
39565 | ||
39566 | C********************************************************************* | |
39567 | ||
39568 | C...PYLAMF | |
39569 | C...The standard lambda function. | |
39570 | ||
39571 | FUNCTION PYLAMF(X,Y,Z) | |
39572 | ||
39573 | C...Double precision and integer declarations. | |
39574 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
39575 | IMPLICIT INTEGER(I-N) | |
39576 | INTEGER PYK,PYCHGE,PYCOMP | |
39577 | ||
39578 | C...Local variables. | |
39579 | DOUBLE PRECISION PYLAMF,X,Y,Z | |
39580 | ||
39581 | PYLAMF=(X-(Y+Z))**2-4D0*Y*Z | |
39582 | IF(PYLAMF.LT.0D0) PYLAMF=0D0 | |
39583 | ||
39584 | RETURN | |
39585 | END | |
39586 | ||
39587 | C********************************************************************* | |
39588 | ||
39589 | C...PYTBDY | |
39590 | C...Generates 3-body decays of gauginos. | |
39591 | ||
39592 | SUBROUTINE PYTBDY(IDIN) | |
39593 | ||
39594 | C...Double precision and integer declarations. | |
39595 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
39596 | IMPLICIT INTEGER(I-N) | |
39597 | INTEGER PYK,PYCHGE,PYCOMP | |
39598 | C...Parameter statement to help give large particle numbers. | |
39599 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
39600 | &KEXCIT=4000000,KDIMEN=5000000) | |
39601 | C...Commonblocks. | |
39602 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
39603 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
39604 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
39605 | C COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
39606 | C COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
39607 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
39608 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
39609 | C SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYSSMT/ | |
39610 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSSMT/ | |
39611 | ||
39612 | C...Local variables. | |
39613 | DOUBLE PRECISION XM(5) | |
39614 | COMPLEX*16 OLPP,ORPP,QLL,QLR,QRR,QRL,GLIJ,GRIJ,PROPZ | |
39615 | COMPLEX*16 QLLS,QRRS,QLRS,QRLS,QLLU,QRRU,QLRT,QRLT | |
39616 | COMPLEX*16 ZMIXC(4,4),UMIXC(2,2),VMIXC(2,2) | |
39617 | DOUBLE PRECISION S12MIN,S12MAX,YJACO1,S23AVE,S23DF1,S23DF2 | |
39618 | DOUBLE PRECISION D1,D2,D3,P1,P2,P3,CTHE1,STHE1,CTHE3,STHE3 | |
39619 | DOUBLE PRECISION CPHI1,SPHI1 | |
39620 | DOUBLE PRECISION S23DEL,EPS | |
39621 | DOUBLE PRECISION GOLDEN,AX,BX,CX,TOL,XMIN,R,C | |
39622 | PARAMETER (R=0.61803399D0,C=1D0-R,TOL=1D-3) | |
39623 | DOUBLE PRECISION F1,F2,X0,X1,X2,X3 | |
39624 | INTEGER INOID(4) | |
39625 | DATA INOID/22,23,25,35/ | |
39626 | DATA EPS/1D-6/ | |
39627 | ||
39628 | ID=IDIN | |
39629 | ISKIP=1 | |
39630 | XM(1)=P(N+1,5) | |
39631 | XM(2)=P(N+2,5) | |
39632 | XM(3)=P(N+3,5) | |
39633 | XM(5)=P(ID,5) | |
39634 | ||
39635 | C...GENERATE S12 | |
39636 | S12MIN=(XM(1)+XM(2))**2 | |
39637 | S12MAX=(XM(5)-XM(3))**2 | |
39638 | YJACO1=S12MAX-S12MIN | |
39639 | ||
39640 | C...Initialize some parameters | |
39641 | XW=PARU(102) | |
39642 | XW1=1D0-XW | |
39643 | TANW=SQRT(XW/XW1) | |
39644 | IZID1=0 | |
39645 | IWID1=0 | |
39646 | IZID2=0 | |
39647 | IWID2=0 | |
39648 | DO 100 I1=1,4 | |
39649 | IF(MOD(K(N+1,2),KSUSY1).EQ.INOID(I1)) IZID1=I1 | |
39650 | IF(MOD(K(ID,2),KSUSY1).EQ.INOID(I1)) IZID2=I1 | |
39651 | 100 CONTINUE | |
39652 | IF(MOD(K(N+1,2),KSUSY1).EQ.24) IWID1=1 | |
39653 | IF(MOD(K(N+1,2),KSUSY1).EQ.37) IWID1=2 | |
39654 | IF(MOD(K(ID,2),KSUSY1).EQ.24) IWID2=1 | |
39655 | IF(MOD(K(ID,2),KSUSY1).EQ.37) IWID2=2 | |
39656 | IA=K(N+2,2) | |
39657 | JA=K(N+3,2) | |
39658 | ZM12=XM(5)**2 | |
39659 | ZM22=XM(1)**2 | |
39660 | EI=KCHG(IABS(IA),1)/3D0 | |
39661 | T3I=SIGN(1D0,EI+1D-6)/2D0 | |
39662 | IF(MAX(ABS(IA),ABS(JA)).EQ.6) THEN | |
39663 | ISKIP=0 | |
39664 | ELSEIF(IZID1*IZID2.NE.0) THEN | |
39665 | SQMZ=PMAS(23,1)**2 | |
39666 | GMMZ=PMAS(23,1)*PMAS(23,2) | |
39667 | DO 110 I=1,4 | |
39668 | ZMIXC(IZID1,I)=DCMPLX(ZMIX(IZID1,I),ZMIXI(IZID1,I)) | |
39669 | ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) | |
39670 | 110 CONTINUE | |
39671 | OLPP=(ZMIXC(IZID1,3)*DCONJG(ZMIXC(IZID2,3))- | |
39672 | & ZMIXC(IZID1,4)*DCONJG(ZMIXC(IZID2,4)))/2D0 | |
39673 | ORPP=DCONJG(OLPP) | |
39674 | XLL2=PMAS(PYCOMP(KSUSY1+IABS(IA)),1)**2 | |
39675 | XLR2=XLL2 | |
39676 | XRR2=PMAS(PYCOMP(KSUSY2+IABS(IA)),1)**2 | |
39677 | XRL2=XRR2 | |
39678 | GLIJ=(T3I*ZMIXC(IZID1,2)-TANW*(T3I-EI)*ZMIXC(IZID1,1))* | |
39679 | & DCONJG(T3I*ZMIXC(IZID2,2)-TANW*(T3I-EI)*ZMIXC(IZID2,1)) | |
39680 | GRIJ=ZMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1))*(EI*TANW)**2 | |
39681 | XM1M2=SMZ(IZID1)*SMZ(IZID2) | |
39682 | QLLS=DCMPLX((T3I-EI*XW)/XW1)*OLPP | |
39683 | QLLU=-GLIJ | |
39684 | QLRS=-DCMPLX((T3I-EI*XW)/XW1)*ORPP | |
39685 | QLRT=DCONJG(GLIJ) | |
39686 | QRLS=-DCMPLX((EI*XW)/XW1)*OLPP | |
39687 | QRLT=GRIJ | |
39688 | QRRS=DCMPLX((EI*XW)/XW1)*ORPP | |
39689 | QRRU=-DCONJG(GRIJ) | |
39690 | ELSEIF(IZID1*IWID2.NE.0.OR.IZID2*IWID1.NE.0) THEN | |
39691 | IF(IZID1.NE.0) THEN | |
39692 | XM1M2=SMZ(IZID1)*SMW(IWID2) | |
39693 | IZID1=IWID2 | |
39694 | IZID2=IZID1 | |
39695 | ELSE | |
39696 | XM1M2=SMZ(IZID2)*SMW(IWID1) | |
39697 | IZID1=IWID1 | |
39698 | ENDIF | |
39699 | RT2I = 1D0/SQRT(2D0) | |
39700 | SQMZ=PMAS(24,1)**2 | |
39701 | GMMZ=PMAS(24,1)*PMAS(24,2) | |
39702 | DO 120 I=1,2 | |
39703 | VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) | |
39704 | UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) | |
39705 | 120 CONTINUE | |
39706 | DO 130 I=1,4 | |
39707 | ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) | |
39708 | 130 CONTINUE | |
39709 | QLLS=(DCONJG(ZMIXC(IZID2,2))*VMIXC(IZID1,1)- | |
39710 | & DCONJG(ZMIXC(IZID2,4))*VMIXC(IZID1,2)*RT2I) | |
39711 | QLRS=(ZMIXC(IZID2,2)*DCONJG(UMIXC(IZID1,1))+ | |
39712 | & ZMIXC(IZID2,3)*DCONJG(UMIXC(IZID1,2))*RT2I) | |
39713 | EJ=KCHG(JA,1)/3D0 | |
39714 | T3J=SIGN(1D0,EJ+1D-6)/2D0 | |
39715 | QRLS=DCMPLX(0D0,0D0) | |
39716 | QRLT=QRLS | |
39717 | QRRS=QRLS | |
39718 | QRRU=QRLS | |
39719 | XRR2=1D6**2 | |
39720 | XRL2=XRR2 | |
39721 | XLR2 = PMAS(PYCOMP(KSUSY1+JA),1)**2 | |
39722 | XLL2 = PMAS(PYCOMP(KSUSY1+IA),1)**2 | |
39723 | IF(MOD(IA,2).EQ.0) THEN | |
39724 | QLLU=VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EI-T3I)* | |
39725 | & TANW+ZMIXC(IZID2,2)*T3I) | |
39726 | QLRT=-DCONJG(UMIXC(IZID1,1))*( | |
39727 | & ZMIXC(IZID2,1)*(EJ-T3J)*TANW+ZMIXC(IZID2,2)*T3J) | |
39728 | ELSE | |
39729 | QLLU=VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EJ-T3J)* | |
39730 | & TANW+ZMIXC(IZID2,2)*T3J) | |
39731 | QLRT=-DCONJG(UMIXC(IZID1,1))*( | |
39732 | & ZMIXC(IZID2,1)*(EI-T3I)*TANW+ZMIXC(IZID2,2)*T3I) | |
39733 | ENDIF | |
39734 | ELSEIF(IWID1*IWID2.NE.0) THEN | |
39735 | IZID1=IWID1 | |
39736 | IZID2=IWID2 | |
39737 | XM1M2=SMW(IWID1)*SMW(IWID2) | |
39738 | SQMZ=PMAS(23,1)**2 | |
39739 | GMMZ=PMAS(23,1)*PMAS(23,2) | |
39740 | DO 140 I=1,2 | |
39741 | VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) | |
39742 | UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) | |
39743 | VMIXC(IZID2,I)=DCMPLX(VMIX(IZID2,I),VMIXI(IZID2,I)) | |
39744 | UMIXC(IZID2,I)=DCMPLX(UMIX(IZID2,I),UMIXI(IZID2,I)) | |
39745 | 140 CONTINUE | |
39746 | OLPP=-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))- | |
39747 | & VMIXC(IZID2,2)*DCONJG(VMIXC(IZID1,2))/2D0 | |
39748 | ORPP=-UMIXC(IZID1,1)*DCONJG(UMIXC(IZID2,1))- | |
39749 | & UMIXC(IZID1,2)*DCONJG(UMIXC(IZID2,2))/2D0 | |
39750 | QRLS=-DCMPLX(EI/XW1)*ORPP | |
39751 | QLLS=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP | |
39752 | QRRS=-DCMPLX(EI/XW1)*OLPP | |
39753 | QLRS=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP | |
39754 | IF(MOD(IA,2).EQ.0) THEN | |
39755 | XLR2=PMAS(PYCOMP(KSUSY1+IABS(IA)-1),1)**2 | |
39756 | QLRT=-UMIXC(IZID2,1)*DCONJG(UMIXC(IZID1,1))*DCMPLX(T3I/XW) | |
39757 | ELSE | |
39758 | XLR2=PMAS(PYCOMP(KSUSY1+IABS(IA)+1),1)**2 | |
39759 | QLRT=-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))*DCMPLX(T3I/XW) | |
39760 | ENDIF | |
39761 | ELSEIF(MOD(K(N+1,2),KSUSY1).EQ.21.OR.MOD(K(ID,2),KSUSY1).EQ.21) | |
39762 | &THEN | |
39763 | ISKIP=0 | |
39764 | ELSE | |
39765 | ISKIP=0 | |
39766 | ENDIF | |
39767 | ||
39768 | IF(ISKIP.NE.0) THEN | |
39769 | WTMAX=0D0 | |
39770 | DO 160 KT=1,100 | |
39771 | S12=S12MIN+YJACO1*(KT-1)/99 | |
39772 | S23AVE=XM(2)**2+XM(3)**2-(S12+XM(2)**2-XM(1)**2) | |
39773 | & *(S12+XM(3)**2-XM(5)**2)/(2D0*S12) | |
39774 | S23DF1=(S12-XM(2)**2-XM(1)**2)**2 | |
39775 | & -(2D0*XM(1)*XM(2))**2 | |
39776 | S23DF2=(S12-XM(3)**2-XM(5)**2)**2 | |
39777 | & -(2D0*XM(3)*XM(5))**2 | |
39778 | S23DF1=S23DF1*EPS | |
39779 | S23DF2=S23DF2*EPS | |
39780 | S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*S12) | |
39781 | S23DEL=S23DEL/EPS | |
39782 | S23MIN=S23AVE-S23DEL | |
39783 | S23MAX=S23AVE+S23DEL | |
39784 | YJACO2=S23MAX-S23MIN | |
39785 | TH=S12 | |
39786 | DO 150 KS=1,100 | |
39787 | S23=S23MIN+YJACO2*(KS-1)/99 | |
39788 | SH=S23 | |
39789 | UH=ZM12+ZM22-SH-TH | |
39790 | WU2 = (UH-ZM12)*(UH-ZM22) | |
39791 | WT2 = (TH-ZM12)*(TH-ZM22) | |
39792 | WS2 = XM1M2*SH | |
39793 | PROPZ2 = (SH-SQMZ)**2 + GMMZ**2 | |
39794 | PROPZ=DCMPLX(SH-SQMZ,-GMMZ)/DCMPLX(PROPZ2) | |
39795 | QLL=QLLS*PROPZ+QLLU/DCMPLX(UH-XLL2) | |
39796 | QLR=QLRS*PROPZ+QLRT/DCMPLX(TH-XLR2) | |
39797 | QRL=QRLS*PROPZ+QRLT/DCMPLX(TH-XRL2) | |
39798 | QRR=QRRS*PROPZ+QRRU/DCMPLX(UH-XRR2) | |
39799 | WT0=-((ABS(QLL)**2+ABS(QRR)**2)*WU2+ | |
39800 | & (ABS(QRL)**2+ABS(QLR)**2)*WT2+ | |
39801 | & 2D0*DBLE(QLR*DCONJG(QLL)+QRL*DCONJG(QRR))*WS2) | |
39802 | IF(WT0.GT.WTMAX) WTMAX=WT0 | |
39803 | 150 CONTINUE | |
39804 | 160 CONTINUE | |
39805 | ||
39806 | WTMAX=WTMAX*1.05D0 | |
39807 | ENDIF | |
39808 | ||
39809 | C...FIND S12* | |
39810 | AX=S12MIN | |
39811 | CX=S12MAX | |
39812 | BX=S12MIN+0.5D0*YJACO1 | |
39813 | X0=AX | |
39814 | X3=CX | |
39815 | IF(ABS(CX-BX).GT.ABS(BX-AX))THEN | |
39816 | X1=BX | |
39817 | X2=BX+C*(CX-BX) | |
39818 | ELSE | |
39819 | X2=BX | |
39820 | X1=BX-C*(BX-AX) | |
39821 | ENDIF | |
39822 | ||
39823 | C...SOLVE FOR F1 AND F2 | |
39824 | S23DF1=(X1-XM(2)**2-XM(1)**2)**2 | |
39825 | &-(2D0*XM(1)*XM(2))**2 | |
39826 | S23DF2=(X1-XM(3)**2-XM(5)**2)**2 | |
39827 | &-(2D0*XM(3)*XM(5))**2 | |
39828 | S23DF1=S23DF1*EPS | |
39829 | S23DF2=S23DF2*EPS | |
39830 | S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X1) | |
39831 | F1=-2D0*S23DEL/EPS | |
39832 | S23DF1=(X2-XM(2)**2-XM(1)**2)**2 | |
39833 | &-(2D0*XM(1)*XM(2))**2 | |
39834 | S23DF2=(X2-XM(3)**2-XM(5)**2)**2 | |
39835 | &-(2D0*XM(3)*XM(5))**2 | |
39836 | S23DF1=S23DF1*EPS | |
39837 | S23DF2=S23DF2*EPS | |
39838 | S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X2) | |
39839 | F2=-2D0*S23DEL/EPS | |
39840 | ||
39841 | 170 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2)))THEN | |
39842 | C...Possibility of infinite loop with .LT.; changed to .LE. (SKANDS) | |
39843 | IF(F2.LE.F1)THEN | |
39844 | X0=X1 | |
39845 | X1=X2 | |
39846 | X2=R*X1+C*X3 | |
39847 | F1=F2 | |
39848 | S23DF1=(X2-XM(2)**2-XM(1)**2)**2 | |
39849 | & -(2D0*XM(1)*XM(2))**2 | |
39850 | S23DF2=(X2-XM(3)**2-XM(5)**2)**2 | |
39851 | & -(2D0*XM(3)*XM(5))**2 | |
39852 | S23DF1=S23DF1*EPS | |
39853 | S23DF2=S23DF2*EPS | |
39854 | S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X2) | |
39855 | F2=-2D0*S23DEL/EPS | |
39856 | ELSE | |
39857 | X3=X2 | |
39858 | X2=X1 | |
39859 | X1=R*X2+C*X0 | |
39860 | F2=F1 | |
39861 | S23DF1=(X1-XM(2)**2-XM(1)**2)**2 | |
39862 | & -(2D0*XM(1)*XM(2))**2 | |
39863 | S23DF2=(X1-XM(3)**2-XM(5)**2)**2 | |
39864 | & -(2D0*XM(3)*XM(5))**2 | |
39865 | S23DF1=S23DF1*EPS | |
39866 | S23DF2=S23DF2*EPS | |
39867 | S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X1) | |
39868 | F1=-2D0*S23DEL/EPS | |
39869 | ENDIF | |
39870 | GOTO 170 | |
39871 | ENDIF | |
39872 | C...WE WANT THE MAXIMUM, NOT THE MINIMUM | |
39873 | IF(F1.LT.F2)THEN | |
39874 | GOLDEN=-F1 | |
39875 | XMIN=X1 | |
39876 | ELSE | |
39877 | GOLDEN=-F2 | |
39878 | XMIN=X2 | |
39879 | ENDIF | |
39880 | ||
39881 | IKNT=0 | |
39882 | 180 S12=S12MIN+PYR(0)*YJACO1 | |
39883 | IKNT=IKNT+1 | |
39884 | C...GENERATE S23 | |
39885 | S23AVE=XM(2)**2+XM(3)**2-(S12+XM(2)**2-XM(1)**2) | |
39886 | &*(S12+XM(3)**2-XM(5)**2)/(2D0*S12) | |
39887 | S23DF1=(S12-XM(2)**2-XM(1)**2)**2 | |
39888 | &-(2D0*XM(1)*XM(2))**2 | |
39889 | S23DF2=(S12-XM(3)**2-XM(5)**2)**2 | |
39890 | &-(2D0*XM(3)*XM(5))**2 | |
39891 | S23DF1=S23DF1*EPS | |
39892 | S23DF2=S23DF2*EPS | |
39893 | S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*S12) | |
39894 | S23DEL=S23DEL/EPS | |
39895 | S23MIN=S23AVE-S23DEL | |
39896 | S23MAX=S23AVE+S23DEL | |
39897 | YJACO2=S23MAX-S23MIN | |
39898 | S23=S23MIN+PYR(0)*YJACO2 | |
39899 | ||
39900 | C...CHECK THE SAMPLING | |
39901 | IF(IKNT.GT.100) THEN | |
39902 | WRITE(MSTU(11),*) ' IKNT > 100 IN PYTBDY ' | |
39903 | GOTO 190 | |
39904 | ENDIF | |
39905 | IF(YJACO2.LT.PYR(0)*GOLDEN) GOTO 180 | |
39906 | ||
39907 | IF(ISKIP.EQ.0) GOTO 190 | |
39908 | ||
39909 | SH=S23 | |
39910 | TH=S12 | |
39911 | UH=ZM12+ZM22-SH-TH | |
39912 | ||
39913 | WU2 = (UH-ZM12)*(UH-ZM22) | |
39914 | WT2 = (TH-ZM12)*(TH-ZM22) | |
39915 | WS2 = XM1M2*SH | |
39916 | PROPZ2 = (SH-SQMZ)**2 + GMMZ**2 | |
39917 | PROPZ=DCMPLX(SH-SQMZ,-GMMZ)/DCMPLX(PROPZ2) | |
39918 | ||
39919 | QLL=QLLS*PROPZ+QLLU/DCMPLX(UH-XLL2) | |
39920 | QLR=QLRS*PROPZ+QLRT/DCMPLX(TH-XLR2) | |
39921 | QRL=QRLS*PROPZ+QRLT/DCMPLX(TH-XRL2) | |
39922 | QRR=QRRS*PROPZ+QRRU/DCMPLX(UH-XRR2) | |
39923 | c QLL=DCMPLX((T3I-EI*XW)/XW1)*OLPP*PROPZ-GLIJ/DCMPLX(UH-XML2) | |
39924 | c QLR=-DCMPLX((T3I-EI*XW)/XW1)*ORPP*PROPZ+DCONJG(GLIJ) | |
39925 | c &/DCMPLX(TH-XML2) | |
39926 | c QRL=-DCMPLX((EI*XW)/XW1)*OLPP*PROPZ+GRIJ/DCMPLX(TH-XMR2) | |
39927 | c QRR=DCMPLX((EI*XW)/XW1)*ORPP*PROPZ | |
39928 | c &-DCONJG(GRIJ)/DCMPLX(UH-XMR2) | |
39929 | WT=-((ABS(QLL)**2+ABS(QRR)**2)*WU2+ | |
39930 | &(ABS(QRL)**2+ABS(QLR)**2)*WT2+ | |
39931 | &2D0*DBLE(QLR*DCONJG(QLL)+QRL*DCONJG(QRR))*WS2) | |
39932 | ||
39933 | IF(WT.LT.PYR(0)*WTMAX) GOTO 180 | |
39934 | IF(WT.GT.WTMAX) PRINT*,' WT > WTMAX ',WT,WTMAX | |
39935 | ||
39936 | 190 D3=(XM(5)**2+XM(3)**2-S12)/(2D0*XM(5)) | |
39937 | D1=(XM(5)**2+XM(1)**2-S23)/(2D0*XM(5)) | |
39938 | D2=XM(5)-D1-D3 | |
39939 | P1=SQRT(D1*D1-XM(1)**2) | |
39940 | P2=SQRT(D2*D2-XM(2)**2) | |
39941 | P3=SQRT(D3*D3-XM(3)**2) | |
39942 | CTHE1=2D0*PYR(0)-1D0 | |
39943 | ANG1=2D0*PYR(0)*PARU(1) | |
39944 | CPHI1=COS(ANG1) | |
39945 | SPHI1=SIN(ANG1) | |
39946 | ARG=1D0-CTHE1**2 | |
39947 | IF(ARG.LT.0D0.AND.ARG.GT.-1D-3) ARG=0D0 | |
39948 | STHE1=SQRT(ARG) | |
39949 | P(N+1,1)=P1*STHE1*CPHI1 | |
39950 | P(N+1,2)=P1*STHE1*SPHI1 | |
39951 | P(N+1,3)=P1*CTHE1 | |
39952 | P(N+1,4)=D1 | |
39953 | ||
39954 | C...GET CPHI3 | |
39955 | ANG3=2D0*PYR(0)*PARU(1) | |
39956 | CPHI3=COS(ANG3) | |
39957 | SPHI3=SIN(ANG3) | |
39958 | CTHE3=(P2**2-P1**2-P3**2)/2D0/P1/P3 | |
39959 | ARG=1D0-CTHE3**2 | |
39960 | IF(ARG.LT.0D0.AND.ARG.GT.-1D-3) ARG=0D0 | |
39961 | STHE3=SQRT(ARG) | |
39962 | P(N+3,1)=-P3*STHE3*CPHI3*CTHE1*CPHI1 | |
39963 | &+P3*STHE3*SPHI3*SPHI1 | |
39964 | &+P3*CTHE3*STHE1*CPHI1 | |
39965 | P(N+3,2)=-P3*STHE3*CPHI3*CTHE1*SPHI1 | |
39966 | &-P3*STHE3*SPHI3*CPHI1 | |
39967 | &+P3*CTHE3*STHE1*SPHI1 | |
39968 | P(N+3,3)=P3*STHE3*CPHI3*STHE1 | |
39969 | &+P3*CTHE3*CTHE1 | |
39970 | P(N+3,4)=D3 | |
39971 | ||
39972 | DO 200 I=1,3 | |
39973 | P(N+2,I)=-P(N+1,I)-P(N+3,I) | |
39974 | 200 CONTINUE | |
39975 | P(N+2,4)=D2 | |
39976 | ||
39977 | RETURN | |
39978 | END | |
39979 | ||
39980 | C********************************************************************* | |
39981 | ||
39982 | C...PYTECM | |
39983 | C...Finds the s-hat dependent eigenvalues of the inverse propagator | |
39984 | C...matrix for gamma, Z, techni-rho, and techni-omega to optimize the | |
39985 | C...phase space generation. | |
39986 | ||
39987 | SUBROUTINE PYTECM(S1,S2) | |
39988 | ||
39989 | C...Double precision and integer declarations. | |
39990 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
39991 | IMPLICIT INTEGER(I-N) | |
39992 | INTEGER PYK,PYCHGE,PYCOMP | |
39993 | C...Parameter statement to help give large particle numbers. | |
39994 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
39995 | &KEXCIT=4000000,KDIMEN=5000000) | |
39996 | C...Commonblocks. | |
39997 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
39998 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
39999 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
40000 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
40001 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYTCSM/ | |
40002 | ||
40003 | C...Local variables. | |
40004 | DOUBLE PRECISION AR(4,4),WR(4),ZR(4,4),ZI(4,4),WORK(12,12), | |
40005 | &AT(4,4),WI(4),FV1(4),FV2(4),FV3(4),sh,aem,tanw,ct2w,qupd,alprht, | |
40006 | &far,fao,fzr,fzo,shr,R1,R2,S1,S2,WDTP(0:400),WDTE(0:400,0:5) | |
40007 | INTEGER i,j,ierr | |
40008 | ||
40009 | SH=PMAS(PYCOMP(KTECHN+113),1)**2 | |
40010 | AEM=PYALEM(SH) | |
40011 | ||
40012 | TANW=SQRT(PARU(102)/(1D0-PARU(102))) | |
40013 | CT2W=(1D0-2D0*PARU(102))/(2D0*PARU(102)/TANW) | |
40014 | QUPD=2D0*RTCM(2)-1D0 | |
40015 | ||
40016 | ALPRHT=2.91D0*(3D0/DBLE(ITCM(1))) | |
40017 | FAR=SQRT(AEM/ALPRHT) | |
40018 | FAO=FAR*QUPD | |
40019 | FZR=FAR*CT2W | |
40020 | FZO=-FAO*TANW | |
40021 | ||
40022 | AR(1,1) = SH | |
40023 | AR(2,2) = SH-PMAS(23,1)**2 | |
40024 | AR(3,3) = SH-PMAS(PYCOMP(KTECHN+113),1)**2 | |
40025 | AR(4,4) = SH-PMAS(PYCOMP(KTECHN+223),1)**2 | |
40026 | AR(1,2) = 0D0 | |
40027 | AR(2,1) = 0D0 | |
40028 | AR(1,3) = -SH*FAR | |
40029 | AR(3,1) = AR(1,3) | |
40030 | AR(1,4) = -SH*FAO | |
40031 | AR(4,1) = AR(1,4) | |
40032 | AR(2,3) = -SH*FZR | |
40033 | AR(3,2) = AR(2,3) | |
40034 | AR(2,4) = -SH*FZO | |
40035 | AR(4,2) = AR(2,4) | |
40036 | AR(3,4) = 0D0 | |
40037 | AR(4,3) = 0D0 | |
40038 | CCCCCCCC | |
40039 | DO 110 I=1,4 | |
40040 | DO 100 J=1,4 | |
40041 | AT(I,J)=0D0 | |
40042 | 100 CONTINUE | |
40043 | 110 CONTINUE | |
40044 | SHR=SQRT(SH) | |
40045 | CALL PYWIDT(23,SH,WDTP,WDTE) | |
40046 | AT(2,2) = WDTP(0)*SHR | |
40047 | CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) | |
40048 | AT(3,3) = WDTP(0)*SHR | |
40049 | CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) | |
40050 | AT(4,4) = WDTP(0)*SHR | |
40051 | CCCC | |
40052 | CALL PYEICG(4,4,AR,AT,WR,WI,0,ZR,ZI,FV1,FV2,FV3,IERR) | |
40053 | DO 120 I=1,4 | |
40054 | WI(I)=SQRT(ABS(SH-WR(I))) | |
40055 | WR(I)=ABS(WR(I)) | |
40056 | 120 CONTINUE | |
40057 | R1=MIN(WR(1),WR(2),WR(3),WR(4)) | |
40058 | R2=1D20 | |
40059 | S1=0D0 | |
40060 | S2=0D0 | |
40061 | DO 130 I=1,4 | |
40062 | IF(ABS(WR(I)-R1).LT.1D-6) THEN | |
40063 | S1=WI(I) | |
40064 | GOTO 130 | |
40065 | ENDIF | |
40066 | IF(WR(I).LE.R2) THEN | |
40067 | R2=WR(I) | |
40068 | S2=WI(I) | |
40069 | ENDIF | |
40070 | 130 CONTINUE | |
40071 | S1=S1**2 | |
40072 | S2=S2**2 | |
40073 | RETURN | |
40074 | END | |
40075 | ||
40076 | C********************************************************************* | |
40077 | ||
40078 | C...PYEIGC | |
40079 | C...Finds eigenvalues of a general complex matrix | |
40080 | C | |
40081 | C THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF | |
40082 | C SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) | |
40083 | C TO FIND THE EIGENVALUES AND EIGENVECTORS (IF DESIRED) | |
40084 | C OF A COMPLEX GENERAL MATRIX. | |
40085 | C | |
40086 | C ON INPUT | |
40087 | C | |
40088 | C NM MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL | |
40089 | C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM | |
40090 | C DIMENSION STATEMENT. | |
40091 | C | |
40092 | C N IS THE ORDER OF THE MATRIX A=(AR,AI). | |
40093 | C | |
40094 | C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40095 | C RESPECTIVELY, OF THE COMPLEX GENERAL MATRIX. | |
40096 | C | |
40097 | C MATZ IS AN INTEGER VARIABLE SET EQUAL TO ZERO IF | |
40098 | C ONLY EIGENVALUES ARE DESIRED. OTHERWISE IT IS SET TO | |
40099 | C ANY NON-ZERO INTEGER FOR BOTH EIGENVALUES AND EIGENVECTORS. | |
40100 | C | |
40101 | C ON OUTPUT | |
40102 | C | |
40103 | C WR AND WI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40104 | C RESPECTIVELY, OF THE EIGENVALUES. | |
40105 | C | |
40106 | C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40107 | C RESPECTIVELY, OF THE EIGENVECTORS IF MATZ IS NOT ZERO. | |
40108 | C | |
40109 | C IERR IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR | |
40110 | C COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR COMQR | |
40111 | C AND COMQR2. THE NORMAL COMPLETION CODE IS ZERO. | |
40112 | C | |
40113 | C FV1, FV2, AND FV3 ARE TEMPORARY STORAGE ARRAYS. | |
40114 | C | |
40115 | C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, | |
40116 | C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY | |
40117 | C | |
40118 | C THIS VERSION DATED AUGUST 1983. | |
40119 | C | |
40120 | ||
40121 | SUBROUTINE PYEICG(NM,N,AR,AI,WR,WI,MATZ,ZR,ZI,FV1,FV2,FV3,IERR) | |
40122 | ||
40123 | INTEGER N,NM,IS1,IS2,IERR,MATZ | |
40124 | DOUBLE PRECISION AR(4,4),AI(4,4),WR(4),WI(4),ZR(4,4),ZI(4,4), | |
40125 | X FV1(4),FV2(4),FV3(4) | |
40126 | IF (N .LE. NM) GOTO 100 | |
40127 | IERR = 10 * N | |
40128 | GOTO 120 | |
40129 | C | |
40130 | 100 CALL PYCBAL(NM,N,AR,AI,IS1,IS2,FV1) | |
40131 | CALL PYCRTH(NM,N,IS1,IS2,AR,AI,FV2,FV3) | |
40132 | IF (MATZ .NE. 0) GOTO 110 | |
40133 | C .......... FIND EIGENVALUES ONLY .......... | |
40134 | CALL PYCMQR(NM,N,IS1,IS2,AR,AI,WR,WI,IERR) | |
40135 | GOTO 120 | |
40136 | C .......... FIND BOTH EIGENVALUES AND EIGENVECTORS .......... | |
40137 | 110 CALL PYCMQ2(NM,N,IS1,IS2,FV2,FV3,AR,AI,WR,WI,ZR,ZI,IERR) | |
40138 | IF (IERR .NE. 0) GOTO 120 | |
40139 | CALL PYCBA2(NM,N,IS1,IS2,FV1,N,ZR,ZI) | |
40140 | 120 RETURN | |
40141 | END | |
40142 | ||
40143 | C********************************************************************* | |
40144 | ||
40145 | C...PYCMQR | |
40146 | C...Auxiliary to PYEICG. | |
40147 | C | |
40148 | C THIS SUBROUTINE IS A TRANSLATION OF A UNITARY ANALOGUE OF THE | |
40149 | C ALGOL PROCEDURE COMLR, NUM. MATH. 12, 369-376(1968) BY MARTIN | |
40150 | C AND WILKINSON. | |
40151 | C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 396-403(1971). | |
40152 | C THE UNITARY ANALOGUE SUBSTITUTES THE QR ALGORITHM OF FRANCIS | |
40153 | C (COMP. JOUR. 4, 332-345(1962)) FOR THE LR ALGORITHM. | |
40154 | C | |
40155 | C THIS SUBROUTINE FINDS THE EIGENVALUES OF A COMPLEX | |
40156 | C UPPER HESSENBERG MATRIX BY THE QR METHOD. | |
40157 | C | |
40158 | C ON INPUT | |
40159 | C | |
40160 | C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL | |
40161 | C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM | |
40162 | C DIMENSION STATEMENT. | |
40163 | C | |
40164 | C N IS THE ORDER OF THE MATRIX. | |
40165 | C | |
40166 | C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING | |
40167 | C SUBROUTINE CBAL. IF CBAL HAS NOT BEEN USED, | |
40168 | C SET LOW=1, IGH=N. | |
40169 | C | |
40170 | C HR AND HI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40171 | C RESPECTIVELY, OF THE COMPLEX UPPER HESSENBERG MATRIX. | |
40172 | C THEIR LOWER TRIANGLES BELOW THE SUBDIAGONAL CONTAIN | |
40173 | C INFORMATION ABOUT THE UNITARY TRANSFORMATIONS USED IN | |
40174 | C THE REDUCTION BY CORTH, IF PERFORMED. | |
40175 | C | |
40176 | C ON OUTPUT | |
40177 | C | |
40178 | C THE UPPER HESSENBERG PORTIONS OF HR AND HI HAVE BEEN | |
40179 | C DESTROYED. THEREFORE, THEY MUST BE SAVED BEFORE | |
40180 | C CALLING COMQR IF SUBSEQUENT CALCULATION OF | |
40181 | C EIGENVECTORS IS TO BE PERFORMED. | |
40182 | C | |
40183 | C WR AND WI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40184 | C RESPECTIVELY, OF THE EIGENVALUES. IF AN ERROR | |
40185 | C EXIT IS MADE, THE EIGENVALUES SHOULD BE CORRECT | |
40186 | C FOR INDICES IERR+1,...,N. | |
40187 | C | |
40188 | C IERR IS SET TO | |
40189 | C ZERO FOR NORMAL RETURN, | |
40190 | C J IF THE LIMIT OF 30*N ITERATIONS IS EXHAUSTED | |
40191 | C WHILE THE J-TH EIGENVALUE IS BEING SOUGHT. | |
40192 | C | |
40193 | C CALLS PYCDIV FOR COMPLEX DIVISION. | |
40194 | C CALLS PYCSRT FOR COMPLEX SQUARE ROOT. | |
40195 | C CALLS PYTHAG FOR DSQRT(A*A + B*B) . | |
40196 | C | |
40197 | C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, | |
40198 | C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY | |
40199 | C | |
40200 | C THIS VERSION DATED AUGUST 1983. | |
40201 | C | |
40202 | ||
40203 | SUBROUTINE PYCMQR(NM,N,LOW,IGH,HR,HI,WR,WI,IERR) | |
40204 | ||
40205 | INTEGER I,J,L,N,EN,LL,NM,IGH,ITN,ITS,LOW,LP1,ENM1,IERR | |
40206 | DOUBLE PRECISION HR(4,4),HI(4,4),WR(4),WI(4) | |
40207 | DOUBLE PRECISION SI,SR,TI,TR,XI,XR,YI,YR,ZZI,ZZR,NORM,TST1,TST2, | |
40208 | X PYTHAG | |
40209 | ||
40210 | IERR = 0 | |
40211 | IF (LOW .EQ. IGH) GOTO 130 | |
40212 | C .......... CREATE REAL SUBDIAGONAL ELEMENTS .......... | |
40213 | L = LOW + 1 | |
40214 | C | |
40215 | DO 120 I = L, IGH | |
40216 | LL = MIN0(I+1,IGH) | |
40217 | IF (HI(I,I-1) .EQ. 0.0D0) GOTO 120 | |
40218 | NORM = PYTHAG(HR(I,I-1),HI(I,I-1)) | |
40219 | YR = HR(I,I-1) / NORM | |
40220 | YI = HI(I,I-1) / NORM | |
40221 | HR(I,I-1) = NORM | |
40222 | HI(I,I-1) = 0.0D0 | |
40223 | C | |
40224 | DO 100 J = I, IGH | |
40225 | SI = YR * HI(I,J) - YI * HR(I,J) | |
40226 | HR(I,J) = YR * HR(I,J) + YI * HI(I,J) | |
40227 | HI(I,J) = SI | |
40228 | 100 CONTINUE | |
40229 | C | |
40230 | DO 110 J = LOW, LL | |
40231 | SI = YR * HI(J,I) + YI * HR(J,I) | |
40232 | HR(J,I) = YR * HR(J,I) - YI * HI(J,I) | |
40233 | HI(J,I) = SI | |
40234 | 110 CONTINUE | |
40235 | C | |
40236 | 120 CONTINUE | |
40237 | C .......... STORE ROOTS ISOLATED BY CBAL .......... | |
40238 | 130 DO 140 I = 1, N | |
40239 | IF (I .GE. LOW .AND. I .LE. IGH) GOTO 140 | |
40240 | WR(I) = HR(I,I) | |
40241 | WI(I) = HI(I,I) | |
40242 | 140 CONTINUE | |
40243 | C | |
40244 | EN = IGH | |
40245 | TR = 0.0D0 | |
40246 | TI = 0.0D0 | |
40247 | ITN = 30*N | |
40248 | C .......... SEARCH FOR NEXT EIGENVALUE .......... | |
40249 | 150 IF (EN .LT. LOW) GOTO 320 | |
40250 | ITS = 0 | |
40251 | ENM1 = EN - 1 | |
40252 | C .......... LOOK FOR SINGLE SMALL SUB-DIAGONAL ELEMENT | |
40253 | C FOR L=EN STEP -1 UNTIL LOW D0 -- .......... | |
40254 | 160 DO 170 LL = LOW, EN | |
40255 | L = EN + LOW - LL | |
40256 | IF (L .EQ. LOW) GOTO 180 | |
40257 | TST1 = DABS(HR(L-1,L-1)) + DABS(HI(L-1,L-1)) | |
40258 | X + DABS(HR(L,L)) + DABS(HI(L,L)) | |
40259 | TST2 = TST1 + DABS(HR(L,L-1)) | |
40260 | IF (TST2 .EQ. TST1) GOTO 180 | |
40261 | 170 CONTINUE | |
40262 | C .......... FORM SHIFT .......... | |
40263 | 180 IF (L .EQ. EN) GOTO 300 | |
40264 | IF (ITN .EQ. 0) GOTO 310 | |
40265 | IF (ITS .EQ. 10 .OR. ITS .EQ. 20) GOTO 200 | |
40266 | SR = HR(EN,EN) | |
40267 | SI = HI(EN,EN) | |
40268 | XR = HR(ENM1,EN) * HR(EN,ENM1) | |
40269 | XI = HI(ENM1,EN) * HR(EN,ENM1) | |
40270 | IF (XR .EQ. 0.0D0 .AND. XI .EQ. 0.0D0) GOTO 210 | |
40271 | YR = (HR(ENM1,ENM1) - SR) / 2.0D0 | |
40272 | YI = (HI(ENM1,ENM1) - SI) / 2.0D0 | |
40273 | CALL PYCSRT(YR**2-YI**2+XR,2.0D0*YR*YI+XI,ZZR,ZZI) | |
40274 | IF (YR * ZZR + YI * ZZI .GE. 0.0D0) GOTO 190 | |
40275 | ZZR = -ZZR | |
40276 | ZZI = -ZZI | |
40277 | 190 CALL PYCDIV(XR,XI,YR+ZZR,YI+ZZI,XR,XI) | |
40278 | SR = SR - XR | |
40279 | SI = SI - XI | |
40280 | GOTO 210 | |
40281 | C .......... FORM EXCEPTIONAL SHIFT .......... | |
40282 | 200 SR = DABS(HR(EN,ENM1)) + DABS(HR(ENM1,EN-2)) | |
40283 | SI = 0.0D0 | |
40284 | C | |
40285 | 210 DO 220 I = LOW, EN | |
40286 | HR(I,I) = HR(I,I) - SR | |
40287 | HI(I,I) = HI(I,I) - SI | |
40288 | 220 CONTINUE | |
40289 | C | |
40290 | TR = TR + SR | |
40291 | TI = TI + SI | |
40292 | ITS = ITS + 1 | |
40293 | ITN = ITN - 1 | |
40294 | C .......... REDUCE TO TRIANGLE (ROWS) .......... | |
40295 | LP1 = L + 1 | |
40296 | C | |
40297 | DO 240 I = LP1, EN | |
40298 | SR = HR(I,I-1) | |
40299 | HR(I,I-1) = 0.0D0 | |
40300 | NORM = PYTHAG(PYTHAG(HR(I-1,I-1),HI(I-1,I-1)),SR) | |
40301 | XR = HR(I-1,I-1) / NORM | |
40302 | WR(I-1) = XR | |
40303 | XI = HI(I-1,I-1) / NORM | |
40304 | WI(I-1) = XI | |
40305 | HR(I-1,I-1) = NORM | |
40306 | HI(I-1,I-1) = 0.0D0 | |
40307 | HI(I,I-1) = SR / NORM | |
40308 | C | |
40309 | DO 230 J = I, EN | |
40310 | YR = HR(I-1,J) | |
40311 | YI = HI(I-1,J) | |
40312 | ZZR = HR(I,J) | |
40313 | ZZI = HI(I,J) | |
40314 | HR(I-1,J) = XR * YR + XI * YI + HI(I,I-1) * ZZR | |
40315 | HI(I-1,J) = XR * YI - XI * YR + HI(I,I-1) * ZZI | |
40316 | HR(I,J) = XR * ZZR - XI * ZZI - HI(I,I-1) * YR | |
40317 | HI(I,J) = XR * ZZI + XI * ZZR - HI(I,I-1) * YI | |
40318 | 230 CONTINUE | |
40319 | C | |
40320 | 240 CONTINUE | |
40321 | C | |
40322 | SI = HI(EN,EN) | |
40323 | IF (SI .EQ. 0.0D0) GOTO 250 | |
40324 | NORM = PYTHAG(HR(EN,EN),SI) | |
40325 | SR = HR(EN,EN) / NORM | |
40326 | SI = SI / NORM | |
40327 | HR(EN,EN) = NORM | |
40328 | HI(EN,EN) = 0.0D0 | |
40329 | C .......... INVERSE OPERATION (COLUMNS) .......... | |
40330 | 250 DO 280 J = LP1, EN | |
40331 | XR = WR(J-1) | |
40332 | XI = WI(J-1) | |
40333 | C | |
40334 | DO 270 I = L, J | |
40335 | YR = HR(I,J-1) | |
40336 | YI = 0.0D0 | |
40337 | ZZR = HR(I,J) | |
40338 | ZZI = HI(I,J) | |
40339 | IF (I .EQ. J) GOTO 260 | |
40340 | YI = HI(I,J-1) | |
40341 | HI(I,J-1) = XR * YI + XI * YR + HI(J,J-1) * ZZI | |
40342 | 260 HR(I,J-1) = XR * YR - XI * YI + HI(J,J-1) * ZZR | |
40343 | HR(I,J) = XR * ZZR + XI * ZZI - HI(J,J-1) * YR | |
40344 | HI(I,J) = XR * ZZI - XI * ZZR - HI(J,J-1) * YI | |
40345 | 270 CONTINUE | |
40346 | C | |
40347 | 280 CONTINUE | |
40348 | C | |
40349 | IF (SI .EQ. 0.0D0) GOTO 160 | |
40350 | C | |
40351 | DO 290 I = L, EN | |
40352 | YR = HR(I,EN) | |
40353 | YI = HI(I,EN) | |
40354 | HR(I,EN) = SR * YR - SI * YI | |
40355 | HI(I,EN) = SR * YI + SI * YR | |
40356 | 290 CONTINUE | |
40357 | C | |
40358 | GOTO 160 | |
40359 | C .......... A ROOT FOUND .......... | |
40360 | 300 WR(EN) = HR(EN,EN) + TR | |
40361 | WI(EN) = HI(EN,EN) + TI | |
40362 | EN = ENM1 | |
40363 | GOTO 150 | |
40364 | C .......... SET ERROR -- ALL EIGENVALUES HAVE NOT | |
40365 | C CONVERGED AFTER 30*N ITERATIONS .......... | |
40366 | 310 IERR = EN | |
40367 | 320 RETURN | |
40368 | END | |
40369 | ||
40370 | C********************************************************************* | |
40371 | ||
40372 | C...PYCMQ2 | |
40373 | C...Auxiliary to PYEICG. | |
40374 | C | |
40375 | C THIS SUBROUTINE IS A TRANSLATION OF A UNITARY ANALOGUE OF THE | |
40376 | C ALGOL PROCEDURE COMLR2, NUM. MATH. 16, 181-204(1970) BY PETERS | |
40377 | C AND WILKINSON. | |
40378 | C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 372-395(1971). | |
40379 | C THE UNITARY ANALOGUE SUBSTITUTES THE QR ALGORITHM OF FRANCIS | |
40380 | C (COMP. JOUR. 4, 332-345(1962)) FOR THE LR ALGORITHM. | |
40381 | C | |
40382 | C THIS SUBROUTINE FINDS THE EIGENVALUES AND EIGENVECTORS | |
40383 | C OF A COMPLEX UPPER HESSENBERG MATRIX BY THE QR | |
40384 | C METHOD. THE EIGENVECTORS OF A COMPLEX GENERAL MATRIX | |
40385 | C CAN ALSO BE FOUND IF CORTH HAS BEEN USED TO REDUCE | |
40386 | C THIS GENERAL MATRIX TO HESSENBERG FORM. | |
40387 | C | |
40388 | C ON INPUT | |
40389 | C | |
40390 | C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL | |
40391 | C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM | |
40392 | C DIMENSION STATEMENT. | |
40393 | C | |
40394 | C N IS THE ORDER OF THE MATRIX. | |
40395 | C | |
40396 | C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING | |
40397 | C SUBROUTINE CBAL. IF CBAL HAS NOT BEEN USED, | |
40398 | C SET LOW=1, IGH=N. | |
40399 | C | |
40400 | C ORTR AND ORTI CONTAIN INFORMATION ABOUT THE UNITARY TRANS- | |
40401 | C FORMATIONS USED IN THE REDUCTION BY CORTH, IF PERFORMED. | |
40402 | C ONLY ELEMENTS LOW THROUGH IGH ARE USED. IF THE EIGENVECTORS | |
40403 | C OF THE HESSENBERG MATRIX ARE DESIRED, SET ORTR(J) AND | |
40404 | C ORTI(J) TO 0.0D0 FOR THESE ELEMENTS. | |
40405 | C | |
40406 | C HR AND HI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40407 | C RESPECTIVELY, OF THE COMPLEX UPPER HESSENBERG MATRIX. | |
40408 | C THEIR LOWER TRIANGLES BELOW THE SUBDIAGONAL CONTAIN FURTHER | |
40409 | C INFORMATION ABOUT THE TRANSFORMATIONS WHICH WERE USED IN THE | |
40410 | C REDUCTION BY CORTH, IF PERFORMED. IF THE EIGENVECTORS OF | |
40411 | C THE HESSENBERG MATRIX ARE DESIRED, THESE ELEMENTS MAY BE | |
40412 | C ARBITRARY. | |
40413 | C | |
40414 | C ON OUTPUT | |
40415 | C | |
40416 | C ORTR, ORTI, AND THE UPPER HESSENBERG PORTIONS OF HR AND HI | |
40417 | C HAVE BEEN DESTROYED. | |
40418 | C | |
40419 | C WR AND WI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40420 | C RESPECTIVELY, OF THE EIGENVALUES. IF AN ERROR | |
40421 | C EXIT IS MADE, THE EIGENVALUES SHOULD BE CORRECT | |
40422 | C FOR INDICES IERR+1,...,N. | |
40423 | C | |
40424 | C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40425 | C RESPECTIVELY, OF THE EIGENVECTORS. THE EIGENVECTORS | |
40426 | C ARE UNNORMALIZED. IF AN ERROR EXIT IS MADE, NONE OF | |
40427 | C THE EIGENVECTORS HAS BEEN FOUND. | |
40428 | C | |
40429 | C IERR IS SET TO | |
40430 | C ZERO FOR NORMAL RETURN, | |
40431 | C J IF THE LIMIT OF 30*N ITERATIONS IS EXHAUSTED | |
40432 | C WHILE THE J-TH EIGENVALUE IS BEING SOUGHT. | |
40433 | C | |
40434 | C CALLS PYCDIV FOR COMPLEX DIVISION. | |
40435 | C CALLS PYCSRT FOR COMPLEX SQUARE ROOT. | |
40436 | C CALLS PYTHAG FOR DSQRT(A*A + B*B) . | |
40437 | C | |
40438 | C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, | |
40439 | C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY | |
40440 | C | |
40441 | C THIS VERSION DATED OCTOBER 1989. | |
40442 | C | |
40443 | C MESHED OVERFLOW CONTROL WITH VECTORS OF ISOLATED ROOTS (10/19/89 BSG) | |
40444 | C MESHED OVERFLOW CONTROL WITH TRIANGULAR MULTIPLY (10/30/89 BSG) | |
40445 | C | |
40446 | ||
40447 | SUBROUTINE PYCMQ2(NM,N,LOW,IGH,ORTR,ORTI,HR,HI,WR,WI,ZR,ZI,IERR) | |
40448 | ||
40449 | INTEGER I,J,K,L,M,N,EN,II,JJ,LL,NM,NN,IGH,IP1, | |
40450 | X ITN,ITS,LOW,LP1,ENM1,IEND,IERR | |
40451 | DOUBLE PRECISION HR(4,4),HI(4,4),WR(4),WI(4),ZR(4,4),ZI(4,4), | |
40452 | X ORTR(4),ORTI(4) | |
40453 | DOUBLE PRECISION SI,SR,TI,TR,XI,XR,YI,YR,ZZI,ZZR,NORM,TST1,TST2, | |
40454 | X PYTHAG | |
40455 | ||
40456 | IERR = 0 | |
40457 | C .......... INITIALIZE EIGENVECTOR MATRIX .......... | |
40458 | DO 110 J = 1, N | |
40459 | C | |
40460 | DO 100 I = 1, N | |
40461 | ZR(I,J) = 0.0D0 | |
40462 | ZI(I,J) = 0.0D0 | |
40463 | 100 CONTINUE | |
40464 | ZR(J,J) = 1.0D0 | |
40465 | 110 CONTINUE | |
40466 | C .......... FORM THE MATRIX OF ACCUMULATED TRANSFORMATIONS | |
40467 | C FROM THE INFORMATION LEFT BY CORTH .......... | |
40468 | IEND = IGH - LOW - 1 | |
40469 | IF (IEND.LT.0) GOTO 220 | |
40470 | IF (IEND.EQ.0) GOTO 170 | |
40471 | C .......... FOR I=IGH-1 STEP -1 UNTIL LOW+1 DO -- .......... | |
40472 | DO 160 II = 1, IEND | |
40473 | I = IGH - II | |
40474 | IF (ORTR(I) .EQ. 0.0D0 .AND. ORTI(I) .EQ. 0.0D0) GOTO 160 | |
40475 | IF (HR(I,I-1) .EQ. 0.0D0 .AND. HI(I,I-1) .EQ. 0.0D0) GOTO 160 | |
40476 | C .......... NORM BELOW IS NEGATIVE OF H FORMED IN CORTH .......... | |
40477 | NORM = HR(I,I-1) * ORTR(I) + HI(I,I-1) * ORTI(I) | |
40478 | IP1 = I + 1 | |
40479 | C | |
40480 | DO 120 K = IP1, IGH | |
40481 | ORTR(K) = HR(K,I-1) | |
40482 | ORTI(K) = HI(K,I-1) | |
40483 | 120 CONTINUE | |
40484 | C | |
40485 | DO 150 J = I, IGH | |
40486 | SR = 0.0D0 | |
40487 | SI = 0.0D0 | |
40488 | C | |
40489 | DO 130 K = I, IGH | |
40490 | SR = SR + ORTR(K) * ZR(K,J) + ORTI(K) * ZI(K,J) | |
40491 | SI = SI + ORTR(K) * ZI(K,J) - ORTI(K) * ZR(K,J) | |
40492 | 130 CONTINUE | |
40493 | C | |
40494 | SR = SR / NORM | |
40495 | SI = SI / NORM | |
40496 | C | |
40497 | DO 140 K = I, IGH | |
40498 | ZR(K,J) = ZR(K,J) + SR * ORTR(K) - SI * ORTI(K) | |
40499 | ZI(K,J) = ZI(K,J) + SR * ORTI(K) + SI * ORTR(K) | |
40500 | 140 CONTINUE | |
40501 | C | |
40502 | 150 CONTINUE | |
40503 | C | |
40504 | 160 CONTINUE | |
40505 | C .......... CREATE REAL SUBDIAGONAL ELEMENTS .......... | |
40506 | 170 L = LOW + 1 | |
40507 | C | |
40508 | DO 210 I = L, IGH | |
40509 | LL = MIN0(I+1,IGH) | |
40510 | IF (HI(I,I-1) .EQ. 0.0D0) GOTO 210 | |
40511 | NORM = PYTHAG(HR(I,I-1),HI(I,I-1)) | |
40512 | YR = HR(I,I-1) / NORM | |
40513 | YI = HI(I,I-1) / NORM | |
40514 | HR(I,I-1) = NORM | |
40515 | HI(I,I-1) = 0.0D0 | |
40516 | C | |
40517 | DO 180 J = I, N | |
40518 | SI = YR * HI(I,J) - YI * HR(I,J) | |
40519 | HR(I,J) = YR * HR(I,J) + YI * HI(I,J) | |
40520 | HI(I,J) = SI | |
40521 | 180 CONTINUE | |
40522 | C | |
40523 | DO 190 J = 1, LL | |
40524 | SI = YR * HI(J,I) + YI * HR(J,I) | |
40525 | HR(J,I) = YR * HR(J,I) - YI * HI(J,I) | |
40526 | HI(J,I) = SI | |
40527 | 190 CONTINUE | |
40528 | C | |
40529 | DO 200 J = LOW, IGH | |
40530 | SI = YR * ZI(J,I) + YI * ZR(J,I) | |
40531 | ZR(J,I) = YR * ZR(J,I) - YI * ZI(J,I) | |
40532 | ZI(J,I) = SI | |
40533 | 200 CONTINUE | |
40534 | C | |
40535 | 210 CONTINUE | |
40536 | C .......... STORE ROOTS ISOLATED BY CBAL .......... | |
40537 | 220 DO 230 I = 1, N | |
40538 | IF (I .GE. LOW .AND. I .LE. IGH) GOTO 230 | |
40539 | WR(I) = HR(I,I) | |
40540 | WI(I) = HI(I,I) | |
40541 | 230 CONTINUE | |
40542 | C | |
40543 | EN = IGH | |
40544 | TR = 0.0D0 | |
40545 | TI = 0.0D0 | |
40546 | ITN = 30*N | |
40547 | C .......... SEARCH FOR NEXT EIGENVALUE .......... | |
40548 | 240 IF (EN .LT. LOW) GOTO 430 | |
40549 | ITS = 0 | |
40550 | ENM1 = EN - 1 | |
40551 | C .......... LOOK FOR SINGLE SMALL SUB-DIAGONAL ELEMENT | |
40552 | C FOR L=EN STEP -1 UNTIL LOW DO -- .......... | |
40553 | 250 DO 260 LL = LOW, EN | |
40554 | L = EN + LOW - LL | |
40555 | IF (L .EQ. LOW) GOTO 270 | |
40556 | TST1 = DABS(HR(L-1,L-1)) + DABS(HI(L-1,L-1)) | |
40557 | X + DABS(HR(L,L)) + DABS(HI(L,L)) | |
40558 | TST2 = TST1 + DABS(HR(L,L-1)) | |
40559 | IF (TST2 .EQ. TST1) GOTO 270 | |
40560 | 260 CONTINUE | |
40561 | C .......... FORM SHIFT .......... | |
40562 | 270 IF (L .EQ. EN) GOTO 420 | |
40563 | IF (ITN .EQ. 0) GOTO 550 | |
40564 | IF (ITS .EQ. 10 .OR. ITS .EQ. 20) GOTO 290 | |
40565 | SR = HR(EN,EN) | |
40566 | SI = HI(EN,EN) | |
40567 | XR = HR(ENM1,EN) * HR(EN,ENM1) | |
40568 | XI = HI(ENM1,EN) * HR(EN,ENM1) | |
40569 | IF (XR .EQ. 0.0D0 .AND. XI .EQ. 0.0D0) GOTO 300 | |
40570 | YR = (HR(ENM1,ENM1) - SR) / 2.0D0 | |
40571 | YI = (HI(ENM1,ENM1) - SI) / 2.0D0 | |
40572 | CALL PYCSRT(YR**2-YI**2+XR,2.0D0*YR*YI+XI,ZZR,ZZI) | |
40573 | IF (YR * ZZR + YI * ZZI .GE. 0.0D0) GOTO 280 | |
40574 | ZZR = -ZZR | |
40575 | ZZI = -ZZI | |
40576 | 280 CALL PYCDIV(XR,XI,YR+ZZR,YI+ZZI,XR,XI) | |
40577 | SR = SR - XR | |
40578 | SI = SI - XI | |
40579 | GOTO 300 | |
40580 | C .......... FORM EXCEPTIONAL SHIFT .......... | |
40581 | 290 SR = DABS(HR(EN,ENM1)) + DABS(HR(ENM1,EN-2)) | |
40582 | SI = 0.0D0 | |
40583 | C | |
40584 | 300 DO 310 I = LOW, EN | |
40585 | HR(I,I) = HR(I,I) - SR | |
40586 | HI(I,I) = HI(I,I) - SI | |
40587 | 310 CONTINUE | |
40588 | C | |
40589 | TR = TR + SR | |
40590 | TI = TI + SI | |
40591 | ITS = ITS + 1 | |
40592 | ITN = ITN - 1 | |
40593 | C .......... REDUCE TO TRIANGLE (ROWS) .......... | |
40594 | LP1 = L + 1 | |
40595 | C | |
40596 | DO 330 I = LP1, EN | |
40597 | SR = HR(I,I-1) | |
40598 | HR(I,I-1) = 0.0D0 | |
40599 | NORM = PYTHAG(PYTHAG(HR(I-1,I-1),HI(I-1,I-1)),SR) | |
40600 | XR = HR(I-1,I-1) / NORM | |
40601 | WR(I-1) = XR | |
40602 | XI = HI(I-1,I-1) / NORM | |
40603 | WI(I-1) = XI | |
40604 | HR(I-1,I-1) = NORM | |
40605 | HI(I-1,I-1) = 0.0D0 | |
40606 | HI(I,I-1) = SR / NORM | |
40607 | C | |
40608 | DO 320 J = I, N | |
40609 | YR = HR(I-1,J) | |
40610 | YI = HI(I-1,J) | |
40611 | ZZR = HR(I,J) | |
40612 | ZZI = HI(I,J) | |
40613 | HR(I-1,J) = XR * YR + XI * YI + HI(I,I-1) * ZZR | |
40614 | HI(I-1,J) = XR * YI - XI * YR + HI(I,I-1) * ZZI | |
40615 | HR(I,J) = XR * ZZR - XI * ZZI - HI(I,I-1) * YR | |
40616 | HI(I,J) = XR * ZZI + XI * ZZR - HI(I,I-1) * YI | |
40617 | 320 CONTINUE | |
40618 | C | |
40619 | 330 CONTINUE | |
40620 | C | |
40621 | SI = HI(EN,EN) | |
40622 | IF (SI .EQ. 0.0D0) GOTO 350 | |
40623 | NORM = PYTHAG(HR(EN,EN),SI) | |
40624 | SR = HR(EN,EN) / NORM | |
40625 | SI = SI / NORM | |
40626 | HR(EN,EN) = NORM | |
40627 | HI(EN,EN) = 0.0D0 | |
40628 | IF (EN .EQ. N) GOTO 350 | |
40629 | IP1 = EN + 1 | |
40630 | C | |
40631 | DO 340 J = IP1, N | |
40632 | YR = HR(EN,J) | |
40633 | YI = HI(EN,J) | |
40634 | HR(EN,J) = SR * YR + SI * YI | |
40635 | HI(EN,J) = SR * YI - SI * YR | |
40636 | 340 CONTINUE | |
40637 | C .......... INVERSE OPERATION (COLUMNS) .......... | |
40638 | 350 DO 390 J = LP1, EN | |
40639 | XR = WR(J-1) | |
40640 | XI = WI(J-1) | |
40641 | C | |
40642 | DO 370 I = 1, J | |
40643 | YR = HR(I,J-1) | |
40644 | YI = 0.0D0 | |
40645 | ZZR = HR(I,J) | |
40646 | ZZI = HI(I,J) | |
40647 | IF (I .EQ. J) GOTO 360 | |
40648 | YI = HI(I,J-1) | |
40649 | HI(I,J-1) = XR * YI + XI * YR + HI(J,J-1) * ZZI | |
40650 | 360 HR(I,J-1) = XR * YR - XI * YI + HI(J,J-1) * ZZR | |
40651 | HR(I,J) = XR * ZZR + XI * ZZI - HI(J,J-1) * YR | |
40652 | HI(I,J) = XR * ZZI - XI * ZZR - HI(J,J-1) * YI | |
40653 | 370 CONTINUE | |
40654 | C | |
40655 | DO 380 I = LOW, IGH | |
40656 | YR = ZR(I,J-1) | |
40657 | YI = ZI(I,J-1) | |
40658 | ZZR = ZR(I,J) | |
40659 | ZZI = ZI(I,J) | |
40660 | ZR(I,J-1) = XR * YR - XI * YI + HI(J,J-1) * ZZR | |
40661 | ZI(I,J-1) = XR * YI + XI * YR + HI(J,J-1) * ZZI | |
40662 | ZR(I,J) = XR * ZZR + XI * ZZI - HI(J,J-1) * YR | |
40663 | ZI(I,J) = XR * ZZI - XI * ZZR - HI(J,J-1) * YI | |
40664 | 380 CONTINUE | |
40665 | C | |
40666 | 390 CONTINUE | |
40667 | C | |
40668 | IF (SI .EQ. 0.0D0) GOTO 250 | |
40669 | C | |
40670 | DO 400 I = 1, EN | |
40671 | YR = HR(I,EN) | |
40672 | YI = HI(I,EN) | |
40673 | HR(I,EN) = SR * YR - SI * YI | |
40674 | HI(I,EN) = SR * YI + SI * YR | |
40675 | 400 CONTINUE | |
40676 | C | |
40677 | DO 410 I = LOW, IGH | |
40678 | YR = ZR(I,EN) | |
40679 | YI = ZI(I,EN) | |
40680 | ZR(I,EN) = SR * YR - SI * YI | |
40681 | ZI(I,EN) = SR * YI + SI * YR | |
40682 | 410 CONTINUE | |
40683 | C | |
40684 | GOTO 250 | |
40685 | C .......... A ROOT FOUND .......... | |
40686 | 420 HR(EN,EN) = HR(EN,EN) + TR | |
40687 | WR(EN) = HR(EN,EN) | |
40688 | HI(EN,EN) = HI(EN,EN) + TI | |
40689 | WI(EN) = HI(EN,EN) | |
40690 | EN = ENM1 | |
40691 | GOTO 240 | |
40692 | C .......... ALL ROOTS FOUND. BACKSUBSTITUTE TO FIND | |
40693 | C VECTORS OF UPPER TRIANGULAR FORM .......... | |
40694 | 430 NORM = 0.0D0 | |
40695 | C | |
40696 | DO 440 I = 1, N | |
40697 | C | |
40698 | DO 440 J = I, N | |
40699 | TR = DABS(HR(I,J)) + DABS(HI(I,J)) | |
40700 | IF (TR .GT. NORM) NORM = TR | |
40701 | 440 CONTINUE | |
40702 | C | |
40703 | IF (N .EQ. 1 .OR. NORM .EQ. 0.0D0) GOTO 560 | |
40704 | C .......... FOR EN=N STEP -1 UNTIL 2 DO -- .......... | |
40705 | DO 500 NN = 2, N | |
40706 | EN = N + 2 - NN | |
40707 | XR = WR(EN) | |
40708 | XI = WI(EN) | |
40709 | HR(EN,EN) = 1.0D0 | |
40710 | HI(EN,EN) = 0.0D0 | |
40711 | ENM1 = EN - 1 | |
40712 | C .......... FOR I=EN-1 STEP -1 UNTIL 1 DO -- .......... | |
40713 | DO 490 II = 1, ENM1 | |
40714 | I = EN - II | |
40715 | ZZR = 0.0D0 | |
40716 | ZZI = 0.0D0 | |
40717 | IP1 = I + 1 | |
40718 | C | |
40719 | DO 450 J = IP1, EN | |
40720 | ZZR = ZZR + HR(I,J) * HR(J,EN) - HI(I,J) * HI(J,EN) | |
40721 | ZZI = ZZI + HR(I,J) * HI(J,EN) + HI(I,J) * HR(J,EN) | |
40722 | 450 CONTINUE | |
40723 | C | |
40724 | YR = XR - WR(I) | |
40725 | YI = XI - WI(I) | |
40726 | IF (YR .NE. 0.0D0 .OR. YI .NE. 0.0D0) GOTO 470 | |
40727 | TST1 = NORM | |
40728 | YR = TST1 | |
40729 | 460 YR = 0.01D0 * YR | |
40730 | TST2 = NORM + YR | |
40731 | IF (TST2 .GT. TST1) GOTO 460 | |
40732 | 470 CONTINUE | |
40733 | CALL PYCDIV(ZZR,ZZI,YR,YI,HR(I,EN),HI(I,EN)) | |
40734 | C .......... OVERFLOW CONTROL .......... | |
40735 | TR = DABS(HR(I,EN)) + DABS(HI(I,EN)) | |
40736 | IF (TR .EQ. 0.0D0) GOTO 490 | |
40737 | TST1 = TR | |
40738 | TST2 = TST1 + 1.0D0/TST1 | |
40739 | IF (TST2 .GT. TST1) GOTO 490 | |
40740 | DO 480 J = I, EN | |
40741 | HR(J,EN) = HR(J,EN)/TR | |
40742 | HI(J,EN) = HI(J,EN)/TR | |
40743 | 480 CONTINUE | |
40744 | C | |
40745 | 490 CONTINUE | |
40746 | C | |
40747 | 500 CONTINUE | |
40748 | C .......... END BACKSUBSTITUTION .......... | |
40749 | C .......... VECTORS OF ISOLATED ROOTS .......... | |
40750 | DO 520 I = 1, N | |
40751 | IF (I .GE. LOW .AND. I .LE. IGH) GOTO 520 | |
40752 | C | |
40753 | DO 510 J = I, N | |
40754 | ZR(I,J) = HR(I,J) | |
40755 | ZI(I,J) = HI(I,J) | |
40756 | 510 CONTINUE | |
40757 | C | |
40758 | 520 CONTINUE | |
40759 | C .......... MULTIPLY BY TRANSFORMATION MATRIX TO GIVE | |
40760 | C VECTORS OF ORIGINAL FULL MATRIX. | |
40761 | C FOR J=N STEP -1 UNTIL LOW DO -- .......... | |
40762 | DO 540 JJ = LOW, N | |
40763 | J = N + LOW - JJ | |
40764 | M = MIN0(J,IGH) | |
40765 | C | |
40766 | DO 540 I = LOW, IGH | |
40767 | ZZR = 0.0D0 | |
40768 | ZZI = 0.0D0 | |
40769 | C | |
40770 | DO 530 K = LOW, M | |
40771 | ZZR = ZZR + ZR(I,K) * HR(K,J) - ZI(I,K) * HI(K,J) | |
40772 | ZZI = ZZI + ZR(I,K) * HI(K,J) + ZI(I,K) * HR(K,J) | |
40773 | 530 CONTINUE | |
40774 | C | |
40775 | ZR(I,J) = ZZR | |
40776 | ZI(I,J) = ZZI | |
40777 | 540 CONTINUE | |
40778 | C | |
40779 | GOTO 560 | |
40780 | C .......... SET ERROR -- ALL EIGENVALUES HAVE NOT | |
40781 | C CONVERGED AFTER 30*N ITERATIONS .......... | |
40782 | 550 IERR = EN | |
40783 | 560 RETURN | |
40784 | END | |
40785 | ||
40786 | C********************************************************************* | |
40787 | ||
40788 | C...PYCDIV | |
40789 | C...Auxiliary to PYCMQR | |
40790 | C | |
40791 | C COMPLEX DIVISION, (CR,CI) = (AR,AI)/(BR,BI) | |
40792 | C | |
40793 | ||
40794 | SUBROUTINE PYCDIV(AR,AI,BR,BI,CR,CI) | |
40795 | ||
40796 | DOUBLE PRECISION AR,AI,BR,BI,CR,CI | |
40797 | DOUBLE PRECISION S,ARS,AIS,BRS,BIS | |
40798 | ||
40799 | S = DABS(BR) + DABS(BI) | |
40800 | ARS = AR/S | |
40801 | AIS = AI/S | |
40802 | BRS = BR/S | |
40803 | BIS = BI/S | |
40804 | S = BRS**2 + BIS**2 | |
40805 | CR = (ARS*BRS + AIS*BIS)/S | |
40806 | CI = (AIS*BRS - ARS*BIS)/S | |
40807 | RETURN | |
40808 | END | |
40809 | ||
40810 | C********************************************************************* | |
40811 | ||
40812 | C...PYCSRT | |
40813 | C...Auxiliary to PYCMQR | |
40814 | C | |
40815 | C (YR,YI) = COMPLEX DSQRT(XR,XI) | |
40816 | C BRANCH CHOSEN SO THAT YR .GE. 0.0 AND SIGN(YI) .EQ. SIGN(XI) | |
40817 | C | |
40818 | ||
40819 | SUBROUTINE PYCSRT(XR,XI,YR,YI) | |
40820 | ||
40821 | DOUBLE PRECISION XR,XI,YR,YI | |
40822 | DOUBLE PRECISION S,TR,TI,PYTHAG | |
40823 | ||
40824 | TR = XR | |
40825 | TI = XI | |
40826 | S = DSQRT(0.5D0*(PYTHAG(TR,TI) + DABS(TR))) | |
40827 | IF (TR .GE. 0.0D0) YR = S | |
40828 | IF (TI .LT. 0.0D0) S = -S | |
40829 | IF (TR .LE. 0.0D0) YI = S | |
40830 | IF (TR .LT. 0.0D0) YR = 0.5D0*(TI/YI) | |
40831 | IF (TR .GT. 0.0D0) YI = 0.5D0*(TI/YR) | |
40832 | RETURN | |
40833 | END | |
40834 | ||
40835 | DOUBLE PRECISION FUNCTION PYTHAG(A,B) | |
40836 | DOUBLE PRECISION A,B | |
40837 | C | |
40838 | C FINDS DSQRT(A**2+B**2) WITHOUT OVERFLOW OR DESTRUCTIVE UNDERFLOW | |
40839 | C | |
40840 | DOUBLE PRECISION P,R,S,T,U | |
40841 | P = DMAX1(DABS(A),DABS(B)) | |
40842 | IF (P .EQ. 0.0D0) GOTO 110 | |
40843 | R = (DMIN1(DABS(A),DABS(B))/P)**2 | |
40844 | 100 CONTINUE | |
40845 | T = 4.0D0 + R | |
40846 | IF (T .EQ. 4.0D0) GOTO 110 | |
40847 | S = R/T | |
40848 | U = 1.0D0 + 2.0D0*S | |
40849 | P = U*P | |
40850 | R = (S/U)**2 * R | |
40851 | GOTO 100 | |
40852 | 110 PYTHAG = P | |
40853 | RETURN | |
40854 | END | |
40855 | ||
40856 | C********************************************************************* | |
40857 | ||
40858 | C...PYCBAL | |
40859 | C...Auxiliary to PYEICG | |
40860 | C | |
40861 | C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE | |
40862 | C CBALANCE, WHICH IS A COMPLEX VERSION OF BALANCE, | |
40863 | C NUM. MATH. 13, 293-304(1969) BY PARLETT AND REINSCH. | |
40864 | C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 315-326(1971). | |
40865 | C | |
40866 | C THIS SUBROUTINE BALANCES A COMPLEX MATRIX AND ISOLATES | |
40867 | C EIGENVALUES WHENEVER POSSIBLE. | |
40868 | C | |
40869 | C ON INPUT | |
40870 | C | |
40871 | C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL | |
40872 | C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM | |
40873 | C DIMENSION STATEMENT. | |
40874 | C | |
40875 | C N IS THE ORDER OF THE MATRIX. | |
40876 | C | |
40877 | C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40878 | C RESPECTIVELY, OF THE COMPLEX MATRIX TO BE BALANCED. | |
40879 | C | |
40880 | C ON OUTPUT | |
40881 | C | |
40882 | C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, | |
40883 | C RESPECTIVELY, OF THE BALANCED MATRIX. | |
40884 | C | |
40885 | C LOW AND IGH ARE TWO INTEGERS SUCH THAT AR(I,J) AND AI(I,J) | |
40886 | C ARE EQUAL TO ZERO IF | |
40887 | C (1) I IS GREATER THAN J AND | |
40888 | C (2) J=1,...,LOW-1 OR I=IGH+1,...,N. | |
40889 | C | |
40890 | C SCALE CONTAINS INFORMATION DETERMINING THE | |
40891 | C PERMUTATIONS AND SCALING FACTORS USED. | |
40892 | C | |
40893 | C SUPPOSE THAT THE PRINCIPAL SUBMATRIX IN ROWS LOW THROUGH IGH | |
40894 | C HAS BEEN BALANCED, THAT P(J) DENOTES THE INDEX INTERCHANGED | |
40895 | C WITH J DURING THE PERMUTATION STEP, AND THAT THE ELEMENTS | |
40896 | C OF THE DIAGONAL MATRIX USED ARE DENOTED BY D(I,J). THEN | |
40897 | C SCALE(J) = P(J), FOR J = 1,...,LOW-1 | |
40898 | C = D(J,J) J = LOW,...,IGH | |
40899 | C = P(J) J = IGH+1,...,N. | |
40900 | C THE ORDER IN WHICH THE INTERCHANGES ARE MADE IS N TO IGH+1, | |
40901 | C THEN 1 TO LOW-1. | |
40902 | C | |
40903 | C NOTE THAT 1 IS RETURNED FOR IGH IF IGH IS ZERO FORMALLY. | |
40904 | C | |
40905 | C THE ALGOL PROCEDURE EXC CONTAINED IN CBALANCE APPEARS IN | |
40906 | C CBAL IN LINE. (NOTE THAT THE ALGOL ROLES OF IDENTIFIERS | |
40907 | C K,L HAVE BEEN REVERSED.) | |
40908 | C | |
40909 | C ARITHMETIC IS REAL THROUGHOUT. | |
40910 | C | |
40911 | C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, | |
40912 | C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY | |
40913 | C | |
40914 | C THIS VERSION DATED AUGUST 1983. | |
40915 | C | |
40916 | ||
40917 | SUBROUTINE PYCBAL(NM,N,AR,AI,LOW,IGH,SCALE) | |
40918 | ||
40919 | INTEGER I,J,K,L,M,N,JJ,NM,IGH,LOW,IEXC | |
40920 | DOUBLE PRECISION AR(4,4),AI(4,4),SCALE(4) | |
40921 | DOUBLE PRECISION C,F,G,R,S,B2,RADIX | |
40922 | LOGICAL NOCONV | |
40923 | ||
40924 | RADIX = 16.0D0 | |
40925 | C | |
40926 | B2 = RADIX * RADIX | |
40927 | K = 1 | |
40928 | L = N | |
40929 | GOTO 150 | |
40930 | C .......... IN-LINE PROCEDURE FOR ROW AND | |
40931 | C COLUMN EXCHANGE .......... | |
40932 | 100 SCALE(M) = J | |
40933 | IF (J .EQ. M) GOTO 130 | |
40934 | C | |
40935 | DO 110 I = 1, L | |
40936 | F = AR(I,J) | |
40937 | AR(I,J) = AR(I,M) | |
40938 | AR(I,M) = F | |
40939 | F = AI(I,J) | |
40940 | AI(I,J) = AI(I,M) | |
40941 | AI(I,M) = F | |
40942 | 110 CONTINUE | |
40943 | C | |
40944 | DO 120 I = K, N | |
40945 | F = AR(J,I) | |
40946 | AR(J,I) = AR(M,I) | |
40947 | AR(M,I) = F | |
40948 | F = AI(J,I) | |
40949 | AI(J,I) = AI(M,I) | |
40950 | AI(M,I) = F | |
40951 | 120 CONTINUE | |
40952 | C | |
40953 | 130 IF(IEXC.EQ.1) GOTO 140 | |
40954 | IF(IEXC.EQ.2) GOTO 180 | |
40955 | C .......... SEARCH FOR ROWS ISOLATING AN EIGENVALUE | |
40956 | C AND PUSH THEM DOWN .......... | |
40957 | 140 IF (L .EQ. 1) GOTO 320 | |
40958 | L = L - 1 | |
40959 | C .......... FOR J=L STEP -1 UNTIL 1 DO -- .......... | |
40960 | 150 DO 170 JJ = 1, L | |
40961 | J = L + 1 - JJ | |
40962 | C | |
40963 | DO 160 I = 1, L | |
40964 | IF (I .EQ. J) GOTO 160 | |
40965 | IF (AR(J,I) .NE. 0.0D0 .OR. AI(J,I) .NE. 0.0D0) GOTO 170 | |
40966 | 160 CONTINUE | |
40967 | C | |
40968 | M = L | |
40969 | IEXC = 1 | |
40970 | GOTO 100 | |
40971 | 170 CONTINUE | |
40972 | C | |
40973 | GOTO 190 | |
40974 | C .......... SEARCH FOR COLUMNS ISOLATING AN EIGENVALUE | |
40975 | C AND PUSH THEM LEFT .......... | |
40976 | 180 K = K + 1 | |
40977 | C | |
40978 | 190 DO 210 J = K, L | |
40979 | C | |
40980 | DO 200 I = K, L | |
40981 | IF (I .EQ. J) GOTO 200 | |
40982 | IF (AR(I,J) .NE. 0.0D0 .OR. AI(I,J) .NE. 0.0D0) GOTO 210 | |
40983 | 200 CONTINUE | |
40984 | C | |
40985 | M = K | |
40986 | IEXC = 2 | |
40987 | GOTO 100 | |
40988 | 210 CONTINUE | |
40989 | C .......... NOW BALANCE THE SUBMATRIX IN ROWS K TO L .......... | |
40990 | DO 220 I = K, L | |
40991 | 220 SCALE(I) = 1.0D0 | |
40992 | C .......... ITERATIVE LOOP FOR NORM REDUCTION .......... | |
40993 | 230 NOCONV = .FALSE. | |
40994 | C | |
40995 | DO 310 I = K, L | |
40996 | C = 0.0D0 | |
40997 | R = 0.0D0 | |
40998 | C | |
40999 | DO 240 J = K, L | |
41000 | IF (J .EQ. I) GOTO 240 | |
41001 | C = C + DABS(AR(J,I)) + DABS(AI(J,I)) | |
41002 | R = R + DABS(AR(I,J)) + DABS(AI(I,J)) | |
41003 | 240 CONTINUE | |
41004 | C .......... GUARD AGAINST ZERO C OR R DUE TO UNDERFLOW .......... | |
41005 | IF (C .EQ. 0.0D0 .OR. R .EQ. 0.0D0) GOTO 310 | |
41006 | G = R / RADIX | |
41007 | F = 1.0D0 | |
41008 | S = C + R | |
41009 | 250 IF (C .GE. G) GOTO 260 | |
41010 | F = F * RADIX | |
41011 | C = C * B2 | |
41012 | GOTO 250 | |
41013 | 260 G = R * RADIX | |
41014 | 270 IF (C .LT. G) GOTO 280 | |
41015 | F = F / RADIX | |
41016 | C = C / B2 | |
41017 | GOTO 270 | |
41018 | C .......... NOW BALANCE .......... | |
41019 | 280 IF ((C + R) / F .GE. 0.95D0 * S) GOTO 310 | |
41020 | G = 1.0D0 / F | |
41021 | SCALE(I) = SCALE(I) * F | |
41022 | NOCONV = .TRUE. | |
41023 | C | |
41024 | DO 290 J = K, N | |
41025 | AR(I,J) = AR(I,J) * G | |
41026 | AI(I,J) = AI(I,J) * G | |
41027 | 290 CONTINUE | |
41028 | C | |
41029 | DO 300 J = 1, L | |
41030 | AR(J,I) = AR(J,I) * F | |
41031 | AI(J,I) = AI(J,I) * F | |
41032 | 300 CONTINUE | |
41033 | C | |
41034 | 310 CONTINUE | |
41035 | C | |
41036 | IF (NOCONV) GOTO 230 | |
41037 | C | |
41038 | 320 LOW = K | |
41039 | IGH = L | |
41040 | RETURN | |
41041 | END | |
41042 | ||
41043 | C********************************************************************* | |
41044 | ||
41045 | C...PYCBA2 | |
41046 | C...Auxiliary to PYEICG. | |
41047 | C | |
41048 | C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE | |
41049 | C CBABK2, WHICH IS A COMPLEX VERSION OF BALBAK, | |
41050 | C NUM. MATH. 13, 293-304(1969) BY PARLETT AND REINSCH. | |
41051 | C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 315-326(1971). | |
41052 | C | |
41053 | C THIS SUBROUTINE FORMS THE EIGENVECTORS OF A COMPLEX GENERAL | |
41054 | C MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING | |
41055 | C BALANCED MATRIX DETERMINED BY CBAL. | |
41056 | C | |
41057 | C ON INPUT | |
41058 | C | |
41059 | C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL | |
41060 | C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM | |
41061 | C DIMENSION STATEMENT. | |
41062 | C | |
41063 | C N IS THE ORDER OF THE MATRIX. | |
41064 | C | |
41065 | C LOW AND IGH ARE INTEGERS DETERMINED BY CBAL. | |
41066 | C | |
41067 | C SCALE CONTAINS INFORMATION DETERMINING THE PERMUTATIONS | |
41068 | C AND SCALING FACTORS USED BY CBAL. | |
41069 | C | |
41070 | C M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. | |
41071 | C | |
41072 | C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, | |
41073 | C RESPECTIVELY, OF THE EIGENVECTORS TO BE | |
41074 | C BACK TRANSFORMED IN THEIR FIRST M COLUMNS. | |
41075 | C | |
41076 | C ON OUTPUT | |
41077 | C | |
41078 | C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, | |
41079 | C RESPECTIVELY, OF THE TRANSFORMED EIGENVECTORS | |
41080 | C IN THEIR FIRST M COLUMNS. | |
41081 | C | |
41082 | C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, | |
41083 | C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY | |
41084 | C | |
41085 | C THIS VERSION DATED AUGUST 1983. | |
41086 | C | |
41087 | ||
41088 | SUBROUTINE PYCBA2(NM,N,LOW,IGH,SCALE,M,ZR,ZI) | |
41089 | ||
41090 | INTEGER I,J,K,M,N,II,NM,IGH,LOW | |
41091 | DOUBLE PRECISION SCALE(4),ZR(4,4),ZI(4,4) | |
41092 | DOUBLE PRECISION S | |
41093 | ||
41094 | IF (M .EQ. 0) GOTO 150 | |
41095 | IF (IGH .EQ. LOW) GOTO 120 | |
41096 | C | |
41097 | DO 110 I = LOW, IGH | |
41098 | S = SCALE(I) | |
41099 | C .......... LEFT HAND EIGENVECTORS ARE BACK TRANSFORMED | |
41100 | C IF THE FOREGOING STATEMENT IS REPLACED BY | |
41101 | C S=1.0D0/SCALE(I). .......... | |
41102 | DO 100 J = 1, M | |
41103 | ZR(I,J) = ZR(I,J) * S | |
41104 | ZI(I,J) = ZI(I,J) * S | |
41105 | 100 CONTINUE | |
41106 | C | |
41107 | 110 CONTINUE | |
41108 | C .......... FOR I=LOW-1 STEP -1 UNTIL 1, | |
41109 | C IGH+1 STEP 1 UNTIL N DO -- .......... | |
41110 | 120 DO 140 II = 1, N | |
41111 | I = II | |
41112 | IF (I .GE. LOW .AND. I .LE. IGH) GOTO 140 | |
41113 | IF (I .LT. LOW) I = LOW - II | |
41114 | K = SCALE(I) | |
41115 | IF (K .EQ. I) GOTO 140 | |
41116 | C | |
41117 | DO 130 J = 1, M | |
41118 | S = ZR(I,J) | |
41119 | ZR(I,J) = ZR(K,J) | |
41120 | ZR(K,J) = S | |
41121 | S = ZI(I,J) | |
41122 | ZI(I,J) = ZI(K,J) | |
41123 | ZI(K,J) = S | |
41124 | 130 CONTINUE | |
41125 | C | |
41126 | 140 CONTINUE | |
41127 | C | |
41128 | 150 RETURN | |
41129 | END | |
41130 | ||
41131 | C********************************************************************* | |
41132 | ||
41133 | C...PYCRTH | |
41134 | C...Auxiliary to PYEICG. | |
41135 | C | |
41136 | C THIS SUBROUTINE IS A TRANSLATION OF A COMPLEX ANALOGUE OF | |
41137 | C THE ALGOL PROCEDURE ORTHES, NUM. MATH. 12, 349-368(1968) | |
41138 | C BY MARTIN AND WILKINSON. | |
41139 | C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 339-358(1971). | |
41140 | C | |
41141 | C GIVEN A COMPLEX GENERAL MATRIX, THIS SUBROUTINE | |
41142 | C REDUCES A SUBMATRIX SITUATED IN ROWS AND COLUMNS | |
41143 | C LOW THROUGH IGH TO UPPER HESSENBERG FORM BY | |
41144 | C UNITARY SIMILARITY TRANSFORMATIONS. | |
41145 | C | |
41146 | C ON INPUT | |
41147 | C | |
41148 | C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL | |
41149 | C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM | |
41150 | C DIMENSION STATEMENT. | |
41151 | C | |
41152 | C N IS THE ORDER OF THE MATRIX. | |
41153 | C | |
41154 | C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING | |
41155 | C SUBROUTINE CBAL. IF CBAL HAS NOT BEEN USED, | |
41156 | C SET LOW=1, IGH=N. | |
41157 | C | |
41158 | C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, | |
41159 | C RESPECTIVELY, OF THE COMPLEX INPUT MATRIX. | |
41160 | C | |
41161 | C ON OUTPUT | |
41162 | C | |
41163 | C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, | |
41164 | C RESPECTIVELY, OF THE HESSENBERG MATRIX. INFORMATION | |
41165 | C ABOUT THE UNITARY TRANSFORMATIONS USED IN THE REDUCTION | |
41166 | C IS STORED IN THE REMAINING TRIANGLES UNDER THE | |
41167 | C HESSENBERG MATRIX. | |
41168 | C | |
41169 | C ORTR AND ORTI CONTAIN FURTHER INFORMATION ABOUT THE | |
41170 | C TRANSFORMATIONS. ONLY ELEMENTS LOW THROUGH IGH ARE USED. | |
41171 | C | |
41172 | C CALLS PYTHAG FOR DSQRT(A*A + B*B) . | |
41173 | C | |
41174 | C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, | |
41175 | C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY | |
41176 | C | |
41177 | C THIS VERSION DATED AUGUST 1983. | |
41178 | C | |
41179 | ||
41180 | SUBROUTINE PYCRTH(NM,N,LOW,IGH,AR,AI,ORTR,ORTI) | |
41181 | ||
41182 | INTEGER I,J,M,N,II,JJ,LA,MP,NM,IGH,KP1,LOW | |
41183 | DOUBLE PRECISION AR(4,4),AI(4,4),ORTR(4),ORTI(4) | |
41184 | DOUBLE PRECISION F,G,H,FI,FR,SCALE,PYTHAG | |
41185 | ||
41186 | LA = IGH - 1 | |
41187 | KP1 = LOW + 1 | |
41188 | IF (LA .LT. KP1) GOTO 210 | |
41189 | C | |
41190 | DO 200 M = KP1, LA | |
41191 | H = 0.0D0 | |
41192 | ORTR(M) = 0.0D0 | |
41193 | ORTI(M) = 0.0D0 | |
41194 | SCALE = 0.0D0 | |
41195 | C .......... SCALE COLUMN (ALGOL TOL THEN NOT NEEDED) .......... | |
41196 | DO 100 I = M, IGH | |
41197 | 100 SCALE = SCALE + DABS(AR(I,M-1)) + DABS(AI(I,M-1)) | |
41198 | C | |
41199 | IF (SCALE .EQ. 0.0D0) GOTO 200 | |
41200 | MP = M + IGH | |
41201 | C .......... FOR I=IGH STEP -1 UNTIL M DO -- .......... | |
41202 | DO 110 II = M, IGH | |
41203 | I = MP - II | |
41204 | ORTR(I) = AR(I,M-1) / SCALE | |
41205 | ORTI(I) = AI(I,M-1) / SCALE | |
41206 | H = H + ORTR(I) * ORTR(I) + ORTI(I) * ORTI(I) | |
41207 | 110 CONTINUE | |
41208 | C | |
41209 | G = DSQRT(H) | |
41210 | F = PYTHAG(ORTR(M),ORTI(M)) | |
41211 | IF (F .EQ. 0.0D0) GOTO 120 | |
41212 | H = H + F * G | |
41213 | G = G / F | |
41214 | ORTR(M) = (1.0D0 + G) * ORTR(M) | |
41215 | ORTI(M) = (1.0D0 + G) * ORTI(M) | |
41216 | GOTO 130 | |
41217 | C | |
41218 | 120 ORTR(M) = G | |
41219 | AR(M,M-1) = SCALE | |
41220 | C .......... FORM (I-(U*UT)/H) * A .......... | |
41221 | 130 DO 160 J = M, N | |
41222 | FR = 0.0D0 | |
41223 | FI = 0.0D0 | |
41224 | C .......... FOR I=IGH STEP -1 UNTIL M DO -- .......... | |
41225 | DO 140 II = M, IGH | |
41226 | I = MP - II | |
41227 | FR = FR + ORTR(I) * AR(I,J) + ORTI(I) * AI(I,J) | |
41228 | FI = FI + ORTR(I) * AI(I,J) - ORTI(I) * AR(I,J) | |
41229 | 140 CONTINUE | |
41230 | C | |
41231 | FR = FR / H | |
41232 | FI = FI / H | |
41233 | C | |
41234 | DO 150 I = M, IGH | |
41235 | AR(I,J) = AR(I,J) - FR * ORTR(I) + FI * ORTI(I) | |
41236 | AI(I,J) = AI(I,J) - FR * ORTI(I) - FI * ORTR(I) | |
41237 | 150 CONTINUE | |
41238 | C | |
41239 | 160 CONTINUE | |
41240 | C .......... FORM (I-(U*UT)/H)*A*(I-(U*UT)/H) .......... | |
41241 | DO 190 I = 1, IGH | |
41242 | FR = 0.0D0 | |
41243 | FI = 0.0D0 | |
41244 | C .......... FOR J=IGH STEP -1 UNTIL M DO -- .......... | |
41245 | DO 170 JJ = M, IGH | |
41246 | J = MP - JJ | |
41247 | FR = FR + ORTR(J) * AR(I,J) - ORTI(J) * AI(I,J) | |
41248 | FI = FI + ORTR(J) * AI(I,J) + ORTI(J) * AR(I,J) | |
41249 | 170 CONTINUE | |
41250 | C | |
41251 | FR = FR / H | |
41252 | FI = FI / H | |
41253 | C | |
41254 | DO 180 J = M, IGH | |
41255 | AR(I,J) = AR(I,J) - FR * ORTR(J) - FI * ORTI(J) | |
41256 | AI(I,J) = AI(I,J) + FR * ORTI(J) - FI * ORTR(J) | |
41257 | 180 CONTINUE | |
41258 | C | |
41259 | 190 CONTINUE | |
41260 | C | |
41261 | ORTR(M) = SCALE * ORTR(M) | |
41262 | ORTI(M) = SCALE * ORTI(M) | |
41263 | AR(M,M-1) = -G * AR(M,M-1) | |
41264 | AI(M,M-1) = -G * AI(M,M-1) | |
41265 | 200 CONTINUE | |
41266 | C | |
41267 | 210 RETURN | |
41268 | END | |
41269 | ||
41270 | C********************************************************************* | |
41271 | ||
41272 | C...PYLDCM | |
41273 | C...Auxiliary to PYSIGH, for technicolor corrections to QCD 2 -> 2 | |
41274 | C...processes. | |
41275 | ||
41276 | SUBROUTINE PYLDCM(A,N,NP,INDX,D) | |
41277 | IMPLICIT NONE | |
41278 | INTEGER N,NP,INDX(N) | |
41279 | REAL*8 D,TINY | |
41280 | COMPLEX*16 A(NP,NP) | |
41281 | PARAMETER (TINY=1.0D-20) | |
41282 | INTEGER I,IMAX,J,K | |
41283 | REAL*8 AAMAX,VV(6),DUM | |
41284 | COMPLEX*16 SUM,DUMC | |
41285 | ||
41286 | D=1D0 | |
41287 | DO 110 I=1,N | |
41288 | AAMAX=0D0 | |
41289 | DO 100 J=1,N | |
41290 | IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J)) | |
41291 | 100 CONTINUE | |
41292 | IF (AAMAX.EQ.0D0) PAUSE 'SINGULAR MATRIX IN PYLDCM' | |
41293 | VV(I)=1D0/AAMAX | |
41294 | 110 CONTINUE | |
41295 | DO 180 J=1,N | |
41296 | DO 130 I=1,J-1 | |
41297 | SUM=A(I,J) | |
41298 | DO 120 K=1,I-1 | |
41299 | SUM=SUM-A(I,K)*A(K,J) | |
41300 | 120 CONTINUE | |
41301 | A(I,J)=SUM | |
41302 | 130 CONTINUE | |
41303 | AAMAX=0D0 | |
41304 | DO 150 I=J,N | |
41305 | SUM=A(I,J) | |
41306 | DO 140 K=1,J-1 | |
41307 | SUM=SUM-A(I,K)*A(K,J) | |
41308 | 140 CONTINUE | |
41309 | A(I,J)=SUM | |
41310 | DUM=VV(I)*ABS(SUM) | |
41311 | IF (DUM.GE.AAMAX) THEN | |
41312 | IMAX=I | |
41313 | AAMAX=DUM | |
41314 | ENDIF | |
41315 | 150 CONTINUE | |
41316 | IF (J.NE.IMAX)THEN | |
41317 | DO 160 K=1,N | |
41318 | DUMC=A(IMAX,K) | |
41319 | A(IMAX,K)=A(J,K) | |
41320 | A(J,K)=DUMC | |
41321 | 160 CONTINUE | |
41322 | D=-D | |
41323 | VV(IMAX)=VV(J) | |
41324 | ENDIF | |
41325 | INDX(J)=IMAX | |
41326 | IF(ABS(A(J,J)).EQ.0D0) A(J,J)=DCMPLX(TINY,0D0) | |
41327 | IF(J.NE.N)THEN | |
41328 | DO 170 I=J+1,N | |
41329 | A(I,J)=A(I,J)/A(J,J) | |
41330 | 170 CONTINUE | |
41331 | ENDIF | |
41332 | 180 CONTINUE | |
41333 | ||
41334 | RETURN | |
41335 | END | |
41336 | ||
41337 | C********************************************************************* | |
41338 | ||
41339 | C...PYBKSB | |
41340 | C...Auxiliary to PYSIGH, for technicolor corrections to QCD 2 -> 2 | |
41341 | C...processes. | |
41342 | ||
41343 | SUBROUTINE PYBKSB(A,N,NP,INDX,B) | |
41344 | IMPLICIT NONE | |
41345 | INTEGER N,NP,INDX(N) | |
41346 | COMPLEX*16 A(NP,NP),B(N) | |
41347 | INTEGER I,II,J,LL | |
41348 | COMPLEX*16 SUM | |
41349 | ||
41350 | II=0 | |
41351 | DO 110 I=1,N | |
41352 | LL=INDX(I) | |
41353 | SUM=B(LL) | |
41354 | B(LL)=B(I) | |
41355 | IF (II.NE.0)THEN | |
41356 | DO 100 J=II,I-1 | |
41357 | SUM=SUM-A(I,J)*B(J) | |
41358 | 100 CONTINUE | |
41359 | ELSE IF (ABS(SUM).NE.0D0) THEN | |
41360 | II=I | |
41361 | ENDIF | |
41362 | B(I)=SUM | |
41363 | 110 CONTINUE | |
41364 | DO 130 I=N,1,-1 | |
41365 | SUM=B(I) | |
41366 | DO 120 J=I+1,N | |
41367 | SUM=SUM-A(I,J)*B(J) | |
41368 | 120 CONTINUE | |
41369 | B(I)=SUM/A(I,I) | |
41370 | 130 CONTINUE | |
41371 | RETURN | |
41372 | END | |
41373 | ||
41374 | C*********************************************************************** | |
41375 | ||
41376 | C...PYWIDX | |
41377 | C...Calculates full and partial widths of resonances. | |
41378 | C....copy of PYWIDT, used for techniparticle widths | |
41379 | ||
41380 | SUBROUTINE PYWIDX(KFLR,SH,WDTP,WDTE) | |
41381 | ||
41382 | C...Double precision and integer declarations. | |
41383 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
41384 | IMPLICIT INTEGER(I-N) | |
41385 | INTEGER PYK,PYCHGE,PYCOMP | |
41386 | C...Parameter statement to help give large particle numbers. | |
41387 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
41388 | &KEXCIT=4000000,KDIMEN=5000000) | |
41389 | C...Commonblocks. | |
41390 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
41391 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
41392 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
41393 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
41394 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
41395 | COMMON/PYINT1/MINT(400),VINT(400) | |
41396 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
41397 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
41398 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
41399 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, | |
41400 | &/PYINT4/,/PYMSSM/,/PYTCSM/ | |
41401 | C...Local arrays and saved variables. | |
41402 | DIMENSION WDTP(0:400),WDTE(0:400,0:5),MOFSV(3,2),WIDWSV(3,2), | |
41403 | &WID2SV(3,2) | |
41404 | SAVE MOFSV,WIDWSV,WID2SV | |
41405 | DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/ | |
41406 | ||
41407 | C...Compressed code and sign; mass. | |
41408 | KFLA=IABS(KFLR) | |
41409 | KFLS=ISIGN(1,KFLR) | |
41410 | KC=PYCOMP(KFLA) | |
41411 | SHR=SQRT(SH) | |
41412 | PMR=PMAS(KC,1) | |
41413 | ||
41414 | C...Reset width information. | |
41415 | DO 110 I=0,200 | |
41416 | WDTP(I)=0D0 | |
41417 | DO 100 J=0,5 | |
41418 | WDTE(I,J)=0D0 | |
41419 | 100 CONTINUE | |
41420 | 110 CONTINUE | |
41421 | ||
41422 | C...Common electroweak and strong constants. | |
41423 | XW=PARU(102) | |
41424 | XWV=XW | |
41425 | IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 | |
41426 | XW1=1D0-XW | |
41427 | AEM=PYALEM(SH) | |
41428 | IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) | |
41429 | AS=PYALPS(SH) | |
41430 | RADC=1D0+AS/PARU(1) | |
41431 | ||
41432 | IF(KFLA.EQ.23) THEN | |
41433 | C...Z0: | |
41434 | ICASE=1 | |
41435 | XWC=1D0/(16D0*XW*XW1) | |
41436 | FAC=(AEM*XWC/3D0)*SHR | |
41437 | 120 CONTINUE | |
41438 | DO 130 I=1,MDCY(KC,3) | |
41439 | IDC=I+MDCY(KC,2)-1 | |
41440 | IF(MDME(IDC,1).LT.0) GOTO 130 | |
41441 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH | |
41442 | RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH | |
41443 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 130 | |
41444 | WID2=1D0 | |
41445 | IF(I.LE.8) THEN | |
41446 | C...Z0 -> q + qbar | |
41447 | EF=KCHG(I,1)/3D0 | |
41448 | AF=SIGN(1D0,EF+0.1D0) | |
41449 | VF=AF-4D0*EF*XWV | |
41450 | FCOF=3D0*RADC | |
41451 | IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) | |
41452 | IF(I.EQ.6) WID2=WIDS(6,1) | |
41453 | IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) | |
41454 | ELSEIF(I.LE.16) THEN | |
41455 | C...Z0 -> l+ + l-, nu + nubar | |
41456 | EF=KCHG(I+2,1)/3D0 | |
41457 | AF=SIGN(1D0,EF+0.1D0) | |
41458 | VF=AF-4D0*EF*XWV | |
41459 | FCOF=1D0 | |
41460 | IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) | |
41461 | ENDIF | |
41462 | BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) | |
41463 | WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* | |
41464 | & BE34 | |
41465 | WDTP(0)=WDTP(0)+WDTP(I) | |
41466 | IF(MDME(IDC,1).GT.0) THEN | |
41467 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
41468 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ | |
41469 | & WDTE(I,MDME(IDC,1)) | |
41470 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
41471 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
41472 | ENDIF | |
41473 | 130 CONTINUE | |
41474 | ||
41475 | ||
41476 | ELSEIF(KFLA.EQ.24) THEN | |
41477 | C...W+/-: | |
41478 | FAC=(AEM/(24D0*XW))*SHR | |
41479 | DO 140 I=1,MDCY(KC,3) | |
41480 | IDC=I+MDCY(KC,2)-1 | |
41481 | IF(MDME(IDC,1).LT.0) GOTO 140 | |
41482 | RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH | |
41483 | RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH | |
41484 | IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140 | |
41485 | WID2=1D0 | |
41486 | IF(I.LE.16) THEN | |
41487 | C...W+/- -> q + qbar' | |
41488 | FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1) | |
41489 | IF(KFLR.GT.0) THEN | |
41490 | IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) | |
41491 | IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) | |
41492 | IF(I.GE.13) WID2=WID2*WIDS(7,3) | |
41493 | ELSE | |
41494 | IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) | |
41495 | IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) | |
41496 | IF(I.GE.13) WID2=WID2*WIDS(7,2) | |
41497 | ENDIF | |
41498 | ELSEIF(I.LE.20) THEN | |
41499 | C...W+/- -> l+/- + nu | |
41500 | FCOF=1D0 | |
41501 | IF(KFLR.GT.0) THEN | |
41502 | IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) | |
41503 | ELSE | |
41504 | IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) | |
41505 | ENDIF | |
41506 | ENDIF | |
41507 | WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* | |
41508 | & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) | |
41509 | WDTP(0)=WDTP(0)+WDTP(I) | |
41510 | IF(MDME(IDC,1).GT.0) THEN | |
41511 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
41512 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
41513 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
41514 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
41515 | ENDIF | |
41516 | 140 CONTINUE | |
41517 | ||
41518 | C.....V8 -> quark anti-quark | |
41519 | ELSEIF(KFLA.EQ.KTECHN+100021) THEN | |
41520 | FAC=AS/6D0*SHR | |
41521 | TANT3=RTCM(21) | |
41522 | IF(ITCM(2).EQ.0) THEN | |
41523 | IMDL=1 | |
41524 | ELSEIF(ITCM(2).EQ.1) THEN | |
41525 | IMDL=2 | |
41526 | ENDIF | |
41527 | DO 150 I=1,MDCY(KC,3) | |
41528 | IDC=I+MDCY(KC,2)-1 | |
41529 | IF(MDME(IDC,1).LT.0) GOTO 150 | |
41530 | PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) | |
41531 | RM1=PM1**2/SH | |
41532 | IF(RM1.GT.0.25D0) GOTO 150 | |
41533 | WID2=1D0 | |
41534 | IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN | |
41535 | FMIX=1D0/TANT3**2 | |
41536 | ELSE | |
41537 | FMIX=TANT3**2 | |
41538 | ENDIF | |
41539 | WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*FMIX | |
41540 | IF(I.EQ.6) WID2=WIDS(6,1) | |
41541 | WDTP(0)=WDTP(0)+WDTP(I) | |
41542 | IF(MDME(IDC,1).GT.0) THEN | |
41543 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
41544 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
41545 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
41546 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
41547 | ENDIF | |
41548 | 150 CONTINUE | |
41549 | ENDIF | |
41550 | ||
41551 | RETURN | |
41552 | END | |
41553 | ||
41554 | C********************************************************************* | |
41555 | ||
41556 | C...PYRVSF | |
41557 | C...Calculates R-violating decays of sfermions. | |
41558 | C...P. Z. Skands | |
41559 | ||
41560 | SUBROUTINE PYRVSF(KFIN,XLAM,IDLAM,LKNT) | |
41561 | ||
41562 | C...Double precision and integer declarations. | |
41563 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
41564 | IMPLICIT INTEGER(I-N) | |
41565 | C...Parameter statement to help give large particle numbers. | |
41566 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
41567 | &KEXCIT=4000000,KDIMEN=5000000) | |
41568 | C...Commonblocks. | |
41569 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
41570 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
41571 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
41572 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
41573 | COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) | |
41574 | C...Local variables. | |
41575 | DOUBLE PRECISION XLAM(0:400) | |
41576 | INTEGER IDLAM(400,3), PYCOMP | |
41577 | SAVE /PYMSRV/,/PYSSMT/,/PYMSSM/,/PYDAT2/ | |
41578 | ||
41579 | C...IS R-VIOLATION ON ? | |
41580 | IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN | |
41581 | C...Mass eigenstate counter | |
41582 | ICNT=INT(KFIN/KSUSY1) | |
41583 | C...SM KF code of SUSY particle | |
41584 | KFSM=KFIN-ICNT*KSUSY1 | |
41585 | C...Squared Sparticle Mass | |
41586 | SM=PMAS(PYCOMP(KFIN),1)**2 | |
41587 | C... Squared mass of top quark | |
41588 | SMT=PMAS(PYCOMP(6),1)**2 | |
41589 | C...IS L-VIOLATION ON ? | |
41590 | IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1)) THEN | |
41591 | C...SLEPTON -> NU(BAR) + LEPTON and UBAR + D | |
41592 | IF(ICNT.NE.0.AND.(KFSM.EQ.11.OR.KFSM.EQ.13.OR.KFSM.EQ.15)) | |
41593 | & THEN | |
41594 | K=INT((KFSM-9)/2) | |
41595 | DO 110 I=1,3 | |
41596 | DO 100 J=1,3 | |
41597 | IF(I.NE.J) THEN | |
41598 | C...~e,~mu,~tau -> nu_I + lepton-_J | |
41599 | LKNT = LKNT+1 | |
41600 | IDLAM(LKNT,1)= 12 +2*(I-1) | |
41601 | IDLAM(LKNT,2)= 11 +2*(J-1) | |
41602 | IDLAM(LKNT,3)= 0 | |
41603 | XLAM(LKNT)=0D0 | |
41604 | RM2=RVLAM(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM | |
41605 | IF (IMSS(51).NE.0) XLAM(LKNT) = | |
41606 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41607 | C...KINEMATICS CHECK | |
41608 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41609 | LKNT=LKNT-1 | |
41610 | ENDIF | |
41611 | ENDIF | |
41612 | 100 CONTINUE | |
41613 | 110 CONTINUE | |
41614 | C...~e,~mu,~tau -> nu_Ibar + lepton-_K | |
41615 | J=INT((KFSM-9)/2) | |
41616 | DO 130 I=1,3 | |
41617 | IF(I.NE.J) THEN | |
41618 | DO 120 K=1,3 | |
41619 | LKNT = LKNT+1 | |
41620 | IDLAM(LKNT,1)=-12 -2*(I-1) | |
41621 | IDLAM(LKNT,2)= 11 +2*(K-1) | |
41622 | IDLAM(LKNT,3)= 0 | |
41623 | XLAM(LKNT)=0D0 | |
41624 | RM2=RVLAM(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM | |
41625 | IF (IMSS(51).NE.0) XLAM(LKNT) = | |
41626 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41627 | C...KINEMATICS CHECK | |
41628 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41629 | LKNT=LKNT-1 | |
41630 | ENDIF | |
41631 | 120 CONTINUE | |
41632 | ENDIF | |
41633 | 130 CONTINUE | |
41634 | C...~e,~mu,~tau -> u_Jbar + d_K | |
41635 | I=INT((KFSM-9)/2) | |
41636 | DO 150 J=1,3 | |
41637 | DO 140 K=1,3 | |
41638 | LKNT = LKNT+1 | |
41639 | IDLAM(LKNT,1)=-2 -2*(J-1) | |
41640 | IDLAM(LKNT,2)= 1 +2*(K-1) | |
41641 | IDLAM(LKNT,3)= 0 | |
41642 | XLAM(LKNT)=0 | |
41643 | IF (IMSS(52).NE.0) THEN | |
41644 | C...Use massive top quark | |
41645 | IF (IDLAM(LKNT,1).EQ.-6) THEN | |
41646 | RM2=3*RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 | |
41647 | & * (SM-SMT) | |
41648 | XLAM(LKNT) = | |
41649 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,3) | |
41650 | C...If no top quark, all decay products massless | |
41651 | ELSE | |
41652 | RM2=3*RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM | |
41653 | XLAM(LKNT) = | |
41654 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41655 | ENDIF | |
41656 | C...KINEMATICS CHECK | |
41657 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41658 | LKNT=LKNT-1 | |
41659 | ENDIF | |
41660 | ENDIF | |
41661 | 140 CONTINUE | |
41662 | 150 CONTINUE | |
41663 | ENDIF | |
41664 | C * SNEUTRINO -> LEPTON+ + LEPTON- and DBAR + D | |
41665 | C...No right-handed neutrinos | |
41666 | IF(ICNT.EQ.1) THEN | |
41667 | IF(KFSM.EQ.12.OR.KFSM.EQ.14.OR.KFSM.EQ.16) THEN | |
41668 | J=INT((KFSM-10)/2) | |
41669 | DO 170 I=1,3 | |
41670 | DO 160 K=1,3 | |
41671 | IF (I.NE.J) THEN | |
41672 | C...~nu_J -> lepton+_I + lepton-_K | |
41673 | LKNT = LKNT+1 | |
41674 | IDLAM(LKNT,1)=-11 -2*(I-1) | |
41675 | IDLAM(LKNT,2)= 11 +2*(K-1) | |
41676 | IDLAM(LKNT,3)= 0 | |
41677 | XLAM(LKNT)=0D0 | |
41678 | RM2=RVLAM(I,J,K)**2 * SM | |
41679 | IF (IMSS(51).NE.0) XLAM(LKNT) = | |
41680 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41681 | C...KINEMATICS CHECK | |
41682 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41683 | LKNT=LKNT-1 | |
41684 | ENDIF | |
41685 | ENDIF | |
41686 | 160 CONTINUE | |
41687 | 170 CONTINUE | |
41688 | C...~nu_I -> dbar_J + d_K | |
41689 | I=INT((KFSM-10)/2) | |
41690 | DO 190 J=1,3 | |
41691 | DO 180 K=1,3 | |
41692 | LKNT = LKNT+1 | |
41693 | IDLAM(LKNT,1)=-1 -2*(J-1) | |
41694 | IDLAM(LKNT,2)= 1 +2*(K-1) | |
41695 | IDLAM(LKNT,3)= 0 | |
41696 | XLAM(LKNT)=0D0 | |
41697 | RM2=3*RVLAMP(I,J,K)**2 * SM | |
41698 | IF (IMSS(52).NE.0) XLAM(LKNT) = | |
41699 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41700 | C...KINEMATICS CHECK | |
41701 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41702 | LKNT=LKNT-1 | |
41703 | ENDIF | |
41704 | 180 CONTINUE | |
41705 | 190 CONTINUE | |
41706 | ENDIF | |
41707 | ENDIF | |
41708 | C * SDOWN -> NU(BAR) + D and LEPTON- + U | |
41709 | IF(ICNT.NE.0.AND.(KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5)) THEN | |
41710 | J=INT((KFSM+1)/2) | |
41711 | DO 210 I=1,3 | |
41712 | DO 200 K=1,3 | |
41713 | C...~d_J -> nu_Ibar + d_K | |
41714 | LKNT = LKNT+1 | |
41715 | IDLAM(LKNT,1)=-12 -2*(I-1) | |
41716 | IDLAM(LKNT,2)= 1 +2*(K-1) | |
41717 | IDLAM(LKNT,3)= 0 | |
41718 | XLAM(LKNT)=0D0 | |
41719 | RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM | |
41720 | IF (IMSS(52).NE.0) XLAM(LKNT) = | |
41721 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41722 | C...KINEMATICS CHECK | |
41723 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41724 | LKNT=LKNT-1 | |
41725 | ENDIF | |
41726 | 200 CONTINUE | |
41727 | 210 CONTINUE | |
41728 | K=INT((KFSM+1)/2) | |
41729 | DO 240 I=1,3 | |
41730 | DO 230 J=1,3 | |
41731 | C...~d_K -> nu_I + d_J | |
41732 | LKNT = LKNT+1 | |
41733 | IDLAM(LKNT,1)= 12 +2*(I-1) | |
41734 | IDLAM(LKNT,2)= 1 +2*(J-1) | |
41735 | IDLAM(LKNT,3)= 0 | |
41736 | XLAM(LKNT)=0D0 | |
41737 | RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM | |
41738 | IF (IMSS(52).NE.0) XLAM(LKNT) = | |
41739 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41740 | C...KINEMATICS CHECK | |
41741 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41742 | LKNT=LKNT-1 | |
41743 | ENDIF | |
41744 | C...~d_K -> lepton_I- + u_J | |
41745 | 220 LKNT = LKNT+1 | |
41746 | IDLAM(LKNT,1)= 11 +2*(I-1) | |
41747 | IDLAM(LKNT,2)= 2 +2*(J-1) | |
41748 | IDLAM(LKNT,3)= 0 | |
41749 | XLAM(LKNT)=0D0 | |
41750 | IF (IMSS(52).NE.0) THEN | |
41751 | C...Use massive top quark | |
41752 | IF (IDLAM(LKNT,2).EQ.6) THEN | |
41753 | RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2*(SM-SMT) | |
41754 | XLAM(LKNT) = | |
41755 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,2) | |
41756 | C...If no top quark, all decay products massless | |
41757 | ELSE | |
41758 | RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM | |
41759 | XLAM(LKNT) = | |
41760 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41761 | ENDIF | |
41762 | C...KINEMATICS CHECK | |
41763 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41764 | LKNT=LKNT-1 | |
41765 | ENDIF | |
41766 | ENDIF | |
41767 | 230 CONTINUE | |
41768 | 240 CONTINUE | |
41769 | ENDIF | |
41770 | C * SUP -> LEPTON+ + D | |
41771 | IF(ICNT.NE.0.AND.(KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6)) THEN | |
41772 | J=NINT(KFSM/2.) | |
41773 | DO 260 I=1,3 | |
41774 | DO 250 K=1,3 | |
41775 | C...~u_J -> lepton_I+ + d_K | |
41776 | LKNT = LKNT+1 | |
41777 | IDLAM(LKNT,1)=-11 -2*(I-1) | |
41778 | IDLAM(LKNT,2)= 1 +2*(K-1) | |
41779 | IDLAM(LKNT,3)= 0 | |
41780 | XLAM(LKNT)=0D0 | |
41781 | RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM | |
41782 | IF (IMSS(52).NE.0) XLAM(LKNT) = | |
41783 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41784 | C...KINEMATICS CHECK | |
41785 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41786 | LKNT=LKNT-1 | |
41787 | ENDIF | |
41788 | 250 CONTINUE | |
41789 | 260 CONTINUE | |
41790 | ENDIF | |
41791 | ENDIF | |
41792 | C...BARYON NUMBER VIOLATING DECAYS | |
41793 | IF (IMSS(53).GE.1) THEN | |
41794 | C * SUP -> DBAR + DBAR | |
41795 | IF(ICNT.NE.0.AND.(KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6)) THEN | |
41796 | I = KFSM/2 | |
41797 | DO 280 J=1,3 | |
41798 | DO 270 K=1,3 | |
41799 | C...~u_I -> dbar_J + dbar_K | |
41800 | IF (J.LT.K) THEN | |
41801 | C...(anti-) symmetry J <-> K. | |
41802 | LKNT = LKNT + 1 | |
41803 | IDLAM(LKNT,1) = -1 -2*(J-1) | |
41804 | IDLAM(LKNT,2) = -1 -2*(K-1) | |
41805 | IDLAM(LKNT,3) = 0 | |
41806 | XLAM(LKNT) = 0D0 | |
41807 | RM2 = 2.*(RVLAMB(I,J,K)**2) | |
41808 | & * SFMIX(KFSM,2*ICNT)**2 * SM | |
41809 | XLAM(LKNT) = | |
41810 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41811 | C...KINEMATICS CHECK | |
41812 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41813 | LKNT = LKNT-1 | |
41814 | ENDIF | |
41815 | ENDIF | |
41816 | 270 CONTINUE | |
41817 | 280 CONTINUE | |
41818 | ENDIF | |
41819 | C * SDOWN -> UBAR + DBAR | |
41820 | IF(ICNT.NE.0.AND.(KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5)) THEN | |
41821 | K=(KFSM+1)/2 | |
41822 | DO 300 I=1,3 | |
41823 | DO 290 J=1,3 | |
41824 | C...LAMB coupling antisymmetric in J and K. | |
41825 | IF (J.NE.K) THEN | |
41826 | C...~d_K -> ubar_I + dbar_K | |
41827 | LKNT = LKNT + 1 | |
41828 | IDLAM(LKNT,1)= -2 -2*(I-1) | |
41829 | IDLAM(LKNT,2)= -1 -2*(J-1) | |
41830 | IDLAM(LKNT,3)= 0 | |
41831 | XLAM(LKNT)=0D0 | |
41832 | C...Use massive top quark | |
41833 | IF (IDLAM(LKNT,1).EQ.-6) THEN | |
41834 | RM2=2*RVLAMB(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2*(SM-SMT | |
41835 | & ) | |
41836 | XLAM(LKNT) = | |
41837 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,3) | |
41838 | C...If no top quark, all decay products massless | |
41839 | ELSE | |
41840 | RM2=2*RVLAMB(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM | |
41841 | XLAM(LKNT) = | |
41842 | & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) | |
41843 | ENDIF | |
41844 | C...KINEMATICS CHECK | |
41845 | IF (XLAM(LKNT).EQ.0D0) THEN | |
41846 | LKNT=LKNT-1 | |
41847 | ENDIF | |
41848 | ENDIF | |
41849 | 290 CONTINUE | |
41850 | 300 CONTINUE | |
41851 | ENDIF | |
41852 | ENDIF | |
41853 | ENDIF | |
41854 | ||
41855 | RETURN | |
41856 | END | |
41857 | ||
41858 | C********************************************************************* | |
41859 | ||
41860 | C...PYRVNE | |
41861 | C...Calculates R-violating neutralino decay widths (pure 1->3 parts). | |
41862 | C...P. Z. Skands | |
41863 | ||
41864 | SUBROUTINE PYRVNE(KFIN,XLAM,IDLAM,LKNT) | |
41865 | ||
41866 | C...Double precision and integer declarations. | |
41867 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
41868 | IMPLICIT INTEGER(I-N) | |
41869 | C...Parameter statement to help give large particle numbers. | |
41870 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
41871 | &KEXCIT=4000000,KDIMEN=5000000) | |
41872 | C...Commonblocks. | |
41873 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
41874 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
41875 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
41876 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
41877 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
41878 | COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) | |
41879 | C...Local variables. | |
41880 | COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 | |
41881 | & ,DCMASS,KFR(3) | |
41882 | DOUBLE PRECISION XLAM(0:400) | |
41883 | DOUBLE PRECISION ZPMIX(4,4), NMIX(4,4), RMQ(6) | |
41884 | INTEGER IDLAM(400,3), PYCOMP | |
41885 | LOGICAL DCMASS | |
41886 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/ | |
41887 | ||
41888 | C...R-VIOLATING DECAYS | |
41889 | IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN | |
41890 | KFSM=KFIN-KSUSY1 | |
41891 | IF(KFSM.EQ.22.OR.KFSM.EQ.23.OR.KFSM.EQ.25.OR.KFSM.EQ.35) THEN | |
41892 | C...WHICH NEUTRALINO ? | |
41893 | NCHI=1 | |
41894 | IF (KFSM.EQ.23) NCHI=2 | |
41895 | IF (KFSM.EQ.25) NCHI=3 | |
41896 | IF (KFSM.EQ.35) NCHI=4 | |
41897 | C...SIGN OF MASS (Opposite convention as HERWIG) | |
41898 | ISM = 1 | |
41899 | IF (SMZ(NCHI).LT.0D0) ISM = -ISM | |
41900 | ||
41901 | C...Useful parameters for the calculation of the A and B constants. | |
41902 | WMASS = PMAS(PYCOMP(24),1) | |
41903 | ECHG = 2*SQRT(PARU(103)*PARU(1)) | |
41904 | COSB=1/(SQRT(1+RMSS(5)**2)) | |
41905 | SINB=RMSS(5)/SQRT(1+RMSS(5)**2) | |
41906 | COSW=SQRT(1-PARU(102)) | |
41907 | SINW=SQRT(PARU(102)) | |
41908 | GW=2D0*SQRT(PARU(103)*PARU(1))/SINW | |
41909 | C...Run quark masses to neutralino mass squared (for Higgs-type | |
41910 | C...couplings) | |
41911 | SQMCHI=PMAS(PYCOMP(KFIN),1)**2 | |
41912 | DO 100 I=1,6 | |
41913 | RMQ(I)=PYMRUN(I,SQMCHI) | |
41914 | 100 CONTINUE | |
41915 | C...EXPRESS NEUTRALINO MIXING IN (photino,Zino,~H_u,~H_d) BASIS | |
41916 | DO 110 NCHJ=1,4 | |
41917 | ZPMIX(NCHJ,1)= ZMIX(NCHJ,1)*COSW+ZMIX(NCHJ,2)*SINW | |
41918 | ZPMIX(NCHJ,2)=-ZMIX(NCHJ,1)*SINW+ZMIX(NCHJ,2)*COSW | |
41919 | ZPMIX(NCHJ,3)= ZMIX(NCHJ,3) | |
41920 | ZPMIX(NCHJ,4)= ZMIX(NCHJ,4) | |
41921 | 110 CONTINUE | |
41922 | C1=GW*ZPMIX(NCHI,3)/(2D0*COSB*WMASS) | |
41923 | C1U=GW*ZPMIX(NCHI,4)/(2D0*SINB*WMASS) | |
41924 | C2=ECHG*ZPMIX(NCHI,1) | |
41925 | C3=GW*ZPMIX(NCHI,2)/COSW | |
41926 | EU=2D0/3D0 | |
41927 | ED=-1D0/3D0 | |
41928 | C... AB(x,y,z): | |
41929 | C x=1-2 : Select A or B constant (1:A ; 2:B) | |
41930 | C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ; | |
41931 | C 11-16:e,nu_e,mu,...) | |
41932 | C z=1-2 : Mass eigenstate number | |
41933 | C...CALCULATE COUPLINGS | |
41934 | DO 120 I = 11,15,2 | |
41935 | CMS=PMAS(PYCOMP(I),1) | |
41936 | C...Intermediate sleptons | |
41937 | AB(1,I,1)=ISM*(CMS*C1*SFMIX(I,1) + SFMIX(I,2) | |
41938 | & *(C2-C3*SINW**2)) | |
41939 | AB(1,I,2)=ISM*(CMS*C1*SFMIX(I,3) + SFMIX(I,4) | |
41940 | & *(C2-C3*SINW**2)) | |
41941 | AB(2,I,1)= CMS*C1*SFMIX(I,2) - SFMIX(I,1)*(C2+C3*(5D-1-SINW | |
41942 | & **2)) | |
41943 | AB(2,I,2)=CMS*C1*SFMIX(I,4) - SFMIX(I,3)*(C2+C3*(5D-1-SINW | |
41944 | & **2)) | |
41945 | C...Inermediate sneutrinos | |
41946 | AB(1,I+1,1)=0D0 | |
41947 | AB(2,I+1,1)=5D-1*C3 | |
41948 | AB(1,I+1,2)=0D0 | |
41949 | AB(2,I+1,2)=0D0 | |
41950 | C...Inermediate sdown | |
41951 | J=I-10 | |
41952 | CMS=RMQ(J) | |
41953 | AB(1,J,1)=ISM*(CMS*C1*SFMIX(J,1) - SFMIX(J,2) | |
41954 | & *ED*(C2-C3*SINW**2)) | |
41955 | AB(1,J,2)=ISM*(CMS*C1*SFMIX(J,3) - SFMIX(J,4) | |
41956 | & *ED*(C2-C3*SINW**2)) | |
41957 | AB(2,J,1)=CMS*C1*SFMIX(J,2) + SFMIX(J,1) | |
41958 | & *(ED*C2-C3*(1D0/2D0+ED*SINW**2)) | |
41959 | AB(2,J,2)=CMS*C1*SFMIX(J,4) + SFMIX(J,3) | |
41960 | & *(ED*C2-C3*(1D0/2D0+ED*SINW**2)) | |
41961 | C...Inermediate sup | |
41962 | J=J+1 | |
41963 | CMS=RMQ(J) | |
41964 | AB(1,J,1)=ISM*(CMS*C1U*SFMIX(J,1) - SFMIX(J,2) | |
41965 | & *EU*(C2-C3*SINW**2)) | |
41966 | AB(1,J,2)=ISM*(CMS*C1U*SFMIX(J,3) - SFMIX(J,4) | |
41967 | & *EU*(C2-C3*SINW**2)) | |
41968 | AB(2,J,1)=CMS*C1U*SFMIX(J,2) + SFMIX(J,1) | |
41969 | & *(EU*C2+C3*(1D0/2D0-EU*SINW**2)) | |
41970 | AB(2,J,2)=CMS*C1U*SFMIX(J,4) + SFMIX(J,3) | |
41971 | & *(EU*C2+C3*(1D0/2D0-EU*SINW**2)) | |
41972 | 120 CONTINUE | |
41973 | ||
41974 | IF (IMSS(51).GE.1) THEN | |
41975 | C...LAMBDA COUPLINGS (LLE TYPE R-VIOLATION) | |
41976 | C * CHI0_I -> NUBAR_I + LEPTON+_J + lEPTON-_K. | |
41977 | C...STEP IN I,J,K USING SINGLE COUNTER | |
41978 | DO 130 ISC=0,26 | |
41979 | C...LAMBDA COUPLING ASYM IN I,J | |
41980 | IF(MOD(ISC/9,3).NE.MOD(ISC/3,3)) THEN | |
41981 | LKNT = LKNT+1 | |
41982 | IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) | |
41983 | IDLAM(LKNT,2) =-11 -2*MOD(ISC/3,3) | |
41984 | IDLAM(LKNT,3) = 11 +2*MOD(ISC,3) | |
41985 | XLAM(LKNT) = 0D0 | |
41986 | C...Set coupling, and decay product masses on/off | |
41987 | RVLAMC = RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1 | |
41988 | & ,MOD(ISC,3)+1)**2 | |
41989 | DCMASS=.FALSE. | |
41990 | IF (IDLAM(LKNT,2).EQ.-15.OR.IDLAM(LKNT,3).EQ.15) | |
41991 | & DCMASS = .TRUE. | |
41992 | C...Resonance KF codes (1=I,2=J,3=K) | |
41993 | KFR(1)=-IDLAM(LKNT,1) | |
41994 | KFR(2)=-IDLAM(LKNT,2) | |
41995 | KFR(3)=-IDLAM(LKNT,3) | |
41996 | C...Calculate width. | |
41997 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
41998 | & IDLAM(LKNT,3),XLAM(LKNT)) | |
41999 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42000 | C...Charge conjugate mode. | |
42001 | LKNT=LKNT+1 | |
42002 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
42003 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
42004 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
42005 | XLAM(LKNT)=XLAM(LKNT-1) | |
42006 | C...KINEMATICS CHECK | |
42007 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42008 | LKNT=LKNT-2 | |
42009 | ENDIF | |
42010 | ENDIF | |
42011 | 130 CONTINUE | |
42012 | ENDIF | |
42013 | ||
42014 | IF (IMSS(52).GE.1) THEN | |
42015 | C...LAMBDA' COUPLINGS. (LQD TYPE R-VIOLATION) | |
42016 | C * CHI0 -> NUBAR_I + DBAR_J + D_K | |
42017 | DO 140 ISC=0,26 | |
42018 | LKNT = LKNT+1 | |
42019 | IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) | |
42020 | IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) | |
42021 | IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) | |
42022 | XLAM(LKNT) = 0D0 | |
42023 | C...Set coupling, and decay product masses on/off | |
42024 | RVLAMC = 3 * RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1 | |
42025 | & ,MOD(ISC,3)+1)**2 | |
42026 | DCMASS=.FALSE. | |
42027 | IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.5) | |
42028 | & DCMASS = .TRUE. | |
42029 | C...Resonance KF codes (1=I,2=J,3=K) | |
42030 | KFR(1)=-IDLAM(LKNT,1) | |
42031 | KFR(2)=-IDLAM(LKNT,2) | |
42032 | KFR(3)=-IDLAM(LKNT,3) | |
42033 | C...Calculate width. | |
42034 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42035 | & ,XLAM(LKNT)) | |
42036 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42037 | C...Charge conjugate mode. | |
42038 | LKNT=LKNT+1 | |
42039 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
42040 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
42041 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
42042 | XLAM(LKNT)=XLAM(LKNT-1) | |
42043 | C...KINEMATICS CHECK | |
42044 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42045 | LKNT=LKNT-2 | |
42046 | ENDIF | |
42047 | ||
42048 | C * CHI0 -> LEPTON_I+ + UBAR_J + D_K | |
42049 | LKNT = LKNT+1 | |
42050 | IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) | |
42051 | IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3) | |
42052 | IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) | |
42053 | XLAM(LKNT) = 0D0 | |
42054 | C...Set coupling, and decay product masses on/off | |
42055 | RVLAMC = 3 * RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1 | |
42056 | & ,MOD(ISC,3)+1)**2 | |
42057 | DCMASS=.FALSE. | |
42058 | IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-6 | |
42059 | & .OR.IDLAM(LKNT,3).EQ.5) DCMASS=.TRUE. | |
42060 | C...Resonance KF codes (1=I,2=J,3=K) | |
42061 | KFR(1)=-IDLAM(LKNT,1) | |
42062 | KFR(2)=-IDLAM(LKNT,2) | |
42063 | KFR(3)=-IDLAM(LKNT,3) | |
42064 | C...Calculate width. | |
42065 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42066 | & ,XLAM(LKNT)) | |
42067 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42068 | C...Charge conjugate mode. | |
42069 | LKNT=LKNT+1 | |
42070 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
42071 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
42072 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
42073 | XLAM(LKNT)=XLAM(LKNT-1) | |
42074 | C...KINEMATICS CHECK | |
42075 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42076 | LKNT=LKNT-2 | |
42077 | ENDIF | |
42078 | 140 CONTINUE | |
42079 | ENDIF | |
42080 | ||
42081 | IF (IMSS(53).GE.1) THEN | |
42082 | C...LAMBDA'' COUPLINGS. (UDD TYPE R-VIOLATION) | |
42083 | C * CHI0 -> UBAR_I + DBAR_J + DBAR_K | |
42084 | DO 150 ISC=0,26 | |
42085 | C...Symmetry J<->K. Also, LAMB antisymmetric in J and K, so no J=K. | |
42086 | IF (MOD(ISC/3,3).LT.MOD(ISC,3)) THEN | |
42087 | LKNT = LKNT+1 | |
42088 | IDLAM(LKNT,1) = -2 -2*MOD(ISC/9,3) | |
42089 | IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) | |
42090 | IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) | |
42091 | XLAM(LKNT) = 0D0 | |
42092 | C...Set coupling, and decay product masses on/off | |
42093 | RVLAMC = 6. * RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3) | |
42094 | & +1,MOD(ISC,3)+1)**2 | |
42095 | DCMASS=.FALSE. | |
42096 | IF (IDLAM(LKNT,1).EQ.-6.OR.IDLAM(LKNT,2).EQ.-5 | |
42097 | & .OR.IDLAM(LKNT,3).EQ.-5) DCMASS=.TRUE. | |
42098 | C...Resonance KF codes (1=I,2=J,3=K) | |
42099 | KFR(1) = IDLAM(LKNT,1) | |
42100 | KFR(2) = IDLAM(LKNT,2) | |
42101 | KFR(3) = IDLAM(LKNT,3) | |
42102 | C...Calculate width. | |
42103 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42104 | & IDLAM(LKNT,3),XLAM(LKNT)) | |
42105 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42106 | C...Charge conjugate mode. | |
42107 | LKNT=LKNT+1 | |
42108 | IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) | |
42109 | IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) | |
42110 | IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) | |
42111 | XLAM(LKNT)=XLAM(LKNT-1) | |
42112 | C...KINEMATICS CHECK | |
42113 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42114 | LKNT=LKNT-2 | |
42115 | ENDIF | |
42116 | ENDIF | |
42117 | 150 CONTINUE | |
42118 | ENDIF | |
42119 | ENDIF | |
42120 | ENDIF | |
42121 | ||
42122 | RETURN | |
42123 | END | |
42124 | ||
42125 | C********************************************************************* | |
42126 | ||
42127 | C...PYRVCH | |
42128 | C...Calculates R-violating chargino decay widths. | |
42129 | C...P. Z. Skands | |
42130 | ||
42131 | SUBROUTINE PYRVCH(KFIN,XLAM,IDLAM,LKNT) | |
42132 | ||
42133 | C...Double precision and integer declarations. | |
42134 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
42135 | IMPLICIT INTEGER(I-N) | |
42136 | C...Parameter statement to help give large particle numbers. | |
42137 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
42138 | &KEXCIT=4000000,KDIMEN=5000000) | |
42139 | C...Commonblocks. | |
42140 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
42141 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
42142 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
42143 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
42144 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
42145 | COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) | |
42146 | C...Local variables. | |
42147 | DOUBLE PRECISION XLAM(0:400) | |
42148 | INTEGER IDLAM(400,3), PYCOMP | |
42149 | C...Information from main routine to PYRVGW | |
42150 | COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 | |
42151 | & ,DCMASS,KFR(3) | |
42152 | C...Auxiliary variables needed for BV (RV Gauge STOre) | |
42153 | COMMON/RVGSTO/XRESI,XRESJ,XRESK,XRESIJ,XRESIK,XRESJK,RVLIJK,RVLKIJ | |
42154 | & ,RVLJKI,RVLJIK | |
42155 | C...Running quark masses | |
42156 | DOUBLE PRECISION RMQ(6) | |
42157 | C...Decay product masses on/off | |
42158 | LOGICAL DCMASS | |
42159 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/, | |
42160 | & /RVGSTO/ | |
42161 | ||
42162 | ||
42163 | C...IF R-VIOLATION ON. | |
42164 | IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN | |
42165 | KFSM=KFIN-KSUSY1 | |
42166 | IF(KFSM.EQ.24.OR.KFSM.EQ.37) THEN | |
42167 | C...WHICH CHARGINO ? | |
42168 | NCHI = 1 | |
42169 | IF (KFSM.EQ.37) NCHI = 2 | |
42170 | ||
42171 | C...Useful parameters for calculating the A and B constants. | |
42172 | C...SIGN OF MASS (Opposite convention as HERWIG) | |
42173 | ISM = 1 | |
42174 | IF (SMW(NCHI).LT.0D0) ISM = -1 | |
42175 | WMASS = PMAS(PYCOMP(24),1) | |
42176 | COSB = 1/(SQRT(1+RMSS(5)**2)) | |
42177 | SINB = RMSS(5)/SQRT(1+RMSS(5)**2) | |
42178 | GW2 = 4*PARU(103)*PARU(1)/PARU(102) | |
42179 | C1U = UMIX(NCHI,2)/(SQRT(2D0)*COSB*WMASS) | |
42180 | C1V = VMIX(NCHI,2)/(SQRT(2D0)*SINB*WMASS) | |
42181 | C2 = UMIX(NCHI,1) | |
42182 | C3 = VMIX(NCHI,1) | |
42183 | C...Running masses at Q^2=MCHI^2. | |
42184 | SQMCHI = PMAS(PYCOMP(KFSM),1)**2 | |
42185 | DO 100 I=1,6 | |
42186 | RMQ(I)=PYMRUN(I,SQMCHI) | |
42187 | 100 CONTINUE | |
42188 | ||
42189 | C... AB(x,y,z) coefficients: | |
42190 | C x=1-2 : A or B coefficient (1:A ; 2:B) | |
42191 | C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ; | |
42192 | C 11-16:e,nu_e,mu,...) | |
42193 | C z=1-2 : Mass eigenstate number | |
42194 | DO 110 I = 11,15,2 | |
42195 | C...Intermediate sleptons | |
42196 | AB(1,I,1) = 0D0 | |
42197 | AB(1,I,2) = 0D0 | |
42198 | AB(2,I,1) = -PMAS(PYCOMP(I),1)*C1U*SFMIX(I,2) + | |
42199 | & SFMIX(I,1)*C2 | |
42200 | AB(2,I,2) = -PMAS(PYCOMP(I),1)*C1U*SFMIX(I,4) + | |
42201 | & SFMIX(I,3)*C2 | |
42202 | C...Intermediate sneutrinos | |
42203 | AB(1,I+1,1) = -PMAS(PYCOMP(I),1)*C1U | |
42204 | AB(1,I+1,2) = 0D0 | |
42205 | AB(2,I+1,1) = ISM*C3 | |
42206 | AB(2,I+1,2) = 0D0 | |
42207 | C...Intermediate sdown | |
42208 | J=I-10 | |
42209 | AB(1,J,1) = -RMQ(J+1)*C1V*SFMIX(J,1) | |
42210 | AB(1,J,2) = -RMQ(J+1)*C1V*SFMIX(J,3) | |
42211 | AB(2,J,1) = -ISM*(RMQ(J)*C1U*SFMIX(J,2) - SFMIX(J,1)*C2) | |
42212 | AB(2,J,2) = -ISM*(RMQ(J)*C1U*SFMIX(J,4) - SFMIX(J,3)*C2) | |
42213 | C...Intermediate sup | |
42214 | J=J+1 | |
42215 | AB(1,J,1) = -RMQ(J-1)*C1U*SFMIX(J,1) | |
42216 | AB(1,J,2) = -RMQ(J-1)*C1U*SFMIX(J,3) | |
42217 | AB(2,J,1) = -ISM*(RMQ(J)*C1V*SFMIX(J,2) - SFMIX(J,1)*C3) | |
42218 | AB(2,J,2) = -ISM*(RMQ(J)*C1V*SFMIX(J,4) - SFMIX(J,3)*C3) | |
42219 | 110 CONTINUE | |
42220 | ||
42221 | C...LLE TYPE R-VIOLATION | |
42222 | IF (IMSS(51).GE.1) THEN | |
42223 | C...LOOP OVER DECAY MODES | |
42224 | DO 140 ISC=0,26 | |
42225 | ||
42226 | C...CHI+ -> NUBAR_I + LEPTON+_J + NU_K. | |
42227 | IF(MOD(ISC/9,3).NE.MOD(ISC/3,3)) THEN | |
42228 | LKNT = LKNT+1 | |
42229 | IDLAM(LKNT,1) = -12 -2*MOD(ISC/9,3) | |
42230 | IDLAM(LKNT,2) = -11 -2*MOD(ISC/3,3) | |
42231 | IDLAM(LKNT,3) = 12 +2*MOD(ISC,3) | |
42232 | XLAM(LKNT) = 0D0 | |
42233 | C...Set coupling, and decay product masses on/off | |
42234 | RVLAMC = GW2 * 5D-1 * | |
42235 | & RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1) | |
42236 | & **2 | |
42237 | DCMASS=.FALSE. | |
42238 | IF (IDLAM(LKNT,2).EQ.-15) DCMASS = .TRUE. | |
42239 | C...Resonance KF codes (1=I,2=J,3=K). | |
42240 | KFR(1) = 0 | |
42241 | KFR(2) = 0 | |
42242 | KFR(3) = -IDLAM(LKNT,3)+1 | |
42243 | C...Calculate width. | |
42244 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42245 | & IDLAM(LKNT,3),XLAM(LKNT)) | |
42246 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42247 | C...KINEMATICS CHECK | |
42248 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42249 | LKNT=LKNT-1 | |
42250 | ENDIF | |
42251 | ||
42252 | C * CHI+ -> NU_I + NU_J + LEPTON+_K. (NOTE: SYMM. IN I AND J) | |
42253 | 120 IF (MOD(ISC/9,3).LT.MOD(ISC/3,3)) THEN | |
42254 | LKNT = LKNT+1 | |
42255 | IDLAM(LKNT,1) = 12 +2*MOD(ISC/9,3) | |
42256 | IDLAM(LKNT,2) = 12 +2*MOD(ISC/3,3) | |
42257 | IDLAM(LKNT,3) =-11 -2*MOD(ISC,3) | |
42258 | XLAM(LKNT) = 0D0 | |
42259 | C...Set coupling, and decay product masses on/off | |
42260 | RVLAMC = GW2 * 5D-1 * | |
42261 | & RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 | |
42262 | C...I,J SYMMETRY => FACTOR 2 | |
42263 | RVLAMC=2*RVLAMC | |
42264 | DCMASS=.FALSE. | |
42265 | IF (IDLAM(LKNT,3).EQ.-15) DCMASS = .TRUE. | |
42266 | C...Resonance KF codes (1=I,2=J,3=K) | |
42267 | KFR(1)=IDLAM(LKNT,1)-1 | |
42268 | KFR(2)=IDLAM(LKNT,2)-1 | |
42269 | KFR(3)=0 | |
42270 | C...Calculate width. | |
42271 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42272 | & IDLAM(LKNT,3),XLAM(LKNT)) | |
42273 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42274 | C...KINEMATICS CHECK | |
42275 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42276 | LKNT=LKNT-1 | |
42277 | ENDIF | |
42278 | 130 ENDIF | |
42279 | ||
42280 | C * CHI+ -> LEPTON+_I + LEPTON+_J + LEPTON-_K | |
42281 | LKNT = LKNT+1 | |
42282 | IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) | |
42283 | IDLAM(LKNT,2) =-11 -2*MOD(ISC/3,3) | |
42284 | IDLAM(LKNT,3) = 11 +2*MOD(ISC,3) | |
42285 | XLAM(LKNT) = 0D0 | |
42286 | C...Set coupling, and decay product masses on/off | |
42287 | RVLAMC = GW2 * 5D-1 * | |
42288 | & RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 | |
42289 | C...I,J SYMMETRY => FACTOR 2 | |
42290 | RVLAMC=2*RVLAMC | |
42291 | DCMASS=.FALSE. | |
42292 | IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-15 | |
42293 | & .OR.IDLAM(LKNT,3).EQ.15) DCMASS = .TRUE. | |
42294 | C...Resonance KF codes (1=I,2=J,3=K) | |
42295 | KFR(1) =-IDLAM(LKNT,1)+1 | |
42296 | KFR(2) =-IDLAM(LKNT,2)+1 | |
42297 | KFR(3) = 0 | |
42298 | C...Calculate width. | |
42299 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42300 | & IDLAM(LKNT,3),XLAM(LKNT)) | |
42301 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42302 | C...KINEMATICS CHECK | |
42303 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42304 | LKNT=LKNT-1 | |
42305 | ENDIF | |
42306 | ENDIF | |
42307 | 140 CONTINUE | |
42308 | ENDIF | |
42309 | ||
42310 | C...LQD TYPE R-VIOLATION | |
42311 | IF (IMSS(52).GE.1) THEN | |
42312 | C...LOOP OVER DECAY MODES | |
42313 | DO 180 ISC=0,26 | |
42314 | ||
42315 | C...CHI+ -> NUBAR_I + DBAR_J + U_K | |
42316 | LKNT = LKNT+1 | |
42317 | IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) | |
42318 | IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) | |
42319 | IDLAM(LKNT,3) = 2 +2*MOD(ISC,3) | |
42320 | XLAM(LKNT) = 0D0 | |
42321 | C...Set coupling, and decay product masses on/off | |
42322 | RVLAMC = 3. * GW2 * 5D-1 * | |
42323 | & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 | |
42324 | DCMASS=.FALSE. | |
42325 | IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.6) | |
42326 | & DCMASS = .TRUE. | |
42327 | C...Resonance KF codes (1=I,2=J,3=K) | |
42328 | KFR(1)=0 | |
42329 | KFR(2)=0 | |
42330 | KFR(3)=-IDLAM(LKNT,3)+1 | |
42331 | C...Calculate width. | |
42332 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42333 | & ,XLAM(LKNT)) | |
42334 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42335 | C...KINEMATICS CHECK | |
42336 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42337 | LKNT=LKNT-1 | |
42338 | ENDIF | |
42339 | ||
42340 | C * CHI+ -> LEPTON+_I + UBAR_J + U_K. | |
42341 | 150 LKNT = LKNT+1 | |
42342 | IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) | |
42343 | IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3) | |
42344 | IDLAM(LKNT,3) = 2 +2*MOD(ISC,3) | |
42345 | XLAM(LKNT) = 0D0 | |
42346 | C...Set coupling, and decay product masses on/off | |
42347 | RVLAMC = 3. * GW2 * 5D-1 * | |
42348 | & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 | |
42349 | DCMASS=.FALSE. | |
42350 | IF (IDLAM(LKNT,1).EQ.-11.OR.IDLAM(LKNT,2).EQ.-6 | |
42351 | & .OR.IDLAM(LKNT,3).EQ.6) DCMASS = .TRUE. | |
42352 | C...Resonance KF codes (1=I,2=J,3=K) | |
42353 | KFR(1)=0 | |
42354 | KFR(2)=0 | |
42355 | KFR(3)=-IDLAM(LKNT,3)+1 | |
42356 | C...Calculate width. | |
42357 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42358 | & ,XLAM(LKNT)) | |
42359 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42360 | C...KINEMATICS CHECK | |
42361 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42362 | LKNT=LKNT-1 | |
42363 | ENDIF | |
42364 | ||
42365 | C * CHI+ -> LEPTON+_I + DBAR_J + D_K. | |
42366 | 160 LKNT = LKNT+1 | |
42367 | IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) | |
42368 | IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) | |
42369 | IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) | |
42370 | XLAM(LKNT) = 0D0 | |
42371 | C...Set coupling, and decay product masses on/off | |
42372 | RVLAMC = 3. * GW2 * 5D-1 * | |
42373 | & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 | |
42374 | DCMASS = .FALSE. | |
42375 | IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-5 | |
42376 | & .OR.IDLAM(LKNT,3).EQ.5) DCMASS = .TRUE. | |
42377 | C...Resonance KF codes (1=I,2=J,3=K) | |
42378 | KFR(1)=-IDLAM(LKNT,1)+1 | |
42379 | KFR(2)=-IDLAM(LKNT,2)+1 | |
42380 | KFR(3)=0 | |
42381 | C...Calculate width. | |
42382 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42383 | & ,XLAM(LKNT)) | |
42384 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42385 | C...KINEMATICS CHECK | |
42386 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42387 | LKNT=LKNT-1 | |
42388 | ENDIF | |
42389 | ||
42390 | C * CHI+ -> NU_I + U_J + DBAR_K. | |
42391 | 170 LKNT = LKNT+1 | |
42392 | IDLAM(LKNT,1) = 12 +2*MOD(ISC/9,3) | |
42393 | IDLAM(LKNT,2) = 2 +2*MOD(ISC/3,3) | |
42394 | IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) | |
42395 | XLAM(LKNT) = 0D0 | |
42396 | C...Set coupling, and decay product masses on/off | |
42397 | DCMASS = .FALSE. | |
42398 | RVLAMC = 3. * GW2 * 5D-1 * | |
42399 | & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 | |
42400 | IF (IDLAM(LKNT,2).EQ.6.OR.IDLAM(LKNT,3).EQ.-5) | |
42401 | & DCMASS = .TRUE. | |
42402 | C...Resonance KF codes (1=I,2=J,3=K) | |
42403 | KFR(1)=IDLAM(LKNT,1)-1 | |
42404 | KFR(2)=IDLAM(LKNT,2)-1 | |
42405 | KFR(3)=0 | |
42406 | C...Calculate width. | |
42407 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42408 | & ,XLAM(LKNT)) | |
42409 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42410 | C...KINEMATICS CHECK | |
42411 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42412 | LKNT=LKNT-1 | |
42413 | ENDIF | |
42414 | ||
42415 | 180 CONTINUE | |
42416 | ENDIF | |
42417 | ||
42418 | C...UDD TYPE R-VIOLATION | |
42419 | C...These decays need special treatment since more than one BV coupling | |
42420 | C...contributes (with interference). Consider e.g. (symbolically) | |
42421 | C |M|^2 = |l''_{ijk}|^2*(PYRVI1(RES_I) + PYRVI2(RES_I)) | |
42422 | C +|l''_{jik}|^2*(PYRVI1(RES_J) + PYRVI2(RES_J)) | |
42423 | C +l''_{ijk}*l''_{jik}*PYRVI3(PYRVI4(RES_I,RES_J)) | |
42424 | C...The problem is that a single call to PYRVGW would evaluate all | |
42425 | C...these terms and sum them, but without the different couplings. The | |
42426 | C...way out is to call PYRVGW three times, once for the first line, once | |
42427 | C...for the second line, and then once for all the lines (it is | |
42428 | C...impossible to get just the last line out) without multiplying by | |
42429 | C...couplings. The last line is then obtained as the result of the third | |
42430 | C...call minus the results of the two first calls. Each term is then | |
42431 | C...multiplied by its respective coupling before the whole thing is | |
42432 | C...summed up in XLAM. | |
42433 | C...Note that with three interfering resonances, this procedure becomes | |
42434 | C...more complicated, as can be seen in the CHI+ -> 3*DBAR mode. | |
42435 | ||
42436 | IF (IMSS(53).GE.1) THEN | |
42437 | C...LOOP OVER DECAY MODES | |
42438 | DO 190 ISC=1,25 | |
42439 | ||
42440 | C...CHI+ -> U_I + U_J + D_K | |
42441 | C...Decay mode I<->J symmetric. | |
42442 | IF (MOD(ISC/9,3).LE.MOD(ISC/3,3).AND.ISC.NE.13) THEN | |
42443 | LKNT = LKNT+1 | |
42444 | IDLAM(LKNT,1) = 2 +2*MOD(ISC/9,3) | |
42445 | IDLAM(LKNT,2) = 2 +2*MOD(ISC/3,3) | |
42446 | IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) | |
42447 | XLAM(LKNT) = 0D0 | |
42448 | C...Set coupling, and decay product masses on/off | |
42449 | RVLAMC= 6. * GW2 * 5D-1 | |
42450 | RVLJIK= RVLAMB(MOD(ISC/3,3)+1,MOD(ISC/9,3)+1,MOD(ISC,3) | |
42451 | & +1) | |
42452 | RVLIJK= RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3) | |
42453 | & +1) | |
42454 | IF (MOD(ISC/9,3).EQ.MOD(ISC/3,3)) RVLAMC = 5D-1 | |
42455 | & * RVLAMC | |
42456 | DCMASS=.FALSE. | |
42457 | IF (IDLAM(LKNT,1).EQ.6.OR.IDLAM(LKNT,2).EQ.6 | |
42458 | & .OR.IDLAM(LKNT,3).EQ.5) DCMASS =.TRUE. | |
42459 | C...Resonance KF codes (1=I,2=J,3=K) | |
42460 | KFR(1) = -IDLAM(LKNT,1)+1 | |
42461 | KFR(2) = 0 | |
42462 | KFR(3) = 0 | |
42463 | C...Calculate width. | |
42464 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42465 | & IDLAM(LKNT,3),XRESI) | |
42466 | C...Resonance KF codes (1=I,2=J,3=K) | |
42467 | KFR(1) = 0 | |
42468 | KFR(2) = -IDLAM(LKNT,2)+1 | |
42469 | KFR(3) = 0 | |
42470 | C...Calculate width. | |
42471 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42472 | & IDLAM(LKNT,3),XRESJ) | |
42473 | C...Resonance KF codes (1=I,2=J,3=K) | |
42474 | KFR(1) = -IDLAM(LKNT,1)+1 | |
42475 | KFR(2) = -IDLAM(LKNT,2)+1 | |
42476 | KFR(3) = 0 | |
42477 | C...Calculate width. | |
42478 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42479 | & IDLAM(LKNT,3),XRESIJ) | |
42480 | IF (ABS((XRESI+XRESJ)/XRESIJ-1.).GT.1D-4) THEN | |
42481 | XRESIJ = XRESIJ-XRESI-XRESJ | |
42482 | ELSE | |
42483 | XRESIJ = 0D0 | |
42484 | ENDIF | |
42485 | C...CALCULATE TOTAL WIDTH | |
42486 | XLAM(LKNT) = RVLJIK**2 * XRESI + RVLIJK**2 * XRESJ | |
42487 | & + RVLJIK*RVLIJK * XRESIJ | |
42488 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42489 | C...KINEMATICS CHECK | |
42490 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42491 | LKNT=LKNT-1 | |
42492 | ENDIF | |
42493 | ENDIF | |
42494 | C...CHI+ -> DBAR_I + DBAR_J + DBAR_K | |
42495 | C...Symmetry I<->J<->K. | |
42496 | IF ((MOD(ISC/9,3).LE.MOD(ISC/3,3)).AND.(MOD(ISC/3,3).LE | |
42497 | & .MOD(ISC,3)).AND.ISC.NE.13) THEN | |
42498 | LKNT = LKNT+1 | |
42499 | IDLAM(LKNT,1) = -1 -2*MOD(ISC/9,3) | |
42500 | IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) | |
42501 | IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) | |
42502 | XLAM(LKNT) = 0D0 | |
42503 | C...Set coupling, and decay product masses on/off | |
42504 | RVLAMC = 6. * GW2 * 5D-1 | |
42505 | RVLIJK = RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3) | |
42506 | & +1) | |
42507 | RVLKIJ = RVLAMB(MOD(ISC,3)+1,MOD(ISC/9,3)+1,MOD(ISC/3,3) | |
42508 | & +1) | |
42509 | RVLJKI = RVLAMB(MOD(ISC/3,3)+1,MOD(ISC,3)+1,MOD(ISC/9,3) | |
42510 | & +1) | |
42511 | DCMASS = .FALSE. | |
42512 | IF (IDLAM(LKNT,1).EQ.-5.OR.IDLAM(LKNT,2).EQ.-5 | |
42513 | & .OR.IDLAM(LKNT,3).EQ.-5) DCMASS = .TRUE. | |
42514 | C...Collect symmetry factors | |
42515 | IF (MOD(ISC/9,3).EQ.MOD(ISC/3,3).OR.MOD(ISC/3,3).EQ | |
42516 | & .MOD(ISC,3).OR.MOD(ISC/9,3).EQ.MOD(ISC,3)) | |
42517 | & RVLAMC = 5D-1 * RVLAMC | |
42518 | C...Resonance KF codes (1=I,2=J,3=K) | |
42519 | KFR(1) = IDLAM(LKNT,1)-1 | |
42520 | KFR(2) = 0 | |
42521 | KFR(3) = 0 | |
42522 | C...Calculate width. | |
42523 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42524 | & IDLAM(LKNT,3),XRESI) | |
42525 | C...Resonance KF codes (1=I,2=J,3=K) | |
42526 | KFR(1) = 0 | |
42527 | KFR(2) = IDLAM(LKNT,2)-1 | |
42528 | KFR(3) = 0 | |
42529 | C...Calculate width. | |
42530 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42531 | & IDLAM(LKNT,3),XRESJ) | |
42532 | C...Resonance KF codes (1=I,2=J,3=K) | |
42533 | KFR(1) = 0 | |
42534 | KFR(2) = 0 | |
42535 | KFR(3) = IDLAM(LKNT,3)-1 | |
42536 | C...Calculate width. | |
42537 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42538 | & IDLAM(LKNT,3),XRESK) | |
42539 | C...Resonance KF codes (1=I,2=J,3=K) | |
42540 | KFR(1) = IDLAM(LKNT,1)-1 | |
42541 | KFR(2) = IDLAM(LKNT,2)-1 | |
42542 | KFR(3) = 0 | |
42543 | C...Calculate width. | |
42544 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42545 | & IDLAM(LKNT,3),XRESIJ) | |
42546 | IF (ABS(XRESIJ/(XRESI+XRESJ)-1.).GT.1D-4) THEN | |
42547 | XRESIJ = XRESI+XRESJ-XRESIJ | |
42548 | ELSE | |
42549 | XRESIJ = 0D0 | |
42550 | ENDIF | |
42551 | C...Resonance KF codes (1=I,2=J,3=K) | |
42552 | KFR(1) = 0 | |
42553 | KFR(2) = IDLAM(LKNT,2)-1 | |
42554 | KFR(3) = IDLAM(LKNT,3)-1 | |
42555 | C...Calculate width. | |
42556 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42557 | & IDLAM(LKNT,3),XRESJK) | |
42558 | IF (ABS(XRESJK/(XRESJ+XRESK)-1.).GT.1D-4) THEN | |
42559 | XRESJK = XRESJ+XRESK-XRESJK | |
42560 | ELSE | |
42561 | XRESJK = 0D0 | |
42562 | ENDIF | |
42563 | C...Resonance KF codes (1=I,2=J,3=K) | |
42564 | KFR(1) = IDLAM(LKNT,1)-1 | |
42565 | KFR(2) = 0 | |
42566 | KFR(3) = IDLAM(LKNT,3)-1 | |
42567 | C...Calculate width. | |
42568 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), | |
42569 | & IDLAM(LKNT,3),XRESIK) | |
42570 | IF (ABS(XRESIK/(XRESI+XRESK)-1.).GT.1D-4) THEN | |
42571 | XRESIK = XRESI+XRESK-XRESIK | |
42572 | ELSE | |
42573 | XRESIK = 0D0 | |
42574 | ENDIF | |
42575 | C...CALCULATE TOTAL WIDTH | |
42576 | XLAM(LKNT) = | |
42577 | & RVLIJK**2 * XRESI | |
42578 | & + RVLJKI**2 * XRESJ | |
42579 | & + RVLKIJ**2 * XRESK | |
42580 | & + RVLIJK*RVLJKI * XRESIJ | |
42581 | & + RVLIJK*RVLKIJ * XRESIK | |
42582 | & + RVLJKI*RVLKIJ * XRESJK | |
42583 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2.*PARU(1)*RMS(0))**3*32) | |
42584 | C...KINEMATICS CHECK | |
42585 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42586 | LKNT=LKNT-1 | |
42587 | ENDIF | |
42588 | ENDIF | |
42589 | 190 CONTINUE | |
42590 | ENDIF | |
42591 | ENDIF | |
42592 | ENDIF | |
42593 | ||
42594 | RETURN | |
42595 | END | |
42596 | ||
42597 | C********************************************************************* | |
42598 | ||
42599 | C...PYRVGL | |
42600 | C...Calculates R-violating gluino decay widths. | |
42601 | C...See BV part of PYRVCH for comments about the way the BV decay width | |
42602 | C...is calculated. Same comments apply here. | |
42603 | C...P. Z. Skands | |
42604 | ||
42605 | SUBROUTINE PYRVGL(KFIN,XLAM,IDLAM,LKNT) | |
42606 | ||
42607 | C...Double precision and integer declarations. | |
42608 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
42609 | IMPLICIT INTEGER(I-N) | |
42610 | C...Parameter statement to help give large particle numbers. | |
42611 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
42612 | &KEXCIT=4000000,KDIMEN=5000000) | |
42613 | C...Commonblocks. | |
42614 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
42615 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
42616 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
42617 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
42618 | &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
42619 | COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) | |
42620 | C...Local variables. | |
42621 | DOUBLE PRECISION XLAM(0:400) | |
42622 | INTEGER IDLAM(400,3), PYCOMP | |
42623 | C...Information from main routine to PYRVGW | |
42624 | COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 | |
42625 | & ,DCMASS,KFR(3) | |
42626 | C...Auxiliary variables needed for BV (RV Gauge STOre) | |
42627 | COMMON/RVGSTO/XRESI,XRESJ,XRESK,XRESIJ,XRESIK,XRESJK,RVLIJK,RVLKIJ | |
42628 | & ,RVLJKI,RVLJIK | |
42629 | C...Running quark masses | |
42630 | DOUBLE PRECISION RMQ(6) | |
42631 | C...Decay product masses on/off | |
42632 | LOGICAL DCMASS | |
42633 | SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/, | |
42634 | & /RVGSTO/ | |
42635 | ||
42636 | C...IF LQD OR UDD TYPE R-VIOLATION ON. | |
42637 | IF (IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN | |
42638 | KFSM=KFIN-KSUSY1 | |
42639 | ||
42640 | C... AB(x,y,z): | |
42641 | C x=1-2 : Select A or B coupling (1:A ; 2:B) | |
42642 | C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ; | |
42643 | C 11-16:e,nu_e,mu,... not used here) | |
42644 | C z=1-2 : Mass eigenstate number | |
42645 | DO 100 I = 1,6 | |
42646 | C...A Couplings | |
42647 | AB(1,I,1) = SFMIX(I,2) | |
42648 | AB(1,I,2) = SFMIX(I,4) | |
42649 | C...B Couplings | |
42650 | AB(2,I,1) = -SFMIX(I,1) | |
42651 | AB(2,I,2) = -SFMIX(I,3) | |
42652 | 100 CONTINUE | |
42653 | GSTR2 = 4D0*PARU(1) * PYALPS(PMAS(PYCOMP(KFIN),1)**2) | |
42654 | C...LQD DECAYS. | |
42655 | IF (IMSS(52).GE.1) THEN | |
42656 | C...STEP IN I,J,K USING SINGLE COUNTER | |
42657 | DO 120 ISC=0,26 | |
42658 | C * GLUINO -> NUBAR_I + DBAR_J + D_K. | |
42659 | LKNT = LKNT+1 | |
42660 | IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) | |
42661 | IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) | |
42662 | IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) | |
42663 | XLAM(LKNT)=0D0 | |
42664 | C...Set coupling, and decay product masses on/off | |
42665 | RVLAMC=RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 | |
42666 | & * 5D-1 * GSTR2 | |
42667 | DCMASS = .FALSE. | |
42668 | IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.5) DCMASS=.TRUE. | |
42669 | C...Resonance KF codes (1=I,2=J,3=K) | |
42670 | KFR(1) = 0 | |
42671 | KFR(2) = -IDLAM(LKNT,2) | |
42672 | KFR(3) = -IDLAM(LKNT,3) | |
42673 | C...Calculate width. | |
42674 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42675 | & ,XLAM(LKNT)) | |
42676 | C...Normalize | |
42677 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42678 | C...Charge conjugate mode. | |
42679 | 110 LKNT = LKNT+1 | |
42680 | IDLAM(LKNT,1) =-IDLAM(LKNT-1,1) | |
42681 | IDLAM(LKNT,2) =-IDLAM(LKNT-1,2) | |
42682 | IDLAM(LKNT,3) =-IDLAM(LKNT-1,3) | |
42683 | XLAM(LKNT) = XLAM(LKNT-1) | |
42684 | C...KINEMATICS CHECK | |
42685 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42686 | LKNT=LKNT-2 | |
42687 | ENDIF | |
42688 | ||
42689 | C * GLUINO -> LEPTON+_I + UBAR_J + D_K | |
42690 | LKNT = LKNT+1 | |
42691 | IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) | |
42692 | IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3) | |
42693 | IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) | |
42694 | XLAM(LKNT)=0D0 | |
42695 | C...Set coupling, and decay product masses on/off | |
42696 | RVLAMC = RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1) | |
42697 | & **2* 5D-1 * GSTR2 | |
42698 | DCMASS = .FALSE. | |
42699 | IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-6 | |
42700 | & .OR.IDLAM(LKNT,3).EQ.5) DCMASS = .TRUE. | |
42701 | C...Resonance KF codes (1=I,2=J,3=K) | |
42702 | KFR(1) = 0 | |
42703 | KFR(2) = -IDLAM(LKNT,2) | |
42704 | KFR(3) = -IDLAM(LKNT,3) | |
42705 | C...Calculate width. | |
42706 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42707 | & ,XLAM(LKNT)) | |
42708 | XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42709 | C...Charge conjugate mode. | |
42710 | LKNT=LKNT+1 | |
42711 | IDLAM(LKNT,1) = -IDLAM(LKNT-1,1) | |
42712 | IDLAM(LKNT,2) = -IDLAM(LKNT-1,2) | |
42713 | IDLAM(LKNT,3) = -IDLAM(LKNT-1,3) | |
42714 | XLAM(LKNT) = XLAM(LKNT-1) | |
42715 | C...KINEMATICS CHECK | |
42716 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42717 | LKNT=LKNT-2 | |
42718 | ENDIF | |
42719 | ||
42720 | 120 CONTINUE | |
42721 | ENDIF | |
42722 | ||
42723 | C...UDD DECAYS. | |
42724 | IF (IMSS(53).GE.1) THEN | |
42725 | C...STEP IN I,J,K USING SINGLE COUNTER | |
42726 | DO 130 ISC=0,26 | |
42727 | C * GLUINO -> UBAR_I + DBAR_J + DBAR_K. | |
42728 | IF (MOD(ISC/3,3).LT.MOD(ISC,3)) THEN | |
42729 | LKNT = LKNT+1 | |
42730 | IDLAM(LKNT,1) = -2 -2*MOD(ISC/9,3) | |
42731 | IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) | |
42732 | IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) | |
42733 | XLAM(LKNT)=0D0 | |
42734 | C...Set coupling, and decay product masses on/off. A factor of 2 for | |
42735 | C...(N_C-1) has been used to cancel a factor 0.5. | |
42736 | RVLAMC=RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1) | |
42737 | & **2 * GSTR2 | |
42738 | DCMASS = .FALSE. | |
42739 | IF (IDLAM(LKNT,1).EQ.-6.OR.IDLAM(LKNT,2).EQ.-5 | |
42740 | & .OR.IDLAM(LKNT,3).EQ.-5) DCMASS=.TRUE. | |
42741 | C...Resonance KF codes (1=I,2=J,3=K) | |
42742 | KFR(1) = IDLAM(LKNT,1) | |
42743 | KFR(2) = 0 | |
42744 | KFR(3) = 0 | |
42745 | C...Calculate width. | |
42746 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42747 | & ,XRESI) | |
42748 | C...Resonance KF codes (1=I,2=J,3=K) | |
42749 | KFR(1) = 0 | |
42750 | KFR(2) = IDLAM(LKNT,2) | |
42751 | KFR(3) = 0 | |
42752 | C...Calculate width. | |
42753 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42754 | & ,XRESJ) | |
42755 | C...Resonance KF codes (1=I,2=J,3=K) | |
42756 | KFR(1) = 0 | |
42757 | KFR(2) = 0 | |
42758 | KFR(3) = IDLAM(LKNT,3) | |
42759 | C...Calculate width. | |
42760 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42761 | & ,XRESK) | |
42762 | C...Resonance KF codes (1=I,2=J,3=K) | |
42763 | KFR(1) = IDLAM(LKNT,1) | |
42764 | KFR(2) = IDLAM(LKNT,2) | |
42765 | KFR(3) = 0 | |
42766 | C...Calculate width. | |
42767 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42768 | & ,XRESIJ) | |
42769 | C...Calculate interference function. (Factor -1/2 to make up for factor | |
42770 | C...-2 in PYRVGW. | |
42771 | IF (ABS((XRESI+XRESJ)/XRESIJ-1D0).GT.1D-4) THEN | |
42772 | XRESIJ = 5D-1 * (XRESI+XRESJ-XRESIJ) | |
42773 | ELSE | |
42774 | XRESIJ = 0D0 | |
42775 | ENDIF | |
42776 | C...Resonance KF codes (1=I,2=J,3=K) | |
42777 | KFR(1) = 0 | |
42778 | KFR(2) = IDLAM(LKNT,2) | |
42779 | KFR(3) = IDLAM(LKNT,3) | |
42780 | C...Calculate width. | |
42781 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42782 | & ,XRESJK) | |
42783 | IF (ABS((XRESJ+XRESK)/XRESJK-1).GT.1D-4) THEN | |
42784 | XRESJK = 5D-1 * (XRESJ+XRESK-XRESJK) | |
42785 | ELSE | |
42786 | XRESJK = 0D0 | |
42787 | ENDIF | |
42788 | C...Resonance KF codes (1=I,2=J,3=K) | |
42789 | KFR(1) = IDLAM(LKNT,1) | |
42790 | KFR(2) = 0 | |
42791 | KFR(3) = IDLAM(LKNT,3) | |
42792 | C...Calculate width. | |
42793 | CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) | |
42794 | & ,XRESIK) | |
42795 | IF (ABS((XRESI+XRESK)/XRESIK-1).GT.1D-4) THEN | |
42796 | XRESIK = 5D-1 * (XRESI+XRESK-XRESIK) | |
42797 | ELSE | |
42798 | XRESIK = 0D0 | |
42799 | ENDIF | |
42800 | C...Calculate total width (factor 1/2 from 1/(N_C-1)) | |
42801 | XLAM(LKNT) = XRESI + XRESJ + XRESK | |
42802 | & + 5D-1 * (XRESIJ + XRESIK + XRESJK) | |
42803 | C...Normalize | |
42804 | XLAM(LKNT) = XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) | |
42805 | C...Charge conjugate mode. | |
42806 | LKNT = LKNT+1 | |
42807 | IDLAM(LKNT,1) =-IDLAM(LKNT-1,1) | |
42808 | IDLAM(LKNT,2) =-IDLAM(LKNT-1,2) | |
42809 | IDLAM(LKNT,3) =-IDLAM(LKNT-1,3) | |
42810 | XLAM(LKNT) = XLAM(LKNT-1) | |
42811 | C...KINEMATICS CHECK | |
42812 | IF (XLAM(LKNT).EQ.0D0) THEN | |
42813 | LKNT=LKNT-2 | |
42814 | ENDIF | |
42815 | ENDIF | |
42816 | 130 CONTINUE | |
42817 | ENDIF | |
42818 | ENDIF | |
42819 | RETURN | |
42820 | END | |
42821 | ||
42822 | C********************************************************************* | |
42823 | ||
42824 | C...PYRVSB | |
42825 | C...Auxiliary function to PYRVSF for calculating R-Violating | |
42826 | C...sfermion widths. Though the decay products are most often treated | |
42827 | C...as massless in the calculation, the kinematical boundary of phase | |
42828 | C...space is tested using the true masses. | |
42829 | C...MODE = 1: All decay products massive | |
42830 | C...MODE = 2: Decay product 1 massless | |
42831 | C...MODE = 3: Decay product 2 massless | |
42832 | C...MODE = 4: All decay products massless | |
42833 | ||
42834 | FUNCTION PYRVSB(KFIN,ID1,ID2,RM2,MODE) | |
42835 | ||
42836 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
42837 | IMPLICIT INTEGER (I-N) | |
42838 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
42839 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
42840 | SAVE /PYDAT1/,/PYDAT2/ | |
42841 | DOUBLE PRECISION SM(3) | |
42842 | INTEGER PYCOMP, KC(3) | |
42843 | KC(1)=PYCOMP(KFIN) | |
42844 | KC(2)=PYCOMP(ID1) | |
42845 | KC(3)=PYCOMP(ID2) | |
42846 | SM(1)=PMAS(KC(1),1)**2 | |
42847 | SM(2)=PMAS(KC(2),1)**2 | |
42848 | SM(3)=PMAS(KC(3),1)**2 | |
42849 | C...Kinematics check | |
42850 | IF ((SM(1)-(PMAS(KC(2),1)+PMAS(KC(3),1))**2).LE.0D0) THEN | |
42851 | PYRVSB=0D0 | |
42852 | RETURN | |
42853 | ENDIF | |
42854 | C...CM momenta squared | |
42855 | IF (MODE.EQ.1) THEN | |
42856 | P2CM=1./(4*SM(1))*(SM(1)-(PMAS(KC(2),1)+PMAS(KC(3),1))**2) | |
42857 | & * (SM(1)-(PMAS(KC(2),1)-PMAS(KC(3),1))**2) | |
42858 | ELSE IF (MODE.EQ.2) THEN | |
42859 | P2CM=1./(4*SM(1))*(SM(1)-(PMAS(KC(3),1))**2)**2 | |
42860 | ELSE IF (MODE.EQ.3) THEN | |
42861 | P2CM=1./(4*SM(1))*(SM(1)-(PMAS(KC(2),1))**2)**2 | |
42862 | ELSE | |
42863 | P2CM=SM(1)/4. | |
42864 | ENDIF | |
42865 | C...Calculate Width | |
42866 | PYRVSB=RM2*SQRT(MAX(0D0,P2CM))/(8*PARU(1)*SM(1)) | |
42867 | RETURN | |
42868 | END | |
42869 | ||
42870 | C********************************************************************* | |
42871 | ||
42872 | C...PYRVGW | |
42873 | C...Generalized Matrix Element for R-Violating 3-body widths. | |
42874 | C...P. Z. Skands | |
42875 | SUBROUTINE PYRVGW(KFIN,ID1,ID2,ID3,XLAM) | |
42876 | ||
42877 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
42878 | IMPLICIT INTEGER (I-N) | |
42879 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
42880 | &KEXCIT=4000000,KDIMEN=5000000) | |
42881 | PARAMETER (EPS=1D-4) | |
42882 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
42883 | COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 | |
42884 | & ,DCMASS,KFR(3) | |
42885 | COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), | |
42886 | & SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) | |
42887 | DOUBLE PRECISION XLIM(3,3) | |
42888 | INTEGER KC(0:3), PYCOMP | |
42889 | LOGICAL DCMASS, DCHECK(6) | |
42890 | SAVE /PYDAT2/,/PYRVNV/,/PYSSMT/ | |
42891 | ||
42892 | XLAM = 0D0 | |
42893 | ||
42894 | KC(0) = PYCOMP(KFIN) | |
42895 | KC(1) = PYCOMP(ID1) | |
42896 | KC(2) = PYCOMP(ID2) | |
42897 | KC(3) = PYCOMP(ID3) | |
42898 | RMS(0) = PMAS(KC(0),1) | |
42899 | RMS(1) = PYMRUN(ID1,PMAS(KC(1),1)**2) | |
42900 | RMS(2) = PYMRUN(ID2,PMAS(KC(2),1)**2) | |
42901 | RMS(3) = PYMRUN(ID3,PMAS(KC(3),1)**2) | |
42902 | C...INITIALIZE OUTER INTEGRATION LIMITS AND KINEMATICS CHECK | |
42903 | XLIM(1,1)=(RMS(1)+RMS(2))**2 | |
42904 | XLIM(1,2)=(RMS(0)-RMS(3))**2 | |
42905 | XLIM(1,3)=XLIM(1,2)-XLIM(1,1) | |
42906 | XLIM(2,1)=(RMS(2)+RMS(3))**2 | |
42907 | XLIM(2,2)=(RMS(0)-RMS(1))**2 | |
42908 | XLIM(2,3)=XLIM(2,2)-XLIM(2,1) | |
42909 | XLIM(3,1)=(RMS(1)+RMS(3))**2 | |
42910 | XLIM(3,2)=(RMS(0)-RMS(2))**2 | |
42911 | XLIM(3,3)=XLIM(3,2)-XLIM(3,1) | |
42912 | C...Check Phase Space | |
42913 | IF (XLIM(1,3).LT.0D0.OR.XLIM(2,3).LT.0D0.OR.XLIM(3,3).LT.0D0) THEN | |
42914 | RETURN | |
42915 | ENDIF | |
42916 | ||
42917 | C...INITIALIZE RESONANCE INFORMATION | |
42918 | DO 110 JRES = 1,3 | |
42919 | DO 100 IMASS = 1,2 | |
42920 | IRES = 2*(JRES-1)+IMASS | |
42921 | INTRES(IRES,1) = 0 | |
42922 | DCHECK(IRES) =.FALSE. | |
42923 | C...NO RIGHT-HANDED NEUTRINOS | |
42924 | IF (((IMASS.EQ.2).AND.((IABS(KFR(JRES)).EQ.12).OR | |
42925 | & .(IABS(KFR(JRES)).EQ.14).OR.(IABS(KFR(JRES)).EQ.16))).OR | |
42926 | & .KFR(JRES).EQ.0) GOTO 100 | |
42927 | RES(IRES,1) = PMAS(PYCOMP(IMASS*KSUSY1+IABS(KFR(JRES))),1) | |
42928 | RES(IRES,2) = PMAS(PYCOMP(IMASS*KSUSY1+IABS(KFR(JRES))),2) | |
42929 | INTRES(IRES,1) = IABS(KFR(JRES)) | |
42930 | INTRES(IRES,2) = IMASS | |
42931 | IF (KFR(JRES).LT.0) INTRES(IRES,3) = 1 | |
42932 | IF (KFR(JRES).GT.0) INTRES(IRES,3) = 0 | |
42933 | 100 CONTINUE | |
42934 | 110 CONTINUE | |
42935 | ||
42936 | C...SUM OVER DIAGRAMS AND INTEGRATE OVER PHASE SPACE | |
42937 | ||
42938 | C...RESONANCE CONTRIBUTIONS | |
42939 | C...(Only sum contributions where the resonance is off shell). | |
42940 | C...Store whether diagram on/off in DCHECK. | |
42941 | C...LOOP OVER MASS STATES | |
42942 | DO 120 J=1,2 | |
42943 | IDR=J | |
42944 | TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2 | |
42945 | IF ((RMS(0).LT.(RMS(1)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(2) | |
42946 | & +RMS(3)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN | |
42947 | DCHECK(IDR) =.TRUE. | |
42948 | XLAM = XLAM + TMIX * PYRVI1(2,3,1) | |
42949 | ENDIF | |
42950 | ||
42951 | IDR=J+2 | |
42952 | TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2 | |
42953 | IF ((RMS(0).LT.(RMS(2)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(1) | |
42954 | & +RMS(3)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN | |
42955 | DCHECK(IDR) =.TRUE. | |
42956 | XLAM = XLAM + TMIX * PYRVI1(1,3,2) | |
42957 | ENDIF | |
42958 | ||
42959 | IDR=J+4 | |
42960 | TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2 | |
42961 | IF ((RMS(0).LT.(RMS(3)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(1) | |
42962 | & +RMS(2)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN | |
42963 | DCHECK(IDR) =.TRUE. | |
42964 | XLAM = XLAM + TMIX * PYRVI1(1,2,3) | |
42965 | ENDIF | |
42966 | 120 CONTINUE | |
42967 | C... L-R INTERFERENCES | |
42968 | C... (Only add contributions where both contributing diagrams | |
42969 | C... are non-resonant). | |
42970 | IDR=1 | |
42971 | IF (DCHECK(1).AND.DCHECK(2)) THEN | |
42972 | C...Bug corrected 11/12 2001. Skands. | |
42973 | XLAM = XLAM + 2D0 * PYRVI2(2,3,1) | |
42974 | & * SFMIX(INTRES(1,1),2+INTRES(1,3)-1) | |
42975 | & * SFMIX(INTRES(2,1),4+INTRES(2,3)-1) | |
42976 | ENDIF | |
42977 | ||
42978 | IDR=3 | |
42979 | IF (DCHECK(3).AND.DCHECK(4)) THEN | |
42980 | XLAM = XLAM + 2D0 * PYRVI2(1,3,2) | |
42981 | & * SFMIX(INTRES(3,1),2+INTRES(3,3)-1) | |
42982 | & * SFMIX(INTRES(4,1),4+INTRES(4,3)-1) | |
42983 | ENDIF | |
42984 | ||
42985 | IDR=5 | |
42986 | IF (DCHECK(5).AND.DCHECK(6)) THEN | |
42987 | XLAM = XLAM + 2D0 * PYRVI2(1,2,3) | |
42988 | & * SFMIX(INTRES(5,1),2+INTRES(5,3)-1) | |
42989 | & * SFMIX(INTRES(6,1),4+INTRES(6,3)-1) | |
42990 | ENDIF | |
42991 | C... TRUE INTERFERENCES | |
42992 | C... (Only add contributions where both contributing diagrams | |
42993 | C... are non-resonant). | |
42994 | PREF=-2D0 | |
42995 | IF ((KFIN-KSUSY1).EQ.24.OR.(KFIN-KSUSY1).EQ.37) PREF=2D0 | |
42996 | DO 140 IKR1 = 1,2 | |
42997 | DO 130 IKR2 = 1,2 | |
42998 | IDR = IKR1+2 | |
42999 | IDR2 = IKR2 | |
43000 | IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN | |
43001 | XLAM = XLAM + PREF*PYRVI3(1,3,2) * | |
43002 | & SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1) | |
43003 | & *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1) | |
43004 | ENDIF | |
43005 | ||
43006 | IDR = IKR1+4 | |
43007 | IDR2 = IKR2 | |
43008 | IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN | |
43009 | XLAM = XLAM + PREF*PYRVI3(1,2,3) * | |
43010 | & SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1) | |
43011 | & *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1) | |
43012 | ENDIF | |
43013 | ||
43014 | IDR = IKR1+4 | |
43015 | IDR2 = IKR2+2 | |
43016 | IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN | |
43017 | XLAM = XLAM + PREF*PYRVI3(2,1,3) * | |
43018 | & SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1) | |
43019 | & *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1) | |
43020 | ENDIF | |
43021 | 130 CONTINUE | |
43022 | 140 CONTINUE | |
43023 | ||
43024 | RETURN | |
43025 | END | |
43026 | ||
43027 | C********************************************************************* | |
43028 | ||
43029 | C...PYRVI1 | |
43030 | C...Function to integrate resonance contributions | |
43031 | ||
43032 | FUNCTION PYRVI1(ID1,ID2,ID3) | |
43033 | ||
43034 | IMPLICIT NONE | |
43035 | DOUBLE PRECISION LO,HI,PYRVI1,PYRVG1,PYGAUS | |
43036 | DOUBLE PRECISION RES, AB, RM, RESM, RESW, A, B, RMS | |
43037 | INTEGER ID1,ID2,ID3, IDR, IDR2, KFR, INTRES | |
43038 | LOGICAL MFLAG,DCMASS | |
43039 | EXTERNAL PYRVG1,PYGAUS | |
43040 | COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 | |
43041 | & ,DCMASS,KFR(3) | |
43042 | COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG | |
43043 | SAVE/PYRVNV/,/PYRVPM/ | |
43044 | C...Initialize mass and width information | |
43045 | PYRVI1 = 0D0 | |
43046 | RM(0) = RMS(0) | |
43047 | RM(1) = RMS(ID1) | |
43048 | RM(2) = RMS(ID2) | |
43049 | RM(3) = RMS(ID3) | |
43050 | RESM(1)= RES(IDR,1) | |
43051 | RESW(1)= RES(IDR,2) | |
43052 | C...A->B and B->A for antisparticles | |
43053 | A(1) = AB(1+INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) | |
43054 | B(1) = AB(2-INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) | |
43055 | C...Integration boundaries and mass flag | |
43056 | LO = (RM(1)+RM(2))**2 | |
43057 | HI = (RM(0)-RM(3))**2 | |
43058 | MFLAG = DCMASS | |
43059 | PYRVI1 = PYGAUS(PYRVG1,LO,HI,1D-3) | |
43060 | RETURN | |
43061 | END | |
43062 | ||
43063 | C********************************************************************* | |
43064 | ||
43065 | C...PYRVI2 | |
43066 | C...Function to integrate L-R interference contributions | |
43067 | ||
43068 | FUNCTION PYRVI2(ID1,ID2,ID3) | |
43069 | ||
43070 | IMPLICIT NONE | |
43071 | DOUBLE PRECISION LO,HI,PYRVI2, PYRVG2, PYGAUS | |
43072 | DOUBLE PRECISION RES, AB, RM, RESM, RESW, A, B, RMS | |
43073 | INTEGER ID1,ID2,ID3, IDR, IDR2, KFR, INTRES | |
43074 | LOGICAL MFLAG,DCMASS | |
43075 | EXTERNAL PYRVG2,PYGAUS | |
43076 | COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 | |
43077 | & ,DCMASS,KFR(3) | |
43078 | COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG | |
43079 | SAVE/PYRVNV/,/PYRVPM/ | |
43080 | C...Initialize mass and width information | |
43081 | PYRVI2 = 0D0 | |
43082 | RM(0) = RMS(0) | |
43083 | RM(1) = RMS(ID1) | |
43084 | RM(2) = RMS(ID2) | |
43085 | RM(3) = RMS(ID3) | |
43086 | RESM(1)= RES(IDR,1) | |
43087 | RESW(1)= RES(IDR,2) | |
43088 | RESM(2)= RES(IDR+1,1) | |
43089 | RESW(2)= RES(IDR+1,2) | |
43090 | C...A->B and B->A for antisparticles | |
43091 | A(1) = AB(1+INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) | |
43092 | B(1) = AB(2-INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) | |
43093 | A(2) = AB(1+INTRES(IDR+1,3),INTRES(IDR+1,1),INTRES(IDR+1,2)) | |
43094 | B(2) = AB(2-INTRES(IDR+1,3),INTRES(IDR+1,1),INTRES(IDR+1,2)) | |
43095 | C...Boundaries and mass flag | |
43096 | LO = (RM(1)+RM(2))**2 | |
43097 | HI = (RM(0)-RM(3))**2 | |
43098 | MFLAG = DCMASS | |
43099 | PYRVI2 = PYGAUS(PYRVG2,LO,HI,1D-3) | |
43100 | RETURN | |
43101 | END | |
43102 | ||
43103 | C********************************************************************* | |
43104 | ||
43105 | C...PYRVI3 | |
43106 | C...Function to integrate true interference contributions | |
43107 | ||
43108 | FUNCTION PYRVI3(ID1,ID2,ID3) | |
43109 | ||
43110 | IMPLICIT NONE | |
43111 | DOUBLE PRECISION LO,HI,PYRVI3, PYRVG3, PYGAUS | |
43112 | DOUBLE PRECISION RES, AB, RM, RESM, RESW, A, B, RMS | |
43113 | INTEGER ID1,ID2,ID3, IDR, IDR2, KFR, INTRES | |
43114 | LOGICAL MFLAG,DCMASS | |
43115 | EXTERNAL PYRVG3,PYGAUS | |
43116 | COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 | |
43117 | & ,DCMASS,KFR(3) | |
43118 | COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG | |
43119 | SAVE/PYRVNV/,/PYRVPM/ | |
43120 | C...Initialize mass and width information | |
43121 | PYRVI3 = 0D0 | |
43122 | RM(0) = RMS(0) | |
43123 | RM(1) = RMS(ID1) | |
43124 | RM(2) = RMS(ID2) | |
43125 | RM(3) = RMS(ID3) | |
43126 | RESM(1)= RES(IDR,1) | |
43127 | RESW(1)= RES(IDR,2) | |
43128 | RESM(2)= RES(IDR2,1) | |
43129 | RESW(2)= RES(IDR2,2) | |
43130 | C...A -> B and B -> A for antisparticles | |
43131 | A(1) = AB(1+INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) | |
43132 | B(1) = AB(2-INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) | |
43133 | A(2) = AB(1+INTRES(IDR2,3),INTRES(IDR2,1),INTRES(IDR2,2)) | |
43134 | B(2) = AB(2-INTRES(IDR2,3),INTRES(IDR2,1),INTRES(IDR2,2)) | |
43135 | C...Boundaries and mass flag | |
43136 | LO = (RM(1)+RM(2))**2 | |
43137 | HI = (RM(0)-RM(3))**2 | |
43138 | MFLAG = DCMASS | |
43139 | PYRVI3 = PYGAUS(PYRVG3,LO,HI,1D-3) | |
43140 | RETURN | |
43141 | END | |
43142 | ||
43143 | C********************************************************************* | |
43144 | ||
43145 | C...PYRVG1 | |
43146 | C...Integrand for resonance contributions | |
43147 | ||
43148 | FUNCTION PYRVG1(X) | |
43149 | ||
43150 | IMPLICIT NONE | |
43151 | COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG | |
43152 | DOUBLE PRECISION X, RM, A, B, RESM, RESW, DELTAY,PYRVR | |
43153 | DOUBLE PRECISION RVR,PYRVG1,E2,E3,C1,SR1,SR2,A1,A2 | |
43154 | LOGICAL MFLAG | |
43155 | SAVE/PYRVPM/ | |
43156 | RVR = PYRVR(X,RESM(1),RESW(1)) | |
43157 | C1 = 2D0*SQRT(MAX(0D0,X)) | |
43158 | IF (.NOT.MFLAG) THEN | |
43159 | E2 = X/C1 | |
43160 | E3 = (RM(0)**2-X)/C1 | |
43161 | DELTAY = 4D0*E2*E3 | |
43162 | PYRVG1 = DELTAY*RVR*X*(A(1)**2+B(1)**2)*(RM(0)**2-X) | |
43163 | ELSE | |
43164 | E2 = (X-RM(1)**2+RM(2)**2)/C1 | |
43165 | E3 = (RM(0)**2-X-RM(3)**2)/C1 | |
43166 | SR1 = SQRT(MAX(0D0,E2**2-RM(2)**2)) | |
43167 | SR2 = SQRT(MAX(0D0,E3**2-RM(3)**2)) | |
43168 | DELTAY = 4D0*SR1*SR2 | |
43169 | A1 = 4.*A(1)*B(1)*RM(3)*RM(0) | |
43170 | A2 = (A(1)**2+B(1)**2)*(RM(0)**2+RM(3)**2-X) | |
43171 | PYRVG1 = DELTAY*RVR*(X-RM(1)**2-RM(2)**2)*(A1+A2) | |
43172 | ENDIF | |
43173 | RETURN | |
43174 | END | |
43175 | ||
43176 | C********************************************************************* | |
43177 | ||
43178 | C...PYRVG2 | |
43179 | C...Integrand for L-R interference contributions | |
43180 | ||
43181 | FUNCTION PYRVG2(X) | |
43182 | ||
43183 | IMPLICIT NONE | |
43184 | COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG | |
43185 | DOUBLE PRECISION X, RM, A, B, RESM, RESW, DELTAY, PYRVS | |
43186 | DOUBLE PRECISION RVS,PYRVG2,E2,E3,C1,SR1,SR2 | |
43187 | LOGICAL MFLAG | |
43188 | SAVE/PYRVPM/ | |
43189 | C1 = 2D0*SQRT(MAX(0D0,X)) | |
43190 | RVS = PYRVS(X,X,RESM(1),RESW(1),RESM(2),RESW(2)) | |
43191 | IF (.NOT.MFLAG) THEN | |
43192 | E2 = X/C1 | |
43193 | E3 = (RM(0)**2-X)/C1 | |
43194 | DELTAY = 4D0*E2*E3 | |
43195 | PYRVG2 = DELTAY*RVS*X*(A(1)*A(2)+B(1)*B(2))*(RM(0)**2-X) | |
43196 | ELSE | |
43197 | E2 = (X-RM(1)**2+RM(2)**2)/C1 | |
43198 | E3 = (RM(0)**2-X-RM(3)**2)/C1 | |
43199 | SR1 = SQRT(MAX(0D0,E2**2-RM(2)**2)) | |
43200 | SR2 = SQRT(MAX(0D0,E3**2-RM(3)**2)) | |
43201 | DELTAY = 4D0*SR1*SR2 | |
43202 | PYRVG2 = DELTAY*RVS*(X-RM(1)**2-RM(2)**2)*((A(1)*A(2) | |
43203 | & + B(1)*B(2))*(RM(0)**2+RM(3)**2-X) | |
43204 | & + 2D0*(A(1)*B(2)+A(2)*B(1))*RM(3)*RM(0)) | |
43205 | ENDIF | |
43206 | RETURN | |
43207 | END | |
43208 | ||
43209 | C********************************************************************* | |
43210 | ||
43211 | C...PYRVG3 | |
43212 | C...Function to do Y integration over true interference contributions | |
43213 | ||
43214 | FUNCTION PYRVG3(X) | |
43215 | ||
43216 | IMPLICIT NONE | |
43217 | COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG | |
43218 | C...Second Dalitz variable for PYRVG4 | |
43219 | COMMON/PYG2DX/X1 | |
43220 | DOUBLE PRECISION RM, A, B, RESM, RESW, X, X1 | |
43221 | DOUBLE PRECISION E2, E3, C1, SQ1, SR1, SR2, YMIN, YMAX | |
43222 | DOUBLE PRECISION PYRVG3, PYRVG4, PYGAU2 | |
43223 | LOGICAL MFLAG | |
43224 | EXTERNAL PYGAU2,PYRVG4 | |
43225 | SAVE/PYRVPM/,/PYG2DX/ | |
43226 | PYRVG3=0D0 | |
43227 | C1=2D0*SQRT(MAX(1D-9,X)) | |
43228 | X1=X | |
43229 | IF (.NOT.MFLAG) THEN | |
43230 | E2 = X/C1 | |
43231 | E3 = (RM(0)**2-X)/C1 | |
43232 | YMIN = 0D0 | |
43233 | YMAX = 4D0*E2*E3 | |
43234 | ELSE | |
43235 | E2 = (X-RM(1)**2+RM(2)**2)/C1 | |
43236 | E3 = (RM(0)**2-X-RM(3)**2)/C1 | |
43237 | SQ1 = (E2+E3)**2 | |
43238 | SR1 = SQRT(MAX(0D0,E2**2-RM(2)**2)) | |
43239 | SR2 = SQRT(MAX(0D0,E3**2-RM(3)**2)) | |
43240 | YMIN = SQ1-(SR1+SR2)**2 | |
43241 | YMAX = SQ1-(SR1-SR2)**2 | |
43242 | ENDIF | |
43243 | PYRVG3 = PYGAU2(PYRVG4,YMIN,YMAX,1D-3) | |
43244 | RETURN | |
43245 | END | |
43246 | ||
43247 | C********************************************************************* | |
43248 | ||
43249 | C...PYRVG4 | |
43250 | C...Integrand for true intereference contributions | |
43251 | ||
43252 | FUNCTION PYRVG4(Y) | |
43253 | ||
43254 | IMPLICIT NONE | |
43255 | COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG | |
43256 | COMMON/PYG2DX/X | |
43257 | DOUBLE PRECISION X, Y, PYRVG4, RM, A, B, RESM, RESW, RVS, PYRVS | |
43258 | LOGICAL MFLAG | |
43259 | SAVE /PYRVPM/,/PYG2DX/ | |
43260 | PYRVG4=0D0 | |
43261 | RVS=PYRVS(X,Y,RESM(1),RESW(1),RESM(2),RESW(2)) | |
43262 | IF (.NOT.MFLAG) THEN | |
43263 | PYRVG4 = RVS*B(1)*B(2)*X*Y | |
43264 | ELSE | |
43265 | PYRVG4 = RVS*(RM(1)*RM(3)*A(1)*A(2)*(X+Y-RM(1)**2-RM(3)**2) | |
43266 | & + RM(1)*RM(0)*B(1)*A(2)*(Y-RM(2)**2-RM(3)**2) | |
43267 | & + RM(3)*RM(0)*A(1)*B(2)*(X-RM(1)**2-RM(2)**2) | |
43268 | & + B(1)*B(2)*(X*Y-(RM(1)*RM(3))**2-(RM(0)*RM(2))**2)) | |
43269 | ENDIF | |
43270 | RETURN | |
43271 | END | |
43272 | ||
43273 | C********************************************************************* | |
43274 | ||
43275 | C...PYRVR | |
43276 | C...Breit-Wigner for resonance contributions | |
43277 | ||
43278 | FUNCTION PYRVR(Mab2,RM,RW) | |
43279 | ||
43280 | IMPLICIT NONE | |
43281 | DOUBLE PRECISION Mab2,RM,RW,PYRVR | |
43282 | PYRVR = 1D0/((Mab2-RM**2)**2+RM**2*RW**2) | |
43283 | RETURN | |
43284 | END | |
43285 | ||
43286 | C********************************************************************* | |
43287 | ||
43288 | C...PYRVS | |
43289 | C...Interference function | |
43290 | ||
43291 | FUNCTION PYRVS(X,Y,M1,W1,M2,W2) | |
43292 | ||
43293 | IMPLICIT NONE | |
43294 | DOUBLE PRECISION X, Y, PYRVS, PYRVR, M1, M2, W1, W2 | |
43295 | PYRVS = PYRVR(X,M1,W1)*PYRVR(Y,M2,W2)*((X-M1**2)*(Y-M2**2) | |
43296 | & +W1*W2*M1*M2) | |
43297 | RETURN | |
43298 | END | |
43299 | ||
43300 | C********************************************************************* | |
43301 | ||
43302 | C...PY1ENT | |
43303 | C...Stores one parton/particle in commonblock PYJETS. | |
43304 | ||
43305 | SUBROUTINE PY1ENT(IP,KF,PE,THE,PHI) | |
43306 | ||
43307 | C...Double precision and integer declarations. | |
43308 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
43309 | IMPLICIT INTEGER(I-N) | |
43310 | INTEGER PYK,PYCHGE,PYCOMP | |
43311 | C...Commonblocks. | |
43312 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
43313 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
43314 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
43315 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
43316 | ||
43317 | C...Standard checks. | |
43318 | MSTU(28)=0 | |
43319 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
43320 | IPA=MAX(1,IABS(IP)) | |
43321 | IF(IPA.GT.MSTU(4)) CALL PYERRM(21, | |
43322 | &'(PY1ENT:) writing outside PYJETS memory') | |
43323 | KC=PYCOMP(KF) | |
43324 | IF(KC.EQ.0) CALL PYERRM(12,'(PY1ENT:) unknown flavour code') | |
43325 | ||
43326 | C...Find mass. Reset K, P and V vectors. | |
43327 | PM=0D0 | |
43328 | IF(MSTU(10).EQ.1) PM=P(IPA,5) | |
43329 | IF(MSTU(10).GE.2) PM=PYMASS(KF) | |
43330 | DO 100 J=1,5 | |
43331 | K(IPA,J)=0 | |
43332 | P(IPA,J)=0D0 | |
43333 | V(IPA,J)=0D0 | |
43334 | 100 CONTINUE | |
43335 | ||
43336 | C...Store parton/particle in K and P vectors. | |
43337 | K(IPA,1)=1 | |
43338 | IF(IP.LT.0) K(IPA,1)=2 | |
43339 | K(IPA,2)=KF | |
43340 | P(IPA,5)=PM | |
43341 | P(IPA,4)=MAX(PE,PM) | |
43342 | PA=SQRT(P(IPA,4)**2-P(IPA,5)**2) | |
43343 | P(IPA,1)=PA*SIN(THE)*COS(PHI) | |
43344 | P(IPA,2)=PA*SIN(THE)*SIN(PHI) | |
43345 | P(IPA,3)=PA*COS(THE) | |
43346 | ||
43347 | C...Set N. Optionally fragment/decay. | |
43348 | N=IPA | |
43349 | IF(IP.EQ.0) CALL PYEXEC | |
43350 | ||
43351 | RETURN | |
43352 | END | |
43353 | ||
43354 | C********************************************************************* | |
43355 | ||
43356 | C...PY2ENT | |
43357 | C...Stores two partons/particles in their CM frame, | |
43358 | C...with the first along the +z axis. | |
43359 | ||
43360 | SUBROUTINE PY2ENT(IP,KF1,KF2,PECM) | |
43361 | ||
43362 | C...Double precision and integer declarations. | |
43363 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
43364 | IMPLICIT INTEGER(I-N) | |
43365 | INTEGER PYK,PYCHGE,PYCOMP | |
43366 | C...Commonblocks. | |
43367 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
43368 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
43369 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
43370 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
43371 | ||
43372 | C...Standard checks. | |
43373 | MSTU(28)=0 | |
43374 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
43375 | IPA=MAX(1,IABS(IP)) | |
43376 | IF(IPA.GT.MSTU(4)-1) CALL PYERRM(21, | |
43377 | &'(PY2ENT:) writing outside PYJETS memory') | |
43378 | KC1=PYCOMP(KF1) | |
43379 | KC2=PYCOMP(KF2) | |
43380 | IF(KC1.EQ.0.OR.KC2.EQ.0) CALL PYERRM(12, | |
43381 | &'(PY2ENT:) unknown flavour code') | |
43382 | ||
43383 | C...Find masses. Reset K, P and V vectors. | |
43384 | PM1=0D0 | |
43385 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) | |
43386 | IF(MSTU(10).GE.2) PM1=PYMASS(KF1) | |
43387 | PM2=0D0 | |
43388 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) | |
43389 | IF(MSTU(10).GE.2) PM2=PYMASS(KF2) | |
43390 | DO 110 I=IPA,IPA+1 | |
43391 | DO 100 J=1,5 | |
43392 | K(I,J)=0 | |
43393 | P(I,J)=0D0 | |
43394 | V(I,J)=0D0 | |
43395 | 100 CONTINUE | |
43396 | 110 CONTINUE | |
43397 | ||
43398 | C...Check flavours. | |
43399 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) | |
43400 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) | |
43401 | IF(MSTU(19).EQ.1) THEN | |
43402 | MSTU(19)=0 | |
43403 | ELSE | |
43404 | IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL PYERRM(2, | |
43405 | & '(PY2ENT:) unphysical flavour combination') | |
43406 | ENDIF | |
43407 | K(IPA,2)=KF1 | |
43408 | K(IPA+1,2)=KF2 | |
43409 | ||
43410 | C...Store partons/particles in K vectors for normal case. | |
43411 | IF(IP.GE.0) THEN | |
43412 | K(IPA,1)=1 | |
43413 | IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2 | |
43414 | K(IPA+1,1)=1 | |
43415 | ||
43416 | C...Store partons in K vectors for parton shower evolution. | |
43417 | ELSE | |
43418 | K(IPA,1)=3 | |
43419 | K(IPA+1,1)=3 | |
43420 | K(IPA,4)=MSTU(5)*(IPA+1) | |
43421 | K(IPA,5)=K(IPA,4) | |
43422 | K(IPA+1,4)=MSTU(5)*IPA | |
43423 | K(IPA+1,5)=K(IPA+1,4) | |
43424 | ENDIF | |
43425 | ||
43426 | C...Check kinematics and store partons/particles in P vectors. | |
43427 | IF(PECM.LE.PM1+PM2) CALL PYERRM(13, | |
43428 | &'(PY2ENT:) energy smaller than sum of masses') | |
43429 | PA=SQRT(MAX(0D0,(PECM**2-PM1**2-PM2**2)**2-(2D0*PM1*PM2)**2))/ | |
43430 | &(2D0*PECM) | |
43431 | P(IPA,3)=PA | |
43432 | P(IPA,4)=SQRT(PM1**2+PA**2) | |
43433 | P(IPA,5)=PM1 | |
43434 | P(IPA+1,3)=-PA | |
43435 | P(IPA+1,4)=SQRT(PM2**2+PA**2) | |
43436 | P(IPA+1,5)=PM2 | |
43437 | ||
43438 | C...Set N. Optionally fragment/decay. | |
43439 | N=IPA+1 | |
43440 | IF(IP.EQ.0) CALL PYEXEC | |
43441 | ||
43442 | RETURN | |
43443 | END | |
43444 | ||
43445 | C********************************************************************* | |
43446 | ||
43447 | C...PY3ENT | |
43448 | C...Stores three partons or particles in their CM frame, | |
43449 | C...with the first along the +z axis and the third in the (x,z) | |
43450 | C...plane with x > 0. | |
43451 | ||
43452 | SUBROUTINE PY3ENT(IP,KF1,KF2,KF3,PECM,X1,X3) | |
43453 | ||
43454 | C...Double precision and integer declarations. | |
43455 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
43456 | IMPLICIT INTEGER(I-N) | |
43457 | INTEGER PYK,PYCHGE,PYCOMP | |
43458 | C...Commonblocks. | |
43459 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
43460 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
43461 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
43462 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
43463 | ||
43464 | C...Standard checks. | |
43465 | MSTU(28)=0 | |
43466 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
43467 | IPA=MAX(1,IABS(IP)) | |
43468 | IF(IPA.GT.MSTU(4)-2) CALL PYERRM(21, | |
43469 | &'(PY3ENT:) writing outside PYJETS memory') | |
43470 | KC1=PYCOMP(KF1) | |
43471 | KC2=PYCOMP(KF2) | |
43472 | KC3=PYCOMP(KF3) | |
43473 | IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL PYERRM(12, | |
43474 | &'(PY3ENT:) unknown flavour code') | |
43475 | ||
43476 | C...Find masses. Reset K, P and V vectors. | |
43477 | PM1=0D0 | |
43478 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) | |
43479 | IF(MSTU(10).GE.2) PM1=PYMASS(KF1) | |
43480 | PM2=0D0 | |
43481 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) | |
43482 | IF(MSTU(10).GE.2) PM2=PYMASS(KF2) | |
43483 | PM3=0D0 | |
43484 | IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) | |
43485 | IF(MSTU(10).GE.2) PM3=PYMASS(KF3) | |
43486 | DO 110 I=IPA,IPA+2 | |
43487 | DO 100 J=1,5 | |
43488 | K(I,J)=0 | |
43489 | P(I,J)=0D0 | |
43490 | V(I,J)=0D0 | |
43491 | 100 CONTINUE | |
43492 | 110 CONTINUE | |
43493 | ||
43494 | C...Check flavours. | |
43495 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) | |
43496 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) | |
43497 | KQ3=KCHG(KC3,2)*ISIGN(1,KF3) | |
43498 | IF(MSTU(19).EQ.1) THEN | |
43499 | MSTU(19)=0 | |
43500 | ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0) THEN | |
43501 | ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.(KQ1+KQ3.EQ.0.OR. | |
43502 | & KQ1+KQ3.EQ.4)) THEN | |
43503 | ELSE | |
43504 | CALL PYERRM(2,'(PY3ENT:) unphysical flavour combination') | |
43505 | ENDIF | |
43506 | K(IPA,2)=KF1 | |
43507 | K(IPA+1,2)=KF2 | |
43508 | K(IPA+2,2)=KF3 | |
43509 | ||
43510 | C...Store partons/particles in K vectors for normal case. | |
43511 | IF(IP.GE.0) THEN | |
43512 | K(IPA,1)=1 | |
43513 | IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0)) K(IPA,1)=2 | |
43514 | K(IPA+1,1)=1 | |
43515 | IF(KQ2.NE.0.AND.KQ3.NE.0) K(IPA+1,1)=2 | |
43516 | K(IPA+2,1)=1 | |
43517 | ||
43518 | C...Store partons in K vectors for parton shower evolution. | |
43519 | ELSE | |
43520 | K(IPA,1)=3 | |
43521 | K(IPA+1,1)=3 | |
43522 | K(IPA+2,1)=3 | |
43523 | KCS=4 | |
43524 | IF(KQ1.EQ.-1) KCS=5 | |
43525 | K(IPA,KCS)=MSTU(5)*(IPA+1) | |
43526 | K(IPA,9-KCS)=MSTU(5)*(IPA+2) | |
43527 | K(IPA+1,KCS)=MSTU(5)*(IPA+2) | |
43528 | K(IPA+1,9-KCS)=MSTU(5)*IPA | |
43529 | K(IPA+2,KCS)=MSTU(5)*IPA | |
43530 | K(IPA+2,9-KCS)=MSTU(5)*(IPA+1) | |
43531 | ENDIF | |
43532 | ||
43533 | C...Check kinematics. | |
43534 | MKERR=0 | |
43535 | IF(0.5D0*X1*PECM.LE.PM1.OR.0.5D0*(2D0-X1-X3)*PECM.LE.PM2.OR. | |
43536 | &0.5D0*X3*PECM.LE.PM3) MKERR=1 | |
43537 | PA1=SQRT(MAX(1D-10,(0.5D0*X1*PECM)**2-PM1**2)) | |
43538 | PA2=SQRT(MAX(1D-10,(0.5D0*(2D0-X1-X3)*PECM)**2-PM2**2)) | |
43539 | PA3=SQRT(MAX(1D-10,(0.5D0*X3*PECM)**2-PM3**2)) | |
43540 | CTHE2=(PA3**2-PA1**2-PA2**2)/(2D0*PA1*PA2) | |
43541 | CTHE3=(PA2**2-PA1**2-PA3**2)/(2D0*PA1*PA3) | |
43542 | IF(ABS(CTHE2).GE.1.001D0.OR.ABS(CTHE3).GE.1.001D0) MKERR=1 | |
43543 | CTHE3=MAX(-1D0,MIN(1D0,CTHE3)) | |
43544 | IF(MKERR.NE.0) CALL PYERRM(13, | |
43545 | &'(PY3ENT:) unphysical kinematical variable setup') | |
43546 | ||
43547 | C...Store partons/particles in P vectors. | |
43548 | P(IPA,3)=PA1 | |
43549 | P(IPA,4)=SQRT(PA1**2+PM1**2) | |
43550 | P(IPA,5)=PM1 | |
43551 | P(IPA+2,1)=PA3*SQRT(1D0-CTHE3**2) | |
43552 | P(IPA+2,3)=PA3*CTHE3 | |
43553 | P(IPA+2,4)=SQRT(PA3**2+PM3**2) | |
43554 | P(IPA+2,5)=PM3 | |
43555 | P(IPA+1,1)=-P(IPA+2,1) | |
43556 | P(IPA+1,3)=-P(IPA,3)-P(IPA+2,3) | |
43557 | P(IPA+1,4)=SQRT(P(IPA+1,1)**2+P(IPA+1,3)**2+PM2**2) | |
43558 | P(IPA+1,5)=PM2 | |
43559 | ||
43560 | C...Set N. Optionally fragment/decay. | |
43561 | N=IPA+2 | |
43562 | IF(IP.EQ.0) CALL PYEXEC | |
43563 | ||
43564 | RETURN | |
43565 | END | |
43566 | ||
43567 | C********************************************************************* | |
43568 | ||
43569 | C...PY4ENT | |
43570 | C...Stores four partons or particles in their CM frame, with | |
43571 | C...the first along the +z axis, the last in the xz plane with x > 0 | |
43572 | C...and the second having y < 0 and y > 0 with equal probability. | |
43573 | ||
43574 | SUBROUTINE PY4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14) | |
43575 | ||
43576 | C...Double precision and integer declarations. | |
43577 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
43578 | IMPLICIT INTEGER(I-N) | |
43579 | INTEGER PYK,PYCHGE,PYCOMP | |
43580 | C...Commonblocks. | |
43581 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
43582 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
43583 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
43584 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
43585 | ||
43586 | C...Standard checks. | |
43587 | MSTU(28)=0 | |
43588 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
43589 | IPA=MAX(1,IABS(IP)) | |
43590 | IF(IPA.GT.MSTU(4)-3) CALL PYERRM(21, | |
43591 | &'(PY4ENT:) writing outside PYJETS momory') | |
43592 | KC1=PYCOMP(KF1) | |
43593 | KC2=PYCOMP(KF2) | |
43594 | KC3=PYCOMP(KF3) | |
43595 | KC4=PYCOMP(KF4) | |
43596 | IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL PYERRM(12, | |
43597 | &'(PY4ENT:) unknown flavour code') | |
43598 | ||
43599 | C...Find masses. Reset K, P and V vectors. | |
43600 | PM1=0D0 | |
43601 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) | |
43602 | IF(MSTU(10).GE.2) PM1=PYMASS(KF1) | |
43603 | PM2=0D0 | |
43604 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) | |
43605 | IF(MSTU(10).GE.2) PM2=PYMASS(KF2) | |
43606 | PM3=0D0 | |
43607 | IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) | |
43608 | IF(MSTU(10).GE.2) PM3=PYMASS(KF3) | |
43609 | PM4=0D0 | |
43610 | IF(MSTU(10).EQ.1) PM4=P(IPA+3,5) | |
43611 | IF(MSTU(10).GE.2) PM4=PYMASS(KF4) | |
43612 | DO 110 I=IPA,IPA+3 | |
43613 | DO 100 J=1,5 | |
43614 | K(I,J)=0 | |
43615 | P(I,J)=0D0 | |
43616 | V(I,J)=0D0 | |
43617 | 100 CONTINUE | |
43618 | 110 CONTINUE | |
43619 | ||
43620 | C...Check flavours. | |
43621 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) | |
43622 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) | |
43623 | KQ3=KCHG(KC3,2)*ISIGN(1,KF3) | |
43624 | KQ4=KCHG(KC4,2)*ISIGN(1,KF4) | |
43625 | IF(MSTU(19).EQ.1) THEN | |
43626 | MSTU(19)=0 | |
43627 | ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0.AND.KQ4.EQ.0) THEN | |
43628 | ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.KQ3.EQ.2.AND.(KQ1+KQ4.EQ.0.OR. | |
43629 | & KQ1+KQ4.EQ.4)) THEN | |
43630 | ELSEIF(KQ1.NE.0.AND.KQ1+KQ2.EQ.0.AND.KQ3.NE.0.AND.KQ3+KQ4.EQ.0D0) | |
43631 | & THEN | |
43632 | ELSE | |
43633 | CALL PYERRM(2,'(PY4ENT:) unphysical flavour combination') | |
43634 | ENDIF | |
43635 | K(IPA,2)=KF1 | |
43636 | K(IPA+1,2)=KF2 | |
43637 | K(IPA+2,2)=KF3 | |
43638 | K(IPA+3,2)=KF4 | |
43639 | ||
43640 | C...Store partons/particles in K vectors for normal case. | |
43641 | IF(IP.GE.0) THEN | |
43642 | K(IPA,1)=1 | |
43643 | IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0.OR.KQ4.NE.0)) K(IPA,1)=2 | |
43644 | K(IPA+1,1)=1 | |
43645 | IF(KQ2.NE.0.AND.KQ1+KQ2.NE.0.AND.(KQ3.NE.0.OR.KQ4.NE.0)) | |
43646 | & K(IPA+1,1)=2 | |
43647 | K(IPA+2,1)=1 | |
43648 | IF(KQ3.NE.0.AND.KQ4.NE.0) K(IPA+2,1)=2 | |
43649 | K(IPA+3,1)=1 | |
43650 | ||
43651 | C...Store partons for parton shower evolution from q-g-g-qbar or | |
43652 | C...g-g-g-g event. | |
43653 | ELSEIF(KQ1+KQ2.NE.0) THEN | |
43654 | K(IPA,1)=3 | |
43655 | K(IPA+1,1)=3 | |
43656 | K(IPA+2,1)=3 | |
43657 | K(IPA+3,1)=3 | |
43658 | KCS=4 | |
43659 | IF(KQ1.EQ.-1) KCS=5 | |
43660 | K(IPA,KCS)=MSTU(5)*(IPA+1) | |
43661 | K(IPA,9-KCS)=MSTU(5)*(IPA+3) | |
43662 | K(IPA+1,KCS)=MSTU(5)*(IPA+2) | |
43663 | K(IPA+1,9-KCS)=MSTU(5)*IPA | |
43664 | K(IPA+2,KCS)=MSTU(5)*(IPA+3) | |
43665 | K(IPA+2,9-KCS)=MSTU(5)*(IPA+1) | |
43666 | K(IPA+3,KCS)=MSTU(5)*IPA | |
43667 | K(IPA+3,9-KCS)=MSTU(5)*(IPA+2) | |
43668 | ||
43669 | C...Store partons for parton shower evolution from q-qbar-q-qbar event. | |
43670 | ELSE | |
43671 | K(IPA,1)=3 | |
43672 | K(IPA+1,1)=3 | |
43673 | K(IPA+2,1)=3 | |
43674 | K(IPA+3,1)=3 | |
43675 | K(IPA,4)=MSTU(5)*(IPA+1) | |
43676 | K(IPA,5)=K(IPA,4) | |
43677 | K(IPA+1,4)=MSTU(5)*IPA | |
43678 | K(IPA+1,5)=K(IPA+1,4) | |
43679 | K(IPA+2,4)=MSTU(5)*(IPA+3) | |
43680 | K(IPA+2,5)=K(IPA+2,4) | |
43681 | K(IPA+3,4)=MSTU(5)*(IPA+2) | |
43682 | K(IPA+3,5)=K(IPA+3,4) | |
43683 | ENDIF | |
43684 | ||
43685 | C...Check kinematics. | |
43686 | MKERR=0 | |
43687 | IF(0.5D0*X1*PECM.LE.PM1.OR.0.5D0*X2*PECM.LE.PM2.OR. | |
43688 | &0.5D0*(2D0-X1-X2-X4)*PECM.LE.PM3.OR.0.5D0*X4*PECM.LE.PM4) | |
43689 | &MKERR=1 | |
43690 | PA1=SQRT(MAX(1D-10,(0.5D0*X1*PECM)**2-PM1**2)) | |
43691 | PA2=SQRT(MAX(1D-10,(0.5D0*X2*PECM)**2-PM2**2)) | |
43692 | PA4=SQRT(MAX(1D-10,(0.5D0*X4*PECM)**2-PM4**2)) | |
43693 | X24=X1+X2+X4-1D0-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2 | |
43694 | CTHE4=(X1*X4-2D0*X14)*PECM**2/(4D0*PA1*PA4) | |
43695 | IF(ABS(CTHE4).GE.1.002D0) MKERR=1 | |
43696 | CTHE4=MAX(-1D0,MIN(1D0,CTHE4)) | |
43697 | STHE4=SQRT(1D0-CTHE4**2) | |
43698 | CTHE2=(X1*X2-2D0*X12)*PECM**2/(4D0*PA1*PA2) | |
43699 | IF(ABS(CTHE2).GE.1.002D0) MKERR=1 | |
43700 | CTHE2=MAX(-1D0,MIN(1D0,CTHE2)) | |
43701 | STHE2=SQRT(1D0-CTHE2**2) | |
43702 | CPHI2=((X2*X4-2D0*X24)*PECM**2-4D0*PA2*CTHE2*PA4*CTHE4)/ | |
43703 | &MAX(1D-8*PECM**2,4D0*PA2*STHE2*PA4*STHE4) | |
43704 | IF(ABS(CPHI2).GE.1.05D0) MKERR=1 | |
43705 | CPHI2=MAX(-1D0,MIN(1D0,CPHI2)) | |
43706 | IF(MKERR.EQ.1) CALL PYERRM(13, | |
43707 | &'(PY4ENT:) unphysical kinematical variable setup') | |
43708 | ||
43709 | C...Store partons/particles in P vectors. | |
43710 | P(IPA,3)=PA1 | |
43711 | P(IPA,4)=SQRT(PA1**2+PM1**2) | |
43712 | P(IPA,5)=PM1 | |
43713 | P(IPA+3,1)=PA4*STHE4 | |
43714 | P(IPA+3,3)=PA4*CTHE4 | |
43715 | P(IPA+3,4)=SQRT(PA4**2+PM4**2) | |
43716 | P(IPA+3,5)=PM4 | |
43717 | P(IPA+1,1)=PA2*STHE2*CPHI2 | |
43718 | P(IPA+1,2)=PA2*STHE2*SQRT(1D0-CPHI2**2)*(-1D0)**INT(PYR(0)+0.5D0) | |
43719 | P(IPA+1,3)=PA2*CTHE2 | |
43720 | P(IPA+1,4)=SQRT(PA2**2+PM2**2) | |
43721 | P(IPA+1,5)=PM2 | |
43722 | P(IPA+2,1)=-P(IPA+1,1)-P(IPA+3,1) | |
43723 | P(IPA+2,2)=-P(IPA+1,2) | |
43724 | P(IPA+2,3)=-P(IPA,3)-P(IPA+1,3)-P(IPA+3,3) | |
43725 | P(IPA+2,4)=SQRT(P(IPA+2,1)**2+P(IPA+2,2)**2+P(IPA+2,3)**2+PM3**2) | |
43726 | P(IPA+2,5)=PM3 | |
43727 | ||
43728 | C...Set N. Optionally fragment/decay. | |
43729 | N=IPA+3 | |
43730 | IF(IP.EQ.0) CALL PYEXEC | |
43731 | ||
43732 | RETURN | |
43733 | END | |
43734 | ||
43735 | C********************************************************************* | |
43736 | ||
43737 | C...PY2FRM | |
43738 | C...An interface from a two-fermion generator to include | |
43739 | C...parton showers and hadronization. | |
43740 | ||
43741 | SUBROUTINE PY2FRM(IRAD,ITAU,ICOM) | |
43742 | ||
43743 | C...Double precision and integer declarations. | |
43744 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
43745 | IMPLICIT INTEGER(I-N) | |
43746 | INTEGER PYK,PYCHGE,PYCOMP | |
43747 | C...Commonblocks. | |
43748 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
43749 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
43750 | SAVE /PYJETS/,/PYDAT1/ | |
43751 | C...Local arrays. | |
43752 | DIMENSION IJOIN(2),INTAU(2) | |
43753 | ||
43754 | C...Call PYHEPC to convert input from HEPEVT to PYJETS common. | |
43755 | IF(ICOM.EQ.0) THEN | |
43756 | MSTU(28)=0 | |
43757 | CALL PYHEPC(2) | |
43758 | ENDIF | |
43759 | ||
43760 | C...Loop through entries and pick up all final fermions/antifermions. | |
43761 | I1=0 | |
43762 | I2=0 | |
43763 | DO 100 I=1,N | |
43764 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 | |
43765 | KFA=IABS(K(I,2)) | |
43766 | IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN | |
43767 | IF(K(I,2).GT.0) THEN | |
43768 | IF(I1.EQ.0) THEN | |
43769 | I1=I | |
43770 | ELSE | |
43771 | CALL PYERRM(16,'(PY2FRM:) more than one fermion') | |
43772 | ENDIF | |
43773 | ELSE | |
43774 | IF(I2.EQ.0) THEN | |
43775 | I2=I | |
43776 | ELSE | |
43777 | CALL PYERRM(16,'(PY2FRM:) more than one antifermion') | |
43778 | ENDIF | |
43779 | ENDIF | |
43780 | ENDIF | |
43781 | 100 CONTINUE | |
43782 | ||
43783 | C...Check that event is arranged according to conventions. | |
43784 | IF(I1.EQ.0.OR.I2.EQ.0) THEN | |
43785 | CALL PYERRM(16,'(PY2FRM:) event contains too few fermions') | |
43786 | ENDIF | |
43787 | IF(I2.LT.I1) THEN | |
43788 | CALL PYERRM(6,'(PY2FRM:) fermions arranged in wrong order') | |
43789 | ENDIF | |
43790 | ||
43791 | C...Check whether fermion pair is quarks or leptons. | |
43792 | IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN | |
43793 | IQL12=1 | |
43794 | ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN | |
43795 | IQL12=2 | |
43796 | ELSE | |
43797 | CALL PYERRM(16,'(PY2FRM:) fermion pair inconsistent') | |
43798 | ENDIF | |
43799 | ||
43800 | C...Decide whether to allow or not photon radiation in showers. | |
43801 | MSTJ(41)=2 | |
43802 | IF(IRAD.EQ.0) MSTJ(41)=1 | |
43803 | ||
43804 | C...Do colour joining and parton showers. | |
43805 | IP1=I1 | |
43806 | IP2=I2 | |
43807 | IF(IQL12.EQ.1) THEN | |
43808 | IJOIN(1)=IP1 | |
43809 | IJOIN(2)=IP2 | |
43810 | CALL PYJOIN(2,IJOIN) | |
43811 | ENDIF | |
43812 | IF(IQL12.EQ.1.OR.IRAD.EQ.1) THEN | |
43813 | PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- | |
43814 | & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 | |
43815 | CALL PYSHOW(IP1,IP2,SQRT(MAX(0D0,PM12S))) | |
43816 | ENDIF | |
43817 | ||
43818 | C...Do fragmentation and decays. Possibly except tau decay. | |
43819 | IF(ITAU.EQ.0) THEN | |
43820 | NTAU=0 | |
43821 | DO 110 I=1,N | |
43822 | IF(IABS(K(I,2)).EQ.15.AND.K(I,1).EQ.1) THEN | |
43823 | NTAU=NTAU+1 | |
43824 | INTAU(NTAU)=I | |
43825 | K(I,1)=11 | |
43826 | ENDIF | |
43827 | 110 CONTINUE | |
43828 | ENDIF | |
43829 | CALL PYEXEC | |
43830 | IF(ITAU.EQ.0) THEN | |
43831 | DO 120 I=1,NTAU | |
43832 | K(INTAU(I),1)=1 | |
43833 | 120 CONTINUE | |
43834 | ENDIF | |
43835 | ||
43836 | C...Call PYHEPC to convert output from PYJETS to HEPEVT common. | |
43837 | IF(ICOM.EQ.0) THEN | |
43838 | MSTU(28)=0 | |
43839 | CALL PYHEPC(1) | |
43840 | ENDIF | |
43841 | ||
43842 | END | |
43843 | ||
43844 | C********************************************************************* | |
43845 | ||
43846 | C...PY4FRM | |
43847 | C...An interface from a four-fermion generator to include | |
43848 | C...parton showers and hadronization. | |
43849 | ||
43850 | SUBROUTINE PY4FRM(ATOTSQ,A1SQ,A2SQ,ISTRAT,IRAD,ITAU,ICOM) | |
43851 | ||
43852 | C...Double precision and integer declarations. | |
43853 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
43854 | IMPLICIT INTEGER(I-N) | |
43855 | INTEGER PYK,PYCHGE,PYCOMP | |
43856 | C...Commonblocks. | |
43857 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
43858 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
43859 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
43860 | COMMON/PYINT1/MINT(400),VINT(400) | |
43861 | SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ | |
43862 | C...Local arrays. | |
43863 | DIMENSION IJOIN(2),INTAU(4) | |
43864 | ||
43865 | C...Call PYHEPC to convert input from HEPEVT to PYJETS common. | |
43866 | IF(ICOM.EQ.0) THEN | |
43867 | MSTU(28)=0 | |
43868 | CALL PYHEPC(2) | |
43869 | ENDIF | |
43870 | ||
43871 | C...Loop through entries and pick up all final fermions/antifermions. | |
43872 | I1=0 | |
43873 | I2=0 | |
43874 | I3=0 | |
43875 | I4=0 | |
43876 | DO 100 I=1,N | |
43877 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 | |
43878 | KFA=IABS(K(I,2)) | |
43879 | IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN | |
43880 | IF(K(I,2).GT.0) THEN | |
43881 | IF(I1.EQ.0) THEN | |
43882 | I1=I | |
43883 | ELSEIF(I3.EQ.0) THEN | |
43884 | I3=I | |
43885 | ELSE | |
43886 | CALL PYERRM(16,'(PY4FRM:) more than two fermions') | |
43887 | ENDIF | |
43888 | ELSE | |
43889 | IF(I2.EQ.0) THEN | |
43890 | I2=I | |
43891 | ELSEIF(I4.EQ.0) THEN | |
43892 | I4=I | |
43893 | ELSE | |
43894 | CALL PYERRM(16,'(PY4FRM:) more than two antifermions') | |
43895 | ENDIF | |
43896 | ENDIF | |
43897 | ENDIF | |
43898 | 100 CONTINUE | |
43899 | ||
43900 | C...Check that event is arranged according to conventions. | |
43901 | IF(I3.EQ.0.OR.I4.EQ.0) THEN | |
43902 | CALL PYERRM(16,'(PY4FRM:) event contains too few fermions') | |
43903 | ENDIF | |
43904 | IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3) THEN | |
43905 | CALL PYERRM(6,'(PY4FRM:) fermions arranged in wrong order') | |
43906 | ENDIF | |
43907 | ||
43908 | C...Check which fermion pairs are quarks and which leptons. | |
43909 | IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN | |
43910 | IQL12=1 | |
43911 | ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN | |
43912 | IQL12=2 | |
43913 | ELSE | |
43914 | CALL PYERRM(16,'(PY4FRM:) first fermion pair inconsistent') | |
43915 | ENDIF | |
43916 | IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN | |
43917 | IQL34=1 | |
43918 | ELSEIF(IABS(K(I3,2)).GT.10.AND.IABS(K(I4,2)).GT.10) THEN | |
43919 | IQL34=2 | |
43920 | ELSE | |
43921 | CALL PYERRM(16,'(PY4FRM:) second fermion pair inconsistent') | |
43922 | ENDIF | |
43923 | ||
43924 | C...Decide whether to allow or not photon radiation in showers. | |
43925 | MSTJ(41)=2 | |
43926 | IF(IRAD.EQ.0) MSTJ(41)=1 | |
43927 | ||
43928 | C...Decide on dipole pairing. | |
43929 | IP1=I1 | |
43930 | IP2=I2 | |
43931 | IP3=I3 | |
43932 | IP4=I4 | |
43933 | IF(IQL12.EQ.IQL34) THEN | |
43934 | R1SQ=A1SQ | |
43935 | R2SQ=A2SQ | |
43936 | DELTA=ATOTSQ-A1SQ-A2SQ | |
43937 | IF(ISTRAT.EQ.1) THEN | |
43938 | IF(DELTA.GT.0D0) R1SQ=R1SQ+DELTA | |
43939 | IF(DELTA.LT.0D0) R2SQ=MAX(0D0,R2SQ+DELTA) | |
43940 | ELSEIF(ISTRAT.EQ.2) THEN | |
43941 | IF(DELTA.GT.0D0) R2SQ=R2SQ+DELTA | |
43942 | IF(DELTA.LT.0D0) R1SQ=MAX(0D0,R1SQ+DELTA) | |
43943 | ENDIF | |
43944 | IF(R2SQ.GT.PYR(0)*(R1SQ+R2SQ)) THEN | |
43945 | IP2=I4 | |
43946 | IP4=I2 | |
43947 | ENDIF | |
43948 | ENDIF | |
43949 | ||
43950 | C...If colour reconnection then bookkeep W+W- or Z0Z0 | |
43951 | C...and copy q qbar q qbar consecutively. | |
43952 | IF(MSTP(115).GE.1.AND.IQL12.EQ.1.AND.IQL34.EQ.1) THEN | |
43953 | K(N+1,1)=11 | |
43954 | K(N+1,3)=IP1 | |
43955 | K(N+1,4)=N+3 | |
43956 | K(N+1,5)=N+4 | |
43957 | K(N+2,1)=11 | |
43958 | K(N+2,3)=IP3 | |
43959 | K(N+2,4)=N+5 | |
43960 | K(N+2,5)=N+6 | |
43961 | IF(K(IP1,2)+K(IP2,2).EQ.0) THEN | |
43962 | K(N+1,2)=23 | |
43963 | K(N+2,2)=23 | |
43964 | MINT(1)=22 | |
43965 | ELSEIF(PYCHGE(K(IP1,2)).GT.0) THEN | |
43966 | K(N+1,2)=24 | |
43967 | K(N+2,2)=-24 | |
43968 | MINT(1)=25 | |
43969 | ELSE | |
43970 | K(N+1,2)=-24 | |
43971 | K(N+2,2)=24 | |
43972 | MINT(1)=25 | |
43973 | ENDIF | |
43974 | DO 110 J=1,5 | |
43975 | K(N+3,J)=K(IP1,J) | |
43976 | K(N+4,J)=K(IP2,J) | |
43977 | K(N+5,J)=K(IP3,J) | |
43978 | K(N+6,J)=K(IP4,J) | |
43979 | P(N+1,J)=P(IP1,J)+P(IP2,J) | |
43980 | P(N+2,J)=P(IP3,J)+P(IP4,J) | |
43981 | P(N+3,J)=P(IP1,J) | |
43982 | P(N+4,J)=P(IP2,J) | |
43983 | P(N+5,J)=P(IP3,J) | |
43984 | P(N+6,J)=P(IP4,J) | |
43985 | V(N+1,J)=V(IP1,J) | |
43986 | V(N+2,J)=V(IP3,J) | |
43987 | V(N+3,J)=V(IP1,J) | |
43988 | V(N+4,J)=V(IP2,J) | |
43989 | V(N+5,J)=V(IP3,J) | |
43990 | V(N+6,J)=V(IP4,J) | |
43991 | 110 CONTINUE | |
43992 | P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- | |
43993 | & P(N+1,3)**2)) | |
43994 | P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- | |
43995 | & P(N+2,3)**2)) | |
43996 | K(N+3,3)=N+1 | |
43997 | K(N+4,3)=N+1 | |
43998 | K(N+5,3)=N+2 | |
43999 | K(N+6,3)=N+2 | |
44000 | C...Remove original q qbar q qbar and update counters. | |
44001 | K(IP1,1)=K(IP1,1)+10 | |
44002 | K(IP2,1)=K(IP2,1)+10 | |
44003 | K(IP3,1)=K(IP3,1)+10 | |
44004 | K(IP4,1)=K(IP4,1)+10 | |
44005 | IW1=N+1 | |
44006 | IW2=N+2 | |
44007 | NSD1=N+2 | |
44008 | IP1=N+3 | |
44009 | IP2=N+4 | |
44010 | IP3=N+5 | |
44011 | IP4=N+6 | |
44012 | N=N+6 | |
44013 | ENDIF | |
44014 | ||
44015 | C...Do colour joinings and parton showers. | |
44016 | IF(IQL12.EQ.1) THEN | |
44017 | IJOIN(1)=IP1 | |
44018 | IJOIN(2)=IP2 | |
44019 | CALL PYJOIN(2,IJOIN) | |
44020 | ENDIF | |
44021 | IF(IQL12.EQ.1.OR.IRAD.EQ.1) THEN | |
44022 | PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- | |
44023 | & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 | |
44024 | CALL PYSHOW(IP1,IP2,SQRT(MAX(0D0,PM12S))) | |
44025 | ENDIF | |
44026 | NAFT1=N | |
44027 | IF(IQL34.EQ.1) THEN | |
44028 | IJOIN(1)=IP3 | |
44029 | IJOIN(2)=IP4 | |
44030 | CALL PYJOIN(2,IJOIN) | |
44031 | ENDIF | |
44032 | IF(IQL34.EQ.1.OR.IRAD.EQ.1) THEN | |
44033 | PM34S=(P(IP3,4)+P(IP4,4))**2-(P(IP3,1)+P(IP4,1))**2- | |
44034 | & (P(IP3,2)+P(IP4,2))**2-(P(IP3,3)+P(IP4,3))**2 | |
44035 | CALL PYSHOW(IP3,IP4,SQRT(MAX(0D0,PM34S))) | |
44036 | ENDIF | |
44037 | ||
44038 | C...Optionally do colour reconnection. | |
44039 | MINT(32)=0 | |
44040 | MSTI(32)=0 | |
44041 | IF(MSTP(115).GE.1.AND.IQL12.EQ.1.AND.IQL34.EQ.1) THEN | |
44042 | CALL PYRECO(IW1,IW2,NSD1,NAFT1) | |
44043 | MSTI(32)=MINT(32) | |
44044 | ENDIF | |
44045 | ||
44046 | C...Do fragmentation and decays. Possibly except tau decay. | |
44047 | IF(ITAU.EQ.0) THEN | |
44048 | NTAU=0 | |
44049 | DO 120 I=1,N | |
44050 | IF(IABS(K(I,2)).EQ.15.AND.K(I,1).EQ.1) THEN | |
44051 | NTAU=NTAU+1 | |
44052 | INTAU(NTAU)=I | |
44053 | K(I,1)=11 | |
44054 | ENDIF | |
44055 | 120 CONTINUE | |
44056 | ENDIF | |
44057 | CALL PYEXEC | |
44058 | IF(ITAU.EQ.0) THEN | |
44059 | DO 130 I=1,NTAU | |
44060 | K(INTAU(I),1)=1 | |
44061 | 130 CONTINUE | |
44062 | ENDIF | |
44063 | ||
44064 | C...Call PYHEPC to convert output from PYJETS to HEPEVT common. | |
44065 | IF(ICOM.EQ.0) THEN | |
44066 | MSTU(28)=0 | |
44067 | CALL PYHEPC(1) | |
44068 | ENDIF | |
44069 | ||
44070 | END | |
44071 | ||
44072 | C********************************************************************* | |
44073 | ||
44074 | C...PY6FRM | |
44075 | C...An interface from a six-fermion generator to include | |
44076 | C...parton showers and hadronization. | |
44077 | ||
44078 | SUBROUTINE PY6FRM(P12,P13,P21,P23,P31,P32,PTOP,IRAD,ITAU,ICOM) | |
44079 | ||
44080 | C...Double precision and integer declarations. | |
44081 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
44082 | IMPLICIT INTEGER(I-N) | |
44083 | INTEGER PYK,PYCHGE,PYCOMP | |
44084 | C...Commonblocks. | |
44085 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
44086 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
44087 | SAVE /PYJETS/,/PYDAT1/ | |
44088 | C...Local arrays. | |
44089 | DIMENSION IJOIN(2),INTAU(6),BETA(3),BETAO(3),BETAN(3) | |
44090 | ||
44091 | C...Call PYHEPC to convert input from HEPEVT to PYJETS common. | |
44092 | IF(ICOM.EQ.0) THEN | |
44093 | MSTU(28)=0 | |
44094 | CALL PYHEPC(2) | |
44095 | ENDIF | |
44096 | ||
44097 | C...Loop through entries and pick up all final fermions/antifermions. | |
44098 | I1=0 | |
44099 | I2=0 | |
44100 | I3=0 | |
44101 | I4=0 | |
44102 | I5=0 | |
44103 | I6=0 | |
44104 | DO 100 I=1,N | |
44105 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 | |
44106 | KFA=IABS(K(I,2)) | |
44107 | IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN | |
44108 | IF(K(I,2).GT.0) THEN | |
44109 | IF(I1.EQ.0) THEN | |
44110 | I1=I | |
44111 | ELSEIF(I3.EQ.0) THEN | |
44112 | I3=I | |
44113 | ELSEIF(I5.EQ.0) THEN | |
44114 | I5=I | |
44115 | ELSE | |
44116 | CALL PYERRM(16,'(PY6FRM:) more than three fermions') | |
44117 | ENDIF | |
44118 | ELSE | |
44119 | IF(I2.EQ.0) THEN | |
44120 | I2=I | |
44121 | ELSEIF(I4.EQ.0) THEN | |
44122 | I4=I | |
44123 | ELSEIF(I6.EQ.0) THEN | |
44124 | I6=I | |
44125 | ELSE | |
44126 | CALL PYERRM(16,'(PY6FRM:) more than three antifermions') | |
44127 | ENDIF | |
44128 | ENDIF | |
44129 | ENDIF | |
44130 | 100 CONTINUE | |
44131 | ||
44132 | C...Check that event is arranged according to conventions. | |
44133 | IF(I5.EQ.0.OR.I6.EQ.0) THEN | |
44134 | CALL PYERRM(16,'(PY6FRM:) event contains too few fermions') | |
44135 | ENDIF | |
44136 | IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3.OR.I5.LT.I4.OR.I6.LT.I5) THEN | |
44137 | CALL PYERRM(6,'(PY6FRM:) fermions arranged in wrong order') | |
44138 | ENDIF | |
44139 | ||
44140 | C...Check which fermion pairs are quarks and which leptons. | |
44141 | IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN | |
44142 | IQL12=1 | |
44143 | ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN | |
44144 | IQL12=2 | |
44145 | ELSE | |
44146 | CALL PYERRM(16,'(PY6FRM:) first fermion pair inconsistent') | |
44147 | ENDIF | |
44148 | IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN | |
44149 | IQL34=1 | |
44150 | ELSEIF(IABS(K(I3,2)).GT.10.AND.IABS(K(I4,2)).GT.10) THEN | |
44151 | IQL34=2 | |
44152 | ELSE | |
44153 | CALL PYERRM(16,'(PY6FRM:) second fermion pair inconsistent') | |
44154 | ENDIF | |
44155 | IF(IABS(K(I5,2)).LT.10.AND.IABS(K(I6,2)).LT.10) THEN | |
44156 | IQL56=1 | |
44157 | ELSEIF(IABS(K(I5,2)).GT.10.AND.IABS(K(I6,2)).GT.10) THEN | |
44158 | IQL56=2 | |
44159 | ELSE | |
44160 | CALL PYERRM(16,'(PY6FRM:) third fermion pair inconsistent') | |
44161 | ENDIF | |
44162 | ||
44163 | C...Decide whether to allow or not photon radiation in showers. | |
44164 | MSTJ(41)=2 | |
44165 | IF(IRAD.EQ.0) MSTJ(41)=1 | |
44166 | ||
44167 | C...Allow dipole pairings only among leptons and quarks separately. | |
44168 | P12D=P12 | |
44169 | P13D=0D0 | |
44170 | IF(IQL34.EQ.IQL56) P13D=P13 | |
44171 | P21D=0D0 | |
44172 | IF(IQL12.EQ.IQL34) P21D=P21 | |
44173 | P23D=0D0 | |
44174 | IF(IQL12.EQ.IQL34.AND.IQL12.EQ.IQL56) P23D=P23 | |
44175 | P31D=0D0 | |
44176 | IF(IQL12.EQ.IQL34.AND.IQL12.EQ.IQL56) P31D=P31 | |
44177 | P32D=0D0 | |
44178 | IF(IQL12.EQ.IQL56) P32D=P32 | |
44179 | ||
44180 | C...Decide whether t+tbar. | |
44181 | ITOP=0 | |
44182 | IF(PYR(0).LT.PTOP) THEN | |
44183 | ITOP=1 | |
44184 | ||
44185 | C...If t+tbar: reconstruct t's. | |
44186 | IT=N+1 | |
44187 | ITB=N+2 | |
44188 | DO 110 J=1,5 | |
44189 | K(IT,J)=0 | |
44190 | K(ITB,J)=0 | |
44191 | P(IT,J)=P(I1,J)+P(I3,J)+P(I4,J) | |
44192 | P(ITB,J)=P(I2,J)+P(I5,J)+P(I6,J) | |
44193 | V(IT,J)=0D0 | |
44194 | V(ITB,J)=0D0 | |
44195 | 110 CONTINUE | |
44196 | K(IT,1)=1 | |
44197 | K(ITB,1)=1 | |
44198 | K(IT,2)=6 | |
44199 | K(ITB,2)=-6 | |
44200 | P(IT,5)=SQRT(MAX(0D0,P(IT,4)**2-P(IT,1)**2-P(IT,2)**2- | |
44201 | & P(IT,3)**2)) | |
44202 | P(ITB,5)=SQRT(MAX(0D0,P(ITB,4)**2-P(ITB,1)**2-P(ITB,2)**2- | |
44203 | & P(ITB,3)**2)) | |
44204 | N=N+2 | |
44205 | ||
44206 | C...If t+tbar: colour join t's and let them shower. | |
44207 | IJOIN(1)=IT | |
44208 | IJOIN(2)=ITB | |
44209 | CALL PYJOIN(2,IJOIN) | |
44210 | PMTTS=(P(IT,4)+P(ITB,4))**2-(P(IT,1)+P(ITB,1))**2- | |
44211 | & (P(IT,2)+P(ITB,2))**2-(P(IT,3)+P(ITB,3))**2 | |
44212 | CALL PYSHOW(IT,ITB,SQRT(MAX(0D0,PMTTS))) | |
44213 | ||
44214 | C...If t+tbar: pick up the t's after shower. | |
44215 | ITNEW=IT | |
44216 | ITBNEW=ITB | |
44217 | DO 120 I=ITB+1,N | |
44218 | IF(K(I,2).EQ.6) ITNEW=I | |
44219 | IF(K(I,2).EQ.-6) ITBNEW=I | |
44220 | 120 CONTINUE | |
44221 | ||
44222 | C...If t+tbar: loop over two top systems. | |
44223 | DO 200 IT1=1,2 | |
44224 | IF(IT1.EQ.1) THEN | |
44225 | ITO=IT | |
44226 | ITN=ITNEW | |
44227 | IBO=I1 | |
44228 | IW1=I3 | |
44229 | IW2=I4 | |
44230 | ELSE | |
44231 | ITO=ITB | |
44232 | ITN=ITBNEW | |
44233 | IBO=I2 | |
44234 | IW1=I5 | |
44235 | IW2=I6 | |
44236 | ENDIF | |
44237 | IF(IABS(K(IBO,2)).NE.5) CALL PYERRM(6, | |
44238 | & '(PY6FRM:) not b in t decay') | |
44239 | ||
44240 | C...If t+tbar: find boost from original to new top frame. | |
44241 | DO 130 J=1,3 | |
44242 | BETAO(J)=P(ITO,J)/P(ITO,4) | |
44243 | BETAN(J)=P(ITN,J)/P(ITN,4) | |
44244 | 130 CONTINUE | |
44245 | ||
44246 | C...If t+tbar: boost copy of b by t shower and connect it in colour. | |
44247 | N=N+1 | |
44248 | IB=N | |
44249 | K(IB,1)=3 | |
44250 | K(IB,2)=K(IBO,2) | |
44251 | K(IB,3)=ITN | |
44252 | DO 140 J=1,5 | |
44253 | P(IB,J)=P(IBO,J) | |
44254 | V(IB,J)=0D0 | |
44255 | 140 CONTINUE | |
44256 | CALL PYROBO(IB,IB,0D0,0D0,-BETAO(1),-BETAO(2),-BETAO(3)) | |
44257 | CALL PYROBO(IB,IB,0D0,0D0,BETAN(1),BETAN(2),BETAN(3)) | |
44258 | K(IB,4)=MSTU(5)*ITN | |
44259 | K(IB,5)=MSTU(5)*ITN | |
44260 | K(ITN,4)=K(ITN,4)+IB | |
44261 | K(ITN,5)=K(ITN,5)+IB | |
44262 | K(ITN,1)=K(ITN,1)+10 | |
44263 | K(IBO,1)=K(IBO,1)+10 | |
44264 | ||
44265 | C...If t+tbar: construct W recoiling against b. | |
44266 | N=N+1 | |
44267 | IW=N | |
44268 | DO 150 J=1,5 | |
44269 | K(IW,J)=0 | |
44270 | V(IW,J)=0D0 | |
44271 | 150 CONTINUE | |
44272 | K(IW,1)=1 | |
44273 | KCHW=PYCHGE(K(IW1,2))+PYCHGE(K(IW2,2)) | |
44274 | IF(IABS(KCHW).EQ.3) THEN | |
44275 | K(IW,2)=ISIGN(24,KCHW) | |
44276 | ELSE | |
44277 | CALL PYERRM(16,'(PY6FRM:) fermion pair inconsistent with W') | |
44278 | ENDIF | |
44279 | K(IW,3)=IW1 | |
44280 | ||
44281 | C...If t+tbar: construct W momentum, including boost by t shower. | |
44282 | DO 160 J=1,4 | |
44283 | P(IW,J)=P(IW1,J)+P(IW2,J) | |
44284 | 160 CONTINUE | |
44285 | P(IW,5)=SQRT(MAX(0D0,P(IW,4)**2-P(IW,1)**2-P(IW,2)**2- | |
44286 | & P(IW,3)**2)) | |
44287 | CALL PYROBO(IW,IW,0D0,0D0,-BETAO(1),-BETAO(2),-BETAO(3)) | |
44288 | CALL PYROBO(IW,IW,0D0,0D0,BETAN(1),BETAN(2),BETAN(3)) | |
44289 | ||
44290 | C...If t+tbar: boost b and W to top rest frame. | |
44291 | DO 170 J=1,3 | |
44292 | BETA(J)=(P(IB,J)+P(IW,J))/(P(IB,4)+P(IW,4)) | |
44293 | 170 CONTINUE | |
44294 | CALL PYROBO(IB,IB,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) | |
44295 | CALL PYROBO(IW,IW,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) | |
44296 | ||
44297 | C...If t+tbar: let b shower and pick up modified W. | |
44298 | PMTS=(P(IB,4)+P(IW,4))**2-(P(IB,1)+P(IW,1))**2- | |
44299 | & (P(IB,2)+P(IW,2))**2-(P(IB,3)+P(IW,3))**2 | |
44300 | CALL PYSHOW(IB,IW,SQRT(MAX(0D0,PMTS))) | |
44301 | DO 180 I=IW,N | |
44302 | IF(IABS(K(I,2)).EQ.24) IWM=I | |
44303 | 180 CONTINUE | |
44304 | ||
44305 | C...If t+tbar: take copy of W decay products. | |
44306 | DO 190 J=1,5 | |
44307 | K(N+1,J)=K(IW1,J) | |
44308 | P(N+1,J)=P(IW1,J) | |
44309 | V(N+1,J)=V(IW1,J) | |
44310 | K(N+2,J)=K(IW2,J) | |
44311 | P(N+2,J)=P(IW2,J) | |
44312 | V(N+2,J)=V(IW2,J) | |
44313 | 190 CONTINUE | |
44314 | K(IW1,1)=K(IW1,1)+10 | |
44315 | K(IW2,1)=K(IW2,1)+10 | |
44316 | K(IWM,1)=K(IWM,1)+10 | |
44317 | K(IWM,4)=N+1 | |
44318 | K(IWM,5)=N+2 | |
44319 | K(N+1,3)=IWM | |
44320 | K(N+2,3)=IWM | |
44321 | IF(IT1.EQ.1) THEN | |
44322 | I3=N+1 | |
44323 | I4=N+2 | |
44324 | ELSE | |
44325 | I5=N+1 | |
44326 | I6=N+2 | |
44327 | ENDIF | |
44328 | N=N+2 | |
44329 | ||
44330 | C...If t+tbar: boost W decay products, first by effects of t shower, | |
44331 | C...then by those of b shower. b and its shower simple boost back. | |
44332 | CALL PYROBO(N-1,N,0D0,0D0,-BETAO(1),-BETAO(2),-BETAO(3)) | |
44333 | CALL PYROBO(N-1,N,0D0,0D0,BETAN(1),BETAN(2),BETAN(3)) | |
44334 | CALL PYROBO(N-1,N,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) | |
44335 | CALL PYROBO(N-1,N,0D0,0D0,-P(IW,1)/P(IW,4), | |
44336 | & -P(IW,2)/P(IW,4),-P(IW,3)/P(IW,4)) | |
44337 | CALL PYROBO(N-1,N,0D0,0D0,P(IWM,1)/P(IWM,4), | |
44338 | & P(IWM,2)/P(IWM,4),P(IWM,3)/P(IWM,4)) | |
44339 | CALL PYROBO(IB,IB,0D0,0D0,BETA(1),BETA(2),BETA(3)) | |
44340 | CALL PYROBO(IW,N,0D0,0D0,BETA(1),BETA(2),BETA(3)) | |
44341 | 200 CONTINUE | |
44342 | ENDIF | |
44343 | ||
44344 | C...Decide on dipole pairing. | |
44345 | IP1=I1 | |
44346 | IP3=I3 | |
44347 | IP5=I5 | |
44348 | PRN=PYR(0)*(P12D+P13D+P21D+P23D+P31D+P32D) | |
44349 | IF(ITOP.EQ.1.OR.PRN.LT.P12D) THEN | |
44350 | IP2=I2 | |
44351 | IP4=I4 | |
44352 | IP6=I6 | |
44353 | ELSEIF(PRN.LT.P12D+P13D) THEN | |
44354 | IP2=I2 | |
44355 | IP4=I6 | |
44356 | IP6=I4 | |
44357 | ELSEIF(PRN.LT.P12D+P13D+P21D) THEN | |
44358 | IP2=I4 | |
44359 | IP4=I2 | |
44360 | IP6=I6 | |
44361 | ELSEIF(PRN.LT.P12D+P13D+P21D+P23D) THEN | |
44362 | IP2=I4 | |
44363 | IP4=I6 | |
44364 | IP6=I2 | |
44365 | ELSEIF(PRN.LT.P12D+P13D+P21D+P23D+P31D) THEN | |
44366 | IP2=I6 | |
44367 | IP4=I2 | |
44368 | IP6=I4 | |
44369 | ELSE | |
44370 | IP2=I6 | |
44371 | IP4=I4 | |
44372 | IP6=I2 | |
44373 | ENDIF | |
44374 | ||
44375 | C...Do colour joinings and parton showers | |
44376 | C...(except ones already made for t+tbar). | |
44377 | IF(ITOP.EQ.0) THEN | |
44378 | IF(IQL12.EQ.1) THEN | |
44379 | IJOIN(1)=IP1 | |
44380 | IJOIN(2)=IP2 | |
44381 | CALL PYJOIN(2,IJOIN) | |
44382 | ENDIF | |
44383 | IF(IQL12.EQ.1.OR.IRAD.EQ.1) THEN | |
44384 | PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- | |
44385 | & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 | |
44386 | CALL PYSHOW(IP1,IP2,SQRT(MAX(0D0,PM12S))) | |
44387 | ENDIF | |
44388 | ENDIF | |
44389 | IF(IQL34.EQ.1) THEN | |
44390 | IJOIN(1)=IP3 | |
44391 | IJOIN(2)=IP4 | |
44392 | CALL PYJOIN(2,IJOIN) | |
44393 | ENDIF | |
44394 | IF(IQL34.EQ.1.OR.IRAD.EQ.1) THEN | |
44395 | PM34S=(P(IP3,4)+P(IP4,4))**2-(P(IP3,1)+P(IP4,1))**2- | |
44396 | & (P(IP3,2)+P(IP4,2))**2-(P(IP3,3)+P(IP4,3))**2 | |
44397 | CALL PYSHOW(IP3,IP4,SQRT(MAX(0D0,PM34S))) | |
44398 | ENDIF | |
44399 | IF(IQL56.EQ.1) THEN | |
44400 | IJOIN(1)=IP5 | |
44401 | IJOIN(2)=IP6 | |
44402 | CALL PYJOIN(2,IJOIN) | |
44403 | ENDIF | |
44404 | IF(IQL56.EQ.1.OR.IRAD.EQ.1) THEN | |
44405 | PM56S=(P(IP5,4)+P(IP6,4))**2-(P(IP5,1)+P(IP6,1))**2- | |
44406 | & (P(IP5,2)+P(IP6,2))**2-(P(IP5,3)+P(IP6,3))**2 | |
44407 | CALL PYSHOW(IP5,IP6,SQRT(MAX(0D0,PM56S))) | |
44408 | ENDIF | |
44409 | ||
44410 | C...Do fragmentation and decays. Possibly except tau decay. | |
44411 | IF(ITAU.EQ.0) THEN | |
44412 | NTAU=0 | |
44413 | DO 210 I=1,N | |
44414 | IF(IABS(K(I,2)).EQ.15.AND.K(I,1).EQ.1) THEN | |
44415 | NTAU=NTAU+1 | |
44416 | INTAU(NTAU)=I | |
44417 | K(I,1)=11 | |
44418 | ENDIF | |
44419 | 210 CONTINUE | |
44420 | ENDIF | |
44421 | CALL PYEXEC | |
44422 | IF(ITAU.EQ.0) THEN | |
44423 | DO 220 I=1,NTAU | |
44424 | K(INTAU(I),1)=1 | |
44425 | 220 CONTINUE | |
44426 | ENDIF | |
44427 | ||
44428 | C...Call PYHEPC to convert output from PYJETS to HEPEVT common. | |
44429 | IF(ICOM.EQ.0) THEN | |
44430 | MSTU(28)=0 | |
44431 | CALL PYHEPC(1) | |
44432 | ENDIF | |
44433 | ||
44434 | END | |
44435 | ||
44436 | C********************************************************************* | |
44437 | ||
44438 | C...PY4JET | |
44439 | C...An interface from a four-parton generator to include | |
44440 | C...parton showers and hadronization. | |
44441 | ||
44442 | SUBROUTINE PY4JET(PMAX,IRAD,ICOM) | |
44443 | ||
44444 | C...Double precision and integer declarations. | |
44445 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
44446 | IMPLICIT INTEGER(I-N) | |
44447 | INTEGER PYK,PYCHGE,PYCOMP | |
44448 | C...Commonblocks. | |
44449 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
44450 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
44451 | SAVE /PYJETS/,/PYDAT1/ | |
44452 | C...Local arrays. | |
44453 | DIMENSION IJOIN(2),PTOT(4),BETA(3) | |
44454 | ||
44455 | C...Call PYHEPC to convert input from HEPEVT to PYJETS common. | |
44456 | IF(ICOM.EQ.0) THEN | |
44457 | MSTU(28)=0 | |
44458 | CALL PYHEPC(2) | |
44459 | ENDIF | |
44460 | ||
44461 | C...Loop through entries and pick up all final partons. | |
44462 | I1=0 | |
44463 | I2=0 | |
44464 | I3=0 | |
44465 | I4=0 | |
44466 | DO 100 I=1,N | |
44467 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 | |
44468 | KFA=IABS(K(I,2)) | |
44469 | IF((KFA.GE.1.AND.KFA.LE.6).OR.KFA.EQ.21) THEN | |
44470 | IF(K(I,2).GT.0.AND.K(I,2).LE.6) THEN | |
44471 | IF(I1.EQ.0) THEN | |
44472 | I1=I | |
44473 | ELSEIF(I3.EQ.0) THEN | |
44474 | I3=I | |
44475 | ELSE | |
44476 | CALL PYERRM(16,'(PY4JET:) more than two quarks') | |
44477 | ENDIF | |
44478 | ELSEIF(K(I,2).LT.0) THEN | |
44479 | IF(I2.EQ.0) THEN | |
44480 | I2=I | |
44481 | ELSEIF(I4.EQ.0) THEN | |
44482 | I4=I | |
44483 | ELSE | |
44484 | CALL PYERRM(16,'(PY4JET:) more than two antiquarks') | |
44485 | ENDIF | |
44486 | ELSE | |
44487 | IF(I3.EQ.0) THEN | |
44488 | I3=I | |
44489 | ELSEIF(I4.EQ.0) THEN | |
44490 | I4=I | |
44491 | ELSE | |
44492 | CALL PYERRM(16,'(PY4JET:) more than two gluons') | |
44493 | ENDIF | |
44494 | ENDIF | |
44495 | ENDIF | |
44496 | 100 CONTINUE | |
44497 | ||
44498 | C...Check that event is arranged according to conventions. | |
44499 | IF(I1.EQ.0.OR.I2.EQ.0.OR.I3.EQ.0.OR.I4.EQ.0) THEN | |
44500 | CALL PYERRM(16,'(PY4JET:) event contains too few partons') | |
44501 | ENDIF | |
44502 | IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3) THEN | |
44503 | CALL PYERRM(6,'(PY4JET:) partons arranged in wrong order') | |
44504 | ENDIF | |
44505 | ||
44506 | C...Check whether second pair are quarks or gluons. | |
44507 | IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN | |
44508 | IQG34=1 | |
44509 | ELSEIF(K(I3,2).EQ.21.AND.K(I4,2).EQ.21) THEN | |
44510 | IQG34=2 | |
44511 | ELSE | |
44512 | CALL PYERRM(16,'(PY4JET:) second parton pair inconsistent') | |
44513 | ENDIF | |
44514 | ||
44515 | C...Boost partons to their cm frame. | |
44516 | DO 110 J=1,4 | |
44517 | PTOT(J)=P(I1,J)+P(I2,J)+P(I3,J)+P(I4,J) | |
44518 | 110 CONTINUE | |
44519 | ECM=SQRT(MAX(0D0,PTOT(4)**2-PTOT(1)**2-PTOT(2)**2-PTOT(3)**2)) | |
44520 | DO 120 J=1,3 | |
44521 | BETA(J)=PTOT(J)/PTOT(4) | |
44522 | 120 CONTINUE | |
44523 | CALL PYROBO(I1,I1,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) | |
44524 | CALL PYROBO(I2,I2,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) | |
44525 | CALL PYROBO(I3,I3,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) | |
44526 | CALL PYROBO(I4,I4,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) | |
44527 | NSAV=N | |
44528 | ||
44529 | C...Decide and set up shower history for q qbar q' qbar' events. | |
44530 | IF(IQG34.EQ.1) THEN | |
44531 | W1=PY4JTW(0,I1,I3,I4) | |
44532 | W2=PY4JTW(0,I2,I3,I4) | |
44533 | IF(W1.GT.PYR(0)*(W1+W2)) THEN | |
44534 | CALL PY4JTS(0,I1,I3,I4,I2,QMAX) | |
44535 | ELSE | |
44536 | CALL PY4JTS(0,I2,I3,I4,I1,QMAX) | |
44537 | ENDIF | |
44538 | ||
44539 | C...Decide and set up shower history for q qbar g g events. | |
44540 | ELSE | |
44541 | W1=PY4JTW(I1,I3,I2,I4) | |
44542 | W2=PY4JTW(I1,I4,I2,I3) | |
44543 | W3=PY4JTW(0,I3,I1,I4) | |
44544 | W4=PY4JTW(0,I4,I1,I3) | |
44545 | W5=PY4JTW(0,I3,I2,I4) | |
44546 | W6=PY4JTW(0,I4,I2,I3) | |
44547 | W7=PY4JTW(0,I1,I3,I4) | |
44548 | W8=PY4JTW(0,I2,I3,I4) | |
44549 | WR=(W1+W2+W3+W4+W5+W6+W7+W8)*PYR(0) | |
44550 | IF(W1.GT.WR) THEN | |
44551 | CALL PY4JTS(I1,I3,I2,I4,0,QMAX) | |
44552 | ELSEIF(W1+W2.GT.WR) THEN | |
44553 | CALL PY4JTS(I1,I4,I2,I3,0,QMAX) | |
44554 | ELSEIF(W1+W2+W3.GT.WR) THEN | |
44555 | CALL PY4JTS(0,I3,I1,I4,I2,QMAX) | |
44556 | ELSEIF(W1+W2+W3+W4.GT.WR) THEN | |
44557 | CALL PY4JTS(0,I4,I1,I3,I2,QMAX) | |
44558 | ELSEIF(W1+W2+W3+W4+W5.GT.WR) THEN | |
44559 | CALL PY4JTS(0,I3,I2,I4,I1,QMAX) | |
44560 | ELSEIF(W1+W2+W3+W4+W5+W6.GT.WR) THEN | |
44561 | CALL PY4JTS(0,I4,I2,I3,I1,QMAX) | |
44562 | ELSEIF(W1+W2+W3+W4+W5+W6+W7.GT.WR) THEN | |
44563 | CALL PY4JTS(0,I1,I3,I4,I2,QMAX) | |
44564 | ELSE | |
44565 | CALL PY4JTS(0,I2,I3,I4,I1,QMAX) | |
44566 | ENDIF | |
44567 | ENDIF | |
44568 | ||
44569 | C...Boost back original partons and mark them as deleted. | |
44570 | CALL PYROBO(I1,I1,0D0,0D0,BETA(1),BETA(2),BETA(3)) | |
44571 | CALL PYROBO(I2,I2,0D0,0D0,BETA(1),BETA(2),BETA(3)) | |
44572 | CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) | |
44573 | CALL PYROBO(I4,I4,0D0,0D0,BETA(1),BETA(2),BETA(3)) | |
44574 | K(I1,1)=K(I1,1)+10 | |
44575 | K(I2,1)=K(I2,1)+10 | |
44576 | K(I3,1)=K(I3,1)+10 | |
44577 | K(I4,1)=K(I4,1)+10 | |
44578 | ||
44579 | C...Rotate shower initiating partons to be along z axis. | |
44580 | PHI=PYANGL(P(NSAV+1,1),P(NSAV+1,2)) | |
44581 | CALL PYROBO(NSAV+1,NSAV+6,0D0,-PHI,0D0,0D0,0D0) | |
44582 | THE=PYANGL(P(NSAV+1,3),P(NSAV+1,1)) | |
44583 | CALL PYROBO(NSAV+1,NSAV+6,-THE,0D0,0D0,0D0,0D0) | |
44584 | ||
44585 | C...Set up copy of shower initiating partons as on mass shell. | |
44586 | DO 140 I=N+1,N+2 | |
44587 | DO 130 J=1,5 | |
44588 | K(I,J)=0 | |
44589 | P(I,J)=0D0 | |
44590 | V(I,J)=V(I1,J) | |
44591 | 130 CONTINUE | |
44592 | K(I,1)=1 | |
44593 | K(I,2)=K(I-6,2) | |
44594 | 140 CONTINUE | |
44595 | IF(K(NSAV+1,2).EQ.K(I1,2)) THEN | |
44596 | K(N+1,3)=I1 | |
44597 | P(N+1,5)=P(I1,5) | |
44598 | K(N+2,3)=I2 | |
44599 | P(N+2,5)=P(I2,5) | |
44600 | ELSE | |
44601 | K(N+1,3)=I2 | |
44602 | P(N+1,5)=P(I2,5) | |
44603 | K(N+2,3)=I1 | |
44604 | P(N+2,5)=P(I1,5) | |
44605 | ENDIF | |
44606 | PABS=SQRT(MAX(0D0,(ECM**2-P(N+1,5)**2-P(N+2,5)**2)**2- | |
44607 | &(2D0*P(N+1,5)*P(N+2,5))**2))/(2D0*ECM) | |
44608 | P(N+1,3)=PABS | |
44609 | P(N+1,4)=SQRT(PABS**2+P(N+1,5)**2) | |
44610 | P(N+2,3)=-PABS | |
44611 | P(N+2,4)=SQRT(PABS**2+P(N+2,5)**2) | |
44612 | N=N+2 | |
44613 | ||
44614 | C...Decide whether to allow or not photon radiation in showers. | |
44615 | C...Connect up colours. | |
44616 | MSTJ(41)=2 | |
44617 | IF(IRAD.EQ.0) MSTJ(41)=1 | |
44618 | IJOIN(1)=N-1 | |
44619 | IJOIN(2)=N | |
44620 | CALL PYJOIN(2,IJOIN) | |
44621 | ||
44622 | C...Decide on maximum virtuality and do parton shower. | |
44623 | IF(PMAX.LT.PARJ(82)) THEN | |
44624 | PQMAX=QMAX | |
44625 | ELSE | |
44626 | PQMAX=PMAX | |
44627 | ENDIF | |
44628 | CALL PYSHOW(NSAV+1,-8,PQMAX) | |
44629 | ||
44630 | C...Rotate and boost back system. | |
44631 | CALL PYROBO(NSAV+1,N,THE,PHI,BETA(1),BETA(2),BETA(3)) | |
44632 | ||
44633 | C...Do fragmentation and decays. | |
44634 | CALL PYEXEC | |
44635 | ||
44636 | C...Call PYHEPC to convert output from PYJETS to HEPEVT common. | |
44637 | IF(ICOM.EQ.0) THEN | |
44638 | MSTU(28)=0 | |
44639 | CALL PYHEPC(1) | |
44640 | ENDIF | |
44641 | ||
44642 | RETURN | |
44643 | END | |
44644 | ||
44645 | C********************************************************************* | |
44646 | ||
44647 | C...PY4JTW | |
44648 | C...Auxiliary to PY4JET, to evaluate weight of configuration. | |
44649 | ||
44650 | FUNCTION PY4JTW(IA1,IA2,IA3,IA4) | |
44651 | ||
44652 | C...Double precision and integer declarations. | |
44653 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
44654 | IMPLICIT INTEGER(I-N) | |
44655 | INTEGER PYK,PYCHGE,PYCOMP | |
44656 | C...Commonblocks. | |
44657 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
44658 | SAVE /PYJETS/ | |
44659 | ||
44660 | C...First case: when both original partons radiate. | |
44661 | C...IA1 /= 0: N+1 -> IA1 + IA2, N+2 -> IA3 + IA4. | |
44662 | IF(IA1.NE.0) THEN | |
44663 | DO 100 J=1,4 | |
44664 | P(N+1,J)=P(IA1,J)+P(IA2,J) | |
44665 | P(N+2,J)=P(IA3,J)+P(IA4,J) | |
44666 | 100 CONTINUE | |
44667 | P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- | |
44668 | & P(N+1,3)**2)) | |
44669 | P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- | |
44670 | & P(N+2,3)**2)) | |
44671 | Z1=P(IA1,4)/P(N+1,4) | |
44672 | WT1=(4D0/3D0)*((1D0+Z1**2)/(1D0-Z1))/(P(N+1,5)**2-P(IA1,5)**2) | |
44673 | Z2=P(IA3,4)/P(N+2,4) | |
44674 | WT2=(4D0/3D0)*((1D0+Z2**2)/(1D0-Z2))/(P(N+2,5)**2-P(IA3,5)**2) | |
44675 | ||
44676 | C...Second case: when one original parton radiates to three. | |
44677 | C...IA1 = 0: N+1 -> IA2 + N+2, N+2 -> IA3 + IA4. | |
44678 | ELSE | |
44679 | DO 110 J=1,4 | |
44680 | P(N+2,J)=P(IA3,J)+P(IA4,J) | |
44681 | P(N+1,J)=P(N+2,J)+P(IA2,J) | |
44682 | 110 CONTINUE | |
44683 | P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- | |
44684 | & P(N+1,3)**2)) | |
44685 | P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- | |
44686 | & P(N+2,3)**2)) | |
44687 | IF(K(IA2,2).EQ.21) THEN | |
44688 | Z1=P(N+2,4)/P(N+1,4) | |
44689 | WT1=(4D0/3D0)*((1D0+Z1**2)/(1D0-Z1))/(P(N+1,5)**2- | |
44690 | & P(IA3,5)**2) | |
44691 | ELSE | |
44692 | Z1=P(IA2,4)/P(N+1,4) | |
44693 | WT1=(4D0/3D0)*((1D0+Z1**2)/(1D0-Z1))/(P(N+1,5)**2- | |
44694 | & P(IA2,5)**2) | |
44695 | ENDIF | |
44696 | Z2=P(IA3,4)/P(N+2,4) | |
44697 | IF(K(IA2,2).EQ.21) THEN | |
44698 | WT2=(4D0/3D0)*((1D0+Z2**2)/(1D0-Z2))/(P(N+2,5)**2- | |
44699 | & P(IA3,5)**2) | |
44700 | ELSEIF(K(IA3,2).EQ.21) THEN | |
44701 | WT2=3D0*((1D0-Z2*(1D0-Z2))**2/(Z2*(1D0-Z2)))/P(N+2,5)**2 | |
44702 | ELSE | |
44703 | WT2=0.5D0*(Z2**2+(1D0-Z2)**2) | |
44704 | ENDIF | |
44705 | ENDIF | |
44706 | ||
44707 | C...Total weight. | |
44708 | PY4JTW=WT1*WT2 | |
44709 | ||
44710 | RETURN | |
44711 | END | |
44712 | ||
44713 | C********************************************************************* | |
44714 | ||
44715 | C...PY4JTS | |
44716 | C...Auxiliary to PY4JET, to set up chosen configuration. | |
44717 | ||
44718 | SUBROUTINE PY4JTS(IA1,IA2,IA3,IA4,IA5,QMAX) | |
44719 | ||
44720 | C...Double precision and integer declarations. | |
44721 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
44722 | IMPLICIT INTEGER(I-N) | |
44723 | INTEGER PYK,PYCHGE,PYCOMP | |
44724 | C...Commonblocks. | |
44725 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
44726 | SAVE /PYJETS/ | |
44727 | ||
44728 | C...Reset info. | |
44729 | DO 110 I=N+1,N+6 | |
44730 | DO 100 J=1,5 | |
44731 | K(I,J)=0 | |
44732 | V(I,J)=V(IA2,J) | |
44733 | 100 CONTINUE | |
44734 | K(I,1)=16 | |
44735 | 110 CONTINUE | |
44736 | ||
44737 | C...First case: when both original partons radiate. | |
44738 | C...N+1 -> (IA1=N+3) + (IA2=N+4), N+2 -> (IA3=N+5) + (IA4=N+6). | |
44739 | IF(IA1.NE.0) THEN | |
44740 | ||
44741 | C...Set up flavour and history pointers for new partons. | |
44742 | K(N+1,2)=K(IA1,2) | |
44743 | K(N+2,2)=K(IA3,2) | |
44744 | K(N+3,2)=K(IA1,2) | |
44745 | K(N+4,2)=K(IA2,2) | |
44746 | K(N+5,2)=K(IA3,2) | |
44747 | K(N+6,2)=K(IA4,2) | |
44748 | K(N+1,3)=IA1 | |
44749 | K(N+1,4)=N+3 | |
44750 | K(N+1,5)=N+4 | |
44751 | K(N+2,3)=IA3 | |
44752 | K(N+2,4)=N+5 | |
44753 | K(N+2,5)=N+6 | |
44754 | K(N+3,3)=N+1 | |
44755 | K(N+4,3)=N+1 | |
44756 | K(N+5,3)=N+2 | |
44757 | K(N+6,3)=N+2 | |
44758 | ||
44759 | C...Set up momenta for new partons. | |
44760 | DO 120 J=1,5 | |
44761 | P(N+1,J)=P(IA1,J)+P(IA2,J) | |
44762 | P(N+2,J)=P(IA3,J)+P(IA4,J) | |
44763 | P(N+3,J)=P(IA1,J) | |
44764 | P(N+4,J)=P(IA2,J) | |
44765 | P(N+5,J)=P(IA3,J) | |
44766 | P(N+6,J)=P(IA4,J) | |
44767 | 120 CONTINUE | |
44768 | P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- | |
44769 | & P(N+1,3)**2)) | |
44770 | P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- | |
44771 | & P(N+2,3)**2)) | |
44772 | QMAX=MIN(P(N+1,5),P(N+2,5)) | |
44773 | ||
44774 | C...Second case: q radiates twice. | |
44775 | C...N+1 -> (IA2=N+4) + N+3, N+3 -> (IA3=N+5) + (IA4=N+6), | |
44776 | C...IA5=N+2 does not radiate. | |
44777 | ELSEIF(K(IA2,2).EQ.21) THEN | |
44778 | ||
44779 | C...Set up flavour and history pointers for new partons. | |
44780 | K(N+1,2)=K(IA3,2) | |
44781 | K(N+2,2)=K(IA5,2) | |
44782 | K(N+3,2)=K(IA3,2) | |
44783 | K(N+4,2)=K(IA2,2) | |
44784 | K(N+5,2)=K(IA3,2) | |
44785 | K(N+6,2)=K(IA4,2) | |
44786 | K(N+1,3)=IA3 | |
44787 | K(N+1,4)=N+3 | |
44788 | K(N+1,5)=N+4 | |
44789 | K(N+2,3)=IA5 | |
44790 | K(N+3,3)=N+1 | |
44791 | K(N+3,4)=N+5 | |
44792 | K(N+3,5)=N+6 | |
44793 | K(N+4,3)=N+1 | |
44794 | K(N+5,3)=N+3 | |
44795 | K(N+6,3)=N+3 | |
44796 | ||
44797 | C...Set up momenta for new partons. | |
44798 | DO 130 J=1,5 | |
44799 | P(N+1,J)=P(IA2,J)+P(IA3,J)+P(IA4,J) | |
44800 | P(N+2,J)=P(IA5,J) | |
44801 | P(N+3,J)=P(IA3,J)+P(IA4,J) | |
44802 | P(N+4,J)=P(IA2,J) | |
44803 | P(N+5,J)=P(IA3,J) | |
44804 | P(N+6,J)=P(IA4,J) | |
44805 | 130 CONTINUE | |
44806 | P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- | |
44807 | & P(N+1,3)**2)) | |
44808 | P(N+3,5)=SQRT(MAX(0D0,P(N+3,4)**2-P(N+3,1)**2-P(N+3,2)**2- | |
44809 | & P(N+3,3)**2)) | |
44810 | QMAX=P(N+3,5) | |
44811 | ||
44812 | C...Third case: q radiates g, g branches. | |
44813 | C...N+1 -> (IA2=N+3) + N+4, N+4 -> (IA3=N+5) + (IA4=N+6), | |
44814 | C...IA5=N+2 does not radiate. | |
44815 | ELSE | |
44816 | ||
44817 | C...Set up flavour and history pointers for new partons. | |
44818 | K(N+1,2)=K(IA2,2) | |
44819 | K(N+2,2)=K(IA5,2) | |
44820 | K(N+3,2)=K(IA2,2) | |
44821 | K(N+4,2)=21 | |
44822 | K(N+5,2)=K(IA3,2) | |
44823 | K(N+6,2)=K(IA4,2) | |
44824 | K(N+1,3)=IA2 | |
44825 | K(N+1,4)=N+3 | |
44826 | K(N+1,5)=N+4 | |
44827 | K(N+2,3)=IA5 | |
44828 | K(N+3,3)=N+1 | |
44829 | K(N+4,3)=N+1 | |
44830 | K(N+4,4)=N+5 | |
44831 | K(N+4,5)=N+6 | |
44832 | K(N+5,3)=N+4 | |
44833 | K(N+6,3)=N+4 | |
44834 | ||
44835 | C...Set up momenta for new partons. | |
44836 | DO 140 J=1,5 | |
44837 | P(N+1,J)=P(IA2,J)+P(IA3,J)+P(IA4,J) | |
44838 | P(N+2,J)=P(IA5,J) | |
44839 | P(N+3,J)=P(IA2,J) | |
44840 | P(N+4,J)=P(IA3,J)+P(IA4,J) | |
44841 | P(N+5,J)=P(IA3,J) | |
44842 | P(N+6,J)=P(IA4,J) | |
44843 | 140 CONTINUE | |
44844 | P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- | |
44845 | & P(N+1,3)**2)) | |
44846 | P(N+4,5)=SQRT(MAX(0D0,P(N+4,4)**2-P(N+4,1)**2-P(N+4,2)**2- | |
44847 | & P(N+4,3)**2)) | |
44848 | QMAX=P(N+4,5) | |
44849 | ||
44850 | ENDIF | |
44851 | N=N+6 | |
44852 | ||
44853 | RETURN | |
44854 | END | |
44855 | ||
44856 | C********************************************************************* | |
44857 | ||
44858 | C...PYJOIN | |
44859 | C...Connects a sequence of partons with colour flow indices, | |
44860 | C...as required for subsequent shower evolution (or other operations). | |
44861 | ||
44862 | SUBROUTINE PYJOIN(NJOIN,IJOIN) | |
44863 | ||
44864 | C...Double precision and integer declarations. | |
44865 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
44866 | IMPLICIT INTEGER(I-N) | |
44867 | INTEGER PYK,PYCHGE,PYCOMP | |
44868 | C...Commonblocks. | |
44869 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
44870 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
44871 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
44872 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
44873 | C...Local array. | |
44874 | DIMENSION IJOIN(*) | |
44875 | ||
44876 | C...Check that partons are of right types to be connected. | |
44877 | IF(NJOIN.LT.2) GOTO 120 | |
44878 | KQSUM=0 | |
44879 | DO 100 IJN=1,NJOIN | |
44880 | I=IJOIN(IJN) | |
44881 | IF(I.LE.0.OR.I.GT.N) GOTO 120 | |
44882 | IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120 | |
44883 | KC=PYCOMP(K(I,2)) | |
44884 | IF(KC.EQ.0) GOTO 120 | |
44885 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
44886 | IF(KQ.EQ.0) GOTO 120 | |
44887 | IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120 | |
44888 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
44889 | IF(IJN.EQ.1) KQS=KQ | |
44890 | 100 CONTINUE | |
44891 | IF(KQSUM.NE.0) GOTO 120 | |
44892 | ||
44893 | C...Connect the partons sequentially (closing for gluon loop). | |
44894 | KCS=(9-KQS)/2 | |
44895 | IF(KQS.EQ.2) KCS=INT(4.5D0+PYR(0)) | |
44896 | DO 110 IJN=1,NJOIN | |
44897 | I=IJOIN(IJN) | |
44898 | K(I,1)=3 | |
44899 | IF(IJN.NE.1) IP=IJOIN(IJN-1) | |
44900 | IF(IJN.EQ.1) IP=IJOIN(NJOIN) | |
44901 | IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1) | |
44902 | IF(IJN.EQ.NJOIN) IN=IJOIN(1) | |
44903 | K(I,KCS)=MSTU(5)*IN | |
44904 | K(I,9-KCS)=MSTU(5)*IP | |
44905 | IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0 | |
44906 | IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0 | |
44907 | 110 CONTINUE | |
44908 | ||
44909 | C...Error exit: no action taken. | |
44910 | RETURN | |
44911 | 120 CALL PYERRM(12, | |
44912 | &'(PYJOIN:) given entries can not be joined by one string') | |
44913 | ||
44914 | RETURN | |
44915 | END | |
44916 | ||
44917 | C********************************************************************* | |
44918 | ||
44919 | C...PYGIVE | |
44920 | C...Sets values of commonblock variables. | |
44921 | ||
44922 | SUBROUTINE PYGIVE(CHIN) | |
44923 | ||
44924 | C...Double precision and integer declarations. | |
44925 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
44926 | IMPLICIT INTEGER(I-N) | |
44927 | INTEGER PYK,PYCHGE,PYCOMP | |
44928 | C...Commonblocks. | |
44929 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
44930 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
44931 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
44932 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
44933 | COMMON/PYDAT4/CHAF(500,2) | |
44934 | CHARACTER CHAF*16 | |
44935 | COMMON/PYDATR/MRPY(6),RRPY(100) | |
44936 | COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
44937 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
44938 | COMMON/PYINT1/MINT(400),VINT(400) | |
44939 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
44940 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
44941 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
44942 | COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
44943 | COMMON/PYINT6/PROC(0:500) | |
44944 | CHARACTER PROC*28 | |
44945 | COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
44946 | COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), | |
44947 | &XPDIR(-6:6) | |
44948 | COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) | |
44949 | COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) | |
44950 | COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) | |
44951 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/, | |
44952 | &/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/, | |
44953 | &/PYINT5/,/PYINT6/,/PYINT7/,/PYINT8/,/PYMSSM/,/PYMSRV/,/PYTCSM/ | |
44954 | C...Local arrays and character variables. | |
44955 | CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28, | |
44956 | &CHNEW2*28,CHNAM*6,CHVAR(54)*6,CHALP(2)*26,CHIND*8,CHINI*10, | |
44957 | &CHINR*16 | |
44958 | DIMENSION MSVAR(54,8) | |
44959 | ||
44960 | C...For each variable to be translated give: name, | |
44961 | C...integer/real/character, no. of indices, lower&upper index bounds. | |
44962 | DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG', | |
44963 | &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRPY', | |
44964 | &'RRPY','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI', | |
44965 | &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH', | |
44966 | &'MWID','WIDS','NGEN','XSEC','PROC','SIGT','XPVMD','XPANL', | |
44967 | &'XPANH','XPBEH','XPDIR','IMSS','RMSS','RVLAM','RVLAMP','RVLAMB', | |
44968 | &'ITCM','RTCM'/ | |
44969 | DATA ((MSVAR(I,J),J=1,8),I=1,54)/ 1,7*0, 1,2,1,4000,1,5,2*0, | |
44970 | &2,2,1,4000,1,5,2*0, 2,2,1,4000,1,5,2*0, 1,1,1,200,4*0, | |
44971 | &2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0, | |
44972 | &1,2,1,500,1,4,2*0, 2,2,1,500,1,4,2*0, 2,1,1,2000,4*0, | |
44973 | &2,2,1,4,1,4,2*0, 1,2,1,500,1,3,2*0, 1,2,1,8000,1,2,2*0, | |
44974 | &2,1,1,8000,4*0, 1,2,1,8000,1,5,2*0, 3,2,1,500,1,2,2*0, | |
44975 | &1,1,1,6,4*0, 2,1,1,100,4*0, | |
44976 | &1,7*0, 1,1,1,500,4*0, 1,2,1,2,-40,40,2*0, 2,1,1,200,4*0, | |
44977 | &1,1,1,200,4*0, 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0, | |
44978 | &1,1,1,400,4*0, 2,1,1,400,4*0, 1,1,1,500,4*0, | |
44979 | &1,2,1,500,1,2,2*0, 2,2,1,500,1,20,2*0, 1,3,1,40,1,4,1,2, | |
44980 | &2,2,1,2,-40,40,2*0, 1,2,1,1000,1,3,2*0, 2,1,1,1000,4*0, | |
44981 | &1,1,1,500,4*0, 2,2,1,500,1,5,2*0, 1,2,0,500,1,3,2*0, | |
44982 | &2,2,0,500,1,3,2*0, 4,1,0,500,4*0, 2,3,0,6,0,6,0,5, | |
44983 | &2,1,-6,6,4*0, 2,1,-6,6,4*0, 2,1,-6,6,4*0, | |
44984 | &2,1,-6,6,4*0, 2,1,-6,6,4*0, 1,1,0,99,4*0, 2,1,0,99,4*0, | |
44985 | &2,3,1,3,1,3,1,3, 2,3,1,3,1,3,1,3, 2,3,1,3,1,3,1,3, | |
44986 | &1,1,0,99,4*0, 2,1,0,99,4*0/ | |
44987 | DATA CHALP/'abcdefghijklmnopqrstuvwxyz', | |
44988 | &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ | |
44989 | ||
44990 | C...Length of character variable. Subdivide it into instructions. | |
44991 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
44992 | CHBIT=CHIN//' ' | |
44993 | LBIT=101 | |
44994 | 100 LBIT=LBIT-1 | |
44995 | IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100 | |
44996 | LTOT=0 | |
44997 | DO 110 LCOM=1,LBIT | |
44998 | IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110 | |
44999 | LTOT=LTOT+1 | |
45000 | CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM) | |
45001 | 110 CONTINUE | |
45002 | LLOW=0 | |
45003 | 120 LHIG=LLOW+1 | |
45004 | 130 LHIG=LHIG+1 | |
45005 | IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130 | |
45006 | LBIT=LHIG-LLOW-1 | |
45007 | CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1) | |
45008 | ||
45009 | C...Peel off any text following exclamation mark. | |
45010 | LHIG2=LBIT | |
45011 | DO 140 LLOW2=LHIG2,1,-1 | |
45012 | IF(CHBIT(LLOW2:LLOW2).EQ.'!') LBIT=LLOW2-1 | |
45013 | 140 CONTINUE | |
45014 | IF(LBIT.EQ.0) RETURN | |
45015 | ||
45016 | C...Identify commonblock variable. | |
45017 | LNAM=1 | |
45018 | 150 LNAM=LNAM+1 | |
45019 | IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND. | |
45020 | &LNAM.LE.6) GOTO 150 | |
45021 | CHNAM=CHBIT(1:LNAM-1)//' ' | |
45022 | DO 170 LCOM=1,LNAM-1 | |
45023 | DO 160 LALP=1,26 | |
45024 | IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)= | |
45025 | & CHALP(2)(LALP:LALP) | |
45026 | 160 CONTINUE | |
45027 | 170 CONTINUE | |
45028 | IVAR=0 | |
45029 | DO 180 IV=1,54 | |
45030 | IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV | |
45031 | 180 CONTINUE | |
45032 | IF(IVAR.EQ.0) THEN | |
45033 | CALL PYERRM(18,'(PYGIVE:) do not recognize variable '//CHNAM) | |
45034 | LLOW=LHIG | |
45035 | IF(LLOW.LT.LTOT) GOTO 120 | |
45036 | RETURN | |
45037 | ENDIF | |
45038 | ||
45039 | C...Identify any indices. | |
45040 | I1=0 | |
45041 | I2=0 | |
45042 | I3=0 | |
45043 | NINDX=0 | |
45044 | IF(CHBIT(LNAM:LNAM).EQ.'(') THEN | |
45045 | LIND=LNAM | |
45046 | 190 LIND=LIND+1 | |
45047 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190 | |
45048 | CHIND=' ' | |
45049 | IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c') | |
45050 | & .AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17.OR. | |
45051 | & IVAR.EQ.37)) THEN | |
45052 | CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1) | |
45053 | READ(CHIND,'(I8)') KF | |
45054 | I1=PYCOMP(KF) | |
45055 | ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ. | |
45056 | & 'c') THEN | |
45057 | CALL PYERRM(18,'(PYGIVE:) not allowed to use C index for '// | |
45058 | & CHNAM) | |
45059 | LLOW=LHIG | |
45060 | IF(LLOW.LT.LTOT) GOTO 120 | |
45061 | RETURN | |
45062 | ELSE | |
45063 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) | |
45064 | READ(CHIND,'(I8)') I1 | |
45065 | ENDIF | |
45066 | LNAM=LIND | |
45067 | IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 | |
45068 | NINDX=1 | |
45069 | ENDIF | |
45070 | IF(CHBIT(LNAM:LNAM).EQ.',') THEN | |
45071 | LIND=LNAM | |
45072 | 200 LIND=LIND+1 | |
45073 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 200 | |
45074 | CHIND=' ' | |
45075 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) | |
45076 | READ(CHIND,'(I8)') I2 | |
45077 | LNAM=LIND | |
45078 | IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 | |
45079 | NINDX=2 | |
45080 | ENDIF | |
45081 | IF(CHBIT(LNAM:LNAM).EQ.',') THEN | |
45082 | LIND=LNAM | |
45083 | 210 LIND=LIND+1 | |
45084 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 210 | |
45085 | CHIND=' ' | |
45086 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) | |
45087 | READ(CHIND,'(I8)') I3 | |
45088 | LNAM=LIND+1 | |
45089 | NINDX=3 | |
45090 | ENDIF | |
45091 | ||
45092 | C...Check that indices allowed. | |
45093 | IERR=0 | |
45094 | IF(NINDX.NE.MSVAR(IVAR,2)) IERR=1 | |
45095 | IF(NINDX.GE.1.AND.(I1.LT.MSVAR(IVAR,3).OR.I1.GT.MSVAR(IVAR,4))) | |
45096 | &IERR=2 | |
45097 | IF(NINDX.GE.2.AND.(I2.LT.MSVAR(IVAR,5).OR.I2.GT.MSVAR(IVAR,6))) | |
45098 | &IERR=3 | |
45099 | IF(NINDX.EQ.3.AND.(I3.LT.MSVAR(IVAR,7).OR.I3.GT.MSVAR(IVAR,8))) | |
45100 | &IERR=4 | |
45101 | IF(CHBIT(LNAM:LNAM).NE.'=') IERR=5 | |
45102 | IF(IERR.GE.1) THEN | |
45103 | CALL PYERRM(18,'(PYGIVE:) unallowed indices for '// | |
45104 | & CHBIT(1:LNAM-1)) | |
45105 | LLOW=LHIG | |
45106 | IF(LLOW.LT.LTOT) GOTO 120 | |
45107 | RETURN | |
45108 | ENDIF | |
45109 | ||
45110 | C...Save old value of variable. | |
45111 | IF(IVAR.EQ.1) THEN | |
45112 | IOLD=N | |
45113 | ELSEIF(IVAR.EQ.2) THEN | |
45114 | IOLD=K(I1,I2) | |
45115 | ELSEIF(IVAR.EQ.3) THEN | |
45116 | ROLD=P(I1,I2) | |
45117 | ELSEIF(IVAR.EQ.4) THEN | |
45118 | ROLD=V(I1,I2) | |
45119 | ELSEIF(IVAR.EQ.5) THEN | |
45120 | IOLD=MSTU(I1) | |
45121 | ELSEIF(IVAR.EQ.6) THEN | |
45122 | ROLD=PARU(I1) | |
45123 | ELSEIF(IVAR.EQ.7) THEN | |
45124 | IOLD=MSTJ(I1) | |
45125 | ELSEIF(IVAR.EQ.8) THEN | |
45126 | ROLD=PARJ(I1) | |
45127 | ELSEIF(IVAR.EQ.9) THEN | |
45128 | IOLD=KCHG(I1,I2) | |
45129 | ELSEIF(IVAR.EQ.10) THEN | |
45130 | ROLD=PMAS(I1,I2) | |
45131 | ELSEIF(IVAR.EQ.11) THEN | |
45132 | ROLD=PARF(I1) | |
45133 | ELSEIF(IVAR.EQ.12) THEN | |
45134 | ROLD=VCKM(I1,I2) | |
45135 | ELSEIF(IVAR.EQ.13) THEN | |
45136 | IOLD=MDCY(I1,I2) | |
45137 | ELSEIF(IVAR.EQ.14) THEN | |
45138 | IOLD=MDME(I1,I2) | |
45139 | ELSEIF(IVAR.EQ.15) THEN | |
45140 | ROLD=BRAT(I1) | |
45141 | ELSEIF(IVAR.EQ.16) THEN | |
45142 | IOLD=KFDP(I1,I2) | |
45143 | ELSEIF(IVAR.EQ.17) THEN | |
45144 | CHOLD=CHAF(I1,I2) | |
45145 | ELSEIF(IVAR.EQ.18) THEN | |
45146 | IOLD=MRPY(I1) | |
45147 | ELSEIF(IVAR.EQ.19) THEN | |
45148 | ROLD=RRPY(I1) | |
45149 | ELSEIF(IVAR.EQ.20) THEN | |
45150 | IOLD=MSEL | |
45151 | ELSEIF(IVAR.EQ.21) THEN | |
45152 | IOLD=MSUB(I1) | |
45153 | ELSEIF(IVAR.EQ.22) THEN | |
45154 | IOLD=KFIN(I1,I2) | |
45155 | ELSEIF(IVAR.EQ.23) THEN | |
45156 | ROLD=CKIN(I1) | |
45157 | ELSEIF(IVAR.EQ.24) THEN | |
45158 | IOLD=MSTP(I1) | |
45159 | ELSEIF(IVAR.EQ.25) THEN | |
45160 | ROLD=PARP(I1) | |
45161 | ELSEIF(IVAR.EQ.26) THEN | |
45162 | IOLD=MSTI(I1) | |
45163 | ELSEIF(IVAR.EQ.27) THEN | |
45164 | ROLD=PARI(I1) | |
45165 | ELSEIF(IVAR.EQ.28) THEN | |
45166 | IOLD=MINT(I1) | |
45167 | ELSEIF(IVAR.EQ.29) THEN | |
45168 | ROLD=VINT(I1) | |
45169 | ELSEIF(IVAR.EQ.30) THEN | |
45170 | IOLD=ISET(I1) | |
45171 | ELSEIF(IVAR.EQ.31) THEN | |
45172 | IOLD=KFPR(I1,I2) | |
45173 | ELSEIF(IVAR.EQ.32) THEN | |
45174 | ROLD=COEF(I1,I2) | |
45175 | ELSEIF(IVAR.EQ.33) THEN | |
45176 | IOLD=ICOL(I1,I2,I3) | |
45177 | ELSEIF(IVAR.EQ.34) THEN | |
45178 | ROLD=XSFX(I1,I2) | |
45179 | ELSEIF(IVAR.EQ.35) THEN | |
45180 | IOLD=ISIG(I1,I2) | |
45181 | ELSEIF(IVAR.EQ.36) THEN | |
45182 | ROLD=SIGH(I1) | |
45183 | ELSEIF(IVAR.EQ.37) THEN | |
45184 | IOLD=MWID(I1) | |
45185 | ELSEIF(IVAR.EQ.38) THEN | |
45186 | ROLD=WIDS(I1,I2) | |
45187 | ELSEIF(IVAR.EQ.39) THEN | |
45188 | IOLD=NGEN(I1,I2) | |
45189 | ELSEIF(IVAR.EQ.40) THEN | |
45190 | ROLD=XSEC(I1,I2) | |
45191 | ELSEIF(IVAR.EQ.41) THEN | |
45192 | CHOLD2=PROC(I1) | |
45193 | ELSEIF(IVAR.EQ.42) THEN | |
45194 | ROLD=SIGT(I1,I2,I3) | |
45195 | ELSEIF(IVAR.EQ.43) THEN | |
45196 | ROLD=XPVMD(I1) | |
45197 | ELSEIF(IVAR.EQ.44) THEN | |
45198 | ROLD=XPANL(I1) | |
45199 | ELSEIF(IVAR.EQ.45) THEN | |
45200 | ROLD=XPANH(I1) | |
45201 | ELSEIF(IVAR.EQ.46) THEN | |
45202 | ROLD=XPBEH(I1) | |
45203 | ELSEIF(IVAR.EQ.47) THEN | |
45204 | ROLD=XPDIR(I1) | |
45205 | ELSEIF(IVAR.EQ.48) THEN | |
45206 | IOLD=IMSS(I1) | |
45207 | ELSEIF(IVAR.EQ.49) THEN | |
45208 | ROLD=RMSS(I1) | |
45209 | ELSEIF(IVAR.EQ.50) THEN | |
45210 | ROLD=RVLAM(I1,I2,I3) | |
45211 | ELSEIF(IVAR.EQ.51) THEN | |
45212 | ROLD=RVLAMP(I1,I2,I3) | |
45213 | ELSEIF(IVAR.EQ.52) THEN | |
45214 | ROLD=RVLAMB(I1,I2,I3) | |
45215 | ELSEIF(IVAR.EQ.53) THEN | |
45216 | IOLD=ITCM(I1) | |
45217 | ELSEIF(IVAR.EQ.54) THEN | |
45218 | ROLD=RTCM(I1) | |
45219 | ENDIF | |
45220 | ||
45221 | C...Print current value of variable. Loop back. | |
45222 | IF(LNAM.GE.LBIT) THEN | |
45223 | CHBIT(LNAM:14)=' ' | |
45224 | CHBIT(15:60)=' has the value ' | |
45225 | IF(MSVAR(IVAR,1).EQ.1) THEN | |
45226 | WRITE(CHBIT(51:60),'(I10)') IOLD | |
45227 | ELSEIF(MSVAR(IVAR,1).EQ.2) THEN | |
45228 | WRITE(CHBIT(47:60),'(F14.5)') ROLD | |
45229 | ELSEIF(MSVAR(IVAR,1).EQ.3) THEN | |
45230 | CHBIT(53:60)=CHOLD | |
45231 | ELSE | |
45232 | CHBIT(33:60)=CHOLD | |
45233 | ENDIF | |
45234 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) | |
45235 | LLOW=LHIG | |
45236 | IF(LLOW.LT.LTOT) GOTO 120 | |
45237 | RETURN | |
45238 | ENDIF | |
45239 | ||
45240 | C...Read in new variable value. | |
45241 | IF(MSVAR(IVAR,1).EQ.1) THEN | |
45242 | CHINI=' ' | |
45243 | CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT) | |
45244 | READ(CHINI,'(I10)') INEW | |
45245 | ELSEIF(MSVAR(IVAR,1).EQ.2) THEN | |
45246 | CHINR=' ' | |
45247 | CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT) | |
45248 | READ(CHINR,*) RNEW | |
45249 | ELSEIF(MSVAR(IVAR,1).EQ.3) THEN | |
45250 | CHNEW=CHBIT(LNAM+1:LBIT)//' ' | |
45251 | ELSE | |
45252 | CHNEW2=CHBIT(LNAM+1:LBIT)//' ' | |
45253 | ENDIF | |
45254 | ||
45255 | C...Store new variable value. | |
45256 | IF(IVAR.EQ.1) THEN | |
45257 | N=INEW | |
45258 | ELSEIF(IVAR.EQ.2) THEN | |
45259 | K(I1,I2)=INEW | |
45260 | ELSEIF(IVAR.EQ.3) THEN | |
45261 | P(I1,I2)=RNEW | |
45262 | ELSEIF(IVAR.EQ.4) THEN | |
45263 | V(I1,I2)=RNEW | |
45264 | ELSEIF(IVAR.EQ.5) THEN | |
45265 | MSTU(I1)=INEW | |
45266 | ELSEIF(IVAR.EQ.6) THEN | |
45267 | PARU(I1)=RNEW | |
45268 | ELSEIF(IVAR.EQ.7) THEN | |
45269 | MSTJ(I1)=INEW | |
45270 | ELSEIF(IVAR.EQ.8) THEN | |
45271 | PARJ(I1)=RNEW | |
45272 | ELSEIF(IVAR.EQ.9) THEN | |
45273 | KCHG(I1,I2)=INEW | |
45274 | ELSEIF(IVAR.EQ.10) THEN | |
45275 | PMAS(I1,I2)=RNEW | |
45276 | ELSEIF(IVAR.EQ.11) THEN | |
45277 | PARF(I1)=RNEW | |
45278 | ELSEIF(IVAR.EQ.12) THEN | |
45279 | VCKM(I1,I2)=RNEW | |
45280 | ELSEIF(IVAR.EQ.13) THEN | |
45281 | MDCY(I1,I2)=INEW | |
45282 | ELSEIF(IVAR.EQ.14) THEN | |
45283 | MDME(I1,I2)=INEW | |
45284 | ELSEIF(IVAR.EQ.15) THEN | |
45285 | BRAT(I1)=RNEW | |
45286 | ELSEIF(IVAR.EQ.16) THEN | |
45287 | KFDP(I1,I2)=INEW | |
45288 | ELSEIF(IVAR.EQ.17) THEN | |
45289 | CHAF(I1,I2)=CHNEW | |
45290 | ELSEIF(IVAR.EQ.18) THEN | |
45291 | MRPY(I1)=INEW | |
45292 | ELSEIF(IVAR.EQ.19) THEN | |
45293 | RRPY(I1)=RNEW | |
45294 | ELSEIF(IVAR.EQ.20) THEN | |
45295 | MSEL=INEW | |
45296 | ELSEIF(IVAR.EQ.21) THEN | |
45297 | MSUB(I1)=INEW | |
45298 | ELSEIF(IVAR.EQ.22) THEN | |
45299 | KFIN(I1,I2)=INEW | |
45300 | ELSEIF(IVAR.EQ.23) THEN | |
45301 | CKIN(I1)=RNEW | |
45302 | ELSEIF(IVAR.EQ.24) THEN | |
45303 | MSTP(I1)=INEW | |
45304 | ELSEIF(IVAR.EQ.25) THEN | |
45305 | PARP(I1)=RNEW | |
45306 | ELSEIF(IVAR.EQ.26) THEN | |
45307 | MSTI(I1)=INEW | |
45308 | ELSEIF(IVAR.EQ.27) THEN | |
45309 | PARI(I1)=RNEW | |
45310 | ELSEIF(IVAR.EQ.28) THEN | |
45311 | MINT(I1)=INEW | |
45312 | ELSEIF(IVAR.EQ.29) THEN | |
45313 | VINT(I1)=RNEW | |
45314 | ELSEIF(IVAR.EQ.30) THEN | |
45315 | ISET(I1)=INEW | |
45316 | ELSEIF(IVAR.EQ.31) THEN | |
45317 | KFPR(I1,I2)=INEW | |
45318 | ELSEIF(IVAR.EQ.32) THEN | |
45319 | COEF(I1,I2)=RNEW | |
45320 | ELSEIF(IVAR.EQ.33) THEN | |
45321 | ICOL(I1,I2,I3)=INEW | |
45322 | ELSEIF(IVAR.EQ.34) THEN | |
45323 | XSFX(I1,I2)=RNEW | |
45324 | ELSEIF(IVAR.EQ.35) THEN | |
45325 | ISIG(I1,I2)=INEW | |
45326 | ELSEIF(IVAR.EQ.36) THEN | |
45327 | SIGH(I1)=RNEW | |
45328 | ELSEIF(IVAR.EQ.37) THEN | |
45329 | MWID(I1)=INEW | |
45330 | ELSEIF(IVAR.EQ.38) THEN | |
45331 | WIDS(I1,I2)=RNEW | |
45332 | ELSEIF(IVAR.EQ.39) THEN | |
45333 | NGEN(I1,I2)=INEW | |
45334 | ELSEIF(IVAR.EQ.40) THEN | |
45335 | XSEC(I1,I2)=RNEW | |
45336 | ELSEIF(IVAR.EQ.41) THEN | |
45337 | PROC(I1)=CHNEW2 | |
45338 | ELSEIF(IVAR.EQ.42) THEN | |
45339 | SIGT(I1,I2,I3)=RNEW | |
45340 | ELSEIF(IVAR.EQ.43) THEN | |
45341 | XPVMD(I1)=RNEW | |
45342 | ELSEIF(IVAR.EQ.44) THEN | |
45343 | XPANL(I1)=RNEW | |
45344 | ELSEIF(IVAR.EQ.45) THEN | |
45345 | XPANH(I1)=RNEW | |
45346 | ELSEIF(IVAR.EQ.46) THEN | |
45347 | XPBEH(I1)=RNEW | |
45348 | ELSEIF(IVAR.EQ.47) THEN | |
45349 | XPDIR(I1)=RNEW | |
45350 | ELSEIF(IVAR.EQ.48) THEN | |
45351 | IMSS(I1)=INEW | |
45352 | ELSEIF(IVAR.EQ.49) THEN | |
45353 | RMSS(I1)=RNEW | |
45354 | ELSEIF(IVAR.EQ.50) THEN | |
45355 | RVLAM(I1,I2,I3)=RNEW | |
45356 | ELSEIF(IVAR.EQ.51) THEN | |
45357 | RVLAMP(I1,I2,I3)=RNEW | |
45358 | ELSEIF(IVAR.EQ.52) THEN | |
45359 | RVLAMB(I1,I2,I3)=RNEW | |
45360 | ELSEIF(IVAR.EQ.53) THEN | |
45361 | ITCM(I1)=INEW | |
45362 | ELSEIF(IVAR.EQ.54) THEN | |
45363 | RTCM(I1)=RNEW | |
45364 | ENDIF | |
45365 | ||
45366 | C...Write old and new value. Loop back. | |
45367 | CHBIT(LNAM:14)=' ' | |
45368 | CHBIT(15:60)=' changed from to ' | |
45369 | IF(MSVAR(IVAR,1).EQ.1) THEN | |
45370 | WRITE(CHBIT(33:42),'(I10)') IOLD | |
45371 | WRITE(CHBIT(51:60),'(I10)') INEW | |
45372 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) | |
45373 | ELSEIF(MSVAR(IVAR,1).EQ.2) THEN | |
45374 | WRITE(CHBIT(29:42),'(F14.5)') ROLD | |
45375 | WRITE(CHBIT(47:60),'(F14.5)') RNEW | |
45376 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) | |
45377 | ELSEIF(MSVAR(IVAR,1).EQ.3) THEN | |
45378 | CHBIT(35:42)=CHOLD | |
45379 | CHBIT(53:60)=CHNEW | |
45380 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) | |
45381 | ELSE | |
45382 | CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2 | |
45383 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5100) CHBIT(1:88) | |
45384 | ENDIF | |
45385 | LLOW=LHIG | |
45386 | IF(LLOW.LT.LTOT) GOTO 120 | |
45387 | ||
45388 | C...Format statement for output on unit MSTU(11) (by default 6). | |
45389 | 5000 FORMAT(5X,A60) | |
45390 | 5100 FORMAT(5X,A88) | |
45391 | ||
45392 | RETURN | |
45393 | END | |
45394 | ||
45395 | C********************************************************************* | |
45396 | ||
45397 | C...PYEXEC | |
45398 | C...Administrates the fragmentation and decay chain. | |
45399 | ||
45400 | SUBROUTINE PYEXEC | |
45401 | ||
45402 | C...Double precision and integer declarations. | |
45403 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
45404 | IMPLICIT INTEGER(I-N) | |
45405 | INTEGER PYK,PYCHGE,PYCOMP | |
45406 | C...Commonblocks. | |
45407 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
45408 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
45409 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
45410 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
45411 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
45412 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYINT4/ | |
45413 | C...Local array. | |
45414 | DIMENSION PS(2,6),IJOIN(100) | |
2dfa57d1 | 45415 | C...Initialize and reset. |
45416 | MSTU(24)=0 | |
45417 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
45418 | MSTU(29)=0 | |
45419 | MSTU(31)=MSTU(31)+1 | |
45420 | MSTU(1)=0 | |
45421 | MSTU(2)=0 | |
45422 | MSTU(3)=0 | |
45423 | IF(MSTU(17).LE.0) MSTU(90)=0 | |
45424 | MCONS=1 | |
45425 | ||
45426 | C...Sum up momentum, energy and charge for starting entries. | |
45427 | NSAV=N | |
45428 | DO 110 I=1,2 | |
45429 | DO 100 J=1,6 | |
45430 | PS(I,J)=0D0 | |
45431 | 100 CONTINUE | |
45432 | 110 CONTINUE | |
45433 | DO 130 I=1,N | |
45434 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 130 | |
45435 | DO 120 J=1,4 | |
45436 | PS(1,J)=PS(1,J)+P(I,J) | |
45437 | 120 CONTINUE | |
45438 | PS(1,6)=PS(1,6)+PYCHGE(K(I,2)) | |
45439 | 130 CONTINUE | |
45440 | PARU(21)=PS(1,4) | |
45441 | ||
45442 | C...Start by all decays of coloured resonances involved in shower. | |
45443 | NORIG=N | |
45444 | DO 140 I=1,NORIG | |
45445 | IF(K(I,1).EQ.3) THEN | |
45446 | KC=PYCOMP(K(I,2)) | |
45447 | IF(MWID(KC).NE.0.AND.KCHG(KC,2).NE.0) CALL PYRESD(I) | |
45448 | ENDIF | |
45449 | 140 CONTINUE | |
45450 | ||
45451 | C...Prepare system for subsequent fragmentation/decay. | |
45452 | CALL PYPREP(0) | |
45453 | ||
45454 | C...Loop through jet fragmentation and particle decays. | |
45455 | MBE=0 | |
45456 | 150 MBE=MBE+1 | |
45457 | IP=0 | |
45458 | 160 IP=IP+1 | |
45459 | KC=0 | |
45460 | IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=PYCOMP(K(IP,2)) | |
45461 | IF(KC.EQ.0) THEN | |
45462 | ||
45463 | C...Deal with any remaining undecayed resonance | |
45464 | C...(normally the task of PYEVNT, so seldom used). | |
45465 | ELSEIF(MWID(KC).NE.0) THEN | |
45466 | IBEG=IP | |
45467 | IF(KCHG(KC,2).NE.0.AND.K(I,1).NE.3) THEN | |
45468 | IBEG=IP+1 | |
45469 | 170 IBEG=IBEG-1 | |
45470 | IF(IBEG.GE.2.AND.K(IBEG,1).EQ.2) GOTO 170 | |
45471 | IF(K(IBEG,1).NE.2) IBEG=IBEG+1 | |
45472 | IEND=IP-1 | |
45473 | 180 IEND=IEND+1 | |
45474 | IF(IEND.LT.N.AND.K(IEND,1).EQ.2) GOTO 180 | |
45475 | IF(IEND.LT.N.AND.KCHG(PYCOMP(K(IEND,2)),2).EQ.0) GOTO 180 | |
45476 | NJOIN=0 | |
45477 | DO 190 I=IBEG,IEND | |
45478 | IF(KCHG(PYCOMP(K(IEND,2)),2).NE.0) THEN | |
45479 | NJOIN=NJOIN+1 | |
45480 | IJOIN(NJOIN)=I | |
45481 | ENDIF | |
45482 | 190 CONTINUE | |
45483 | ENDIF | |
45484 | CALL PYRESD(IP) | |
45485 | CALL PYPREP(IBEG) | |
45486 | ||
45487 | C...Particle decay if unstable and allowed. Save long-lived particle | |
45488 | C...decays until second pass after Bose-Einstein effects. | |
45489 | ELSEIF(KCHG(KC,2).EQ.0) THEN | |
45490 | IF(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1.AND.(MSTJ(51).LE.0.OR.MBE | |
45491 | & .EQ.2.OR.PMAS(KC,2).GE.PARJ(91).OR.IABS(K(IP,2)).EQ.311)) | |
45492 | & CALL PYDECY(IP) | |
45493 | ||
45494 | C...Decay products may develop a shower. | |
45495 | IF(MSTJ(92).GT.0) THEN | |
45496 | IP1=MSTJ(92) | |
45497 | QMAX=SQRT(MAX(0D0,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1, | |
45498 | & 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2)) | |
45499 | CALL PYSHOW(IP1,IP1+1,QMAX) | |
45500 | CALL PYPREP(IP1) | |
45501 | MSTJ(92)=0 | |
45502 | ELSEIF(MSTJ(92).LT.0) THEN | |
45503 | IP1=-MSTJ(92) | |
45504 | CALL PYSHOW(IP1,-3,P(IP,5)) | |
45505 | CALL PYPREP(IP1) | |
45506 | MSTJ(92)=0 | |
45507 | ENDIF | |
45508 | ||
45509 | C...Jet fragmentation: string or independent fragmentation. | |
45510 | ELSEIF(K(IP,1).EQ.1.OR.K(IP,1).EQ.2) THEN | |
45511 | MFRAG=MSTJ(1) | |
45512 | IF(MFRAG.GE.1.AND.K(IP,1).EQ.1) MFRAG=2 | |
45513 | IF(MSTJ(21).GE.2.AND.K(IP,1).EQ.2.AND.N.GT.IP) THEN | |
45514 | IF(K(IP+1,1).EQ.1.AND.K(IP+1,3).EQ.K(IP,3).AND. | |
45515 | & K(IP,3).GT.0.AND.K(IP,3).LT.IP) THEN | |
45516 | IF(KCHG(PYCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG) | |
45517 | ENDIF | |
45518 | ENDIF | |
45519 | IF(MFRAG.EQ.1) CALL PYSTRF(IP) | |
45520 | IF(MFRAG.EQ.2) CALL PYINDF(IP) | |
45521 | IF(MFRAG.EQ.2.AND.K(IP,1).EQ.1) MCONS=0 | |
45522 | IF(MFRAG.EQ.2.AND.(MSTJ(3).LE.0.OR.MOD(MSTJ(3),5).EQ.0)) MCONS=0 | |
45523 | ENDIF | |
45524 | ||
45525 | C...Loop back if enough space left in PYJETS and no error abort. | |
45526 | IF(MSTU(24).NE.0.AND.MSTU(21).GE.2) THEN | |
45527 | ELSEIF(IP.LT.N.AND.N.LT.MSTU(4)-20-MSTU(32)) THEN | |
45528 | GOTO 160 | |
45529 | ELSEIF(IP.LT.N) THEN | |
45530 | CALL PYERRM(11,'(PYEXEC:) no more memory left in PYJETS') | |
45531 | ENDIF | |
45532 | ||
45533 | C...Include simple Bose-Einstein effect parametrization if desired. | |
45534 | IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN | |
45535 | CALL PYBOEI(NSAV) | |
45536 | GOTO 150 | |
45537 | ENDIF | |
45538 | ||
45539 | C...Check that momentum, energy and charge were conserved. | |
45540 | DO 210 I=1,N | |
45541 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 210 | |
45542 | DO 200 J=1,4 | |
45543 | PS(2,J)=PS(2,J)+P(I,J) | |
45544 | 200 CONTINUE | |
45545 | PS(2,6)=PS(2,6)+PYCHGE(K(I,2)) | |
45546 | 210 CONTINUE | |
45547 | PDEV=(ABS(PS(2,1)-PS(1,1))+ABS(PS(2,2)-PS(1,2))+ABS(PS(2,3)- | |
45548 | &PS(1,3))+ABS(PS(2,4)-PS(1,4)))/(1D0+ABS(PS(2,4))+ABS(PS(1,4))) | |
45549 | IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL PYERRM(15, | |
45550 | &'(PYEXEC:) four-momentum was not conserved') | |
45551 | IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1D0) CALL PYERRM(15, | |
45552 | &'(PYEXEC:) charge was not conserved') | |
45553 | ||
45554 | RETURN | |
45555 | END | |
45556 | ||
45557 | C********************************************************************* | |
45558 | ||
45559 | C...PYPREP | |
45560 | C...Rearranges partons along strings. | |
45561 | C...Special considerations for systems with junctions, with | |
45562 | C...possibility of junction-antijunction annihilation. | |
45563 | C...Allows small systems to collapse into one or two particles. | |
45564 | C...Checks flavours and colour singlet invariant masses. | |
45565 | ||
45566 | SUBROUTINE PYPREP(IP) | |
45567 | ||
45568 | C...Double precision and integer declarations. | |
45569 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
45570 | INTEGER PYK,PYCHGE,PYCOMP | |
45571 | C...Commonblocks. | |
45572 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
45573 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
45574 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
45575 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
45576 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ | |
45577 | C...Local arrays. | |
45578 | DIMENSION DPS(5),DPC(5),UE(3),PG(5),E1(3),E2(3),E3(3),E4(3), | |
45579 | &ECL(3),IJUNC(10,0:4),IPIECE(30,0:4),KFEND(4),KFQ(4), | |
45580 | &IJUR(4),PJU(4,6),IRNG(4,2),TJJ(2,5),T(5),PUL(3,5), | |
45581 | &IJCP(0:6),TJUOLD(5) | |
45582 | ||
45583 | C...Function to give four-product. | |
45584 | 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) | |
45585 | ||
45586 | C...Rearrange parton shower product listing along strings: begin loop. | |
45587 | NOLD=N | |
45588 | I1=N | |
45589 | NJUNC=0 | |
45590 | NPIECE=0 | |
45591 | NJJSTR=0 | |
45592 | MSTU32=MSTU(32)+1 | |
45593 | DO 170 MQGST=1,3 | |
45594 | DO 160 I=MAX(1,IP),N | |
45595 | ||
45596 | C...Special treatment for junctions | |
45597 | IF(K(I,1).EQ.42) THEN | |
45598 | C...First, just store positions | |
45599 | IF (MQGST.EQ.1) THEN | |
45600 | NJUNC=NJUNC+1 | |
45601 | IJUNC(NJUNC,0)=I | |
45602 | IJUNC(NJUNC,4)=0 | |
45603 | C...Then look for junction-junction strings (not detected in the | |
45604 | C...main search below). | |
45605 | ELSE IF (MQGST.EQ.2.AND.NPIECE.NE.3*NJUNC) THEN | |
45606 | IF (NJJSTR.EQ.0) THEN | |
45607 | NJJSTR = (3*NJUNC-NPIECE)/2 | |
45608 | ENDIF | |
45609 | C...Check how many already identified strings end on this junction | |
45610 | ILC=0 | |
45611 | DO 100 J=1,NPIECE | |
45612 | IF (IPIECE(J,4).EQ.I) ILC=ILC+1 | |
45613 | 100 CONTINUE | |
45614 | C...If only 2, third one must be to another junction | |
45615 | IF (ILC.EQ.2) THEN | |
45616 | C...The colour information in the junction is unreadable for the | |
45617 | C...colour space search further down in this routine, so we must | |
45618 | C...start on the colour mother of this junction and then "artificially" | |
45619 | C...prevent the colour mother from connecting here again. | |
45620 | IA=MOD(K(I,4),MSTU(5)) | |
45621 | KCS=4 | |
45622 | IF (MOD(MOD(K(I,4)/MSTU(5),MSTU(5)),2).EQ.1) KCS=5 | |
45623 | K(IA,KCS) = K(IA,KCS) + MSTU(5)**2 | |
45624 | K(I,KCS) = K(I,KCS) + 2*MSTU(5)**2 | |
45625 | I1BEG = I1 | |
45626 | NSTP = 0 | |
45627 | GOTO 150 | |
45628 | ELSE IF (ILC.NE.3) THEN | |
45629 | C...This could happen if 2 legs of a junction connect to other | |
45630 | C...junctions. | |
45631 | CALL PYERRM(12, | |
45632 | & '(PYPREP:) Too many junction-junction strings.') | |
45633 | ENDIF | |
45634 | ENDIF | |
45635 | ENDIF | |
45636 | ||
45637 | C...Look for coloured string endpoint, or (later) leftover gluon. | |
45638 | IF(K(I,1).NE.3) GOTO 160 | |
45639 | KC=PYCOMP(K(I,2)) | |
45640 | IF(KC.EQ.0) GOTO 160 | |
45641 | KQ=KCHG(KC,2) | |
45642 | IF(KQ.EQ.0.OR.(MQGST.LE.2.AND.KQ.EQ.2)) GOTO 160 | |
45643 | ||
45644 | C...Pick up loose string end. | |
45645 | KCS=4 | |
45646 | IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5 | |
45647 | IA=I | |
45648 | IB=I | |
45649 | I1BEG=I1 | |
45650 | NSTP=0 | |
45651 | 110 NSTP=NSTP+1 | |
45652 | IF(NSTP.GT.4*N) THEN | |
45653 | CALL PYERRM(14,'(PYPREP:) caught in infinite loop') | |
45654 | RETURN | |
45655 | ENDIF | |
45656 | ||
45657 | C...Copy undecayed parton. Finished if reached string endpoint. | |
45658 | IF(K(IA,1).EQ.3) THEN | |
45659 | IF(I1.GE.MSTU(4)-MSTU32-5) THEN | |
45660 | CALL PYERRM(11,'(PYPREP:) no more memory left in PYJETS') | |
45661 | RETURN | |
45662 | ENDIF | |
45663 | I1=I1+1 | |
45664 | K(I1,1)=2 | |
45665 | IF(NSTP.GE.2.AND.KCHG(PYCOMP(K(IA,2)),2).NE.2) K(I1,1)=1 | |
45666 | K(I1,2)=K(IA,2) | |
45667 | K(I1,3)=IA | |
45668 | K(I1,4)=0 | |
45669 | K(I1,5)=0 | |
45670 | DO 120 J=1,5 | |
45671 | P(I1,J)=P(IA,J) | |
45672 | V(I1,J)=V(IA,J) | |
45673 | 120 CONTINUE | |
45674 | K(IA,1)=K(IA,1)+10 | |
45675 | IF(K(I1,1).EQ.1) GOTO 160 | |
45676 | ENDIF | |
45677 | ||
45678 | C...Also finished (for now) if reached junction; then copy to end. | |
45679 | IF(K(IA,1).EQ.42) THEN | |
45680 | NCOPY=I1-I1BEG | |
45681 | IF(I1.GE.MSTU(4)-MSTU32-NCOPY-5) THEN | |
45682 | CALL PYERRM(11,'(PYPREP:) no more memory left in PYJETS') | |
45683 | RETURN | |
45684 | ENDIF | |
45685 | IF (MQGST.LE.2.AND.NCOPY.NE.0) THEN | |
45686 | DO 140 ICOPY=1,NCOPY | |
45687 | DO 130 J=1,5 | |
45688 | K(MSTU(4)-MSTU32-ICOPY,J)=K(I1BEG+ICOPY,J) | |
45689 | P(MSTU(4)-MSTU32-ICOPY,J)=P(I1BEG+ICOPY,J) | |
45690 | V(MSTU(4)-MSTU32-ICOPY,J)=V(I1BEG+ICOPY,J) | |
45691 | 130 CONTINUE | |
45692 | 140 CONTINUE | |
45693 | ENDIF | |
45694 | NPIECE=NPIECE+1 | |
45695 | IPIECE(NPIECE,0)=I | |
45696 | IPIECE(NPIECE,1)=MSTU32+1 | |
45697 | IPIECE(NPIECE,2)=MSTU32+NCOPY | |
45698 | IPIECE(NPIECE,3)=IB | |
45699 | IPIECE(NPIECE,4)=IA | |
45700 | MSTU32=MSTU32+NCOPY | |
45701 | I1=I1BEG | |
45702 | GOTO 160 | |
45703 | ENDIF | |
45704 | ||
45705 | C...GOTO next parton in colour space. | |
45706 | 150 IB=IA | |
45707 | IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5)) | |
45708 | & .NE.0) THEN | |
45709 | IA=MOD(K(IB,KCS),MSTU(5)) | |
45710 | K(IB,KCS)=K(IB,KCS)+MSTU(5)**2 | |
45711 | MREV=0 | |
45712 | ELSE | |
45713 | IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5), | |
45714 | & MSTU(5)).EQ.0) KCS=9-KCS | |
45715 | IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5)) | |
45716 | K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2 | |
45717 | MREV=1 | |
45718 | ENDIF | |
45719 | IF(IA.LE.0.OR.IA.GT.N) THEN | |
45720 | CALL PYERRM(12,'(PYPREP:) colour rearrangement failed') | |
45721 | RETURN | |
45722 | ENDIF | |
45723 | IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5), | |
45724 | & MSTU(5)).EQ.IB) THEN | |
45725 | IF(MREV.EQ.1) KCS=9-KCS | |
45726 | IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS | |
45727 | K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2 | |
45728 | ELSE | |
45729 | IF(MREV.EQ.0) KCS=9-KCS | |
45730 | IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS | |
45731 | K(IA,KCS)=K(IA,KCS)+MSTU(5)**2 | |
45732 | ENDIF | |
45733 | IF(IA.NE.I) GOTO 110 | |
45734 | K(I1,1)=1 | |
45735 | 160 CONTINUE | |
45736 | 170 CONTINUE | |
45737 | ||
45738 | C...Junction systems remain. | |
45739 | IJU=0 | |
45740 | IJUS=0 | |
45741 | IJUCNT=0 | |
45742 | MREV=0 | |
45743 | IJJSTR=0 | |
45744 | 180 IJUCNT=IJUCNT+1 | |
45745 | IF (IJUCNT.LE.NJUNC) THEN | |
45746 | C...If we are not processing a j-j string, treat this junction as new. | |
45747 | IF (IJJSTR.EQ.0) THEN | |
45748 | IJU=IJUNC(IJUCNT,0) | |
45749 | MREV=0 | |
45750 | C...If junction has already been read, ignore it. | |
45751 | IF (IJUNC(IJUCNT,4).EQ.1) GOTO 180 | |
45752 | C...If we are on a j-j string, goto second j-j junction. | |
45753 | ELSE | |
45754 | IJUCNT=IJUCNT-1 | |
45755 | IJU=IJUS | |
45756 | ENDIF | |
45757 | C...Mark selected junction read. | |
45758 | DO 190 J=1,NJUNC | |
45759 | IF (IJUNC(J,0).EQ.IJU) IJUNC(J,4)=1 | |
45760 | 190 CONTINUE | |
45761 | ||
45762 | C...Determine junction type | |
45763 | ITJUNC = MOD(K(IJU,4)/MSTU(5),MSTU(5)) | |
45764 | C...Type 1 and 2 junctions: ~chi -> q q q, ~chi -> qbar,qbar,qbar | |
45765 | C...Type 3 and 4 junctions: ~qbar -> q q , ~q -> qbar qbar | |
45766 | C...Type 5 and 6 junctions: ~g -> q q q, ~g -> qbar qbar qbar | |
45767 | IF (ITJUNC.GE.1.AND.ITJUNC.LE.6) THEN | |
45768 | IHK=0 | |
45769 | 200 IHK=IHK+1 | |
45770 | C...Find which quarks belong to given junction. | |
45771 | IF(IHK.EQ.1) IEND=MOD(K(IJU,5),MSTU(5)) | |
45772 | IF(IHK.EQ.2) IEND=MOD(K(IJU,5)/MSTU(5),MSTU(5)) | |
45773 | C...IHK = 3 is special. Either normal string piece, or j-j string. | |
45774 | IF(IHK.EQ.3) THEN | |
45775 | IEND=MOD(K(IJU,4),MSTU(5)) | |
45776 | IF (MREV.NE.1) THEN | |
45777 | DO 210 IPC=1,NPIECE | |
45778 | C...If there is a j-j string starting on the present junction which has | |
45779 | C...zero length, insert next junction immediately. | |
45780 | IF (IPIECE(IPC,0).EQ.IJU.AND.K(IPIECE(IPC,4),1) | |
45781 | & .EQ.42.AND.IPIECE(IPC,1)-1-IPIECE(IPC,2).EQ.0) THEN | |
45782 | IJJSTR = 1 | |
45783 | GOTO 250 | |
45784 | ENDIF | |
45785 | 210 CONTINUE | |
45786 | MREV = 1 | |
45787 | C...If MREV is 1 and IHK is 3 we are finished with this system. | |
45788 | ELSE | |
45789 | MREV=0 | |
45790 | GOTO 180 | |
45791 | ENDIF | |
45792 | ENDIF | |
45793 | ||
45794 | C...If we've gotten this far, then either IHK < 3, or | |
45795 | C...an interjunction string exists, or just a third normal string. | |
45796 | IJUNC(IJUCNT,IHK)=0 | |
45797 | IJJSTR = 0 | |
45798 | C..Order pieces belonging to this junction. Also look for j-j. | |
45799 | DO 220 IPC=1,NPIECE | |
45800 | IF (IPIECE(IPC,3).EQ.IEND) IJUNC(IJUCNT,IHK)=IPC | |
45801 | IF (IHK.EQ.3.AND.IPIECE(IPC,0).EQ.IJUNC(IJUCNT,0) | |
45802 | & .AND.K(IPIECE(IPC,4),1).EQ.42) THEN | |
45803 | IJUNC(IJUCNT,IHK)=IPC | |
45804 | IJJSTR = 1 | |
45805 | MREV = 0 | |
45806 | ENDIF | |
45807 | 220 CONTINUE | |
45808 | C...Copy back chains in proper order. MREV=0/1 : descending/ascending | |
45809 | IPC=IJUNC(IJUCNT,IHK) | |
45810 | DO 240 ICP=IPIECE(IPC,1+MREV),IPIECE(IPC,2-MREV),1-2*MREV | |
45811 | I1=I1+1 | |
45812 | DO 230 J=1,5 | |
45813 | K(I1,J)=K(MSTU(4)-ICP,J) | |
45814 | P(I1,J)=P(MSTU(4)-ICP,J) | |
45815 | V(I1,J)=V(MSTU(4)-ICP,J) | |
45816 | 230 CONTINUE | |
45817 | 240 CONTINUE | |
45818 | K(I1,1)=2 | |
45819 | C...Mark last quark. | |
45820 | IF (MREV.EQ.1.AND.IHK.GE.2) K(I1,1)=1 | |
45821 | C...Do not insert junctions at wrong places. | |
45822 | IF(IHK.LT.2.OR.MREV.NE.0) GOTO 270 | |
45823 | C...Insert junction. | |
45824 | 250 IJUS = IJU | |
45825 | IF (IHK.EQ.3) THEN | |
45826 | C...Shift to end junction if a j-j string has been processed. | |
45827 | IF (IJJSTR.NE.0) IJUS = IPIECE(IPC,4) | |
45828 | MREV= 1 | |
45829 | ENDIF | |
45830 | I1=I1+1 | |
45831 | DO 260 J=1,5 | |
45832 | K(I1,J)=0 | |
45833 | P(I1,J)=0. | |
45834 | V(I1,J)=0. | |
45835 | 260 CONTINUE | |
45836 | K(I1,1)=41 | |
45837 | K(IJUS,1)=K(IJUS,1)+10 | |
45838 | K(I1,2)=K(IJUS,2) | |
45839 | K(I1,3)=K(IJUS,3) | |
45840 | 270 IF (IHK.LT.3) GOTO 200 | |
45841 | ELSE | |
45842 | CALL PYERRM(12,'(PYPREP:) Unknown junction type') | |
45843 | ENDIF | |
45844 | IF (IJUCNT.NE.NJUNC) GOTO 180 | |
45845 | ENDIF | |
45846 | N=I1 | |
45847 | ||
45848 | C...Rearrange three strings from junction, e.g. in case one has been | |
45849 | C...shortened by shower, so the last is the largest-energy one. | |
45850 | IF(NJUNC.GE.1) THEN | |
45851 | C...Find systems with exactly one junction. | |
45852 | MJUN1=0 | |
45853 | NBEG=NOLD+1 | |
45854 | DO 380 I=NOLD+1,N | |
45855 | IF(K(I,1).NE.1.AND.K(I,1).NE.41) THEN | |
45856 | ELSEIF(K(I,1).EQ.41) THEN | |
45857 | MJUN1=MJUN1+1 | |
45858 | ELSEIF(K(I,1).EQ.1.AND.MJUN1.NE.1) THEN | |
45859 | MJUN1=0 | |
45860 | NBEG=I+1 | |
45861 | ELSE | |
45862 | NEND=I | |
45863 | C...Sum up energy-momentum in each junction string. | |
45864 | DO 280 J=1,5 | |
45865 | PJU(1,J)=0D0 | |
45866 | PJU(2,J)=0D0 | |
45867 | PJU(3,J)=0D0 | |
45868 | 280 CONTINUE | |
45869 | NJU=0 | |
45870 | DO 300 I1=NBEG,NEND | |
45871 | IF(K(I1,2).NE.21) THEN | |
45872 | NJU=NJU+1 | |
45873 | IJUR(NJU)=I1 | |
45874 | ENDIF | |
45875 | DO 290 J=1,5 | |
45876 | PJU(MIN(NJU,3),J)=PJU(MIN(NJU,3),J)+P(I1,J) | |
45877 | 290 CONTINUE | |
45878 | 300 CONTINUE | |
45879 | C...Find which of them has highest energy (minus mass) in rest frame. | |
45880 | DO 310 J=1,5 | |
45881 | PJU(4,J)=PJU(1,J)+PJU(2,J)+PJU(3,J) | |
45882 | 310 CONTINUE | |
45883 | PMJU=SQRT(MAX(0D0,PJU(4,4)**2-PJU(4,1)**2-PJU(4,2)**2- | |
45884 | & PJU(4,3)**2)) | |
45885 | DO 320 I2=1,3 | |
45886 | PJU(I2,6)=(PJU(4,4)*PJU(I2,4)-PJU(4,1)*PJU(I2,1)- | |
45887 | & PJU(4,2)*PJU(I2,2)-PJU(4,3)*PJU(I2,3))/PMJU-PJU(I2,5) | |
45888 | 320 CONTINUE | |
45889 | IF(PJU(3,6).LT.MIN(PJU(1,6),PJU(2,6))) THEN | |
45890 | C...Decide how to rearrange so that new last has highest energy. | |
45891 | IF(PJU(1,6).LT.PJU(2,6)) THEN | |
45892 | IRNG(1,1)=IJUR(1) | |
45893 | IRNG(1,2)=IJUR(2)-1 | |
45894 | IRNG(2,1)=IJUR(4) | |
45895 | IRNG(2,2)=IJUR(3)+1 | |
45896 | IRNG(4,1)=IJUR(3)-1 | |
45897 | IRNG(4,2)=IJUR(2) | |
45898 | ELSE | |
45899 | IRNG(1,1)=IJUR(4) | |
45900 | IRNG(1,2)=IJUR(3)+1 | |
45901 | IRNG(2,1)=IJUR(2) | |
45902 | IRNG(2,2)=IJUR(3)-1 | |
45903 | IRNG(4,1)=IJUR(2)-1 | |
45904 | IRNG(4,2)=IJUR(1) | |
45905 | ENDIF | |
45906 | IRNG(3,1)=IJUR(3) | |
45907 | IRNG(3,2)=IJUR(3) | |
45908 | C...Copy in correct order below bottom of current event record. | |
45909 | I2=N | |
45910 | DO 350 II=1,4 | |
45911 | DO 340 I1=IRNG(II,1),IRNG(II,2), | |
45912 | & ISIGN(1,IRNG(II,2)-IRNG(II,1)) | |
45913 | I2=I2+1 | |
45914 | DO 330 J=1,5 | |
45915 | K(I2,J)=K(I1,J) | |
45916 | P(I2,J)=P(I1,J) | |
45917 | V(I2,J)=V(I1,J) | |
45918 | 330 CONTINUE | |
45919 | IF(K(I2,1).EQ.1) K(I2,1)=2 | |
45920 | 340 CONTINUE | |
45921 | 350 CONTINUE | |
45922 | K(I2,1)=1 | |
45923 | C...Copy back up, overwriting but now in correct order. | |
45924 | DO 370 I1=NBEG,NEND | |
45925 | I2=I1-NBEG+N+1 | |
45926 | DO 360 J=1,5 | |
45927 | K(I1,J)=K(I2,J) | |
45928 | P(I1,J)=P(I2,J) | |
45929 | V(I1,J)=V(I2,J) | |
45930 | 360 CONTINUE | |
45931 | 370 CONTINUE | |
45932 | ENDIF | |
45933 | MJUN1=0 | |
45934 | NBEG=I+1 | |
45935 | ENDIF | |
45936 | 380 CONTINUE | |
45937 | C++SKANDS | |
45938 | C...Check whether q-q-j-j-qbar-qbar systems should be collapsed | |
45939 | C...to two q-qbar systems. | |
45940 | C...(MSTJ(19)=1 forces q-q-j-j-qbar-qbar.) | |
45941 | IF (MSTJ(19).NE.1) THEN | |
45942 | MJUN1 = 0 | |
45943 | JJGLUE = 0 | |
45944 | NBEG = NOLD+1 | |
45945 | C...Force collapse when MSTJ(19)=2. | |
45946 | IF (MSTJ(19).EQ.2) THEN | |
45947 | DELMJJ = 1D9 | |
45948 | DELMQQ = 0D0 | |
45949 | ENDIF | |
45950 | C...Find systems with exactly two junctions. | |
45951 | DO 610 I=NOLD+1,N | |
45952 | C...Count junctions | |
45953 | IF (K(I,1).EQ.41) THEN | |
45954 | MJUN1 = MJUN1+1 | |
45955 | C...Check for interjunction gluons | |
45956 | IF (MJUN1.EQ.2.AND.K(I-1,1).NE.41) THEN | |
45957 | JJGLUE = 1 | |
45958 | ENDIF | |
45959 | ELSEIF(K(I,1).EQ.1.AND.(MJUN1.NE.2)) THEN | |
45960 | C...If end of system reached with either zero or one junction, restart | |
45961 | C...with next system. | |
45962 | MJUN1 = 0 | |
45963 | JJGLUE = 0 | |
45964 | NBEG = I+1 | |
45965 | ELSEIF(K(I,1).EQ.1) THEN | |
45966 | C...If end of system reached with exactly two junctions, compute string | |
45967 | C...length measure for the (q-q-j-j-qbar-qbar) topology and compare with | |
45968 | C...length measure for the (q-qbar)(q-qbar) topology. | |
45969 | NEND=I | |
45970 | C...Loop down through chain. | |
45971 | ISID=0 | |
45972 | DO 390 I1=NBEG,NEND | |
45973 | C...Store string piece division locations in event record | |
45974 | IF (K(I1,2).NE.21) THEN | |
45975 | ISID = ISID+1 | |
45976 | IJCP(ISID) = I1 | |
45977 | ENDIF | |
45978 | 390 CONTINUE | |
45979 | C...Randomly choose between (1,3)(2,4) and (1,4)(2,3) topologies. | |
45980 | ISW=0 | |
45981 | IF (PYR(0).LT.0.5D0) ISW=1 | |
45982 | C...Randomly choose which qqbar string gets the jj gluons. | |
45983 | IGS=1 | |
45984 | IF (PYR(0).GT.0.5D0) IGS=2 | |
45985 | C...Only compute string lengths when no topology forced. | |
45986 | IF (MSTJ(19).EQ.0) THEN | |
45987 | C...Repeat following for each junction | |
45988 | DO 480 IJU=1,2 | |
45989 | C...Initialize iterative procedure for finding JRF | |
45990 | IJRFIT=0 | |
45991 | DO 400 IX=1,3 | |
45992 | TJUOLD(IX)=0D0 | |
45993 | 400 CONTINUE | |
45994 | TJUOLD(4)=1D0 | |
45995 | C...Start iteration. Sum up momenta in string pieces | |
45996 | 410 DO 450 IJS=1,3 | |
45997 | C...JD=-1 for first junction, +1 for second junction. | |
45998 | C...Find out where piece starts and ends and which direction to go. | |
45999 | JD=2*IJU-3 | |
46000 | IF (IJS.LE.2) THEN | |
46001 | IA = IJCP((IJU-1)*7 - JD*(IJS+1)) + JD | |
46002 | IB = IJCP((IJU-1)*7 - JD*IJS) | |
46003 | ELSEIF (IJS.EQ.3) THEN | |
46004 | JD =-JD | |
46005 | IA = IJCP((IJU-1)*7 + JD*(IJS)) + JD | |
46006 | IB = IJCP((IJU-1)*7 + JD*(IJS+3)) | |
46007 | ENDIF | |
46008 | C...Initialize junction pull 4-vector. | |
46009 | DO 420 J=1,5 | |
46010 | PUL(IJS,J)=0D0 | |
46011 | 420 CONTINUE | |
46012 | C...Initialize weight | |
46013 | PWT = 0D0 | |
46014 | PWTOLD = 0D0 | |
46015 | C...Sum up (weighted) momenta along each string piece | |
46016 | DO 440 ISP=IA,IB,JD | |
46017 | C...If present parton not last in chain | |
46018 | IF (ISP.NE.IA.AND.ISP.NE.IB) THEN | |
46019 | C...If last parton was a junction, store present weight | |
46020 | IF (K(ISP-JD,2).EQ.88) THEN | |
46021 | PWTOLD = PWT | |
46022 | C...If last parton was a quark, reset to stored weight. | |
46023 | ELSEIF (K(ISP-JD,2).NE.21) THEN | |
46024 | PWT = PWTOLD | |
46025 | ENDIF | |
46026 | ENDIF | |
46027 | C...Skip next parton if weight already large | |
46028 | IF (PWT.GT.10D0) GOTO 440 | |
46029 | C...Compute momentum in TJUOLD frame: | |
46030 | TDP=TJUOLD(1)*P(ISP,1)+TJUOLD(2)*P(ISP,2)+TJUOLD(3 | |
46031 | & )*P(ISP,3) | |
46032 | BFC=TDP/(1D0+TJUOLD(4))+P(ISP,4) | |
46033 | DO 430 J=1,3 | |
46034 | TMP=P(ISP,J)+TJUOLD(J)*BFC | |
46035 | PUL(IJS,J)=PUL(IJS,J)+TMP*EXP(-PWT) | |
46036 | 430 CONTINUE | |
46037 | C...Boosted energy | |
46038 | TMP=TJUOLD(4)*P(ISP,4)+TDP | |
46039 | PUL(IJS,4)=PUL(IJS,J)+TMP*EXP(-PWT) | |
46040 | C...Update weight | |
46041 | PWT=PWT+TMP/PARJ(48) | |
46042 | C...Put |p| rather than m in 5th slot | |
46043 | PUL(IJS,5)=SQRT(PUL(IJS,1)**2+PUL(IJS,2)**2 | |
46044 | & +PUL(IJS,3)**2) | |
46045 | 440 CONTINUE | |
46046 | 450 CONTINUE | |
46047 | C...Compute boost | |
46048 | IJRFIT=IJRFIT+1 | |
46049 | CALL PYJURF(PUL,T) | |
46050 | C...Combine new boost (T) with old boost (TJUOLD) | |
46051 | TMP=T(1)*TJUOLD(1)+T(2)*TJUOLD(2)+T(3)*TJUOLD(3) | |
46052 | DO 460 IX=1,3 | |
46053 | TJUOLD(IX)=T(IX)+TJUOLD(IX)*(TMP/(1D0+TJUOLD(4))+T(4 | |
46054 | & )) | |
46055 | 460 CONTINUE | |
46056 | TJUOLD(4)=SQRT(1D0+TJUOLD(1)**2+TJUOLD(2)**2+TJUOLD(3) | |
46057 | & **2) | |
46058 | C...If last boost small, accept JRF, else iterate. | |
46059 | C...Also prevent possibility of infinite loop. | |
46060 | IF (ABS((T(4)-1D0)/TJUOLD(4)).GT.0.01D0.AND. | |
46061 | & IJRFIT.LT.MSTJ(18))THEN | |
46062 | GOTO 410 | |
46063 | ELSEIF (IJRFIT.GE.MSTJ(18)) THEN | |
46064 | CALL PYERRM(1,'(PYPREP:) failed to converge on JRF') | |
46065 | ENDIF | |
46066 | C...Store final boost, with change of sign since TJJ motion vector. | |
46067 | DO 470 IX=1,3 | |
46068 | TJJ(IJU,IX)=-TJUOLD(IX) | |
46069 | 470 CONTINUE | |
46070 | TJJ(IJU,4)=SQRT(1D0+TJJ(IJU,1)**2+TJJ(IJU,2)**2 | |
46071 | & +TJJ(IJU,3)**2) | |
46072 | 480 CONTINUE | |
46073 | C...String length measure for (q-qbar)(q-qbar) topology. | |
46074 | C...Note only momenta of nearest partons used (since rest of system | |
46075 | C...identical). | |
46076 | IF (JJGLUE.EQ.0) THEN | |
46077 | DELMQQ=4D0*FOUR(IJCP(2)-1,IJCP(4+ISW)+1)*FOUR(IJCP(3) | |
46078 | & -1,IJCP(5-ISW)+1) | |
46079 | ELSE | |
46080 | C...Put jj gluons on selected string (IGS selected randomly above). | |
46081 | IF (IGS.EQ.1) THEN | |
46082 | DELMQQ=8D0*FOUR(IJCP(2)-1,IJCP(4)-1)*FOUR(IJCP(3)+1 | |
46083 | & ,IJCP(4+ISW)+1)*FOUR(IJCP(3)-1,IJCP(5-ISW)+1) | |
46084 | ELSE | |
46085 | DELMQQ=8D0*FOUR(IJCP(2)-1,IJCP(4+ISW)+1) | |
46086 | & *FOUR(IJCP(3)-1,IJCP(4)-1)*FOUR(IJCP(3)+1 | |
46087 | & ,IJCP(5-ISW)+1) | |
46088 | ENDIF | |
46089 | ENDIF | |
46090 | C...String length measure for q-q-j-j-q-q topology. | |
46091 | T1G1=0D0 | |
46092 | T2G2=0D0 | |
46093 | T1T2=0D0 | |
46094 | T1P1=0D0 | |
46095 | T1P2=0D0 | |
46096 | T2P3=0D0 | |
46097 | T2P4=0D0 | |
46098 | ISGN=-1 | |
46099 | C...Note only momenta of nearest partons used (since rest of system | |
46100 | C...identical). | |
46101 | DO 490 IX=1,4 | |
46102 | IF (IX.EQ.4) ISGN=1 | |
46103 | T1P1=T1P1+ISGN*TJJ(1,IX)*P(IJCP(2)-1,IX) | |
46104 | T1P2=T1P2+ISGN*TJJ(1,IX)*P(IJCP(3)-1,IX) | |
46105 | T2P3=T2P3+ISGN*TJJ(2,IX)*P(IJCP(4)+1,IX) | |
46106 | T2P4=T2P4+ISGN*TJJ(2,IX)*P(IJCP(5)+1,IX) | |
46107 | IF (JJGLUE.EQ.0) THEN | |
46108 | C...Junction motion vector dot product gives length when inter-junction | |
46109 | C...gluons absent. | |
46110 | T1T2=T1T2+ISGN*TJJ(1,IX)*TJJ(2,IX) | |
46111 | ELSE | |
46112 | C...Junction motion vector dot products with gluon momenta give length | |
46113 | C...when inter-junction gluons present. | |
46114 | T1G1=T1G1+ISGN*TJJ(1,IX)*P(IJCP(3)+1,IX) | |
46115 | T2G2=T2G2+ISGN*TJJ(2,IX)*P(IJCP(4)-1,IX) | |
46116 | ENDIF | |
46117 | 490 CONTINUE | |
46118 | DELMJJ=16D0*T1P1*T1P2*T2P3*T2P4 | |
46119 | IF (JJGLUE.EQ.0) THEN | |
46120 | DELMJJ=DELMJJ*(T1T2+SQRT(T1T2**2-1)) | |
46121 | ELSE | |
46122 | DELMJJ=DELMJJ*4D0*T1G1*T2G2 | |
46123 | ENDIF | |
46124 | ENDIF | |
46125 | C...If delmjj > delmqq collapse string system to q-qbar q-qbar | |
46126 | C...(Always the case for MSTJ(19)=2 due to initialization above) | |
46127 | IF (DELMJJ.GT.DELMQQ) THEN | |
46128 | C...Put new system at end of event record | |
46129 | NCOP=N | |
46130 | DO 560 IST=1,2 | |
46131 | DO 510 ICOP=IJCP(IST),IJCP(IST+1)-1 | |
46132 | NCOP=NCOP+1 | |
46133 | DO 500 IX=1,5 | |
46134 | P(NCOP,IX)=P(ICOP,IX) | |
46135 | K(NCOP,IX)=K(ICOP,IX) | |
46136 | 500 CONTINUE | |
46137 | 510 CONTINUE | |
46138 | IF (JJGLUE.NE.0.AND.IST.EQ.IGS) THEN | |
46139 | C...Insert inter-junction gluon string piece (reversed) | |
46140 | NJJGL=0 | |
46141 | DO 530 ICOP=IJCP(4)-1,IJCP(3)+1,-1 | |
46142 | NJJGL=NJJGL+1 | |
46143 | NCOP=NCOP+1 | |
46144 | DO 520 IX=1,5 | |
46145 | P(NCOP,IX)=P(ICOP,IX) | |
46146 | K(NCOP,IX)=K(ICOP,IX) | |
46147 | 520 CONTINUE | |
46148 | 530 CONTINUE | |
46149 | ENDIF | |
46150 | IFC=-2*IST+3 | |
46151 | DO 550 ICOP=IJCP(IST+IFC*ISW+3)+1,IJCP(IST+IFC*ISW+4) | |
46152 | NCOP=NCOP+1 | |
46153 | DO 540 IX=1,5 | |
46154 | P(NCOP,IX)=P(ICOP,IX) | |
46155 | K(NCOP,IX)=K(ICOP,IX) | |
46156 | 540 CONTINUE | |
46157 | 550 CONTINUE | |
46158 | K(NCOP,1)=1 | |
46159 | 560 CONTINUE | |
46160 | C...Copy system back in right order | |
46161 | DO 580 ICOP=NBEG,NEND-2 | |
46162 | DO 570 IX=1,5 | |
46163 | P(ICOP,IX)=P(N+ICOP-NBEG+1,IX) | |
46164 | K(ICOP,IX)=K(N+ICOP-NBEG+1,IX) | |
46165 | 570 CONTINUE | |
46166 | 580 CONTINUE | |
46167 | C...Shift down rest of event record | |
46168 | DO 600 ICOP=NEND+1,N | |
46169 | DO 590 IX=1,5 | |
46170 | P(ICOP-2,IX)=P(ICOP,IX) | |
46171 | K(ICOP-2,IX)=K(ICOP,IX) | |
46172 | 590 CONTINUE | |
46173 | 600 CONTINUE | |
46174 | C...Update length of event record. | |
46175 | N=N-2 | |
46176 | ENDIF | |
46177 | MJUN1=0 | |
46178 | NBEG=I+1 | |
46179 | ENDIF | |
46180 | 610 CONTINUE | |
46181 | ENDIF | |
46182 | ENDIF | |
46183 | ||
46184 | C...Done if no checks on small-mass systems. | |
46185 | IF(MSTJ(14).LT.0) RETURN | |
46186 | IF(MSTJ(14).EQ.0) GOTO 1050 | |
46187 | ||
46188 | C...Find lowest-mass colour singlet jet system. | |
46189 | NS=N | |
46190 | 620 NSIN=N-NS | |
46191 | PDMIN=1D0+PARJ(32) | |
46192 | IC=0 | |
46193 | DO 680 I=MAX(1,IP),N | |
46194 | IF(K(I,1).NE.1.AND.K(I,1).NE.2) THEN | |
46195 | ELSEIF(K(I,1).EQ.2.AND.IC.EQ.0) THEN | |
46196 | NSIN=NSIN+1 | |
46197 | IC=I | |
46198 | DO 630 J=1,4 | |
46199 | DPS(J)=P(I,J) | |
46200 | 630 CONTINUE | |
46201 | MSTJ(93)=1 | |
46202 | DPS(5)=PYMASS(K(I,2)) | |
46203 | ELSEIF(K(I,1).EQ.2.AND.K(I,2).NE.21) THEN | |
46204 | DO 640 J=1,4 | |
46205 | DPS(J)=DPS(J)+P(I,J) | |
46206 | 640 CONTINUE | |
46207 | MSTJ(93)=1 | |
46208 | DPS(5)=DPS(5)+PYMASS(K(I,2)) | |
46209 | ELSEIF(K(I,1).EQ.2) THEN | |
46210 | DO 650 J=1,4 | |
46211 | DPS(J)=DPS(J)+P(I,J) | |
46212 | 650 CONTINUE | |
46213 | ELSEIF(IC.NE.0.AND.KCHG(PYCOMP(K(I,2)),2).NE.0) THEN | |
46214 | DO 660 J=1,4 | |
46215 | DPS(J)=DPS(J)+P(I,J) | |
46216 | 660 CONTINUE | |
46217 | MSTJ(93)=1 | |
46218 | DPS(5)=DPS(5)+PYMASS(K(I,2)) | |
46219 | PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))- | |
46220 | & DPS(5) | |
46221 | IF(PD.LT.PDMIN) THEN | |
46222 | PDMIN=PD | |
46223 | DO 670 J=1,5 | |
46224 | DPC(J)=DPS(J) | |
46225 | 670 CONTINUE | |
46226 | IC1=IC | |
46227 | IC2=I | |
46228 | ENDIF | |
46229 | IC=0 | |
46230 | ELSE | |
46231 | NSIN=NSIN+1 | |
46232 | ENDIF | |
46233 | 680 CONTINUE | |
46234 | ||
46235 | C...Done if lowest-mass system above threshold for string frag. | |
46236 | IF(PDMIN.GE.PARJ(32)) GOTO 1050 | |
46237 | ||
46238 | C...Fill small-mass system as cluster. | |
46239 | NSAV=N | |
46240 | PECM=SQRT(MAX(0D0,DPC(4)**2-DPC(1)**2-DPC(2)**2-DPC(3)**2)) | |
46241 | K(N+1,1)=11 | |
46242 | K(N+1,2)=91 | |
46243 | K(N+1,3)=IC1 | |
46244 | P(N+1,1)=DPC(1) | |
46245 | P(N+1,2)=DPC(2) | |
46246 | P(N+1,3)=DPC(3) | |
46247 | P(N+1,4)=DPC(4) | |
46248 | P(N+1,5)=PECM | |
46249 | ||
46250 | C...Set up history, assuming cluster -> 2 hadrons. | |
46251 | NBODY=2 | |
46252 | K(N+1,4)=N+2 | |
46253 | K(N+1,5)=N+3 | |
46254 | K(N+2,1)=1 | |
46255 | K(N+3,1)=1 | |
46256 | IF(MSTU(16).NE.2) THEN | |
46257 | K(N+2,3)=N+1 | |
46258 | K(N+3,3)=N+1 | |
46259 | ELSE | |
46260 | K(N+2,3)=IC1 | |
46261 | K(N+3,3)=IC2 | |
46262 | ENDIF | |
46263 | K(N+2,4)=0 | |
46264 | K(N+3,4)=0 | |
46265 | K(N+2,5)=0 | |
46266 | K(N+3,5)=0 | |
46267 | V(N+1,5)=0D0 | |
46268 | V(N+2,5)=0D0 | |
46269 | V(N+3,5)=0D0 | |
46270 | ||
46271 | C...Find total flavour content - complicated by presence of junctions. | |
46272 | NQ=0 | |
46273 | NDIQ=0 | |
46274 | DO 690 I=IC1,IC2 | |
46275 | IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.K(I,2).NE.21) THEN | |
46276 | NQ=NQ+1 | |
46277 | KFQ(NQ)=K(I,2) | |
46278 | IF(IABS(K(I,2)).GT.1000) NDIQ=NDIQ+1 | |
46279 | ENDIF | |
46280 | 690 CONTINUE | |
46281 | ||
46282 | C...If several diquarks, split up one to give even number of flavours. | |
46283 | IF(NQ.EQ.3.AND.NDIQ.GE.2) THEN | |
46284 | I1=3 | |
46285 | IF(IABS(KFQ(3)).LT.1000) I1=1 | |
46286 | KFQ(4)=ISIGN(MOD(IABS(KFQ(I1))/100,10),KFQ(I1)) | |
46287 | KFQ(I1)=KFQ(I1)/1000 | |
46288 | NQ=4 | |
46289 | NDIQ=NDIQ-1 | |
46290 | ENDIF | |
46291 | ||
46292 | C...If four quark ends, join two to diquark. | |
46293 | IF(NQ.EQ.4.AND.NDIQ.EQ.0) THEN | |
46294 | I1=1 | |
46295 | I2=2 | |
46296 | IF(KFQ(I1)*KFQ(I2).LT.0) I2=3 | |
46297 | IF(I2.EQ.3.AND.KFQ(I1)*KFQ(I2).LT.0) I2=4 | |
46298 | KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1 | |
46299 | IF(KFQ(I1).EQ.KFQ(I2)) KFLS=3 | |
46300 | KFQ(I1)=ISIGN(1000*MAX(IABS(KFQ(I1)),IABS(KFQ(I2)))+ | |
46301 | & 100*MIN(IABS(KFQ(I1)),IABS(KFQ(I2)))+KFLS,KFQ(I1)) | |
46302 | KFQ(I2)=KFQ(4) | |
46303 | NQ=3 | |
46304 | NDIQ=1 | |
46305 | ENDIF | |
46306 | ||
46307 | C...If two quark ends, plus quark or diquark, join quarks to diquark. | |
46308 | IF(NQ.EQ.3) THEN | |
46309 | I1=1 | |
46310 | I2=2 | |
46311 | IF(IABS(KFQ(I1)).GT.1000) I1=3 | |
46312 | IF(IABS(KFQ(I2)).GT.1000) I2=3 | |
46313 | KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1 | |
46314 | IF(KFQ(I1).EQ.KFQ(I2)) KFLS=3 | |
46315 | KFQ(I1)=ISIGN(1000*MAX(IABS(KFQ(I1)),IABS(KFQ(I2)))+ | |
46316 | & 100*MIN(IABS(KFQ(I1)),IABS(KFQ(I2)))+KFLS,KFQ(I1)) | |
46317 | KFQ(I2)=KFQ(3) | |
46318 | NQ=2 | |
46319 | NDIQ=NDIQ+1 | |
46320 | ENDIF | |
46321 | ||
46322 | C...Form two particles from flavours of lowest-mass system, if feasible. | |
46323 | NTRY = 0 | |
46324 | 700 NTRY = NTRY + 1 | |
46325 | ||
46326 | C...Open string with two specified endpoint flavours. | |
46327 | IF(NQ.EQ.2) THEN | |
46328 | KC1=PYCOMP(KFQ(1)) | |
46329 | KC2=PYCOMP(KFQ(2)) | |
46330 | IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 1050 | |
46331 | KQ1=KCHG(KC1,2)*ISIGN(1,KFQ(1)) | |
46332 | KQ2=KCHG(KC2,2)*ISIGN(1,KFQ(2)) | |
46333 | IF(KQ1+KQ2.NE.0) GOTO 1050 | |
46334 | C...Start with qq, if there is one. Only allow for rank 1 popcorn meson | |
46335 | 710 K1=KFQ(1) | |
46336 | IF(IABS(KFQ(2)).GT.1000) K1=KFQ(2) | |
46337 | MSTU(125)=0 | |
46338 | CALL PYDCYK(K1,0,KFLN,K(N+2,2)) | |
46339 | CALL PYDCYK(KFQ(1)+KFQ(2)-K1,-KFLN,KFLDMP,K(N+3,2)) | |
46340 | IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 710 | |
46341 | ||
46342 | C...Open string with four specified flavours. | |
46343 | ELSEIF(NQ.EQ.4) THEN | |
46344 | KC1=PYCOMP(KFQ(1)) | |
46345 | KC2=PYCOMP(KFQ(2)) | |
46346 | KC3=PYCOMP(KFQ(3)) | |
46347 | KC4=PYCOMP(KFQ(4)) | |
46348 | IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) GOTO 1050 | |
46349 | KQ1=KCHG(KC1,2)*ISIGN(1,KFQ(1)) | |
46350 | KQ2=KCHG(KC2,2)*ISIGN(1,KFQ(2)) | |
46351 | KQ3=KCHG(KC3,2)*ISIGN(1,KFQ(3)) | |
46352 | KQ4=KCHG(KC4,2)*ISIGN(1,KFQ(4)) | |
46353 | IF(KQ1+KQ2+KQ3+KQ4.NE.0) GOTO 1050 | |
46354 | C...Combine flavours pairwise to form two hadrons. | |
46355 | 720 I1=1 | |
46356 | I2=2 | |
46357 | IF(KQ1*KQ2.GT.0.OR.(IABS(KFQ(1)).GT.1000.AND. | |
46358 | & IABS(KFQ(2)).GT.1000)) I2=3 | |
46359 | IF(I2.EQ.3.AND.(KQ1*KQ3.GT.0.OR.(IABS(KFQ(1)).GT.1000.AND. | |
46360 | & IABS(KFQ(3)).GT.1000))) I2=4 | |
46361 | I3=3 | |
46362 | IF(I2.EQ.3) I3=2 | |
46363 | I4=10-I1-I2-I3 | |
46364 | CALL PYDCYK(KFQ(I1),KFQ(I2),KFLDMP,K(N+2,2)) | |
46365 | CALL PYDCYK(KFQ(I3),KFQ(I4),KFLDMP,K(N+3,2)) | |
46366 | IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 720 | |
46367 | ||
46368 | C...Closed string. | |
46369 | ELSE | |
46370 | IF(IABS(K(IC2,2)).NE.21) GOTO 1050 | |
46371 | C...No room for popcorn mesons in closed string -> 2 hadrons. | |
46372 | MSTU(125)=0 | |
46373 | 730 CALL PYDCYK(1+INT((2D0+PARJ(2))*PYR(0)),0,KFLN,KFDMP) | |
46374 | CALL PYDCYK(KFLN,0,KFLM,K(N+2,2)) | |
46375 | CALL PYDCYK(-KFLN,-KFLM,KFLDMP,K(N+3,2)) | |
46376 | IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 730 | |
46377 | ENDIF | |
46378 | P(N+2,5)=PYMASS(K(N+2,2)) | |
46379 | P(N+3,5)=PYMASS(K(N+3,2)) | |
46380 | ||
46381 | C...If it does not work: try again (a number of times), give up (if no | |
46382 | C...place to shuffle momentum or too many flavours), or form one hadron. | |
46383 | IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) THEN | |
46384 | IF(NTRY.LT.MSTJ(17).OR.(NQ.EQ.4.AND.NTRY.LT.5*MSTJ(17))) THEN | |
46385 | GOTO 700 | |
46386 | ELSEIF(NSIN.EQ.1.OR.NQ.EQ.4) THEN | |
46387 | GOTO 1050 | |
46388 | ELSE | |
46389 | GOTO 800 | |
46390 | END IF | |
46391 | END IF | |
46392 | ||
46393 | C...Perform two-particle decay of jet system. | |
46394 | C...First step: find reference axis in decaying system rest frame. | |
46395 | C...(Borrow slot N+2 for temporary direction.) | |
46396 | DO 740 J=1,4 | |
46397 | P(N+2,J)=P(IC1,J) | |
46398 | 740 CONTINUE | |
46399 | DO 760 I=IC1+1,IC2-1 | |
46400 | IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND. | |
46401 | & KCHG(PYCOMP(K(I,2)),2).NE.0) THEN | |
46402 | FRAC1=FOUR(IC2,I)/(FOUR(IC1,I)+FOUR(IC2,I)) | |
46403 | DO 750 J=1,4 | |
46404 | P(N+2,J)=P(N+2,J)+FRAC1*P(I,J) | |
46405 | 750 CONTINUE | |
46406 | ENDIF | |
46407 | 760 CONTINUE | |
46408 | CALL PYROBO(N+2,N+2,0D0,0D0,-DPC(1)/DPC(4),-DPC(2)/DPC(4), | |
46409 | &-DPC(3)/DPC(4)) | |
46410 | THE1=PYANGL(P(N+2,3),SQRT(P(N+2,1)**2+P(N+2,2)**2)) | |
46411 | PHI1=PYANGL(P(N+2,1),P(N+2,2)) | |
46412 | ||
46413 | C...Second step: generate isotropic/anisotropic decay. | |
46414 | PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2- | |
46415 | &(P(N+2,5)-P(N+3,5))**2))/(2D0*PECM) | |
46416 | 770 UE(3)=PYR(0) | |
46417 | IF(PARJ(21).LE.0.01D0) UE(3)=1D0 | |
46418 | PT2=(1D0-UE(3)**2)*PA**2 | |
46419 | IF(MSTJ(16).LE.0) THEN | |
46420 | PREV=0.5D0 | |
46421 | ELSE | |
46422 | IF(EXP(-PT2/(2D0*MAX(0.01D0,PARJ(21))**2)).LT.PYR(0)) GOTO 770 | |
46423 | PR1=P(N+2,5)**2+PT2 | |
46424 | PR2=P(N+3,5)**2+PT2 | |
46425 | ALAMBD=SQRT(MAX(0D0,(PECM**2-PR1-PR2)**2-4D0*PR1*PR2)) | |
46426 | PREVCF=PARJ(42) | |
46427 | IF(MSTJ(11).EQ.2) PREVCF=PARJ(39) | |
46428 | PREV=1D0/(1D0+EXP(MIN(50D0,PREVCF*ALAMBD*PARJ(40)))) | |
46429 | ENDIF | |
46430 | IF(PYR(0).LT.PREV) UE(3)=-UE(3) | |
46431 | PHI=PARU(2)*PYR(0) | |
46432 | UE(1)=SQRT(1D0-UE(3)**2)*COS(PHI) | |
46433 | UE(2)=SQRT(1D0-UE(3)**2)*SIN(PHI) | |
46434 | DO 780 J=1,3 | |
46435 | P(N+2,J)=PA*UE(J) | |
46436 | P(N+3,J)=-PA*UE(J) | |
46437 | 780 CONTINUE | |
46438 | P(N+2,4)=SQRT(PA**2+P(N+2,5)**2) | |
46439 | P(N+3,4)=SQRT(PA**2+P(N+3,5)**2) | |
46440 | ||
46441 | C...Third step: move back to event frame and set production vertex. | |
46442 | CALL PYROBO(N+2,N+3,THE1,PHI1,DPC(1)/DPC(4),DPC(2)/DPC(4), | |
46443 | &DPC(3)/DPC(4)) | |
46444 | DO 790 J=1,4 | |
46445 | V(N+1,J)=V(IC1,J) | |
46446 | V(N+2,J)=V(IC1,J) | |
46447 | V(N+3,J)=V(IC2,J) | |
46448 | 790 CONTINUE | |
46449 | N=N+3 | |
46450 | GOTO 1030 | |
46451 | ||
46452 | C...Else form one particle, if possible. | |
46453 | 800 NBODY=1 | |
46454 | K(N+1,5)=N+2 | |
46455 | DO 810 J=1,4 | |
46456 | V(N+1,J)=V(IC1,J) | |
46457 | V(N+2,J)=V(IC1,J) | |
46458 | 810 CONTINUE | |
46459 | ||
46460 | C...Select hadron flavour from available quark flavours. | |
46461 | 820 IF(NQ.EQ.2.AND.IABS(KFQ(1)).GT.100.AND.IABS(KFQ(2)).GT.100) THEN | |
46462 | GOTO 1050 | |
46463 | ELSEIF(NQ.EQ.2) THEN | |
46464 | CALL PYKFDI(KFQ(1),KFQ(2),KFLDMP,K(N+2,2)) | |
46465 | ELSE | |
46466 | KFLN=1+INT((2D0+PARJ(2))*PYR(0)) | |
46467 | CALL PYKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2)) | |
46468 | ENDIF | |
46469 | IF(K(N+2,2).EQ.0) GOTO 820 | |
46470 | P(N+2,5)=PYMASS(K(N+2,2)) | |
46471 | ||
46472 | C...Use old algorithm for E/p conservation? (EN) | |
46473 | IF (MSTJ(16).LE.0) GOTO 990 | |
46474 | ||
46475 | C...Find the string piece closest to the cluster by a loop | |
46476 | C...over the undecayed partons not in present cluster. (EN) | |
46477 | DGLOMI=1D30 | |
46478 | IBEG=0 | |
46479 | I0=0 | |
46480 | NJUNC=0 | |
46481 | DO 850 I1=MAX(1,IP),N-1 | |
46482 | IF(K(I,1).EQ.1) NJUNC=0 | |
46483 | IF(K(I,1).EQ.41) NJUNC=NJUNC+1 | |
46484 | IF(I1.GE.IC1-1.AND.I1.LE.IC2) THEN | |
46485 | I0=0 | |
46486 | ELSEIF(K(I1,1).EQ.2) THEN | |
46487 | IF(I0.EQ.0) I0=I1 | |
46488 | I2=I1 | |
46489 | 830 I2=I2+1 | |
46490 | IF(K(I2,1).EQ.41) GOTO 850 | |
46491 | IF(K(I2,1).GT.10) GOTO 830 | |
46492 | IF(KCHG(PYCOMP(K(I2,2)),2).EQ.0) GOTO 830 | |
46493 | IF(K(I1,2).EQ.21.AND.K(I2,2).NE.21.AND.K(I2,1).NE.1.AND. | |
46494 | & NJUNC.EQ.0) GOTO 850 | |
46495 | IF(K(I1,2).NE.21.AND.K(I2,2).EQ.21.AND.NJUNC.NE.0) GOTO 850 | |
46496 | ||
46497 | C...Define velocity vectors e1, e2, ecl and differences e3, e4. | |
46498 | DO 840 J=1,3 | |
46499 | E1(J)=P(I1,J)/P(I1,4) | |
46500 | E2(J)=P(I2,J)/P(I2,4) | |
46501 | ECL(J)=P(N+1,J)/P(N+1,4) | |
46502 | E3(J)=E2(J)-E1(J) | |
46503 | E4(J)=ECL(J)-E1(J) | |
46504 | 840 CONTINUE | |
46505 | ||
46506 | C...Calculate minimal D=(e4-alpha*e3)**2 for 0<alpha<1. | |
46507 | E3S=E3(1)**2+E3(2)**2+E3(3)**2 | |
46508 | E4S=E4(1)**2+E4(2)**2+E4(3)**2 | |
46509 | E34=E3(1)*E4(1)+E3(2)*E4(2)+E3(3)*E4(3) | |
46510 | IF(E34.LE.0D0) THEN | |
46511 | DDMIN=E4S | |
46512 | ELSEIF(E34.LT.E3S) THEN | |
46513 | DDMIN=E4S-E34**2/E3S | |
46514 | ELSE | |
46515 | DDMIN=E4S-2D0*E34+E3S | |
46516 | ENDIF | |
46517 | ||
46518 | C...Is this the smallest so far? | |
46519 | IF(DDMIN.LT.DGLOMI) THEN | |
46520 | DGLOMI=DDMIN | |
46521 | IBEG=I0 | |
46522 | IPCS=I1 | |
46523 | ENDIF | |
46524 | ELSEIF(K(I1,1).EQ.1.AND.KCHG(PYCOMP(K(I1,2)),2).NE.0) THEN | |
46525 | I0=0 | |
46526 | ENDIF | |
46527 | 850 CONTINUE | |
46528 | ||
46529 | C... Check if there are any strings to connect to the new gluon. (EN) | |
46530 | IF (IBEG.EQ.0) GOTO 990 | |
46531 | ||
46532 | C...Delta_m = m_clus - m_had > 0: emit a 'gluon' (EN) | |
46533 | IF (P(N+1,5).GE.P(N+2,5)) THEN | |
46534 | ||
46535 | C...Construct 'gluon' that is needed to put hadron on the mass shell. | |
46536 | FRAC=P(N+2,5)/P(N+1,5) | |
46537 | DO 860 J=1,5 | |
46538 | P(N+2,J)=FRAC*P(N+1,J) | |
46539 | PG(J)=(1D0-FRAC)*P(N+1,J) | |
46540 | 860 CONTINUE | |
46541 | ||
46542 | C... Copy string with new gluon put in. | |
46543 | N=N+2 | |
46544 | I=IBEG-1 | |
46545 | 870 I=I+1 | |
46546 | IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 870 | |
46547 | IF(KCHG(PYCOMP(K(I,2)),2).EQ.0.AND.K(I,1).NE.41) GOTO 870 | |
46548 | N=N+1 | |
46549 | DO 880 J=1,5 | |
46550 | K(N,J)=K(I,J) | |
46551 | P(N,J)=P(I,J) | |
46552 | V(N,J)=V(I,J) | |
46553 | 880 CONTINUE | |
46554 | K(I,1)=K(I,1)+10 | |
46555 | K(I,4)=N | |
46556 | K(I,5)=N | |
46557 | K(N,3)=I | |
46558 | IF(I.EQ.IPCS) THEN | |
46559 | N=N+1 | |
46560 | DO 890 J=1,5 | |
46561 | K(N,J)=K(N-1,J) | |
46562 | P(N,J)=PG(J) | |
46563 | V(N,J)=V(N-1,J) | |
46564 | 890 CONTINUE | |
46565 | K(N,2)=21 | |
46566 | K(N,3)=NSAV+1 | |
46567 | ENDIF | |
46568 | IF(K(I,1).EQ.12.OR.K(I,1).EQ.51) GOTO 870 | |
46569 | GOTO 1030 | |
46570 | ||
46571 | C...Delta_m = m_clus - m_had < 0: have to absorb a 'gluon' instead, | |
46572 | C...from string piece endpoints. | |
46573 | ELSE | |
46574 | ||
46575 | C...Begin by copying string that should give energy to cluster. | |
46576 | N=N+2 | |
46577 | I=IBEG-1 | |
46578 | 900 I=I+1 | |
46579 | IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 900 | |
46580 | IF(KCHG(PYCOMP(K(I,2)),2).EQ.0.AND.K(I,1).NE.41) GOTO 900 | |
46581 | N=N+1 | |
46582 | DO 910 J=1,5 | |
46583 | K(N,J)=K(I,J) | |
46584 | P(N,J)=P(I,J) | |
46585 | V(N,J)=V(I,J) | |
46586 | 910 CONTINUE | |
46587 | K(I,1)=K(I,1)+10 | |
46588 | K(I,4)=N | |
46589 | K(I,5)=N | |
46590 | K(N,3)=I | |
46591 | IF(I.EQ.IPCS) I1=N | |
46592 | IF(K(I,1).EQ.12.OR.K(I,1).EQ.51) GOTO 900 | |
46593 | I2=I1+1 | |
46594 | ||
46595 | C...Set initial Phad. | |
46596 | DO 920 J=1,4 | |
46597 | P(NSAV+2,J)=P(NSAV+1,J) | |
46598 | 920 CONTINUE | |
46599 | ||
46600 | C...Calculate Pg, a part of which will be added to Phad later. (EN) | |
46601 | 930 IF(MSTJ(16).EQ.1) THEN | |
46602 | ALPHA=1D0 | |
46603 | BETA=1D0 | |
46604 | ELSE | |
46605 | ALPHA=FOUR(NSAV+1,I2)/FOUR(I1,I2) | |
46606 | BETA=FOUR(NSAV+1,I1)/FOUR(I1,I2) | |
46607 | ENDIF | |
46608 | DO 940 J=1,4 | |
46609 | PG(J)=ALPHA*P(I1,J)+BETA*P(I2,J) | |
46610 | 940 CONTINUE | |
46611 | PG(5)=SQRT(MAX(1D-20,PG(4)**2-PG(1)**2-PG(2)**2-PG(3)**2)) | |
46612 | ||
46613 | C..Solve 2nd order equation, use the best (smallest) solution. (EN) | |
46614 | PMSCOL=P(NSAV+2,4)**2-P(NSAV+2,1)**2-P(NSAV+2,2)**2- | |
46615 | & P(NSAV+2,3)**2 | |
46616 | PCLPG=(P(NSAV+2,4)*PG(4)-P(NSAV+2,1)*PG(1)- | |
46617 | & P(NSAV+2,2)*PG(2)-P(NSAV+2,3)*PG(3))/PG(5)**2 | |
46618 | DELTA=SQRT(PCLPG**2+(P(NSAV+2,5)**2-PMSCOL)/PG(5)**2)-PCLPG | |
46619 | ||
46620 | C...If all gluon energy eaten, zero it and take a step back. | |
46621 | ITER=0 | |
46622 | IF(DELTA*ALPHA.GT.1D0.AND.I1.GT.NSAV+3) THEN | |
46623 | ITER=1 | |
46624 | DO 950 J=1,4 | |
46625 | P(NSAV+2,J)=P(NSAV+2,J)+P(I1,J) | |
46626 | P(I1,J)=0D0 | |
46627 | 950 CONTINUE | |
46628 | P(I1,5)=0D0 | |
46629 | K(I1,1)=K(I1,1)+10 | |
46630 | I1=I1-1 | |
46631 | IF(K(I1,1).EQ.41) ITER=-1 | |
46632 | ENDIF | |
46633 | IF(DELTA*BETA.GT.1D0.AND.I2.LT.N) THEN | |
46634 | ITER=1 | |
46635 | DO 960 J=1,4 | |
46636 | P(NSAV+2,J)=P(NSAV+2,J)+P(I2,J) | |
46637 | P(I2,J)=0D0 | |
46638 | 960 CONTINUE | |
46639 | P(I2,5)=0D0 | |
46640 | K(I2,1)=K(I2,1)+10 | |
46641 | I2=I2+1 | |
46642 | IF(K(I2,1).EQ.41) ITER=-1 | |
46643 | ENDIF | |
46644 | IF(ITER.EQ.1) GOTO 930 | |
46645 | ||
46646 | C...If also all endpoint energy eaten, revert to old procedure. | |
46647 | IF((1D0-DELTA*ALPHA)*P(I1,4).LT.P(I1,5).OR. | |
46648 | & (1D0-DELTA*BETA)*P(I2,4).LT.P(I2,5).OR.ITER.EQ.-1) THEN | |
46649 | DO 970 I=NSAV+3,N | |
46650 | IM=K(I,3) | |
46651 | K(IM,1)=K(IM,1)-10 | |
46652 | K(IM,4)=0 | |
46653 | K(IM,5)=0 | |
46654 | 970 CONTINUE | |
46655 | N=NSAV | |
46656 | GOTO 990 | |
46657 | ENDIF | |
46658 | ||
46659 | C... Construct the collapsed hadron and modified string partons. | |
46660 | DO 980 J=1,4 | |
46661 | P(NSAV+2,J)=P(NSAV+2,J)+DELTA*PG(J) | |
46662 | P(I1,J)=(1D0-DELTA*ALPHA)*P(I1,J) | |
46663 | P(I2,J)=(1D0-DELTA*BETA)*P(I2,J) | |
46664 | 980 CONTINUE | |
46665 | P(I1,5)=(1D0-DELTA*ALPHA)*P(I1,5) | |
46666 | P(I2,5)=(1D0-DELTA*BETA)*P(I2,5) | |
46667 | ||
46668 | C...Finished with string collapse in new scheme. | |
46669 | GOTO 1030 | |
46670 | ENDIF | |
46671 | ||
46672 | C... Use old algorithm; by choice or when in trouble. | |
46673 | 990 CONTINUE | |
46674 | C...Find parton/particle which combines to largest extra mass. | |
46675 | IR=0 | |
46676 | HA=0D0 | |
46677 | HSM=0D0 | |
46678 | DO 1010 MCOMB=1,3 | |
46679 | IF(IR.NE.0) GOTO 1010 | |
46680 | DO 1000 I=MAX(1,IP),N | |
46681 | IF(K(I,1).LE.0.OR.K(I,1).GT.10.OR.(I.GE.IC1.AND.I.LE.IC2 | |
46682 | & .AND.K(I,1).GE.1.AND.K(I,1).LE.2)) GOTO 1000 | |
46683 | IF(MCOMB.EQ.1) KCI=PYCOMP(K(I,2)) | |
46684 | IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 1000 | |
46685 | IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 1000 | |
46686 | IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100) | |
46687 | & GOTO 1000 | |
46688 | HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3) | |
46689 | HSR=2D0*HCR+PECM**2-P(N+2,5)**2-2D0*P(N+2,5)*P(I,5) | |
46690 | IF(HSR.GT.HSM) THEN | |
46691 | IR=I | |
46692 | HA=HCR | |
46693 | HSM=HSR | |
46694 | ENDIF | |
46695 | 1000 CONTINUE | |
46696 | 1010 CONTINUE | |
46697 | ||
46698 | C...Shuffle energy and momentum to put new particle on mass shell. | |
46699 | IF(IR.NE.0) THEN | |
46700 | HB=PECM**2+HA | |
46701 | HC=P(N+2,5)**2+HA | |
46702 | HD=P(IR,5)**2+HA | |
46703 | HK2=0.5D0*(HB*SQRT(MAX(0D0,((HB+HC)**2-4D0*(HB+HD)*P(N+2,5)**2)/ | |
46704 | & (HA**2-(PECM*P(IR,5))**2)))-(HB+HC))/(HB+HD) | |
46705 | HK1=(0.5D0*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB | |
46706 | DO 1020 J=1,4 | |
46707 | P(N+2,J)=(1D0+HK1)*DPC(J)-HK2*P(IR,J) | |
46708 | P(IR,J)=(1D0+HK2)*P(IR,J)-HK1*DPC(J) | |
46709 | 1020 CONTINUE | |
46710 | N=N+2 | |
46711 | ELSE | |
46712 | CALL PYERRM(3,'(PYPREP:) no match for collapsing cluster') | |
46713 | RETURN | |
46714 | ENDIF | |
46715 | ||
46716 | C...Mark collapsed system and store daughter pointers. Iterate. | |
46717 | 1030 DO 1040 I=IC1,IC2 | |
46718 | IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND. | |
46719 | & KCHG(PYCOMP(K(I,2)),2).NE.0) THEN | |
46720 | K(I,1)=K(I,1)+10 | |
46721 | IF(MSTU(16).NE.2) THEN | |
46722 | K(I,4)=NSAV+1 | |
46723 | K(I,5)=NSAV+1 | |
46724 | ELSE | |
46725 | K(I,4)=NSAV+2 | |
46726 | K(I,5)=NSAV+1+NBODY | |
46727 | ENDIF | |
46728 | ENDIF | |
46729 | IF(K(I,1).EQ.41) K(I,1)=K(I,1)+10 | |
46730 | 1040 CONTINUE | |
46731 | IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 620 | |
46732 | ||
46733 | C...Check flavours and invariant masses in parton systems. | |
46734 | 1050 NP=0 | |
46735 | KFN=0 | |
46736 | KQS=0 | |
46737 | NJU=0 | |
46738 | DO 1060 J=1,5 | |
46739 | DPS(J)=0D0 | |
46740 | 1060 CONTINUE | |
46741 | DO 1090 I=MAX(1,IP),N | |
46742 | IF(K(I,1).EQ.41) NJU=NJU+1 | |
46743 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 1090 | |
46744 | KC=PYCOMP(K(I,2)) | |
46745 | IF(KC.EQ.0) GOTO 1090 | |
46746 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
46747 | IF(KQ.EQ.0) GOTO 1090 | |
46748 | NP=NP+1 | |
46749 | IF(KQ.NE.2) THEN | |
46750 | KFN=KFN+1 | |
46751 | KQS=KQS+KQ | |
46752 | MSTJ(93)=1 | |
46753 | DPS(5)=DPS(5)+PYMASS(K(I,2)) | |
46754 | ENDIF | |
46755 | DO 1070 J=1,4 | |
46756 | DPS(J)=DPS(J)+P(I,J) | |
46757 | 1070 CONTINUE | |
46758 | IF(K(I,1).EQ.1) THEN | |
46759 | NFERR=0 | |
46760 | IF(NJU.EQ.0.AND.NP.NE.1) THEN | |
46761 | IF(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0) NFERR=1 | |
46762 | ELSEIF(NJU.EQ.1) THEN | |
46763 | IF(KFN.NE.3.OR.IABS(KQS).NE.3) NFERR=1 | |
46764 | ELSEIF(NJU.EQ.2) THEN | |
46765 | IF(KFN.NE.4.OR.KQS.NE.0) NFERR=1 | |
46766 | ELSEIF(NJU.GE.3) THEN | |
46767 | NFERR=1 | |
46768 | ENDIF | |
46769 | IF(NFERR.EQ.1) CALL | |
46770 | & PYERRM(2,'(PYPREP:) unphysical flavour combination') | |
46771 | IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT. | |
46772 | & (0.9D0*PARJ(32)+DPS(5))**2) CALL PYERRM(3, | |
46773 | & '(PYPREP:) too small mass in jet system') | |
46774 | NP=0 | |
46775 | KFN=0 | |
46776 | KQS=0 | |
46777 | NJU=0 | |
46778 | DO 1080 J=1,5 | |
46779 | DPS(J)=0D0 | |
46780 | 1080 CONTINUE | |
46781 | ENDIF | |
46782 | 1090 CONTINUE | |
46783 | ||
46784 | RETURN | |
46785 | END | |
46786 | ||
46787 | C********************************************************************* | |
46788 | ||
46789 | C...PYSTRF | |
46790 | C...Handles the fragmentation of an arbitrary colour singlet | |
46791 | C...jet system according to the Lund string fragmentation model. | |
46792 | ||
46793 | SUBROUTINE PYSTRF(IP) | |
46794 | ||
46795 | C...Double precision and integer declarations. | |
46796 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
46797 | IMPLICIT INTEGER(I-N) | |
46798 | INTEGER PYK,PYCHGE,PYCOMP | |
46799 | C...Commonblocks. | |
46800 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
46801 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
46802 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
46803 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
46804 | C...Local arrays. All MOPS variables ends with MO | |
46805 | DIMENSION DPS(5),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2), | |
46806 | &IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(6),PJU(5,5), | |
46807 | &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8), | |
46808 | &INMO(9),PM2QMO(2),XTMO(2),EJSTR(2),IJUORI(2),IBARRK(2), | |
46809 | &PBST(3,5),TJUOLD(5) | |
46810 | ||
46811 | C...Function: four-product of two vectors. | |
46812 | 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) | |
46813 | DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)- | |
46814 | &DP(I,3)*DP(J,3) | |
46815 | ||
46816 | C...Reset counters. | |
46817 | MSTJ(91)=0 | |
46818 | NSAV=N | |
46819 | MSTU90=MSTU(90) | |
46820 | NP=0 | |
46821 | KQSUM=0 | |
46822 | DO 100 J=1,5 | |
46823 | DPS(J)=0D0 | |
46824 | 100 CONTINUE | |
46825 | MJU(1)=0 | |
46826 | MJU(2)=0 | |
46827 | NTRYFN=0 | |
46828 | IJUORI(1)=0 | |
46829 | IJUORI(2)=0 | |
46830 | ||
46831 | C...Identify parton system. | |
46832 | I=IP-1 | |
46833 | 110 I=I+1 | |
46834 | IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN | |
46835 | CALL PYERRM(12,'(PYSTRF:) failed to reconstruct jet system') | |
46836 | IF(MSTU(21).GE.1) RETURN | |
46837 | ENDIF | |
46838 | IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110 | |
46839 | KC=PYCOMP(K(I,2)) | |
46840 | IF(KC.EQ.0) GOTO 110 | |
46841 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
46842 | IF(KQ.EQ.0.AND.K(I,1).NE.41) GOTO 110 | |
46843 | IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN | |
46844 | CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS') | |
46845 | IF(MSTU(21).GE.1) RETURN | |
46846 | ENDIF | |
46847 | ||
46848 | C...Take copy of partons to be considered. Check flavour sum. | |
46849 | NP=NP+1 | |
46850 | DO 120 J=1,5 | |
46851 | K(N+NP,J)=K(I,J) | |
46852 | P(N+NP,J)=P(I,J) | |
46853 | IF(J.NE.4) DPS(J)=DPS(J)+P(I,J) | |
46854 | 120 CONTINUE | |
46855 | DPS(4)=DPS(4)+SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
46856 | K(N+NP,3)=I | |
46857 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
46858 | IF(K(I,1).EQ.41) THEN | |
46859 | IF(MOD(KQSUM,2).EQ.0.AND.MJU(1).EQ.0) THEN | |
46860 | MJU(1)=N+NP | |
46861 | IJUORI(1)=I | |
46862 | ELSE | |
46863 | MJU(2)=N+NP | |
46864 | IJUORI(2)=I | |
46865 | ENDIF | |
46866 | ENDIF | |
46867 | IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110 | |
46868 | IF(MOD(KQSUM,3).NE.0) THEN | |
46869 | CALL PYERRM(12,'(PYSTRF:) unphysical flavour combination') | |
46870 | IF(MSTU(21).GE.1) RETURN | |
46871 | ENDIF | |
46872 | IF(MJU(1).GT.0.OR.MJU(2).GT.0) MSTU(29)=1 | |
46873 | ||
46874 | C...Boost copied system to CM frame (for better numerical precision). | |
46875 | IF(ABS(DPS(3)).LT.0.99D0*DPS(4)) THEN | |
46876 | MBST=0 | |
46877 | MSTU(33)=1 | |
46878 | CALL PYROBO(N+1,N+NP,0D0,0D0,-DPS(1)/DPS(4),-DPS(2)/DPS(4), | |
46879 | & -DPS(3)/DPS(4)) | |
46880 | ELSE | |
46881 | MBST=1 | |
46882 | HHBZ=SQRT(MAX(1D-6,DPS(4)+DPS(3))/MAX(1D-6,DPS(4)-DPS(3))) | |
46883 | DO 130 I=N+1,N+NP | |
46884 | HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 | |
46885 | IF(P(I,3).GT.0D0) THEN | |
46886 | HHPEZ=MAX(1D-10,(P(I,4)+P(I,3))/HHBZ) | |
46887 | P(I,3)=0.5D0*(HHPEZ-HHPMT/HHPEZ) | |
46888 | P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) | |
46889 | ELSE | |
46890 | HHPEZ=MAX(1D-10,(P(I,4)-P(I,3))*HHBZ) | |
46891 | P(I,3)=-0.5D0*(HHPEZ-HHPMT/HHPEZ) | |
46892 | P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) | |
46893 | ENDIF | |
46894 | 130 CONTINUE | |
46895 | ENDIF | |
46896 | ||
46897 | C...Search for very nearby partons that may be recombined. | |
46898 | NTRYR=0 | |
46899 | NTRYWR=0 | |
46900 | PARU12=PARU(12) | |
46901 | PARU13=PARU(13) | |
46902 | MJU(3)=MJU(1) | |
46903 | MJU(4)=MJU(2) | |
46904 | NR=NP | |
46905 | 140 IF(NR.GE.3) THEN | |
46906 | PDRMIN=2D0*PARU12 | |
46907 | DO 150 I=N+1,N+NR | |
46908 | IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 150 | |
46909 | I1=I+1 | |
46910 | IF(I.EQ.N+NR) I1=N+1 | |
46911 | IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 150 | |
46912 | IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21) | |
46913 | & GOTO 150 | |
46914 | IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21) | |
46915 | & GOTO 150 | |
46916 | PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+ | |
46917 | & P(I1,2)**2+P(I1,3)**2)) | |
46918 | PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3) | |
46919 | PDR=4D0*(PAP-PVP)**2/MAX(1D-6,PARU13**2*PAP+2D0*(PAP-PVP)) | |
46920 | IF(PDR.LT.PDRMIN) THEN | |
46921 | IR=I | |
46922 | PDRMIN=PDR | |
46923 | ENDIF | |
46924 | 150 CONTINUE | |
46925 | ||
46926 | C...Recombine very nearby partons to avoid machine precision problems. | |
46927 | IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN | |
46928 | DO 160 J=1,4 | |
46929 | P(N+1,J)=P(N+1,J)+P(N+NR,J) | |
46930 | 160 CONTINUE | |
46931 | P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- | |
46932 | & P(N+1,3)**2)) | |
46933 | NR=NR-1 | |
46934 | GOTO 140 | |
46935 | ELSEIF(PDRMIN.LT.PARU12) THEN | |
46936 | DO 170 J=1,4 | |
46937 | P(IR,J)=P(IR,J)+P(IR+1,J) | |
46938 | 170 CONTINUE | |
46939 | P(IR,5)=SQRT(MAX(0D0,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2- | |
46940 | & P(IR,3)**2)) | |
46941 | IF(MJU(2).NE.0.AND.IR.GT.MJU(2)) K(IR,2)=K(IR+1,2) | |
46942 | DO 190 I=IR+1,N+NR-1 | |
46943 | K(I,1)=K(I+1,1) | |
46944 | K(I,2)=K(I+1,2) | |
46945 | DO 180 J=1,5 | |
46946 | P(I,J)=P(I+1,J) | |
46947 | 180 CONTINUE | |
46948 | 190 CONTINUE | |
46949 | IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2) | |
46950 | NR=NR-1 | |
46951 | IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1 | |
46952 | IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1 | |
46953 | GOTO 140 | |
46954 | ENDIF | |
46955 | ENDIF | |
46956 | NTRYR=NTRYR+1 | |
46957 | ||
46958 | C...Reset particle counter. Skip ahead if no junctions are present; | |
46959 | C...this is usually the case! | |
46960 | NRS=MAX(5*NR+11,NP) | |
46961 | NTRY=0 | |
46962 | 200 NTRY=NTRY+1 | |
46963 | IF(NTRY.GT.100.AND.NTRYR.LE.8) THEN | |
46964 | PARU12=4D0*PARU12 | |
46965 | PARU13=2D0*PARU13 | |
46966 | GOTO 140 | |
46967 | ELSEIF(NTRY.GT.100) THEN | |
46968 | CALL PYERRM(14,'(PYSTRF:) caught in infinite loop') | |
46969 | IF(MSTU(21).GE.1) RETURN | |
46970 | ENDIF | |
46971 | I=N+NRS | |
46972 | MSTU(90)=MSTU90 | |
46973 | IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 640 | |
46974 | IF(MSTJ(12).GE.4) CALL PYERRM(29,'(PYSTRF:) sorry,'// | |
46975 | & ' junction strings not handled by MSTJ(12)>3 options') | |
46976 | DO 630 JT=1,2 | |
46977 | NJS(JT)=0 | |
46978 | IF(MJU(JT).EQ.0) GOTO 630 | |
46979 | JS=3-2*JT | |
46980 | ||
46981 | C++SKANDS | |
46982 | C...Find and sum up momentum on three sides of junction. | |
46983 | C...Begin with previous boost = zero. | |
46984 | IJRFIT=0 | |
46985 | DO 210 IX=1,3 | |
46986 | TJUOLD(IX)=0D0 | |
46987 | 210 CONTINUE | |
46988 | TJUOLD(4)=1D0 | |
46989 | 220 IU=0 | |
46990 | C...Beginning and end of string system in event record. | |
46991 | I1BEG=N+1+(JT-1)*(NR-1) | |
46992 | I1END=N+NR+(JT-1)*(1-NR) | |
46993 | C...Look for junction string piece end points | |
46994 | DO 230 I1=I1BEG,I1END,JS | |
46995 | IF(K(I1,2).NE.21.AND.IU.LE.5.AND.IJRFIT.EQ.0) THEN | |
46996 | C...Store junction string piece end points. | |
46997 | C 1-junction systems 2-junction systems | |
46998 | C IU : 1 2 3 4 1 2 3 4 5 6 | |
46999 | C IJU(IU): q-g-g-q-g-g-j-g-q q-g-g-q-g-j-g-g-j-g-q-g-g-q | |
47000 | IU=IU+1 | |
47001 | IJU(IU)=I1 | |
47002 | ENDIF | |
47003 | C...Sum over momenta, from junction outwards. | |
47004 | 230 CONTINUE | |
47005 | DO 280 IU=1,3 | |
47006 | PWT=0D0 | |
47007 | C...Initialize junction drag and string piece 4-vectors. | |
47008 | DO 240 J=1,5 | |
47009 | PBST(IU,J)=0D0 | |
47010 | PJU(IU,J)=0D0 | |
47011 | 240 CONTINUE | |
47012 | C...First two branches. Inwards out means opposite direction to JS. | |
47013 | C...(JS is 1 for JT=1, -1 for JT=2) | |
47014 | IF (IU.LT.3) THEN | |
47015 | I1A=IJU(IU+1)-JS | |
47016 | I1B=IJU(IU) | |
47017 | IDIR=-JS | |
47018 | C...Last branch (gq or gjgqgq). Direction now reversed. | |
47019 | ELSE | |
47020 | I1A=IJU(IU)+JS | |
47021 | I1B=I1END | |
47022 | IDIR=JS | |
47023 | ENDIF | |
47024 | DO 270 I1=I1A,I1B,IDIR | |
47025 | C...Sum up momentum directions with exponential suppression | |
47026 | C...for use in finding junction rest frame below. | |
47027 | IF (K(I1,2).EQ.88) THEN | |
47028 | C...gjgqgq type system encountered. Use current PWT as start | |
47029 | C...for both strings. | |
47030 | PWTOLD=PWT | |
47031 | ELSE | |
47032 | IF (I1.EQ.IJU(5)+IDIR) PWT=PWTOLD | |
47033 | C...Sum up string piece (boosted) 4-momenta. | |
47034 | DO 250 J=1,4 | |
47035 | PJU(IU,J)=PJU(IU,J)+P(I1,J) | |
47036 | 250 CONTINUE | |
47037 | C...Compute "junction drag" vectors from (boosted) 4-momenta (initial | |
47038 | C...boost is zero, see above). Skip parton if suppression factor large. | |
47039 | IF (PWT.GT.10D0) GOTO 270 | |
47040 | C...Compute momentum in current frame: | |
47041 | TDP=TJUOLD(1)*P(I1,1)+TJUOLD(2)*P(I1,2)+TJUOLD(3)*P(I1,3) | |
47042 | BFC=TDP/(1D0+TJUOLD(4))+P(I1,4) | |
47043 | DO 260 J=1,3 | |
47044 | PTMP=P(I1,J)+TJUOLD(J)*BFC | |
47045 | PBST(IU,J)=PBST(IU,J)+PTMP*EXP(-PWT) | |
47046 | 260 CONTINUE | |
47047 | C...Boosted energy | |
47048 | PTMP=TJUOLD(4)*P(I1,4)+TDP | |
47049 | PBST(IU,4)=PBST(IU,J)+PTMP*EXP(-PWT) | |
47050 | PWT=PWT+PTMP/PARJ(48) | |
47051 | ENDIF | |
47052 | 270 CONTINUE | |
47053 | C...Put |p| rather than m in 5th slot. | |
47054 | PBST(IU,5)=SQRT(PBST(IU,1)**2+PBST(IU,2)**2+PBST(IU,3)**2) | |
47055 | PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) | |
47056 | 280 CONTINUE | |
47057 | ||
47058 | C...Calculate boost from present frame to next JRF candidate. | |
47059 | IJRFIT=IJRFIT+1 | |
47060 | CALL PYJURF(PBST,TJU) | |
47061 | ||
47062 | C...Combine new boost (TJU) with old boost (TJUOLD) | |
47063 | TMP=TJU(1)*TJUOLD(1)+TJU(2)*TJUOLD(2)+TJU(3)*TJUOLD(3) | |
47064 | DO 290 IX=1,3 | |
47065 | TJUOLD(IX)=TJU(IX)+TJUOLD(IX)*(TMP/(1D0+TJUOLD(4))+TJU(4)) | |
47066 | 290 CONTINUE | |
47067 | TJUOLD(4)=SQRT(1D0+TJUOLD(1)**2+TJUOLD(2)**2+TJUOLD(3)**2) | |
47068 | ||
47069 | C...If last boost small, accept JRF, else iterate. | |
47070 | C...Also prevent possibility of infinite loop. | |
47071 | IF (ABS((TJU(4)-1D0)/TJUOLD(4)).GT.0.01D0.AND. | |
47072 | & IJRFIT.LT.MSTJ(18)) THEN | |
47073 | GOTO 220 | |
47074 | ELSEIF (IJRFIT.GE.MSTJ(18)) THEN | |
47075 | CALL PYERRM(1,'(PYSTRF:) failed to converge on JRF') | |
47076 | ENDIF | |
47077 | ||
47078 | C...Now store total boost in TJU and change perception. | |
47079 | C...TJUOLD = boost vector from CM of string syst -> JRF. Henceforth, | |
47080 | C...TJU = junction motion vector in string CM, so the sign changes. | |
47081 | DO 300 J=1,3 | |
47082 | TJU(J)=-TJUOLD(J) | |
47083 | 300 CONTINUE | |
47084 | TJU(4)=SQRT(1D0+TJU(1)**2+TJU(2)**2+TJU(3)**2) | |
47085 | ||
47086 | C--SKANDS | |
47087 | ||
47088 | C...Calculate string piece energies in junction rest frame. | |
47089 | DO 310 IU=1,3 | |
47090 | PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)- | |
47091 | & TJU(3)*PJU(IU,3) | |
47092 | PBST(IU,5)=TJU(4)*PBST(IU,4)-TJU(1)*PBST(IU,1)- | |
47093 | & TJU(2)*PBST(IU,2)-TJU(3)*PBST(IU,3) | |
47094 | 310 CONTINUE | |
47095 | ||
47096 | C...Start preparing for fragmentation of two strings from junction. | |
47097 | ISTA=I | |
47098 | NTRYER=0 | |
47099 | 320 NTRYER=NTRYER+1 | |
47100 | I=ISTA | |
47101 | DO 610 IU=1,2 | |
47102 | NS=IABS(IJU(IU+1)-IJU(IU)) | |
47103 | ||
47104 | C...Junction strings: find longitudinal string directions. | |
47105 | DO 350 IS=1,NS | |
47106 | IS1=IJU(IU)+JS*(IS-1) | |
47107 | IS2=IJU(IU)+JS*IS | |
47108 | DO 330 J=1,5 | |
47109 | DP(1,J)=0.5D0*P(IS1,J) | |
47110 | IF(IS.EQ.1) DP(1,J)=P(IS1,J) | |
47111 | DP(2,J)=0.5D0*P(IS2,J) | |
47112 | IF(IS.EQ.NS) DP(2,J)=(-PBST(IU,J)+2D0*PBST(IU,5)*TJU(J))* | |
47113 | & (PJU(IU,5)/PBST(IU,5)) | |
47114 | 330 CONTINUE | |
47115 | IF(IS.EQ.NS) DP(2,5)=SQRT(MAX(0D0,PJU(IU,4)**2- | |
47116 | & PJU(IU,1)**2-PJU(IU,2)**2-PJU(IU,3)**2)) | |
47117 | DP(3,5)=DFOUR(1,1) | |
47118 | DP(4,5)=DFOUR(2,2) | |
47119 | DHKC=DFOUR(1,2) | |
47120 | IF(DP(3,5)+2D0*DHKC+DP(4,5).LE.0D0) THEN | |
47121 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
47122 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
47123 | DP(3,5)=0D0 | |
47124 | DP(4,5)=0D0 | |
47125 | DHKC=DFOUR(1,2) | |
47126 | ENDIF | |
47127 | DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) | |
47128 | DHK1=0.5D0*((DP(4,5)+DHKC)/DHKS-1D0) | |
47129 | DHK2=0.5D0*((DP(3,5)+DHKC)/DHKS-1D0) | |
47130 | IN1=N+NR+4*IS-3 | |
47131 | P(IN1,5)=SQRT(DP(3,5)+2D0*DHKC+DP(4,5)) | |
47132 | DO 340 J=1,4 | |
47133 | P(IN1,J)=(1D0+DHK1)*DP(1,J)-DHK2*DP(2,J) | |
47134 | P(IN1+1,J)=(1D0+DHK2)*DP(2,J)-DHK1*DP(1,J) | |
47135 | 340 CONTINUE | |
47136 | 350 CONTINUE | |
47137 | ||
47138 | C...Junction strings: initialize flavour, momentum and starting pos. | |
47139 | ISAV=I | |
47140 | MSTU91=MSTU(90) | |
47141 | 360 NTRY=NTRY+1 | |
47142 | IF(NTRY.GT.100.AND.NTRYR.LE.8) THEN | |
47143 | PARU12=4D0*PARU12 | |
47144 | PARU13=2D0*PARU13 | |
47145 | GOTO 140 | |
47146 | ELSEIF(NTRY.GT.100) THEN | |
47147 | CALL PYERRM(14,'(PYSTRF:) caught in infinite loop') | |
47148 | IF(MSTU(21).GE.1) RETURN | |
47149 | ENDIF | |
47150 | I=ISAV | |
47151 | MSTU(90)=MSTU91 | |
47152 | IRANKJ=0 | |
47153 | IE(1)=K(N+1+(JT/2)*(NP-1),3) | |
47154 | IN(4)=N+NR+1 | |
47155 | IN(5)=IN(4)+1 | |
47156 | IN(6)=N+NR+4*NS+1 | |
47157 | DO 380 JQ=1,2 | |
47158 | DO 370 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4 | |
47159 | P(IN1,1)=2-JQ | |
47160 | P(IN1,2)=JQ-1 | |
47161 | P(IN1,3)=1D0 | |
47162 | 370 CONTINUE | |
47163 | 380 CONTINUE | |
47164 | KFL(1)=K(IJU(IU),2) | |
47165 | PX(1)=0D0 | |
47166 | PY(1)=0D0 | |
47167 | GAM(1)=0D0 | |
47168 | DO 390 J=1,5 | |
47169 | PJU(IU+3,J)=0D0 | |
47170 | 390 CONTINUE | |
47171 | ||
47172 | C...Junction strings: find initial transverse directions. | |
47173 | DO 400 J=1,4 | |
47174 | DP(1,J)=P(IN(4),J) | |
47175 | DP(2,J)=P(IN(4)+1,J) | |
47176 | DP(3,J)=0D0 | |
47177 | DP(4,J)=0D0 | |
47178 | 400 CONTINUE | |
47179 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
47180 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
47181 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
47182 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
47183 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
47184 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1D0 | |
47185 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 | |
47186 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 | |
47187 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 | |
47188 | DHC12=DFOUR(1,2) | |
47189 | DHCX1=DFOUR(3,1)/DHC12 | |
47190 | DHCX2=DFOUR(3,2)/DHC12 | |
47191 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
47192 | DHCY1=DFOUR(4,1)/DHC12 | |
47193 | DHCY2=DFOUR(4,2)/DHC12 | |
47194 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
47195 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
47196 | DO 410 J=1,4 | |
47197 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
47198 | P(IN(6),J)=DP(3,J) | |
47199 | P(IN(6)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
47200 | & DHCYX*DP(3,J)) | |
47201 | 410 CONTINUE | |
47202 | ||
47203 | C...Junction strings: produce new particle, origin. | |
47204 | 420 I=I+1 | |
47205 | IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN | |
47206 | CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS') | |
47207 | IF(MSTU(21).GE.1) RETURN | |
47208 | ENDIF | |
47209 | IRANKJ=IRANKJ+1 | |
47210 | K(I,1)=1 | |
47211 | K(I,3)=IE(1) | |
47212 | K(I,4)=0 | |
47213 | K(I,5)=0 | |
47214 | ||
47215 | C...Junction strings: generate flavour, hadron, pT, z and Gamma. | |
47216 | 430 CALL PYKFDI(KFL(1),0,KFL(3),K(I,2)) | |
47217 | IF(K(I,2).EQ.0) GOTO 360 | |
47218 | IF(IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND. | |
47219 | & IABS(KFL(3)).GT.10) THEN | |
47220 | IF(PYR(0).GT.PARJ(19)) GOTO 430 | |
47221 | ENDIF | |
47222 | P(I,5)=PYMASS(K(I,2)) | |
47223 | CALL PYPTDI(KFL(1),PX(3),PY(3)) | |
47224 | PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2 | |
47225 | CALL PYZDIS(KFL(1),KFL(3),PR(1),Z) | |
47226 | IF(IABS(KFL(1)).GE.4.AND.IABS(KFL(1)).LE.8.AND. | |
47227 | & MSTU(90).LT.8) THEN | |
47228 | MSTU(90)=MSTU(90)+1 | |
47229 | MSTU(90+MSTU(90))=I | |
47230 | PARU(90+MSTU(90))=Z | |
47231 | ENDIF | |
47232 | GAM(3)=(1D0-Z)*(GAM(1)+PR(1)/Z) | |
47233 | DO 440 J=1,3 | |
47234 | IN(J)=IN(3+J) | |
47235 | 440 CONTINUE | |
47236 | ||
47237 | C...Junction strings: stepping within 'low' string region. | |
47238 | IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* | |
47239 | & P(IN(1),5)**2.GE.PR(1)) THEN | |
47240 | P(IN(1)+2,4)=Z*P(IN(1)+2,3) | |
47241 | P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2) | |
47242 | DO 450 J=1,4 | |
47243 | P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J) | |
47244 | 450 CONTINUE | |
47245 | GOTO 550 | |
47246 | C...Has used up energy of junction string, i.e. no more hadrons in it. | |
47247 | ELSEIF(IN(1)+1.EQ.IN(2).AND.IN(1).EQ.N+NR+4*NS-3) THEN | |
47248 | DO 460 J=1,5 | |
47249 | P(I,J)=0D0 | |
47250 | 460 CONTINUE | |
47251 | GOTO 590 | |
47252 | C...Stepping from 'low' string region | |
47253 | ELSEIF(IN(1)+1.EQ.IN(2)) THEN | |
47254 | P(IN(2)+2,4)=P(IN(2)+2,3) | |
47255 | P(IN(2)+2,1)=1D0 | |
47256 | IN(2)=IN(2)+4 | |
47257 | IF(IN(2).GT.N+NR+4*NS) GOTO 360 | |
47258 | IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN | |
47259 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
47260 | P(IN(1)+2,1)=0D0 | |
47261 | IN(1)=IN(1)+4 | |
47262 | ENDIF | |
47263 | ENDIF | |
47264 | ||
47265 | C...Junction strings: find new transverse directions. | |
47266 | 470 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR. | |
47267 | & IN(1).GT.IN(2)) GOTO 360 | |
47268 | IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN | |
47269 | DO 480 J=1,4 | |
47270 | DP(1,J)=P(IN(1),J) | |
47271 | DP(2,J)=P(IN(2),J) | |
47272 | DP(3,J)=0D0 | |
47273 | DP(4,J)=0D0 | |
47274 | 480 CONTINUE | |
47275 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
47276 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
47277 | DHC12=DFOUR(1,2) | |
47278 | IF(DHC12.LE.1D-2) THEN | |
47279 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
47280 | P(IN(1)+2,1)=0D0 | |
47281 | IN(1)=IN(1)+4 | |
47282 | GOTO 470 | |
47283 | ENDIF | |
47284 | IN(3)=N+NR+4*NS+5 | |
47285 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
47286 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
47287 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
47288 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1D0 | |
47289 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 | |
47290 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 | |
47291 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 | |
47292 | DHCX1=DFOUR(3,1)/DHC12 | |
47293 | DHCX2=DFOUR(3,2)/DHC12 | |
47294 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
47295 | DHCY1=DFOUR(4,1)/DHC12 | |
47296 | DHCY2=DFOUR(4,2)/DHC12 | |
47297 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
47298 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
47299 | DO 490 J=1,4 | |
47300 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
47301 | P(IN(3),J)=DP(3,J) | |
47302 | P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
47303 | & DHCYX*DP(3,J)) | |
47304 | 490 CONTINUE | |
47305 | C...Express pT with respect to new axes, if sensible. | |
47306 | PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3))) | |
47307 | PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1)) | |
47308 | IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01D0) THEN | |
47309 | PX(3)=PXP | |
47310 | PY(3)=PYP | |
47311 | ENDIF | |
47312 | ENDIF | |
47313 | ||
47314 | C...Junction strings: sum up known four-momentum, coefficients for m2. | |
47315 | DO 520 J=1,4 | |
47316 | DHG(J)=0D0 | |
47317 | P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+ | |
47318 | & PY(3)*P(IN(3)+1,J) | |
47319 | DO 500 IN1=IN(4),IN(1)-4,4 | |
47320 | P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) | |
47321 | 500 CONTINUE | |
47322 | DO 510 IN2=IN(5),IN(2)-4,4 | |
47323 | P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) | |
47324 | 510 CONTINUE | |
47325 | 520 CONTINUE | |
47326 | DHM(1)=FOUR(I,I) | |
47327 | DHM(2)=2D0*FOUR(I,IN(1)) | |
47328 | DHM(3)=2D0*FOUR(I,IN(2)) | |
47329 | DHM(4)=2D0*FOUR(IN(1),IN(2)) | |
47330 | ||
47331 | C...Junction strings: find coefficients for Gamma expression. | |
47332 | DO 540 IN2=IN(1)+1,IN(2),4 | |
47333 | DO 530 IN1=IN(1),IN2-1,4 | |
47334 | DHC=2D0*FOUR(IN1,IN2) | |
47335 | DHG(1)=DHG(1)+P(IN1+2,1)*P(IN2+2,1)*DHC | |
47336 | IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-P(IN2+2,1)*DHC | |
47337 | IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+P(IN1+2,1)*DHC | |
47338 | IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC | |
47339 | 530 CONTINUE | |
47340 | 540 CONTINUE | |
47341 | ||
47342 | C...Junction strings: solve (m2, Gamma) equation system for energies. | |
47343 | DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3) | |
47344 | IF(ABS(DHS1).LT.1D-4) GOTO 360 | |
47345 | DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(2)*DHG(3)-DHG(4)* | |
47346 | & (P(I,5)**2-DHM(1))+DHG(2)*DHM(3) | |
47347 | DHS3=DHM(2)*(GAM(3)-DHG(1))-DHG(2)*(P(I,5)**2-DHM(1)) | |
47348 | P(IN(2)+2,4)=0.5D0*(SQRT(MAX(0D0,DHS2**2-4D0*DHS1*DHS3))/ | |
47349 | & ABS(DHS1)-DHS2/DHS1) | |
47350 | IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0D0) GOTO 360 | |
47351 | P(IN(1)+2,4)=(P(I,5)**2-DHM(1)-DHM(3)*P(IN(2)+2,4))/ | |
47352 | & (DHM(2)+DHM(4)*P(IN(2)+2,4)) | |
47353 | ||
47354 | C...Junction strings: step to new region if necessary. | |
47355 | IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN | |
47356 | P(IN(2)+2,4)=P(IN(2)+2,3) | |
47357 | P(IN(2)+2,1)=1D0 | |
47358 | IN(2)=IN(2)+4 | |
47359 | IF(IN(2).GT.N+NR+4*NS) GOTO 360 | |
47360 | IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN | |
47361 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
47362 | P(IN(1)+2,1)=0D0 | |
47363 | IN(1)=IN(1)+4 | |
47364 | ENDIF | |
47365 | GOTO 470 | |
47366 | ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN | |
47367 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
47368 | P(IN(1)+2,1)=0D0 | |
47369 | IN(1)=IN(1)+4 | |
47370 | GOTO 470 | |
47371 | ENDIF | |
47372 | ||
47373 | C...Junction strings: particle four-momentum, remainder, loop back. | |
47374 | 550 DO 560 J=1,4 | |
47375 | P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+ | |
47376 | & P(IN(2)+2,4)*P(IN(2),J) | |
47377 | PJU(IU+3,J)=PJU(IU+3,J)+P(I,J) | |
47378 | 560 CONTINUE | |
47379 | IF(P(I,4).LT.P(I,5)) GOTO 360 | |
47380 | PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)- | |
47381 | & TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3) | |
47382 | IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN | |
47383 | KFL(1)=-KFL(3) | |
47384 | PX(1)=-PX(3) | |
47385 | PY(1)=-PY(3) | |
47386 | GAM(1)=GAM(3) | |
47387 | IF(IN(3).NE.IN(6)) THEN | |
47388 | DO 570 J=1,4 | |
47389 | P(IN(6),J)=P(IN(3),J) | |
47390 | P(IN(6)+1,J)=P(IN(3)+1,J) | |
47391 | 570 CONTINUE | |
47392 | ENDIF | |
47393 | DO 580 JQ=1,2 | |
47394 | IN(3+JQ)=IN(JQ) | |
47395 | P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) | |
47396 | P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4) | |
47397 | 580 CONTINUE | |
47398 | GOTO 420 | |
47399 | ENDIF | |
47400 | ||
47401 | C...Junction strings: save quantities left after each string. | |
47402 | IF(IABS(KFL(1)).GT.10) GOTO 360 | |
47403 | 590 I=I-1 | |
47404 | KFJH(IU)=KFL(1) | |
47405 | DO 600 J=1,4 | |
47406 | PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J) | |
47407 | 600 CONTINUE | |
47408 | ||
47409 | C...Junction strings: loopback if much unused energy in both strings. | |
47410 | PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)- | |
47411 | & TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3) | |
47412 | EJSTR(IU)=PJU(IU,5)-PJU(IU+3,5) | |
47413 | 610 CONTINUE | |
47414 | IF((MIN(EJSTR(1),EJSTR(2)).GT.PARJ(49).OR. | |
47415 | & EJSTR(1).GT.PARJ(49)+PYR(0)*PARJ(50).OR. | |
47416 | & EJSTR(2).GT.PARJ(49)+PYR(0)*PARJ(50)) | |
47417 | & .AND.NTRYER.LT.10) GOTO 320 | |
47418 | ||
47419 | C...Junction strings: put together to new effective string endpoint. | |
47420 | NJS(JT)=I-ISTA | |
47421 | KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1 | |
47422 | IF(KFJH(1).EQ.KFJH(2)) KFLS=3 | |
47423 | KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)),IABS(KFJH(2)))+ | |
47424 | & 100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+KFLS,KFJH(1)) | |
47425 | DO 620 J=1,4 | |
47426 | PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J) | |
47427 | PJS(JT+2,J)=PJU(4,J)+PJU(5,J) | |
47428 | 620 CONTINUE | |
47429 | PJS(JT,5)=SQRT(MAX(0D0,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2- | |
47430 | & PJS(JT,3)**2)) | |
47431 | PJS(JT+2,5)=0D0 | |
47432 | 630 CONTINUE | |
47433 | ||
47434 | C...Open versus closed strings. Choose breakup region for latter. | |
47435 | 640 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN | |
47436 | NS=MJU(2)-MJU(1) | |
47437 | NB=MJU(1)-N | |
47438 | ELSEIF(MJU(1).NE.0) THEN | |
47439 | NS=N+NR-MJU(1) | |
47440 | NB=MJU(1)-N | |
47441 | ELSEIF(MJU(2).NE.0) THEN | |
47442 | NS=MJU(2)-N | |
47443 | NB=1 | |
47444 | ELSEIF(IABS(K(N+1,2)).NE.21) THEN | |
47445 | NS=NR-1 | |
47446 | NB=1 | |
47447 | ELSE | |
47448 | NS=NR+1 | |
47449 | W2SUM=0D0 | |
47450 | DO 650 IS=1,NR | |
47451 | P(N+NR+IS,1)=0.5D0*FOUR(N+IS,N+IS+1-NR*(IS/NR)) | |
47452 | W2SUM=W2SUM+P(N+NR+IS,1) | |
47453 | 650 CONTINUE | |
47454 | W2RAN=PYR(0)*W2SUM | |
47455 | NB=0 | |
47456 | 660 NB=NB+1 | |
47457 | W2SUM=W2SUM-P(N+NR+NB,1) | |
47458 | IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 660 | |
47459 | ENDIF | |
47460 | ||
47461 | C...Find longitudinal string directions (i.e. lightlike four-vectors). | |
47462 | DO 690 IS=1,NS | |
47463 | IS1=N+IS+NB-1-NR*((IS+NB-2)/NR) | |
47464 | IS2=N+IS+NB-NR*((IS+NB-1)/NR) | |
47465 | DO 670 J=1,5 | |
47466 | DP(1,J)=P(IS1,J) | |
47467 | IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5D0*DP(1,J) | |
47468 | IF(IS1.EQ.MJU(1)) DP(1,J)=PJS(1,J)-PJS(3,J) | |
47469 | DP(2,J)=P(IS2,J) | |
47470 | IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5D0*DP(2,J) | |
47471 | IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J) | |
47472 | 670 CONTINUE | |
47473 | IF(IS1.EQ.MJU(1)) DP(1,5)=SQRT(MAX(0D0,DP(1,4)**2-DP(1,1)**2- | |
47474 | & DP(1,2)**2-DP(1,3)**2)) | |
47475 | IF(IS2.EQ.MJU(2)) DP(2,5)=SQRT(MAX(0D0,DP(2,4)**2-DP(2,1)**2- | |
47476 | & DP(2,2)**2-DP(2,3)**2)) | |
47477 | DP(3,5)=DFOUR(1,1) | |
47478 | DP(4,5)=DFOUR(2,2) | |
47479 | DHKC=DFOUR(1,2) | |
47480 | IF(DP(3,5)+2D0*DHKC+DP(4,5).LE.0D0) GOTO 200 | |
47481 | DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) | |
47482 | DHK1=0.5D0*((DP(4,5)+DHKC)/DHKS-1D0) | |
47483 | DHK2=0.5D0*((DP(3,5)+DHKC)/DHKS-1D0) | |
47484 | IN1=N+NR+4*IS-3 | |
47485 | P(IN1,5)=SQRT(DP(3,5)+2D0*DHKC+DP(4,5)) | |
47486 | DO 680 J=1,4 | |
47487 | P(IN1,J)=(1D0+DHK1)*DP(1,J)-DHK2*DP(2,J) | |
47488 | P(IN1+1,J)=(1D0+DHK2)*DP(2,J)-DHK1*DP(1,J) | |
47489 | 680 CONTINUE | |
47490 | 690 CONTINUE | |
47491 | ||
47492 | C...Begin initialization: sum up energy, set starting position. | |
47493 | ISAV=I | |
47494 | MSTU91=MSTU(90) | |
47495 | 700 NTRY=NTRY+1 | |
47496 | IF(NTRY.GT.100.AND.NTRYR.LE.8) THEN | |
47497 | PARU12=4D0*PARU12 | |
47498 | PARU13=2D0*PARU13 | |
47499 | GOTO 140 | |
47500 | ELSEIF(NTRY.GT.100) THEN | |
47501 | CALL PYERRM(14,'(PYSTRF:) caught in infinite loop') | |
47502 | IF(MSTU(21).GE.1) RETURN | |
47503 | ENDIF | |
47504 | I=ISAV | |
47505 | MSTU(90)=MSTU91 | |
47506 | DO 720 J=1,4 | |
47507 | P(N+NRS,J)=0D0 | |
47508 | DO 710 IS=1,NR | |
47509 | P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J) | |
47510 | 710 CONTINUE | |
47511 | 720 CONTINUE | |
47512 | DO 740 JT=1,2 | |
47513 | IRANK(JT)=0 | |
47514 | IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT) | |
47515 | IF(NS.GT.NR) IRANK(JT)=1 | |
47516 | IBARRK(JT)=0 | |
47517 | IE(JT)=K(N+1+(JT/2)*(NP-1),3) | |
47518 | IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1) | |
47519 | IN(3*JT+2)=IN(3*JT+1)+1 | |
47520 | IN(3*JT+3)=N+NR+4*NS+2*JT-1 | |
47521 | DO 730 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4 | |
47522 | P(IN1,1)=2-JT | |
47523 | P(IN1,2)=JT-1 | |
47524 | P(IN1,3)=1D0 | |
47525 | 730 CONTINUE | |
47526 | 740 CONTINUE | |
47527 | ||
47528 | C.. MOPS variables and switches | |
47529 | NRVMO=0 | |
47530 | XBMO=1D0 | |
47531 | MSTU(121)=0 | |
47532 | MSTU(122)=0 | |
47533 | ||
47534 | C...Initialize flavour and pT variables for open string. | |
47535 | IF(NS.LT.NR) THEN | |
47536 | PX(1)=0D0 | |
47537 | PY(1)=0D0 | |
47538 | IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL PYPTDI(0,PX(1),PY(1)) | |
47539 | PX(2)=-PX(1) | |
47540 | PY(2)=-PY(1) | |
47541 | DO 750 JT=1,2 | |
47542 | KFL(JT)=K(IE(JT),2) | |
47543 | IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT) | |
47544 | IF(MJU(JT).NE.0.AND.IABS(KFL(JT)).GT.1000) IBARRK(JT)=1 | |
47545 | MSTJ(93)=1 | |
47546 | PMQ(JT)=PYMASS(KFL(JT)) | |
47547 | GAM(JT)=0D0 | |
47548 | 750 CONTINUE | |
47549 | ||
47550 | C...Closed string: random initial breakup flavour, pT and vertex. | |
47551 | ELSE | |
47552 | KFL(3)=INT(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0) | |
47553 | IBMO=0 | |
47554 | 760 CALL PYKFDI(KFL(3),0,KFL(1),KDUMP) | |
47555 | C.. Closed string: first vertex diq attempt => enforced second | |
47556 | C.. vertex diq | |
47557 | IF(IABS(KFL(1)).GT.10)THEN | |
47558 | IBMO=1 | |
47559 | MSTU(121)=0 | |
47560 | GOTO 760 | |
47561 | ENDIF | |
47562 | IF(IBMO.EQ.1) MSTU(121)=-1 | |
47563 | KFL(2)=-KFL(1) | |
47564 | CALL PYPTDI(KFL(1),PX(1),PY(1)) | |
47565 | PX(2)=-PX(1) | |
47566 | PY(2)=-PY(1) | |
47567 | PR3=MIN(25D0,0.1D0*P(N+NR+1,5)**2) | |
47568 | 770 CALL PYZDIS(KFL(1),KFL(2),PR3,Z) | |
47569 | ZR=PR3/(Z*P(N+NR+1,5)**2) | |
47570 | IF(ZR.GE.1D0) GOTO 770 | |
47571 | DO 780 JT=1,2 | |
47572 | MSTJ(93)=1 | |
47573 | PMQ(JT)=PYMASS(KFL(JT)) | |
47574 | GAM(JT)=PR3*(1D0-Z)/Z | |
47575 | IN1=N+NR+3+4*(JT/2)*(NS-1) | |
47576 | P(IN1,JT)=1D0-Z | |
47577 | P(IN1,3-JT)=JT-1 | |
47578 | P(IN1,3)=(2-JT)*(1D0-Z)+(JT-1)*Z | |
47579 | P(IN1+1,JT)=ZR | |
47580 | P(IN1+1,3-JT)=2-JT | |
47581 | P(IN1+1,3)=(2-JT)*(1D0-ZR)+(JT-1)*ZR | |
47582 | 780 CONTINUE | |
47583 | ENDIF | |
47584 | C.. MOPS variables | |
47585 | DO 790 JT=1,2 | |
47586 | XTMO(JT)=1D0 | |
47587 | PM2QMO(JT)=PMQ(JT)**2 | |
47588 | IF(IABS(KFL(JT)).GT.10) PM2QMO(JT)=0D0 | |
47589 | 790 CONTINUE | |
47590 | ||
47591 | C...Find initial transverse directions (i.e. spacelike four-vectors). | |
47592 | DO 830 JT=1,2 | |
47593 | IF(JT.EQ.1.OR.NS.EQ.NR-1.OR.MJU(1)+MJU(2).NE.0) THEN | |
47594 | IN1=IN(3*JT+1) | |
47595 | IN3=IN(3*JT+3) | |
47596 | DO 800 J=1,4 | |
47597 | DP(1,J)=P(IN1,J) | |
47598 | DP(2,J)=P(IN1+1,J) | |
47599 | DP(3,J)=0D0 | |
47600 | DP(4,J)=0D0 | |
47601 | 800 CONTINUE | |
47602 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
47603 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
47604 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
47605 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
47606 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
47607 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1D0 | |
47608 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 | |
47609 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 | |
47610 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 | |
47611 | DHC12=DFOUR(1,2) | |
47612 | DHCX1=DFOUR(3,1)/DHC12 | |
47613 | DHCX2=DFOUR(3,2)/DHC12 | |
47614 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
47615 | DHCY1=DFOUR(4,1)/DHC12 | |
47616 | DHCY2=DFOUR(4,2)/DHC12 | |
47617 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
47618 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
47619 | DO 810 J=1,4 | |
47620 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
47621 | P(IN3,J)=DP(3,J) | |
47622 | P(IN3+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
47623 | & DHCYX*DP(3,J)) | |
47624 | 810 CONTINUE | |
47625 | ELSE | |
47626 | DO 820 J=1,4 | |
47627 | P(IN3+2,J)=P(IN3,J) | |
47628 | P(IN3+3,J)=P(IN3+1,J) | |
47629 | 820 CONTINUE | |
47630 | ENDIF | |
47631 | 830 CONTINUE | |
47632 | ||
47633 | C...Remove energy used up in junction string fragmentation. | |
47634 | IF(MJU(1)+MJU(2).GT.0) THEN | |
47635 | DO 850 JT=1,2 | |
47636 | IF(NJS(JT).EQ.0) GOTO 850 | |
47637 | DO 840 J=1,4 | |
47638 | P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J) | |
47639 | 840 CONTINUE | |
47640 | 850 CONTINUE | |
47641 | PARJST=PARJ(33) | |
47642 | IF(MSTJ(11).EQ.2) PARJST=PARJ(34) | |
47643 | WMIN=PARJST+PMQ(1)+PMQ(2) | |
47644 | WREM2=FOUR(N+NRS,N+NRS) | |
47645 | IF(P(N+NRS,4).LT.0D0.OR.WREM2.LT.WMIN**2) THEN | |
47646 | NTRYWR=NTRYWR+1 | |
47647 | IF(MOD(NTRYWR,20).NE.0) NTRYR=NTRYR-1 | |
47648 | GOTO 140 | |
47649 | ENDIF | |
47650 | ENDIF | |
47651 | ||
47652 | C...Produce new particle: side, origin. | |
47653 | 860 I=I+1 | |
47654 | IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN | |
47655 | CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS') | |
47656 | IF(MSTU(21).GE.1) RETURN | |
47657 | ENDIF | |
47658 | C.. New side priority for popcorn systems | |
47659 | IF(MSTU(121).LE.0)THEN | |
47660 | JT=1.5D0+PYR(0) | |
47661 | IF(IABS(KFL(3-JT)).GT.10) JT=3-JT | |
47662 | IF(IABS(KFL(3-JT)).GE.4.AND.IABS(KFL(3-JT)).LE.8) JT=3-JT | |
47663 | ENDIF | |
47664 | JR=3-JT | |
47665 | JS=3-2*JT | |
47666 | IRANK(JT)=IRANK(JT)+1 | |
47667 | K(I,1)=1 | |
47668 | K(I,4)=0 | |
47669 | K(I,5)=0 | |
47670 | ||
47671 | C...Generate flavour, hadron and pT. | |
47672 | 870 K(I,3)=IE(JT) | |
47673 | CALL PYKFDI(KFL(JT),0,KFL(3),K(I,2)) | |
47674 | IF(K(I,2).EQ.0) GOTO 700 | |
47675 | MU90MO=MSTU(90) | |
47676 | IF(MSTU(121).EQ.-1) GOTO 900 | |
47677 | IF(IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND. | |
47678 | &IABS(KFL(3)).GT.10) THEN | |
47679 | IF(PYR(0).GT.PARJ(19)) GOTO 870 | |
47680 | ENDIF | |
47681 | IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) | |
47682 | &K(I,3)=IJUORI(JT) | |
47683 | P(I,5)=PYMASS(K(I,2)) | |
47684 | CALL PYPTDI(KFL(JT),PX(3),PY(3)) | |
47685 | PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2 | |
47686 | ||
47687 | C...Final hadrons for small invariant mass. | |
47688 | MSTJ(93)=1 | |
47689 | PMQ(3)=PYMASS(KFL(3)) | |
47690 | PARJST=PARJ(33) | |
47691 | IF(MSTJ(11).EQ.2) PARJST=PARJ(34) | |
47692 | WMIN=PARJST+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3) | |
47693 | IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN= | |
47694 | &WMIN-0.5D0*PARJ(36)*PMQ(3) | |
47695 | WREM2=FOUR(N+NRS,N+NRS) | |
47696 | IF(WREM2.LT.0.10D0) GOTO 700 | |
47697 | IF(WREM2.LT.MAX(WMIN*(1D0+(2D0*PYR(0)-1D0)*PARJ(37)), | |
47698 | &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 1070 | |
47699 | ||
47700 | C...Choose z, which gives Gamma. Shift z for heavy flavours. | |
47701 | CALL PYZDIS(KFL(JT),KFL(3),PR(JT),Z) | |
47702 | IF(IABS(KFL(JT)).GE.4.AND.IABS(KFL(JT)).LE.8.AND. | |
47703 | &MSTU(90).LT.8) THEN | |
47704 | MSTU(90)=MSTU(90)+1 | |
47705 | MSTU(90+MSTU(90))=I | |
47706 | PARU(90+MSTU(90))=Z | |
47707 | ENDIF | |
47708 | KFL1A=IABS(KFL(1)) | |
47709 | KFL2A=IABS(KFL(2)) | |
47710 | IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), | |
47711 | &MOD(KFL2A/1000,10)).GE.4) THEN | |
47712 | PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 | |
47713 | PW12=SQRT(MAX(0D0,(WREM2-PR(1)-PR(2))**2-4D0*PR(1)*PR(2))) | |
47714 | Z=(WREM2+PR(JT)-PR(JR)+PW12*(2D0*Z-1D0))/(2D0*WREM2) | |
47715 | PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 | |
47716 | IF((1D0-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 1070 | |
47717 | ENDIF | |
47718 | GAM(3)=(1D0-Z)*(GAM(JT)+PR(JT)/Z) | |
47719 | ||
47720 | C.. MOPS baryon model modification | |
47721 | XTMO3=(1D0-Z)*XTMO(JT) | |
47722 | IF(IABS(KFL(3)).LE.10) NRVMO=0 | |
47723 | IF(IABS(KFL(3)).GT.10.AND.MSTJ(12).GE.4) THEN | |
47724 | GTSTMO=1D0 | |
47725 | PTSTMO=1D0 | |
47726 | RTSTMO=PYR(0) | |
47727 | IF(IABS(KFL(JT)).LE.10)THEN | |
47728 | XBMO=MIN(XTMO3,1D0-(2D-10)) | |
47729 | GBMO=GAM(3) | |
47730 | PMMO=0D0 | |
47731 | PGMO=GBMO+LOG(1D0-XBMO)*PM2QMO(JT) | |
47732 | GTSTMO=1D0-PARF(192)**PGMO | |
47733 | ELSE | |
47734 | IF(IRANK(JT).EQ.1) THEN | |
47735 | GBMO=GAM(JT) | |
47736 | PMMO=0D0 | |
47737 | XBMO=1D0 | |
47738 | ENDIF | |
47739 | IF(XBMO.LT.1D0-(1D-10))THEN | |
47740 | PGNMO=GBMO*XTMO3/XBMO+PM2QMO(JT)*LOG(1D0-XTMO3) | |
47741 | GTSTMO=(1D0-PARF(192)**PGNMO)/(1D0-PARF(192)**PGMO) | |
47742 | PGMO=PGNMO | |
47743 | ENDIF | |
47744 | IF(MSTJ(12).GE.5)THEN | |
47745 | PMNMO=SQRT((XBMO-XTMO3)*(GAM(3)/XTMO3-GBMO/XBMO)) | |
47746 | PMMO=PMMO+PMAS(PYCOMP(K(I,2)),1)-PMAS(PYCOMP(K(I,2)),3) | |
47747 | PTSTMO=EXP((PMMO-PMNMO)*PARF(193)) | |
47748 | PMMO=PMNMO | |
47749 | ENDIF | |
47750 | ENDIF | |
47751 | ||
47752 | C.. MOPS Accepting popcorn system hadron. | |
47753 | IF(PTSTMO*GTSTMO.GT.RTSTMO) THEN | |
47754 | IF(IRANK(JT).EQ.1.OR.IABS(KFL(JT)).LE.10) THEN | |
47755 | NRVMO=I-N-NR | |
47756 | IF(I+NRVMO.GT.MSTU(4)-MSTU(32)-5) THEN | |
47757 | CALL PYERRM(11, | |
47758 | & '(PYSTRF:) no more memory left in PYJETS') | |
47759 | IF(MSTU(21).GE.1) RETURN | |
47760 | ENDIF | |
47761 | IMO=I | |
47762 | KFLMO=KFL(JT) | |
47763 | PMQMO=PMQ(JT) | |
47764 | PXMO=PX(JT) | |
47765 | PYMO=PY(JT) | |
47766 | GAMMO=GAM(JT) | |
47767 | IRMO=IRANK(JT) | |
47768 | XMO=XTMO(JT) | |
47769 | DO 890 J=1,9 | |
47770 | IF(J.LE.5) THEN | |
47771 | DO 880 LINE=1,I-N-NR | |
47772 | P(MSTU(4)-MSTU(32)-LINE,J)=P(N+NR+LINE,J) | |
47773 | K(MSTU(4)-MSTU(32)-LINE,J)=K(N+NR+LINE,J) | |
47774 | 880 CONTINUE | |
47775 | ENDIF | |
47776 | INMO(J)=IN(J) | |
47777 | 890 CONTINUE | |
47778 | ENDIF | |
47779 | ELSE | |
47780 | C..Reject popcorn system, flag=-1 if enforcing new one | |
47781 | MSTU(121)=-1 | |
47782 | IF(PTSTMO.GT.RTSTMO) MSTU(121)=-2 | |
47783 | ENDIF | |
47784 | ENDIF | |
47785 | ||
47786 | ||
47787 | C..Lift restoring string outside MOPS block | |
47788 | 900 IF(MSTU(121).LT.0) THEN | |
47789 | IF(MSTU(121).EQ.-2) MSTU(121)=0 | |
47790 | MSTU(90)=MU90MO | |
47791 | NRVMO=0 | |
47792 | IF(IRANK(JT).EQ.1.OR.IABS(KFL(JT)).LE.10) GOTO 870 | |
47793 | I=IMO | |
47794 | KFL(JT)=KFLMO | |
47795 | PMQ(JT)=PMQMO | |
47796 | PX(JT)=PXMO | |
47797 | PY(JT)=PYMO | |
47798 | GAM(JT)=GAMMO | |
47799 | IRANK(JT)=IRMO | |
47800 | XTMO(JT)=XMO | |
47801 | DO 920 J=1,9 | |
47802 | IF(J.LE.5) THEN | |
47803 | DO 910 LINE=1,I-N-NR | |
47804 | P(N+NR+LINE,J)=P(MSTU(4)-MSTU(32)-LINE,J) | |
47805 | K(N+NR+LINE,J)=K(MSTU(4)-MSTU(32)-LINE,J) | |
47806 | 910 CONTINUE | |
47807 | ENDIF | |
47808 | IN(J)=INMO(J) | |
47809 | 920 CONTINUE | |
47810 | GOTO 870 | |
47811 | ENDIF | |
47812 | XTMO(JT)=XTMO3 | |
47813 | C.. MOPS end of modification | |
47814 | ||
47815 | DO 930 J=1,3 | |
47816 | IN(J)=IN(3*JT+J) | |
47817 | 930 CONTINUE | |
47818 | ||
47819 | C...Stepping within or from 'low' string region easy. | |
47820 | IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* | |
47821 | &P(IN(1),5)**2.GE.PR(JT)) THEN | |
47822 | P(IN(JT)+2,4)=Z*P(IN(JT)+2,3) | |
47823 | P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2) | |
47824 | DO 940 J=1,4 | |
47825 | P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J) | |
47826 | 940 CONTINUE | |
47827 | GOTO 1030 | |
47828 | ELSEIF(IN(1)+1.EQ.IN(2)) THEN | |
47829 | P(IN(JR)+2,4)=P(IN(JR)+2,3) | |
47830 | P(IN(JR)+2,JT)=1D0 | |
47831 | IN(JR)=IN(JR)+4*JS | |
47832 | IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 700 | |
47833 | IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN | |
47834 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
47835 | P(IN(JT)+2,JT)=0D0 | |
47836 | IN(JT)=IN(JT)+4*JS | |
47837 | ENDIF | |
47838 | ENDIF | |
47839 | ||
47840 | C...Find new transverse directions (i.e. spacelike string vectors). | |
47841 | 950 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR. | |
47842 | &IN(1).GT.IN(2)) GOTO 700 | |
47843 | IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN | |
47844 | DO 960 J=1,4 | |
47845 | DP(1,J)=P(IN(1),J) | |
47846 | DP(2,J)=P(IN(2),J) | |
47847 | DP(3,J)=0D0 | |
47848 | DP(4,J)=0D0 | |
47849 | 960 CONTINUE | |
47850 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
47851 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
47852 | DHC12=DFOUR(1,2) | |
47853 | IF(DHC12.LE.1D-2) THEN | |
47854 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
47855 | P(IN(JT)+2,JT)=0D0 | |
47856 | IN(JT)=IN(JT)+4*JS | |
47857 | GOTO 950 | |
47858 | ENDIF | |
47859 | IN(3)=N+NR+4*NS+5 | |
47860 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
47861 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
47862 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
47863 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1D0 | |
47864 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 | |
47865 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 | |
47866 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 | |
47867 | DHCX1=DFOUR(3,1)/DHC12 | |
47868 | DHCX2=DFOUR(3,2)/DHC12 | |
47869 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
47870 | DHCY1=DFOUR(4,1)/DHC12 | |
47871 | DHCY2=DFOUR(4,2)/DHC12 | |
47872 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
47873 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
47874 | DO 970 J=1,4 | |
47875 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
47876 | P(IN(3),J)=DP(3,J) | |
47877 | P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
47878 | & DHCYX*DP(3,J)) | |
47879 | 970 CONTINUE | |
47880 | C...Express pT with respect to new axes, if sensible. | |
47881 | PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)* | |
47882 | & FOUR(IN(3*JT+3)+1,IN(3))) | |
47883 | PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)* | |
47884 | & FOUR(IN(3*JT+3)+1,IN(3)+1)) | |
47885 | IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01D0) THEN | |
47886 | PX(3)=PXP | |
47887 | PY(3)=PYP | |
47888 | ENDIF | |
47889 | ENDIF | |
47890 | ||
47891 | C...Sum up known four-momentum. Gives coefficients for m2 expression. | |
47892 | DO 1000 J=1,4 | |
47893 | DHG(J)=0D0 | |
47894 | P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+ | |
47895 | & PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J) | |
47896 | DO 980 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS | |
47897 | P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) | |
47898 | 980 CONTINUE | |
47899 | DO 990 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS | |
47900 | P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) | |
47901 | 990 CONTINUE | |
47902 | 1000 CONTINUE | |
47903 | DHM(1)=FOUR(I,I) | |
47904 | DHM(2)=2D0*FOUR(I,IN(1)) | |
47905 | DHM(3)=2D0*FOUR(I,IN(2)) | |
47906 | DHM(4)=2D0*FOUR(IN(1),IN(2)) | |
47907 | ||
47908 | C...Find coefficients for Gamma expression. | |
47909 | DO 1020 IN2=IN(1)+1,IN(2),4 | |
47910 | DO 1010 IN1=IN(1),IN2-1,4 | |
47911 | DHC=2D0*FOUR(IN1,IN2) | |
47912 | DHG(1)=DHG(1)+P(IN1+2,JT)*P(IN2+2,JT)*DHC | |
47913 | IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-JS*P(IN2+2,JT)*DHC | |
47914 | IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+JS*P(IN1+2,JT)*DHC | |
47915 | IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC | |
47916 | 1010 CONTINUE | |
47917 | 1020 CONTINUE | |
47918 | ||
47919 | C...Solve (m2, Gamma) equation system for energies taken. | |
47920 | DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1) | |
47921 | IF(ABS(DHS1).LT.1D-4) GOTO 700 | |
47922 | DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)* | |
47923 | &(P(I,5)**2-DHM(1))+DHG(JT+1)*DHM(JR+1) | |
47924 | DHS3=DHM(JT+1)*(GAM(3)-DHG(1))-DHG(JT+1)*(P(I,5)**2-DHM(1)) | |
47925 | P(IN(JR)+2,4)=0.5D0*(SQRT(MAX(0D0,DHS2**2-4D0*DHS1*DHS3))/ | |
47926 | &ABS(DHS1)-DHS2/DHS1) | |
47927 | IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0D0) GOTO 700 | |
47928 | P(IN(JT)+2,4)=(P(I,5)**2-DHM(1)-DHM(JR+1)*P(IN(JR)+2,4))/ | |
47929 | &(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4)) | |
47930 | ||
47931 | C...Step to new region if necessary. | |
47932 | IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN | |
47933 | P(IN(JR)+2,4)=P(IN(JR)+2,3) | |
47934 | P(IN(JR)+2,JT)=1D0 | |
47935 | IN(JR)=IN(JR)+4*JS | |
47936 | IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 700 | |
47937 | IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN | |
47938 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
47939 | P(IN(JT)+2,JT)=0D0 | |
47940 | IN(JT)=IN(JT)+4*JS | |
47941 | ENDIF | |
47942 | GOTO 950 | |
47943 | ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN | |
47944 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
47945 | P(IN(JT)+2,JT)=0D0 | |
47946 | IN(JT)=IN(JT)+4*JS | |
47947 | GOTO 950 | |
47948 | ENDIF | |
47949 | ||
47950 | C...Four-momentum of particle. Remaining quantities. Loop back. | |
47951 | 1030 DO 1040 J=1,4 | |
47952 | P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) | |
47953 | P(N+NRS,J)=P(N+NRS,J)-P(I,J) | |
47954 | 1040 CONTINUE | |
47955 | IF(P(I,4).LT.P(I,5)) GOTO 700 | |
47956 | KFL(JT)=-KFL(3) | |
47957 | PMQ(JT)=PMQ(3) | |
47958 | PX(JT)=-PX(3) | |
47959 | PY(JT)=-PY(3) | |
47960 | GAM(JT)=GAM(3) | |
47961 | IF(IN(3).NE.IN(3*JT+3)) THEN | |
47962 | DO 1050 J=1,4 | |
47963 | P(IN(3*JT+3),J)=P(IN(3),J) | |
47964 | P(IN(3*JT+3)+1,J)=P(IN(3)+1,J) | |
47965 | 1050 CONTINUE | |
47966 | ENDIF | |
47967 | DO 1060 JQ=1,2 | |
47968 | IN(3*JT+JQ)=IN(JQ) | |
47969 | P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) | |
47970 | P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4) | |
47971 | 1060 CONTINUE | |
47972 | IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) | |
47973 | &IBARRK(JT)=0 | |
47974 | GOTO 860 | |
47975 | ||
47976 | C...Final hadron: side, flavour, hadron, mass. | |
47977 | 1070 I=I+1 | |
47978 | K(I,1)=1 | |
47979 | K(I,3)=IE(JR) | |
47980 | K(I,4)=0 | |
47981 | K(I,5)=0 | |
47982 | CALL PYKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2)) | |
47983 | IF(K(I,2).EQ.0) GOTO 700 | |
47984 | IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I-1,2)),10000).GT.1000) | |
47985 | &IBARRK(JT)=0 | |
47986 | IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) | |
47987 | &K(I,3)=IJUORI(JT) | |
47988 | IF(IBARRK(JR).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) | |
47989 | &K(I,3)=IJUORI(JR) | |
47990 | P(I,5)=PYMASS(K(I,2)) | |
47991 | PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 | |
47992 | ||
47993 | C...Final two hadrons: find common setup of four-vectors. | |
47994 | JQ=1 | |
47995 | IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT. | |
47996 | &P(IN(7)+2,3)*P(IN(8)+2,3)*FOUR(IN(7),IN(8))) JQ=2 | |
47997 | DHC12=FOUR(IN(3*JQ+1),IN(3*JQ+2)) | |
47998 | DHR1=FOUR(N+NRS,IN(3*JQ+2))/DHC12 | |
47999 | DHR2=FOUR(N+NRS,IN(3*JQ+1))/DHC12 | |
48000 | IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN | |
48001 | PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ) | |
48002 | PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ) | |
48003 | PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS* | |
48004 | & PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2 | |
48005 | ENDIF | |
48006 | ||
48007 | C...Solve kinematics for final two hadrons, if possible. | |
48008 | WREM2=2D0*DHR1*DHR2*DHC12 | |
48009 | FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2) | |
48010 | IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1D0) GOTO 200 | |
48011 | IF(FD.GE.1D0) GOTO 700 | |
48012 | FA=WREM2+PR(JT)-PR(JR) | |
48013 | FB=SQRT(MAX(0D0,FA**2-4D0*WREM2*PR(JT))) | |
48014 | PREVCF=PARJ(42) | |
48015 | IF(MSTJ(11).EQ.2) PREVCF=PARJ(39) | |
48016 | PREV=1D0/(1D0+EXP(MIN(50D0,PREVCF*FB*PARJ(40)))) | |
48017 | FB=SIGN(FB,JS*(PYR(0)-PREV)) | |
48018 | KFL1A=IABS(KFL(1)) | |
48019 | KFL2A=IABS(KFL(2)) | |
48020 | IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), | |
48021 | &MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0D0,FA**2- | |
48022 | &4D0*WREM2*PR(JT))),DBLE(JS)) | |
48023 | DO 1080 J=1,4 | |
48024 | P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))* | |
48025 | & P(IN(3*JQ+3)+1,J)+0.5D0*(DHR1*(FA+FB)*P(IN(3*JQ+1),J)+ | |
48026 | & DHR2*(FA-FB)*P(IN(3*JQ+2),J))/WREM2 | |
48027 | P(I,J)=P(N+NRS,J)-P(I-1,J) | |
48028 | 1080 CONTINUE | |
48029 | IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 700 | |
48030 | DM2F1=P(I-1,4)**2-P(I-1,1)**2-P(I-1,2)**2-P(I-1,3)**2-P(I-1,5)**2 | |
48031 | DM2F2=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 | |
48032 | IF(DM2F1.GT.1D-10*P(I-1,4)**2.OR.DM2F2.GT.1D-10*P(I,4)**2) THEN | |
48033 | NTRYFN=NTRYFN+1 | |
48034 | IF(NTRYFN.LT.100) GOTO 140 | |
48035 | CALL PYERRM(13,'(PYSTRF:) bad energies for final two hadrons') | |
48036 | ENDIF | |
48037 | ||
48038 | C...Mark jets as fragmented and give daughter pointers. | |
48039 | N=I-NRS+1 | |
48040 | DO 1090 I=NSAV+1,NSAV+NP | |
48041 | IM=K(I,3) | |
48042 | K(IM,1)=K(IM,1)+10 | |
48043 | IF(MSTU(16).NE.2) THEN | |
48044 | K(IM,4)=NSAV+1 | |
48045 | K(IM,5)=NSAV+1 | |
48046 | ELSE | |
48047 | K(IM,4)=NSAV+2 | |
48048 | K(IM,5)=N | |
48049 | ENDIF | |
48050 | 1090 CONTINUE | |
48051 | ||
48052 | C...Document string system. Move up particles. | |
48053 | NSAV=NSAV+1 | |
48054 | K(NSAV,1)=11 | |
48055 | K(NSAV,2)=92 | |
48056 | K(NSAV,3)=IP | |
48057 | K(NSAV,4)=NSAV+1 | |
48058 | K(NSAV,5)=N | |
48059 | DO 1100 J=1,4 | |
48060 | P(NSAV,J)=DPS(J) | |
48061 | V(NSAV,J)=V(IP,J) | |
48062 | 1100 CONTINUE | |
48063 | P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) | |
48064 | V(NSAV,5)=0D0 | |
48065 | DO 1120 I=NSAV+1,N | |
48066 | DO 1110 J=1,5 | |
48067 | K(I,J)=K(I+NRS-1,J) | |
48068 | P(I,J)=P(I+NRS-1,J) | |
48069 | V(I,J)=0D0 | |
48070 | 1110 CONTINUE | |
48071 | 1120 CONTINUE | |
48072 | MSTU91=MSTU(90) | |
48073 | DO 1130 IZ=MSTU90+1,MSTU91 | |
48074 | MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N | |
48075 | PARU9T(IZ)=PARU(90+IZ) | |
48076 | 1130 CONTINUE | |
48077 | MSTU(90)=MSTU90 | |
48078 | ||
48079 | C...Order particles in rank along the chain. Update mother pointer. | |
48080 | DO 1150 I=NSAV+1,N | |
48081 | DO 1140 J=1,5 | |
48082 | K(I-NSAV+N,J)=K(I,J) | |
48083 | P(I-NSAV+N,J)=P(I,J) | |
48084 | 1140 CONTINUE | |
48085 | 1150 CONTINUE | |
48086 | I1=NSAV | |
48087 | DO 1180 I=N+1,2*N-NSAV | |
48088 | IF(K(I,3).NE.IE(1).AND.K(I,3).NE.IJUORI(1)) GOTO 1180 | |
48089 | I1=I1+1 | |
48090 | DO 1160 J=1,5 | |
48091 | K(I1,J)=K(I,J) | |
48092 | P(I1,J)=P(I,J) | |
48093 | 1160 CONTINUE | |
48094 | IF(MSTU(16).NE.2) K(I1,3)=NSAV | |
48095 | DO 1170 IZ=MSTU90+1,MSTU91 | |
48096 | IF(MSTU9T(IZ).EQ.I) THEN | |
48097 | MSTU(90)=MSTU(90)+1 | |
48098 | MSTU(90+MSTU(90))=I1 | |
48099 | PARU(90+MSTU(90))=PARU9T(IZ) | |
48100 | ENDIF | |
48101 | 1170 CONTINUE | |
48102 | 1180 CONTINUE | |
48103 | DO 1210 I=2*N-NSAV,N+1,-1 | |
48104 | IF(K(I,3).EQ.IE(1).OR.K(I,3).EQ.IJUORI(1)) GOTO 1210 | |
48105 | I1=I1+1 | |
48106 | DO 1190 J=1,5 | |
48107 | K(I1,J)=K(I,J) | |
48108 | P(I1,J)=P(I,J) | |
48109 | 1190 CONTINUE | |
48110 | IF(MSTU(16).NE.2) K(I1,3)=NSAV | |
48111 | DO 1200 IZ=MSTU90+1,MSTU91 | |
48112 | IF(MSTU9T(IZ).EQ.I) THEN | |
48113 | MSTU(90)=MSTU(90)+1 | |
48114 | MSTU(90+MSTU(90))=I1 | |
48115 | PARU(90+MSTU(90))=PARU9T(IZ) | |
48116 | ENDIF | |
48117 | 1200 CONTINUE | |
48118 | 1210 CONTINUE | |
48119 | ||
48120 | C...Boost back particle system. Set production vertices. | |
48121 | IF(MBST.EQ.0) THEN | |
48122 | MSTU(33)=1 | |
48123 | CALL PYROBO(NSAV+1,N,0D0,0D0,DPS(1)/DPS(4),DPS(2)/DPS(4), | |
48124 | & DPS(3)/DPS(4)) | |
48125 | ELSE | |
48126 | DO 1220 I=NSAV+1,N | |
48127 | HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 | |
48128 | IF(P(I,3).GT.0D0) THEN | |
48129 | HHPEZ=(P(I,4)+P(I,3))*HHBZ | |
48130 | P(I,3)=0.5D0*(HHPEZ-HHPMT/HHPEZ) | |
48131 | P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) | |
48132 | ELSE | |
48133 | HHPEZ=(P(I,4)-P(I,3))/HHBZ | |
48134 | P(I,3)=-0.5D0*(HHPEZ-HHPMT/HHPEZ) | |
48135 | P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) | |
48136 | ENDIF | |
48137 | 1220 CONTINUE | |
48138 | ENDIF | |
48139 | DO 1240 I=NSAV+1,N | |
48140 | DO 1230 J=1,4 | |
48141 | V(I,J)=V(IP,J) | |
48142 | 1230 CONTINUE | |
48143 | 1240 CONTINUE | |
48144 | ||
48145 | RETURN | |
48146 | END | |
48147 | ||
48148 | C********************************************************************* | |
48149 | ||
48150 | C...PYJURF | |
48151 | C...From three given input vectors in PJU the boost VJU from | |
48152 | C...the "lab frame" to the junction rest frame is constructed. | |
48153 | ||
48154 | SUBROUTINE PYJURF(PJU,VJU) | |
48155 | ||
48156 | C...Double precision and integer declarations. | |
48157 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
48158 | IMPLICIT INTEGER(I-N) | |
48159 | ||
48160 | C...Input, output and local arrays. | |
48161 | DIMENSION PJU(3,5),VJU(5),PSUM(5),A(3,3),PENEW(3),PCM(5,5) | |
48162 | DATA TWOPI/6.283186D0/ | |
48163 | ||
48164 | C...Calculate masses and other invariants. | |
48165 | DO 100 J=1,4 | |
48166 | PSUM(J)=PJU(1,J)+PJU(2,J)+PJU(3,J) | |
48167 | 100 CONTINUE | |
48168 | PSUM2=PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2 | |
48169 | PSUM(5)=SQRT(PSUM2) | |
48170 | DO 120 I=1,3 | |
48171 | DO 110 J=1,3 | |
48172 | A(I,J)=PJU(I,4)*PJU(J,4)-PJU(I,1)*PJU(J,1)- | |
48173 | & PJU(I,2)*PJU(J,2)-PJU(I,3)*PJU(J,3) | |
48174 | 110 CONTINUE | |
48175 | 120 CONTINUE | |
48176 | ||
48177 | C...Pick I to be most massive parton and J to be the one closest to I. | |
48178 | ITRY=0 | |
48179 | I=1 | |
48180 | IF(A(2,2).GT.A(1,1)) I=2 | |
48181 | IF(A(3,3).GT.MAX(A(1,1),A(2,2))) I=3 | |
48182 | 130 ITRY=ITRY+1 | |
48183 | J=1+MOD(I,3) | |
48184 | K=1+MOD(J,3) | |
48185 | IF(A(I,K)**2*A(J,J).LT.A(I,J)**2*A(K,K)) THEN | |
48186 | K=1+MOD(I,3) | |
48187 | J=1+MOD(K,3) | |
48188 | ENDIF | |
48189 | PMI2=A(I,I) | |
48190 | PMJ2=A(J,J) | |
48191 | PMK2=A(K,K) | |
48192 | AIJ=A(I,J) | |
48193 | AIK=A(I,K) | |
48194 | AJK=A(J,K) | |
48195 | ||
48196 | C...Trivial find new parton energies if all three partons are massless. | |
48197 | IF(PMI2.LT.1D-4) THEN | |
48198 | PEI=SQRT(2D0*AIK*AIJ/(3D0*AJK)) | |
48199 | PEJ=SQRT(2D0*AJK*AIJ/(3D0*AIK)) | |
48200 | PEK=SQRT(2D0*AIK*AJK/(3D0*AIJ)) | |
48201 | ||
48202 | C...Else find momentum range for parton I and values at extremes. | |
48203 | ELSE | |
48204 | PAIMIN=0D0 | |
48205 | PEIMIN=SQRT(PMI2) | |
48206 | PEJMIN=AIJ/PEIMIN | |
48207 | PEKMIN=AIK/PEIMIN | |
48208 | PAJMIN=SQRT(MAX(0D0,PEJMIN**2-PMJ2)) | |
48209 | PAKMIN=SQRT(MAX(0D0,PEKMIN**2-PMK2)) | |
48210 | FMIN=PEJMIN*PEKMIN+0.5D0*PAJMIN*PAKMIN-AJK | |
48211 | PEIMAX=(AIJ+AIK)/SQRT(PMJ2+PMK2+2D0*AJK) | |
48212 | IF(PMJ2.GT.1D-4) PEIMAX=AIJ/SQRT(PMJ2) | |
48213 | PAIMAX=SQRT(MAX(0D0,PEIMAX**2-PMI2)) | |
48214 | HI=PEIMAX**2-0.25D0*PAIMAX**2 | |
48215 | PAJMAX=(PEIMAX*SQRT(MAX(0D0,AIJ**2-PMJ2*HI))- | |
48216 | & 0.5D0*PAIMAX*AIJ)/HI | |
48217 | PAKMAX=(PEIMAX*SQRT(MAX(0D0,AIK**2-PMK2*HI))- | |
48218 | & 0.5D0*PAIMAX*AIK)/HI | |
48219 | PEJMAX=SQRT(PAJMAX**2+PMJ2) | |
48220 | PEKMAX=SQRT(PAKMAX**2+PMK2) | |
48221 | FMAX=PEJMAX*PEKMAX+0.5D0*PAJMAX*PAKMAX-AJK | |
48222 | ||
48223 | C...If unexpected values at upper endpoint then pick another parton. | |
48224 | IF(FMAX.GT.0D0.AND.ITRY.LE.2) THEN | |
48225 | I1=1+MOD(I,3) | |
48226 | IF(A(I1,I1).GE.1D-4) THEN | |
48227 | I=I1 | |
48228 | GOTO 130 | |
48229 | ENDIF | |
48230 | ITRY=ITRY+1 | |
48231 | I1=1+MOD(I,3) | |
48232 | IF(ITRY.LE.2.AND.A(I1,I1).GE.1D-4) THEN | |
48233 | I=I1 | |
48234 | GOTO 130 | |
48235 | ENDIF | |
48236 | ENDIF | |
48237 | ||
48238 | C..Start binary + linear search to find solution inside range. | |
48239 | ITER=0 | |
48240 | ITMIN=0 | |
48241 | ITMAX=0 | |
48242 | PAI=0.5D0*(PAIMIN+PAIMAX) | |
48243 | 140 ITER=ITER+1 | |
48244 | ||
48245 | C...Derive momentum of other two partons and distance to root. | |
48246 | PEI=SQRT(PAI**2+PMI2) | |
48247 | HI=PEI**2-0.25D0*PAI**2 | |
48248 | PAJ=(PEI*SQRT(MAX(0D0,AIJ**2-PMJ2*HI))-0.5D0*PAI*AIJ)/HI | |
48249 | PEJ=SQRT(PAJ**2+PMJ2) | |
48250 | PAK=(PEI*SQRT(MAX(0D0,AIK**2-PMK2*HI))-0.5D0*PAI*AIK)/HI | |
48251 | PEK=SQRT(PAK**2+PMK2) | |
48252 | FNOW=PEJ*PEK+0.5D0*PAJ*PAK-AJK | |
48253 | ||
48254 | C...Pick next I momentum to explore, hopefully closer to root. | |
48255 | IF(FNOW.GT.0D0) THEN | |
48256 | PAIMIN=PAI | |
48257 | FMIN=FNOW | |
48258 | ITMIN=ITMIN+1 | |
48259 | ELSE | |
48260 | PAIMAX=PAI | |
48261 | FMAX=FNOW | |
48262 | ITMAX=ITMAX+1 | |
48263 | ENDIF | |
48264 | IF((ITER.LT.10.OR.ITMIN.LE.1.OR.ITMAX.LE.1).AND.ITER.LT.20) | |
48265 | & THEN | |
48266 | PAI=0.5D0*(PAIMIN+PAIMAX) | |
48267 | GOTO 140 | |
48268 | ELSEIF(ITER.LT.40.AND.FMIN.GT.0D0.AND.FMAX.LT.0D0.AND. | |
48269 | & ABS(FNOW).GT.1D-12*PSUM2) THEN | |
48270 | PAI=PAIMIN+(PAIMAX-PAIMIN)*FMIN/(FMIN-FMAX) | |
48271 | GOTO 140 | |
48272 | ENDIF | |
48273 | ENDIF | |
48274 | ||
48275 | C...Now know energies in junction rest frame. | |
48276 | PENEW(I)=PEI | |
48277 | PENEW(J)=PEJ | |
48278 | PENEW(K)=PEK | |
48279 | ||
48280 | C...Boost (copy of) partons to their rest frame. | |
48281 | VXCM=-PSUM(1)/PSUM(5) | |
48282 | VYCM=-PSUM(2)/PSUM(5) | |
48283 | VZCM=-PSUM(3)/PSUM(5) | |
48284 | GAMCM=SQRT(1D0+VXCM**2+VYCM**2+VZCM**2) | |
48285 | DO 150 I=1,3 | |
48286 | FAC1=PJU(I,1)*VXCM+PJU(I,2)*VYCM+PJU(I,3)*VZCM | |
48287 | FAC2=FAC1/(1D0+GAMCM)+PJU(I,4) | |
48288 | PCM(I,1)=PJU(I,1)+FAC2*VXCM | |
48289 | PCM(I,2)=PJU(I,2)+FAC2*VYCM | |
48290 | PCM(I,3)=PJU(I,3)+FAC2*VZCM | |
48291 | PCM(I,4)=PJU(I,4)*GAMCM+FAC1 | |
48292 | PCM(I,5)=SQRT(PCM(I,1)**2+PCM(I,2)**2+PCM(I,3)**2) | |
48293 | 150 CONTINUE | |
48294 | ||
48295 | C...Construct difference vectors and boost to junction rest frame. | |
48296 | DO 160 J=1,3 | |
48297 | PCM(4,J)=PCM(1,J)/PCM(1,4)-PCM(2,J)/PCM(2,4) | |
48298 | PCM(5,J)=PCM(1,J)/PCM(1,4)-PCM(3,J)/PCM(3,4) | |
48299 | 160 CONTINUE | |
48300 | PCM(4,4)=PENEW(1)/PCM(1,4)-PENEW(2)/PCM(2,4) | |
48301 | PCM(5,4)=PENEW(1)/PCM(1,4)-PENEW(3)/PCM(3,4) | |
48302 | PCM4S=PCM(4,1)**2+PCM(4,2)**2+PCM(4,3)**2 | |
48303 | PCM5S=PCM(5,1)**2+PCM(5,2)**2+PCM(5,3)**2 | |
48304 | PCM45=PCM(4,1)*PCM(5,1)+PCM(4,2)*PCM(5,2)+PCM(4,3)*PCM(5,3) | |
48305 | C4=(PCM5S*PCM(4,4)-PCM45*PCM(5,4))/(PCM4S*PCM5S-PCM45**2) | |
48306 | C5=(PCM4S*PCM(5,4)-PCM45*PCM(4,4))/(PCM4S*PCM5S-PCM45**2) | |
48307 | VXJU=C4*PCM(4,1)+C5*PCM(5,1) | |
48308 | VYJU=C4*PCM(4,2)+C5*PCM(5,2) | |
48309 | VZJU=C4*PCM(4,3)+C5*PCM(5,3) | |
48310 | GAMJU=SQRT(1D0+VXJU**2+VYJU**2+VZJU**2) | |
48311 | ||
48312 | C...Add two boosts, giving final result. | |
48313 | FCM=(VXJU*VXCM+VYJU*VYCM+VZJU*VZCM)/(1+GAMCM)+GAMJU | |
48314 | VJU(1)=VXJU+FCM*VXCM | |
48315 | VJU(2)=VYJU+FCM*VYCM | |
48316 | VJU(3)=VZJU+FCM*VZCM | |
48317 | VJU(4)=SQRT(1D0+VJU(1)**2+VJU(2)**2+VJU(3)**2) | |
48318 | VJU(5)=1D0 | |
48319 | ||
48320 | C...In case of error in reconstruction: revert to CM frame of system. | |
48321 | CTH12=(PCM(1,1)*PCM(2,1)+PCM(1,2)*PCM(2,2)+PCM(1,3)*PCM(2,3))/ | |
48322 | &(PCM(1,5)*PCM(2,5)) | |
48323 | CTH13=(PCM(1,1)*PCM(3,1)+PCM(1,2)*PCM(3,2)+PCM(1,3)*PCM(3,3))/ | |
48324 | &(PCM(1,5)*PCM(3,5)) | |
48325 | CTH23=(PCM(2,1)*PCM(3,1)+PCM(2,2)*PCM(3,2)+PCM(2,3)*PCM(3,3))/ | |
48326 | &(PCM(2,5)*PCM(3,5)) | |
48327 | ERRCCM=(CTH12+0.5D0)**2+(CTH13+0.5D0)**2+(CTH23+0.5D0)**2 | |
48328 | ERRTCM=TWOPI-ACOS(CTH12)-ACOS(CTH13)-ACOS(CTH23) | |
48329 | DO 170 I=1,3 | |
48330 | FAC1=PJU(I,1)*VJU(1)+PJU(I,2)*VJU(2)+PJU(I,3)*VJU(3) | |
48331 | FAC2=FAC1/(1D0+VJU(4))+PJU(I,4) | |
48332 | PCM(I,1)=PJU(I,1)+FAC2*VJU(1) | |
48333 | PCM(I,2)=PJU(I,2)+FAC2*VJU(2) | |
48334 | PCM(I,3)=PJU(I,3)+FAC2*VJU(3) | |
48335 | PCM(I,4)=PJU(I,4)*VJU(4)+FAC1 | |
48336 | PCM(I,5)=SQRT(PCM(I,1)**2+PCM(I,2)**2+PCM(I,3)**2) | |
48337 | 170 CONTINUE | |
48338 | CTH12=(PCM(1,1)*PCM(2,1)+PCM(1,2)*PCM(2,2)+PCM(1,3)*PCM(2,3))/ | |
48339 | &(PCM(1,5)*PCM(2,5)) | |
48340 | CTH13=(PCM(1,1)*PCM(3,1)+PCM(1,2)*PCM(3,2)+PCM(1,3)*PCM(3,3))/ | |
48341 | &(PCM(1,5)*PCM(3,5)) | |
48342 | CTH23=(PCM(2,1)*PCM(3,1)+PCM(2,2)*PCM(3,2)+PCM(2,3)*PCM(3,3))/ | |
48343 | &(PCM(2,5)*PCM(3,5)) | |
48344 | ERRCJU=(CTH12+0.5D0)**2+(CTH13+0.5D0)**2+(CTH23+0.5D0)**2 | |
48345 | ERRTJU=TWOPI-ACOS(CTH12)-ACOS(CTH13)-ACOS(CTH23) | |
48346 | IF(ERRCJU+ERRTJU.GT.ERRCCM+ERRTCM) THEN | |
48347 | VJU(1)=VXCM | |
48348 | VJU(2)=VYCM | |
48349 | VJU(3)=VZCM | |
48350 | VJU(4)=GAMCM | |
48351 | ENDIF | |
48352 | ||
48353 | RETURN | |
48354 | END | |
48355 | ||
48356 | C********************************************************************* | |
48357 | ||
48358 | C...PYINDF | |
48359 | C...Handles the fragmentation of a jet system (or a single | |
48360 | C...jet) according to independent fragmentation models. | |
48361 | ||
48362 | SUBROUTINE PYINDF(IP) | |
48363 | ||
48364 | C...Double precision and integer declarations. | |
48365 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
48366 | IMPLICIT INTEGER(I-N) | |
48367 | INTEGER PYK,PYCHGE,PYCOMP | |
48368 | C...Commonblocks. | |
48369 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
48370 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
48371 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
48372 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
48373 | C...Local arrays. | |
48374 | DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3), | |
48375 | &KFLO(2),PXO(2),PYO(2),WO(2) | |
48376 | ||
48377 | C.. MOPS error message | |
48378 | IF(MSTJ(12).GT.3) CALL PYERRM(9,'(PYINDF:) MSTJ(12)>3 options'// | |
48379 | &' are not treated as expected in independent fragmentation') | |
48380 | ||
48381 | C...Reset counters. Identify parton system and take copy. Check flavour. | |
48382 | NSAV=N | |
48383 | MSTU90=MSTU(90) | |
48384 | NJET=0 | |
48385 | KQSUM=0 | |
48386 | DO 100 J=1,5 | |
48387 | DPS(J)=0D0 | |
48388 | 100 CONTINUE | |
48389 | I=IP-1 | |
48390 | 110 I=I+1 | |
48391 | IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN | |
48392 | CALL PYERRM(12,'(PYINDF:) failed to reconstruct jet system') | |
48393 | IF(MSTU(21).GE.1) RETURN | |
48394 | ENDIF | |
48395 | IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110 | |
48396 | KC=PYCOMP(K(I,2)) | |
48397 | IF(KC.EQ.0) GOTO 110 | |
48398 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
48399 | IF(KQ.EQ.0) GOTO 110 | |
48400 | NJET=NJET+1 | |
48401 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
48402 | DO 120 J=1,5 | |
48403 | K(NSAV+NJET,J)=K(I,J) | |
48404 | P(NSAV+NJET,J)=P(I,J) | |
48405 | DPS(J)=DPS(J)+P(I,J) | |
48406 | 120 CONTINUE | |
48407 | K(NSAV+NJET,3)=I | |
48408 | IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND. | |
48409 | &K(I+1,1).EQ.2)) GOTO 110 | |
48410 | IF(NJET.NE.1.AND.KQSUM.NE.0) THEN | |
48411 | CALL PYERRM(12,'(PYINDF:) unphysical flavour combination') | |
48412 | IF(MSTU(21).GE.1) RETURN | |
48413 | ENDIF | |
48414 | ||
48415 | C...Boost copied system to CM frame. Find CM energy and sum flavours. | |
48416 | IF(NJET.NE.1) THEN | |
48417 | MSTU(33)=1 | |
48418 | CALL PYROBO(NSAV+1,NSAV+NJET,0D0,0D0,-DPS(1)/DPS(4), | |
48419 | & -DPS(2)/DPS(4),-DPS(3)/DPS(4)) | |
48420 | ENDIF | |
48421 | PECM=0D0 | |
48422 | DO 130 J=1,3 | |
48423 | NFI(J)=0 | |
48424 | 130 CONTINUE | |
48425 | DO 140 I=NSAV+1,NSAV+NJET | |
48426 | PECM=PECM+P(I,4) | |
48427 | KFA=IABS(K(I,2)) | |
48428 | IF(KFA.LE.3) THEN | |
48429 | NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2)) | |
48430 | ELSEIF(KFA.GT.1000) THEN | |
48431 | KFLA=MOD(KFA/1000,10) | |
48432 | KFLB=MOD(KFA/100,10) | |
48433 | IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2)) | |
48434 | IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2)) | |
48435 | ENDIF | |
48436 | 140 CONTINUE | |
48437 | ||
48438 | C...Loop over attempts made. Reset counters. | |
48439 | NTRY=0 | |
48440 | 150 NTRY=NTRY+1 | |
48441 | IF(NTRY.GT.200) THEN | |
48442 | CALL PYERRM(14,'(PYINDF:) caught in infinite loop') | |
48443 | IF(MSTU(21).GE.1) RETURN | |
48444 | ENDIF | |
48445 | N=NSAV+NJET | |
48446 | MSTU(90)=MSTU90 | |
48447 | DO 160 J=1,3 | |
48448 | NFL(J)=NFI(J) | |
48449 | IFET(J)=0 | |
48450 | KFLF(J)=0 | |
48451 | 160 CONTINUE | |
48452 | ||
48453 | C...Loop over jets to be fragmented. | |
48454 | DO 230 IP1=NSAV+1,NSAV+NJET | |
48455 | MSTJ(91)=0 | |
48456 | NSAV1=N | |
48457 | MSTU91=MSTU(90) | |
48458 | ||
48459 | C...Initial flavour and momentum values. Jet along +z axis. | |
48460 | KFLH=IABS(K(IP1,2)) | |
48461 | IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10) | |
48462 | KFLO(2)=0 | |
48463 | WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2) | |
48464 | ||
48465 | C...Initial values for quark or diquark jet. | |
48466 | 170 IF(IABS(K(IP1,2)).NE.21) THEN | |
48467 | NSTR=1 | |
48468 | KFLO(1)=K(IP1,2) | |
48469 | CALL PYPTDI(0,PXO(1),PYO(1)) | |
48470 | WO(1)=WF | |
48471 | ||
48472 | C...Initial values for gluon treated like random quark jet. | |
48473 | ELSEIF(MSTJ(2).LE.2) THEN | |
48474 | NSTR=1 | |
48475 | IF(MSTJ(2).EQ.2) MSTJ(91)=1 | |
48476 | KFLO(1)=INT(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0) | |
48477 | CALL PYPTDI(0,PXO(1),PYO(1)) | |
48478 | WO(1)=WF | |
48479 | ||
48480 | C...Initial values for gluon treated like quark-antiquark jet pair, | |
48481 | C...sharing energy according to Altarelli-Parisi splitting function. | |
48482 | ELSE | |
48483 | NSTR=2 | |
48484 | IF(MSTJ(2).EQ.4) MSTJ(91)=1 | |
48485 | KFLO(1)=INT(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0) | |
48486 | KFLO(2)=-KFLO(1) | |
48487 | CALL PYPTDI(0,PXO(1),PYO(1)) | |
48488 | PXO(2)=-PXO(1) | |
48489 | PYO(2)=-PYO(1) | |
48490 | WO(1)=WF*PYR(0)**(1D0/3D0) | |
48491 | WO(2)=WF-WO(1) | |
48492 | ENDIF | |
48493 | ||
48494 | C...Initial values for rank, flavour, pT and W+. | |
48495 | DO 220 ISTR=1,NSTR | |
48496 | 180 I=N | |
48497 | MSTU(90)=MSTU91 | |
48498 | IRANK=0 | |
48499 | KFL1=KFLO(ISTR) | |
48500 | PX1=PXO(ISTR) | |
48501 | PY1=PYO(ISTR) | |
48502 | W=WO(ISTR) | |
48503 | ||
48504 | C...New hadron. Generate flavour and hadron species. | |
48505 | 190 I=I+1 | |
48506 | IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN | |
48507 | CALL PYERRM(11,'(PYINDF:) no more memory left in PYJETS') | |
48508 | IF(MSTU(21).GE.1) RETURN | |
48509 | ENDIF | |
48510 | IRANK=IRANK+1 | |
48511 | K(I,1)=1 | |
48512 | K(I,3)=IP1 | |
48513 | K(I,4)=0 | |
48514 | K(I,5)=0 | |
48515 | 200 CALL PYKFDI(KFL1,0,KFL2,K(I,2)) | |
48516 | IF(K(I,2).EQ.0) GOTO 180 | |
48517 | IF(IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND.IABS(KFL2).GT.10) THEN | |
48518 | IF(PYR(0).GT.PARJ(19)) GOTO 200 | |
48519 | ENDIF | |
48520 | ||
48521 | C...Find hadron mass. Generate four-momentum. | |
48522 | P(I,5)=PYMASS(K(I,2)) | |
48523 | CALL PYPTDI(KFL1,PX2,PY2) | |
48524 | P(I,1)=PX1+PX2 | |
48525 | P(I,2)=PY1+PY2 | |
48526 | PR=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
48527 | CALL PYZDIS(KFL1,KFL2,PR,Z) | |
48528 | MZSAV=0 | |
48529 | IF(IABS(KFL1).GE.4.AND.IABS(KFL1).LE.8.AND.MSTU(90).LT.8) THEN | |
48530 | MZSAV=1 | |
48531 | MSTU(90)=MSTU(90)+1 | |
48532 | MSTU(90+MSTU(90))=I | |
48533 | PARU(90+MSTU(90))=Z | |
48534 | ENDIF | |
48535 | P(I,3)=0.5D0*(Z*W-PR/MAX(1D-4,Z*W)) | |
48536 | P(I,4)=0.5D0*(Z*W+PR/MAX(1D-4,Z*W)) | |
48537 | IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND. | |
48538 | & P(I,3).LE.0.001D0) THEN | |
48539 | IF(W.GE.P(I,5)+0.5D0*PARJ(32)) GOTO 180 | |
48540 | P(I,3)=0.0001D0 | |
48541 | P(I,4)=SQRT(PR) | |
48542 | Z=P(I,4)/W | |
48543 | ENDIF | |
48544 | ||
48545 | C...Remaining flavour and momentum. | |
48546 | KFL1=-KFL2 | |
48547 | PX1=-PX2 | |
48548 | PY1=-PY2 | |
48549 | W=(1D0-Z)*W | |
48550 | DO 210 J=1,5 | |
48551 | V(I,J)=0D0 | |
48552 | 210 CONTINUE | |
48553 | ||
48554 | C...Check if pL acceptable. Go back for new hadron if enough energy. | |
48555 | IF(MSTJ(3).GE.0.AND.P(I,3).LT.0D0) THEN | |
48556 | I=I-1 | |
48557 | IF(MZSAV.EQ.1) MSTU(90)=MSTU(90)-1 | |
48558 | ENDIF | |
48559 | IF(W.GT.PARJ(31)) GOTO 190 | |
48560 | N=I | |
48561 | 220 CONTINUE | |
48562 | IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1D0*PARJ(32) | |
48563 | IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170 | |
48564 | ||
48565 | C...Rotate jet to new direction. | |
48566 | THE=PYANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2)) | |
48567 | PHI=PYANGL(P(IP1,1),P(IP1,2)) | |
48568 | MSTU(33)=1 | |
48569 | CALL PYROBO(NSAV1+1,N,THE,PHI,0D0,0D0,0D0) | |
48570 | K(K(IP1,3),4)=NSAV1+1 | |
48571 | K(K(IP1,3),5)=N | |
48572 | ||
48573 | C...End of jet generation loop. Skip conservation in some cases. | |
48574 | 230 CONTINUE | |
48575 | IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 490 | |
48576 | IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150 | |
48577 | ||
48578 | C...Subtract off produced hadron flavours, finished if zero. | |
48579 | DO 240 I=NSAV+NJET+1,N | |
48580 | KFA=IABS(K(I,2)) | |
48581 | KFLA=MOD(KFA/1000,10) | |
48582 | KFLB=MOD(KFA/100,10) | |
48583 | KFLC=MOD(KFA/10,10) | |
48584 | IF(KFLA.EQ.0) THEN | |
48585 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB | |
48586 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB | |
48587 | ELSE | |
48588 | IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2)) | |
48589 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2)) | |
48590 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2)) | |
48591 | ENDIF | |
48592 | 240 CONTINUE | |
48593 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ | |
48594 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 | |
48595 | IF(NREQ.EQ.0) GOTO 320 | |
48596 | ||
48597 | C...Take away flavour of low-momentum particles until enough freedom. | |
48598 | NREM=0 | |
48599 | 250 IREM=0 | |
48600 | P2MIN=PECM**2 | |
48601 | DO 260 I=NSAV+NJET+1,N | |
48602 | P2=P(I,1)**2+P(I,2)**2+P(I,3)**2 | |
48603 | IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I | |
48604 | IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2 | |
48605 | 260 CONTINUE | |
48606 | IF(IREM.EQ.0) GOTO 150 | |
48607 | K(IREM,1)=7 | |
48608 | KFA=IABS(K(IREM,2)) | |
48609 | KFLA=MOD(KFA/1000,10) | |
48610 | KFLB=MOD(KFA/100,10) | |
48611 | KFLC=MOD(KFA/10,10) | |
48612 | IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8 | |
48613 | IF(K(IREM,1).EQ.8) GOTO 250 | |
48614 | IF(KFLA.EQ.0) THEN | |
48615 | ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB | |
48616 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN | |
48617 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN | |
48618 | ELSE | |
48619 | IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2)) | |
48620 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2)) | |
48621 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2)) | |
48622 | ENDIF | |
48623 | NREM=NREM+1 | |
48624 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ | |
48625 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 | |
48626 | IF(NREQ.GT.NREM) GOTO 250 | |
48627 | DO 270 I=NSAV+NJET+1,N | |
48628 | IF(K(I,1).EQ.8) K(I,1)=1 | |
48629 | 270 CONTINUE | |
48630 | ||
48631 | C...Find combination of existing and new flavours for hadron. | |
48632 | 280 NFET=2 | |
48633 | IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3 | |
48634 | IF(NREQ.LT.NREM) NFET=1 | |
48635 | IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0 | |
48636 | DO 290 J=1,NFET | |
48637 | IFET(J)=1+(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*PYR(0) | |
48638 | KFLF(J)=ISIGN(1,NFL(1)) | |
48639 | IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2)) | |
48640 | IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3)) | |
48641 | 290 CONTINUE | |
48642 | IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0)) | |
48643 | &GOTO 280 | |
48644 | IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR. | |
48645 | &IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3) | |
48646 | &.LT.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280 | |
48647 | IF(NFET.EQ.0) KFLF(1)=1+INT((2D0+PARJ(2))*PYR(0)) | |
48648 | IF(NFET.EQ.0) KFLF(2)=-KFLF(1) | |
48649 | IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2D0+PARJ(2))*PYR(0)),-KFLF(1)) | |
48650 | IF(NFET.LE.2) KFLF(3)=0 | |
48651 | IF(KFLF(3).NE.0) THEN | |
48652 | KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+ | |
48653 | & 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1)) | |
48654 | IF(KFLF(1).EQ.KFLF(3).OR.(1D0+3D0*PARJ(4))*PYR(0).GT.1D0) | |
48655 | & KFLFC=KFLFC+ISIGN(2,KFLFC) | |
48656 | ELSE | |
48657 | KFLFC=KFLF(1) | |
48658 | ENDIF | |
48659 | CALL PYKFDI(KFLFC,KFLF(2),KFLDMP,KF) | |
48660 | IF(KF.EQ.0) GOTO 280 | |
48661 | DO 300 J=1,MAX(2,NFET) | |
48662 | NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J)) | |
48663 | 300 CONTINUE | |
48664 | ||
48665 | C...Store hadron at random among free positions. | |
48666 | NPOS=MIN(1+INT(PYR(0)*NREM),NREM) | |
48667 | DO 310 I=NSAV+NJET+1,N | |
48668 | IF(K(I,1).EQ.7) NPOS=NPOS-1 | |
48669 | IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310 | |
48670 | K(I,1)=1 | |
48671 | K(I,2)=KF | |
48672 | P(I,5)=PYMASS(K(I,2)) | |
48673 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
48674 | 310 CONTINUE | |
48675 | NREM=NREM-1 | |
48676 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ | |
48677 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 | |
48678 | IF(NREM.GT.0) GOTO 280 | |
48679 | ||
48680 | C...Compensate for missing momentum in global scheme (3 options). | |
48681 | 320 IF(MOD(MSTJ(3),5).NE.0.AND.MOD(MSTJ(3),5).NE.4) THEN | |
48682 | DO 340 J=1,3 | |
48683 | PSI(J)=0D0 | |
48684 | DO 330 I=NSAV+NJET+1,N | |
48685 | PSI(J)=PSI(J)+P(I,J) | |
48686 | 330 CONTINUE | |
48687 | 340 CONTINUE | |
48688 | PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2 | |
48689 | PWS=0D0 | |
48690 | DO 350 I=NSAV+NJET+1,N | |
48691 | IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4) | |
48692 | IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ | |
48693 | & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) | |
48694 | IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1D0 | |
48695 | 350 CONTINUE | |
48696 | DO 370 I=NSAV+NJET+1,N | |
48697 | IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4) | |
48698 | IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ | |
48699 | & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) | |
48700 | IF(MOD(MSTJ(3),5).EQ.3) PW=1D0 | |
48701 | DO 360 J=1,3 | |
48702 | P(I,J)=P(I,J)-PSI(J)*PW/PWS | |
48703 | 360 CONTINUE | |
48704 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
48705 | 370 CONTINUE | |
48706 | ||
48707 | C...Compensate for missing momentum withing each jet separately. | |
48708 | ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN | |
48709 | DO 390 I=N+1,N+NJET | |
48710 | K(I,1)=0 | |
48711 | DO 380 J=1,5 | |
48712 | P(I,J)=0D0 | |
48713 | 380 CONTINUE | |
48714 | 390 CONTINUE | |
48715 | DO 410 I=NSAV+NJET+1,N | |
48716 | IR1=K(I,3) | |
48717 | IR2=N+IR1-NSAV | |
48718 | K(IR2,1)=K(IR2,1)+1 | |
48719 | PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ | |
48720 | & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) | |
48721 | DO 400 J=1,3 | |
48722 | P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J) | |
48723 | 400 CONTINUE | |
48724 | P(IR2,4)=P(IR2,4)+P(I,4) | |
48725 | P(IR2,5)=P(IR2,5)+PLS | |
48726 | 410 CONTINUE | |
48727 | PSS=0D0 | |
48728 | DO 420 I=N+1,N+NJET | |
48729 | IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8D0*P(I,5)+0.2D0)) | |
48730 | 420 CONTINUE | |
48731 | DO 440 I=NSAV+NJET+1,N | |
48732 | IR1=K(I,3) | |
48733 | IR2=N+IR1-NSAV | |
48734 | PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ | |
48735 | & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) | |
48736 | DO 430 J=1,3 | |
48737 | P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1D0/(P(IR2,5)*PSS)-1D0)* | |
48738 | & PLS*P(IR1,J) | |
48739 | 430 CONTINUE | |
48740 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
48741 | 440 CONTINUE | |
48742 | ENDIF | |
48743 | ||
48744 | C...Scale momenta for energy conservation. | |
48745 | IF(MOD(MSTJ(3),5).NE.0) THEN | |
48746 | PMS=0D0 | |
48747 | PES=0D0 | |
48748 | PQS=0D0 | |
48749 | DO 450 I=NSAV+NJET+1,N | |
48750 | PMS=PMS+P(I,5) | |
48751 | PES=PES+P(I,4) | |
48752 | PQS=PQS+P(I,5)**2/P(I,4) | |
48753 | 450 CONTINUE | |
48754 | IF(PMS.GE.PECM) GOTO 150 | |
48755 | NECO=0 | |
48756 | 460 NECO=NECO+1 | |
48757 | PFAC=(PECM-PQS)/(PES-PQS) | |
48758 | PES=0D0 | |
48759 | PQS=0D0 | |
48760 | DO 480 I=NSAV+NJET+1,N | |
48761 | DO 470 J=1,3 | |
48762 | P(I,J)=PFAC*P(I,J) | |
48763 | 470 CONTINUE | |
48764 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
48765 | PES=PES+P(I,4) | |
48766 | PQS=PQS+P(I,5)**2/P(I,4) | |
48767 | 480 CONTINUE | |
48768 | IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2D-6*PECM) GOTO 460 | |
48769 | ENDIF | |
48770 | ||
48771 | C...Origin of produced particles and parton daughter pointers. | |
48772 | 490 DO 500 I=NSAV+NJET+1,N | |
48773 | IF(MSTU(16).NE.2) K(I,3)=NSAV+1 | |
48774 | IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3) | |
48775 | 500 CONTINUE | |
48776 | DO 510 I=NSAV+1,NSAV+NJET | |
48777 | I1=K(I,3) | |
48778 | K(I1,1)=K(I1,1)+10 | |
48779 | IF(MSTU(16).NE.2) THEN | |
48780 | K(I1,4)=NSAV+1 | |
48781 | K(I1,5)=NSAV+1 | |
48782 | ELSE | |
48783 | K(I1,4)=K(I1,4)-NJET+1 | |
48784 | K(I1,5)=K(I1,5)-NJET+1 | |
48785 | IF(K(I1,5).LT.K(I1,4)) THEN | |
48786 | K(I1,4)=0 | |
48787 | K(I1,5)=0 | |
48788 | ENDIF | |
48789 | ENDIF | |
48790 | 510 CONTINUE | |
48791 | ||
48792 | C...Document independent fragmentation system. Remove copy of jets. | |
48793 | NSAV=NSAV+1 | |
48794 | K(NSAV,1)=11 | |
48795 | K(NSAV,2)=93 | |
48796 | K(NSAV,3)=IP | |
48797 | K(NSAV,4)=NSAV+1 | |
48798 | K(NSAV,5)=N-NJET+1 | |
48799 | DO 520 J=1,4 | |
48800 | P(NSAV,J)=DPS(J) | |
48801 | V(NSAV,J)=V(IP,J) | |
48802 | 520 CONTINUE | |
48803 | P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) | |
48804 | V(NSAV,5)=0D0 | |
48805 | DO 540 I=NSAV+NJET,N | |
48806 | DO 530 J=1,5 | |
48807 | K(I-NJET+1,J)=K(I,J) | |
48808 | P(I-NJET+1,J)=P(I,J) | |
48809 | V(I-NJET+1,J)=V(I,J) | |
48810 | 530 CONTINUE | |
48811 | 540 CONTINUE | |
48812 | N=N-NJET+1 | |
48813 | DO 550 IZ=MSTU90+1,MSTU(90) | |
48814 | MSTU(90+IZ)=MSTU(90+IZ)-NJET+1 | |
48815 | 550 CONTINUE | |
48816 | ||
48817 | C...Boost back particle system. Set production vertices. | |
48818 | IF(NJET.NE.1) CALL PYROBO(NSAV+1,N,0D0,0D0,DPS(1)/DPS(4), | |
48819 | &DPS(2)/DPS(4),DPS(3)/DPS(4)) | |
48820 | DO 570 I=NSAV+1,N | |
48821 | DO 560 J=1,4 | |
48822 | V(I,J)=V(IP,J) | |
48823 | 560 CONTINUE | |
48824 | 570 CONTINUE | |
48825 | ||
48826 | RETURN | |
48827 | END | |
48828 | ||
48829 | C********************************************************************* | |
48830 | ||
48831 | C...PYDECY | |
48832 | C...Handles the decay of unstable particles. | |
48833 | ||
48834 | SUBROUTINE PYDECY(IP) | |
48835 | ||
48836 | C...Double precision and integer declarations. | |
48837 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
48838 | IMPLICIT INTEGER(I-N) | |
48839 | INTEGER PYK,PYCHGE,PYCOMP | |
48840 | C...Commonblocks. | |
48841 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
48842 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
48843 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
48844 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
48845 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ | |
48846 | C...Local arrays. | |
48847 | DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3), | |
48848 | &WTCOR(10),PTAU(4),PCMTAU(4),DBETAU(3) | |
48849 | CHARACTER CIDC*4 | |
48850 | DATA WTCOR/2D0,5D0,15D0,60D0,250D0,1500D0,1.2D4,1.2D5,150D0,16D0/ | |
48851 | ||
48852 | C...Functions: momentum in two-particle decays and four-product. | |
48853 | PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2D0*A) | |
48854 | 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) | |
48855 | ||
48856 | C...Initial values. | |
48857 | NTRY=0 | |
48858 | NSAV=N | |
48859 | KFA=IABS(K(IP,2)) | |
48860 | KFS=ISIGN(1,K(IP,2)) | |
48861 | KC=PYCOMP(KFA) | |
48862 | MSTJ(92)=0 | |
48863 | ||
48864 | C...Choose lifetime and determine decay vertex. | |
48865 | IF(K(IP,1).EQ.5) THEN | |
48866 | V(IP,5)=0D0 | |
48867 | ELSEIF(K(IP,1).NE.4) THEN | |
48868 | V(IP,5)=-PMAS(KC,4)*LOG(PYR(0)) | |
48869 | ENDIF | |
48870 | DO 100 J=1,4 | |
48871 | VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5) | |
48872 | 100 CONTINUE | |
48873 | ||
48874 | C...Determine whether decay allowed or not. | |
48875 | MOUT=0 | |
48876 | IF(MSTJ(22).EQ.2) THEN | |
48877 | IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1 | |
48878 | ELSEIF(MSTJ(22).EQ.3) THEN | |
48879 | IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1 | |
48880 | ELSEIF(MSTJ(22).EQ.4) THEN | |
48881 | IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1 | |
48882 | IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1 | |
48883 | ENDIF | |
48884 | IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN | |
48885 | K(IP,1)=4 | |
48886 | RETURN | |
48887 | ENDIF | |
48888 | ||
48889 | C...Interface to external tau decay library (for tau polarization). | |
48890 | IF(KFA.EQ.15.AND.MSTJ(28).GE.1) THEN | |
48891 | ||
48892 | C...Starting values for pointers and momenta. | |
48893 | ITAU=IP | |
48894 | DO 110 J=1,4 | |
48895 | PTAU(J)=P(ITAU,J) | |
48896 | PCMTAU(J)=P(ITAU,J) | |
48897 | 110 CONTINUE | |
48898 | ||
48899 | C...Iterate to find position and code of mother of tau. | |
48900 | IMTAU=ITAU | |
48901 | 120 IMTAU=K(IMTAU,3) | |
48902 | ||
48903 | IF(IMTAU.EQ.0) THEN | |
48904 | C...If no known origin then impossible to do anything further. | |
48905 | KFORIG=0 | |
48906 | IORIG=0 | |
48907 | ||
48908 | ELSEIF(K(IMTAU,2).EQ.K(ITAU,2)) THEN | |
48909 | C...If tau -> tau + gamma then add gamma energy and loop. | |
48910 | IF(K(K(IMTAU,4),2).EQ.22) THEN | |
48911 | DO 130 J=1,4 | |
48912 | PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,4),J) | |
48913 | 130 CONTINUE | |
48914 | ELSEIF(K(K(IMTAU,5),2).EQ.22) THEN | |
48915 | DO 140 J=1,4 | |
48916 | PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,5),J) | |
48917 | 140 CONTINUE | |
48918 | ENDIF | |
48919 | GOTO 120 | |
48920 | ||
48921 | ELSEIF(IABS(K(IMTAU,2)).GT.100) THEN | |
48922 | C...If coming from weak decay of hadron then W is not stored in record, | |
48923 | C...but can be reconstructed by adding neutrino momentum. | |
48924 | KFORIG=-ISIGN(24,K(ITAU,2)) | |
48925 | IORIG=0 | |
48926 | DO 160 II=K(IMTAU,4),K(IMTAU,5) | |
48927 | IF(K(II,2)*ISIGN(1,K(ITAU,2)).EQ.-16) THEN | |
48928 | DO 150 J=1,4 | |
48929 | PCMTAU(J)=PCMTAU(J)+P(II,J) | |
48930 | 150 CONTINUE | |
48931 | ENDIF | |
48932 | 160 CONTINUE | |
48933 | ||
48934 | ELSE | |
48935 | C...If coming from resonance decay then find latest copy of this | |
48936 | C...resonance (may not completely agree). | |
48937 | KFORIG=K(IMTAU,2) | |
48938 | IORIG=IMTAU | |
48939 | DO 170 II=IMTAU+1,IP-1 | |
48940 | IF(K(II,2).EQ.KFORIG.AND.K(II,3).EQ.IORIG.AND. | |
48941 | & ABS(P(II,5)-P(IORIG,5)).LT.1D-5*P(IORIG,5)) IORIG=II | |
48942 | 170 CONTINUE | |
48943 | DO 180 J=1,4 | |
48944 | PCMTAU(J)=P(IORIG,J) | |
48945 | 180 CONTINUE | |
48946 | ENDIF | |
48947 | ||
48948 | C...Boost tau to rest frame of production process (where known) | |
48949 | C...and rotate it to sit along +z axis. | |
48950 | DO 190 J=1,3 | |
48951 | DBETAU(J)=PCMTAU(J)/PCMTAU(4) | |
48952 | 190 CONTINUE | |
48953 | IF(KFORIG.NE.0) CALL PYROBO(ITAU,ITAU,0D0,0D0,-DBETAU(1), | |
48954 | & -DBETAU(2),-DBETAU(3)) | |
48955 | PHITAU=PYANGL(P(ITAU,1),P(ITAU,2)) | |
48956 | CALL PYROBO(ITAU,ITAU,0D0,-PHITAU,0D0,0D0,0D0) | |
48957 | THETAU=PYANGL(P(ITAU,3),P(ITAU,1)) | |
48958 | CALL PYROBO(ITAU,ITAU,-THETAU,0D0,0D0,0D0,0D0) | |
48959 | ||
48960 | C...Call tau decay routine (if meaningful) and fill extra info. | |
48961 | IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN | |
48962 | CALL PYTAUD(ITAU,IORIG,KFORIG,NDECAY) | |
48963 | DO 200 II=NSAV+1,NSAV+NDECAY | |
48964 | K(II,1)=1 | |
48965 | K(II,3)=IP | |
48966 | K(II,4)=0 | |
48967 | K(II,5)=0 | |
48968 | 200 CONTINUE | |
48969 | N=NSAV+NDECAY | |
48970 | ENDIF | |
48971 | ||
48972 | C...Boost back decay tau and decay products. | |
48973 | DO 210 J=1,4 | |
48974 | P(ITAU,J)=PTAU(J) | |
48975 | 210 CONTINUE | |
48976 | IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN | |
48977 | CALL PYROBO(NSAV+1,N,THETAU,PHITAU,0D0,0D0,0D0) | |
48978 | IF(KFORIG.NE.0) CALL PYROBO(NSAV+1,N,0D0,0D0,DBETAU(1), | |
48979 | & DBETAU(2),DBETAU(3)) | |
48980 | ||
48981 | C...Skip past ordinary tau decay treatment. | |
48982 | MMAT=0 | |
48983 | MBST=0 | |
48984 | ND=0 | |
48985 | GOTO 630 | |
48986 | ENDIF | |
48987 | ENDIF | |
48988 | ||
48989 | C...B-Bbar mixing: flip sign of meson appropriately. | |
48990 | MMIX=0 | |
48991 | IF((KFA.EQ.511.OR.KFA.EQ.531).AND.MSTJ(26).GE.1) THEN | |
48992 | XBBMIX=PARJ(76) | |
48993 | IF(KFA.EQ.531) XBBMIX=PARJ(77) | |
48994 | IF(SIN(0.5D0*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.PYR(0)) MMIX=1 | |
48995 | IF(MMIX.EQ.1) KFS=-KFS | |
48996 | ENDIF | |
48997 | ||
48998 | C...Check existence of decay channels. Particle/antiparticle rules. | |
48999 | KCA=KC | |
49000 | IF(MDCY(KC,2).GT.0) THEN | |
49001 | MDMDCY=MDME(MDCY(KC,2),2) | |
49002 | IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY | |
49003 | ENDIF | |
49004 | IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN | |
49005 | CALL PYERRM(9,'(PYDECY:) no decay channel defined') | |
49006 | RETURN | |
49007 | ENDIF | |
49008 | IF(MOD(KFA/1000,10).EQ.0.AND.KCA.EQ.85) KFS=-KFS | |
49009 | IF(KCHG(KC,3).EQ.0) THEN | |
49010 | KFSP=1 | |
49011 | KFSN=0 | |
49012 | IF(PYR(0).GT.0.5D0) KFS=-KFS | |
49013 | ELSEIF(KFS.GT.0) THEN | |
49014 | KFSP=1 | |
49015 | KFSN=0 | |
49016 | ELSE | |
49017 | KFSP=0 | |
49018 | KFSN=1 | |
49019 | ENDIF | |
49020 | ||
49021 | C...Sum branching ratios of allowed decay channels. | |
49022 | 220 NOPE=0 | |
49023 | BRSU=0D0 | |
49024 | DO 230 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1 | |
49025 | IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. | |
49026 | & KFSN*MDME(IDL,1).NE.3) GOTO 230 | |
49027 | IF(MDME(IDL,2).GT.100) GOTO 230 | |
49028 | NOPE=NOPE+1 | |
49029 | BRSU=BRSU+BRAT(IDL) | |
49030 | 230 CONTINUE | |
49031 | IF(NOPE.EQ.0) THEN | |
49032 | CALL PYERRM(2,'(PYDECY:) all decay channels closed by user') | |
49033 | RETURN | |
49034 | ENDIF | |
49035 | ||
49036 | C...Select decay channel among allowed ones. | |
49037 | 240 RBR=BRSU*PYR(0) | |
49038 | IDL=MDCY(KCA,2)-1 | |
49039 | 250 IDL=IDL+1 | |
49040 | IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. | |
49041 | &KFSN*MDME(IDL,1).NE.3) THEN | |
49042 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250 | |
49043 | ELSEIF(MDME(IDL,2).GT.100) THEN | |
49044 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250 | |
49045 | ELSE | |
49046 | IDC=IDL | |
49047 | RBR=RBR-BRAT(IDL) | |
49048 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0D0) GOTO 250 | |
49049 | ENDIF | |
49050 | ||
49051 | C...Start readout of decay channel: matrix element, reset counters. | |
49052 | MMAT=MDME(IDC,2) | |
49053 | 260 NTRY=NTRY+1 | |
49054 | IF(MOD(NTRY,200).EQ.0) THEN | |
49055 | WRITE(CIDC,'(I4)') IDC | |
49056 | C...Do not print warning for some well-known special cases. | |
49057 | IF(KFA.NE.113.AND.KFA.NE.115.AND.KFA.NE.215) | |
49058 | & CALL PYERRM(4,'(PYDECY:) caught in loop for decay channel'// | |
49059 | & CIDC) | |
49060 | GOTO 240 | |
49061 | ENDIF | |
49062 | IF(NTRY.GT.1000) THEN | |
49063 | CALL PYERRM(14,'(PYDECY:) caught in infinite loop') | |
49064 | IF(MSTU(21).GE.1) RETURN | |
49065 | ENDIF | |
49066 | I=N | |
49067 | NP=0 | |
49068 | NQ=0 | |
49069 | MBST=0 | |
49070 | IF(MMAT.GE.11.AND.P(IP,4).GT.20D0*P(IP,5)) MBST=1 | |
49071 | DO 270 J=1,4 | |
49072 | PV(1,J)=0D0 | |
49073 | IF(MBST.EQ.0) PV(1,J)=P(IP,J) | |
49074 | 270 CONTINUE | |
49075 | IF(MBST.EQ.1) PV(1,4)=P(IP,5) | |
49076 | PV(1,5)=P(IP,5) | |
49077 | PS=0D0 | |
49078 | PSQ=0D0 | |
49079 | MREM=0 | |
49080 | MHADDY=0 | |
49081 | IF(KFA.GT.80) MHADDY=1 | |
49082 | C.. Random flavour and popcorn system memory. | |
49083 | IRNDMO=0 | |
49084 | JTMO=0 | |
49085 | MSTU(121)=0 | |
49086 | MSTU(125)=10 | |
49087 | ||
49088 | C...Read out decay products. Convert to standard flavour code. | |
49089 | JTMAX=5 | |
49090 | IF(MDME(IDC+1,2).EQ.101) JTMAX=10 | |
49091 | DO 280 JT=1,JTMAX | |
49092 | IF(JT.LE.5) KP=KFDP(IDC,JT) | |
49093 | IF(JT.GE.6) KP=KFDP(IDC+1,JT-5) | |
49094 | IF(KP.EQ.0) GOTO 280 | |
49095 | KPA=IABS(KP) | |
49096 | KCP=PYCOMP(KPA) | |
49097 | IF(KPA.GT.80) MHADDY=1 | |
49098 | IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN | |
49099 | KFP=KP | |
49100 | ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN | |
49101 | KFP=KFS*KP | |
49102 | ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN | |
49103 | KFP=-KFS*MOD(KFA/10,10) | |
49104 | ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN | |
49105 | KFP=KFS*(100*MOD(KFA/10,100)+3) | |
49106 | ELSEIF(KPA.EQ.81) THEN | |
49107 | KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1) | |
49108 | ELSEIF(KP.EQ.82) THEN | |
49109 | CALL PYDCYK(-KFS*INT(1D0+(2D0+PARJ(2))*PYR(0)),0,KFP,KDUMP) | |
49110 | IF(KFP.EQ.0) GOTO 260 | |
49111 | KFP=-KFP | |
49112 | IRNDMO=1 | |
49113 | MSTJ(93)=1 | |
49114 | IF(PV(1,5).LT.PARJ(32)+2D0*PYMASS(KFP)) GOTO 260 | |
49115 | ELSEIF(KP.EQ.-82) THEN | |
49116 | KFP=MSTU(124) | |
49117 | ENDIF | |
49118 | IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=PYCOMP(KFP) | |
49119 | ||
49120 | C...Add decay product to event record or to quark flavour list. | |
49121 | KFPA=IABS(KFP) | |
49122 | KQP=KCHG(KCP,2) | |
49123 | IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN | |
49124 | NQ=NQ+1 | |
49125 | KFLO(NQ)=KFP | |
49126 | C...set rndmflav popcorn system pointer | |
49127 | IF(KP.EQ.82.AND.MSTU(121).GT.0) JTMO=NQ | |
49128 | MSTJ(93)=2 | |
49129 | PSQ=PSQ+PYMASS(KFLO(NQ)) | |
49130 | ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.48).AND.NP.EQ.3.AND. | |
49131 | & MOD(NQ,2).EQ.1) THEN | |
49132 | NQ=NQ-1 | |
49133 | PS=PS-P(I,5) | |
49134 | K(I,1)=1 | |
49135 | KFI=K(I,2) | |
49136 | CALL PYKFDI(KFP,KFI,KFLDMP,K(I,2)) | |
49137 | IF(K(I,2).EQ.0) GOTO 260 | |
49138 | MSTJ(93)=1 | |
49139 | P(I,5)=PYMASS(K(I,2)) | |
49140 | PS=PS+P(I,5) | |
49141 | ELSE | |
49142 | I=I+1 | |
49143 | NP=NP+1 | |
49144 | IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1 | |
49145 | IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1 | |
49146 | K(I,1)=1+MOD(NQ,2) | |
49147 | IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2 | |
49148 | IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1 | |
49149 | K(I,2)=KFP | |
49150 | K(I,3)=IP | |
49151 | K(I,4)=0 | |
49152 | K(I,5)=0 | |
49153 | P(I,5)=PYMASS(KFP) | |
49154 | PS=PS+P(I,5) | |
49155 | ENDIF | |
49156 | 280 CONTINUE | |
49157 | ||
49158 | C...Check masses for resonance decays. | |
49159 | IF(MHADDY.EQ.0) THEN | |
49160 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 240 | |
49161 | ENDIF | |
49162 | ||
49163 | C...Choose decay multiplicity in phase space model. | |
49164 | 290 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN | |
49165 | PSP=PS | |
49166 | CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1D0)) | |
49167 | IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63) | |
49168 | 300 NTRY=NTRY+1 | |
49169 | C...Reset popcorn flags if new attempt. Re-select rndmflav if failed. | |
49170 | IF(IRNDMO.EQ.0) THEN | |
49171 | MSTU(121)=0 | |
49172 | JTMO=0 | |
49173 | ELSEIF(IRNDMO.EQ.1) THEN | |
49174 | IRNDMO=2 | |
49175 | ELSE | |
49176 | GOTO 260 | |
49177 | ENDIF | |
49178 | IF(NTRY.GT.1000) THEN | |
49179 | CALL PYERRM(14,'(PYDECY:) caught in infinite loop') | |
49180 | IF(MSTU(21).GE.1) RETURN | |
49181 | ENDIF | |
49182 | IF(MMAT.LE.20) THEN | |
49183 | GAUSS=SQRT(-2D0*CNDE*LOG(MAX(1D-10,PYR(0))))* | |
49184 | & SIN(PARU(2)*PYR(0)) | |
49185 | ND=0.5D0+0.5D0*NP+0.25D0*NQ+CNDE+GAUSS | |
49186 | IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 300 | |
49187 | IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 300 | |
49188 | IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 300 | |
49189 | IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 300 | |
49190 | ELSE | |
49191 | ND=MMAT-20 | |
49192 | ENDIF | |
49193 | C.. Set maximum popcorn meson number. Test rndmflav popcorn size. | |
49194 | MSTU(125)=ND-NQ/2 | |
49195 | IF(MSTU(121).GT.MSTU(125)) GOTO 300 | |
49196 | ||
49197 | C...Form hadrons from flavour content. | |
49198 | DO 310 JT=1,NQ | |
49199 | KFL1(JT)=KFLO(JT) | |
49200 | 310 CONTINUE | |
49201 | IF(ND.EQ.NP+NQ/2) GOTO 330 | |
49202 | DO 320 I=N+NP+1,N+ND-NQ/2 | |
49203 | C.. Stick to started popcorn system, else pick side at random | |
49204 | JT=JTMO | |
49205 | IF(JT.EQ.0) JT=1+INT((NQ-1)*PYR(0)) | |
49206 | CALL PYDCYK(KFL1(JT),0,KFL2,K(I,2)) | |
49207 | IF(K(I,2).EQ.0) GOTO 300 | |
49208 | MSTU(125)=MSTU(125)-1 | |
49209 | JTMO=0 | |
49210 | IF(MSTU(121).GT.0) JTMO=JT | |
49211 | KFL1(JT)=-KFL2 | |
49212 | 320 CONTINUE | |
49213 | 330 JT=2 | |
49214 | JT2=3 | |
49215 | JT3=4 | |
49216 | IF(NQ.EQ.4.AND.PYR(0).LT.PARJ(66)) JT=4 | |
49217 | IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))* | |
49218 | & ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3 | |
49219 | IF(JT.EQ.3) JT2=2 | |
49220 | IF(JT.EQ.4) JT3=2 | |
49221 | CALL PYDCYK(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2)) | |
49222 | IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 300 | |
49223 | IF(NQ.EQ.4) CALL PYDCYK(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2)) | |
49224 | IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 300 | |
49225 | ||
49226 | C...Check that sum of decay product masses not too large. | |
49227 | PS=PSP | |
49228 | DO 340 I=N+NP+1,N+ND | |
49229 | K(I,1)=1 | |
49230 | K(I,3)=IP | |
49231 | K(I,4)=0 | |
49232 | K(I,5)=0 | |
49233 | P(I,5)=PYMASS(K(I,2)) | |
49234 | PS=PS+P(I,5) | |
49235 | 340 CONTINUE | |
49236 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 300 | |
49237 | ||
49238 | C...Rescale energy to subtract off spectator quark mass. | |
49239 | ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44) | |
49240 | & .AND.NP.GE.3) THEN | |
49241 | PS=PS-P(N+NP,5) | |
49242 | PQT=(P(N+NP,5)+PARJ(65))/PV(1,5) | |
49243 | DO 350 J=1,5 | |
49244 | P(N+NP,J)=PQT*PV(1,J) | |
49245 | PV(1,J)=(1D0-PQT)*PV(1,J) | |
49246 | 350 CONTINUE | |
49247 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260 | |
49248 | ND=NP-1 | |
49249 | MREM=1 | |
49250 | ||
49251 | C...Fully specified final state: check mass broadening effects. | |
49252 | ELSE | |
49253 | IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 260 | |
49254 | ND=NP | |
49255 | ENDIF | |
49256 | ||
49257 | C...Determine position of grandmother, number of sisters. | |
49258 | NM=0 | |
49259 | KFAS=0 | |
49260 | MSGN=0 | |
49261 | IF(MMAT.EQ.3) THEN | |
49262 | IM=K(IP,3) | |
49263 | IF(IM.LT.0.OR.IM.GE.IP) IM=0 | |
49264 | IF(IM.NE.0) KFAM=IABS(K(IM,2)) | |
49265 | IF(IM.NE.0) THEN | |
49266 | DO 360 IL=MAX(IP-2,IM+1),MIN(IP+2,N) | |
49267 | IF(K(IL,3).EQ.IM) NM=NM+1 | |
49268 | IF(K(IL,3).EQ.IM.AND.IL.NE.IP) ISIS=IL | |
49269 | 360 CONTINUE | |
49270 | IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR. | |
49271 | & MOD(KFAM/1000,10).NE.0) NM=0 | |
49272 | IF(NM.EQ.2) THEN | |
49273 | KFAS=IABS(K(ISIS,2)) | |
49274 | IF((KFAS.LE.100.OR.MOD(KFAS,10).NE.1.OR. | |
49275 | & MOD(KFAS/1000,10).NE.0).AND.KFAS.NE.22) NM=0 | |
49276 | ENDIF | |
49277 | ENDIF | |
49278 | ENDIF | |
49279 | ||
49280 | C...Kinematics of one-particle decays. | |
49281 | IF(ND.EQ.1) THEN | |
49282 | DO 370 J=1,4 | |
49283 | P(N+1,J)=P(IP,J) | |
49284 | 370 CONTINUE | |
49285 | GOTO 630 | |
49286 | ENDIF | |
49287 | ||
49288 | C...Calculate maximum weight ND-particle decay. | |
49289 | PV(ND,5)=P(N+ND,5) | |
49290 | IF(ND.GE.3) THEN | |
49291 | WTMAX=1D0/WTCOR(ND-2) | |
49292 | PMAX=PV(1,5)-PS+P(N+ND,5) | |
49293 | PMIN=0D0 | |
49294 | DO 380 IL=ND-1,1,-1 | |
49295 | PMAX=PMAX+P(N+IL,5) | |
49296 | PMIN=PMIN+P(N+IL+1,5) | |
49297 | WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5)) | |
49298 | 380 CONTINUE | |
49299 | ENDIF | |
49300 | ||
49301 | C...Find virtual gamma mass in Dalitz decay. | |
49302 | 390 IF(ND.EQ.2) THEN | |
49303 | ELSEIF(MMAT.EQ.2) THEN | |
49304 | PMES=4D0*PMAS(11,1)**2 | |
49305 | PMRHO2=PMAS(131,1)**2 | |
49306 | PGRHO2=PMAS(131,2)**2 | |
49307 | 400 PMST=PMES*(P(IP,5)**2/PMES)**PYR(0) | |
49308 | WT=(1+0.5D0*PMES/PMST)*SQRT(MAX(0D0,1D0-PMES/PMST))* | |
49309 | & (1D0-PMST/P(IP,5)**2)**3*(1D0+PGRHO2/PMRHO2)/ | |
49310 | & ((1D0-PMST/PMRHO2)**2+PGRHO2/PMRHO2) | |
49311 | IF(WT.LT.PYR(0)) GOTO 400 | |
49312 | PV(2,5)=MAX(2.00001D0*PMAS(11,1),SQRT(PMST)) | |
49313 | ||
49314 | C...M-generator gives weight. If rejected, try again. | |
49315 | ELSE | |
49316 | 410 RORD(1)=1D0 | |
49317 | DO 440 IL1=2,ND-1 | |
49318 | RSAV=PYR(0) | |
49319 | DO 420 IL2=IL1-1,1,-1 | |
49320 | IF(RSAV.LE.RORD(IL2)) GOTO 430 | |
49321 | RORD(IL2+1)=RORD(IL2) | |
49322 | 420 CONTINUE | |
49323 | 430 RORD(IL2+1)=RSAV | |
49324 | 440 CONTINUE | |
49325 | RORD(ND)=0D0 | |
49326 | WT=1D0 | |
49327 | DO 450 IL=ND-1,1,-1 | |
49328 | PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))* | |
49329 | & (PV(1,5)-PS) | |
49330 | WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) | |
49331 | 450 CONTINUE | |
49332 | IF(WT.LT.PYR(0)*WTMAX) GOTO 410 | |
49333 | ENDIF | |
49334 | ||
49335 | C...Perform two-particle decays in respective CM frame. | |
49336 | 460 DO 480 IL=1,ND-1 | |
49337 | PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) | |
49338 | UE(3)=2D0*PYR(0)-1D0 | |
49339 | PHI=PARU(2)*PYR(0) | |
49340 | UE(1)=SQRT(1D0-UE(3)**2)*COS(PHI) | |
49341 | UE(2)=SQRT(1D0-UE(3)**2)*SIN(PHI) | |
49342 | DO 470 J=1,3 | |
49343 | P(N+IL,J)=PA*UE(J) | |
49344 | PV(IL+1,J)=-PA*UE(J) | |
49345 | 470 CONTINUE | |
49346 | P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2) | |
49347 | PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2) | |
49348 | 480 CONTINUE | |
49349 | ||
49350 | C...Lorentz transform decay products to lab frame. | |
49351 | DO 490 J=1,4 | |
49352 | P(N+ND,J)=PV(ND,J) | |
49353 | 490 CONTINUE | |
49354 | DO 530 IL=ND-1,1,-1 | |
49355 | DO 500 J=1,3 | |
49356 | BE(J)=PV(IL,J)/PV(IL,4) | |
49357 | 500 CONTINUE | |
49358 | GA=PV(IL,4)/PV(IL,5) | |
49359 | DO 520 I=N+IL,N+ND | |
49360 | BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) | |
49361 | DO 510 J=1,3 | |
49362 | P(I,J)=P(I,J)+GA*(GA*BEP/(1D0+GA)+P(I,4))*BE(J) | |
49363 | 510 CONTINUE | |
49364 | P(I,4)=GA*(P(I,4)+BEP) | |
49365 | 520 CONTINUE | |
49366 | 530 CONTINUE | |
49367 | ||
49368 | C...Check that no infinite loop in matrix element weight. | |
49369 | NTRY=NTRY+1 | |
49370 | IF(NTRY.GT.800) GOTO 560 | |
49371 | ||
49372 | C...Matrix elements for omega and phi decays. | |
49373 | IF(MMAT.EQ.1) THEN | |
49374 | WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2 | |
49375 | & -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2 | |
49376 | & +2D0*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3) | |
49377 | IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001D0).LT.PYR(0)) GOTO 390 | |
49378 | ||
49379 | C...Matrix elements for pi0 or eta Dalitz decay to gamma e+ e-. | |
49380 | ELSEIF(MMAT.EQ.2) THEN | |
49381 | FOUR12=FOUR(N+1,N+2) | |
49382 | FOUR13=FOUR(N+1,N+3) | |
49383 | WT=(PMST-0.5D0*PMES)*(FOUR12**2+FOUR13**2)+ | |
49384 | & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2) | |
49385 | IF(WT.LT.PYR(0)*0.25D0*PMST*(P(IP,5)**2-PMST)**2) GOTO 460 | |
49386 | ||
49387 | C...Matrix element for S0 -> S1 + V1 -> S1 + S2 + S3 (S scalar, | |
49388 | C...V vector), of form cos**2(theta02) in V1 rest frame, and for | |
49389 | C...S0 -> gamma + V1 -> gamma + S2 + S3, of form sin**2(theta02). | |
49390 | ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN | |
49391 | FOUR10=FOUR(IP,IM) | |
49392 | FOUR12=FOUR(IP,N+1) | |
49393 | FOUR02=FOUR(IM,N+1) | |
49394 | PMS1=P(IP,5)**2 | |
49395 | PMS0=P(IM,5)**2 | |
49396 | PMS2=P(N+1,5)**2 | |
49397 | IF(KFAS.NE.22) HNUM=(FOUR10*FOUR12-PMS1*FOUR02)**2 | |
49398 | IF(KFAS.EQ.22) HNUM=PMS1*(2D0*FOUR10*FOUR12*FOUR02- | |
49399 | & PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2) | |
49400 | HNUM=MAX(1D-6*PMS1**2*PMS0*PMS2,HNUM) | |
49401 | HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2) | |
49402 | IF(HNUM.LT.PYR(0)*HDEN) GOTO 460 | |
49403 | ||
49404 | C...Matrix element for "onium" -> g + g + g or gamma + g + g. | |
49405 | ELSEIF(MMAT.EQ.4) THEN | |
49406 | HX1=2D0*FOUR(IP,N+1)/P(IP,5)**2 | |
49407 | HX2=2D0*FOUR(IP,N+2)/P(IP,5)**2 | |
49408 | HX3=2D0*FOUR(IP,N+3)/P(IP,5)**2 | |
49409 | WT=((1D0-HX1)/(HX2*HX3))**2+((1D0-HX2)/(HX1*HX3))**2+ | |
49410 | & ((1D0-HX3)/(HX1*HX2))**2 | |
49411 | IF(WT.LT.2D0*PYR(0)) GOTO 390 | |
49412 | IF(K(IP+1,2).EQ.22.AND.(1D0-HX1)*P(IP,5)**2.LT.4D0*PARJ(32)**2) | |
49413 | & GOTO 390 | |
49414 | ||
49415 | C...Effective matrix element for nu spectrum in tau -> nu + hadrons. | |
49416 | ELSEIF(MMAT.EQ.41) THEN | |
49417 | HX1=2D0*FOUR(IP,N+1)/P(IP,5)**2 | |
49418 | HXM=MIN(0.75D0,2D0*(1D0-PS/P(IP,5))) | |
49419 | IF(HX1*(3D0-2D0*HX1).LT.PYR(0)*HXM*(3D0-2D0*HXM)) GOTO 390 | |
49420 | ||
49421 | C...Matrix elements for weak decays (only semileptonic for c and b) | |
49422 | ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) | |
49423 | & .AND.ND.EQ.3) THEN | |
49424 | IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3) | |
49425 | IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3) | |
49426 | IF(WT.LT.PYR(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 390 | |
49427 | ELSEIF(MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) THEN | |
49428 | DO 550 J=1,4 | |
49429 | P(N+NP+1,J)=0D0 | |
49430 | DO 540 IS=N+3,N+NP | |
49431 | P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J) | |
49432 | 540 CONTINUE | |
49433 | 550 CONTINUE | |
49434 | IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1) | |
49435 | IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1) | |
49436 | IF(WT.LT.PYR(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 390 | |
49437 | ENDIF | |
49438 | ||
49439 | C...Scale back energy and reattach spectator. | |
49440 | 560 IF(MREM.EQ.1) THEN | |
49441 | DO 570 J=1,5 | |
49442 | PV(1,J)=PV(1,J)/(1D0-PQT) | |
49443 | 570 CONTINUE | |
49444 | ND=ND+1 | |
49445 | MREM=0 | |
49446 | ENDIF | |
49447 | ||
49448 | C...Low invariant mass for system with spectator quark gives particle, | |
49449 | C...not two jets. Readjust momenta accordingly. | |
49450 | IF(MMAT.EQ.31.AND.ND.EQ.3) THEN | |
49451 | MSTJ(93)=1 | |
49452 | PM2=PYMASS(K(N+2,2)) | |
49453 | MSTJ(93)=1 | |
49454 | PM3=PYMASS(K(N+3,2)) | |
49455 | IF(P(N+2,5)**2+P(N+3,5)**2+2D0*FOUR(N+2,N+3).GE. | |
49456 | & (PARJ(32)+PM2+PM3)**2) GOTO 630 | |
49457 | K(N+2,1)=1 | |
49458 | KFTEMP=K(N+2,2) | |
49459 | CALL PYKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2)) | |
49460 | IF(K(N+2,2).EQ.0) GOTO 260 | |
49461 | P(N+2,5)=PYMASS(K(N+2,2)) | |
49462 | PS=P(N+1,5)+P(N+2,5) | |
49463 | PV(2,5)=P(N+2,5) | |
49464 | MMAT=0 | |
49465 | ND=2 | |
49466 | GOTO 460 | |
49467 | ELSEIF(MMAT.EQ.44) THEN | |
49468 | MSTJ(93)=1 | |
49469 | PM3=PYMASS(K(N+3,2)) | |
49470 | MSTJ(93)=1 | |
49471 | PM4=PYMASS(K(N+4,2)) | |
49472 | IF(P(N+3,5)**2+P(N+4,5)**2+2D0*FOUR(N+3,N+4).GE. | |
49473 | & (PARJ(32)+PM3+PM4)**2) GOTO 600 | |
49474 | K(N+3,1)=1 | |
49475 | KFTEMP=K(N+3,2) | |
49476 | CALL PYKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2)) | |
49477 | IF(K(N+3,2).EQ.0) GOTO 260 | |
49478 | P(N+3,5)=PYMASS(K(N+3,2)) | |
49479 | DO 580 J=1,3 | |
49480 | P(N+3,J)=P(N+3,J)+P(N+4,J) | |
49481 | 580 CONTINUE | |
49482 | 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) | |
49483 | HA=P(N+1,4)**2-P(N+2,4)**2 | |
49484 | HB=HA-(P(N+1,5)**2-P(N+2,5)**2) | |
49485 | HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+ | |
49486 | & (P(N+1,3)-P(N+2,3))**2 | |
49487 | HD=(PV(1,4)-P(N+3,4))**2 | |
49488 | HE=HA**2-2D0*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2 | |
49489 | HF=HD*HC-HB**2 | |
49490 | HG=HD*HC-HA*HB | |
49491 | HH=(SQRT(HG**2+HE*HF)-HG)/(2D0*HF) | |
49492 | DO 590 J=1,3 | |
49493 | PCOR=HH*(P(N+1,J)-P(N+2,J)) | |
49494 | P(N+1,J)=P(N+1,J)+PCOR | |
49495 | P(N+2,J)=P(N+2,J)-PCOR | |
49496 | 590 CONTINUE | |
49497 | 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) | |
49498 | 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) | |
49499 | ND=ND-1 | |
49500 | ENDIF | |
49501 | ||
49502 | C...Check invariant mass of W jets. May give one particle or start over. | |
49503 | 600 IF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) | |
49504 | &.AND.IABS(K(N+1,2)).LT.10) THEN | |
49505 | PMR=SQRT(MAX(0D0,P(N+1,5)**2+P(N+2,5)**2+2D0*FOUR(N+1,N+2))) | |
49506 | MSTJ(93)=1 | |
49507 | PM1=PYMASS(K(N+1,2)) | |
49508 | MSTJ(93)=1 | |
49509 | PM2=PYMASS(K(N+2,2)) | |
49510 | IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 610 | |
49511 | KFLDUM=INT(1.5D0+PYR(0)) | |
49512 | CALL PYKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1) | |
49513 | CALL PYKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2) | |
49514 | IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 260 | |
49515 | PSM=PYMASS(KF1)+PYMASS(KF2) | |
49516 | IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.PMR.GT.PARJ(64)+PSM) GOTO 610 | |
49517 | IF(MMAT.GE.43.AND.PMR.GT.0.2D0*PARJ(32)+PSM) GOTO 610 | |
49518 | IF(MMAT.EQ.48) GOTO 390 | |
49519 | IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 260 | |
49520 | K(N+1,1)=1 | |
49521 | KFTEMP=K(N+1,2) | |
49522 | CALL PYKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2)) | |
49523 | IF(K(N+1,2).EQ.0) GOTO 260 | |
49524 | P(N+1,5)=PYMASS(K(N+1,2)) | |
49525 | K(N+2,2)=K(N+3,2) | |
49526 | P(N+2,5)=P(N+3,5) | |
49527 | PS=P(N+1,5)+P(N+2,5) | |
49528 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260 | |
49529 | PV(2,5)=P(N+3,5) | |
49530 | MMAT=0 | |
49531 | ND=2 | |
49532 | GOTO 460 | |
49533 | ENDIF | |
49534 | ||
49535 | C...Phase space decay of partons from W decay. | |
49536 | 610 IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.IABS(K(N+1,2)).LT.10) THEN | |
49537 | KFLO(1)=K(N+1,2) | |
49538 | KFLO(2)=K(N+2,2) | |
49539 | K(N+1,1)=K(N+3,1) | |
49540 | K(N+1,2)=K(N+3,2) | |
49541 | DO 620 J=1,5 | |
49542 | PV(1,J)=P(N+1,J)+P(N+2,J) | |
49543 | P(N+1,J)=P(N+3,J) | |
49544 | 620 CONTINUE | |
49545 | PV(1,5)=PMR | |
49546 | N=N+1 | |
49547 | NP=0 | |
49548 | NQ=2 | |
49549 | PS=0D0 | |
49550 | MSTJ(93)=2 | |
49551 | PSQ=PYMASS(KFLO(1)) | |
49552 | MSTJ(93)=2 | |
49553 | PSQ=PSQ+PYMASS(KFLO(2)) | |
49554 | MMAT=11 | |
49555 | GOTO 290 | |
49556 | ENDIF | |
49557 | ||
49558 | C...Boost back for rapidly moving particle. | |
49559 | 630 N=N+ND | |
49560 | IF(MBST.EQ.1) THEN | |
49561 | DO 640 J=1,3 | |
49562 | BE(J)=P(IP,J)/P(IP,4) | |
49563 | 640 CONTINUE | |
49564 | GA=P(IP,4)/P(IP,5) | |
49565 | DO 660 I=NSAV+1,N | |
49566 | BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) | |
49567 | DO 650 J=1,3 | |
49568 | P(I,J)=P(I,J)+GA*(GA*BEP/(1D0+GA)+P(I,4))*BE(J) | |
49569 | 650 CONTINUE | |
49570 | P(I,4)=GA*(P(I,4)+BEP) | |
49571 | 660 CONTINUE | |
49572 | ENDIF | |
49573 | ||
49574 | C...Fill in position of decay vertex. | |
49575 | DO 680 I=NSAV+1,N | |
49576 | DO 670 J=1,4 | |
49577 | V(I,J)=VDCY(J) | |
49578 | 670 CONTINUE | |
49579 | V(I,5)=0D0 | |
49580 | 680 CONTINUE | |
49581 | ||
49582 | C...Set up for parton shower evolution from jets. | |
49583 | IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN | |
49584 | K(NSAV+1,1)=3 | |
49585 | K(NSAV+2,1)=3 | |
49586 | K(NSAV+3,1)=3 | |
49587 | K(NSAV+1,4)=MSTU(5)*(NSAV+2) | |
49588 | K(NSAV+1,5)=MSTU(5)*(NSAV+3) | |
49589 | K(NSAV+2,4)=MSTU(5)*(NSAV+3) | |
49590 | K(NSAV+2,5)=MSTU(5)*(NSAV+1) | |
49591 | K(NSAV+3,4)=MSTU(5)*(NSAV+1) | |
49592 | K(NSAV+3,5)=MSTU(5)*(NSAV+2) | |
49593 | MSTJ(92)=-(NSAV+1) | |
49594 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN | |
49595 | K(NSAV+2,1)=3 | |
49596 | K(NSAV+3,1)=3 | |
49597 | K(NSAV+2,4)=MSTU(5)*(NSAV+3) | |
49598 | K(NSAV+2,5)=MSTU(5)*(NSAV+3) | |
49599 | K(NSAV+3,4)=MSTU(5)*(NSAV+2) | |
49600 | K(NSAV+3,5)=MSTU(5)*(NSAV+2) | |
49601 | MSTJ(92)=NSAV+2 | |
49602 | ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44).AND. | |
49603 | & IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN | |
49604 | K(NSAV+1,1)=3 | |
49605 | K(NSAV+2,1)=3 | |
49606 | K(NSAV+1,4)=MSTU(5)*(NSAV+2) | |
49607 | K(NSAV+1,5)=MSTU(5)*(NSAV+2) | |
49608 | K(NSAV+2,4)=MSTU(5)*(NSAV+1) | |
49609 | K(NSAV+2,5)=MSTU(5)*(NSAV+1) | |
49610 | MSTJ(92)=NSAV+1 | |
49611 | ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44).AND. | |
49612 | & IABS(K(NSAV+1,2)).LE.20.AND.IABS(K(NSAV+2,2)).LE.20) THEN | |
49613 | MSTJ(92)=NSAV+1 | |
49614 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21) | |
49615 | & THEN | |
49616 | K(NSAV+1,1)=3 | |
49617 | K(NSAV+2,1)=3 | |
49618 | K(NSAV+3,1)=3 | |
49619 | KCP=PYCOMP(K(NSAV+1,2)) | |
49620 | KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2)) | |
49621 | JCON=4 | |
49622 | IF(KQP.LT.0) JCON=5 | |
49623 | K(NSAV+1,JCON)=MSTU(5)*(NSAV+2) | |
49624 | K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1) | |
49625 | K(NSAV+2,JCON)=MSTU(5)*(NSAV+3) | |
49626 | K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2) | |
49627 | MSTJ(92)=NSAV+1 | |
49628 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN | |
49629 | K(NSAV+1,1)=3 | |
49630 | K(NSAV+3,1)=3 | |
49631 | K(NSAV+1,4)=MSTU(5)*(NSAV+3) | |
49632 | K(NSAV+1,5)=MSTU(5)*(NSAV+3) | |
49633 | K(NSAV+3,4)=MSTU(5)*(NSAV+1) | |
49634 | K(NSAV+3,5)=MSTU(5)*(NSAV+1) | |
49635 | MSTJ(92)=NSAV+1 | |
49636 | ENDIF | |
49637 | ||
49638 | C...Mark decayed particle; special option for B-Bbar mixing. | |
49639 | IF(K(IP,1).EQ.5) K(IP,1)=15 | |
49640 | IF(K(IP,1).LE.10) K(IP,1)=11 | |
49641 | IF(MMIX.EQ.1.AND.MSTJ(26).EQ.2.AND.K(IP,1).EQ.11) K(IP,1)=12 | |
49642 | K(IP,4)=NSAV+1 | |
49643 | K(IP,5)=N | |
49644 | ||
49645 | RETURN | |
49646 | END | |
49647 | ||
49648 | ||
49649 | C********************************************************************* | |
49650 | ||
49651 | C...PYDCYK | |
49652 | C...Handles flavour production in the decay of unstable particles | |
49653 | C...and small string clusters. | |
49654 | ||
49655 | SUBROUTINE PYDCYK(KFL1,KFL2,KFL3,KF) | |
49656 | ||
49657 | C...Double precision and integer declarations. | |
49658 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
49659 | IMPLICIT INTEGER(I-N) | |
49660 | INTEGER PYK,PYCHGE,PYCOMP | |
49661 | C...Commonblocks. | |
49662 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
49663 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
49664 | SAVE /PYDAT1/,/PYDAT2/ | |
49665 | ||
49666 | ||
49667 | C.. Call PYKFDI directly if no popcorn option is on | |
49668 | IF(MSTJ(12).LT.2) THEN | |
49669 | CALL PYKFDI(KFL1,KFL2,KFL3,KF) | |
49670 | MSTU(124)=KFL3 | |
49671 | RETURN | |
49672 | ENDIF | |
49673 | ||
49674 | KFL3=0 | |
49675 | KF=0 | |
49676 | IF(KFL1.EQ.0) RETURN | |
49677 | KF1A=IABS(KFL1) | |
49678 | KF2A=IABS(KFL2) | |
49679 | ||
49680 | NSTO=130 | |
49681 | NMAX=MIN(MSTU(125),10) | |
49682 | ||
49683 | C.. Identify rank 0 cluster qq | |
49684 | IRANK=1 | |
49685 | IF(KF1A.GT.10.AND.KF1A.LT.10000) IRANK=0 | |
49686 | ||
49687 | IF(KF2A.GT.0)THEN | |
49688 | C.. Join jets: Fails if store not empty | |
49689 | IF(MSTU(121).GT.0) THEN | |
49690 | MSTU(121)=0 | |
49691 | RETURN | |
49692 | ENDIF | |
49693 | CALL PYKFDI(KFL1,KFL2,KFL3,KF) | |
49694 | ELSEIF(KF1A.GT.10.AND.MSTU(121).GT.0)THEN | |
49695 | C.. Pick popcorn meson from store, return same qq, decrease store | |
49696 | KF=MSTU(NSTO+MSTU(121)) | |
49697 | KFL3=-KFL1 | |
49698 | MSTU(121)=MSTU(121)-1 | |
49699 | ELSE | |
49700 | C.. Generate new flavour. Then done if no diquark is generated | |
49701 | 100 CALL PYKFDI(KFL1,0,KFL3,KF) | |
49702 | IF(MSTU(121).EQ.-1) GOTO 100 | |
49703 | MSTU(124)=KFL3 | |
49704 | IF(KF.EQ.0.OR.IABS(KFL3).LE.10) RETURN | |
49705 | ||
49706 | C.. Simple case if no dynamical popcorn suppressions are considered | |
49707 | IF(MSTJ(12).LT.4) THEN | |
49708 | IF(MSTU(121).EQ.0) RETURN | |
49709 | NMES=1 | |
49710 | KFPREV=-KFL3 | |
49711 | CALL PYKFDI(KFPREV,0,KFL3,KFM) | |
49712 | C.. Due to eta+eta' suppr., a qq->M+qq attempt might end as qq->B+q | |
49713 | IF(IABS(KFL3).LE.10)THEN | |
49714 | KFL3=-KFPREV | |
49715 | RETURN | |
49716 | ENDIF | |
49717 | GOTO 120 | |
49718 | ENDIF | |
49719 | ||
49720 | C test output qq against fake Gamma, then return if no popcorn. | |
49721 | GB=2D0 | |
49722 | IF(IRANK.NE.0)THEN | |
49723 | CALL PYZDIS(1,2103,5D0,Z) | |
49724 | GB=5D0*(1D0-Z)/Z | |
49725 | IF(1D0-PARF(192)**GB.LT.PYR(0)) THEN | |
49726 | MSTU(121)=0 | |
49727 | GOTO 100 | |
49728 | ENDIF | |
49729 | ENDIF | |
49730 | IF(MSTU(121).EQ.0) RETURN | |
49731 | ||
49732 | C..Set store size memory. Pick fake dynamical variables of qq. | |
49733 | NMES=MSTU(121) | |
49734 | CALL PYPTDI(1,PX3,PY3) | |
49735 | X=1D0 | |
49736 | POPM=0D0 | |
49737 | G=GB | |
49738 | POPG=GB | |
49739 | ||
49740 | C.. Pick next popcorn meson, test with fake dynamical variables | |
49741 | 110 KFPREV=-KFL3 | |
49742 | PX1=-PX3 | |
49743 | PY1=-PY3 | |
49744 | CALL PYKFDI(KFPREV,0,KFL3,KFM) | |
49745 | IF(MSTU(121).EQ.-1) GOTO 100 | |
49746 | CALL PYPTDI(KFL3,PX3,PY3) | |
49747 | PM=PYMASS(KFM)**2+(PX1+PX3)**2+(PY1+PY3)**2 | |
49748 | CALL PYZDIS(KFPREV,KFL3,PM,Z) | |
49749 | G=(1D0-Z)*(G+PM/Z) | |
49750 | X=(1D0-Z)*X | |
49751 | ||
49752 | PTST=1D0 | |
49753 | GTST=1D0 | |
49754 | RTST=PYR(0) | |
49755 | IF(MSTJ(12).GT.4)THEN | |
49756 | POPMN=SQRT((1D0-X)*(G/X-GB)) | |
49757 | POPM=POPM+PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3) | |
49758 | PTST=EXP((POPM-POPMN)*PARF(193)) | |
49759 | POPM=POPMN | |
49760 | ENDIF | |
49761 | IF(IRANK.NE.0)THEN | |
49762 | POPGN=X*GB | |
49763 | GTST=(1D0-PARF(192)**POPGN)/(1D0-PARF(192)**POPG) | |
49764 | POPG=POPGN | |
49765 | ENDIF | |
49766 | IF(RTST.GT.PTST*GTST)THEN | |
49767 | MSTU(121)=0 | |
49768 | IF(RTST.GT.PTST) MSTU(121)=-1 | |
49769 | GOTO 100 | |
49770 | ENDIF | |
49771 | ||
49772 | C.. Store meson | |
49773 | 120 IF(NMES.LE.NMAX) MSTU(NSTO+MSTU(121)+1)=KFM | |
49774 | IF(MSTU(121).GT.0) GOTO 110 | |
49775 | ||
49776 | C.. Test accepted system size. If OK set global popcorn size variable. | |
49777 | IF(NMES.GT.NMAX)THEN | |
49778 | KF=0 | |
49779 | KFL3=0 | |
49780 | RETURN | |
49781 | ENDIF | |
49782 | MSTU(121)=NMES | |
49783 | ENDIF | |
49784 | ||
49785 | RETURN | |
49786 | END | |
49787 | ||
49788 | C******************************************************************** | |
49789 | ||
49790 | C...PYKFDI | |
49791 | C...Generates a new flavour pair and combines off a hadron | |
49792 | ||
49793 | SUBROUTINE PYKFDI(KFL1,KFL2,KFL3,KF) | |
49794 | ||
49795 | C...Double precision and integer declarations. | |
49796 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
49797 | IMPLICIT INTEGER(I-N) | |
49798 | INTEGER PYK,PYCHGE,PYCOMP | |
49799 | C...Commonblocks. | |
49800 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
49801 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
49802 | SAVE /PYDAT1/,/PYDAT2/ | |
49803 | C...Local arrays. | |
49804 | DIMENSION PD(7) | |
49805 | ||
49806 | IF(MSTU(123).EQ.0.AND.MSTJ(12).GE.0) CALL PYKFIN | |
49807 | ||
49808 | C...Default flavour values. Input consistency checks. | |
49809 | KF1A=IABS(KFL1) | |
49810 | KF2A=IABS(KFL2) | |
49811 | KFL3=0 | |
49812 | KF=0 | |
49813 | IF(KF1A.EQ.0) RETURN | |
49814 | IF(KF2A.NE.0)THEN | |
49815 | IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN | |
49816 | IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN | |
49817 | IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN | |
49818 | ENDIF | |
49819 | ||
49820 | C...Check if tabulated flavour probabilities are to be used. | |
49821 | IF(MSTJ(15).EQ.1) THEN | |
49822 | IF(MSTJ(12).GE.5) CALL PYERRM(29, | |
49823 | & '(PYKFDI:) Sorry, option MSTJ(15)=1 not available' // | |
49824 | & ' together with MSTJ(12)>=5 modification') | |
49825 | KTAB1=-1 | |
49826 | IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A | |
49827 | KFL1A=MOD(KF1A/1000,10) | |
49828 | KFL1B=MOD(KF1A/100,10) | |
49829 | KFL1S=MOD(KF1A,10) | |
49830 | IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4) | |
49831 | & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2 | |
49832 | IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1 | |
49833 | IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A | |
49834 | KTAB2=0 | |
49835 | IF(KF2A.NE.0) THEN | |
49836 | KTAB2=-1 | |
49837 | IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A | |
49838 | KFL2A=MOD(KF2A/1000,10) | |
49839 | KFL2B=MOD(KF2A/100,10) | |
49840 | KFL2S=MOD(KF2A,10) | |
49841 | IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4) | |
49842 | & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2 | |
49843 | IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1 | |
49844 | ENDIF | |
49845 | IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 140 | |
49846 | ENDIF | |
49847 | ||
49848 | C.. Recognize rank 0 diquark case | |
49849 | 100 IRANK=1 | |
49850 | KFDIQ=MAX(KF1A,KF2A) | |
49851 | IF(KFDIQ.GT.10.AND.KFDIQ.LT.10000) IRANK=0 | |
49852 | ||
49853 | C.. Join two flavours to meson or baryon. Test for popcorn. | |
49854 | IF(KF2A.GT.0)THEN | |
49855 | MBARY=0 | |
49856 | IF(KFDIQ.GT.10) THEN | |
49857 | IF(IRANK.EQ.0.AND.MSTJ(12).LT.5) | |
49858 | & CALL PYNMES(KFDIQ) | |
49859 | IF(MSTU(121).NE.0) THEN | |
49860 | MSTU(121)=0 | |
49861 | RETURN | |
49862 | ENDIF | |
49863 | MBARY=2 | |
49864 | ENDIF | |
49865 | KFQOLD=KF1A | |
49866 | KFQVER=KF2A | |
49867 | GOTO 130 | |
49868 | ENDIF | |
49869 | ||
49870 | C.. Separate incoming flavours, curtain flavour consistency check | |
49871 | KFIN=KFL1 | |
49872 | KFQOLD=KF1A | |
49873 | KFQPOP=KF1A/10000 | |
49874 | IF(KF1A.GT.10)THEN | |
49875 | KFIN=-KFL1 | |
49876 | KFL1A=MOD(KF1A/1000,10) | |
49877 | KFL1B=MOD(KF1A/100,10) | |
49878 | IF(IRANK.EQ.0)THEN | |
49879 | QAWT=1D0 | |
49880 | IF(KFL1A.GE.3) QAWT=PARF(136+KFL1A/4) | |
49881 | IF(KFL1B.GE.3) QAWT=QAWT/PARF(136+KFL1B/4) | |
49882 | KFQPOP=KFL1A+(KFL1B-KFL1A)*INT(1D0/(QAWT+1D0)+PYR(0)) | |
49883 | ENDIF | |
49884 | IF(KFQPOP.NE.KFL1B.AND.KFQPOP.NE.KFL1A) THEN | |
49885 | MSTU(121)=0 | |
49886 | RETURN | |
49887 | ENDIF | |
49888 | KFQOLD=KFL1A+KFL1B-KFQPOP | |
49889 | ENDIF | |
49890 | ||
49891 | C...Meson/baryon choice. Set number of mesons if starting a popcorn | |
49892 | C...system. | |
49893 | 110 MBARY=0 | |
49894 | IF(KF1A.LE.10.AND.MSTJ(12).GT.0)THEN | |
49895 | IF(MSTU(121).EQ.-1.OR.(1D0+PARJ(1))*PYR(0).GT.1D0)THEN | |
49896 | MBARY=1 | |
49897 | CALL PYNMES(0) | |
49898 | ENDIF | |
49899 | ELSEIF(KF1A.GT.10)THEN | |
49900 | MBARY=2 | |
49901 | IF(IRANK.EQ.0) CALL PYNMES(KF1A) | |
49902 | IF(MSTU(121).GT.0) MBARY=-1 | |
49903 | ENDIF | |
49904 | ||
49905 | C..x->H+q: Choose single vertex quark. Jump to form hadron. | |
49906 | IF(MBARY.EQ.0.OR.MBARY.EQ.2)THEN | |
49907 | KFQVER=1+INT((2D0+PARJ(2))*PYR(0)) | |
49908 | KFL3=ISIGN(KFQVER,-KFIN) | |
49909 | GOTO 130 | |
49910 | ENDIF | |
49911 | ||
49912 | C..x->H+qq: (IDW=proper PARF position for diquark weights) | |
49913 | IDW=160 | |
49914 | IF(MBARY.EQ.1)THEN | |
49915 | IF(MSTU(121).EQ.0) IDW=150 | |
49916 | SQWT=PARF(IDW+1) | |
49917 | IF(MSTU(121).GT.0) SQWT=SQWT*PARF(135)*PARF(138)**MSTU(121) | |
49918 | KFQPOP=1+INT((2D0+SQWT)*PYR(0)) | |
49919 | C.. Shift to s-curtain parameters if needed | |
49920 | IF(KFQPOP.GE.3.AND.MSTJ(12).GE.5)THEN | |
49921 | PARF(194)=PARF(138)*PARF(139) | |
49922 | PARF(193)=PARJ(8)+PARJ(9) | |
49923 | ENDIF | |
49924 | ENDIF | |
49925 | ||
49926 | C.. x->H+qq: Get vertex quark | |
49927 | IF(MBARY.EQ.-1.AND.MSTJ(12).GE.5)THEN | |
49928 | IDW=MSTU(122) | |
49929 | MSTU(121)=MSTU(121)-1 | |
49930 | IF(IDW.EQ.170) THEN | |
49931 | IF(MSTU(121).EQ.0)THEN | |
49932 | IPOS=3*MIN(KFQPOP-1,2)+MIN(KFQOLD-1,2) | |
49933 | ELSE | |
49934 | IPOS=3*3+3*MAX(0,MIN(KFQPOP-2,1))+MIN(KFQOLD-1,2) | |
49935 | ENDIF | |
49936 | ELSE | |
49937 | IF(MSTU(121).EQ.0)THEN | |
49938 | IPOS=3*5+5*MIN(KFQPOP-1,3)+MIN(KFQOLD-1,4) | |
49939 | ELSE | |
49940 | IPOS=3*5+5*4+MIN(KFQOLD-1,4) | |
49941 | ENDIF | |
49942 | ENDIF | |
49943 | IPOS=200+30*IPOS+1 | |
49944 | ||
49945 | IMES=-1 | |
49946 | RMES=PYR(0)*PARF(194) | |
49947 | 120 IMES=IMES+1 | |
49948 | RMES=RMES-PARF(IPOS+IMES) | |
49949 | IF(IMES.EQ.30) THEN | |
49950 | MSTU(121)=-1 | |
49951 | KF=-111 | |
49952 | RETURN | |
49953 | ENDIF | |
49954 | IF(RMES.GT.0D0) GOTO 120 | |
49955 | KMUL=IMES/5 | |
49956 | KFJ=2*KMUL+1 | |
49957 | IF(KMUL.EQ.2) KFJ=10003 | |
49958 | IF(KMUL.EQ.3) KFJ=10001 | |
49959 | IF(KMUL.EQ.4) KFJ=20003 | |
49960 | IF(KMUL.EQ.5) KFJ=5 | |
49961 | IDIAG=0 | |
49962 | KFQVER=MOD(IMES,5)+1 | |
49963 | IF(KFQVER.GE.KFQOLD) KFQVER=KFQVER+1 | |
49964 | IF(KFQVER.GT.3)THEN | |
49965 | IDIAG=KFQVER-3 | |
49966 | KFQVER=KFQOLD | |
49967 | ENDIF | |
49968 | ELSE | |
49969 | IF(MBARY.EQ.-1) IDW=170 | |
49970 | SQWT=PARF(IDW+2) | |
49971 | IF(KFQPOP.EQ.3) SQWT=PARF(IDW+3) | |
49972 | IF(KFQPOP.GT.3) SQWT=PARF(IDW+3)*(1D0/PARF(IDW+5)+1D0)/2D0 | |
49973 | KFQVER=MIN(3,1+INT((2D0+SQWT)*PYR(0))) | |
49974 | IF(KFQPOP.LT.3.AND.KFQVER.LT.3)THEN | |
49975 | KFQVER=KFQPOP | |
49976 | IF(PYR(0).GT.PARF(IDW+4)) KFQVER=3-KFQPOP | |
49977 | ENDIF | |
49978 | ENDIF | |
49979 | ||
49980 | C..x->H+qq: form outgoing diquark with KFQPOP flag at 10000-pos | |
49981 | KFLDS=3 | |
49982 | IF(KFQPOP.NE.KFQVER)THEN | |
49983 | SWT=PARF(IDW+7) | |
49984 | IF(KFQVER.EQ.3) SWT=PARF(IDW+6) | |
49985 | IF(KFQPOP.GE.3) SWT=PARF(IDW+5) | |
49986 | IF((1D0+SWT)*PYR(0).LT.1D0) KFLDS=1 | |
49987 | ENDIF | |
49988 | KFDIQ=900*MAX(KFQVER,KFQPOP)+100*(KFQVER+KFQPOP)+KFLDS | |
49989 | & +10000*KFQPOP | |
49990 | KFL3=ISIGN(KFDIQ,KFIN) | |
49991 | ||
49992 | C..x->M+y: flavour for meson. | |
49993 | 130 IF(MBARY.LE.0)THEN | |
49994 | KFLA=MAX(KFQOLD,KFQVER) | |
49995 | KFLB=MIN(KFQOLD,KFQVER) | |
49996 | KFS=ISIGN(1,KFL1) | |
49997 | IF(KFLA.NE.KFQOLD) KFS=-KFS | |
49998 | C... Form meson, with spin and flavour mixing for diagonal states. | |
49999 | IF(MBARY.EQ.-1.AND.MSTJ(12).GE.5)THEN | |
50000 | IF(IDIAG.GT.0) KF=110*IDIAG+KFJ | |
50001 | IF(IDIAG.EQ.0) KF=(100*KFLA+10*KFLB+KFJ)*KFS*(-1)**KFLA | |
50002 | RETURN | |
50003 | ENDIF | |
50004 | IF(KFLA.LE.2) KMUL=INT(PARJ(11)+PYR(0)) | |
50005 | IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+PYR(0)) | |
50006 | IF(KFLA.GE.4) KMUL=INT(PARJ(13)+PYR(0)) | |
50007 | IF(KMUL.EQ.0.AND.PARJ(14).GT.0D0)THEN | |
50008 | IF(PYR(0).LT.PARJ(14)) KMUL=2 | |
50009 | ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0D0)THEN | |
50010 | RMUL=PYR(0) | |
50011 | IF(RMUL.LT.PARJ(15)) KMUL=3 | |
50012 | IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4 | |
50013 | IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5 | |
50014 | ENDIF | |
50015 | KFLS=3 | |
50016 | IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 | |
50017 | IF(KMUL.EQ.5) KFLS=5 | |
50018 | IF(KFLA.NE.KFLB)THEN | |
50019 | KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA | |
50020 | ELSE | |
50021 | RMIX=PYR(0) | |
50022 | IMIX=2*KFLA+10*KMUL | |
50023 | IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+ | |
50024 | & INT(RMIX+PARF(IMIX)))+KFLS | |
50025 | IF(KFLA.GE.4) KF=110*KFLA+KFLS | |
50026 | ENDIF | |
50027 | IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF) | |
50028 | IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF) | |
50029 | ||
50030 | C..Optional extra suppression of eta and eta'. | |
50031 | C..Allow shift to qq->B+q in old version (set IRANK to 0) | |
50032 | IF(KF.EQ.221.OR.KF.EQ.331)THEN | |
50033 | IF(PYR(0).GT.PARJ(25+KF/300))THEN | |
50034 | IF(KF2A.GT.0) GOTO 130 | |
50035 | IF(MSTJ(12).LT.4) IRANK=0 | |
50036 | GOTO 110 | |
50037 | ENDIF | |
50038 | ENDIF | |
50039 | MSTU(121)=0 | |
50040 | ||
50041 | C.. x->B+y: Flavour for baryon | |
50042 | ELSE | |
50043 | KFLA=KFQVER | |
50044 | IF(KF1A.LE.10) KFLA=KFQOLD | |
50045 | KFLB=MOD(KFDIQ/1000,10) | |
50046 | KFLC=MOD(KFDIQ/100,10) | |
50047 | KFLDS=MOD(KFDIQ,10) | |
50048 | KFLD=MAX(KFLA,KFLB,KFLC) | |
50049 | KFLF=MIN(KFLA,KFLB,KFLC) | |
50050 | KFLE=KFLA+KFLB+KFLC-KFLD-KFLF | |
50051 | ||
50052 | C... SU(6) factors for formation of baryon. | |
50053 | KBARY=3 | |
50054 | KDMAX=5 | |
50055 | KFLG=KFLB | |
50056 | IF(KFLB.NE.KFLC)THEN | |
50057 | KBARY=2*KFLDS-1 | |
50058 | KDMAX=1+KFLDS/2 | |
50059 | IF(KFLB.GT.2) KDMAX=KDMAX+2 | |
50060 | ENDIF | |
50061 | IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC)THEN | |
50062 | KBARY=KBARY+1 | |
50063 | KFLG=KFLA | |
50064 | ENDIF | |
50065 | ||
50066 | SU6MAX=PARF(140+KDMAX) | |
50067 | SU6DEC=PARJ(18) | |
50068 | SU6S =PARF(146) | |
50069 | IF(MSTJ(12).GE.5.AND.IRANK.EQ.0) THEN | |
50070 | SU6MAX=1D0 | |
50071 | SU6DEC=1D0 | |
50072 | SU6S =1D0 | |
50073 | ENDIF | |
50074 | SU6OCT=PARF(60+KBARY) | |
50075 | IF(KFLG.GT.MAX(KFLA+KFLB-KFLG,2))THEN | |
50076 | SU6OCT=SU6OCT*4*SU6S/(3*SU6S+1) | |
50077 | IF(KBARY.EQ.2) SU6OCT=PARF(60+KBARY)*4/(3*SU6S+1) | |
50078 | ELSE | |
50079 | IF(KBARY.EQ.6) SU6OCT=SU6OCT*(3+SU6S)/(3*SU6S+1) | |
50080 | ENDIF | |
50081 | SU6WT=SU6OCT+SU6DEC*PARF(70+KBARY) | |
50082 | ||
50083 | C.. SU(6) test. Old options enforce new baryon if q->B+qq is rejected. | |
50084 | IF(SU6WT.LT.PYR(0)*SU6MAX.AND.KF2A.EQ.0)THEN | |
50085 | MSTU(121)=0 | |
50086 | IF(MSTJ(12).LE.2.AND.MBARY.EQ.1) MSTU(121)=-1 | |
50087 | GOTO 110 | |
50088 | ENDIF | |
50089 | ||
50090 | C.. Form baryon. Distinguish Lambda- and Sigmalike baryons. | |
50091 | KSIG=1 | |
50092 | KFLS=2 | |
50093 | IF(SU6WT*PYR(0).GT.SU6OCT) KFLS=4 | |
50094 | IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF)THEN | |
50095 | KSIG=KFLDS/3 | |
50096 | IF(KFLA.NE.KFLD) KSIG=INT(3*SU6S/(3*SU6S+KFLDS**2)+PYR(0)) | |
50097 | ENDIF | |
50098 | KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1) | |
50099 | IF(KSIG.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1) | |
50100 | ENDIF | |
aabcdb29 | 50101 | C ------------------------------------------------------------------------- |
50102 | C Extracted from a private e-mail exchange with Torbjorn Sjostrand | |
50103 | C | |
50104 | C No, Lambda(1520) is not included and not foreseen. | |
50105 | C So if you want it in Pythia, it would have to be a hack. | |
50106 | C What you could do is: | |
50107 | C 1) In PYKFDI, just before the RETURN above label 140, you could check if | |
50108 | C a Lambda, Sigma0 or Sigma*0 has been produced, and with some small | |
50109 | C probability switch such a particle to the Lambda(1520) code. That is, | |
50110 | C if KF = 3122, 3212, or 3214 and a random number below some number, switch | |
50111 | C to KF = 3124. (And correspondingly for anticparticles.) | |
50112 | C 2) Use the PYUPDA routine (see manual) to include particle and decay data | |
50113 | C for the Lambda(1520). | |
50114 | C ------------------------------------------------------------------------- | |
50115 | ||
bf6cd108 | 50116 | IF (IABS(KF).EQ.3122) THEN |
aabcdb29 | 50117 | C Converting a fraction (0.20) of Lambda0 to Lambda(1520) + c.c. |
50118 | C This fraction is based on the experimental measurement at ISR | |
50119 | C Bobbink 83, NP B217,11 (1983) | |
50120 | C The region 0.5 < XF < 1.0 has been extrapolated to XF=0 | |
bf6cd108 | 50121 | IF(PYR(0).LE.0.20) KF=ISIGN(3124,KF) |
50122 | ENDIF | |
aabcdb29 | 50123 | |
bf6cd108 | 50124 | IF(IABS(KF).EQ.3212) THEN |
aabcdb29 | 50125 | C Converting a fraction (0.20) of Sigma0 to Lambda(1520) + c.c. |
50126 | C We suppose the same fraction as for Lambda0 | |
bf6cd108 | 50127 | IF(PYR(0).LE.0.20) KF=ISIGN(3124,KF) |
50128 | ENDIF | |
aabcdb29 | 50129 | |
bf6cd108 | 50130 | IF (IABS(KF).EQ.3214) THEN |
aabcdb29 | 50131 | C Converting a fraction (0.30) of Sigma0(1385) to Lambda(1520) + c.c. |
50132 | C This is conservative extimate supposing that the ratio | |
50133 | C scales as (M_Sigma1385/M_Lambda0)^2 ~ 1.5 | |
bf6cd108 | 50134 | IF(PYR(0).LE.0.30) KF=ISIGN(3124,KF) |
50135 | ENDIF | |
2dfa57d1 | 50136 | RETURN |
50137 | ||
50138 | C...Use tabulated probabilities to select new flavour and hadron. | |
50139 | 140 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN | |
50140 | KT3L=1 | |
50141 | KT3U=6 | |
50142 | ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN | |
50143 | KT3L=1 | |
50144 | KT3U=6 | |
50145 | ELSEIF(KTAB2.EQ.0) THEN | |
50146 | KT3L=1 | |
50147 | KT3U=22 | |
50148 | ELSE | |
50149 | KT3L=KTAB2 | |
50150 | KT3U=KTAB2 | |
50151 | ENDIF | |
50152 | RFL=0D0 | |
50153 | DO 160 KTS=0,2 | |
50154 | DO 150 KT3=KT3L,KT3U | |
50155 | RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3) | |
50156 | 150 CONTINUE | |
50157 | 160 CONTINUE | |
50158 | RFL=PYR(0)*RFL | |
50159 | DO 180 KTS=0,2 | |
50160 | KTABS=KTS | |
50161 | DO 170 KT3=KT3L,KT3U | |
50162 | KTAB3=KT3 | |
50163 | RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3) | |
50164 | IF(RFL.LE.0D0) GOTO 190 | |
50165 | 170 CONTINUE | |
50166 | 180 CONTINUE | |
50167 | 190 CONTINUE | |
50168 | ||
50169 | C...Reconstruct flavour of produced quark/diquark. | |
50170 | IF(KTAB3.LE.6) THEN | |
50171 | KFL3A=KTAB3 | |
50172 | KFL3B=0 | |
50173 | KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13)) | |
50174 | ELSE | |
50175 | KFL3A=1 | |
50176 | IF(KTAB3.GE.8) KFL3A=2 | |
50177 | IF(KTAB3.GE.11) KFL3A=3 | |
50178 | IF(KTAB3.GE.16) KFL3A=4 | |
50179 | KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2 | |
50180 | KFL3=1000*KFL3A+100*KFL3B+1 | |
50181 | IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3= | |
50182 | & KFL3+2 | |
50183 | KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1)) | |
50184 | ENDIF | |
50185 | ||
50186 | C...Reconstruct meson code. | |
50187 | IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR. | |
50188 | &KFL3B.NE.0)) THEN | |
50189 | RFL=PYR(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ | |
50190 | & 25*KTABS)+PARF(145+80*KTAB1+25*KTABS)) | |
50191 | KF=110+2*KTABS+1 | |
50192 | IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1 | |
50193 | IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ | |
50194 | & 25*KTABS)) KF=330+2*KTABS+1 | |
50195 | ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN | |
50196 | KFLA=MAX(KTAB1,KTAB3) | |
50197 | KFLB=MIN(KTAB1,KTAB3) | |
50198 | KFS=ISIGN(1,KFL1) | |
50199 | IF(KFLA.NE.KF1A) KFS=-KFS | |
50200 | KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA | |
50201 | ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN | |
50202 | KFS=ISIGN(1,KFL1) | |
50203 | IF(KFL1A.EQ.KFL3A) THEN | |
50204 | KFLA=MAX(KFL1B,KFL3B) | |
50205 | KFLB=MIN(KFL1B,KFL3B) | |
50206 | IF(KFLA.NE.KFL1B) KFS=-KFS | |
50207 | ELSEIF(KFL1A.EQ.KFL3B) THEN | |
50208 | KFLA=KFL3A | |
50209 | KFLB=KFL1B | |
50210 | KFS=-KFS | |
50211 | ELSEIF(KFL1B.EQ.KFL3A) THEN | |
50212 | KFLA=KFL1A | |
50213 | KFLB=KFL3B | |
50214 | ELSEIF(KFL1B.EQ.KFL3B) THEN | |
50215 | KFLA=MAX(KFL1A,KFL3A) | |
50216 | KFLB=MIN(KFL1A,KFL3A) | |
50217 | IF(KFLA.NE.KFL1A) KFS=-KFS | |
50218 | ELSE | |
50219 | CALL PYERRM(2,'(PYKFDI:) no matching flavours for qq -> qq') | |
50220 | GOTO 100 | |
50221 | ENDIF | |
50222 | KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA | |
50223 | ||
50224 | C...Reconstruct baryon code. | |
50225 | ELSE | |
50226 | IF(KTAB1.GE.7) THEN | |
50227 | KFLA=KFL3A | |
50228 | KFLB=KFL1A | |
50229 | KFLC=KFL1B | |
50230 | ELSE | |
50231 | KFLA=KFL1A | |
50232 | KFLB=KFL3A | |
50233 | KFLC=KFL3B | |
50234 | ENDIF | |
50235 | KFLD=MAX(KFLA,KFLB,KFLC) | |
50236 | KFLF=MIN(KFLA,KFLB,KFLC) | |
50237 | KFLE=KFLA+KFLB+KFLC-KFLD-KFLF | |
50238 | IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1) | |
50239 | IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1) | |
50240 | ENDIF | |
50241 | ||
50242 | C...Check that constructed flavour code is an allowed one. | |
50243 | IF(KFL2.NE.0) KFL3=0 | |
50244 | KC=PYCOMP(KF) | |
50245 | IF(KC.EQ.0) THEN | |
50246 | CALL PYERRM(2,'(PYKFDI:) user-defined flavour probabilities '// | |
50247 | & 'failed') | |
50248 | GOTO 100 | |
50249 | ENDIF | |
50250 | ||
50251 | RETURN | |
50252 | END | |
50253 | ||
50254 | C********************************************************************* | |
50255 | ||
50256 | C...PYNMES | |
50257 | C...Generates number of popcorn mesons and stores some relevant | |
50258 | C...parameters. | |
50259 | ||
50260 | SUBROUTINE PYNMES(KFDIQ) | |
50261 | ||
50262 | C...Double precision and integer declarations. | |
50263 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
50264 | IMPLICIT INTEGER(I-N) | |
50265 | INTEGER PYK,PYCHGE,PYCOMP | |
50266 | C...Commonblocks. | |
50267 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
50268 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
50269 | SAVE /PYDAT1/,/PYDAT2/ | |
50270 | ||
50271 | MSTU(121)=0 | |
50272 | IF(MSTJ(12).LT.2) RETURN | |
50273 | ||
50274 | C..Old version: Get 1 or 0 popcorn mesons | |
50275 | IF(MSTJ(12).LT.5)THEN | |
50276 | POPWT=PARF(131) | |
50277 | IF(KFDIQ.NE.0) THEN | |
50278 | KFDIQA=IABS(KFDIQ) | |
50279 | KFA=MOD(KFDIQA/1000,10) | |
50280 | KFB=MOD(KFDIQA/100,10) | |
50281 | KFS=MOD(KFDIQA,10) | |
50282 | POPWT=PARF(132) | |
50283 | IF(KFA.EQ.3) POPWT=PARF(133) | |
50284 | IF(KFB.EQ.3) POPWT=PARF(134) | |
50285 | IF(KFS.EQ.1) POPWT=POPWT*SQRT(PARJ(4)) | |
50286 | ENDIF | |
50287 | MSTU(121)=INT(POPWT/(1D0+POPWT)+PYR(0)) | |
50288 | RETURN | |
50289 | ENDIF | |
50290 | ||
50291 | C..New version: Store popcorn- or rank 0 diquark parameters | |
50292 | MSTU(122)=170 | |
50293 | PARF(193)=PARJ(8) | |
50294 | PARF(194)=PARF(139) | |
50295 | IF(KFDIQ.NE.0) THEN | |
50296 | MSTU(122)=180 | |
50297 | PARF(193)=PARJ(10) | |
50298 | PARF(194)=PARF(140) | |
50299 | ENDIF | |
50300 | IF(PARF(194).LT.1D-5.OR.PARF(194).GT.1D0-1D-5) THEN | |
50301 | IF(PARF(194).GT.1D0-1D-5) CALL PYERRM(9, | |
50302 | & '(PYNMES:) Neglecting too large popcorn possibility') | |
50303 | RETURN | |
50304 | ENDIF | |
50305 | ||
50306 | C..New version: Get number of popcorn mesons | |
50307 | 100 RTST=PYR(0) | |
50308 | MSTU(121)=-1 | |
50309 | 110 MSTU(121)=MSTU(121)+1 | |
50310 | RTST=RTST/PARF(194) | |
50311 | IF(RTST.LT.1D0) GOTO 110 | |
50312 | IF(KFDIQ.EQ.0.AND.PYR(0)*(2D0+PARF(135)*PARF(161)).GT. | |
50313 | & (2D0+PARF(135)*PARF(161)*PARF(138)**MSTU(121))) GOTO 100 | |
50314 | RETURN | |
50315 | END | |
50316 | ||
50317 | C*************************************************************** | |
50318 | ||
50319 | C...PYKFIN | |
50320 | C...Precalculates a set of diquark and popcorn weights. | |
50321 | ||
50322 | SUBROUTINE PYKFIN | |
50323 | ||
50324 | C...Double precision and integer declarations. | |
50325 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
50326 | IMPLICIT INTEGER(I-N) | |
50327 | INTEGER PYK,PYCHGE,PYCOMP | |
50328 | C...Commonblocks. | |
50329 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
50330 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
50331 | SAVE /PYDAT1/,/PYDAT2/ | |
50332 | ||
50333 | DIMENSION SU6(12),SU6M(7),QBB(7),QBM(7),DMB(14) | |
50334 | ||
50335 | ||
50336 | MSTU(123)=1 | |
50337 | C..Diquark indices for dimensional variables | |
50338 | IUD1=1 | |
50339 | IUU1=2 | |
50340 | IUS0=3 | |
50341 | ISU0=4 | |
50342 | IUS1=5 | |
50343 | ISU1=6 | |
50344 | ISS1=7 | |
50345 | ||
50346 | C.. *** SU(6) factors ** | |
50347 | C..Modify with decuplet- (and Sigma/Lambda-) suppression. | |
50348 | PARF(146)=1D0 | |
50349 | IF(MSTJ(12).GE.5) PARF(146)=3D0*PARJ(18)/(2D0*PARJ(18)+1D0) | |
50350 | IF(PARJ(18).LT.1D0-1D-5.AND.MSTJ(12).LT.5) CALL PYERRM(9, | |
50351 | & '(PYKFIN:) PARJ(18)<1 combined with 0<MSTJ(12)<5 option') | |
50352 | DO 100 I=1,6 | |
50353 | SU6(I)=PARF(60+I) | |
50354 | SU6(6+I)=SU6(I)*4*PARF(146)/(3*PARF(146)+1) | |
50355 | 100 CONTINUE | |
50356 | SU6(8)=SU6(2)*4/(3*PARF(146)+1) | |
50357 | SU6(6)=SU6(6)*(3+PARF(146))/(3*PARF(146)+1) | |
50358 | DO 110 I=1,6 | |
50359 | SU6(I)=SU6(I)+PARJ(18)*PARF(70+I) | |
50360 | SU6(6+I)=SU6(6+I)+PARJ(18)*PARF(70+I) | |
50361 | 110 CONTINUE | |
50362 | ||
50363 | C..SU(6)max q q' s,c,b | |
50364 | SU6MUD =MAX(SU6(1) , SU6(8) ) | |
50365 | SU6M(IUD1)=MAX(SU6(5) , SU6(12)) | |
50366 | SU6M(ISU0)=MAX(SU6(7) ,SU6(2),SU6MUD ) | |
50367 | SU6M(IUU1)=MAX(SU6(3) ,SU6(4),SU6(10)) | |
50368 | SU6M(ISU1)=MAX(SU6(11),SU6(6),SU6M(IUD1)) | |
50369 | SU6M(IUS0)=SU6M(ISU0) | |
50370 | SU6M(ISS1)=SU6M(IUU1) | |
50371 | SU6M(IUS1)=SU6M(ISU1) | |
50372 | ||
50373 | C..Store SU(6)max, in order UD0,UD1,US0,US1,QQ1 | |
50374 | PARF(141)=SU6MUD | |
50375 | PARF(142)=SU6M(IUD1) | |
50376 | PARF(143)=SU6M(ISU0) | |
50377 | PARF(144)=SU6M(ISU1) | |
50378 | PARF(145)=SU6M(ISS1) | |
50379 | ||
50380 | C..diquark SU(6) survival = | |
50381 | C..sum over quark (quark tunnel weight)*(SU(6)). | |
50382 | PUD0=(2D0*SU6(1)+PARJ(2)*SU6(8)) | |
50383 | DMB(ISU0)=(SU6(7)+SU6(2)+PARJ(2)*SU6(1))/PUD0 | |
50384 | DMB(IUS0)=DMB(ISU0) | |
50385 | DMB(ISS1)=(2D0*SU6(4)+PARJ(2)*SU6(3))/PUD0 | |
50386 | DMB(IUU1)=(SU6(3)+SU6(4)+PARJ(2)*SU6(10))/PUD0 | |
50387 | DMB(ISU1)=(SU6(11)+SU6(6)+PARJ(2)*SU6(5))/PUD0 | |
50388 | DMB(IUS1)=DMB(ISU1) | |
50389 | DMB(IUD1)=(2D0*SU6(5)+PARJ(2)*SU6(12))/PUD0 | |
50390 | ||
50391 | C.. *** Tunneling factors for Diquark production*** | |
50392 | C.. T: half a curtain pair = sqrt(curtain pair factor) | |
50393 | IF(MSTJ(12).GE.5) THEN | |
50394 | PMUD0=PYMASS(2101) | |
50395 | PMUD1=PYMASS(2103)-PMUD0 | |
50396 | PMUS0=PYMASS(3201)-PMUD0 | |
50397 | PMUS1=PYMASS(3203)-PMUS0-PMUD0 | |
50398 | PMSS1=PYMASS(3303)-PMUS0-PMUD0 | |
50399 | QBB(ISU0)=EXP(-(PARJ(9)+PARJ(8))*PMUS0-PARJ(9)*PARF(191)) | |
50400 | QBB(IUS0)=EXP(-PARJ(8)*PMUS0) | |
50401 | QBB(ISS1)=EXP(-(PARJ(9)+PARJ(8))*PMSS1)*QBB(ISU0) | |
50402 | QBB(IUU1)=EXP(-PARJ(8)*PMUD1) | |
50403 | QBB(ISU1)=EXP(-(PARJ(9)+PARJ(8))*PMUS1)*QBB(ISU0) | |
50404 | QBB(IUS1)=EXP(-PARJ(8)*PMUS1)*QBB(IUS0) | |
50405 | QBB(IUD1)=QBB(IUU1) | |
50406 | ELSE | |
50407 | PAR2M=SQRT(PARJ(2)) | |
50408 | PAR3M=SQRT(PARJ(3)) | |
50409 | PAR4M=SQRT(PARJ(4)) | |
50410 | QBB(ISU0)=PAR2M*PAR3M | |
50411 | QBB(IUS0)=PAR3M | |
50412 | QBB(ISS1)=PAR2M*PARJ(3)*PAR4M | |
50413 | QBB(IUU1)=PAR4M | |
50414 | QBB(ISU1)=PAR4M*QBB(ISU0) | |
50415 | QBB(IUS1)=PAR4M*QBB(IUS0) | |
50416 | QBB(IUD1)=PAR4M | |
50417 | ENDIF | |
50418 | ||
50419 | C.. tau: spin*(vertex factor)*(T = half-curtain factor) | |
50420 | QBM(ISU0)=QBB(ISU0) | |
50421 | QBM(IUS0)=PARJ(2)*QBB(IUS0) | |
50422 | QBM(ISS1)=PARJ(2)*6D0*QBB(ISS1) | |
50423 | QBM(IUU1)=6D0*QBB(IUU1) | |
50424 | QBM(ISU1)=3D0*QBB(ISU1) | |
50425 | QBM(IUS1)=PARJ(2)*3D0*QBB(IUS1) | |
50426 | QBM(IUD1)=3D0*QBB(IUD1) | |
50427 | ||
50428 | C.. Combine T and tau to diquark weight for q-> B+B+.. | |
50429 | DO 120 I=1,7 | |
50430 | QBB(I)=QBB(I)*QBM(I) | |
50431 | 120 CONTINUE | |
50432 | ||
50433 | IF(MSTJ(12).GE.5)THEN | |
50434 | C..New version: tau for rank 0 diquark. | |
50435 | DMB(7+ISU0)=EXP(-PARJ(10)*PMUS0) | |
50436 | DMB(7+IUS0)=PARJ(2)*DMB(7+ISU0) | |
50437 | DMB(7+ISS1)=6D0*PARJ(2)*EXP(-PARJ(10)*PMSS1)*DMB(7+ISU0) | |
50438 | DMB(7+IUU1)=6D0*EXP(-PARJ(10)*PMUD1) | |
50439 | DMB(7+ISU1)=3D0*EXP(-PARJ(10)*PMUS1)*DMB(7+ISU0) | |
50440 | DMB(7+IUS1)=PARJ(2)*DMB(7+ISU1) | |
50441 | DMB(7+IUD1)=DMB(7+IUU1)/2D0 | |
50442 | ||
50443 | C..New version: curtain flavour ratios. | |
50444 | C.. s/u for q->B+M+... | |
50445 | C.. s/u for rank 0 diquark: su -> ...M+B+... | |
50446 | C.. Q/q for heavy rank 0 diquark: Qu -> ...M+B+... | |
50447 | WU=1D0+QBM(IUD1)+QBM(IUS0)+QBM(IUS1)+QBM(IUU1) | |
50448 | PARF(135)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/WU | |
50449 | WU=1D0+DMB(7+IUD1)+DMB(7+IUS0)+DMB(7+IUS1)+DMB(7+IUU1) | |
50450 | PARF(136)=(2D0*(DMB(7+ISU0)+DMB(7+ISU1))+DMB(7+ISS1))/WU | |
50451 | PARF(137)=(DMB(7+ISU0)+DMB(7+ISU1))* | |
50452 | & (2D0+DMB(7+ISS1)/(2D0*DMB(7+ISU1)))/WU | |
50453 | ELSE | |
50454 | C..Old version: reset unused rank 0 diquark weights and | |
50455 | C.. unused diquark SU(6) survival weights | |
50456 | DO 130 I=1,7 | |
50457 | IF(MSTJ(12).LT.3) DMB(I)=1D0 | |
50458 | DMB(7+I)=1D0 | |
50459 | 130 CONTINUE | |
50460 | ||
50461 | C..Old version: Shuffle PARJ(7) into tau | |
50462 | QBM(IUS0)=QBM(IUS0)*PARJ(7) | |
50463 | QBM(ISS1)=QBM(ISS1)*PARJ(7) | |
50464 | QBM(IUS1)=QBM(IUS1)*PARJ(7) | |
50465 | ||
50466 | C..Old version: curtain flavour ratios. | |
50467 | C.. s/u for q->B+M+... | |
50468 | C.. s/u for rank 0 diquark: su -> ...M+B+... | |
50469 | C.. Q/q for heavy rank 0 diquark: Qu -> ...M+B+... | |
50470 | WU=1D0+QBM(IUD1)+QBM(IUS0)+QBM(IUS1)+QBM(IUU1) | |
50471 | PARF(135)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/WU | |
50472 | PARF(136)=PARF(135)*PARJ(6)*QBM(ISU0)/QBM(IUS0) | |
50473 | PARF(137)=(1D0+QBM(IUD1))*(2D0+QBM(IUS0))/WU | |
50474 | ENDIF | |
50475 | ||
50476 | C..Combine diquark SU(6) survival, SU(6)max, tau and T into factors for: | |
50477 | C.. rank0 D->M+B+..; D->M+B+..; q->B+M+..; q->B+B.. | |
50478 | DO 140 I=1,7 | |
50479 | DMB(7+I)=DMB(7+I)*DMB(I) | |
50480 | DMB(I)=DMB(I)*QBM(I) | |
50481 | QBM(I)=QBM(I)*SU6M(I)/SU6MUD | |
50482 | QBB(I)=QBB(I)*SU6M(I)/SU6MUD | |
50483 | 140 CONTINUE | |
50484 | ||
50485 | C.. *** Popcorn factors *** | |
50486 | ||
50487 | IF(MSTJ(12).LT.5)THEN | |
50488 | C.. Old version: Resulting popcorn weights. | |
50489 | PARF(138)=PARJ(6) | |
50490 | WS=PARF(135)*PARF(138) | |
50491 | WQ=WU*PARJ(5)/3D0 | |
50492 | PARF(132)=WQ*QBM(IUD1)/QBB(IUD1) | |
50493 | PARF(133)=WQ* | |
50494 | & (QBM(IUS1)/QBB(IUS1)+WS*QBM(ISU1)/QBB(ISU1))/2D0 | |
50495 | PARF(134)=WQ*WS*QBM(ISS1)/QBB(ISS1) | |
50496 | PARF(131)=WQ*(1D0+QBM(IUD1)+QBM(IUU1)+QBM(IUS0)+QBM(IUS1)+ | |
50497 | & WS*(QBM(ISU0)+QBM(ISU1)+QBM(ISS1)/2D0))/ | |
50498 | & (1D0+QBB(IUD1)+QBB(IUU1)+ | |
50499 | & 2D0*(QBB(IUS0)+QBB(IUS1))+QBB(ISS1)/2D0) | |
50500 | ELSE | |
50501 | C..New version: Store weights for popcorn mesons, | |
50502 | C..get prel. popcorn weights. | |
50503 | DO 150 IPOS=201,1400 | |
50504 | PARF(IPOS)=0D0 | |
50505 | 150 CONTINUE | |
50506 | DO 160 I=138,140 | |
50507 | PARF(I)=0D0 | |
50508 | 160 CONTINUE | |
50509 | IPOS=200 | |
50510 | PARF(193)=PARJ(8) | |
50511 | DO 240 MR=0,7,7 | |
50512 | IF(MR.EQ.7) PARF(193)=PARJ(10) | |
50513 | SQWT=2D0*(DMB(MR+IUS0)+DMB(MR+IUS1))/ | |
50514 | & (1D0+DMB(MR+IUD1)+DMB(MR+IUU1)) | |
50515 | QQWT=DMB(MR+IUU1)/(1D0+DMB(MR+IUD1)+DMB(MR+IUU1)) | |
50516 | DO 230 NMES=0,1 | |
50517 | IF(NMES.EQ.1) SQWT=PARJ(2) | |
50518 | DO 220 KFQPOP=1,4 | |
50519 | IF(MR.EQ.0.AND.KFQPOP.GT.3) GOTO 220 | |
50520 | IF(NMES.EQ.0.AND.KFQPOP.GE.3)THEN | |
50521 | SQWT=DMB(MR+ISS1)/(DMB(MR+ISU0)+DMB(MR+ISU1)) | |
50522 | QQWT=0.5D0 | |
50523 | IF(MR.EQ.0) PARF(193)=PARJ(8)+PARJ(9) | |
50524 | IF(KFQPOP.EQ.4) SQWT=SQWT*(1D0/DMB(7+ISU1)+1D0)/2D0 | |
50525 | ENDIF | |
50526 | DO 210 KFQOLD =1,5 | |
50527 | IF(MR.EQ.0.AND.KFQOLD.GT.3) GOTO 210 | |
50528 | IF(NMES.EQ.1) THEN | |
50529 | IF(MR.EQ.0.AND.KFQPOP.EQ.1) GOTO 210 | |
50530 | IF(MR.EQ.7.AND.KFQPOP.NE.1) GOTO 210 | |
50531 | ENDIF | |
50532 | WTTOT=0D0 | |
50533 | WTFAIL=0D0 | |
50534 | DO 190 KMUL=0,5 | |
50535 | PJWT=PARJ(12+KMUL) | |
50536 | IF(KMUL.EQ.0) PJWT=1D0-PARJ(14) | |
50537 | IF(KMUL.EQ.1) PJWT=1D0-PARJ(15)-PARJ(16)-PARJ(17) | |
50538 | IF(PJWT.LE.0D0) GOTO 190 | |
50539 | IF(PJWT.GT.1D0) PJWT=1D0 | |
50540 | IMES=5*KMUL | |
50541 | IMIX=2*KFQOLD+10*KMUL | |
50542 | KFJ=2*KMUL+1 | |
50543 | IF(KMUL.EQ.2) KFJ=10003 | |
50544 | IF(KMUL.EQ.3) KFJ=10001 | |
50545 | IF(KMUL.EQ.4) KFJ=20003 | |
50546 | IF(KMUL.EQ.5) KFJ=5 | |
50547 | DO 180 KFQVER =1,3 | |
50548 | KFLA=MAX(KFQOLD,KFQVER) | |
50549 | KFLB=MIN(KFQOLD,KFQVER) | |
50550 | SWT=PARJ(11+KFLA/3+KFLA/4) | |
50551 | IF(KMUL.EQ.0.OR.KMUL.EQ.2) SWT=1D0-SWT | |
50552 | SWT=SWT*PJWT | |
50553 | QWT=SQWT/(2D0+SQWT) | |
50554 | IF(KFQVER.LT.3)THEN | |
50555 | IF(KFQVER.EQ.KFQPOP) QWT=(1D0-QWT)*QQWT | |
50556 | IF(KFQVER.NE.KFQPOP) QWT=(1D0-QWT)*(1D0-QQWT) | |
50557 | ENDIF | |
50558 | IF(KFQVER.NE.KFQOLD)THEN | |
50559 | IMES=IMES+1 | |
50560 | KFM=100*KFLA+10*KFLB+KFJ | |
50561 | PMM=PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3) | |
50562 | PARF(IPOS+IMES)=QWT*SWT*EXP(-PARF(193)*PMM) | |
50563 | WTTOT=WTTOT+PARF(IPOS+IMES) | |
50564 | ELSE | |
50565 | DO 170 ID=3,5 | |
50566 | IF(ID.EQ.3) DWT=1D0-PARF(IMIX-1) | |
50567 | IF(ID.EQ.4) DWT=PARF(IMIX-1)-PARF(IMIX) | |
50568 | IF(ID.EQ.5) DWT=PARF(IMIX) | |
50569 | KFM=110*(ID-2)+KFJ | |
50570 | PMM=PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3) | |
50571 | PARF(IPOS+5*KMUL+ID)=QWT*SWT*DWT*EXP(-PARF(193)*PMM) | |
50572 | IF(KMUL.EQ.0.AND.ID.GT.3) THEN | |
50573 | WTFAIL=WTFAIL+QWT*SWT*DWT*(1D0-PARJ(21+ID)) | |
50574 | PARF(IPOS+5*KMUL+ID)= | |
50575 | & PARF(IPOS+5*KMUL+ID)*PARJ(21+ID) | |
50576 | ENDIF | |
50577 | WTTOT=WTTOT+PARF(IPOS+5*KMUL+ID) | |
50578 | 170 CONTINUE | |
50579 | ENDIF | |
50580 | 180 CONTINUE | |
50581 | 190 CONTINUE | |
50582 | DO 200 IMES=1,30 | |
50583 | PARF(IPOS+IMES)=PARF(IPOS+IMES)/(1D0-WTFAIL) | |
50584 | 200 CONTINUE | |
50585 | IF(MR.EQ.7) PARF(140)= | |
50586 | & MAX(PARF(140),WTTOT/(1D0-WTFAIL)) | |
50587 | IF(MR.EQ.0) PARF(139-KFQPOP/3)= | |
50588 | & MAX(PARF(139-KFQPOP/3),WTTOT/(1D0-WTFAIL)) | |
50589 | IPOS=IPOS+30 | |
50590 | 210 CONTINUE | |
50591 | 220 CONTINUE | |
50592 | 230 CONTINUE | |
50593 | 240 CONTINUE | |
50594 | IF(PARF(139).GT.1D-10) PARF(138)=PARF(138)/PARF(139) | |
50595 | MSTU(121)=0 | |
50596 | ||
50597 | ENDIF | |
50598 | ||
50599 | C..Recombine diquark weights to flavour and spin ratios | |
50600 | PARF(151)=(2D0*(QBB(ISU0)+QBB(ISU1))+QBB(ISS1))/ | |
50601 | & (1D0+QBB(IUD1)+QBB(IUU1)+QBB(IUS0)+QBB(IUS1)) | |
50602 | PARF(152)=2D0*(QBB(IUS0)+QBB(IUS1))/(1D0+QBB(IUD1)+QBB(IUU1)) | |
50603 | PARF(153)=QBB(ISS1)/(QBB(ISU0)+QBB(ISU1)) | |
50604 | PARF(154)=QBB(IUU1)/(1D0+QBB(IUD1)+QBB(IUU1)) | |
50605 | PARF(155)=QBB(ISU1)/QBB(ISU0) | |
50606 | PARF(156)=QBB(IUS1)/QBB(IUS0) | |
50607 | PARF(157)=QBB(IUD1) | |
50608 | ||
50609 | PARF(161)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/ | |
50610 | & (1D0+QBM(IUD1)+QBM(IUU1)+QBM(IUS0)+QBM(IUS1)) | |
50611 | PARF(162)=2D0*(QBM(IUS0)+QBM(IUS1))/(1D0+QBM(IUD1)+QBM(IUU1)) | |
50612 | PARF(163)=QBM(ISS1)/(QBM(ISU0)+QBM(ISU1)) | |
50613 | PARF(164)=QBM(IUU1)/(1D0+QBM(IUD1)+QBM(IUU1)) | |
50614 | PARF(165)=QBM(ISU1)/QBM(ISU0) | |
50615 | PARF(166)=QBM(IUS1)/QBM(IUS0) | |
50616 | PARF(167)=QBM(IUD1) | |
50617 | ||
50618 | PARF(171)=(2D0*(DMB(ISU0)+DMB(ISU1))+DMB(ISS1))/ | |
50619 | & (1D0+DMB(IUD1)+DMB(IUU1)+DMB(IUS0)+DMB(IUS1)) | |
50620 | PARF(172)=2D0*(DMB(IUS0)+DMB(IUS1))/(1D0+DMB(IUD1)+DMB(IUU1)) | |
50621 | PARF(173)=DMB(ISS1)/(DMB(ISU0)+DMB(ISU1)) | |
50622 | PARF(174)=DMB(IUU1)/(1D0+DMB(IUD1)+DMB(IUU1)) | |
50623 | PARF(175)=DMB(ISU1)/DMB(ISU0) | |
50624 | PARF(176)=DMB(IUS1)/DMB(IUS0) | |
50625 | PARF(177)=DMB(IUD1) | |
50626 | ||
50627 | PARF(185)=DMB(7+ISU1)/DMB(7+ISU0) | |
50628 | PARF(186)=DMB(7+IUS1)/DMB(7+IUS0) | |
50629 | PARF(187)=DMB(7+IUD1) | |
50630 | ||
50631 | RETURN | |
50632 | END | |
50633 | ||
50634 | ||
50635 | C********************************************************************* | |
50636 | ||
50637 | C...PYPTDI | |
50638 | C...Generates transverse momentum according to a Gaussian. | |
50639 | ||
50640 | SUBROUTINE PYPTDI(KFL,PX,PY) | |
50641 | ||
50642 | C...Double precision and integer declarations. | |
50643 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
50644 | IMPLICIT INTEGER(I-N) | |
50645 | INTEGER PYK,PYCHGE,PYCOMP | |
50646 | C...Commonblocks. | |
50647 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
50648 | SAVE /PYDAT1/ | |
50649 | ||
50650 | C...Generate p_T and azimuthal angle, gives p_x and p_y. | |
50651 | KFLA=IABS(KFL) | |
50652 | PT=PARJ(21)*SQRT(-LOG(MAX(1D-10,PYR(0)))) | |
50653 | IF(PARJ(23).GT.PYR(0)) PT=PARJ(24)*PT | |
50654 | IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT | |
50655 | IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0D0 | |
50656 | PHI=PARU(2)*PYR(0) | |
50657 | PX=PT*COS(PHI) | |
50658 | PY=PT*SIN(PHI) | |
50659 | ||
50660 | RETURN | |
50661 | END | |
50662 | ||
50663 | C********************************************************************* | |
50664 | ||
50665 | C...PYZDIS | |
50666 | C...Generates the longitudinal splitting variable z. | |
50667 | ||
50668 | SUBROUTINE PYZDIS(KFL1,KFL2,PR,Z) | |
50669 | ||
50670 | C...Double precision and integer declarations. | |
50671 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
50672 | IMPLICIT INTEGER(I-N) | |
50673 | INTEGER PYK,PYCHGE,PYCOMP | |
50674 | C...Commonblocks. | |
50675 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
50676 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
50677 | SAVE /PYDAT1/,/PYDAT2/ | |
50678 | ||
50679 | C...Check if heavy flavour fragmentation. | |
50680 | KFLA=IABS(KFL1) | |
50681 | KFLB=IABS(KFL2) | |
50682 | KFLH=KFLA | |
50683 | IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10) | |
50684 | ||
50685 | C...Lund symmetric scaling function: determine parameters of shape. | |
50686 | IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3).OR. | |
50687 | &MSTJ(11).GE.4) THEN | |
50688 | FA=PARJ(41) | |
50689 | IF(MSTJ(91).EQ.1) FA=PARJ(43) | |
50690 | IF(KFLB.GE.10) FA=FA+PARJ(45) | |
50691 | FBB=PARJ(42) | |
50692 | IF(MSTJ(91).EQ.1) FBB=PARJ(44) | |
50693 | FB=FBB*PR | |
50694 | FC=1D0 | |
50695 | IF(KFLA.GE.10) FC=FC-PARJ(45) | |
50696 | IF(KFLB.GE.10) FC=FC+PARJ(45) | |
50697 | IF(MSTJ(11).GE.4.AND.(KFLH.EQ.4.OR.KFLH.EQ.5)) THEN | |
50698 | FRED=PARJ(46) | |
50699 | IF(MSTJ(11).EQ.5.AND.KFLH.EQ.5) FRED=PARJ(47) | |
50700 | FC=FC+FRED*FBB*PARF(100+KFLH)**2 | |
50701 | ENDIF | |
50702 | MC=1 | |
50703 | IF(ABS(FC-1D0).GT.0.01D0) MC=2 | |
50704 | ||
50705 | C...Determine position of maximum. Special cases for a = 0 or a = c. | |
50706 | IF(FA.LT.0.02D0) THEN | |
50707 | MA=1 | |
50708 | ZMAX=1D0 | |
50709 | IF(FC.GT.FB) ZMAX=FB/FC | |
50710 | ELSEIF(ABS(FC-FA).LT.0.01D0) THEN | |
50711 | MA=2 | |
50712 | ZMAX=FB/(FB+FC) | |
50713 | ELSE | |
50714 | MA=3 | |
50715 | ZMAX=0.5D0*(FB+FC-SQRT((FB-FC)**2+4D0*FA*FB))/(FC-FA) | |
50716 | IF(ZMAX.GT.0.9999D0.AND.FB.GT.100D0) ZMAX=MIN(ZMAX,1D0-FA/FB) | |
50717 | ENDIF | |
50718 | ||
50719 | C...Subdivide z range if distribution very peaked near endpoint. | |
50720 | MMAX=2 | |
50721 | IF(ZMAX.LT.0.1D0) THEN | |
50722 | MMAX=1 | |
50723 | ZDIV=2.75D0*ZMAX | |
50724 | IF(MC.EQ.1) THEN | |
50725 | FINT=1D0-LOG(ZDIV) | |
50726 | ELSE | |
50727 | ZDIVC=ZDIV**(1D0-FC) | |
50728 | FINT=1D0+(1D0-1D0/ZDIVC)/(FC-1D0) | |
50729 | ENDIF | |
50730 | ELSEIF(ZMAX.GT.0.85D0.AND.FB.GT.1D0) THEN | |
50731 | MMAX=3 | |
50732 | FSCB=SQRT(4D0+(FC/FB)**2) | |
50733 | ZDIV=FSCB-1D0/ZMAX-(FC/FB)*LOG(ZMAX*0.5D0*(FSCB+FC/FB)) | |
50734 | IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1D0-ZMAX) | |
50735 | ZDIV=MIN(ZMAX,MAX(0D0,ZDIV)) | |
50736 | FINT=1D0+FB*(1D0-ZDIV) | |
50737 | ENDIF | |
50738 | ||
50739 | C...Choice of z, preweighted for peaks at low or high z. | |
50740 | 100 Z=PYR(0) | |
50741 | FPRE=1D0 | |
50742 | IF(MMAX.EQ.1) THEN | |
50743 | IF(FINT*PYR(0).LE.1D0) THEN | |
50744 | Z=ZDIV*Z | |
50745 | ELSEIF(MC.EQ.1) THEN | |
50746 | Z=ZDIV**Z | |
50747 | FPRE=ZDIV/Z | |
50748 | ELSE | |
50749 | Z=(ZDIVC+Z*(1D0-ZDIVC))**(1D0/(1D0-FC)) | |
50750 | FPRE=(ZDIV/Z)**FC | |
50751 | ENDIF | |
50752 | ELSEIF(MMAX.EQ.3) THEN | |
50753 | IF(FINT*PYR(0).LE.1D0) THEN | |
50754 | Z=ZDIV+LOG(Z)/FB | |
50755 | FPRE=EXP(FB*(Z-ZDIV)) | |
50756 | ELSE | |
50757 | Z=ZDIV+Z*(1D0-ZDIV) | |
50758 | ENDIF | |
50759 | ENDIF | |
50760 | ||
50761 | C...Weighting according to correct formula. | |
50762 | IF(Z.LE.0D0.OR.Z.GE.1D0) GOTO 100 | |
50763 | FEXP=FC*LOG(ZMAX/Z)+FB*(1D0/ZMAX-1D0/Z) | |
50764 | IF(MA.GE.2) FEXP=FEXP+FA*LOG((1D0-Z)/(1D0-ZMAX)) | |
50765 | FVAL=EXP(MAX(-50D0,MIN(50D0,FEXP))) | |
50766 | IF(FVAL.LT.PYR(0)*FPRE) GOTO 100 | |
50767 | ||
50768 | C...Generate z according to Field-Feynman, SLAC, (1-z)**c OR z**c. | |
50769 | ELSE | |
50770 | FC=PARJ(50+MAX(1,KFLH)) | |
50771 | IF(MSTJ(91).EQ.1) FC=PARJ(59) | |
50772 | 110 Z=PYR(0) | |
50773 | IF(FC.GE.0D0.AND.FC.LE.1D0) THEN | |
50774 | IF(FC.GT.PYR(0)) Z=1D0-Z**(1D0/3D0) | |
50775 | ELSEIF(FC.GT.-1.AND.FC.LT.0D0) THEN | |
50776 | IF(-4D0*FC*Z*(1D0-Z)**2.LT.PYR(0)*((1D0-Z)**2-FC*Z)**2) | |
50777 | & GOTO 110 | |
50778 | ELSE | |
50779 | IF(FC.GT.0D0) Z=1D0-Z**(1D0/FC) | |
50780 | IF(FC.LT.0D0) Z=Z**(-1D0/FC) | |
50781 | ENDIF | |
50782 | ENDIF | |
50783 | ||
50784 | RETURN | |
50785 | END | |
50786 | ||
50787 | C********************************************************************* | |
50788 | ||
50789 | C...PYSHOW | |
50790 | C...Generates timelike parton showers from given partons. | |
50791 | ||
50792 | SUBROUTINE PYSHOW(IP1,IP2,QMAX) | |
50793 | ||
50794 | C...Double precision and integer declarations. | |
50795 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
50796 | IMPLICIT INTEGER(I-N) | |
50797 | INTEGER PYK,PYCHGE,PYCOMP | |
50798 | C...Parameter statement to help give large particle numbers. | |
50799 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
50800 | &KEXCIT=4000000,KDIMEN=5000000) | |
50801 | C...Commonblocks. | |
50802 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
50803 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
50804 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
50805 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
50806 | C...Local arrays. | |
50807 | DIMENSION PMTH(5,50),PS(5),PMA(19),PMSD(10),IEP(10),IPA(10), | |
50808 | &KFLA(10),KFLD(10),KFL(10),ITRY(10),ISI(10),ISL(10),DP(10), | |
50809 | &DPT(5,4),KSH(0:40),KCII(2),NIIS(2),IIIS(2,2),THEIIS(2,2), | |
50810 | &PHIIIS(2,2),ISII(2),ISSET(3),ISCOL(0:40),ISCHG(0:40), | |
50811 | &IREF(1000) | |
50812 | ||
50813 | C...Check that QMAX not too low. | |
50814 | IF(MSTJ(41).LE.0) THEN | |
50815 | RETURN | |
50816 | ELSEIF(MSTJ(41).EQ.1) THEN | |
50817 | IF(QMAX.LE.PARJ(82).AND.IP2.GT.-8) RETURN | |
50818 | ELSE | |
50819 | IF(QMAX.LE.MIN(PARJ(82),PARJ(83),PARJ(90)).AND.IP2.GT.-8) | |
50820 | & RETURN | |
50821 | ENDIF | |
50822 | ||
50823 | C...Initialization of cutoff masses etc. | |
50824 | DO 100 IFL=0,40 | |
50825 | ISCOL(IFL)=0 | |
50826 | ISCHG(IFL)=0 | |
50827 | KSH(IFL)=0 | |
50828 | 100 CONTINUE | |
50829 | ISCOL(21)=1 | |
50830 | KSH(21)=1 | |
50831 | PMTH(1,21)=PYMASS(21) | |
50832 | PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25D0*PARJ(82)**2) | |
50833 | PMTH(3,21)=2D0*PMTH(2,21) | |
50834 | PMTH(4,21)=PMTH(3,21) | |
50835 | PMTH(5,21)=PMTH(3,21) | |
50836 | PMTH(1,22)=PYMASS(22) | |
50837 | PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25D0*PARJ(83)**2) | |
50838 | PMTH(3,22)=2D0*PMTH(2,22) | |
50839 | PMTH(4,22)=PMTH(3,22) | |
50840 | PMTH(5,22)=PMTH(3,22) | |
50841 | PMQTH1=PARJ(82) | |
50842 | IF(MSTJ(41).GE.2) PMQTH1=MIN(PARJ(82),PARJ(83)) | |
50843 | PMQT1E=MIN(PMQTH1,PARJ(90)) | |
50844 | PMQTH2=PMTH(2,21) | |
50845 | IF(MSTJ(41).GE.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22)) | |
50846 | PMQT2E=MIN(PMQTH2,0.5D0*PARJ(90)) | |
50847 | DO 110 IFL=1,5 | |
50848 | ISCOL(IFL)=1 | |
50849 | IF(MSTJ(41).GE.2) ISCHG(IFL)=1 | |
50850 | KSH(IFL)=1 | |
50851 | PMTH(1,IFL)=PYMASS(IFL) | |
50852 | PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PMQTH1**2) | |
50853 | PMTH(3,IFL)=PMTH(2,IFL)+PMQTH2 | |
50854 | PMTH(4,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(82)**2)+PMTH(2,21) | |
50855 | PMTH(5,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(83)**2)+PMTH(2,22) | |
50856 | 110 CONTINUE | |
50857 | DO 120 IFL=11,15,2 | |
50858 | IF(MSTJ(41).EQ.2.OR.MSTJ(41).GE.4) ISCHG(IFL)=1 | |
50859 | IF(MSTJ(41).EQ.2.OR.MSTJ(41).GE.4) KSH(IFL)=1 | |
50860 | PMTH(1,IFL)=PYMASS(IFL) | |
50861 | PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(90)**2) | |
50862 | PMTH(3,IFL)=PMTH(2,IFL)+0.5D0*PARJ(90) | |
50863 | PMTH(4,IFL)=PMTH(3,IFL) | |
50864 | PMTH(5,IFL)=PMTH(3,IFL) | |
50865 | 120 CONTINUE | |
50866 | PT2MIN=MAX(0.5D0*PARJ(82),1.1D0*PARJ(81))**2 | |
50867 | ALAMS=PARJ(81)**2 | |
50868 | ALFM=LOG(PT2MIN/ALAMS) | |
50869 | ||
50870 | C...Store positions of shower initiating partons. | |
50871 | MPSPD=0 | |
50872 | IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN | |
50873 | NPA=1 | |
50874 | IPA(1)=IP1 | |
50875 | ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)- | |
50876 | & MSTU(32))) THEN | |
50877 | NPA=2 | |
50878 | IPA(1)=IP1 | |
50879 | IPA(2)=IP2 | |
50880 | ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0 | |
50881 | & .AND.IP2.GE.-7) THEN | |
50882 | NPA=IABS(IP2) | |
50883 | DO 130 I=1,NPA | |
50884 | IPA(I)=IP1+I-1 | |
50885 | 130 CONTINUE | |
50886 | ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND. | |
50887 | &IP2.EQ.-8) THEN | |
50888 | MPSPD=1 | |
50889 | NPA=2 | |
50890 | IPA(1)=IP1+6 | |
50891 | IPA(2)=IP1+7 | |
50892 | ELSE | |
50893 | CALL PYERRM(12, | |
50894 | & '(PYSHOW:) failed to reconstruct showering system') | |
50895 | IF(MSTU(21).GE.1) RETURN | |
50896 | ENDIF | |
50897 | ||
50898 | C...Check on phase space available for emission. | |
50899 | IREJ=0 | |
50900 | DO 140 J=1,5 | |
50901 | PS(J)=0D0 | |
50902 | 140 CONTINUE | |
50903 | PM=0D0 | |
50904 | KFLA(2)=0 | |
50905 | DO 160 I=1,NPA | |
50906 | KFLA(I)=IABS(K(IPA(I),2)) | |
50907 | PMA(I)=P(IPA(I),5) | |
50908 | C...Special cutoff masses for initial partons (may be a heavy quark, | |
50909 | C...squark, ..., and need not be on the mass shell). | |
50910 | IR=30+I | |
50911 | IF(NPA.LE.1) IREF(I)=IR | |
50912 | IF(NPA.GE.2) IREF(I+1)=IR | |
50913 | IF(KFLA(I).LE.8) THEN | |
50914 | ISCOL(IR)=1 | |
50915 | IF(MSTJ(41).GE.2) ISCHG(IR)=1 | |
50916 | ELSEIF(KFLA(I).EQ.11.OR.KFLA(I).EQ.13.OR.KFLA(I).EQ.15.OR. | |
50917 | & KFLA(I).EQ.17) THEN | |
50918 | IF(MSTJ(41).EQ.2.OR.MSTJ(41).GE.4) ISCHG(IR)=1 | |
50919 | ELSEIF(KFLA(I).EQ.21) THEN | |
50920 | ISCOL(IR)=1 | |
50921 | ELSEIF((KFLA(I).GE.KSUSY1+1.AND.KFLA(I).LE.KSUSY1+8).OR. | |
50922 | & (KFLA(I).GE.KSUSY2+1.AND.KFLA(I).LE.KSUSY2+8)) THEN | |
50923 | ISCOL(IR)=1 | |
50924 | ELSEIF(KFLA(I).EQ.KSUSY1+21) THEN | |
50925 | ISCOL(IR)=1 | |
50926 | ENDIF | |
50927 | IF(ISCOL(IR).EQ.1.OR.ISCHG(IR).EQ.1) KSH(IR)=1 | |
50928 | PMTH(1,IR)=PMA(I) | |
50929 | IF(ISCOL(IR).EQ.1.AND.ISCHG(IR).EQ.1) THEN | |
50930 | PMTH(2,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PMQTH1**2) | |
50931 | PMTH(3,IR)=PMTH(2,IR)+PMQTH2 | |
50932 | PMTH(4,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(82)**2)+PMTH(2,21) | |
50933 | PMTH(5,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(83)**2)+PMTH(2,22) | |
50934 | ELSEIF(ISCOL(IR).EQ.1) THEN | |
50935 | PMTH(2,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(82)**2) | |
50936 | PMTH(3,IR)=PMTH(2,IR)+0.5D0*PARJ(82) | |
50937 | PMTH(4,IR)=PMTH(3,IR) | |
50938 | PMTH(5,IR)=PMTH(3,IR) | |
50939 | ELSEIF(ISCHG(IR).EQ.1) THEN | |
50940 | PMTH(2,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(90)**2) | |
50941 | PMTH(3,IR)=PMTH(2,IR)+0.5D0*PARJ(90) | |
50942 | PMTH(4,IR)=PMTH(3,IR) | |
50943 | PMTH(5,IR)=PMTH(3,IR) | |
50944 | ENDIF | |
50945 | IF(KSH(IR).EQ.1) PMA(I)=PMTH(3,IR) | |
50946 | PM=PM+PMA(I) | |
50947 | IF(KSH(IR).EQ.0.OR.PMA(I).GT.10D0*QMAX) IREJ=IREJ+1 | |
50948 | DO 150 J=1,4 | |
50949 | PS(J)=PS(J)+P(IPA(I),J) | |
50950 | 150 CONTINUE | |
50951 | 160 CONTINUE | |
50952 | IF(IREJ.EQ.NPA.AND.IP2.GE.-7) RETURN | |
50953 | PS(5)=SQRT(MAX(0D0,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2)) | |
50954 | IF(NPA.EQ.1) PS(5)=PS(4) | |
50955 | IF(PS(5).LE.PM+PMQT1E) RETURN | |
50956 | ||
50957 | C...Identify source: q(1), ~q(2), V(3), S(4), chi(5), ~g(6), unknown(0). | |
50958 | KFSRCE=0 | |
50959 | IF(IP2.LE.0) THEN | |
50960 | ELSEIF(K(IP1,3).EQ.K(IP2,3).AND.K(IP1,3).GT.0) THEN | |
50961 | KFSRCE=IABS(K(K(IP1,3),2)) | |
50962 | ELSE | |
50963 | IPAR1=MAX(1,K(IP1,3)) | |
50964 | IPAR2=MAX(1,K(IP2,3)) | |
50965 | IF(K(IPAR1,3).EQ.K(IPAR2,3).AND.K(IPAR1,3).GT.0) | |
50966 | & KFSRCE=IABS(K(K(IPAR1,3),2)) | |
50967 | ENDIF | |
50968 | ITYPES=0 | |
50969 | IF(KFSRCE.GE.1.AND.KFSRCE.LE.8) ITYPES=1 | |
50970 | IF(KFSRCE.GE.KSUSY1+1.AND.KFSRCE.LE.KSUSY1+8) ITYPES=2 | |
50971 | IF(KFSRCE.GE.KSUSY2+1.AND.KFSRCE.LE.KSUSY2+8) ITYPES=2 | |
50972 | IF(KFSRCE.GE.21.AND.KFSRCE.LE.24) ITYPES=3 | |
50973 | IF(KFSRCE.GE.32.AND.KFSRCE.LE.34) ITYPES=3 | |
50974 | IF(KFSRCE.EQ.25.OR.(KFSRCE.GE.35.AND.KFSRCE.LE.37)) ITYPES=4 | |
50975 | IF(KFSRCE.GE.KSUSY1+22.AND.KFSRCE.LE.KSUSY1+37) ITYPES=5 | |
50976 | IF(KFSRCE.EQ.KSUSY1+21) ITYPES=6 | |
50977 | ||
50978 | C...Identify two primary showerers. | |
50979 | ITYPE1=0 | |
50980 | IF(KFLA(1).GE.1.AND.KFLA(1).LE.8) ITYPE1=1 | |
50981 | IF(KFLA(1).GE.KSUSY1+1.AND.KFLA(1).LE.KSUSY1+8) ITYPE1=2 | |
50982 | IF(KFLA(1).GE.KSUSY2+1.AND.KFLA(1).LE.KSUSY2+8) ITYPE1=2 | |
50983 | IF(KFLA(1).GE.21.AND.KFLA(1).LE.24) ITYPE1=3 | |
50984 | IF(KFLA(1).GE.32.AND.KFLA(1).LE.34) ITYPE1=3 | |
50985 | IF(KFLA(1).EQ.25.OR.(KFLA(1).GE.35.AND.KFLA(1).LE.37)) ITYPE1=4 | |
50986 | IF(KFLA(1).GE.KSUSY1+22.AND.KFLA(1).LE.KSUSY1+37) ITYPE1=5 | |
50987 | IF(KFLA(1).EQ.KSUSY1+21) ITYPE1=6 | |
50988 | ITYPE2=0 | |
50989 | IF(KFLA(2).GE.1.AND.KFLA(2).LE.8) ITYPE2=1 | |
50990 | IF(KFLA(2).GE.KSUSY1+1.AND.KFLA(2).LE.KSUSY1+8) ITYPE2=2 | |
50991 | IF(KFLA(2).GE.KSUSY2+1.AND.KFLA(2).LE.KSUSY2+8) ITYPE2=2 | |
50992 | IF(KFLA(2).GE.21.AND.KFLA(2).LE.24) ITYPE2=3 | |
50993 | IF(KFLA(2).GE.32.AND.KFLA(2).LE.34) ITYPE2=3 | |
50994 | IF(KFLA(2).EQ.25.OR.(KFLA(2).GE.35.AND.KFLA(2).LE.37)) ITYPE2=4 | |
50995 | IF(KFLA(2).GE.KSUSY1+22.AND.KFLA(2).LE.KSUSY1+37) ITYPE2=5 | |
50996 | IF(KFLA(2).EQ.KSUSY1+21) ITYPE2=6 | |
50997 | ||
50998 | C...Order of showerers. Presence of gluino. | |
50999 | ITYPMN=MIN(ITYPE1,ITYPE2) | |
51000 | ITYPMX=MAX(ITYPE1,ITYPE2) | |
51001 | IORD=1 | |
51002 | IF(ITYPE1.GT.ITYPE2) IORD=2 | |
51003 | IGLUI=0 | |
51004 | IF(ITYPE1.EQ.6.OR.ITYPE2.EQ.6) IGLUI=1 | |
51005 | ||
51006 | C...Check if 3-jet matrix elements to be used. | |
51007 | M3JC=0 | |
51008 | ALPHA=0.5D0 | |
51009 | IF(NPA.EQ.2.AND.MSTJ(47).GE.1.AND.MPSPD.EQ.0) THEN | |
51010 | IF(MSTJ(38).NE.0) THEN | |
51011 | M3JC=MSTJ(38) | |
51012 | ALPHA=PARJ(80) | |
51013 | MSTJ(38)=0 | |
51014 | ELSEIF(MSTJ(47).GE.6) THEN | |
51015 | M3JC=MSTJ(47) | |
51016 | ELSE | |
51017 | ICLASS=1 | |
51018 | ICOMBI=4 | |
51019 | ||
51020 | C...Vector/axial vector -> q + qbar; q -> q + V. | |
51021 | IF(ITYPMN.EQ.1.AND.ITYPMX.EQ.1.AND.(ITYPES.EQ.0.OR. | |
51022 | & ITYPES.EQ.3)) THEN | |
51023 | ICLASS=2 | |
51024 | IF(KFSRCE.EQ.21.OR.KFSRCE.EQ.22) THEN | |
51025 | ICOMBI=1 | |
51026 | ELSEIF(KFSRCE.EQ.23.OR.(KFSRCE.EQ.0.AND. | |
51027 | & K(IP1,2)+K(IP2,2).EQ.0)) THEN | |
51028 | C...gamma*/Z0: assume e+e- initial state if unknown. | |
51029 | EI=-1D0 | |
51030 | IF(KFSRCE.EQ.23) THEN | |
51031 | IANNFL=K(K(IP1,3),3) | |
51032 | IF(IANNFL.NE.0) THEN | |
51033 | KANNFL=IABS(K(IANNFL,2)) | |
51034 | IF(KANNFL.GE.1.AND.KANNFL.LE.18) EI=KCHG(KANNFL,1)/3D0 | |
51035 | ENDIF | |
51036 | ENDIF | |
51037 | AI=SIGN(1D0,EI+0.1D0) | |
51038 | VI=AI-4D0*EI*PARU(102) | |
51039 | EF=KCHG(KFLA(1),1)/3D0 | |
51040 | AF=SIGN(1D0,EF+0.1D0) | |
51041 | VF=AF-4D0*EF*PARU(102) | |
51042 | XWC=1D0/(16D0*PARU(102)*(1D0-PARU(102))) | |
51043 | SH=PS(5)**2 | |
51044 | SQMZ=PMAS(23,1)**2 | |
51045 | SQWZ=PS(5)*PMAS(23,2) | |
51046 | SBWZ=1D0/((SH-SQMZ)**2+SQWZ**2) | |
51047 | VECT=EI**2*EF**2+2D0*EI*VI*EF*VF*XWC*SH*(SH-SQMZ)*SBWZ+ | |
51048 | & (VI**2+AI**2)*VF**2*XWC**2*SH**2*SBWZ | |
51049 | AXIV=(VI**2+AI**2)*AF**2*XWC**2*SH**2*SBWZ | |
51050 | ICOMBI=3 | |
51051 | ALPHA=VECT/(VECT+AXIV) | |
51052 | ELSEIF(KFSRCE.EQ.24.OR.KFSRCE.EQ.0) THEN | |
51053 | ICOMBI=4 | |
51054 | ENDIF | |
51055 | C...For chi -> chi q qbar, use V/A -> q qbar as first approximation. | |
51056 | ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.1.AND.ITYPES.EQ.5) THEN | |
51057 | ICLASS=2 | |
51058 | ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.3.AND.(ITYPES.EQ.0.OR. | |
51059 | & ITYPES.EQ.1)) THEN | |
51060 | ICLASS=3 | |
51061 | ||
51062 | C...Scalar/pseudoscalar -> q + qbar; q -> q + S. | |
51063 | ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.1.AND.ITYPES.EQ.4) THEN | |
51064 | ICLASS=4 | |
51065 | IF(KFSRCE.EQ.25.OR.KFSRCE.EQ.35.OR.KFSRCE.EQ.37) THEN | |
51066 | ICOMBI=1 | |
51067 | ELSEIF(KFSRCE.EQ.36) THEN | |
51068 | ICOMBI=2 | |
51069 | ENDIF | |
51070 | ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.4.AND.(ITYPES.EQ.0.OR. | |
51071 | & ITYPES.EQ.1)) THEN | |
51072 | ICLASS=5 | |
51073 | ||
51074 | C...V -> ~q + ~qbar; ~q -> ~q + V; S -> ~q + ~qbar; ~q -> ~q + S. | |
51075 | ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.2.AND.(ITYPES.EQ.0.OR. | |
51076 | & ITYPES.EQ.3)) THEN | |
51077 | ICLASS=6 | |
51078 | ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.3.AND.(ITYPES.EQ.0.OR. | |
51079 | & ITYPES.EQ.2)) THEN | |
51080 | ICLASS=7 | |
51081 | ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.2.AND.ITYPES.EQ.4) THEN | |
51082 | ICLASS=8 | |
51083 | ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.4.AND.(ITYPES.EQ.0.OR. | |
51084 | & ITYPES.EQ.2)) THEN | |
51085 | ICLASS=9 | |
51086 | ||
51087 | C...chi -> q + ~qbar; ~q -> q + chi; q -> ~q + chi. | |
51088 | ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.2.AND.(ITYPES.EQ.0.OR. | |
51089 | & ITYPES.EQ.5)) THEN | |
51090 | ICLASS=10 | |
51091 | ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.5.AND.(ITYPES.EQ.0.OR. | |
51092 | & ITYPES.EQ.2)) THEN | |
51093 | ICLASS=11 | |
51094 | ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.5.AND.(ITYPES.EQ.0.OR. | |
51095 | & ITYPES.EQ.1)) THEN | |
51096 | ICLASS=12 | |
51097 | ||
51098 | C...~g -> q + ~qbar; ~q -> q + ~g; q -> ~q + ~g. | |
51099 | ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.2.AND.ITYPES.EQ.6) THEN | |
51100 | ICLASS=13 | |
51101 | ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.6.AND.(ITYPES.EQ.0.OR. | |
51102 | & ITYPES.EQ.2)) THEN | |
51103 | ICLASS=14 | |
51104 | ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.6.AND.(ITYPES.EQ.0.OR. | |
51105 | & ITYPES.EQ.1)) THEN | |
51106 | ICLASS=15 | |
51107 | ||
51108 | C...g -> ~g + ~g (eikonal approximation). | |
51109 | ELSEIF(ITYPMN.EQ.6.AND.ITYPMX.EQ.6.AND.ITYPES.EQ.0) THEN | |
51110 | ICLASS=16 | |
51111 | ENDIF | |
51112 | M3JC=5*ICLASS+ICOMBI | |
51113 | ENDIF | |
51114 | ENDIF | |
51115 | ||
51116 | C...Find if interference with initial state partons. | |
51117 | MIIS=0 | |
51118 | IF(MSTJ(50).GE.1.AND.MSTJ(50).LE.3.AND.NPA.EQ.2.AND.KFSRCE.EQ.0 | |
51119 | &.AND.MPSPD.EQ.0) MIIS=MSTJ(50) | |
51120 | IF(MSTJ(50).GE.4.AND.MSTJ(50).LE.6.AND.NPA.EQ.2.AND.MPSPD.EQ.0) | |
51121 | &MIIS=MSTJ(50)-3 | |
51122 | IF(MIIS.NE.0) THEN | |
51123 | DO 180 I=1,2 | |
51124 | KCII(I)=0 | |
51125 | KCA=PYCOMP(KFLA(I)) | |
51126 | IF(KCA.NE.0) KCII(I)=KCHG(KCA,2)*ISIGN(1,K(IPA(I),2)) | |
51127 | NIIS(I)=0 | |
51128 | IF(KCII(I).NE.0) THEN | |
51129 | DO 170 J=1,2 | |
51130 | ICSI=MOD(K(IPA(I),3+J)/MSTU(5),MSTU(5)) | |
51131 | IF(ICSI.GT.0.AND.ICSI.NE.IPA(1).AND.ICSI.NE.IPA(2).AND. | |
51132 | & (KCII(I).EQ.(-1)**(J+1).OR.KCII(I).EQ.2)) THEN | |
51133 | NIIS(I)=NIIS(I)+1 | |
51134 | IIIS(I,NIIS(I))=ICSI | |
51135 | ENDIF | |
51136 | 170 CONTINUE | |
51137 | ENDIF | |
51138 | 180 CONTINUE | |
51139 | IF(NIIS(1)+NIIS(2).EQ.0) MIIS=0 | |
51140 | ENDIF | |
51141 | ||
51142 | C...Boost interfering initial partons to rest frame | |
51143 | C...and reconstruct their polar and azimuthal angles. | |
51144 | IF(MIIS.NE.0) THEN | |
51145 | DO 200 I=1,2 | |
51146 | DO 190 J=1,5 | |
51147 | K(N+I,J)=K(IPA(I),J) | |
51148 | P(N+I,J)=P(IPA(I),J) | |
51149 | V(N+I,J)=0D0 | |
51150 | 190 CONTINUE | |
51151 | 200 CONTINUE | |
51152 | DO 220 I=3,2+NIIS(1) | |
51153 | DO 210 J=1,5 | |
51154 | K(N+I,J)=K(IIIS(1,I-2),J) | |
51155 | P(N+I,J)=P(IIIS(1,I-2),J) | |
51156 | V(N+I,J)=0D0 | |
51157 | 210 CONTINUE | |
51158 | 220 CONTINUE | |
51159 | DO 240 I=3+NIIS(1),2+NIIS(1)+NIIS(2) | |
51160 | DO 230 J=1,5 | |
51161 | K(N+I,J)=K(IIIS(2,I-2-NIIS(1)),J) | |
51162 | P(N+I,J)=P(IIIS(2,I-2-NIIS(1)),J) | |
51163 | V(N+I,J)=0D0 | |
51164 | 230 CONTINUE | |
51165 | 240 CONTINUE | |
51166 | CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),0D0,0D0,-PS(1)/PS(4), | |
51167 | & -PS(2)/PS(4),-PS(3)/PS(4)) | |
51168 | PHI=PYANGL(P(N+1,1),P(N+1,2)) | |
51169 | CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),0D0,-PHI,0D0,0D0,0D0) | |
51170 | THE=PYANGL(P(N+1,3),P(N+1,1)) | |
51171 | CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),-THE,0D0,0D0,0D0,0D0) | |
51172 | DO 250 I=3,2+NIIS(1) | |
51173 | THEIIS(1,I-2)=PYANGL(P(N+I,3),SQRT(P(N+I,1)**2+P(N+I,2)**2)) | |
51174 | PHIIIS(1,I-2)=PYANGL(P(N+I,1),P(N+I,2)) | |
51175 | 250 CONTINUE | |
51176 | DO 260 I=3+NIIS(1),2+NIIS(1)+NIIS(2) | |
51177 | THEIIS(2,I-2-NIIS(1))=PARU(1)-PYANGL(P(N+I,3), | |
51178 | & SQRT(P(N+I,1)**2+P(N+I,2)**2)) | |
51179 | PHIIIS(2,I-2-NIIS(1))=PYANGL(P(N+I,1),P(N+I,2)) | |
51180 | 260 CONTINUE | |
51181 | ENDIF | |
51182 | ||
51183 | C...Boost 3 or more partons to their rest frame. | |
51184 | IF(NPA.GE.3) CALL PYROBO(IPA(1),IPA(NPA),0D0,0D0,-PS(1)/PS(4), | |
51185 | &-PS(2)/PS(4),-PS(3)/PS(4)) | |
51186 | ||
51187 | C...Define imagined single initiator of shower for parton system. | |
51188 | NS=N | |
51189 | IF(N.GT.MSTU(4)-MSTU(32)-10) THEN | |
51190 | CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS') | |
51191 | IF(MSTU(21).GE.1) RETURN | |
51192 | ENDIF | |
51193 | 270 N=NS | |
51194 | IF(NPA.GE.2) THEN | |
51195 | K(N+1,1)=11 | |
51196 | K(N+1,2)=21 | |
51197 | K(N+1,3)=0 | |
51198 | K(N+1,4)=0 | |
51199 | K(N+1,5)=0 | |
51200 | P(N+1,1)=0D0 | |
51201 | P(N+1,2)=0D0 | |
51202 | P(N+1,3)=0D0 | |
51203 | P(N+1,4)=PS(5) | |
51204 | P(N+1,5)=PS(5) | |
51205 | V(N+1,5)=PS(5)**2 | |
51206 | N=N+1 | |
51207 | IREF(1)=21 | |
51208 | ENDIF | |
51209 | ||
51210 | C...Loop over partons that may branch. | |
51211 | NEP=NPA | |
51212 | IM=NS | |
51213 | IF(NPA.EQ.1) IM=NS-1 | |
51214 | 280 IM=IM+1 | |
51215 | IF(N.GT.NS) THEN | |
51216 | IF(IM.GT.N) GOTO 590 | |
51217 | KFLM=IABS(K(IM,2)) | |
51218 | IR=IREF(IM-NS) | |
51219 | IF(KSH(IR).EQ.0) GOTO 280 | |
51220 | IF(P(IM,5).LT.PMTH(2,IR)) GOTO 280 | |
51221 | IGM=K(IM,3) | |
51222 | ELSE | |
51223 | IGM=-1 | |
51224 | ENDIF | |
51225 | IF(N+NEP.GT.MSTU(4)-MSTU(32)-10) THEN | |
51226 | CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS') | |
51227 | IF(MSTU(21).GE.1) RETURN | |
51228 | ENDIF | |
51229 | ||
51230 | C...Position of aunt (sister to branching parton). | |
51231 | C...Origin and flavour of daughters. | |
51232 | IAU=0 | |
51233 | IF(IGM.GT.0) THEN | |
51234 | IF(K(IM-1,3).EQ.IGM) IAU=IM-1 | |
51235 | IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1 | |
51236 | ENDIF | |
51237 | IF(IGM.GE.0) THEN | |
51238 | K(IM,4)=N+1 | |
51239 | DO 290 I=1,NEP | |
51240 | K(N+I,3)=IM | |
51241 | 290 CONTINUE | |
51242 | ELSE | |
51243 | K(N+1,3)=IPA(1) | |
51244 | ENDIF | |
51245 | IF(IGM.LE.0) THEN | |
51246 | DO 300 I=1,NEP | |
51247 | K(N+I,2)=K(IPA(I),2) | |
51248 | 300 CONTINUE | |
51249 | ELSEIF(KFLM.NE.21) THEN | |
51250 | K(N+1,2)=K(IM,2) | |
51251 | K(N+2,2)=K(IM,5) | |
51252 | IREF(N+1-NS)=IREF(IM-NS) | |
51253 | IREF(N+2-NS)=IABS(K(N+2,2)) | |
51254 | ELSEIF(K(IM,5).EQ.21) THEN | |
51255 | K(N+1,2)=21 | |
51256 | K(N+2,2)=21 | |
51257 | IREF(N+1-NS)=21 | |
51258 | IREF(N+2-NS)=21 | |
51259 | ELSE | |
51260 | K(N+1,2)=K(IM,5) | |
51261 | K(N+2,2)=-K(IM,5) | |
51262 | IREF(N+1-NS)=IABS(K(N+1,2)) | |
51263 | IREF(N+2-NS)=IABS(K(N+2,2)) | |
51264 | ENDIF | |
51265 | ||
51266 | C...Reset flags on daughters and tries made. | |
51267 | DO 310 IP=1,NEP | |
51268 | K(N+IP,1)=3 | |
51269 | K(N+IP,4)=0 | |
51270 | K(N+IP,5)=0 | |
51271 | KFLD(IP)=IABS(K(N+IP,2)) | |
51272 | IF(KCHG(PYCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1 | |
51273 | ITRY(IP)=0 | |
51274 | ISL(IP)=0 | |
51275 | ISI(IP)=0 | |
51276 | IF(KSH(IREF(N+IP-NS)).EQ.1) ISI(IP)=1 | |
51277 | 310 CONTINUE | |
51278 | ISLM=0 | |
51279 | ||
51280 | C...Maximum virtuality of daughters. | |
51281 | IF(IGM.LE.0) THEN | |
51282 | DO 320 I=1,NPA | |
51283 | IF(NPA.GE.3) P(N+I,4)=P(IPA(I),4) | |
51284 | P(N+I,5)=MIN(QMAX,PS(5)) | |
51285 | IR=IREF(N+I-NS) | |
51286 | IF(IP2.LE.-8) P(N+I,5)=MAX(P(N+I,5),2D0*PMTH(3,IR)) | |
51287 | IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5) | |
51288 | 320 CONTINUE | |
51289 | ELSE | |
51290 | IF(MSTJ(43).LE.2) PEM=V(IM,2) | |
51291 | IF(MSTJ(43).GE.3) PEM=P(IM,4) | |
51292 | P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM) | |
51293 | P(N+2,5)=MIN(P(IM,5),(1D0-V(IM,1))*PEM) | |
51294 | IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22) | |
51295 | ENDIF | |
51296 | DO 330 I=1,NEP | |
51297 | PMSD(I)=P(N+I,5) | |
51298 | IF(ISI(I).EQ.1) THEN | |
51299 | IR=IREF(N+I-NS) | |
51300 | IF(P(N+I,5).LE.PMTH(3,IR)) P(N+I,5)=PMTH(1,IR) | |
51301 | ENDIF | |
51302 | V(N+I,5)=P(N+I,5)**2 | |
51303 | 330 CONTINUE | |
51304 | ||
51305 | C...Choose one of the daughters for evolution. | |
51306 | 340 INUM=0 | |
51307 | IF(NEP.EQ.1) INUM=1 | |
51308 | DO 350 I=1,NEP | |
51309 | IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I | |
51310 | 350 CONTINUE | |
51311 | DO 360 I=1,NEP | |
51312 | IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN | |
51313 | IR=IREF(N+I-NS) | |
51314 | IF(P(N+I,5).GE.PMTH(2,IR)) INUM=I | |
51315 | ENDIF | |
51316 | 360 CONTINUE | |
51317 | IF(INUM.EQ.0) THEN | |
51318 | RMAX=0D0 | |
51319 | DO 370 I=1,NEP | |
51320 | IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQT2E) THEN | |
51321 | RPM=P(N+I,5)/PMSD(I) | |
51322 | IR=IREF(N+I-NS) | |
51323 | IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,IR)) THEN | |
51324 | RMAX=RPM | |
51325 | INUM=I | |
51326 | ENDIF | |
51327 | ENDIF | |
51328 | 370 CONTINUE | |
51329 | ENDIF | |
51330 | ||
51331 | C...Cancel choice of predetermined daughter already treated. | |
51332 | INUM=MAX(1,INUM) | |
51333 | INUMT=INUM | |
51334 | IF(MPSPD.EQ.1.AND.IGM.EQ.0.AND.ITRY(INUMT).GE.1) THEN | |
51335 | IF(K(IP1-1+INUM,4).GT.0) INUM=3-INUM | |
51336 | ELSEIF(MPSPD.EQ.1.AND.IM.EQ.NS+2.AND.ITRY(INUMT).GE.1) THEN | |
51337 | IF(KFLD(INUMT).NE.21.AND.K(IP1+2,4).GT.0) INUM=3-INUM | |
51338 | IF(KFLD(INUMT).EQ.21.AND.K(IP1+3,4).GT.0) INUM=3-INUM | |
51339 | ENDIF | |
51340 | ||
51341 | C...Store information on choice of evolving daughter. | |
51342 | IEP(1)=N+INUM | |
51343 | DO 380 I=2,NEP | |
51344 | IEP(I)=IEP(I-1)+1 | |
51345 | IF(IEP(I).GT.N+NEP) IEP(I)=N+1 | |
51346 | 380 CONTINUE | |
51347 | DO 390 I=1,NEP | |
51348 | KFL(I)=IABS(K(IEP(I),2)) | |
51349 | 390 CONTINUE | |
51350 | ITRY(INUM)=ITRY(INUM)+1 | |
51351 | IF(ITRY(INUM).GT.200) THEN | |
51352 | CALL PYERRM(14,'(PYSHOW:) caught in infinite loop') | |
51353 | IF(MSTU(21).GE.1) RETURN | |
51354 | ENDIF | |
51355 | Z=0.5D0 | |
51356 | IR=IREF(IEP(1)-NS) | |
51357 | IF(KSH(IR).EQ.0) GOTO 440 | |
51358 | IF(P(IEP(1),5).LT.PMTH(2,IR)) GOTO 440 | |
51359 | ||
51360 | C...Check if evolution already predetermined for daughter. | |
51361 | IPSPD=0 | |
51362 | IF(MPSPD.EQ.1.AND.IGM.EQ.0) THEN | |
51363 | IF(K(IP1-1+INUM,4).GT.0) IPSPD=IP1-1+INUM | |
51364 | ELSEIF(MPSPD.EQ.1.AND.IM.EQ.NS+2) THEN | |
51365 | IF(KFL(1).NE.21.AND.K(IP1+2,4).GT.0) IPSPD=IP1+2 | |
51366 | IF(KFL(1).EQ.21.AND.K(IP1+3,4).GT.0) IPSPD=IP1+3 | |
51367 | ENDIF | |
51368 | ISSET(INUM)=0 | |
51369 | IF(IPSPD.NE.0) ISSET(INUM)=1 | |
51370 | ||
51371 | C...Select side for interference with initial state partons. | |
51372 | IF(MIIS.GE.1.AND.IEP(1).LE.NS+3) THEN | |
51373 | III=IEP(1)-NS-1 | |
51374 | ISII(III)=0 | |
51375 | IF(IABS(KCII(III)).EQ.1.AND.NIIS(III).EQ.1) THEN | |
51376 | ISII(III)=1 | |
51377 | ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.1) THEN | |
51378 | IF(PYR(0).GT.0.5D0) ISII(III)=1 | |
51379 | ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.2) THEN | |
51380 | ISII(III)=1 | |
51381 | IF(PYR(0).GT.0.5D0) ISII(III)=2 | |
51382 | ENDIF | |
51383 | ENDIF | |
51384 | ||
51385 | C...Calculate allowed z range. | |
51386 | IF(NEP.EQ.1) THEN | |
51387 | PMED=PS(4) | |
51388 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN | |
51389 | PMED=P(IM,5) | |
51390 | ELSE | |
51391 | IF(INUM.EQ.1) PMED=V(IM,1)*PEM | |
51392 | IF(INUM.EQ.2) PMED=(1D0-V(IM,1))*PEM | |
51393 | ENDIF | |
51394 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
51395 | ZC=PMTH(2,21)/PMED | |
51396 | ZCE=PMTH(2,22)/PMED | |
51397 | IF(ISCOL(IR).EQ.0) ZCE=0.5D0*PARJ(90)/PMED | |
51398 | ELSE | |
51399 | ZC=0.5D0*(1D0-SQRT(MAX(0D0,1D0-(2D0*PMTH(2,21)/PMED)**2))) | |
51400 | IF(ZC.LT.1D-6) ZC=(PMTH(2,21)/PMED)**2 | |
51401 | PMTMPE=PMTH(2,22) | |
51402 | IF(ISCOL(IR).EQ.0) PMTMPE=0.5D0*PARJ(90) | |
51403 | ZCE=0.5D0*(1D0-SQRT(MAX(0D0,1D0-(2D0*PMTMPE/PMED)**2))) | |
51404 | IF(ZCE.LT.1D-6) ZCE=(PMTMPE/PMED)**2 | |
51405 | ENDIF | |
51406 | ZC=MIN(ZC,0.491D0) | |
51407 | ZCE=MIN(ZCE,0.49991D0) | |
51408 | IF(((MSTJ(41).EQ.1.AND.ZC.GT.0.49D0).OR.(MSTJ(41).GE.2.AND. | |
51409 | &MIN(ZC,ZCE).GT.0.4999D0)).AND.IPSPD.EQ.0) THEN | |
51410 | P(IEP(1),5)=PMTH(1,IR) | |
51411 | V(IEP(1),5)=P(IEP(1),5)**2 | |
51412 | GOTO 440 | |
51413 | ENDIF | |
51414 | ||
51415 | C...Integral of Altarelli-Parisi z kernel for QCD. | |
51416 | C...(Includes squark and gluino; with factor N_C/C_F extra for latter). | |
3a709cfa | 51417 | FMED = PARJ(200) |
2dfa57d1 | 51418 | IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN |
3a709cfa | 51419 | C Nestor |
51420 | FBR=(1.D0+FMED)*6D0*LOG((1D0-ZC)/ZC)+MSTJ(45)*0.5D0 | |
2dfa57d1 | 51421 | ELSEIF(MSTJ(49).EQ.0) THEN |
3a709cfa | 51422 | C Nestor |
51423 | FBR=(1.D0+FMED)*(8D0/3D0)*LOG((1D0-ZC)/ZC) | |
2dfa57d1 | 51424 | IF(IGLUI.EQ.1.AND.IR.GE.31) FBR=FBR*(9D0/4D0) |
51425 | ||
51426 | C...Integral of Altarelli-Parisi z kernel for scalar gluon. | |
51427 | ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN | |
51428 | FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1D0-2D0*ZC) | |
51429 | ELSEIF(MSTJ(49).EQ.1) THEN | |
51430 | FBR=(1D0-2D0*ZC)/3D0 | |
51431 | IF(IGM.EQ.0.AND.M3JC.GE.1) FBR=4D0*FBR | |
51432 | ||
51433 | C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon. | |
51434 | ELSEIF(KFL(1).EQ.21) THEN | |
3a709cfa | 51435 | FBR=(1.D0+FMED)*6D0*MSTJ(45)*(0.5D0-ZC) |
2dfa57d1 | 51436 | ELSE |
3a709cfa | 51437 | FBR=(1.D0+FMED)*2D0*LOG((1D0-ZC)/ZC) |
2dfa57d1 | 51438 | ENDIF |
51439 | ||
51440 | C...Reset QCD probability for colourless. | |
51441 | IF(ISCOL(IR).EQ.0) FBR=0D0 | |
51442 | ||
51443 | C...Integral of Altarelli-Parisi kernel for photon emission. | |
51444 | FBRE=0D0 | |
51445 | IF(MSTJ(41).GE.2.AND.ISCHG(IR).EQ.1) THEN | |
51446 | IF(KFL(1).LE.18) THEN | |
51447 | FBRE=(KCHG(KFL(1),1)/3D0)**2*2D0*LOG((1D0-ZCE)/ZCE) | |
51448 | ENDIF | |
51449 | IF(MSTJ(41).EQ.10) FBRE=PARJ(84)*FBRE | |
51450 | ENDIF | |
51451 | ||
51452 | C...Inner veto algorithm starts. Find maximum mass for evolution. | |
51453 | 400 PMS=V(IEP(1),5) | |
51454 | IF(IGM.GE.0) THEN | |
51455 | PM2=0D0 | |
51456 | DO 410 I=2,NEP | |
51457 | PM=P(IEP(I),5) | |
51458 | IRI=IREF(IEP(I)-NS) | |
51459 | IF(KSH(IRI).EQ.1) PM=PMTH(2,IRI) | |
51460 | PM2=PM2+PM | |
51461 | 410 CONTINUE | |
51462 | PMS=MIN(PMS,(P(IM,5)-PM2)**2) | |
51463 | ENDIF | |
51464 | ||
51465 | C...Select mass for daughter in QCD evolution. | |
51466 | B0=27D0/6D0 | |
51467 | DO 420 IFF=4,MSTJ(45) | |
51468 | IF(PMS.GT.4D0*PMTH(2,IFF)**2) B0=(33D0-2D0*IFF)/6D0 | |
51469 | 420 CONTINUE | |
51470 | C...Shift m^2 for evolution in Q^2 = m^2 - m(onshell)^2. | |
51471 | PMSC=MAX(0.5D0*PARJ(82),PMS-PMTH(1,IR)**2) | |
51472 | C...Already predetermined choice. | |
51473 | IF(IPSPD.NE.0) THEN | |
51474 | PMSQCD=P(IPSPD,5)**2 | |
51475 | ELSEIF(FBR.LT.1D-3) THEN | |
51476 | PMSQCD=0D0 | |
51477 | ELSEIF(MSTJ(44).LE.0) THEN | |
51478 | PMSQCD=PMSC*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/(PARU(111)*FBR))) | |
51479 | ELSEIF(MSTJ(44).EQ.1) THEN | |
51480 | PMSQCD=4D0*ALAMS*(0.25D0*PMSC/ALAMS)**(PYR(0)**(B0/FBR)) | |
51481 | ELSE | |
51482 | PMSQCD=PMSC*EXP(MAX(-50D0,ALFM*B0*LOG(PYR(0))/FBR)) | |
51483 | ENDIF | |
51484 | C...Shift back m^2 from evolution in Q^2 = m^2 - m(onshell)^2. | |
51485 | IF(IPSPD.EQ.0) PMSQCD=PMSQCD+PMTH(1,IR)**2 | |
51486 | IF(ZC.GT.0.49D0.OR.PMSQCD.LE.PMTH(4,IR)**2) PMSQCD=PMTH(2,IR)**2 | |
51487 | V(IEP(1),5)=PMSQCD | |
51488 | MCE=1 | |
51489 | ||
51490 | C...Select mass for daughter in QED evolution. | |
51491 | IF(MSTJ(41).GE.2.AND.ISCHG(IR).EQ.1.AND.IPSPD.EQ.0) THEN | |
51492 | C...Shift m^2 for evolution in Q^2 = m^2 - m(onshell)^2. | |
51493 | PMSE=MAX(0.5D0*PARJ(83),PMS-PMTH(1,IR)**2) | |
51494 | IF(FBRE.LT.1D-3) THEN | |
51495 | PMSQED=0D0 | |
51496 | ELSE | |
51497 | PMSQED=PMSE*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/ | |
51498 | & (PARU(101)*FBRE))) | |
51499 | ENDIF | |
51500 | C...Shift back m^2 from evolution in Q^2 = m^2 - m(onshell)^2. | |
51501 | PMSQED=PMSQED+PMTH(1,IR)**2 | |
51502 | IF(ZCE.GT.0.4999D0.OR.PMSQED.LE.PMTH(5,IR)**2) PMSQED= | |
51503 | & PMTH(2,IR)**2 | |
51504 | IF(PMSQED.GT.PMSQCD) THEN | |
51505 | V(IEP(1),5)=PMSQED | |
51506 | MCE=2 | |
51507 | ENDIF | |
51508 | ENDIF | |
51509 | ||
51510 | C...Check whether daughter mass below cutoff. | |
51511 | P(IEP(1),5)=SQRT(V(IEP(1),5)) | |
51512 | IF(P(IEP(1),5).LE.PMTH(3,IR)) THEN | |
51513 | P(IEP(1),5)=PMTH(1,IR) | |
51514 | V(IEP(1),5)=P(IEP(1),5)**2 | |
51515 | GOTO 440 | |
51516 | ENDIF | |
51517 | ||
51518 | C...Already predetermined choice of z, and flavour in g -> qqbar. | |
51519 | IF(IPSPD.NE.0) THEN | |
51520 | IPSGD1=K(IPSPD,4) | |
51521 | IPSGD2=K(IPSPD,5) | |
51522 | PMSGD1=P(IPSGD1,5)**2 | |
51523 | PMSGD2=P(IPSGD2,5)**2 | |
51524 | ALAMPS=SQRT(MAX(1D-10,(PMSQCD-PMSGD1-PMSGD2)**2- | |
51525 | & 4D0*PMSGD1*PMSGD2)) | |
51526 | Z=0.5D0*(PMSQCD*(2D0*P(IPSGD1,4)/P(IPSPD,4)-1D0)+ALAMPS- | |
51527 | & PMSGD1+PMSGD2)/ALAMPS | |
51528 | Z=MAX(0.00001D0,MIN(0.99999D0,Z)) | |
51529 | IF(KFL(1).NE.21) THEN | |
51530 | K(IEP(1),5)=21 | |
51531 | ELSE | |
51532 | K(IEP(1),5)=IABS(K(IPSGD1,2)) | |
51533 | ENDIF | |
51534 | ||
51535 | C...Select z value of branching: q -> qgamma. | |
51536 | ELSEIF(MCE.EQ.2) THEN | |
51537 | Z=1D0-(1D0-ZCE)*(ZCE/(1D0-ZCE))**PYR(0) | |
51538 | IF(1D0+Z**2.LT.2D0*PYR(0)) GOTO 400 | |
51539 | K(IEP(1),5)=22 | |
51540 | ||
51541 | C...Select z value of branching: q -> qg, g -> gg, g -> qqbar. | |
51542 | ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN | |
51543 | Z=1D0-(1D0-ZC)*(ZC/(1D0-ZC))**PYR(0) | |
51544 | C...Only do z weighting when no ME correction afterwards. | |
51545 | IF(M3JC.EQ.0.AND.1D0+Z**2.LT.2D0*PYR(0)) GOTO 400 | |
51546 | K(IEP(1),5)=21 | |
51547 | ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*0.5D0.LT.PYR(0)*FBR) THEN | |
51548 | Z=(1D0-ZC)*(ZC/(1D0-ZC))**PYR(0) | |
51549 | IF(PYR(0).GT.0.5D0) Z=1D0-Z | |
51550 | IF((1D0-Z*(1D0-Z))**2.LT.PYR(0)) GOTO 400 | |
51551 | K(IEP(1),5)=21 | |
51552 | ELSEIF(MSTJ(49).NE.1) THEN | |
51553 | Z=PYR(0) | |
51554 | IF(Z**2+(1D0-Z)**2.LT.PYR(0)) GOTO 400 | |
51555 | KFLB=1+INT(MSTJ(45)*PYR(0)) | |
51556 | PMQ=4D0*PMTH(2,KFLB)**2/V(IEP(1),5) | |
51557 | IF(PMQ.GE.1D0) GOTO 400 | |
51558 | IF(MSTJ(44).LE.2.OR.MSTJ(44).EQ.4) THEN | |
51559 | IF(Z.LT.ZC.OR.Z.GT.1D0-ZC) GOTO 400 | |
51560 | PMQ0=4D0*PMTH(2,21)**2/V(IEP(1),5) | |
51561 | IF(MOD(MSTJ(43),2).EQ.0.AND.(1D0+0.5D0*PMQ)*SQRT(1D0-PMQ) | |
51562 | & .LT.PYR(0)*(1D0+0.5D0*PMQ0)*SQRT(1D0-PMQ0)) GOTO 400 | |
51563 | ELSE | |
51564 | IF((1D0+0.5D0*PMQ)*SQRT(1D0-PMQ).LT.PYR(0)) GOTO 400 | |
51565 | ENDIF | |
51566 | K(IEP(1),5)=KFLB | |
51567 | ||
51568 | C...Ditto for scalar gluon model. | |
51569 | ELSEIF(KFL(1).NE.21) THEN | |
51570 | Z=1D0-SQRT(ZC**2+PYR(0)*(1D0-2D0*ZC)) | |
51571 | K(IEP(1),5)=21 | |
51572 | ELSEIF(PYR(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN | |
51573 | Z=ZC+(1D0-2D0*ZC)*PYR(0) | |
51574 | K(IEP(1),5)=21 | |
51575 | ELSE | |
51576 | Z=ZC+(1D0-2D0*ZC)*PYR(0) | |
51577 | KFLB=1+INT(MSTJ(45)*PYR(0)) | |
51578 | PMQ=4D0*PMTH(2,KFLB)**2/V(IEP(1),5) | |
51579 | IF(PMQ.GE.1D0) GOTO 400 | |
51580 | K(IEP(1),5)=KFLB | |
51581 | ENDIF | |
51582 | ||
51583 | C...Correct to alpha_s(pT^2) (optionally m^2/4 for g -> q qbar). | |
51584 | IF(MCE.EQ.1.AND.MSTJ(44).GE.2.AND.IPSPD.EQ.0) THEN | |
51585 | IF(KFL(1).EQ.21.AND.K(IEP(1),5).LT.10.AND. | |
51586 | & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN | |
51587 | IF(ALFM/LOG(V(IEP(1),5)*0.25D0/ALAMS).LT.PYR(0)) GOTO 400 | |
51588 | ELSE | |
51589 | PT2APP=Z*(1D0-Z)*V(IEP(1),5) | |
51590 | IF(MSTJ(44).GE.4) PT2APP=PT2APP* | |
51591 | & (1D0-PMTH(1,IR)**2/V(IEP(1),5))**2 | |
51592 | IF(PT2APP.LT.PT2MIN) GOTO 400 | |
51593 | IF(ALFM/LOG(PT2APP/ALAMS).LT.PYR(0)) GOTO 400 | |
51594 | ENDIF | |
51595 | ENDIF | |
51596 | ||
51597 | C...Check if z consistent with chosen m. | |
51598 | IF(KFL(1).EQ.21) THEN | |
51599 | IRGD1=IABS(K(IEP(1),5)) | |
51600 | IRGD2=IRGD1 | |
51601 | ELSE | |
51602 | IRGD1=IR | |
51603 | IRGD2=IABS(K(IEP(1),5)) | |
51604 | ENDIF | |
51605 | IF(NEP.EQ.1) THEN | |
51606 | PED=PS(4) | |
51607 | ELSEIF(NEP.GE.3) THEN | |
51608 | PED=P(IEP(1),4) | |
51609 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN | |
51610 | PED=0.5D0*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5) | |
51611 | ELSE | |
51612 | IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM | |
51613 | IF(IEP(1).EQ.N+2) PED=(1D0-V(IM,1))*PEM | |
51614 | ENDIF | |
51615 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
51616 | PMQTH3=0.5D0*PARJ(82) | |
51617 | IF(IRGD2.EQ.22) PMQTH3=0.5D0*PARJ(83) | |
51618 | IF(IRGD2.EQ.22.AND.ISCOL(IR).EQ.0) PMQTH3=0.5D0*PARJ(90) | |
51619 | PMQ1=(PMTH(1,IRGD1)**2+PMQTH3**2)/V(IEP(1),5) | |
51620 | PMQ2=(PMTH(1,IRGD2)**2+PMQTH3**2)/V(IEP(1),5) | |
51621 | ZD=SQRT(MAX(0D0,(1D0-V(IEP(1),5)/PED**2)*((1D0-PMQ1-PMQ2)**2- | |
51622 | & 4D0*PMQ1*PMQ2))) | |
51623 | ZH=1D0+PMQ1-PMQ2 | |
51624 | ELSE | |
51625 | ZD=SQRT(MAX(0D0,1D0-V(IEP(1),5)/PED**2)) | |
51626 | ZH=1D0 | |
51627 | ENDIF | |
51628 | IF(KFL(1).EQ.21.AND.K(IEP(1),5).LT.10.AND. | |
51629 | &(MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN | |
51630 | ELSEIF(IPSPD.NE.0) THEN | |
51631 | ELSE | |
51632 | ZL=0.5D0*(ZH-ZD) | |
51633 | ZU=0.5D0*(ZH+ZD) | |
51634 | IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 400 | |
51635 | ENDIF | |
51636 | IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1D0-ZL)/MAX(1D-20,ZL* | |
51637 | &(1D0-ZU))) | |
51638 | IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1D0-ZL)/MAX(1D-10,1D0-ZU)) | |
51639 | ||
51640 | C...Width suppression for q -> q + g. | |
51641 | IF(MSTJ(40).NE.0.AND.KFL(1).NE.21.AND.IPSPD.EQ.0) THEN | |
51642 | IF(IGM.EQ.0) THEN | |
51643 | EGLU=0.5D0*PS(5)*(1D0-Z)*(1D0+V(IEP(1),5)/V(NS+1,5)) | |
51644 | ELSE | |
51645 | EGLU=PMED*(1D0-Z) | |
51646 | ENDIF | |
51647 | CHI=PARJ(89)**2/(PARJ(89)**2+EGLU**2) | |
51648 | IF(MSTJ(40).EQ.1) THEN | |
51649 | IF(CHI.LT.PYR(0)) GOTO 400 | |
51650 | ELSEIF(MSTJ(40).EQ.2) THEN | |
51651 | IF(1D0-CHI.LT.PYR(0)) GOTO 400 | |
51652 | ENDIF | |
51653 | ENDIF | |
51654 | ||
51655 | C...Three-jet matrix element correction. | |
51656 | IF(M3JC.GE.1) THEN | |
51657 | WME=1D0 | |
51658 | WSHOW=1D0 | |
51659 | ||
51660 | C...QED matrix elements: only for massless case so far. | |
51661 | IF(MCE.EQ.2.AND.IGM.EQ.0) THEN | |
51662 | X1=Z*(1D0+V(IEP(1),5)/V(NS+1,5)) | |
51663 | X2=1D0-V(IEP(1),5)/V(NS+1,5) | |
51664 | X3=(1D0-X1)+(1D0-X2) | |
51665 | KI1=K(IPA(INUM),2) | |
51666 | KI2=K(IPA(3-INUM),2) | |
51667 | QF1=KCHG(PYCOMP(KI1),1)*ISIGN(1,KI1)/3D0 | |
51668 | QF2=KCHG(PYCOMP(KI2),1)*ISIGN(1,KI2)/3D0 | |
51669 | WSHOW=QF1**2*(1D0-X1)/X3*(1D0+(X1/(2D0-X2))**2)+ | |
51670 | & QF2**2*(1D0-X2)/X3*(1D0+(X2/(2D0-X1))**2) | |
51671 | WME=(QF1*(1D0-X1)/X3-QF2*(1D0-X2)/X3)**2*(X1**2+X2**2) | |
51672 | ELSEIF(MCE.EQ.2) THEN | |
51673 | ||
51674 | C...QCD matrix elements, including mass effects. | |
51675 | ELSEIF(MSTJ(49).NE.1.AND.K(IEP(1),2).NE.21) THEN | |
51676 | PS1ME=V(IEP(1),5) | |
51677 | PM1ME=PMTH(1,IR) | |
51678 | M3JCC=M3JC | |
51679 | IF(IR.GE.31.AND.IGM.EQ.0) THEN | |
51680 | C...QCD ME: original parton, first branching. | |
51681 | PM2ME=PMTH(1,63-IR) | |
51682 | ECMME=PS(5) | |
51683 | ELSEIF(IR.GE.31) THEN | |
51684 | C...QCD ME: original parton, subsequent branchings. | |
51685 | PM2ME=PMTH(1,63-IR) | |
51686 | PEDME=PEM*(V(IM,1)+(1D0-V(IM,1))*PS1ME/V(IM,5)) | |
51687 | ECMME=PEDME+SQRT(MAX(0D0,PEDME**2-PS1ME+PM2ME**2)) | |
51688 | ELSEIF(K(IM,2).EQ.21) THEN | |
51689 | C...QCD ME: secondary partons, first branching. | |
51690 | PM2ME=PM1ME | |
51691 | ZMME=V(IM,1) | |
51692 | IF(IEP(1).GT.IEP(2)) ZMME=1D0-ZMME | |
51693 | PMLME=SQRT(MAX(0D0,(V(IM,5)-PS1ME-PM2ME**2)**2- | |
51694 | & 4D0*PS1ME*PM2ME**2)) | |
51695 | PEDME=PEM*(0.5D0*(V(IM,5)-PMLME+PS1ME-PM2ME**2)+PMLME*ZMME)/ | |
51696 | & V(IM,5) | |
51697 | ECMME=PEDME+SQRT(MAX(0D0,PEDME**2-PS1ME+PM2ME**2)) | |
51698 | M3JCC=66 | |
51699 | ELSE | |
51700 | C...QCD ME: secondary partons, subsequent branchings. | |
51701 | PM2ME=PM1ME | |
51702 | PEDME=PEM*(V(IM,1)+(1D0-V(IM,1))*PS1ME/V(IM,5)) | |
51703 | ECMME=PEDME+SQRT(MAX(0D0,PEDME**2-PS1ME+PM2ME**2)) | |
51704 | M3JCC=66 | |
51705 | ENDIF | |
51706 | C...Construct ME variables. | |
51707 | R1ME=PM1ME/ECMME | |
51708 | R2ME=PM2ME/ECMME | |
51709 | X1=(1D0+PS1ME/ECMME**2-R2ME**2)*(Z+(1D0-Z)*PM1ME**2/PS1ME) | |
51710 | X2=1D0+R2ME**2-PS1ME/ECMME**2 | |
51711 | C...Call ME, with right order important for two inequivalent showerers. | |
51712 | IF(IR.EQ.IORD+30) THEN | |
51713 | WME=PYMAEL(M3JCC,X1,X2,R1ME,R2ME,ALPHA) | |
51714 | ELSE | |
51715 | WME=PYMAEL(M3JCC,X2,X1,R2ME,R1ME,ALPHA) | |
51716 | ENDIF | |
51717 | C...Split up total ME when two radiating partons. | |
51718 | ISPRAD=1 | |
51719 | IF((M3JCC.GE.16.AND.M3JCC.LE.19).OR. | |
51720 | & (M3JCC.GE.26.AND.M3JCC.LE.29).OR. | |
51721 | & (M3JCC.GE.36.AND.M3JCC.LE.39).OR. | |
51722 | & (M3JCC.GE.46.AND.M3JCC.LE.49).OR. | |
51723 | & (M3JCC.GE.56.AND.M3JCC.LE.64)) ISPRAD=0 | |
51724 | IF(ISPRAD.EQ.1) WME=WME*MAX(1D-10,1D0+R1ME**2-R2ME**2-X1)/ | |
51725 | & MAX(1D-10,2D0-X1-X2) | |
51726 | C...Evaluate shower rate to be compared with. | |
51727 | WSHOW=2D0/(MAX(1D-10,2D0-X1-X2)* | |
51728 | & MAX(1D-10,1D0+R2ME**2-R1ME**2-X2)) | |
51729 | IF(IGLUI.EQ.1.AND.IR.GE.31) WSHOW=(9D0/4D0)*WSHOW | |
51730 | ELSEIF(MSTJ(49).NE.1) THEN | |
51731 | ||
51732 | C...Toy model scalar theory matrix elements; no mass effects. | |
51733 | ELSE | |
51734 | X1=Z*(1D0+V(IEP(1),5)/V(NS+1,5)) | |
51735 | X2=1D0-V(IEP(1),5)/V(NS+1,5) | |
51736 | X3=(1D0-X1)+(1D0-X2) | |
51737 | WSHOW=4D0*X3*((1D0-X1)/(2D0-X2)**2+(1D0-X2)/(2D0-X1)**2) | |
51738 | WME=X3**2 | |
51739 | IF(MSTJ(102).GE.2) WME=X3**2-2D0*(1D0+X3)*(1D0-X1)*(1D0-X2)* | |
51740 | & PARJ(171) | |
51741 | ENDIF | |
51742 | ||
51743 | IF(WME.LT.PYR(0)*WSHOW) GOTO 400 | |
51744 | ENDIF | |
51745 | ||
51746 | C...Impose angular ordering by rejection of nonordered emission. | |
51747 | IF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2.AND.IPSPD.EQ.0) THEN | |
51748 | PEMAO=V(IM,1)*P(IM,4) | |
51749 | IF(IEP(1).EQ.N+2) PEMAO=(1D0-V(IM,1))*P(IM,4) | |
51750 | IF(IR.GE.31.AND.MSTJ(42).GE.5) THEN | |
51751 | MAOD=0 | |
51752 | ELSEIF(KFL(1).EQ.21.AND.K(IEP(1),5).LE.10.AND.(MSTJ(42).EQ.4 | |
51753 | & .OR.MSTJ(42).EQ.7)) THEN | |
51754 | MAOD=0 | |
51755 | ELSEIF(KFL(1).EQ.21.AND.K(IEP(1),5).LE.10.AND.(MSTJ(42).EQ.3 | |
51756 | & .OR.MSTJ(42).EQ.6)) THEN | |
51757 | MAOD=1 | |
51758 | PMDAO=PMTH(2,K(IEP(1),5)) | |
51759 | THE2ID=Z*(1D0-Z)*PEMAO**2/(V(IEP(1),5)-4D0*PMDAO**2) | |
51760 | ELSE | |
51761 | MAOD=1 | |
51762 | THE2ID=Z*(1D0-Z)*PEMAO**2/V(IEP(1),5) | |
51763 | IF(MSTJ(42).GE.3.AND.MSTJ(42).NE.5) THE2ID=THE2ID* | |
51764 | & (1D0+PMTH(1,IR)**2*(1D0-Z)/(V(IEP(1),5)*Z))**2 | |
51765 | ENDIF | |
51766 | MAOM=1 | |
51767 | IAOM=IM | |
51768 | 430 IF(K(IAOM,5).EQ.22) THEN | |
51769 | IAOM=K(IAOM,3) | |
51770 | IF(K(IAOM,3).LE.NS) MAOM=0 | |
51771 | IF(MAOM.EQ.1) GOTO 430 | |
51772 | ENDIF | |
51773 | IF(MAOM.EQ.1.AND.MAOD.EQ.1) THEN | |
51774 | THE2IM=V(IAOM,1)*(1D0-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5) | |
51775 | IF(THE2ID.LT.THE2IM) GOTO 400 | |
51776 | ENDIF | |
51777 | ENDIF | |
51778 | ||
51779 | C...Impose user-defined maximum angle at first branching. | |
51780 | IF(MSTJ(48).EQ.1.AND.IPSPD.EQ.0) THEN | |
51781 | IF(NEP.EQ.1.AND.IM.EQ.NS) THEN | |
51782 | THE2ID=Z*(1D0-Z)*PS(4)**2/V(IEP(1),5) | |
51783 | IF(PARJ(85)**2*THE2ID.LT.1D0) GOTO 400 | |
51784 | ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN | |
51785 | THE2ID=Z*(1D0-Z)*(0.5D0*P(IM,4))**2/V(IEP(1),5) | |
51786 | IF(PARJ(85)**2*THE2ID.LT.1D0) GOTO 400 | |
51787 | ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN | |
51788 | THE2ID=Z*(1D0-Z)*(0.5D0*P(IM,4))**2/V(IEP(1),5) | |
51789 | IF(PARJ(86)**2*THE2ID.LT.1D0) GOTO 400 | |
51790 | ENDIF | |
51791 | ENDIF | |
51792 | ||
51793 | C...Impose angular constraint in first branching from interference | |
51794 | C...with initial state partons. | |
51795 | IF(MIIS.GE.2.AND.IEP(1).LE.NS+3) THEN | |
51796 | THE2D=MAX((1D0-Z)/Z,Z/(1D0-Z))*V(IEP(1),5)/(0.5D0*P(IM,4))**2 | |
51797 | IF(IEP(1).EQ.NS+2.AND.ISII(1).GE.1) THEN | |
51798 | IF(THE2D.GT.THEIIS(1,ISII(1))**2) GOTO 400 | |
51799 | ELSEIF(IEP(1).EQ.NS+3.AND.ISII(2).GE.1) THEN | |
51800 | IF(THE2D.GT.THEIIS(2,ISII(2))**2) GOTO 400 | |
51801 | ENDIF | |
51802 | ENDIF | |
51803 | ||
51804 | C...End of inner veto algorithm. Check if only one leg evolved so far. | |
51805 | 440 V(IEP(1),1)=Z | |
51806 | ISL(1)=0 | |
51807 | ISL(2)=0 | |
51808 | IF(NEP.EQ.1) GOTO 480 | |
51809 | IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 340 | |
51810 | DO 450 I=1,NEP | |
51811 | IR=IREF(N+I-NS) | |
51812 | IF(ITRY(I).EQ.0.AND.KSH(IR).EQ.1) THEN | |
51813 | IF(P(N+I,5).GE.PMTH(2,IR)) GOTO 340 | |
51814 | ENDIF | |
51815 | 450 CONTINUE | |
51816 | ||
51817 | C...Check if chosen multiplet m1,m2,z1,z2 is physical. | |
51818 | IF(NEP.GE.3) THEN | |
51819 | PMSUM=0D0 | |
51820 | DO 460 I=1,NEP | |
51821 | PMSUM=PMSUM+P(N+I,5) | |
51822 | 460 CONTINUE | |
51823 | IF(PMSUM.GE.PS(5)) GOTO 340 | |
51824 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN | |
51825 | DO 470 I1=N+1,N+2 | |
51826 | IRDA=IREF(I1-NS) | |
51827 | IF(KSH(IRDA).EQ.0) GOTO 470 | |
51828 | IF(P(I1,5).LT.PMTH(2,IRDA)) GOTO 470 | |
51829 | IF(IRDA.EQ.21) THEN | |
51830 | IRGD1=IABS(K(I1,5)) | |
51831 | IRGD2=IRGD1 | |
51832 | ELSE | |
51833 | IRGD1=IRDA | |
51834 | IRGD2=IABS(K(I1,5)) | |
51835 | ENDIF | |
51836 | I2=2*N+3-I1 | |
51837 | IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN | |
51838 | PED=0.5D0*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5) | |
51839 | ELSE | |
51840 | IF(I1.EQ.N+1) ZM=V(IM,1) | |
51841 | IF(I1.EQ.N+2) ZM=1D0-V(IM,1) | |
51842 | PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2- | |
51843 | & 4D0*V(N+1,5)*V(N+2,5)) | |
51844 | PED=PEM*(0.5D0*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/ | |
51845 | & V(IM,5) | |
51846 | ENDIF | |
51847 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
51848 | PMQTH3=0.5D0*PARJ(82) | |
51849 | IF(IRGD2.EQ.22) PMQTH3=0.5D0*PARJ(83) | |
51850 | IF(IRGD2.EQ.22.AND.ISCOL(IRDA).EQ.0) PMQTH3=0.5D0*PARJ(90) | |
51851 | PMQ1=(PMTH(1,IRGD1)**2+PMQTH3**2)/V(I1,5) | |
51852 | PMQ2=(PMTH(1,IRGD2)**2+PMQTH3**2)/V(I1,5) | |
51853 | ZD=SQRT(MAX(0D0,(1D0-V(I1,5)/PED**2)*((1D0-PMQ1-PMQ2)**2- | |
51854 | & 4D0*PMQ1*PMQ2))) | |
51855 | ZH=1D0+PMQ1-PMQ2 | |
51856 | ELSE | |
51857 | ZD=SQRT(MAX(0D0,1D0-V(I1,5)/PED**2)) | |
51858 | ZH=1D0 | |
51859 | ENDIF | |
51860 | IF(IRDA.EQ.21.AND.IRGD1.LT.10.AND. | |
51861 | & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN | |
51862 | ELSE | |
51863 | ZL=0.5D0*(ZH-ZD) | |
51864 | ZU=0.5D0*(ZH+ZD) | |
51865 | IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU).AND. | |
51866 | & ISSET(1).EQ.0) THEN | |
51867 | ISL(1)=1 | |
51868 | ELSEIF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU).AND. | |
51869 | & ISSET(2).EQ.0) THEN | |
51870 | ISL(2)=1 | |
51871 | ENDIF | |
51872 | ENDIF | |
51873 | IF(IRDA.EQ.21) V(I1,4)=LOG(ZU*(1D0-ZL)/MAX(1D-20, | |
51874 | & ZL*(1D0-ZU))) | |
51875 | IF(IRDA.NE.21) V(I1,4)=LOG((1D0-ZL)/MAX(1D-10,1D0-ZU)) | |
51876 | 470 CONTINUE | |
51877 | IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN | |
51878 | ISL(3-ISLM)=0 | |
51879 | ISLM=3-ISLM | |
51880 | ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN | |
51881 | ZDR1=MAX(0D0,V(N+1,3)/MAX(1D-6,V(N+1,4))-1D0) | |
51882 | ZDR2=MAX(0D0,V(N+2,3)/MAX(1D-6,V(N+2,4))-1D0) | |
51883 | IF(ZDR2.GT.PYR(0)*(ZDR1+ZDR2)) ISL(1)=0 | |
51884 | IF(ISL(1).EQ.1) ISL(2)=0 | |
51885 | IF(ISL(1).EQ.0) ISLM=1 | |
51886 | IF(ISL(2).EQ.0) ISLM=2 | |
51887 | ENDIF | |
51888 | IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 340 | |
51889 | ENDIF | |
51890 | IRD1=IREF(N+1-NS) | |
51891 | IRD2=IREF(N+2-NS) | |
51892 | IF(IGM.GT.0) THEN | |
51893 | IF(MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE. | |
51894 | & PMTH(2,IRD1).OR.P(N+2,5).GE.PMTH(2,IRD2))) THEN | |
51895 | PMQ1=V(N+1,5)/V(IM,5) | |
51896 | PMQ2=V(N+2,5)/V(IM,5) | |
51897 | ZD=SQRT(MAX(0D0,(1D0-V(IM,5)/PEM**2)*((1D0-PMQ1-PMQ2)**2- | |
51898 | & 4D0*PMQ1*PMQ2))) | |
51899 | ZH=1D0+PMQ1-PMQ2 | |
51900 | ZL=0.5D0*(ZH-ZD) | |
51901 | ZU=0.5D0*(ZH+ZD) | |
51902 | IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 340 | |
51903 | ENDIF | |
51904 | ENDIF | |
51905 | ||
51906 | C...Accepted branch. Construct four-momentum for initial partons. | |
51907 | 480 MAZIP=0 | |
51908 | MAZIC=0 | |
51909 | IF(NEP.EQ.1) THEN | |
51910 | P(N+1,1)=0D0 | |
51911 | P(N+1,2)=0D0 | |
51912 | P(N+1,3)=SQRT(MAX(0D0,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)- | |
51913 | & P(N+1,5)))) | |
51914 | P(N+1,4)=P(IPA(1),4) | |
51915 | V(N+1,2)=P(N+1,4) | |
51916 | ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN | |
51917 | PED1=0.5D0*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5) | |
51918 | P(N+1,1)=0D0 | |
51919 | P(N+1,2)=0D0 | |
51920 | P(N+1,3)=SQRT(MAX(0D0,(PED1+P(N+1,5))*(PED1-P(N+1,5)))) | |
51921 | P(N+1,4)=PED1 | |
51922 | P(N+2,1)=0D0 | |
51923 | P(N+2,2)=0D0 | |
51924 | P(N+2,3)=-P(N+1,3) | |
51925 | P(N+2,4)=P(IM,5)-PED1 | |
51926 | V(N+1,2)=P(N+1,4) | |
51927 | V(N+2,2)=P(N+2,4) | |
51928 | ELSEIF(NEP.GE.3) THEN | |
51929 | C...Rescale all momenta for energy conservation. | |
51930 | LOOP=0 | |
51931 | PES=0D0 | |
51932 | PQS=0D0 | |
51933 | DO 500 I=1,NEP | |
51934 | DO 490 J=1,4 | |
51935 | P(N+I,J)=P(IPA(I),J) | |
51936 | 490 CONTINUE | |
51937 | PES=PES+P(N+I,4) | |
51938 | PQS=PQS+P(N+I,5)**2/P(N+I,4) | |
51939 | 500 CONTINUE | |
51940 | 510 LOOP=LOOP+1 | |
51941 | FAC=(PS(5)-PQS)/(PES-PQS) | |
51942 | PES=0D0 | |
51943 | PQS=0D0 | |
51944 | DO 530 I=1,NEP | |
51945 | DO 520 J=1,3 | |
51946 | P(N+I,J)=FAC*P(N+I,J) | |
51947 | 520 CONTINUE | |
51948 | P(N+I,4)=SQRT(P(N+I,5)**2+P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2) | |
51949 | V(N+I,2)=P(N+I,4) | |
51950 | PES=PES+P(N+I,4) | |
51951 | PQS=PQS+P(N+I,5)**2/P(N+I,4) | |
51952 | 530 CONTINUE | |
51953 | IF(LOOP.LT.10.AND.ABS(PES-PS(5)).GT.1D-12*PS(5)) GOTO 510 | |
51954 | ||
51955 | C...Construct transverse momentum for ordinary branching in shower. | |
51956 | ELSE | |
51957 | ZM=V(IM,1) | |
51958 | LOOPPT=0 | |
51959 | 540 LOOPPT=LOOPPT+1 | |
51960 | PZM=SQRT(MAX(0D0,(PEM+P(IM,5))*(PEM-P(IM,5)))) | |
51961 | PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4D0*V(N+1,5)*V(N+2,5) | |
51962 | IF(PZM.LE.0D0) THEN | |
51963 | PTS=0D0 | |
51964 | ELSEIF(K(IM,2).EQ.21.AND.IABS(K(N+1,2)).LE.10.AND. | |
51965 | & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN | |
51966 | PTS=PMLS*ZM*(1D0-ZM)/V(IM,5) | |
51967 | ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN | |
51968 | PTS=(PEM**2*(ZM*(1D0-ZM)*V(IM,5)-(1D0-ZM)*V(N+1,5)- | |
51969 | & ZM*V(N+2,5))-0.25D0*PMLS)/PZM**2 | |
51970 | ELSE | |
51971 | PTS=PMLS*(ZM*(1D0-ZM)*PEM**2/V(IM,5)-0.25D0)/PZM**2 | |
51972 | ENDIF | |
51973 | IF(PTS.LT.0D0.AND.LOOPPT.LT.10) THEN | |
51974 | ZM=0.05D0+0.9D0*ZM | |
51975 | GOTO 540 | |
51976 | ELSEIF(PTS.LT.0D0) THEN | |
51977 | GOTO 270 | |
51978 | ENDIF | |
51979 | PT=SQRT(MAX(0D0,PTS)) | |
51980 | ||
51981 | C...Find coefficient of azimuthal asymmetry due to gluon polarization. | |
51982 | HAZIP=0D0 | |
51983 | IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21 | |
51984 | & .AND.IAU.NE.0) THEN | |
51985 | IF(K(IGM,3).NE.0) MAZIP=1 | |
51986 | ZAU=V(IGM,1) | |
51987 | IF(IAU.EQ.IM+1) ZAU=1D0-V(IGM,1) | |
51988 | IF(MAZIP.EQ.0) ZAU=0D0 | |
51989 | IF(K(IGM,2).NE.21) THEN | |
51990 | HAZIP=2D0*ZAU/(1D0+ZAU**2) | |
51991 | ELSE | |
51992 | HAZIP=(ZAU/(1D0-ZAU*(1D0-ZAU)))**2 | |
51993 | ENDIF | |
51994 | IF(K(N+1,2).NE.21) THEN | |
51995 | HAZIP=HAZIP*(-2D0*ZM*(1D0-ZM))/(1D0-2D0*ZM*(1D0-ZM)) | |
51996 | ELSE | |
51997 | HAZIP=HAZIP*(ZM*(1D0-ZM)/(1D0-ZM*(1D0-ZM)))**2 | |
51998 | ENDIF | |
51999 | ENDIF | |
52000 | ||
52001 | C...Find coefficient of azimuthal asymmetry due to soft gluon | |
52002 | C...interference. | |
52003 | HAZIC=0D0 | |
52004 | IF(MSTJ(49).NE.2.AND.MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR. | |
52005 | & K(N+2,2).EQ.21).AND.IAU.NE.0) THEN | |
52006 | IF(K(IGM,3).NE.0) MAZIC=N+1 | |
52007 | IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2 | |
52008 | IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND. | |
52009 | & ZM.GT.0.5D0) MAZIC=N+2 | |
52010 | IF(K(IAU,2).EQ.22) MAZIC=0 | |
52011 | ZS=ZM | |
52012 | IF(MAZIC.EQ.N+2) ZS=1D0-ZM | |
52013 | ZGM=V(IGM,1) | |
52014 | IF(IAU.EQ.IM-1) ZGM=1D0-V(IGM,1) | |
52015 | IF(MAZIC.EQ.0) ZGM=1D0 | |
52016 | IF(MAZIC.NE.0) HAZIC=(P(IM,5)/P(IGM,5))* | |
52017 | & SQRT((1D0-ZS)*(1D0-ZGM)/(ZS*ZGM)) | |
52018 | HAZIC=MIN(0.95D0,HAZIC) | |
52019 | ENDIF | |
52020 | ENDIF | |
52021 | ||
52022 | C...Construct energies for ordinary branching in shower. | |
52023 | 550 IF(NEP.EQ.2.AND.IGM.GT.0) THEN | |
52024 | IF(K(IM,2).EQ.21.AND.IABS(K(N+1,2)).LE.10.AND. | |
52025 | & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN | |
52026 | P(N+1,4)=0.5D0*(PEM*(V(IM,5)+V(N+1,5)-V(N+2,5))+ | |
52027 | & PZM*SQRT(MAX(0D0,PMLS))*(2D0*ZM-1D0))/V(IM,5) | |
52028 | ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN | |
52029 | P(N+1,4)=PEM*V(IM,1) | |
52030 | ELSE | |
52031 | P(N+1,4)=PEM*(0.5D0*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+ | |
52032 | & SQRT(PMLS)*ZM)/V(IM,5) | |
52033 | ENDIF | |
52034 | ||
52035 | C...Already predetermined choice of phi angle or not | |
52036 | PHI=PARU(2)*PYR(0) | |
52037 | IF(MPSPD.EQ.1.AND.IGM.EQ.NS+1) THEN | |
52038 | IPSPD=IP1+IM-NS-2 | |
52039 | IF(K(IPSPD,4).GT.0) THEN | |
52040 | IPSGD1=K(IPSPD,4) | |
52041 | IF(IM.EQ.NS+2) THEN | |
52042 | PHI=PYANGL(P(IPSGD1,1),P(IPSGD1,2)) | |
52043 | ELSE | |
52044 | PHI=PYANGL(-P(IPSGD1,1),P(IPSGD1,2)) | |
52045 | ENDIF | |
52046 | ENDIF | |
52047 | ELSEIF(MPSPD.EQ.1.AND.IGM.EQ.NS+2) THEN | |
52048 | IPSPD=IP1+IM-NS-2 | |
52049 | IF(K(IPSPD,4).GT.0) THEN | |
52050 | IPSGD1=K(IPSPD,4) | |
52051 | PHIPSM=PYANGL(P(IPSPD,1),P(IPSPD,2)) | |
52052 | THEPSM=PYANGL(P(IPSPD,3),SQRT(P(IPSPD,1)**2+P(IPSPD,2)**2)) | |
52053 | CALL PYROBO(IPSGD1,IPSGD1,0D0,-PHIPSM,0D0,0D0,0D0) | |
52054 | CALL PYROBO(IPSGD1,IPSGD1,-THEPSM,0D0,0D0,0D0,0D0) | |
52055 | PHI=PYANGL(P(IPSGD1,1),P(IPSGD1,2)) | |
52056 | CALL PYROBO(IPSGD1,IPSGD1,THEPSM,PHIPSM,0D0,0D0,0D0) | |
52057 | ENDIF | |
52058 | ENDIF | |
52059 | ||
52060 | C...Construct momenta for ordinary branching in shower. | |
52061 | P(N+1,1)=PT*COS(PHI) | |
52062 | P(N+1,2)=PT*SIN(PHI) | |
52063 | IF(K(IM,2).EQ.21.AND.IABS(K(N+1,2)).LE.10.AND. | |
52064 | & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN | |
52065 | P(N+1,3)=0.5D0*(PZM*(V(IM,5)+V(N+1,5)-V(N+2,5))+ | |
52066 | & PEM*SQRT(MAX(0D0,PMLS))*(2D0*ZM-1D0))/V(IM,5) | |
52067 | ELSEIF(PZM.GT.0D0) THEN | |
52068 | P(N+1,3)=0.5D0*(V(N+2,5)-V(N+1,5)-V(IM,5)+ | |
52069 | & 2D0*PEM*P(N+1,4))/PZM | |
52070 | ELSE | |
52071 | P(N+1,3)=0D0 | |
52072 | ENDIF | |
52073 | P(N+2,1)=-P(N+1,1) | |
52074 | P(N+2,2)=-P(N+1,2) | |
52075 | P(N+2,3)=PZM-P(N+1,3) | |
52076 | P(N+2,4)=PEM-P(N+1,4) | |
52077 | IF(MSTJ(43).LE.2) THEN | |
52078 | V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5) | |
52079 | V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5) | |
52080 | ENDIF | |
52081 | ENDIF | |
52082 | ||
52083 | C...Rotate and boost daughters. | |
52084 | IF(IGM.GT.0) THEN | |
52085 | IF(MSTJ(43).LE.2) THEN | |
52086 | BEX=P(IGM,1)/P(IGM,4) | |
52087 | BEY=P(IGM,2)/P(IGM,4) | |
52088 | BEZ=P(IGM,3)/P(IGM,4) | |
52089 | GA=P(IGM,4)/P(IGM,5) | |
52090 | GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1D0+GA)- | |
52091 | & P(IM,4)) | |
52092 | ELSE | |
52093 | BEX=0D0 | |
52094 | BEY=0D0 | |
52095 | BEZ=0D0 | |
52096 | GA=1D0 | |
52097 | GABEP=0D0 | |
52098 | ENDIF | |
52099 | PTIMB=SQRT((P(IM,1)+GABEP*BEX)**2+(P(IM,2)+GABEP*BEY)**2) | |
52100 | THE=PYANGL(P(IM,3)+GABEP*BEZ,PTIMB) | |
52101 | IF(PTIMB.GT.1D-4) THEN | |
52102 | PHI=PYANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY) | |
52103 | ELSE | |
52104 | PHI=0D0 | |
52105 | ENDIF | |
52106 | DO 560 I=N+1,N+2 | |
52107 | DP(1)=COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+ | |
52108 | & SIN(THE)*COS(PHI)*P(I,3) | |
52109 | DP(2)=COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+ | |
52110 | & SIN(THE)*SIN(PHI)*P(I,3) | |
52111 | DP(3)=-SIN(THE)*P(I,1)+COS(THE)*P(I,3) | |
52112 | DP(4)=P(I,4) | |
52113 | DBP=BEX*DP(1)+BEY*DP(2)+BEZ*DP(3) | |
52114 | DGABP=GA*(GA*DBP/(1D0+GA)+DP(4)) | |
52115 | P(I,1)=DP(1)+DGABP*BEX | |
52116 | P(I,2)=DP(2)+DGABP*BEY | |
52117 | P(I,3)=DP(3)+DGABP*BEZ | |
52118 | P(I,4)=GA*(DP(4)+DBP) | |
52119 | 560 CONTINUE | |
52120 | ENDIF | |
52121 | ||
52122 | C...Weight with azimuthal distribution, if required. | |
52123 | IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN | |
52124 | DO 570 J=1,3 | |
52125 | DPT(1,J)=P(IM,J) | |
52126 | DPT(2,J)=P(IAU,J) | |
52127 | DPT(3,J)=P(N+1,J) | |
52128 | 570 CONTINUE | |
52129 | DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3) | |
52130 | DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3) | |
52131 | DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2 | |
52132 | DO 580 J=1,3 | |
52133 | DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/MAX(1D-10,DPMM) | |
52134 | DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/MAX(1D-10,DPMM) | |
52135 | 580 CONTINUE | |
52136 | DPT(4,4)=SQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2) | |
52137 | DPT(5,4)=SQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2) | |
52138 | IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1D0*PARJ(82)) THEN | |
52139 | CAD=(DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+ | |
52140 | & DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4)) | |
52141 | IF(MAZIP.NE.0) THEN | |
52142 | IF(1D0+HAZIP*(2D0*CAD**2-1D0).LT.PYR(0)*(1D0+ABS(HAZIP))) | |
52143 | & GOTO 550 | |
52144 | ENDIF | |
52145 | IF(MAZIC.NE.0) THEN | |
52146 | IF(MAZIC.EQ.N+2) CAD=-CAD | |
52147 | IF((1D0-HAZIC)*(1D0-HAZIC*CAD)/(1D0+HAZIC**2-2D0*HAZIC*CAD) | |
52148 | & .LT.PYR(0)) GOTO 550 | |
52149 | ENDIF | |
52150 | ENDIF | |
52151 | ENDIF | |
52152 | ||
52153 | C...Azimuthal anisotropy due to interference with initial state partons. | |
52154 | IF(MOD(MIIS,2).EQ.1.AND.IGM.EQ.NS+1.AND.(K(N+1,2).EQ.21.OR. | |
52155 | &K(N+2,2).EQ.21)) THEN | |
52156 | III=IM-NS-1 | |
52157 | IF(ISII(III).GE.1) THEN | |
52158 | IAZIID=N+1 | |
52159 | IF(K(N+1,2).NE.21) IAZIID=N+2 | |
52160 | IF(K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND. | |
52161 | & P(N+1,4).GT.P(N+2,4)) IAZIID=N+2 | |
52162 | THEIID=PYANGL(P(IAZIID,3),SQRT(P(IAZIID,1)**2+P(IAZIID,2)**2)) | |
52163 | IF(III.EQ.2) THEIID=PARU(1)-THEIID | |
52164 | PHIIID=PYANGL(P(IAZIID,1),P(IAZIID,2)) | |
52165 | HAZII=MIN(0.95D0,THEIID/THEIIS(III,ISII(III))) | |
52166 | CAD=COS(PHIIID-PHIIIS(III,ISII(III))) | |
52167 | PHIREL=ABS(PHIIID-PHIIIS(III,ISII(III))) | |
52168 | IF(PHIREL.GT.PARU(1)) PHIREL=PARU(2)-PHIREL | |
52169 | IF((1D0-HAZII)*(1D0-HAZII*CAD)/(1D0+HAZII**2-2D0*HAZII*CAD) | |
52170 | & .LT.PYR(0)) GOTO 550 | |
52171 | ENDIF | |
52172 | ENDIF | |
52173 | ||
52174 | C...Continue loop over partons that may branch, until none left. | |
52175 | IF(IGM.GE.0) K(IM,1)=14 | |
52176 | N=N+NEP | |
52177 | NEP=2 | |
52178 | IF(N.GT.MSTU(4)-MSTU(32)-10) THEN | |
52179 | CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS') | |
52180 | IF(MSTU(21).GE.1) N=NS | |
52181 | IF(MSTU(21).GE.1) RETURN | |
52182 | ENDIF | |
52183 | GOTO 280 | |
52184 | ||
52185 | C...Set information on imagined shower initiator. | |
52186 | 590 IF(NPA.GE.2) THEN | |
52187 | K(NS+1,1)=11 | |
52188 | K(NS+1,2)=94 | |
52189 | K(NS+1,3)=IP1 | |
52190 | IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2 | |
52191 | K(NS+1,4)=NS+2 | |
52192 | K(NS+1,5)=NS+1+NPA | |
52193 | IIM=1 | |
52194 | ELSE | |
52195 | IIM=0 | |
52196 | ENDIF | |
52197 | ||
52198 | C...Reconstruct string drawing information. | |
52199 | DO 600 I=NS+1+IIM,N | |
52200 | KQ=KCHG(PYCOMP(K(I,2)),2) | |
52201 | IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN | |
52202 | K(I,1)=1 | |
52203 | ELSEIF(K(I,1).LE.10.AND.IABS(K(I,2)).GE.11.AND. | |
52204 | & IABS(K(I,2)).LE.18) THEN | |
52205 | K(I,1)=1 | |
52206 | ELSEIF(K(I,1).LE.10) THEN | |
52207 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5)) | |
52208 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5)) | |
52209 | ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN | |
52210 | ID1=MOD(K(I,4),MSTU(5)) | |
52211 | IF(KQ.EQ.1.AND.K(I,2).GT.0) ID1=MOD(K(I,4),MSTU(5))+1 | |
52212 | IF(KQ.EQ.2.AND.(K(ID1,2).EQ.21.OR.K(ID1+1,2).EQ.21).AND. | |
52213 | & PYR(0).GT.0.5D0) ID1=MOD(K(I,4),MSTU(5))+1 | |
52214 | ID2=2*MOD(K(I,4),MSTU(5))+1-ID1 | |
52215 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 | |
52216 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2 | |
52217 | K(ID1,4)=K(ID1,4)+MSTU(5)*I | |
52218 | K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 | |
52219 | K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 | |
52220 | K(ID2,5)=K(ID2,5)+MSTU(5)*I | |
52221 | ELSE | |
52222 | ID1=MOD(K(I,4),MSTU(5)) | |
52223 | ID2=ID1+1 | |
52224 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 | |
52225 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1 | |
52226 | IF(KQ.EQ.1.OR.K(ID1,1).GE.11) THEN | |
52227 | K(ID1,4)=K(ID1,4)+MSTU(5)*I | |
52228 | K(ID1,5)=K(ID1,5)+MSTU(5)*I | |
52229 | ELSE | |
52230 | K(ID1,4)=0 | |
52231 | K(ID1,5)=0 | |
52232 | ENDIF | |
52233 | K(ID2,4)=0 | |
52234 | K(ID2,5)=0 | |
52235 | ENDIF | |
52236 | 600 CONTINUE | |
52237 | ||
52238 | C...Transformation from CM frame. | |
52239 | IF(NPA.EQ.1) THEN | |
52240 | THE=PYANGL(P(IPA(1),3),SQRT(P(IPA(1),1)**2+P(IPA(1),2)**2)) | |
52241 | PHI=PYANGL(P(IPA(1),1),P(IPA(1),2)) | |
52242 | MSTU(33)=1 | |
52243 | CALL PYROBO(NS+1,N,THE,PHI,0D0,0D0,0D0) | |
52244 | ELSEIF(NPA.EQ.2) THEN | |
52245 | BEX=PS(1)/PS(4) | |
52246 | BEY=PS(2)/PS(4) | |
52247 | BEZ=PS(3)/PS(4) | |
52248 | GA=PS(4)/PS(5) | |
52249 | GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3)) | |
52250 | & /(1D0+GA)-P(IPA(1),4)) | |
52251 | THE=PYANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1) | |
52252 | & +GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2)) | |
52253 | PHI=PYANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY) | |
52254 | MSTU(33)=1 | |
52255 | CALL PYROBO(NS+1,N,THE,PHI,BEX,BEY,BEZ) | |
52256 | ELSE | |
52257 | CALL PYROBO(IPA(1),IPA(NPA),0D0,0D0,PS(1)/PS(4),PS(2)/PS(4), | |
52258 | & PS(3)/PS(4)) | |
52259 | MSTU(33)=1 | |
52260 | CALL PYROBO(NS+1,N,0D0,0D0,PS(1)/PS(4),PS(2)/PS(4),PS(3)/PS(4)) | |
52261 | ENDIF | |
52262 | ||
52263 | C...Decay vertex of shower. | |
52264 | DO 620 I=NS+1,N | |
52265 | DO 610 J=1,5 | |
52266 | V(I,J)=V(IP1,J) | |
52267 | 610 CONTINUE | |
52268 | 620 CONTINUE | |
52269 | ||
52270 | C...Delete trivial shower, else connect initiators. | |
52271 | IF(N.LE.NS+NPA+IIM) THEN | |
52272 | N=NS | |
52273 | ELSE | |
52274 | DO 630 IP=1,NPA | |
52275 | K(IPA(IP),1)=14 | |
52276 | K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP | |
52277 | K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP | |
52278 | K(NS+IIM+IP,3)=IPA(IP) | |
52279 | IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1 | |
52280 | IF(K(NS+IIM+IP,1).NE.1) THEN | |
52281 | K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4) | |
52282 | K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5) | |
52283 | ENDIF | |
52284 | 630 CONTINUE | |
52285 | ENDIF | |
52286 | ||
52287 | RETURN | |
52288 | END | |
52289 | ||
52290 | C********************************************************************* | |
52291 | ||
52292 | C...PYMAEL | |
52293 | C...Auxiliary to PYSHOW. | |
52294 | C...Matrix elements for gluon (or photon) emission from | |
52295 | C...a two-body state; to be used by the parton shower routine. | |
52296 | C...Here X_i = 2 E_i/E_cm, R_i = m_i/E_cm and | |
52297 | C...1/sigma_0 d(sigma)/d(x_1)d(x_2) = | |
52298 | C... = (alpha-strong/2 pi) * CF * PYMAEL, | |
52299 | C...i.e. normalization is such that one recovers the familiar | |
52300 | C...(X1**2+X2**2)/((1-X1)*(1-X2)) for the massless case. | |
52301 | C...Coupling structure: | |
52302 | C...NI = 6- 9 : eikonal soft-gluon expression (spin-independent) | |
52303 | C... = 11-14 : V -> q qbar (V = vector/axial vector colour singlet) | |
52304 | C... = 16-19 : q -> q V | |
52305 | C... = 21-24 : S -> q qbar (S = scalar/pseudoscalar colour singlet) | |
52306 | C... = 26-29 : q -> q S | |
52307 | C... = 31-34 : V -> ~q ~qbar (~q = squark) | |
52308 | C... = 36-39 : ~q -> ~q V | |
52309 | C... = 41-44 : S -> ~q ~qbar | |
52310 | C... = 46-49 : ~q -> ~q S | |
52311 | C... = 51-54 : chi -> q ~qbar (chi = neutralino/chargino) | |
52312 | C... = 56-59 : ~q -> q chi | |
52313 | C... = 61-64 : q -> ~q chi | |
52314 | C... = 66-69 : ~g -> q ~qbar | |
52315 | C... = 71-74 : ~q -> q ~g | |
52316 | C... = 76-79 : q -> ~q ~g | |
52317 | C... = 81-84 : (9/4)*(eikonal) for gg -> ~g ~g | |
52318 | C...Note that the order of the decay products is important. | |
52319 | C...In each set of four, the variants are ordered as: | |
52320 | C...ICOMBI = 1 : pure non-gamma5, i.e. vector/scalar/... | |
52321 | C... = 2 : pure gamma5, i.e. axial vector/pseudoscalar/.... | |
52322 | C... = 3 : mixture alpha*(ICOMBI=1) + (1-alpha)*(ICOMBI=2) | |
52323 | C... = 4 : mixture (ICOMBI=1) +- (ICOMBI=2) | |
52324 | ||
52325 | FUNCTION PYMAEL(NI,X1,X2,R1,R2,ALPHA) | |
52326 | ||
52327 | C...Double precision and integer declarations. | |
52328 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
52329 | IMPLICIT INTEGER(I-N) | |
52330 | ||
52331 | C...Check input values. Return zero outside allowed phase space. | |
52332 | PYMAEL=0D0 | |
52333 | IF(X1.LE.2D0*R1.OR.X1.GE.1D0+R1**2-R2**2) RETURN | |
52334 | IF(X2.LE.2D0*R2.OR.X2.GE.1D0+R2**2-R1**2) RETURN | |
52335 | IF(X1+X2.LE.1D0+(R1+R2)**2) RETURN | |
52336 | IF((2D0-2D0*X1-2D0*X2+X1*X2+2D0*R1**2+2D0*R2**2)**2.GE. | |
52337 | &(X1**2-4D0*R1**2)*(X2**2-4D0*R2**2)) RETURN | |
52338 | ALPCOR=MAX(0D0,MIN(1D0,ALPHA)) | |
52339 | ||
52340 | C...Initial values and flags. | |
52341 | ICLASS=NI/5 | |
52342 | ICOMBI=NI-5*ICLASS | |
52343 | ISSET1=0 | |
52344 | ISSET2=0 | |
52345 | ISSET4=0 | |
52346 | ||
52347 | C... Phase space. | |
52348 | PS=SQRT((1D0-(R1+R2)**2)*(1D0-(R1-R2)**2)) | |
52349 | ||
52350 | C...Eikonal expression; also acts as default. | |
52351 | IF(ICLASS.LE.1.OR.ICLASS.GE.17.OR.ICOMBI.EQ.0) THEN | |
52352 | RLO=PS | |
52353 | IF(ICOMBI.EQ.0.OR.ICOMBI.EQ.1) THEN | |
52354 | ANUM=0D0 | |
52355 | ELSEIF(ICOMBI.EQ.2) THEN | |
52356 | ANUM=(2D0-X1-X2)**2 | |
52357 | ELSEIF(ICOMBI.EQ.3) THEN | |
52358 | ANUM=ALPCOR*(2D0-X1-X2)**2 | |
52359 | ELSE | |
52360 | ANUM=0.5D0*(2D0-X1-X2)**2 | |
52361 | ENDIF | |
52362 | RFO=PS*2D0*((X1+X2-1D0+ANUM-R1**2-R2**2)/ | |
52363 | & ((1D0+R1**2-R2**2-X1)*(1D0+R2**2-R1**2-X2))- | |
52364 | & R1**2/(1D0+R2**2-R1**2-X2)**2- | |
52365 | & R2**2/(1D0+R1**2-R2**2-X1)**2) | |
52366 | ICOMBI=0 | |
52367 | ||
52368 | C...V -> q qbar (V = gamma*/Z0/W+-/...). | |
52369 | ELSEIF(ICLASS.EQ.2) THEN | |
52370 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52371 | RLO1=PS*(2-R1**2-R1**4+6*R1*R2-R2**2+2*R1**2*R2**2-R2**4)/2.D0 | |
52372 | RFO1=-1.D0*(3+6*R1**2+R1**4-6*R1*R2+6*R1**3*R2-2*R2**2 | |
52373 | & -6*R1**2*R2**2+6*R1*R2**3+R2**4-3*X1+6*R1*R2*X1 | |
52374 | & +2*R2**2*X1+X1**2-2*R1**2*X1**2+3*R1**2*(2-X1-X2) | |
52375 | & +6*R1*R2*(2-X1-X2)-R2**2*(2-X1-X2)-2*X1*(2-X1-X2) | |
52376 | & -5*R1**2*X1*(2-X1-X2)+R2**2*X1*(2-X1-X2)+X1**2*(2-X1-X2) | |
52377 | & -3*(2-X1-X2)**2-3*R1**2*(2-X1-X2)**2+R2**2*(2-X1-X2)**2 | |
52378 | & +2*X1*(2-X1-X2)**2+(2-X1-X2)**3-X2)/ | |
52379 | & (-1+R1**2-R2**2+X2)**2 | |
52380 | RFO1=RFO1-2*(-3+R1**2-6*R1*R2+6*R1**3*R2+3*R2**2-4*R1**2*R2**2 | |
52381 | & +6*R1*R2**3+2*X1+3*R1**2*X1+R2**2*X1-X1**2-R1**2*X1**2 | |
52382 | & -R2**2*X1**2+4*(2-X1-X2)+2*R1**2*(2-X1-X2)+3*R1*R2*(2-X1 | |
52383 | & -X2)-R2**2*(2-X1-X2)-3*X1*(2-X1-X2)-2*R1**2*X1*(2-X1-X2) | |
52384 | & +X1**2*(2-X1-X2)-(2-X1-X2)**2-R1**2*(2-X1-X2)**2+R1*R2*(2 | |
52385 | & -X1-X2)**2+X1*(2-X1-X2)**2)/ | |
52386 | & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52387 | RFO1=RFO1-1.D0*(-1+2*R1**2+R1**4+6*R1*R2+6*R1**3*R2-2*R2**2 | |
52388 | & -6*R1**2*R2**2+6*R1*R2**3+R2**4-X1-2*R1**2*X1-6*R1*R2*X1 | |
52389 | & +8*R2**2*X1+X1**2-2*R2**2*X1**2-R1**2*(2-X1-X2)+R2**2*(2 | |
52390 | & -X1-X2)-R1**2*X1*(2-X1-X2)+R2**2*X1*(2-X1-X2)+X1**2* | |
52391 | & (2-X1-X2)+X2)/(-1-R1**2+R2**2+X1)**2 | |
52392 | RFO1=RFO1/2.D0 | |
52393 | ISSET1=1 | |
52394 | ENDIF | |
52395 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52396 | RLO2=PS*(2-R1**2-R1**4-6*R1*R2-R2**2+2*R1**2*R2**2-R2**4)/2.D0 | |
52397 | RFO2=-1*(3+6*R1**2+R1**4+6*R1*R2-6*R1**3*R2-2*R2**2 | |
52398 | & -6*R1**2*R2**2-6*R1*R2**3+R2**4-3*X1-6*R1*R2*X1+2*R2**2*X1 | |
52399 | & +X1**2-2*R1**2*X1**2+3*R1**2*(2-X1-X2)-6*R1*R2*(2-X1-X2) | |
52400 | & -R2**2*(2-X1-X2)-2*X1*(2-X1-X2)-5*R1**2*X1*(2-X1-X2) | |
52401 | & +R2**2*X1*(2-X1-X2)+X1**2*(2-X1-X2)-3*(2-X1-X2)**2 | |
52402 | & -3*R1**2*(2-X1-X2)**2+R2**2*(2-X1-X2)**2+2*X1*(2-X1-X2)**2 | |
52403 | & +(2-X1-X2)**3-X2)/(-1+R1**2-R2**2+X2)**2 | |
52404 | RFO2=RFO2-2*(-3+R1**2+6*R1*R2-6*R1**3*R2+3*R2**2-4*R1**2*R2**2 | |
52405 | & -6*R1*R2**3+2*X1+3*R1**2*X1+R2**2*X1-X1**2-R1**2*X1**2 | |
52406 | & -R2**2*X1**2+4*(2-X1-X2)+2*R1**2*(2-X1-X2)-3*R1*R2*(2-X1 | |
52407 | & -X2)-R2**2*(2-X1-X2)-3*X1*(2-X1-X2)-2*R1**2*X1*(2-X1-X2) | |
52408 | & +X1**2*(2-X1-X2)-(2-X1-X2)**2-R1**2*(2-X1-X2)**2-R1*R2*(2 | |
52409 | & -X1-X2)**2+X1*(2-X1-X2)**2)/ | |
52410 | & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52411 | RFO2=RFO2-1*(-1+2*R1**2+R1**4-6*R1*R2-6*R1**3*R2-2*R2**2 | |
52412 | & -6*R1**2*R2**2-6*R1*R2**3+R2**4-X1-2*R1**2*X1+6*R1*R2*X1 | |
52413 | & +8*R2**2*X1+X1**2-2*R2**2*X1**2-R1**2*(2-X1-X2)+R2**2*(2-X1 | |
52414 | & -X2)-R1**2*X1*(2-X1-X2)+R2**2*X1*(2-X1-X2)+X1**2*(2-X1-X2) | |
52415 | & +X2)/(-1-R1**2+R2**2+X1)**2 | |
52416 | RFO2=RFO2/2.D0 | |
52417 | ISSET2=1 | |
52418 | ENDIF | |
52419 | IF(ICOMBI.EQ.4) THEN | |
52420 | RLO4=PS*(2D0-R1**2-R1**4-R2**2+2D0*R1**2*R2**2-R2**4)/2D0 | |
52421 | RFO4=(1-R1**4+6*R1**2*R2**2-R2**4+X1+3*R1**2*X1-9*R2**2*X1 | |
52422 | & -3*X1**2-R1**2*X1**2+3*R2**2*X1**2+X1**3-X2-R1**2*X2 | |
52423 | & +R2**2*X2-R1**2*X1*X2+R2**2*X1*X2+X1**2*X2)/ | |
52424 | & (-1-R1**2+R2**2+X1)**2 | |
52425 | RFO4=RFO4 | |
52426 | & -2*(1+R1**2+R2**2-4*R1**2*R2**2+R1**2*X1+2*R2**2*X1-X1**2 | |
52427 | & -R2**2*X1**2+2*R1**2*X2+R2**2*X2-3*X1*X2+X1**2*X2-X2**2 | |
52428 | & -R1**2*X2**2+X1*X2**2)/ | |
52429 | & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52430 | RFO4=RFO4+(1-R1**4+6*R1**2*R2**2-R2**4-X1+R1**2*X1-R2**2*X1+X2 | |
52431 | & -9*R1**2*X2+3*R2**2*X2+R1**2*X1*X2-R2**2*X1*X2-3*X2**2 | |
52432 | & +3*R1**2*X2**2-R2**2*X2**2+X1*X2**2+X2**3)/ | |
52433 | & (-1+R1**2-R2**2+X2)**2 | |
52434 | RFO4=RFO4/2.D0 | |
52435 | ISSET4=1 | |
52436 | ENDIF | |
52437 | ||
52438 | C...q -> q V. | |
52439 | ELSEIF(ICLASS.EQ.3) THEN | |
52440 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52441 | RLO1=PS*(1D0-2D0*R1**2+R1**4+R2**2-6D0*R1*R2**2 | |
52442 | & +R1**2*R2**2-2D0*R2**4) | |
52443 | RFO1=2*(-1+R1-2*R1**2+2*R1**3-R1**4+R1**5-R2**2+R1*R2**2 | |
52444 | & -5*R1**2*R2**2+R1**3*R2**2-2*R1*R2**4+2*X1-2*R1*X1 | |
52445 | & +2*R1**2*X1-2*R1**3*X1+2*R2**2*X1+5*R1*R2**2*X1 | |
52446 | & +R1**2*R2**2*X1+2*R2**4*X1-X1**2+R1*X1**2-R2**2*X1**2+3*X2 | |
52447 | & +4*R1**2*X2+R1**4*X2+2*R2**2*X2+2*R1**2*R2**2*X2-4*X1*X2 | |
52448 | & -2*R1**2*X1*X2-R2**2*X1*X2+X1**2*X2-2*X2**2 | |
52449 | & -2*R1**2*X2**2+X1*X2**2)/(1-R1**2+R2**2-X2)/(-2+X1+X2) | |
52450 | RFO1=RFO1+(2*R2**2+6*R1*R2**2-6*R1**2*R2**2+6*R1**3*R2**2 | |
52451 | & +2*R2**4+6*R1*R2**4-R2**2*X1+R1**2*R2**2*X1-R2**4*X1+X2 | |
52452 | & -R1**4*X2-3*R2**2*X2-6*R1*R2**2*X2+9*R1**2*R2**2*X2 | |
52453 | & -2*R2**4*X2-X1*X2+R1**2*X1*X2-X2**2-3*R1**2*X2**2 | |
52454 | & +2*R2**2*X2**2+X1*X2**2)/(-1+R1**2-R2**2+X2)**2 | |
52455 | RFO1=RFO1+(-4-8*R1**2-4*R1**4+4*R2**2-4*R1**2*R2**2+8*R2**4 | |
52456 | & +9*X1+10*R1**2*X1+R1**4*X1-3*R2**2*X1+6*R1*R2**2*X1 | |
52457 | & +R1**2*R2**2*X1-2*R2**4*X1-6*X1**2-2*R1**2*X1**2+X1**3 | |
52458 | & +7*X2+8*R1**2*X2+R1**4*X2-7*R2**2*X2+6*R1*R2**2*X2 | |
52459 | & +R1**2*R2**2*X2-2*R2**4*X2-9*X1*X2-3*R1**2*X1*X2 | |
52460 | & +2*R2**2*X1*X2+2*X1**2*X2-3*X2**2-R1**2*X2**2 | |
52461 | & +2*R2**2*X2**2+X1*X2**2)/(-2+X1+X2)**2 | |
52462 | ISSET1=1 | |
52463 | ENDIF | |
52464 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52465 | RLO2=PS*(1D0-2D0*R1**2+R1**4+R2**2+6D0*R1*R2**2 | |
52466 | & +R1**2*R2**2-2D0*R2**4) | |
52467 | RFO2=2*(1+R1+2*R1**2+2*R1**3+R1**4+R1**5+R2**2+R1*R2**2 | |
52468 | & +5*R1**2*R2**2+R1**3*R2**2-2*R1*R2**4-2*X1-2*R1*X1 | |
52469 | & -2*R1**2*X1-2*R1**3*X1-2*R2**2*X1+5*R1*R2**2*X1 | |
52470 | & -R1**2*R2**2*X1-2*R2**4*X1+X1**2+R1*X1**2+R2**2*X1**2-3*X2 | |
52471 | & -4*R1**2*X2-R1**4*X2-2*R2**2*X2-2*R1**2*R2**2*X2+4*X1*X2 | |
52472 | & +2*R1**2*X1*X2+R2**2*X1*X2-X1**2*X2+2*X2**2+2*R1**2*X2**2 | |
52473 | & -X1*X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) | |
52474 | RFO2=RFO2+(2*R2**2-6*R1*R2**2-6*R1**2*R2**2-6*R1**3*R2**2 | |
52475 | & +2*R2**4-6*R1*R2**4-R2**2*X1+R1**2*R2**2*X1-R2**4*X1+X2 | |
52476 | & -R1**4*X2-3*R2**2*X2+6*R1*R2**2*X2+9*R1**2*R2**2*X2 | |
52477 | & -2*R2**4*X2-X1*X2+R1**2*X1*X2-X2**2-3*R1**2*X2**2 | |
52478 | & +2*R2**2*X2**2+X1*X2**2)/(-1+R1**2-R2**2+X2)**2 | |
52479 | RFO2=RFO2+(-4-8*R1**2-4*R1**4+4*R2**2-4*R1**2*R2**2+8*R2**4+9*X1 | |
52480 | & +10*R1**2*X1+R1**4*X1-3*R2**2*X1-6*R1*R2**2*X1 | |
52481 | & +R1**2*R2**2*X1-2*R2**4*X1-6*X1**2-2*R1**2*X1**2+X1**3 | |
52482 | & +7*X2+8*R1**2*X2+R1**4*X2-7*R2**2*X2-6*R1*R2**2*X2 | |
52483 | & +R1**2*R2**2*X2-2*R2**4*X2-9*X1*X2-3*R1**2*X1*X2 | |
52484 | & +2*R2**2*X1*X2+2*X1**2*X2-3*X2**2-R1**2*X2**2+2*R2**2*X2**2 | |
52485 | & +X1*X2**2)/(-2+X1+X2)**2 | |
52486 | ISSET2=1 | |
52487 | ENDIF | |
52488 | IF(ICOMBI.EQ.4) THEN | |
52489 | RLO4=PS*(1.D0-2.D0*R1**2+R1**4+R2**2+R1**2*R2**2-2.D0*R2**4) | |
52490 | RFO4=2*(1+2*R1**2+R1**4+R2**2+5*R1**2*R2**2-2*X1-2*R1**2*X1 | |
52491 | & -2*R2**2*X1-R1**2*R2**2*X1-2*R2**4*X1+X1**2+R2**2*X1**2 | |
52492 | & -3*X2-4*R1**2*X2-R1**4*X2-2*R2**2*X2-2*R1**2*R2**2*X2 | |
52493 | & +4*X1*X2+2*R1**2*X1*X2+R2**2*X1*X2-X1**2*X2+2*X2**2 | |
52494 | & +2*R1**2*X2**2-X1*X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) | |
52495 | RFO4=RFO4+(2*R2**2-6*R1**2*R2**2+2*R2**4-R2**2*X1+R1**2*R2**2*X1 | |
52496 | & -R2**4*X1+X2-R1**4*X2-3*R2**2*X2+9*R1**2*R2**2*X2 | |
52497 | & -2*R2**4*X2-X1*X2+R1**2*X1*X2-X2**2-3*R1**2*X2**2 | |
52498 | & +2*R2**2*X2**2+X1*X2**2)/(-1+R1**2-R2**2+X2)**2 | |
52499 | RFO4=RFO4+(-4-8*R1**2-4*R1**4+4*R2**2-4*R1**2*R2**2+8*R2**4+9*X1 | |
52500 | & +10*R1**2*X1+R1**4*X1-3*R2**2*X1+R1**2*R2**2*X1-2*R2**4*X1 | |
52501 | & -6*X1**2-2*R1**2*X1**2+X1**3+7*X2+8*R1**2*X2+R1**4*X2 | |
52502 | & -7*R2**2*X2+R1**2*R2**2*X2-2*R2**4*X2-9*X1*X2-3*R1**2*X1*X2 | |
52503 | & +2*R2**2*X1*X2+2*X1**2*X2-3*X2**2-R1**2*X2**2+2*R2**2*X2**2 | |
52504 | & +X1*X2**2)/(2-X1-X2)**2 | |
52505 | ISSET4=1 | |
52506 | ENDIF | |
52507 | ||
52508 | C...S -> q qbar (S = h0/H0/A0/H+-/...). | |
52509 | ELSEIF(ICLASS.EQ.4) THEN | |
52510 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52511 | RLO1=PS*(1D0-R1**2-R2**2-2D0*R1*R2) | |
52512 | RFO1=-(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 | |
52513 | & +R2**4+X1-R1**2*X1+2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 | |
52514 | & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 | |
52515 | & -2*(R1**2+R1**4-2*R1**3*R2+R2**2-6*R1**2*R2**2-2*R1*R2**3 | |
52516 | & +R2**4-R1**2*X1+R1*R2*X1+2*R2**2*X1+2*R1**2*X2+R1*R2*X2 | |
52517 | & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52518 | & -(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 | |
52519 | & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2+2*R1*R2*X2 | |
52520 | & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 | |
52521 | ISSET1=1 | |
52522 | ENDIF | |
52523 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52524 | RLO2=PS*(1D0-R1**2-R2**2+2D0*R1*R2) | |
52525 | RFO2=-(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 | |
52526 | & +R2**4+X1-R1**2*X1-2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 | |
52527 | & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 | |
52528 | & -(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 | |
52529 | & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2-2*R1*R2*X2 | |
52530 | & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 | |
52531 | & +2*(-R1**2-R1**4-2*R1**3*R2-R2**2+6*R1**2*R2**2 | |
52532 | & -2*R1*R2**3-R2**4+R1**2*X1+R1*R2*X1-2*R2**2*X1 | |
52533 | & -2*R1**2*X2+R1*R2*X2+R2**2*X2+X1*X2)/ | |
52534 | & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52535 | ISSET2=1 | |
52536 | ENDIF | |
52537 | IF(ICOMBI.EQ.4) THEN | |
52538 | RLO4=PS*(1D0-R1**2-R2**2) | |
52539 | RFO4=-(-1+R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+3*R2**2*X1+X2 | |
52540 | & +R1**2*X2-R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 | |
52541 | & -2*(R1**2+R1**4+R2**2-6*R1**2*R2**2+R2**4-R1**2*X1 | |
52542 | & +2*R2**2*X1+2*R1**2*X2-R2**2*X2-X1*X2)/ | |
52543 | & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52544 | & -(-1+R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+R2**2*X1 | |
52545 | & +X2+3*R1**2*X2-R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 | |
52546 | ISSET4=1 | |
52547 | ENDIF | |
52548 | ||
52549 | C...q -> q S. | |
52550 | ELSEIF(ICLASS.EQ.5) THEN | |
52551 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52552 | RLO1=PS*(1D0+R1**2-R2**2+2D0*R1) | |
52553 | RFO1=(4-4*R1**2+4*R2**2-3*X1-2*R1*X1+R1**2*X1-R2**2*X1-5*X2 | |
52554 | & -2*R1*X2+R1**2*X2-R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2 | |
52555 | & +2*(3-R1-5*R1**2-R1**3+3*R2**2+R1*R2**2-2*X1-R1*X1 | |
52556 | & +R1**2*X1-4*X2+2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52557 | & (1-R1**2+R2**2-X2)/(-2+X1+X2) | |
52558 | & +(2-2*R1-6*R1**2-2*R1**3+2*R2**2-2*R1*R2**2-X1+R1**2*X1 | |
52559 | & -R2**2*X1-3*X2+2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52560 | & (-1+R1**2-R2**2+X2)**2 | |
52561 | ISSET1=1 | |
52562 | ENDIF | |
52563 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52564 | RLO2=PS*(1D0+R1**2-R2**2-2D0*R1) | |
52565 | RFO2=(4-4*R1**2+4*R2**2-3*X1+2*R1*X1+R1**2*X1-R2**2*X1-5*X2 | |
52566 | & +2*R1*X2+R1**2*X2-R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2 | |
52567 | & +2*(3+R1-5*R1**2+R1**3+3*R2**2-R1*R2**2-2*X1+R1*X1 | |
52568 | & +R1**2*X1-4*X2+2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52569 | & (1-R1**2+R2**2-X2)/(-2+X1+X2) | |
52570 | & +(2+2*R1-6*R1**2+2*R1**3+2*R2**2+2*R1*R2**2-X1+R1**2*X1 | |
52571 | & -R2**2*X1-3*X2-2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52572 | & (-1+R1**2-R2**2+X2)**2 | |
52573 | ISSET2=1 | |
52574 | ENDIF | |
52575 | IF(ICOMBI.EQ.4) THEN | |
52576 | RLO4=PS*(1D0+R1**2-R2**2) | |
52577 | RFO4=(4-4*R1**2+4*R2**2-3*X1+R1**2*X1-R2**2*X1-5*X2+R1**2*X2 | |
52578 | & -R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2 | |
52579 | & +2*(3-5*R1**2+3*R2**2-2*X1+R1**2*X1-4*X2+2*R1**2*X2 | |
52580 | & -R2**2*X2+X1*X2+X2**2)/(1-R1**2+R2**2-X2)/(-2+X1+X2) | |
52581 | & +(2-6*R1**2+2*R2**2-X1+R1**2*X1-R2**2*X1-3*X2+3*R1**2*X2 | |
52582 | & -R2**2*X2+X1*X2+X2**2)/(-1+R1**2-R2**2+X2)**2 | |
52583 | ISSET4=1 | |
52584 | ENDIF | |
52585 | ||
52586 | C...V -> ~q ~qbar (~q = squark). | |
52587 | ELSEIF(ICLASS.EQ.6) THEN | |
52588 | RLO1=PS*(1D0-2D0*R1**2+R1**4-2D0*R2**2-2D0*R1**2*R2**2+R2**4) | |
52589 | RFO1=2D0*3D0+(1+R1**2+R2**2-X1)*(4*R1**2-X1**2)/ | |
52590 | & (-1-R1**2+R2**2+X1)**2 | |
52591 | & -2D0*(-1-3*R1**2-R2**2+X1+X1**2/2+X2-X1*X2/2)/ | |
52592 | & (-1-R1**2+R2**2+X1) | |
52593 | & +(1+R1**2+R2**2-X2)*(4*R2**2-X2**2) | |
52594 | & /(-1+R1**2-R2**2+X2)**2 | |
52595 | & -2D0*(-1-R1**2-3*R2**2+X1+X2-X1*X2/2+X2**2/2)/ | |
52596 | & (-1+R1**2-R2**2+X2) | |
52597 | & -(-4*R1**2-4*R1**4-4*R2**2-8*R1**2*R2**2-4*R2**4+2*X1 | |
52598 | & +6*R1**2*X1+6*R2**2*X1-2*X1**2+2*X2+6*R1**2*X2+6*R2**2*X2 | |
52599 | & -4*X1*X2-2*R1**2*X1*X2-2*R2**2*X1*X2+X1**2*X2-2*X2**2 | |
52600 | & +X1*X2**2)/(-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52601 | ISSET1=1 | |
52602 | ||
52603 | C...~q -> ~q V. | |
52604 | ELSEIF(ICLASS.EQ.7) THEN | |
52605 | RLO1=PS*(1D0-2D0*R1**2+R1**4-2D0*R2**2-2D0*R1**2*R2**2+R2**4) | |
52606 | RFO1=16*R2**2+8*(4*R2**2+2*R2**2*X1+X2+R1**2*X2+R2**2*X2-X1*X2 | |
52607 | & -2*X2**2)/(3*(-1+R1**2-R2**2+X2))+8*(1+R1**2+R2**2-X2)* | |
52608 | & (4*R2**2-X2**2)/(3*(-1+R1**2-R2**2+X2)**2)+8*(X1+X2)* | |
52609 | & (-1-2*R1**2-R1**4-2*R2**2+2*R1**2*R2**2-R2**4+2*X1 | |
52610 | & +2*R1**2*X1+2*R2**2*X1-X1**2+2*X2+2*R1**2*X2+2*R2**2*X2 | |
52611 | & -2*X1*X2-X2**2)/(3*(-2+X1+X2)**2)+8*(-1-R1**2+R2**2-X1)* | |
52612 | & (2*R2**2*X1+X2+R1**2*X2+R2**2*X2-X1*X2-X2**2)/ | |
52613 | & (3*(-1+R1**2-R2**2+X2)*(-2+X1+X2))+8*(1+2*R1**2+R1**4 | |
52614 | & +2*R2**2-2*R1**2*R2**2+R2**4-2*X1-2*R1**2*X1-4*R2**2*X1 | |
52615 | & +X1**2-3*X2-3*R1**2*X2-3*R2**2*X2+3*X1*X2+2*X2**2)/ | |
52616 | & (3*(-2+X1+X2)) | |
52617 | RFO1=3D0*RFO1/8D0 | |
52618 | ISSET1=1 | |
52619 | ||
52620 | C...S -> ~q ~qbar. | |
52621 | ELSEIF(ICLASS.EQ.8) THEN | |
52622 | RLO1=PS | |
52623 | RFO1=(-1-2*R1**2-R1**4-2*R2**2+2*R1**2*R2**2-R2**4+2*X1 | |
52624 | & +2*R1**2*X1+2*R2**2*X1-X1**2-R2**2*X1**2+2*X2+2*R1**2*X2 | |
52625 | & +2*R2**2*X2-3*X1*X2-R1**2*X1*X2-R2**2*X1*X2+X1**2*X2-X2**2 | |
52626 | & -R1**2*X2**2+X1*X2**2)/ | |
52627 | & (1+R1**2-R2**2-X1)**2/(-1+R1**2-R2**2+X2)**2 | |
52628 | RFO1=2D0*RFO1 | |
52629 | ISSET1=1 | |
52630 | ||
52631 | C...~q -> ~q S. | |
52632 | ELSEIF(ICLASS.EQ.9) THEN | |
52633 | RLO1=PS | |
52634 | RFO1=(-1-R1**2-R2**2+X2)/(-1+R1**2-R2**2+X2)**2 | |
52635 | & +(1+R1**2-R2**2+X1)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) | |
52636 | & -(X1+X2)/(-2+X1+X2)**2 | |
52637 | ISSET1=1 | |
52638 | ||
52639 | C...chi -> q ~qbar (chi = neutralino/chargino). | |
52640 | ELSEIF(ICLASS.EQ.10) THEN | |
52641 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52642 | RLO1=PS*(1D0+R1**2-R2**2+2D0*R1) | |
52643 | RFO1=(2*R1+X1)*(-1-R1**2-R2**2+X1)/(-1-R1**2+R2**2+X1)**2 | |
52644 | & +2*(-1-R1**2-2*R1**3-R2**2-2*R1*R2**2+3*X1/2+R1*X1 | |
52645 | & -R1**2*X1/2-R2**2*X1/2+X2+R1*X2+R1**2*X2-X1*X2/2)/ | |
52646 | & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52647 | & +(2-2*R1-6*R1**2-2*R1**3+2*R2**2-2*R1*R2**2-X1+R1**2*X1 | |
52648 | & -R2**2*X1-3*X2+2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52649 | & (-1+R1**2-R2**2+X2)**2 | |
52650 | ISSET1=1 | |
52651 | ENDIF | |
52652 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52653 | RLO2=PS*(1D0-2D0*R1+R1**2-R2**2) | |
52654 | RFO2=(2*R1-X1)*(1+R1**2+R2**2-X1)/(-1-R1**2+R2**2+X1)**2 | |
52655 | & +2*(-1-R1**2+2*R1**3-R2**2+2*R1*R2**2+3*X1/2-R1*X1 | |
52656 | & -R1**2*X1/2-R2**2*X1/2+X2-R1*X2+R1**2*X2-X1*X2/2)/ | |
52657 | & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52658 | & +(2+2*R1-6*R1**2+2*R1**3+2*R2**2+2*R1*R2**2-X1+R1**2*X1 | |
52659 | & -R2**2*X1-3*X2-2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52660 | & (-1+R1**2-R2**2+X2)**2 | |
52661 | ISSET2=1 | |
52662 | ENDIF | |
52663 | IF(ICOMBI.EQ.4) THEN | |
52664 | RLO4=PS*(1+R1**2-R2**2) | |
52665 | RFO4=X1*(-1-R1**2-R2**2+X1)/(-1-R1**2+R2**2+X1)**2 | |
52666 | & +2D0*(-1-R1**2-R2**2+3*X1/2-R1**2*X1/2-R2**2*X1/2 | |
52667 | & +X2+R1**2*X2-X1*X2/2)/ | |
52668 | & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) | |
52669 | & +(2-6*R1**2+2*R2**2-X1+R1**2*X1-R2**2*X1-3*X2+3*R1**2*X2 | |
52670 | & -R2**2*X2+X1*X2+X2**2)/(-1+R1**2-R2**2+X2)**2 | |
52671 | ISSET4=1 | |
52672 | ENDIF | |
52673 | ||
52674 | C...~q -> q chi. | |
52675 | ELSEIF(ICLASS.EQ.11) THEN | |
52676 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52677 | RLO1=PS*(1D0-(R1+R2)**2) | |
52678 | RFO1=(1+R1**2+2*R1*R2+R2**2-X1-X2)*(X1+X2)/(-2+X1+X2)**2 | |
52679 | & -(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 | |
52680 | & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2+2*R1*R2*X2 | |
52681 | & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 | |
52682 | & +(-1-2*R1**2-R1**4-2*R1*R2-2*R1**3*R2+2*R1*R2**3+R2**4 | |
52683 | & +X1+R1**2*X1-2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2-2*R2**2*X2 | |
52684 | & +X1*X2+X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) | |
52685 | ISSET1=1 | |
52686 | ENDIF | |
52687 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52688 | RLO2=PS*(1D0-(R1-R2)**2) | |
52689 | RFO2=(1+R1**2-2*R1*R2+R2**2-X1-X2)*(X1+X2)/ | |
52690 | & (-2+X1+X2)**2 | |
52691 | & -(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 | |
52692 | & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2-2*R1*R2*X2 | |
52693 | & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 | |
52694 | & +(-1-2*R1**2-R1**4+2*R1*R2+2*R1**3*R2-2*R1*R2**3+R2**4 | |
52695 | & +X1+R1**2*X1+2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2-2*R2**2*X2 | |
52696 | & +X1*X2+X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) | |
52697 | ISSET2=1 | |
52698 | ENDIF | |
52699 | IF(ICOMBI.EQ.4) THEN | |
52700 | RLO4=PS*(1D0-R1**2-R2**2) | |
52701 | RFO4=(1+R1**2+R2**2-X1-X2)*(X1+X2)/(-2+X1+X2)**2 | |
52702 | & -(-1+R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+R2**2*X1+X2 | |
52703 | & +3*R1**2*X2-R2**2*X2-X1*X2)/ | |
52704 | & (-1+R1**2-R2**2+X2)**2 | |
52705 | & -(-1-2*R1**2-R1**4+R2**4+X1+R1**2*X1-3*R2**2*X1 | |
52706 | & +2*R1**2*X2-2*R2**2*X2+X1*X2+X2**2)/ | |
52707 | & (2-X1-X2)/(-1+R1**2-R2**2+X2) | |
52708 | ISSET4=1 | |
52709 | ENDIF | |
52710 | ||
52711 | C...q -> ~q chi. | |
52712 | ELSEIF(ICLASS.EQ.12) THEN | |
52713 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52714 | RLO1=PS*(1D0-R1**2+R2**2+2D0*R2) | |
52715 | RFO1=(2*R2+X2)*(-1-R1**2-R2**2+X2)/(-1+R1**2-R2**2+X2)**2 | |
52716 | & +(4+4*R1**2-4*R2**2-5*X1-R1**2*X1-2*R2*X1+R2**2*X1+X1**2 | |
52717 | & -3*X2-R1**2*X2-2*R2*X2+R2**2*X2+X1*X2)/ | |
52718 | & (-2+X1+X2)**2-2*(-1-R1**2+R2+R1**2*R2-R2**2-R2**3+X1 | |
52719 | & +R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2-X2**2/2)/ | |
52720 | & (2-X1-X2)/(-1+R1**2-R2**2+X2) | |
52721 | ISSET1=1 | |
52722 | END IF | |
52723 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52724 | RLO2=PS*(1D0-R1**2+R2**2-2D0*R2) | |
52725 | RFO2=(2*R2-X2)*(1+R1**2+R2**2-X2)/(-1+R1**2-R2**2+X2)**2 | |
52726 | & +(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+2*R2*X1+R2**2*X1+X1**2 | |
52727 | & -3*X2-R1**2*X2+2*R2*X2+R2**2*X2+X1*X2)/ | |
52728 | & (-2+X1+X2)**2-2*(-1-R1**2-R2-R1**2*R2-R2**2+R2**3+X1 | |
52729 | & -R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2-X2**2/2)/ | |
52730 | & (2-X1-X2)/(-1+R1**2-R2**2+X2) | |
52731 | ISSET2=1 | |
52732 | END IF | |
52733 | IF(ICOMBI.EQ.4) THEN | |
52734 | RLO4=PS*(1D0-R1**2+R2**2) | |
52735 | RFO4=X2*(-1-R1**2-R2**2+X2)/(-1+R1**2-R2**2+X2)**2 | |
52736 | & +(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+R2**2*X1+X1**2 | |
52737 | & -3*X2-R1**2*X2+R2**2*X2+X1*X2)/ | |
52738 | & (-2+X1+X2)**2-2*(-1-R1**2-R2**2+X1+R2**2*X1+2*X2 | |
52739 | & +R1**2*X2-X1*X2/2-X2**2/2)/ | |
52740 | & (2-X1-X2)/(-1+R1**2-R2**2+X2) | |
52741 | ISSET4=1 | |
52742 | END IF | |
52743 | ||
52744 | C...~g -> q ~qbar. | |
52745 | ELSEIF(ICLASS.EQ.13) THEN | |
52746 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52747 | RLO1=PS*(1D0+R1**2-R2**2+2D0*R1) | |
52748 | RFO1=4*(2*R1+X1)*(-1-R1**2-R2**2+X1)/(3*(-1-R1**2+R2**2+X1)**2) | |
52749 | & -(-1-R1**2-2*R1**3-R2**2-2*R1*R2**2+3*X1/2+R1*X1-R1**2*X1/2 | |
52750 | & -R2**2*X1/2+X2+R1*X2+R1**2*X2-X1*X2/2)/(3*(-1-R1**2+R2**2 | |
52751 | & +X1)*(-1+R1**2-R2**2+X2))-3*(-1+R1-R1**2-R1**3-R2**2 | |
52752 | & +R1*R2**2+2*X1+R2**2*X1-X1**2/2+X2+R1*X2+R1**2*X2-X1*X2/2)/ | |
52753 | & ((-1-R1**2+R2**2+X1)*(2-X1-X2))+3*(4-4*R1**2+4*R2**2-3*X1 | |
52754 | & -2*R1*X1+R1**2*X1-R2**2*X1-5*X2-2*R1*X2+R1**2*X2-R2**2*X2 | |
52755 | & +X1*X2+X2**2)/(-2+X1+X2)**2+3*(3-R1-5*R1**2-R1**3+3*R2**2 | |
52756 | & +R1*R2**2-2*X1-R1*X1+R1**2*X1-4*X2+2*R1**2*X2-R2**2*X2 | |
52757 | & +X1*X2+X2**2)/((1-R1**2+R2**2-X2)*(-2+X1+X2))+4*(2-2*R1 | |
52758 | & -6*R1**2-2*R1**3+2*R2**2-2*R1*R2**2-X1+R1**2*X1-R2**2*X1 | |
52759 | & -3*X2+2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52760 | & (3*(-1+R1**2-R2**2+X2)**2) | |
52761 | RFO1=3D0*RFO1/4D0 | |
52762 | ISSET1=1 | |
52763 | ENDIF | |
52764 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52765 | RLO2=PS*(1D0+R1**2-R2**2-2D0*R1) | |
52766 | RFO2=4*(2*R1-X1)*(1+R1**2+R2**2-X1)/(3*(-1-R1**2+R2**2+X1)**2) | |
52767 | & -3*(-1-R1-R1**2+R1**3-R2**2-R1*R2**2+2*X1+R2**2*X1-X1**2/2 | |
52768 | & +X2-R1*X2+R1**2*X2-X1*X2/2)/((-1-R1**2+R2**2+X1)*(2-X1-X2)) | |
52769 | & +(2+2*R1**2-4*R1**3+2*R2**2-4*R1*R2**2-3*X1+2*R1*X1 | |
52770 | & +R1**2*X1+R2**2*X1-2*X2+2*R1*X2-2*R1**2*X2+X1*X2)/ | |
52771 | & (6*(-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+3*(4-4*R1**2 | |
52772 | & +4*R2**2-3*X1+2*R1*X1+R1**2*X1-R2**2*X1-5*X2+2*R1*X2 | |
52773 | & +R1**2*X2-R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2+3*(3+R1 | |
52774 | & -5*R1**2+R1**3+3*R2**2-R1*R2**2-2*X1+R1*X1+R1**2*X1-4*X2 | |
52775 | & +2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52776 | & ((1-R1**2+R2**2-X2)*(-2+X1+X2))+4*(2+2*R1-6*R1**2+2*R1**3 | |
52777 | & +2*R2**2+2*R1*R2**2-X1+R1**2*X1-R2**2*X1-3*X2-2*R1*X2 | |
52778 | & +3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52779 | & (3*(-1+R1**2-R2**2+X2)**2) | |
52780 | RFO2=3D0*RFO2/4D0 | |
52781 | ISSET2=1 | |
52782 | ENDIF | |
52783 | IF(ICOMBI.EQ.4) THEN | |
52784 | RLO4=PS*(1D0+R1**2-R2**2) | |
52785 | RFO4=8*X1*(-1-R1**2-R2**2+X1)/(3*(-1-R1**2+R2**2+X1)**2)-6*(-1 | |
52786 | & -R1**2-R2**2+2*X1+R2**2*X1-X1**2/2+X2+R1**2*X2-X1*X2/2)/ | |
52787 | & ((-1-R1**2+R2**2+X1)*(2-X1-X2))+(2+2*R1**2+2*R2**2-3*X1 | |
52788 | & +R1**2*X1+R2**2*X1-2*X2-2*R1**2*X2+X1*X2)/(3*(-1-R1**2 | |
52789 | & +R2**2+X1)*(-1+R1**2-R2**2+X2))+6*(4-4*R1**2+4*R2**2-3*X1 | |
52790 | & +R1**2*X1-R2**2*X1-5*X2+R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52791 | & (-2+X1+X2)**2+6*(3-5*R1**2+3*R2**2-2*X1+R1**2*X1-4*X2 | |
52792 | & +2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52793 | & ((1-R1**2+R2**2-X2)*(-2+X1+X2))+8*(2-6*R1**2+2*R2**2-X1 | |
52794 | & +R1**2*X1-R2**2*X1-3*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ | |
52795 | & (3*(-1+R1**2-R2**2+X2)**2) | |
52796 | RFO4=3D0*RFO4/8D0 | |
52797 | ISSET4=1 | |
52798 | ENDIF | |
52799 | ||
52800 | C...~q -> q ~g. | |
52801 | ELSEIF(ICLASS.EQ.14) THEN | |
52802 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52803 | RLO1=PS*(1-R1**2-R2**2-2D0*R1*R2) | |
52804 | RFO1=64*(1+R1**2+2*R1*R2+R2**2-X1-X2)*(X1+X2)/(9*(-2+X1+X2)**2) | |
52805 | & -16*(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 | |
52806 | & +R2**4+X1-R1**2*X1+2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 | |
52807 | & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2-16*(R1**2+R1**4 | |
52808 | & -2*R1**3*R2+R2**2-6*R1**2*R2**2-2*R1*R2**3+R2**4 | |
52809 | & -R1**2*X1+R1*R2*X1+2*R2**2*X1+2*R1**2*X2+R1*R2*X2-R2**2*X2 | |
52810 | & -X1*X2)/((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2)) | |
52811 | & -64*(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 | |
52812 | & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2+2*R1*R2*X2 | |
52813 | & -R2**2*X2-X1*X2)/(9*(-1+R1**2-R2**2+X2)**2) | |
52814 | & +8*(-1+R1**4-2*R1*R2+2*R1**3*R2-2*R2**2-2*R1*R2**3-R2**4 | |
52815 | & -2*R1**2*X1+2*R2**2*X1+X1**2+X2-3*R1**2*X2-2*R1*R2*X2 | |
52816 | & +R2**2*X2+X1*X2)/((-1-R1**2+R2**2+X1)*(-2+X1+X2)) | |
52817 | RFO1=RFO1 | |
52818 | & +8*(-1-2*R1**2-R1**4-2*R1*R2-2*R1**3*R2+2*R1*R2**3+R2**4 | |
52819 | & +X1+R1**2*X1-2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2-2*R2**2*X2 | |
52820 | & +X1*X2+X2**2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) | |
52821 | RFO1=9D0*RFO1/64D0 | |
52822 | ISSET1=1 | |
52823 | ENDIF | |
52824 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52825 | RLO2=PS*(1-R1**2-R2**2+2D0*R1*R2) | |
52826 | RFO2=64*(1+R1**2-2*R1*R2+R2**2-X1-X2)*(X1+X2)/(9*(-2+X1+X2)**2) | |
52827 | & -16*(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 | |
52828 | & +R2**4+X1-R1**2*X1-2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 | |
52829 | & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2-64*(-1+R1**4 | |
52830 | & +2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3+R2**4+X1 | |
52831 | & -R1**2*X1+R2**2*X1+X2+3*R1**2*X2-2*R1*R2*X2-R2**2*X2 | |
52832 | & -X1*X2)/(9*(-1+R1**2-R2**2+X2)**2)+16*(-R1**2-R1**4 | |
52833 | & -2*R1**3*R2-R2**2+6*R1**2*R2**2-2*R1*R2**3-R2**4+R1**2*X1 | |
52834 | & +R1*R2*X1-2*R2**2*X1-2*R1**2*X2+R1*R2*X2+R2**2*X2+X1*X2)/ | |
52835 | & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2)) | |
52836 | RFO2=RFO2 | |
52837 | & +8*(-1+R1**4+2*R1*R2-2*R1**3*R2-2*R2**2+2*R1*R2**3-R2**4 | |
52838 | & -2*R1**2*X1+2*R2**2*X1+X1**2+X2-3*R1**2*X2+2*R1*R2*X2 | |
52839 | & +R2**2*X2+X1*X2)/((-1-R1**2+R2**2+X1)*(-2+X1+X2)) | |
52840 | & +8*(-1-2*R1**2-R1**4+2*R1*R2+2*R1**3*R2-2*R1*R2**3 | |
52841 | & +R2**4+X1+R1**2*X1+2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2 | |
52842 | & -2*R2**2*X2+X1*X2+X2**2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) | |
52843 | RFO2=9D0*RFO2/64D0 | |
52844 | ISSET2=1 | |
52845 | ENDIF | |
52846 | IF(ICOMBI.EQ.4) THEN | |
52847 | RLO4=PS*(1-R1**2-R2**2) | |
52848 | RFO4=128*(1+R1**2+R2**2-X1-X2)*(X1+X2)/(9*(-2+X1+X2)**2)-32*(-1 | |
52849 | & +R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+3*R2**2*X1+X2 | |
52850 | & +R1**2*X2-R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 | |
52851 | & -32*(R1**2+R1**4+R2**2-6*R1**2*R2**2+R2**4-R1**2*X1 | |
52852 | & +2*R2**2*X1+2*R1**2*X2-R2**2*X2-X1*X2)/ | |
52853 | & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))-128*(-1+R1**4 | |
52854 | & -6*R1**2*R2**2+R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2 | |
52855 | & -R2**2*X2-X1*X2)/(9*(-1+R1**2-R2**2+X2)**2) | |
52856 | & +16*(-1+R1**4-2*R2**2-R2**4-2*R1**2*X1+2*R2**2*X1+X1**2 | |
52857 | & +X2-3*R1**2*X2+R2**2*X2+X1*X2)/ | |
52858 | & ((-1-R1**2+R2**2+X1)*(-2+X1+ X2)) | |
52859 | RFO4=RFO4+16*(-1-2*R1**2-R1**4+R2**4+X1+R1**2*X1-3*R2**2*X1 | |
52860 | & +2*R1**2*X2-2*R2**2*X2+X1*X2+X2**2)/ | |
52861 | & (9*(1-R1**2+R2**2-X2)*(-2+X1+X2)) | |
52862 | RFO4=9D0*RFO4/128D0 | |
52863 | ISSET4=1 | |
52864 | ENDIF | |
52865 | ||
52866 | C...q -> ~q ~g. | |
52867 | ELSEIF(ICLASS.EQ.15) THEN | |
52868 | IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN | |
52869 | RLO1=PS*(1D0-R1**2+R2**2+2D0*R2) | |
52870 | RFO1=32*(2*R2+X2)*(-1-R1**2-R2**2+X2)/(9*(-1+R1**2-R2**2+X2)**2) | |
52871 | & +8*(-1-R1**2-2*R1**2*R2-R2**2-2*R2**3+X1+R2*X1+R2**2*X1 | |
52872 | & +3*X2/2-R1**2*X2/2+R2*X2-R2**2*X2/2-X1*X2/2)/ | |
52873 | & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+8*(2+2*R1**2-2*R2 | |
52874 | & -2*R1**2*R2-6*R2**2-2*R2**3-3*X1-R1**2*X1+2*R2*X1 | |
52875 | & +3*R2**2*X1+X1**2-X2-R1**2*X2+R2**2*X2+X1*X2)/ | |
52876 | & (-1-R1**2+R2**2+X1)**2+32*(4+4*R1**2-4*R2**2-5*X1 | |
52877 | & -R1**2*X1-2*R2*X1+R2**2*X1+X1**2-3*X2-R1**2*X2-2*R2*X2 | |
52878 | & +R2**2*X2+X1*X2)/(9*(-2+X1+X2)**2) | |
52879 | RFO1=RFO1+8*(3+3*R1**2-R2+R1**2*R2-5*R2**2-R2**3-4*X1-R1**2*X1 | |
52880 | & +2*R2**2*X1+X1**2-2*X2-R2*X2+R2**2*X2+X1*X2)/ | |
52881 | & ((-1-R1**2+R2**2+X1)*(2-X1-X2))+8*(-1-R1**2+R2+R1**2*R2 | |
52882 | & -R2**2-R2**3+X1+R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2 | |
52883 | & -X2**2/2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) | |
52884 | RFO1=9D0*RFO1/32D0 | |
52885 | ISSET1=1 | |
52886 | END IF | |
52887 | IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN | |
52888 | RLO2=PS*(1D0-R1**2+R2**2-2D0*R2) | |
52889 | RFO2=32*(2*R2-X2)*(1+R1**2+R2**2-X2)/(9*(-1+R1**2-R2**2+X2)**2) | |
52890 | & +8*(-1-R1**2+2*R1**2*R2-R2**2+2*R2**3+X1-R2*X1+R2**2*X1 | |
52891 | & +3*X2/2-R1**2*X2/2-R2*X2-R2**2*X2/2-X1*X2/2)/ | |
52892 | & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+8*(2+2*R1**2+2*R2 | |
52893 | & +2*R1**2*R2-6*R2**2+2*R2**3-3*X1-R1**2*X1-2*R2*X1 | |
52894 | & +3*R2**2*X1+X1**2-X2-R1**2*X2+R2**2*X2+X1*X2)/ | |
52895 | & (-1-R1**2+R2**2+X1)**2+8*(3+3*R1**2+R2-R1**2*R2-5*R2**2 | |
52896 | & +R2**3-4*X1-R1**2*X1+2*R2**2*X1+X1**2-2*X2+R2*X2+R2**2*X2 | |
52897 | & +X1*X2)/((-1-R1**2+R2**2+X1)*(2-X1-X2)) | |
52898 | RFO2=RFO2+32*(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+2*R2*X1+R2**2*X1 | |
52899 | & +X1**2-3*X2-R1**2*X2+2*R2*X2+R2**2*X2+X1*X2)/ | |
52900 | & (9*(-2+X1+X2)**2)+8*(-1-R1**2-R2-R1**2*R2-R2**2+R2**3+X1 | |
52901 | & -R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2-X2**2/2)/ | |
52902 | & (9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) | |
52903 | RFO2=9D0*RFO2/32D0 | |
52904 | ISSET2=1 | |
52905 | END IF | |
52906 | IF(ICOMBI.EQ.4) THEN | |
52907 | RLO4=PS*(1D0-R1**2+R2**2) | |
52908 | RFO4=64*X2*(-1-R1**2-R2**2+X2)/(9*(-1+R1**2-R2**2+X2)**2) | |
52909 | & +16*(-1-R1**2-R2**2+X1+R2**2*X1+3*X2/2-R1**2*X2/2 | |
52910 | & -R2**2*X2/2-X1*X2/2)/ | |
52911 | & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+16*(3+3*R1**2 | |
52912 | & -5*R2**2-4*X1-R1**2*X1+2*R2**2*X1+X1**2-2*X2+R2**2*X2 | |
52913 | & +X1*X2)/((-1-R1**2+R2**2+X1)*(2-X1-X2)) | |
52914 | & +64*(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+R2**2*X1+X1**2-3*X2 | |
52915 | & -R1**2*X2+R2**2*X2+X1*X2)/(9*(-2+X1+X2)**2) | |
52916 | RFO4=RFO4+16*(2+2*R1**2-6*R2**2-3*X1-R1**2*X1+3*R2**2*X1+X1**2 | |
52917 | & -X2-R1**2*X2+R2**2*X2+X1*X2)/(-1-R1**2+R2**2+X1)**2 | |
52918 | & +16*(-1-R1**2-R2**2+X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2 | |
52919 | & -X2**2/2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) | |
52920 | RFO4=9D0*RFO4/64D0 | |
52921 | ISSET4=1 | |
52922 | END IF | |
52923 | ||
52924 | C...g -> ~g ~g. Use (9/4)*eikonal. May be changed in the future. | |
52925 | ELSEIF(ICLASS.EQ.16) THEN | |
52926 | RLO=PS | |
52927 | IF(ICOMBI.EQ.0.OR.ICOMBI.EQ.1) THEN | |
52928 | ANUM=0D0 | |
52929 | ELSEIF(ICOMBI.EQ.2) THEN | |
52930 | ANUM=(2D0-X1-X2)**2 | |
52931 | ELSEIF(ICOMBI.EQ.3) THEN | |
52932 | ANUM=ALPCOR*(2D0-X1-X2)**2 | |
52933 | ELSE | |
52934 | ANUM=0.5D0*(2D0-X1-X2)**2 | |
52935 | ENDIF | |
52936 | RFO=PS*2D0*((X1+X2-1D0+ANUM-R1**2-R2**2)/ | |
52937 | & ((1D0+R1**2-R2**2-X1)*(1D0+R2**2-R1**2-X2))- | |
52938 | & R1**2/(1D0+R2**2-R1**2-X2)**2- | |
52939 | & R2**2/(1D0+R1**2-R2**2-X1)**2) | |
52940 | RFO=9D0*RFO/4D0 | |
52941 | ICOMBI=0 | |
52942 | ENDIF | |
52943 | ||
52944 | C...Find relevant LO and FO expression. | |
52945 | IF(ICOMBI.EQ.0) THEN | |
52946 | ELSEIF(ICOMBI.EQ.1.AND.ISSET1.EQ.1) THEN | |
52947 | RLO=RLO1 | |
52948 | RFO=RFO1 | |
52949 | ELSEIF(ICOMBI.EQ.2.AND.ISSET2.EQ.1) THEN | |
52950 | RLO=RLO2 | |
52951 | RFO=RFO2 | |
52952 | ELSEIF(ICOMBI.EQ.3.AND.ISSET1.EQ.1.AND.ISSET2.EQ.1) THEN | |
52953 | RLO=ALPCOR*RLO1+(1D0-ALPCOR)*RLO2 | |
52954 | RFO=ALPCOR*RFO1+(1D0-ALPCOR)*RFO2 | |
52955 | ELSEIF(ISSET4.EQ.1) THEN | |
52956 | RLO=RLO4 | |
52957 | RFO=RFO4 | |
52958 | ELSEIF(ICOMBI.EQ.4.AND.ISSET1.EQ.1.AND.ISSET2.EQ.1) THEN | |
52959 | RLO=0.5D0*(RLO1+RLO2) | |
52960 | RFO=0.5D0*(RFO1+RFO2) | |
52961 | ELSEIF(ISSET1.EQ.1) THEN | |
52962 | RLO=RLO1 | |
52963 | RFO=RFO1 | |
52964 | ELSE | |
52965 | CALL PYERRM(16,'(PYMAEL:) not implemented ME code') | |
52966 | RLO=1D0 | |
52967 | RFO=0D0 | |
52968 | ENDIF | |
52969 | ||
52970 | C...Output. | |
52971 | PYMAEL=RFO/RLO | |
52972 | ||
52973 | RETURN | |
52974 | END | |
52975 | ||
52976 | C********************************************************************* | |
52977 | ||
52978 | C...PYBOEI | |
52979 | C...Modifies an event so as to approximately take into account | |
52980 | C...Bose-Einstein effects according to a simple phenomenological | |
52981 | C...parametrization. | |
52982 | ||
52983 | SUBROUTINE PYBOEI(NSAV) | |
52984 | ||
52985 | C...Double precision and integer declarations. | |
52986 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
52987 | IMPLICIT INTEGER(I-N) | |
52988 | INTEGER PYK,PYCHGE,PYCOMP | |
52989 | C...Parameter statement to help give large particle numbers. | |
52990 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
52991 | &KEXCIT=4000000,KDIMEN=5000000) | |
52992 | C...Commonblocks. | |
52993 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
52994 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
52995 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
52996 | COMMON/PYINT1/MINT(400),VINT(400) | |
52997 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYINT1/ | |
52998 | C...Local arrays and data. | |
52999 | DIMENSION DPS(4),KFBE(9),NBE(0:10),BEI(100),BEI3(100), | |
53000 | &BEIW(100),BEI3W(100) | |
53001 | DATA KFBE/211,-211,111,321,-321,130,310,221,331/ | |
53002 | C...Statement function: squared invariant mass. | |
53003 | SDIP(I,J)=((P(I,4)+P(J,4))**2-(P(I,3)+P(J,3))**2- | |
53004 | &(P(I,2)+P(J,2))**2-(P(I,1)+P(J,1))**2) | |
53005 | ||
53006 | C...Boost event to overall CM frame. Calculate CM energy. | |
53007 | IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN | |
53008 | DO 100 J=1,4 | |
53009 | DPS(J)=0D0 | |
53010 | 100 CONTINUE | |
53011 | DO 120 I=1,N | |
53012 | KFA=IABS(K(I,2)) | |
53013 | IF(K(I,1).LE.10.AND.((KFA.GT.10.AND.KFA.LE.20).OR.KFA.EQ.22) | |
53014 | & .AND.K(I,3).GT.0) THEN | |
53015 | KFMA=IABS(K(K(I,3),2)) | |
53016 | IF(KFMA.GT.10.AND.KFMA.LE.80) K(I,1)=-K(I,1) | |
53017 | ENDIF | |
53018 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 | |
53019 | DO 110 J=1,4 | |
53020 | DPS(J)=DPS(J)+P(I,J) | |
53021 | 110 CONTINUE | |
53022 | 120 CONTINUE | |
53023 | CALL PYROBO(0,0,0D0,0D0,-DPS(1)/DPS(4),-DPS(2)/DPS(4), | |
53024 | &-DPS(3)/DPS(4)) | |
53025 | PECM=0D0 | |
53026 | DO 130 I=1,N | |
53027 | IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4) | |
53028 | 130 CONTINUE | |
53029 | ||
53030 | C...Check if we have separated strings | |
53031 | ||
53032 | C...Reserve copy of particles by species at end of record. | |
53033 | IWP=0 | |
53034 | IWN=0 | |
53035 | NBE(0)=N+MSTU(3) | |
53036 | NMAX=NBE(0) | |
53037 | SMMIN=PECM | |
53038 | DO 190 IBE=1,MIN(10,MSTJ(52)+1) | |
53039 | NBE(IBE)=NBE(IBE-1) | |
53040 | DO 180 I=NSAV+1,N | |
53041 | IF(IBE.EQ.MIN(10,MSTJ(52)+1)) THEN | |
53042 | DO 140 IIBE=1,IBE-1 | |
53043 | IF(K(I,2).EQ.KFBE(IIBE)) GOTO 180 | |
53044 | 140 CONTINUE | |
53045 | ELSE | |
53046 | IF(K(I,2).NE.KFBE(IBE)) GOTO 180 | |
53047 | ENDIF | |
53048 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 180 | |
53049 | IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN | |
53050 | CALL PYERRM(11,'(PYBOEI:) no more memory left in PYJETS') | |
53051 | RETURN | |
53052 | ENDIF | |
53053 | NBE(IBE)=NBE(IBE)+1 | |
53054 | NMAX=NBE(IBE) | |
53055 | K(NBE(IBE),1)=I | |
53056 | K(NBE(IBE),2)=0 | |
53057 | K(NBE(IBE),3)=0 | |
53058 | K(NBE(IBE),4)=0 | |
53059 | K(NBE(IBE),5)=0 | |
53060 | P(NBE(IBE),1)=0.0D0 | |
53061 | P(NBE(IBE),2)=0.0D0 | |
53062 | P(NBE(IBE),3)=0.0D0 | |
53063 | P(NBE(IBE),4)=0.0D0 | |
53064 | P(NBE(IBE),5)=0.0D0 | |
53065 | SMMIN=MIN(SMMIN,P(I,5)) | |
53066 | C...Check if particles comes from different W's or Z's | |
53067 | IF((MSTJ(53).NE.0.OR.MSTJ(56).GT.0).AND.MINT(32).EQ.0) THEN | |
53068 | IM=I | |
53069 | 150 IF(K(IM,3).GT.0) THEN | |
53070 | IM=K(IM,3) | |
53071 | IF(ABS(K(IM,2)).NE.24.AND.K(IM,2).NE.23) GOTO 150 | |
53072 | K(NBE(IBE),5)=IM | |
53073 | IF(IWP.EQ.0.AND.K(IM,2).EQ.24) IWP=IM | |
53074 | IF(IWN.EQ.0.AND.K(IM,2).EQ.-24) IWN=IM | |
53075 | IF(IWP.EQ.0.AND.K(IM,2).EQ.23) IWP=IM | |
53076 | IF(IWN.EQ.0.AND.K(IM,2).EQ.23.AND.IM.NE.IWP) IWN=IM | |
53077 | ENDIF | |
53078 | ENDIF | |
53079 | C...Check if particles comes from different strings. | |
53080 | IF(PARJ(94).GT.0.0D0) THEN | |
53081 | IM=I | |
53082 | 160 IF(K(IM,3).GT.0) THEN | |
53083 | IM=K(IM,3) | |
53084 | IF(K(IM,2).NE.92.AND.K(IM,2).NE.91) GOTO 160 | |
53085 | K(NBE(IBE),5)=IM | |
53086 | ENDIF | |
53087 | ENDIF | |
53088 | DO 170 J=1,3 | |
53089 | P(NBE(IBE),J)=0D0 | |
53090 | V(NBE(IBE),J)=0D0 | |
53091 | 170 CONTINUE | |
53092 | P(NBE(IBE),5)=-1.0D0 | |
53093 | 180 CONTINUE | |
53094 | 190 CONTINUE | |
53095 | IF(NBE(MIN(9,MSTJ(52)))-NBE(0).LE.1) GOTO 510 | |
53096 | ||
53097 | C...Calculate separation between W+ and W- or between two Z0's. | |
53098 | C...No separation if there has been re-connections. | |
53099 | SIGW=PARJ(93) | |
53100 | IF(IWP.GT.0.AND.IWN.GT.0.AND.MSTJ(56).GT.0.AND.MINT(32).EQ.0) THEN | |
53101 | IF(K(IWP,2).EQ.23) THEN | |
53102 | DMW=PMAS(23,1) | |
53103 | DGW=PMAS(23,2) | |
53104 | ELSE | |
53105 | DMW=PMAS(24,1) | |
53106 | DGW=PMAS(24,2) | |
53107 | ENDIF | |
53108 | DMP=P(IWP,5) | |
53109 | DMN=P(IWN,5) | |
53110 | TAUPD=DMP/SQRT((DMP**2-DMW**2)**2+(DGW*(DMP**2)/DMW)**2) | |
53111 | TAUND=DMN/SQRT((DMN**2-DMW**2)**2+(DGW*(DMN**2)/DMW)**2) | |
53112 | TAUP=-TAUPD*LOG(PYR(IDUM)) | |
53113 | TAUN=-TAUND*LOG(PYR(IDUM)) | |
53114 | DXP=TAUP*PYP(IWP,8)/DMP | |
53115 | DXN=TAUN*PYP(IWN,8)/DMN | |
53116 | DX=DXP+DXN | |
53117 | SIGW=1.0D0/(1.0D0/PARJ(93)+REAL(MSTJ(56))*DX) | |
53118 | IF(PARJ(94).LT.0.0D0) SIGW=1.0D0/(1.0D0/SIGW-1.0D0/PARJ(94)) | |
53119 | ENDIF | |
53120 | ||
53121 | C...Add separation between strings. | |
53122 | IF(PARJ(94).GT.0.0D0) THEN | |
53123 | SIGW=1.0D0/(1.0D0/SIGW+1.0D0/PARJ(94)) | |
53124 | IWP=-1 | |
53125 | IWN=-1 | |
53126 | ENDIF | |
53127 | ||
53128 | IF(MSTJ(57).EQ.1.AND.MSTJ(54).LT.0) THEN | |
53129 | DO 220 IBE=1,MIN(9,MSTJ(52)) | |
53130 | DO 210 I1M=NBE(IBE-1)+1,NBE(IBE) | |
53131 | Q2MIN=PECM**2 | |
53132 | I1=K(I1M,1) | |
53133 | DO 200 I2M=NBE(IBE-1)+1,NBE(IBE) | |
53134 | IF(I2M.EQ.I1M) GOTO 200 | |
53135 | I2=K(I2M,1) | |
53136 | Q2=(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2- | |
53137 | & (P(I1,2)+P(I2,2))**2-(P(I1,3)+P(I2,3))**2- | |
53138 | & (P(I1,5)+P(I2,5))**2 | |
53139 | IF(Q2.GT.0.0D0.AND.Q2.LT.Q2MIN) THEN | |
53140 | Q2MIN=Q2 | |
53141 | ENDIF | |
53142 | 200 CONTINUE | |
53143 | P(I1M,5)=Q2MIN | |
53144 | 210 CONTINUE | |
53145 | 220 CONTINUE | |
53146 | ENDIF | |
53147 | ||
53148 | C...Tabulate integral for subsequent momentum shift. | |
53149 | DO 400 IBE=1,MIN(9,MSTJ(52)) | |
53150 | IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 270 | |
53151 | IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)) | |
53152 | & .LE.1) GOTO 270 | |
53153 | IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5), | |
53154 | & NBE(7)-NBE(6)).LE.1) GOTO 270 | |
53155 | IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 270 | |
53156 | IF(IBE.EQ.1) PMHQ=2D0*PYMASS(211) | |
53157 | IF(IBE.EQ.4) PMHQ=2D0*PYMASS(321) | |
53158 | IF(IBE.EQ.8) PMHQ=2D0*PYMASS(221) | |
53159 | IF(IBE.EQ.9) PMHQ=2D0*PYMASS(331) | |
53160 | QDEL=0.1D0*MIN(PMHQ,PARJ(93)) | |
53161 | QDEL3=0.1D0*MIN(PMHQ,PARJ(93)*3.0D0) | |
53162 | QDELW=0.1D0*MIN(PMHQ,SIGW) | |
53163 | QDEL3W=0.1D0*MIN(PMHQ,SIGW*3.0D0) | |
53164 | IF(MSTJ(51).EQ.1) THEN | |
53165 | NBIN=MIN(100,NINT(9D0*PARJ(93)/QDEL)) | |
53166 | NBIN3=MIN(100,NINT(27D0*PARJ(93)/QDEL3)) | |
53167 | NBINW=MIN(100,NINT(9D0*SIGW/QDELW)) | |
53168 | NBIN3W=MIN(100,NINT(27D0*SIGW/QDEL3W)) | |
53169 | BEEX=EXP(0.5D0*QDEL/PARJ(93)) | |
53170 | BEEX3=EXP(0.5D0*QDEL3/(3.0D0*PARJ(93))) | |
53171 | BEEXW=EXP(0.5D0*QDELW/SIGW) | |
53172 | BEEX3W=EXP(0.5D0*QDEL3W/(3.0D0*SIGW)) | |
53173 | BERT=EXP(-QDEL/PARJ(93)) | |
53174 | BERT3=EXP(-QDEL3/(3.0D0*PARJ(93))) | |
53175 | BERTW=EXP(-QDELW/SIGW) | |
53176 | BERT3W=EXP(-QDEL3W/(3.0D0*SIGW)) | |
53177 | ELSE | |
53178 | NBIN=MIN(100,NINT(3D0*PARJ(93)/QDEL)) | |
53179 | NBIN3=MIN(100,NINT(9D0*PARJ(93)/QDEL3)) | |
53180 | NBINW=MIN(100,NINT(3D0*SIGW/QDELW)) | |
53181 | NBIN3W=MIN(100,NINT(9D0*SIGW/QDEL3W)) | |
53182 | ENDIF | |
53183 | DO 230 IBIN=1,NBIN | |
53184 | QBIN=QDEL*(IBIN-0.5D0) | |
53185 | BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12D0)/SQRT(QBIN**2+PMHQ**2) | |
53186 | IF(MSTJ(51).EQ.1) THEN | |
53187 | BEEX=BEEX*BERT | |
53188 | BEI(IBIN)=BEI(IBIN)*BEEX | |
53189 | ELSE | |
53190 | BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2) | |
53191 | ENDIF | |
53192 | IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1) | |
53193 | 230 CONTINUE | |
53194 | DO 240 IBIN=1,NBIN3 | |
53195 | QBIN=QDEL3*(IBIN-0.5D0) | |
53196 | BEI3(IBIN)=QDEL3*(QBIN**2+QDEL3**2/12D0)/SQRT(QBIN**2+PMHQ**2) | |
53197 | IF(MSTJ(51).EQ.1) THEN | |
53198 | BEEX3=BEEX3*BERT3 | |
53199 | BEI3(IBIN)=BEI3(IBIN)*BEEX3 | |
53200 | ELSE | |
53201 | BEI3(IBIN)=BEI3(IBIN)*EXP(-(QBIN/(3.0D0*PARJ(93)))**2) | |
53202 | ENDIF | |
53203 | IF(IBIN.GE.2) BEI3(IBIN)=BEI3(IBIN)+BEI3(IBIN-1) | |
53204 | 240 CONTINUE | |
53205 | DO 250 IBIN=1,NBINW | |
53206 | QBIN=QDELW*(IBIN-0.5D0) | |
53207 | BEIW(IBIN)=QDELW*(QBIN**2+QDELW**2/12D0)/SQRT(QBIN**2+PMHQ**2) | |
53208 | IF(MSTJ(51).EQ.1) THEN | |
53209 | BEEXW=BEEXW*BERTW | |
53210 | BEIW(IBIN)=BEIW(IBIN)*BEEXW | |
53211 | ELSE | |
53212 | BEIW(IBIN)=BEIW(IBIN)*EXP(-(QBIN/SIGW)**2) | |
53213 | ENDIF | |
53214 | IF(IBIN.GE.2) BEIW(IBIN)=BEIW(IBIN)+BEIW(IBIN-1) | |
53215 | 250 CONTINUE | |
53216 | DO 260 IBIN=1,NBIN3W | |
53217 | QBIN=QDEL3W*(IBIN-0.5D0) | |
53218 | BEI3W(IBIN)=QDEL3W*(QBIN**2+QDEL3W**2/12D0)/ | |
53219 | & SQRT(QBIN**2+PMHQ**2) | |
53220 | IF(MSTJ(51).EQ.1) THEN | |
53221 | BEEX3W=BEEX3W*BERT3W | |
53222 | BEI3W(IBIN)=BEI3W(IBIN)*BEEX3W | |
53223 | ELSE | |
53224 | BEI3W(IBIN)=BEI3W(IBIN)*EXP(-(QBIN/(3.0D0*SIGW))**2) | |
53225 | ENDIF | |
53226 | IF(IBIN.GE.2) BEI3W(IBIN)=BEI3W(IBIN)+BEI3W(IBIN-1) | |
53227 | 260 CONTINUE | |
53228 | ||
53229 | C...Loop through particle pairs and find old relative momentum. | |
53230 | 270 DO 390 I1M=NBE(IBE-1)+1,NBE(IBE)-1 | |
53231 | I1=K(I1M,1) | |
53232 | DO 380 I2M=I1M+1,NBE(IBE) | |
53233 | IF(MSTJ(53).EQ.1.AND.K(I1M,5).NE.K(I2M,5)) GOTO 380 | |
53234 | IF(MSTJ(53).EQ.2.AND.K(I1M,5).EQ.K(I2M,5)) GOTO 380 | |
53235 | I2=K(I2M,1) | |
53236 | Q2OLD=(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+ | |
53237 | & P(I2,2))**2-(P(I1,3)+P(I2,3))**2-(P(I1,5)+P(I2,5))**2 | |
53238 | IF(Q2OLD.LE.0.0D0) GOTO 380 | |
53239 | QOLD=SQRT(Q2OLD) | |
53240 | ||
53241 | C...Calculate new relative momentum. | |
53242 | QMOV=0.0D0 | |
53243 | QMOV3=0.0D0 | |
53244 | QMOVW=0.0D0 | |
53245 | QMOV3W=0.0D0 | |
53246 | IF(QOLD.LT.1D-3*QDEL) THEN | |
53247 | GOTO 280 | |
53248 | ELSEIF(QOLD.LE.QDEL) THEN | |
53249 | QMOV=QOLD/3D0 | |
53250 | ELSEIF(QOLD.LT.(NBIN-0.1D0)*QDEL) THEN | |
53251 | RBIN=QOLD/QDEL | |
53252 | IBIN=RBIN | |
53253 | RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1) | |
53254 | QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))* | |
53255 | & SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
53256 | ELSE | |
53257 | QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
53258 | ENDIF | |
53259 | 280 Q2NEW=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV))**(2D0/3D0) | |
53260 | IF(QOLD.LT.1D-3*QDEL3) THEN | |
53261 | GOTO 290 | |
53262 | ELSEIF(QOLD.LE.QDEL3) THEN | |
53263 | QMOV3=QOLD/3D0 | |
53264 | ELSEIF(QOLD.LT.(NBIN3-0.1D0)*QDEL3) THEN | |
53265 | RBIN3=QOLD/QDEL3 | |
53266 | IBIN3=RBIN3 | |
53267 | RINP3=(RBIN3**3-IBIN3**3)/(3*IBIN3*(IBIN3+1)+1) | |
53268 | QMOV3=(BEI3(IBIN3)+RINP3*(BEI3(IBIN3+1)-BEI3(IBIN3)))* | |
53269 | & SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
53270 | ELSE | |
53271 | QMOV3=BEI3(NBIN3)*SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
53272 | ENDIF | |
53273 | 290 Q2NEW3=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV3))**(2D0/3D0) | |
53274 | RSCALE=1.0D0 | |
53275 | IF(MSTJ(54).EQ.2) | |
53276 | & RSCALE=1.0D0-EXP(-(QOLD/(2D0*PARJ(93)))**2) | |
53277 | IF((IWP.NE.-1.AND.MSTJ(56).LE.0).OR.IWP.EQ.0.OR.IWN.EQ.0.OR. | |
53278 | & K(I1M,5).EQ.K(I2M,5)) GOTO 320 | |
53279 | ||
53280 | IF(QOLD.LT.1D-3*QDELW) THEN | |
53281 | GOTO 300 | |
53282 | ELSEIF(QOLD.LE.QDELW) THEN | |
53283 | QMOVW=QOLD/3D0 | |
53284 | ELSEIF(QOLD.LT.(NBINW-0.1D0)*QDELW) THEN | |
53285 | RBINW=QOLD/QDELW | |
53286 | IBINW=RBINW | |
53287 | RINPW=(RBINW**3-IBINW**3)/(3*IBINW*(IBINW+1)+1) | |
53288 | QMOVW=(BEIW(IBINW)+RINPW*(BEIW(IBINW+1)-BEIW(IBINW)))* | |
53289 | & SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
53290 | ELSE | |
53291 | QMOVW=BEIW(NBINW)*SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
53292 | ENDIF | |
53293 | 300 Q2NEW=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOVW))**(2D0/3D0) | |
53294 | IF(QOLD.LT.1D-3*QDEL3W) THEN | |
53295 | GOTO 310 | |
53296 | ELSEIF(QOLD.LE.QDEL3W) THEN | |
53297 | QMOV3W=QOLD/3D0 | |
53298 | ELSEIF(QOLD.LT.(NBIN3W-0.1D0)*QDEL3W) THEN | |
53299 | RBIN3W=QOLD/QDEL3W | |
53300 | IBIN3W=RBIN3W | |
53301 | RINP3W=(RBIN3W**3-IBIN3W**3)/(3*IBIN3W*(IBIN3W+1)+1) | |
53302 | QMOV3W=(BEI3W(IBIN3W)+RINP3W*(BEI3W(IBIN3W+1)- | |
53303 | & BEI3W(IBIN3W)))*SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
53304 | ELSE | |
53305 | QMOV3W=BEI3W(NBIN3W)*SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
53306 | ENDIF | |
53307 | 310 Q2NEW3=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV3W))**(2D0/3D0) | |
53308 | IF(MSTJ(54).EQ.2) | |
53309 | & RSCALE=1.0D0-EXP(-(QOLD/(2D0*SIGW))**2) | |
53310 | ||
53311 | 320 CALL PYBESQ(I1,I2,NMAX,Q2OLD,Q2NEW) | |
53312 | DO 330 J=1,3 | |
53313 | P(I1M,J)=P(I1M,J)+P(NMAX+1,J) | |
53314 | P(I2M,J)=P(I2M,J)+P(NMAX+2,J) | |
53315 | 330 CONTINUE | |
53316 | IF(MSTJ(54).GE.1) THEN | |
53317 | CALL PYBESQ(I1,I2,NMAX,Q2OLD,Q2NEW3) | |
53318 | DO 340 J=1,3 | |
53319 | V(I1M,J)=V(I1M,J)+P(NMAX+1,J)*RSCALE | |
53320 | V(I2M,J)=V(I2M,J)+P(NMAX+2,J)*RSCALE | |
53321 | 340 CONTINUE | |
53322 | ELSEIF(MSTJ(54).LE.-1) THEN | |
53323 | EDEL=P(I1,4)+P(I2,4)- | |
53324 | & SQRT(MAX(Q2NEW-Q2OLD+(P(I1,4)+P(I2,4))**2,0.0D0)) | |
53325 | A2=(P(I1,1)-P(I2,1))**2+(P(I1,2)-P(I2,2))**2+ | |
53326 | & (P(I1,3)-P(I2,3))**2 | |
53327 | WMAX=-1.0D20 | |
53328 | MI3=0 | |
53329 | MI4=0 | |
53330 | S12=SDIP(I1,I2) | |
53331 | SM1=(P(I1,5)+SMMIN)**2 | |
53332 | DO 360 I3M=NBE(0)+1,NBE(MIN(10,MSTJ(52)+1)) | |
53333 | IF(I3M.EQ.I1M.OR.I3M.EQ.I2M) GOTO 360 | |
53334 | IF(MSTJ(53).EQ.1.AND.K(I3M,5).NE.K(I1M,5)) GOTO 360 | |
53335 | IF(MSTJ(53).EQ.-2.AND.K(I1M,5).EQ.K(I2M,5).AND. | |
53336 | & K(I3M,5).NE.K(I1M,5)) GOTO 360 | |
53337 | I3=K(I3M,1) | |
53338 | IF(K(I3,2).EQ.K(I1,2)) GOTO 360 | |
53339 | S13=SDIP(I1,I3) | |
53340 | S23=SDIP(I2,I3) | |
53341 | SM3=(P(I3,5)+SMMIN)**2 | |
53342 | IF(MSTJ(54).EQ.-2) THEN | |
53343 | WI=(MIN(S12*SM3,S13*MIN(SM1,SM3), | |
53344 | & S23*MIN(SM1,SM3))*SM1) | |
53345 | ELSE | |
53346 | WI=((P(I1,4)+P(I2,4)+P(I3,4))**2- | |
53347 | & (P(I1,3)+P(I2,3)+P(I3,3))**2- | |
53348 | & (P(I1,2)+P(I2,2)+P(I3,2))**2- | |
53349 | & (P(I1,1)+P(I2,1)+P(I3,1))**2) | |
53350 | ENDIF | |
53351 | IF(MSTJ(57).EQ.1.AND.P(I3M,5).GT.0) THEN | |
53352 | IF (WMAX*WI.GE.(1.0D0-EXP(-P(I3M,5)/(PARJ(93)**2)))) | |
53353 | & GOTO 360 | |
53354 | ELSE | |
53355 | IF(WMAX*WI.GE.1.0) GOTO 360 | |
53356 | ENDIF | |
53357 | DO 350 I4M=I3M+1,NBE(MIN(10,MSTJ(52)+1)) | |
53358 | IF(I4M.EQ.I1M.OR.I4M.EQ.I2M) GOTO 350 | |
53359 | IF(MSTJ(53).EQ.1.AND.K(I4M,5).NE.K(I1M,5)) GOTO 350 | |
53360 | IF(MSTJ(53).EQ.-2.AND.K(I1M,5).EQ.K(I2M,5).AND. | |
53361 | & K(I4M,5).NE.K(I1M,5)) GOTO 350 | |
53362 | I4=K(I4M,1) | |
53363 | IF(K(I3,2).EQ.K(I4,2).OR.K(I4,2).EQ.K(I1,2)) | |
53364 | & GOTO 350 | |
53365 | IF((P(I3,4)+P(I4,4)+EDEL)**2.LT. | |
53366 | & (P(I3,1)+P(I4,1))**2+(P(I3,2)+P(I4,2))**2+ | |
53367 | & (P(I3,3)+P(I4,3))**2+(P(I3,5)+P(I4,5))**2) | |
53368 | & GOTO 350 | |
53369 | IF(MSTJ(54).EQ.-2) THEN | |
53370 | S14=SDIP(I1,I4) | |
53371 | S24=SDIP(I2,I4) | |
53372 | S34=SDIP(I3,I4) | |
53373 | W=S12*MIN(MIN(S23,S24),MIN(S13,S14))*S34 | |
53374 | W=MIN(W,S13*MIN(MIN(S23,S34),S12)*S24) | |
53375 | W=MIN(W,S14*MIN(MIN(S24,S34),S12)*S23) | |
53376 | W=MIN(W,MIN(S23,S24)*S13*S14) | |
53377 | W=1.0D0/W | |
53378 | ELSE | |
53379 | C...weight=1-cos(theta)/mtot2 | |
53380 | S1234=(P(I1,4)+P(I2,4)+P(I3,4)+P(I4,4))**2- | |
53381 | & (P(I1,3)+P(I2,3)+P(I3,3)+P(I4,3))**2- | |
53382 | & (P(I1,2)+P(I2,2)+P(I3,2)+P(I4,2))**2- | |
53383 | & (P(I1,1)+P(I2,1)+P(I3,1)+P(I4,1))**2 | |
53384 | W=1.0D0/S1234 | |
53385 | IF(W.LE.WMAX) GOTO 350 | |
53386 | ENDIF | |
53387 | IF(MSTJ(57).EQ.1.AND.P(I3M,5).GT.0) | |
53388 | & W=W*(1.0D0-EXP(-P(I3M,5)/(PARJ(93)**2))) | |
53389 | IF(MSTJ(57).EQ.1.AND.P(I4M,5).GT.0) | |
53390 | & W=W*(1.0D0-EXP(-P(I4M,5)/(PARJ(93)**2))) | |
53391 | IF(W.LE.WMAX) GOTO 350 | |
53392 | MI3=I3M | |
53393 | MI4=I4M | |
53394 | WMAX=W | |
53395 | 350 CONTINUE | |
53396 | 360 CONTINUE | |
53397 | IF(MI4.EQ.0) GOTO 380 | |
53398 | I3=K(MI3,1) | |
53399 | I4=K(MI4,1) | |
53400 | EOLD=P(I3,4)+P(I4,4) | |
53401 | ENEW=EOLD+EDEL | |
53402 | P2=(P(I3,1)+P(I4,1))**2+(P(I3,2)+P(I4,2))**2+ | |
53403 | & (P(I3,3)+P(I4,3))**2 | |
53404 | Q2NEWP=MAX(0.0D0,ENEW**2-P2-(P(I3,5)+P(I4,5))**2) | |
53405 | Q2OLDP=MAX(0.0D0,EOLD**2-P2-(P(I3,5)+P(I4,5))**2) | |
53406 | CALL PYBESQ(I3,I4,NMAX,Q2OLDP,Q2NEWP) | |
53407 | DO 370 J=1,3 | |
53408 | V(MI3,J)=V(MI3,J)+P(NMAX+1,J) | |
53409 | V(MI4,J)=V(MI4,J)+P(NMAX+2,J) | |
53410 | 370 CONTINUE | |
53411 | ENDIF | |
53412 | 380 CONTINUE | |
53413 | 390 CONTINUE | |
53414 | 400 CONTINUE | |
53415 | ||
53416 | C...Shift momenta and recalculate energies. | |
53417 | ESUMP=0.0D0 | |
53418 | ESUM=0.0D0 | |
53419 | PROD=0.0D0 | |
53420 | DO 430 IM=NBE(0)+1,NBE(MIN(10,MSTJ(52)+1)) | |
53421 | I=K(IM,1) | |
53422 | ESUMP=ESUMP+P(I,4) | |
53423 | DO 410 J=1,3 | |
53424 | P(I,J)=P(I,J)+P(IM,J) | |
53425 | 410 CONTINUE | |
53426 | P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
53427 | ESUM=ESUM+P(I,4) | |
53428 | DO 420 J=1,3 | |
53429 | PROD=PROD+V(IM,J)*P(I,J)/P(I,4) | |
53430 | 420 CONTINUE | |
53431 | 430 CONTINUE | |
53432 | ||
53433 | PARJ(96)=0.0D0 | |
53434 | IF(MSTJ(54).NE.0.AND.PROD.NE.0.0D0) THEN | |
53435 | 440 ALPHA=(ESUMP-ESUM)/PROD | |
53436 | PARJ(96)=PARJ(96)+ALPHA | |
53437 | PROD=0.0D0 | |
53438 | ESUM=0.0D0 | |
53439 | DO 470 IM=NBE(0)+1,NBE(MIN(10,MSTJ(52)+1)) | |
53440 | I=K(IM,1) | |
53441 | DO 450 J=1,3 | |
53442 | P(I,J)=P(I,J)+ALPHA*V(IM,J) | |
53443 | 450 CONTINUE | |
53444 | P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
53445 | ESUM=ESUM+P(I,4) | |
53446 | DO 460 J=1,3 | |
53447 | PROD=PROD+V(IM,J)*P(I,J)/P(I,4) | |
53448 | 460 CONTINUE | |
53449 | 470 CONTINUE | |
53450 | IF(PROD.NE.0.0D0.AND.ABS(ESUMP-ESUM)/PECM.GT.0.00001D0) | |
53451 | & GOTO 440 | |
53452 | ENDIF | |
53453 | ||
53454 | C...Rescale all momenta for energy conservation. | |
53455 | PES=0D0 | |
53456 | PQS=0D0 | |
53457 | DO 480 I=1,N | |
53458 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 480 | |
53459 | PES=PES+P(I,4) | |
53460 | PQS=PQS+P(I,5)**2/P(I,4) | |
53461 | 480 CONTINUE | |
53462 | PARJ(95)=PES-PECM | |
53463 | FAC=(PECM-PQS)/(PES-PQS) | |
53464 | DO 500 I=1,N | |
53465 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 500 | |
53466 | DO 490 J=1,3 | |
53467 | P(I,J)=FAC*P(I,J) | |
53468 | 490 CONTINUE | |
53469 | P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
53470 | 500 CONTINUE | |
53471 | ||
53472 | C...Boost back to correct reference frame. | |
53473 | 510 CALL PYROBO(0,0,0D0,0D0,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4)) | |
53474 | DO 520 I=1,N | |
53475 | IF(K(I,1).LT.0) K(I,1)=-K(I,1) | |
53476 | 520 CONTINUE | |
53477 | ||
53478 | RETURN | |
53479 | END | |
53480 | ||
53481 | C********************************************************************* | |
53482 | ||
53483 | C...PYBESQ | |
53484 | C...Calculates the momentum shift in a system of two particles assuming | |
53485 | C...the relative momentum squared should be shifted to Q2NEW. NI is the | |
53486 | C...last position occupied in /PYJETS/. | |
53487 | ||
53488 | SUBROUTINE PYBESQ(I1,I2,NI,Q2OLD,Q2NEW) | |
53489 | ||
53490 | C...Double precision and integer declarations. | |
53491 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53492 | IMPLICIT INTEGER(I-N) | |
53493 | INTEGER PYK,PYCHGE,PYCOMP | |
53494 | C...Parameter statement to help give large particle numbers. | |
53495 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
53496 | &KEXCIT=4000000,KDIMEN=5000000) | |
53497 | C...Commonblocks. | |
53498 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
53499 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
53500 | SAVE /PYJETS/,/PYDAT1/ | |
53501 | C...Local arrays and data. | |
53502 | DIMENSION DP(5) | |
53503 | SAVE HC1 | |
53504 | ||
53505 | IF(MSTJ(55).EQ.0) THEN | |
53506 | DQ2=Q2NEW-Q2OLD | |
53507 | DP2=(P(I1,1)-P(I2,1))**2+(P(I1,2)-P(I2,2))**2+ | |
53508 | & (P(I1,3)-P(I2,3))**2 | |
53509 | DP12=P(I1,1)**2+P(I1,2)**2+P(I1,3)**2 | |
53510 | & -P(I2,1)**2-P(I2,2)**2-P(I2,3)**2 | |
53511 | SE=P(I1,4)+P(I2,4) | |
53512 | DE=P(I1,4)-P(I2,4) | |
53513 | DQ2SE=DQ2+SE**2 | |
53514 | DA=SE*DE*DP12-DP2*DQ2SE | |
53515 | DB=DP2*DQ2SE-DP12**2 | |
53516 | HA=(DA+SQRT(MAX(DA**2+DQ2*(DQ2+SE**2-DE**2)*DB,0D0)))/(2D0*DB) | |
53517 | DO 100 J=1,3 | |
53518 | PD=HA*(P(I1,J)-P(I2,J)) | |
53519 | P(NI+1,J)=PD | |
53520 | P(NI+2,J)=-PD | |
53521 | 100 CONTINUE | |
53522 | RETURN | |
53523 | ENDIF | |
53524 | ||
53525 | K(NI+1,1)=1 | |
53526 | K(NI+2,1)=1 | |
53527 | DO 110 J=1,5 | |
53528 | P(NI+1,J)=P(I1,J) | |
53529 | P(NI+2,J)=P(I2,J) | |
53530 | DP(J)=P(I1,J)+P(I2,J) | |
53531 | 110 CONTINUE | |
53532 | ||
53533 | C...Boost to cms and rotate first particle to z-axis | |
53534 | CALL PYROBO(NI+1,NI+2,0.0D0,0.0D0, | |
53535 | &-DP(1)/DP(4),-DP(2)/DP(4),-DP(3)/DP(4)) | |
53536 | PHI=PYANGL(P(NI+1,1),P(NI+1,2)) | |
53537 | THE=PYANGL(P(NI+1,3),SQRT(P(NI+1,1)**2+P(NI+1,2)**2)) | |
53538 | S=Q2NEW+(P(I1,5)+P(I2,5))**2 | |
53539 | PZ=0.5D0*SQRT(Q2NEW*(S-(P(I1,5)-P(I2,5))**2)/S) | |
53540 | P(NI+1,1)=0.0D0 | |
53541 | P(NI+1,2)=0.0D0 | |
53542 | P(NI+1,3)=PZ | |
53543 | P(NI+1,4)=SQRT(PZ**2+P(I1,5)**2) | |
53544 | P(NI+2,1)=0.0D0 | |
53545 | P(NI+2,2)=0.0D0 | |
53546 | P(NI+2,3)=-PZ | |
53547 | P(NI+2,4)=SQRT(PZ**2+P(I2,5)**2) | |
53548 | DP(4)=SQRT(DP(1)**2+DP(2)**2+DP(3)**2+S) | |
53549 | CALL PYROBO(NI+1,NI+2,THE,PHI, | |
53550 | &DP(1)/DP(4),DP(2)/DP(4),DP(3)/DP(4)) | |
53551 | ||
53552 | DO 120 J=1,3 | |
53553 | P(NI+1,J)=P(NI+1,J)-P(I1,J) | |
53554 | P(NI+2,J)=P(NI+2,J)-P(I2,J) | |
53555 | 120 CONTINUE | |
53556 | ||
53557 | RETURN | |
53558 | END | |
53559 | ||
53560 | C********************************************************************* | |
53561 | ||
53562 | C...PYMASS | |
53563 | C...Gives the mass of a particle/parton. | |
53564 | ||
53565 | FUNCTION PYMASS(KF) | |
53566 | ||
53567 | C...Double precision and integer declarations. | |
53568 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53569 | IMPLICIT INTEGER(I-N) | |
53570 | INTEGER PYK,PYCHGE,PYCOMP | |
53571 | C...Commonblocks. | |
53572 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
53573 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
53574 | SAVE /PYDAT1/,/PYDAT2/ | |
53575 | ||
53576 | C...Reset variables. Compressed code. Special case for popcorn diquarks. | |
53577 | PYMASS=0D0 | |
53578 | KFA=IABS(KF) | |
53579 | KC=PYCOMP(KF) | |
53580 | IF(KC.EQ.0) THEN | |
53581 | MSTJ(93)=0 | |
53582 | RETURN | |
53583 | ENDIF | |
53584 | ||
53585 | C...Guarantee use of constituent masses for internal checks. | |
53586 | IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND. | |
53587 | &(KFA.LE.10.OR.MOD(KFA/10,10).EQ.0)) THEN | |
53588 | IF(KFA.LE.5) THEN | |
53589 | PYMASS=PARF(100+KFA) | |
53590 | IF(MSTJ(93).EQ.2) PYMASS=MAX(0D0,PYMASS-PARF(121)) | |
53591 | ELSEIF(KFA.LE.10) THEN | |
53592 | PYMASS=PMAS(KFA,1) | |
53593 | ELSEIF(MSTJ(93).EQ.1) THEN | |
53594 | PYMASS=PARF(100+MOD(KFA/1000,10))+PARF(100+MOD(KFA/100,10)) | |
53595 | ELSE | |
53596 | PYMASS=MAX(0D0,PMAS(KC,1)-PARF(122)-2D0*PARF(112)/3D0) | |
53597 | ENDIF | |
53598 | ||
53599 | C...Other masses can be read directly off table. | |
53600 | ELSE | |
53601 | PYMASS=PMAS(KC,1) | |
53602 | ENDIF | |
53603 | ||
53604 | C...Optional mass broadening according to truncated Breit-Wigner | |
53605 | C...(either in m or in m^2). | |
53606 | IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1D-4) THEN | |
53607 | IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN | |
53608 | PYMASS=PYMASS+0.5D0*PMAS(KC,2)*TAN((2D0*PYR(0)-1D0)* | |
53609 | & ATAN(2D0*PMAS(KC,3)/PMAS(KC,2))) | |
53610 | ELSE | |
53611 | PM0=PYMASS | |
53612 | PMLOW=ATAN((MAX(0D0,PM0-PMAS(KC,3))**2-PM0**2)/ | |
53613 | & (PM0*PMAS(KC,2))) | |
53614 | PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2))) | |
53615 | PYMASS=SQRT(MAX(0D0,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+ | |
53616 | & (PMUPP-PMLOW)*PYR(0)))) | |
53617 | ENDIF | |
53618 | ENDIF | |
53619 | MSTJ(93)=0 | |
53620 | ||
53621 | RETURN | |
53622 | END | |
53623 | ||
53624 | C********************************************************************* | |
53625 | ||
53626 | C...PYMRUN | |
53627 | C...Gives the running, current-algebra mass of a d, u, s, c or b quark, | |
53628 | C...for Higgs couplings. Everything else sent on to PYMASS. | |
53629 | ||
53630 | FUNCTION PYMRUN(KF,Q2) | |
53631 | ||
53632 | C...Double precision and integer declarations. | |
53633 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53634 | IMPLICIT INTEGER(I-N) | |
53635 | INTEGER PYK,PYCHGE,PYCOMP | |
53636 | C...Commonblocks. | |
53637 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
53638 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
53639 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
53640 | SAVE /PYDAT1/,/PYDAT2/,/PYPARS/ | |
53641 | ||
53642 | C...Most masses not handled here. | |
53643 | KFA=IABS(KF) | |
53644 | IF(KFA.EQ.0.OR.KFA.GT.6) THEN | |
53645 | PYMRUN=PYMASS(KF) | |
53646 | ||
53647 | C...Current-algebra masses, but no Q2 dependence. | |
53648 | ELSEIF(MSTP(37).NE.1.OR.MSTP(2).LE.0) THEN | |
53649 | PYMRUN=PARF(90+KFA) | |
53650 | ||
53651 | C...Running current-algebra masses. | |
53652 | ELSE | |
53653 | AS=PYALPS(Q2) | |
53654 | PYMRUN=PARF(90+KFA)* | |
53655 | & (LOG(MAX(4D0,PARP(37)**2*PARF(90+KFA)**2/PARU(117)**2))/ | |
53656 | & LOG(MAX(4D0,Q2/PARU(117)**2)))**(12D0/(33D0-2D0*MSTU(118))) | |
53657 | ENDIF | |
53658 | ||
53659 | RETURN | |
53660 | END | |
53661 | ||
53662 | C********************************************************************* | |
53663 | ||
53664 | C...PYNAME | |
53665 | C...Gives the particle/parton name as a character string. | |
53666 | ||
53667 | SUBROUTINE PYNAME(KF,CHAU) | |
53668 | ||
53669 | C...Double precision and integer declarations. | |
53670 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53671 | IMPLICIT INTEGER(I-N) | |
53672 | INTEGER PYK,PYCHGE,PYCOMP | |
53673 | C...Commonblocks. | |
53674 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
53675 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
53676 | COMMON/PYDAT4/CHAF(500,2) | |
53677 | CHARACTER CHAF*16 | |
53678 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT4/ | |
53679 | C...Local character variable. | |
53680 | CHARACTER CHAU*16 | |
53681 | ||
53682 | C...Read out code with distinction particle/antiparticle. | |
53683 | CHAU=' ' | |
53684 | KC=PYCOMP(KF) | |
53685 | IF(KC.NE.0) CHAU=CHAF(KC,(3-ISIGN(1,KF))/2) | |
53686 | ||
53687 | ||
53688 | RETURN | |
53689 | END | |
53690 | ||
53691 | C********************************************************************* | |
53692 | ||
53693 | C...PYCHGE | |
53694 | C...Gives three times the charge for a particle/parton. | |
53695 | ||
53696 | FUNCTION PYCHGE(KF) | |
53697 | ||
53698 | C...Double precision and integer declarations. | |
53699 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53700 | IMPLICIT INTEGER(I-N) | |
53701 | INTEGER PYK,PYCHGE,PYCOMP | |
53702 | C...Commonblocks. | |
53703 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
53704 | SAVE /PYDAT2/ | |
53705 | ||
53706 | C...Read out charge and change sign for antiparticle. | |
53707 | PYCHGE=0 | |
53708 | KC=PYCOMP(KF) | |
53709 | IF(KC.NE.0) PYCHGE=KCHG(KC,1)*ISIGN(1,KF) | |
53710 | ||
53711 | RETURN | |
53712 | END | |
53713 | ||
53714 | C********************************************************************* | |
53715 | ||
53716 | C...PYCOMP | |
53717 | C...Compress the standard KF codes for use in mass and decay arrays; | |
53718 | C...also checks whether a given code actually is defined. | |
53719 | ||
53720 | FUNCTION PYCOMP(KF) | |
53721 | ||
53722 | C...Double precision and integer declarations. | |
53723 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53724 | IMPLICIT INTEGER(I-N) | |
53725 | INTEGER PYK,PYCHGE,PYCOMP | |
53726 | C...Commonblocks. | |
53727 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
53728 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
53729 | SAVE /PYDAT1/,/PYDAT2/ | |
53730 | C...Local arrays and saved data. | |
53731 | DIMENSION KFORD(100:500),KCORD(101:500) | |
53732 | SAVE KFORD,KCORD,NFORD,KFLAST,KCLAST | |
53733 | ||
53734 | C...Whenever necessary reorder codes for faster search. | |
53735 | IF(MSTU(20).EQ.0) THEN | |
53736 | NFORD=100 | |
53737 | KFORD(100)=0 | |
53738 | DO 120 I=101,500 | |
53739 | KFA=KCHG(I,4) | |
53740 | IF(KFA.LE.100) GOTO 120 | |
53741 | NFORD=NFORD+1 | |
53742 | DO 100 I1=NFORD-1,0,-1 | |
53743 | IF(KFA.GE.KFORD(I1)) GOTO 110 | |
53744 | KFORD(I1+1)=KFORD(I1) | |
53745 | KCORD(I1+1)=KCORD(I1) | |
53746 | 100 CONTINUE | |
53747 | 110 KFORD(I1+1)=KFA | |
53748 | KCORD(I1+1)=I | |
53749 | 120 CONTINUE | |
53750 | MSTU(20)=1 | |
53751 | KFLAST=0 | |
53752 | KCLAST=0 | |
53753 | ENDIF | |
53754 | ||
53755 | C...Fast action if same code as in latest call. | |
53756 | IF(KF.EQ.KFLAST) THEN | |
53757 | PYCOMP=KCLAST | |
53758 | RETURN | |
53759 | ENDIF | |
53760 | ||
53761 | C...Starting values. Remove internal diquark flags. | |
53762 | PYCOMP=0 | |
53763 | KFA=IABS(KF) | |
53764 | IF(MOD(KFA/10,10).EQ.0.AND.KFA.LT.100000 | |
53765 | & .AND.MOD(KFA/1000,10).GT.0) KFA=MOD(KFA,10000) | |
53766 | ||
53767 | C...Simple cases: direct translation. | |
53768 | IF(KFA.GT.KFORD(NFORD)) THEN | |
53769 | ELSEIF(KFA.LE.100) THEN | |
53770 | PYCOMP=KFA | |
53771 | ||
53772 | C...Else binary search. | |
53773 | ELSE | |
53774 | IMIN=100 | |
53775 | IMAX=NFORD+1 | |
53776 | 130 IAVG=(IMIN+IMAX)/2 | |
53777 | IF(KFORD(IAVG).GT.KFA) THEN | |
53778 | IMAX=IAVG | |
53779 | IF(IMAX.GT.IMIN+1) GOTO 130 | |
53780 | ELSEIF(KFORD(IAVG).LT.KFA) THEN | |
53781 | IMIN=IAVG | |
53782 | IF(IMAX.GT.IMIN+1) GOTO 130 | |
53783 | ELSE | |
53784 | PYCOMP=KCORD(IAVG) | |
53785 | ENDIF | |
53786 | ENDIF | |
53787 | ||
53788 | C...Check if antiparticle allowed. | |
53789 | IF(PYCOMP.NE.0.AND.KF.LT.0) THEN | |
53790 | IF(KCHG(PYCOMP,3).EQ.0) PYCOMP=0 | |
53791 | ENDIF | |
53792 | ||
53793 | C...Save codes for possible future fast action. | |
53794 | KFLAST=KF | |
53795 | KCLAST=PYCOMP | |
53796 | ||
53797 | RETURN | |
53798 | END | |
53799 | ||
53800 | C********************************************************************* | |
53801 | ||
53802 | C...PYERRM | |
53803 | C...Informs user of errors in program execution. | |
53804 | ||
53805 | SUBROUTINE PYERRM(MERR,CHMESS) | |
53806 | ||
53807 | C...Double precision and integer declarations. | |
53808 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53809 | IMPLICIT INTEGER(I-N) | |
53810 | INTEGER PYK,PYCHGE,PYCOMP | |
53811 | C...Commonblocks. | |
53812 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
53813 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
53814 | SAVE /PYJETS/,/PYDAT1/ | |
53815 | C...Local character variable. | |
53816 | CHARACTER CHMESS*(*) | |
53817 | ||
53818 | C...Write first few warnings, then be silent. | |
53819 | IF(MERR.LE.10) THEN | |
53820 | MSTU(27)=MSTU(27)+1 | |
53821 | MSTU(28)=MERR | |
53822 | IF(MSTU(25).EQ.1.AND.MSTU(27).LE.MSTU(26)) WRITE(MSTU(11),5000) | |
53823 | & MERR,MSTU(31),CHMESS | |
53824 | ||
53825 | C...Write first few errors, then be silent or stop program. | |
53826 | ELSEIF(MERR.LE.20) THEN | |
53827 | IF(MSTU(29).EQ.0) MSTU(23)=MSTU(23)+1 | |
53828 | MSTU(24)=MERR-10 | |
53829 | IF(MSTU(21).GE.1.AND.MSTU(23).LE.MSTU(22)) WRITE(MSTU(11),5100) | |
53830 | & MERR-10,MSTU(31),CHMESS | |
53831 | IF(MSTU(21).GE.2.AND.MSTU(23).GT.MSTU(22)) THEN | |
53832 | WRITE(MSTU(11),5100) MERR-10,MSTU(31),CHMESS | |
53833 | WRITE(MSTU(11),5200) | |
53834 | IF(MERR.NE.17) CALL PYLIST(2) | |
53835 | STOP | |
53836 | ENDIF | |
53837 | ||
53838 | C...Stop program in case of irreparable error. | |
53839 | ELSE | |
53840 | WRITE(MSTU(11),5300) MERR-20,MSTU(31),CHMESS | |
53841 | STOP | |
53842 | ENDIF | |
53843 | ||
53844 | C...Formats for output. | |
53845 | 5000 FORMAT(/5X,'Advisory warning type',I2,' given after',I9, | |
53846 | &' PYEXEC calls:'/5X,A) | |
53847 | 5100 FORMAT(/5X,'Error type',I2,' has occured after',I9, | |
53848 | &' PYEXEC calls:'/5X,A) | |
53849 | 5200 FORMAT(5X,'Execution will be stopped after listing of last ', | |
53850 | &'event!') | |
53851 | 5300 FORMAT(/5X,'Fatal error type',I2,' has occured after',I9, | |
53852 | &' PYEXEC calls:'/5X,A/5X,'Execution will now be stopped!') | |
53853 | ||
53854 | RETURN | |
53855 | END | |
53856 | ||
53857 | C********************************************************************* | |
53858 | ||
53859 | C...PYALEM | |
53860 | C...Calculates the running alpha_electromagnetic. | |
53861 | ||
53862 | FUNCTION PYALEM(Q2) | |
53863 | ||
53864 | C...Double precision and integer declarations. | |
53865 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53866 | IMPLICIT INTEGER(I-N) | |
53867 | INTEGER PYK,PYCHGE,PYCOMP | |
53868 | C...Commonblocks. | |
53869 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
53870 | SAVE /PYDAT1/ | |
53871 | ||
53872 | C...Calculate real part of photon vacuum polarization. | |
53873 | C...For leptons simplify by using asymptotic (Q^2 >> m^2) expressions. | |
53874 | C...For hadrons use parametrization of H. Burkhardt et al. | |
53875 | C...See R. Kleiss et al, CERN 89-08, vol. 3, pp. 129-131. | |
53876 | AEMPI=PARU(101)/(3D0*PARU(1)) | |
53877 | IF(MSTU(101).LE.0.OR.Q2.LT.2D-6) THEN | |
53878 | RPIGG=0D0 | |
53879 | ELSEIF(MSTU(101).EQ.2.AND.Q2.LT.PARU(104)) THEN | |
53880 | RPIGG=0D0 | |
53881 | ELSEIF(MSTU(101).EQ.2) THEN | |
53882 | RPIGG=1D0-PARU(101)/PARU(103) | |
53883 | ELSEIF(Q2.LT.0.09D0) THEN | |
53884 | RPIGG=AEMPI*(13.4916D0+LOG(Q2))+0.00835D0*LOG(1D0+Q2) | |
53885 | ELSEIF(Q2.LT.9D0) THEN | |
53886 | RPIGG=AEMPI*(16.3200D0+2D0*LOG(Q2))+ | |
53887 | & 0.00238D0*LOG(1D0+3.927D0*Q2) | |
53888 | ELSEIF(Q2.LT.1D4) THEN | |
53889 | RPIGG=AEMPI*(13.4955D0+3D0*LOG(Q2))+0.00165D0+ | |
53890 | & 0.00299D0*LOG(1D0+Q2) | |
53891 | ELSE | |
53892 | RPIGG=AEMPI*(13.4955D0+3D0*LOG(Q2))+0.00221D0+ | |
53893 | & 0.00293D0*LOG(1D0+Q2) | |
53894 | ENDIF | |
53895 | ||
53896 | C...Calculate running alpha_em. | |
53897 | PYALEM=PARU(101)/(1D0-RPIGG) | |
53898 | PARU(108)=PYALEM | |
53899 | ||
53900 | RETURN | |
53901 | END | |
53902 | ||
53903 | C********************************************************************* | |
53904 | ||
53905 | C...PYALPS | |
53906 | C...Gives the value of alpha_strong. | |
53907 | ||
53908 | FUNCTION PYALPS(Q2) | |
53909 | ||
53910 | C...Double precision and integer declarations. | |
53911 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53912 | IMPLICIT INTEGER(I-N) | |
53913 | INTEGER PYK,PYCHGE,PYCOMP | |
53914 | C...Commonblocks. | |
53915 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
53916 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
53917 | SAVE /PYDAT1/,/PYDAT2/ | |
53918 | ||
53919 | C...Constant alpha_strong trivial. Pick artificial Lambda. | |
53920 | IF(MSTU(111).LE.0) THEN | |
53921 | PYALPS=PARU(111) | |
53922 | MSTU(118)=MSTU(112) | |
53923 | PARU(117)=0.2D0 | |
53924 | IF(Q2.GT.0.04D0) PARU(117)=SQRT(Q2)*EXP(-6D0*PARU(1)/ | |
53925 | & ((33D0-2D0*MSTU(112))*PARU(111))) | |
53926 | PARU(118)=PARU(111) | |
53927 | RETURN | |
53928 | ENDIF | |
53929 | ||
53930 | C...Find effective Q2, number of flavours and Lambda. | |
53931 | Q2EFF=Q2 | |
53932 | IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114)) | |
53933 | NF=MSTU(112) | |
53934 | ALAM2=PARU(112)**2 | |
53935 | 100 IF(NF.GT.MAX(2,MSTU(113))) THEN | |
53936 | Q2THR=PARU(113)*PMAS(NF,1)**2 | |
53937 | IF(Q2EFF.LT.Q2THR) THEN | |
53938 | NF=NF-1 | |
53939 | ALAM2=ALAM2*(Q2THR/ALAM2)**(2D0/(33D0-2D0*NF)) | |
53940 | GOTO 100 | |
53941 | ENDIF | |
53942 | ENDIF | |
53943 | 110 IF(NF.LT.MIN(8,MSTU(114))) THEN | |
53944 | Q2THR=PARU(113)*PMAS(NF+1,1)**2 | |
53945 | IF(Q2EFF.GT.Q2THR) THEN | |
53946 | NF=NF+1 | |
53947 | ALAM2=ALAM2*(ALAM2/Q2THR)**(2D0/(33D0-2D0*NF)) | |
53948 | GOTO 110 | |
53949 | ENDIF | |
53950 | ENDIF | |
53951 | IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2 | |
53952 | PARU(117)=SQRT(ALAM2) | |
53953 | ||
53954 | C...Evaluate first or second order alpha_strong. | |
53955 | B0=(33D0-2D0*NF)/6D0 | |
53956 | ALGQ=LOG(MAX(1.0001D0,Q2EFF/ALAM2)) | |
53957 | IF(MSTU(111).EQ.1) THEN | |
53958 | PYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)) | |
53959 | ELSE | |
53960 | B1=(153D0-19D0*NF)/6D0 | |
53961 | PYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1D0-B1*LOG(ALGQ)/ | |
53962 | & (B0**2*ALGQ))) | |
53963 | ENDIF | |
53964 | MSTU(118)=NF | |
53965 | PARU(118)=PYALPS | |
53966 | ||
53967 | RETURN | |
53968 | END | |
53969 | ||
53970 | C********************************************************************* | |
53971 | ||
53972 | C...PYANGL | |
53973 | C...Reconstructs an angle from given x and y coordinates. | |
53974 | ||
53975 | FUNCTION PYANGL(X,Y) | |
53976 | ||
53977 | C...Double precision and integer declarations. | |
53978 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
53979 | IMPLICIT INTEGER(I-N) | |
53980 | INTEGER PYK,PYCHGE,PYCOMP | |
53981 | C...Commonblocks. | |
53982 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
53983 | SAVE /PYDAT1/ | |
53984 | ||
53985 | PYANGL=0D0 | |
53986 | R=SQRT(X**2+Y**2) | |
53987 | IF(R.LT.1D-20) RETURN | |
53988 | IF(ABS(X)/R.LT.0.8D0) THEN | |
53989 | PYANGL=SIGN(ACOS(X/R),Y) | |
53990 | ELSE | |
53991 | PYANGL=ASIN(Y/R) | |
53992 | IF(X.LT.0D0.AND.PYANGL.GE.0D0) THEN | |
53993 | PYANGL=PARU(1)-PYANGL | |
53994 | ELSEIF(X.LT.0D0) THEN | |
53995 | PYANGL=-PARU(1)-PYANGL | |
53996 | ENDIF | |
53997 | ENDIF | |
53998 | ||
53999 | RETURN | |
54000 | END | |
54001 | ||
54002 | C********************************************************************* | |
54003 | ||
54004 | C...PYROBO | |
54005 | C...Performs rotations and boosts. | |
54006 | ||
54007 | SUBROUTINE PYROBO(IMI,IMA,THE,PHI,BEX,BEY,BEZ) | |
54008 | ||
54009 | C...Double precision and integer declarations. | |
54010 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
54011 | IMPLICIT INTEGER(I-N) | |
54012 | INTEGER PYK,PYCHGE,PYCOMP | |
54013 | C...Commonblocks. | |
54014 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
54015 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
54016 | SAVE /PYJETS/,/PYDAT1/ | |
54017 | C...Local arrays. | |
54018 | DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4) | |
54019 | ||
54020 | C...Find and check range of rotation/boost. | |
54021 | IMIN=IMI | |
54022 | IF(IMIN.LE.0) IMIN=1 | |
54023 | IF(MSTU(1).GT.0) IMIN=MSTU(1) | |
54024 | IMAX=IMA | |
54025 | IF(IMAX.LE.0) IMAX=N | |
54026 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
54027 | IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN | |
54028 | CALL PYERRM(11,'(PYROBO:) range outside PYJETS memory') | |
54029 | RETURN | |
54030 | ENDIF | |
54031 | ||
54032 | C...Optional resetting of V (when not set before.) | |
54033 | IF(MSTU(33).NE.0) THEN | |
54034 | DO 110 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4)) | |
54035 | DO 100 J=1,5 | |
54036 | V(I,J)=0D0 | |
54037 | 100 CONTINUE | |
54038 | 110 CONTINUE | |
54039 | MSTU(33)=0 | |
54040 | ENDIF | |
54041 | ||
54042 | C...Rotate, typically from z axis to direction (theta,phi). | |
54043 | IF(THE**2+PHI**2.GT.1D-20) THEN | |
54044 | ROT(1,1)=COS(THE)*COS(PHI) | |
54045 | ROT(1,2)=-SIN(PHI) | |
54046 | ROT(1,3)=SIN(THE)*COS(PHI) | |
54047 | ROT(2,1)=COS(THE)*SIN(PHI) | |
54048 | ROT(2,2)=COS(PHI) | |
54049 | ROT(2,3)=SIN(THE)*SIN(PHI) | |
54050 | ROT(3,1)=-SIN(THE) | |
54051 | ROT(3,2)=0D0 | |
54052 | ROT(3,3)=COS(THE) | |
54053 | DO 140 I=IMIN,IMAX | |
54054 | IF(K(I,1).LE.0) GOTO 140 | |
54055 | DO 120 J=1,3 | |
54056 | PR(J)=P(I,J) | |
54057 | VR(J)=V(I,J) | |
54058 | 120 CONTINUE | |
54059 | DO 130 J=1,3 | |
54060 | P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3) | |
54061 | V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3) | |
54062 | 130 CONTINUE | |
54063 | 140 CONTINUE | |
54064 | ENDIF | |
54065 | ||
54066 | C...Boost, typically from rest to momentum/energy=beta. | |
54067 | IF(BEX**2+BEY**2+BEZ**2.GT.1D-20) THEN | |
54068 | DBX=BEX | |
54069 | DBY=BEY | |
54070 | DBZ=BEZ | |
54071 | DB=SQRT(DBX**2+DBY**2+DBZ**2) | |
54072 | EPS1=1D0-1D-12 | |
54073 | IF(DB.GT.EPS1) THEN | |
54074 | C...Rescale boost vector if too close to unity. | |
54075 | CALL PYERRM(3,'(PYROBO:) boost vector too large') | |
54076 | DBX=DBX*(EPS1/DB) | |
54077 | DBY=DBY*(EPS1/DB) | |
54078 | DBZ=DBZ*(EPS1/DB) | |
54079 | DB=EPS1 | |
54080 | ENDIF | |
54081 | DGA=1D0/SQRT(1D0-DB**2) | |
54082 | DO 160 I=IMIN,IMAX | |
54083 | IF(K(I,1).LE.0) GOTO 160 | |
54084 | DO 150 J=1,4 | |
54085 | DP(J)=P(I,J) | |
54086 | DV(J)=V(I,J) | |
54087 | 150 CONTINUE | |
54088 | DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3) | |
54089 | DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4)) | |
54090 | P(I,1)=DP(1)+DGABP*DBX | |
54091 | P(I,2)=DP(2)+DGABP*DBY | |
54092 | P(I,3)=DP(3)+DGABP*DBZ | |
54093 | P(I,4)=DGA*(DP(4)+DBP) | |
54094 | DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3) | |
54095 | DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4)) | |
54096 | V(I,1)=DV(1)+DGABV*DBX | |
54097 | V(I,2)=DV(2)+DGABV*DBY | |
54098 | V(I,3)=DV(3)+DGABV*DBZ | |
54099 | V(I,4)=DGA*(DV(4)+DBV) | |
54100 | 160 CONTINUE | |
54101 | ENDIF | |
54102 | ||
54103 | RETURN | |
54104 | END | |
54105 | ||
54106 | C********************************************************************* | |
54107 | ||
54108 | C...PYEDIT | |
54109 | C...Performs global manipulations on the event record, in particular | |
54110 | C...to exclude unstable or undetectable partons/particles. | |
54111 | ||
54112 | SUBROUTINE PYEDIT(MEDIT) | |
54113 | ||
54114 | C...Double precision and integer declarations. | |
54115 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
54116 | IMPLICIT INTEGER(I-N) | |
54117 | INTEGER PYK,PYCHGE,PYCOMP | |
54118 | C...Commonblocks. | |
54119 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
54120 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
54121 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
54122 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
54123 | C...Local arrays. | |
54124 | DIMENSION NS(2),PTS(2),PLS(2) | |
54125 | ||
54126 | C...Remove unwanted partons/particles. | |
54127 | IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN | |
54128 | IMAX=N | |
54129 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
54130 | I1=MAX(1,MSTU(1))-1 | |
54131 | DO 110 I=MAX(1,MSTU(1)),IMAX | |
54132 | IF(K(I,1).EQ.0.OR.(K(I,1).GE.21.AND.K(I,1).LE.40)) GOTO 110 | |
54133 | IF(MEDIT.EQ.1) THEN | |
54134 | IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42) GOTO 110 | |
54135 | ELSEIF(MEDIT.EQ.2) THEN | |
54136 | IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42) GOTO 110 | |
54137 | KC=PYCOMP(K(I,2)) | |
54138 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18) | |
54139 | & GOTO 110 | |
54140 | ELSEIF(MEDIT.EQ.3) THEN | |
54141 | IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42) GOTO 110 | |
54142 | KC=PYCOMP(K(I,2)) | |
54143 | IF(KC.EQ.0) GOTO 110 | |
54144 | IF(KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) GOTO 110 | |
54145 | ELSEIF(MEDIT.EQ.5) THEN | |
54146 | IF(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.K(I,1).EQ.52) GOTO 110 | |
54147 | KC=PYCOMP(K(I,2)) | |
54148 | IF(KC.EQ.0) GOTO 110 | |
54149 | IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42.AND. | |
54150 | & KCHG(KC,2).EQ.0) GOTO 110 | |
54151 | ENDIF | |
54152 | ||
54153 | C...Pack remaining partons/particles. Origin no longer known. | |
54154 | I1=I1+1 | |
54155 | DO 100 J=1,5 | |
54156 | K(I1,J)=K(I,J) | |
54157 | P(I1,J)=P(I,J) | |
54158 | V(I1,J)=V(I,J) | |
54159 | 100 CONTINUE | |
54160 | K(I1,3)=0 | |
54161 | 110 CONTINUE | |
54162 | IF(I1.LT.N) MSTU(3)=0 | |
54163 | IF(I1.LT.N) MSTU(70)=0 | |
54164 | N=I1 | |
54165 | ||
54166 | C...Selective removal of class of entries. New position of retained. | |
54167 | ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN | |
54168 | I1=0 | |
54169 | DO 120 I=1,N | |
54170 | K(I,3)=MOD(K(I,3),MSTU(5)) | |
54171 | IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120 | |
54172 | IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120 | |
54173 | IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR. | |
54174 | & K(I,1).EQ.15.OR.K(I,1).EQ.51).AND.K(I,2).NE.94) GOTO 120 | |
54175 | IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR. | |
54176 | & K(I,1).EQ.52.OR.K(I,2).EQ.94)) GOTO 120 | |
54177 | IF(MEDIT.EQ.15.AND.K(I,1).GE.21.AND.K(I,1).LE.40) GOTO 120 | |
54178 | I1=I1+1 | |
54179 | K(I,3)=K(I,3)+MSTU(5)*I1 | |
54180 | 120 CONTINUE | |
54181 | ||
54182 | C...Find new event history information and replace old. | |
54183 | DO 140 I=1,N | |
54184 | IF(K(I,1).LE.0.OR.(K(I,1).GE.21.AND.K(I,1).LE.40).OR. | |
54185 | & K(I,3)/MSTU(5).EQ.0) GOTO 140 | |
54186 | ID=I | |
54187 | 130 IM=MOD(K(ID,3),MSTU(5)) | |
54188 | IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN | |
54189 | IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15.OR. | |
54190 | & K(IM,1).EQ.51).AND.K(IM,2).NE.94) THEN | |
54191 | ID=IM | |
54192 | GOTO 130 | |
54193 | ENDIF | |
54194 | ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN | |
54195 | IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,1).EQ.52.OR. | |
54196 | & K(IM,2).EQ.94) THEN | |
54197 | ID=IM | |
54198 | GOTO 130 | |
54199 | ENDIF | |
54200 | ENDIF | |
54201 | K(I,3)=MSTU(5)*(K(I,3)/MSTU(5)) | |
54202 | IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5) | |
54203 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14.AND. | |
54204 | & K(I,1).NE.42.AND.K(I,1).NE.52) THEN | |
54205 | IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)= | |
54206 | & K(K(I,4),3)/MSTU(5) | |
54207 | IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)= | |
54208 | & K(K(I,5),3)/MSTU(5) | |
54209 | ELSE | |
54210 | KCM=MOD(K(I,4)/MSTU(5),MSTU(5)) | |
54211 | IF(KCM.GT.0.AND.KCM.LE.MSTU(4).AND.K(I,1).NE.42.AND. | |
54212 | & K(I,1).NE.52) KCM=K(KCM,3)/MSTU(5) | |
54213 | KCD=MOD(K(I,4),MSTU(5)) | |
54214 | IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) | |
54215 | K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD | |
54216 | KCM=MOD(K(I,5)/MSTU(5),MSTU(5)) | |
54217 | IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) | |
54218 | KCD=MOD(K(I,5),MSTU(5)) | |
54219 | IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) | |
54220 | K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD | |
54221 | ENDIF | |
54222 | 140 CONTINUE | |
54223 | ||
54224 | C...Pack remaining entries. | |
54225 | I1=0 | |
54226 | MSTU90=MSTU(90) | |
54227 | MSTU(90)=0 | |
54228 | DO 170 I=1,N | |
54229 | IF(K(I,3)/MSTU(5).EQ.0) GOTO 170 | |
54230 | I1=I1+1 | |
54231 | DO 150 J=1,5 | |
54232 | K(I1,J)=K(I,J) | |
54233 | P(I1,J)=P(I,J) | |
54234 | V(I1,J)=V(I,J) | |
54235 | 150 CONTINUE | |
54236 | K(I1,3)=MOD(K(I1,3),MSTU(5)) | |
54237 | DO 160 IZ=1,MSTU90 | |
54238 | IF(I.EQ.MSTU(90+IZ)) THEN | |
54239 | MSTU(90)=MSTU(90)+1 | |
54240 | MSTU(90+MSTU(90))=I1 | |
54241 | PARU(90+MSTU(90))=PARU(90+IZ) | |
54242 | ENDIF | |
54243 | 160 CONTINUE | |
54244 | 170 CONTINUE | |
54245 | IF(I1.LT.N) MSTU(3)=0 | |
54246 | IF(I1.LT.N) MSTU(70)=0 | |
54247 | N=I1 | |
54248 | ||
54249 | C...Fill in some missing daughter pointers (lost in colour flow). | |
54250 | ELSEIF(MEDIT.EQ.16) THEN | |
54251 | DO 220 I=1,N | |
54252 | IF(K(I,1).LE.10.OR.(K(I,1).GE.21.AND.K(I,1).LE.50)) GOTO 220 | |
54253 | IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 220 | |
54254 | C...Find daughters who point to mother. | |
54255 | DO 180 I1=I+1,N | |
54256 | IF(K(I1,3).NE.I) THEN | |
54257 | ELSEIF(K(I,4).EQ.0) THEN | |
54258 | K(I,4)=I1 | |
54259 | ELSE | |
54260 | K(I,5)=I1 | |
54261 | ENDIF | |
54262 | 180 CONTINUE | |
54263 | IF(K(I,5).EQ.0) K(I,5)=K(I,4) | |
54264 | IF(K(I,4).NE.0) GOTO 220 | |
54265 | C...Find daughters who point to documentation version of mother. | |
54266 | IM=K(I,3) | |
54267 | IF(IM.LE.0.OR.IM.GE.I) GOTO 220 | |
54268 | IF(K(IM,1).LE.20.OR.K(IM,1).GT.30) GOTO 220 | |
54269 | IF(K(IM,2).NE.K(I,2).OR.ABS(P(IM,5)-P(I,5)).GT.1D-2) GOTO 220 | |
54270 | DO 190 I1=I+1,N | |
54271 | IF(K(I1,3).NE.IM) THEN | |
54272 | ELSEIF(K(I,4).EQ.0) THEN | |
54273 | K(I,4)=I1 | |
54274 | ELSE | |
54275 | K(I,5)=I1 | |
54276 | ENDIF | |
54277 | 190 CONTINUE | |
54278 | IF(K(I,5).EQ.0) K(I,5)=K(I,4) | |
54279 | IF(K(I,4).NE.0) GOTO 220 | |
54280 | C...Find daughters who point to documentation daughters who, | |
54281 | C...in their turn, point to documentation mother. | |
54282 | ID1=IM | |
54283 | ID2=IM | |
54284 | DO 200 I1=IM+1,I-1 | |
54285 | IF(K(I1,3).EQ.IM.AND.K(I1,1).GE.21.AND.K(I1,1).LE.30) THEN | |
54286 | ID2=I1 | |
54287 | IF(ID1.EQ.IM) ID1=I1 | |
54288 | ENDIF | |
54289 | 200 CONTINUE | |
54290 | DO 210 I1=I+1,N | |
54291 | IF(K(I1,3).NE.ID1.AND.K(I1,3).NE.ID2) THEN | |
54292 | ELSEIF(K(I,4).EQ.0) THEN | |
54293 | K(I,4)=I1 | |
54294 | ELSE | |
54295 | K(I,5)=I1 | |
54296 | ENDIF | |
54297 | 210 CONTINUE | |
54298 | IF(K(I,5).EQ.0) K(I,5)=K(I,4) | |
54299 | 220 CONTINUE | |
54300 | ||
54301 | C...Save top entries at bottom of PYJETS commonblock. | |
54302 | ELSEIF(MEDIT.EQ.21) THEN | |
54303 | IF(2*N.GE.MSTU(4)) THEN | |
54304 | CALL PYERRM(11,'(PYEDIT:) no more memory left in PYJETS') | |
54305 | RETURN | |
54306 | ENDIF | |
54307 | DO 240 I=1,N | |
54308 | DO 230 J=1,5 | |
54309 | K(MSTU(4)-I,J)=K(I,J) | |
54310 | P(MSTU(4)-I,J)=P(I,J) | |
54311 | V(MSTU(4)-I,J)=V(I,J) | |
54312 | 230 CONTINUE | |
54313 | 240 CONTINUE | |
54314 | MSTU(32)=N | |
54315 | ||
54316 | C...Restore bottom entries of commonblock PYJETS to top. | |
54317 | ELSEIF(MEDIT.EQ.22) THEN | |
54318 | DO 260 I=1,MSTU(32) | |
54319 | DO 250 J=1,5 | |
54320 | K(I,J)=K(MSTU(4)-I,J) | |
54321 | P(I,J)=P(MSTU(4)-I,J) | |
54322 | V(I,J)=V(MSTU(4)-I,J) | |
54323 | 250 CONTINUE | |
54324 | 260 CONTINUE | |
54325 | N=MSTU(32) | |
54326 | ||
54327 | C...Mark primary entries at top of commonblock PYJETS as untreated. | |
54328 | ELSEIF(MEDIT.EQ.23) THEN | |
54329 | I1=0 | |
54330 | DO 270 I=1,N | |
54331 | KH=K(I,3) | |
54332 | IF(KH.GE.1) THEN | |
54333 | IF(K(KH,1).GE.21.AND.K(KH,1).LE.30) KH=0 | |
54334 | ENDIF | |
54335 | IF(KH.NE.0) GOTO 280 | |
54336 | I1=I1+1 | |
54337 | IF(K(I,1).GE.11.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10 | |
54338 | IF(K(I,1).GE.51.AND.K(I,1).LE.60) K(I,1)=K(I,1)-10 | |
54339 | 270 CONTINUE | |
54340 | 280 N=I1 | |
54341 | ||
54342 | C...Place largest axis along z axis and second largest in xy plane. | |
54343 | ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN | |
54344 | CALL PYROBO(1,N+MSTU(3),0D0,-PYANGL(P(MSTU(61),1), | |
54345 | & P(MSTU(61),2)),0D0,0D0,0D0) | |
54346 | CALL PYROBO(1,N+MSTU(3),-PYANGL(P(MSTU(61),3), | |
54347 | & P(MSTU(61),1)),0D0,0D0,0D0,0D0) | |
54348 | CALL PYROBO(1,N+MSTU(3),0D0,-PYANGL(P(MSTU(61)+1,1), | |
54349 | & P(MSTU(61)+1,2)),0D0,0D0,0D0) | |
54350 | IF(MEDIT.EQ.31) RETURN | |
54351 | ||
54352 | C...Rotate to put slim jet along +z axis. | |
54353 | DO 290 IS=1,2 | |
54354 | NS(IS)=0 | |
54355 | PTS(IS)=0D0 | |
54356 | PLS(IS)=0D0 | |
54357 | 290 CONTINUE | |
54358 | DO 300 I=1,N | |
54359 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 300 | |
54360 | IF(MSTU(41).GE.2) THEN | |
54361 | KC=PYCOMP(K(I,2)) | |
54362 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
54363 | & KC.EQ.18) GOTO 300 | |
54364 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)) | |
54365 | & .EQ.0) GOTO 300 | |
54366 | ENDIF | |
54367 | IS=2D0-SIGN(0.5D0,P(I,3)) | |
54368 | NS(IS)=NS(IS)+1 | |
54369 | PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2) | |
54370 | 300 CONTINUE | |
54371 | IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2) | |
54372 | & CALL PYROBO(1,N+MSTU(3),PARU(1),0D0,0D0,0D0,0D0) | |
54373 | ||
54374 | C...Rotate to put second largest jet into -z,+x quadrant. | |
54375 | DO 310 I=1,N | |
54376 | IF(P(I,3).GE.0D0) GOTO 310 | |
54377 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 310 | |
54378 | IF(MSTU(41).GE.2) THEN | |
54379 | KC=PYCOMP(K(I,2)) | |
54380 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
54381 | & KC.EQ.18) GOTO 310 | |
54382 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)) | |
54383 | & .EQ.0) GOTO 310 | |
54384 | ENDIF | |
54385 | IS=2D0-SIGN(0.5D0,P(I,1)) | |
54386 | PLS(IS)=PLS(IS)-P(I,3) | |
54387 | 310 CONTINUE | |
54388 | IF(PLS(2).GT.PLS(1)) CALL PYROBO(1,N+MSTU(3),0D0,PARU(1), | |
54389 | & 0D0,0D0,0D0) | |
54390 | ENDIF | |
54391 | ||
54392 | RETURN | |
54393 | END | |
54394 | ||
54395 | C********************************************************************* | |
54396 | ||
54397 | C...PYLIST | |
54398 | C...Gives program heading, or lists an event, or particle | |
54399 | C...data, or current parameter values. | |
54400 | ||
54401 | SUBROUTINE PYLIST(MLIST) | |
54402 | ||
54403 | C...Double precision and integer declarations. | |
54404 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
54405 | IMPLICIT INTEGER(I-N) | |
54406 | INTEGER PYK,PYCHGE,PYCOMP | |
54407 | C...Parameter statement to help give large particle numbers. | |
54408 | PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, | |
54409 | &KEXCIT=4000000,KDIMEN=5000000) | |
54410 | ||
54411 | C...HEPEVT commonblock. | |
54412 | PARAMETER (NMXHEP=4000) | |
54413 | COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
54414 | &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) | |
54415 | DOUBLE PRECISION PHEP,VHEP | |
54416 | SAVE /HEPEVT/ | |
54417 | ||
54418 | C...User process event common block. | |
54419 | INTEGER MAXNUP | |
54420 | PARAMETER (MAXNUP=500) | |
54421 | INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP | |
54422 | DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP | |
54423 | COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), | |
54424 | &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), | |
54425 | &VTIMUP(MAXNUP),SPINUP(MAXNUP) | |
54426 | SAVE /HEPEUP/ | |
54427 | ||
54428 | C...Commonblocks. | |
54429 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
54430 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
54431 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
54432 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
54433 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ | |
54434 | C...Local arrays, character variables and data. | |
54435 | CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHDL(7)*4 | |
54436 | DIMENSION PS(6) | |
54437 | DATA CHDL/'(())',' ','()','!!','<>','==','(==)'/ | |
54438 | ||
54439 | C...Initialization printout: version number and date of last change. | |
54440 | IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN | |
54441 | CALL PYLOGO | |
54442 | MSTU(12)=0 | |
54443 | IF(MLIST.EQ.0) RETURN | |
54444 | ENDIF | |
54445 | ||
54446 | C...List event data, including additional lines after N. | |
54447 | IF(MLIST.GE.1.AND.MLIST.LE.3) THEN | |
54448 | IF(MLIST.EQ.1) WRITE(MSTU(11),5100) | |
54449 | IF(MLIST.EQ.2) WRITE(MSTU(11),5200) | |
54450 | IF(MLIST.EQ.3) WRITE(MSTU(11),5300) | |
54451 | LMX=12 | |
54452 | IF(MLIST.GE.2) LMX=16 | |
54453 | ISTR=0 | |
54454 | IMAX=N | |
54455 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
54456 | DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3))) | |
54457 | IF(I.GT.IMAX.AND.I.LE.N) GOTO 120 | |
54458 | IF(MSTU(15).EQ.0.AND.K(I,1).LE.0) GOTO 120 | |
54459 | IF(MSTU(15).EQ.1.AND.K(I,1).LT.0) GOTO 120 | |
54460 | ||
54461 | C...Get particle name, pad it and check it is not too long. | |
54462 | CALL PYNAME(K(I,2),CHAP) | |
54463 | LEN=0 | |
54464 | DO 100 LEM=1,16 | |
54465 | IF(CHAP(LEM:LEM).NE.' ') LEN=LEM | |
54466 | 100 CONTINUE | |
54467 | MDL=(K(I,1)+19)/10 | |
54468 | LDL=0 | |
54469 | IF(MDL.EQ.2.OR.MDL.GE.8) THEN | |
54470 | CHAC=CHAP | |
54471 | IF(LEN.GT.LMX) CHAC(LMX:LMX)='?' | |
54472 | ELSE | |
54473 | LDL=1 | |
54474 | IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2 | |
54475 | IF(LEN.EQ.0) THEN | |
54476 | CHAC=CHDL(MDL)(1:2*LDL)//' ' | |
54477 | ELSE | |
54478 | CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))// | |
54479 | & CHDL(MDL)(LDL+1:2*LDL)//' ' | |
54480 | IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?' | |
54481 | ENDIF | |
54482 | ENDIF | |
54483 | ||
54484 | C...Add information on string connection. | |
54485 | IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12) | |
54486 | & THEN | |
54487 | KC=PYCOMP(K(I,2)) | |
54488 | KCC=0 | |
54489 | IF(KC.NE.0) KCC=KCHG(KC,2) | |
54490 | IF(IABS(K(I,2)).EQ.39) THEN | |
54491 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X' | |
54492 | ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN | |
54493 | ISTR=1 | |
54494 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A' | |
54495 | ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN | |
54496 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I' | |
54497 | ELSEIF(KCC.NE.0) THEN | |
54498 | ISTR=0 | |
54499 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V' | |
54500 | ENDIF | |
54501 | ENDIF | |
54502 | IF((K(I,1).EQ.41.OR.K(I,1).EQ.51).AND.LEN+2*LDL+3.LE.LMX) | |
54503 | & CHAC(LMX-1:LMX-1)='I' | |
54504 | ||
54505 | C...Write data for particle/jet. | |
54506 | IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999D0) THEN | |
54507 | WRITE(MSTU(11),5400) I,CHAC(1:12),(K(I,J1),J1=1,3), | |
54508 | & (P(I,J2),J2=1,5) | |
54509 | ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999D0) THEN | |
54510 | WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3), | |
54511 | & (P(I,J2),J2=1,5) | |
54512 | ELSEIF(MLIST.EQ.1) THEN | |
54513 | WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3), | |
54514 | & (P(I,J2),J2=1,5) | |
54515 | ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR. | |
54516 | & K(I,1).EQ.14.OR.K(I,1).EQ.42.OR.K(I,1).EQ.52)) THEN | |
54517 | WRITE(MSTU(11),5700) I,CHAC,(K(I,J1),J1=1,3), | |
54518 | & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000), | |
54519 | & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000), | |
54520 | & (P(I,J2),J2=1,5) | |
54521 | ELSE | |
54522 | WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,5), | |
54523 | & (P(I,J2),J2=1,5) | |
54524 | ENDIF | |
54525 | IF(MLIST.EQ.3) WRITE(MSTU(11),5900) (V(I,J),J=1,5) | |
54526 | ||
54527 | C...Insert extra separator lines specified by user. | |
54528 | IF(MSTU(70).GE.1) THEN | |
54529 | ISEP=0 | |
54530 | DO 110 J=1,MIN(10,MSTU(70)) | |
54531 | IF(I.EQ.MSTU(70+J)) ISEP=1 | |
54532 | 110 CONTINUE | |
54533 | IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),6000) | |
54534 | IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),6100) | |
54535 | ENDIF | |
54536 | 120 CONTINUE | |
54537 | ||
54538 | C...Sum of charges and momenta. | |
54539 | DO 130 J=1,6 | |
54540 | PS(J)=PYP(0,J) | |
54541 | 130 CONTINUE | |
54542 | IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999D0) THEN | |
54543 | WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5) | |
54544 | ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999D0) THEN | |
54545 | WRITE(MSTU(11),6300) PS(6),(PS(J),J=1,5) | |
54546 | ELSEIF(MLIST.EQ.1) THEN | |
54547 | WRITE(MSTU(11),6400) PS(6),(PS(J),J=1,5) | |
54548 | ELSE | |
54549 | WRITE(MSTU(11),6500) PS(6),(PS(J),J=1,5) | |
54550 | ENDIF | |
54551 | ||
54552 | C...Simple listing of HEPEVT entries (mainly for test purposes). | |
54553 | ELSEIF(MLIST.EQ.5) THEN | |
54554 | WRITE(MSTU(11),7500) | |
54555 | DO 140 I=1,NHEP | |
54556 | IF(ISTHEP(I).EQ.0) GOTO 140 | |
54557 | WRITE(MSTU(11),7600) I,ISTHEP(I),IDHEP(I),JMOHEP(1,I), | |
54558 | & JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),(PHEP(J,I),J=1,5) | |
54559 | 140 CONTINUE | |
54560 | ||
54561 | ||
54562 | C...Simple listing of user-process entries (mainly for test purposes). | |
54563 | ELSEIF(MLIST.EQ.7) THEN | |
54564 | WRITE(MSTU(11),7300) | |
54565 | DO 150 I=1,NUP | |
54566 | WRITE(MSTU(11),7400) I,ISTUP(I),IDUP(I),MOTHUP(1,I), | |
54567 | & MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),(PUP(J,I),J=1,5) | |
54568 | 150 CONTINUE | |
54569 | ||
54570 | C...Give simple list of KF codes defined in program. | |
54571 | ELSEIF(MLIST.EQ.11) THEN | |
54572 | WRITE(MSTU(11),6600) | |
54573 | DO 160 KF=1,80 | |
54574 | CALL PYNAME(KF,CHAP) | |
54575 | CALL PYNAME(-KF,CHAN) | |
54576 | IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP | |
54577 | IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN | |
54578 | 160 CONTINUE | |
54579 | DO 190 KFLS=1,3,2 | |
54580 | DO 180 KFLA=1,5 | |
54581 | DO 170 KFLB=1,KFLA-(3-KFLS)/2 | |
54582 | KF=1000*KFLA+100*KFLB+KFLS | |
54583 | CALL PYNAME(KF,CHAP) | |
54584 | CALL PYNAME(-KF,CHAN) | |
54585 | WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN | |
54586 | 170 CONTINUE | |
54587 | 180 CONTINUE | |
54588 | 190 CONTINUE | |
54589 | DO 220 KMUL=0,5 | |
54590 | KFLS=3 | |
54591 | IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 | |
54592 | IF(KMUL.EQ.5) KFLS=5 | |
54593 | KFLR=0 | |
54594 | IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1 | |
54595 | IF(KMUL.EQ.4) KFLR=2 | |
54596 | DO 210 KFLB=1,5 | |
54597 | DO 200 KFLC=1,KFLB-1 | |
54598 | KF=10000*KFLR+100*KFLB+10*KFLC+KFLS | |
54599 | CALL PYNAME(KF,CHAP) | |
54600 | CALL PYNAME(-KF,CHAN) | |
54601 | WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN | |
54602 | IF(KF.EQ.311) THEN | |
54603 | KFK=130 | |
54604 | CALL PYNAME(KFK,CHAP) | |
54605 | WRITE(MSTU(11),6700) KFK,CHAP | |
54606 | KFK=310 | |
54607 | CALL PYNAME(KFK,CHAP) | |
54608 | WRITE(MSTU(11),6700) KFK,CHAP | |
54609 | ENDIF | |
54610 | 200 CONTINUE | |
54611 | KF=10000*KFLR+110*KFLB+KFLS | |
54612 | CALL PYNAME(KF,CHAP) | |
54613 | WRITE(MSTU(11),6700) KF,CHAP | |
54614 | 210 CONTINUE | |
54615 | 220 CONTINUE | |
54616 | KF=100443 | |
54617 | CALL PYNAME(KF,CHAP) | |
54618 | WRITE(MSTU(11),6700) KF,CHAP | |
54619 | KF=100553 | |
54620 | CALL PYNAME(KF,CHAP) | |
54621 | WRITE(MSTU(11),6700) KF,CHAP | |
54622 | DO 260 KFLSP=1,3 | |
54623 | KFLS=2+2*(KFLSP/3) | |
54624 | DO 250 KFLA=1,5 | |
54625 | DO 240 KFLB=1,KFLA | |
54626 | DO 230 KFLC=1,KFLB | |
54627 | IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) | |
54628 | & GOTO 230 | |
54629 | IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 230 | |
54630 | IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS | |
54631 | IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS | |
54632 | CALL PYNAME(KF,CHAP) | |
54633 | CALL PYNAME(-KF,CHAN) | |
54634 | WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN | |
54635 | 230 CONTINUE | |
54636 | 240 CONTINUE | |
54637 | 250 CONTINUE | |
54638 | 260 CONTINUE | |
54639 | DO 270 KC=1,500 | |
54640 | KF=KCHG(KC,4) | |
54641 | IF(KF.LT.1000000) GOTO 270 | |
54642 | CALL PYNAME(KF,CHAP) | |
54643 | CALL PYNAME(-KF,CHAN) | |
54644 | IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP | |
54645 | IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN | |
54646 | 270 CONTINUE | |
54647 | ||
54648 | C...List parton/particle data table. Check whether to be listed. | |
54649 | ELSEIF(MLIST.EQ.12) THEN | |
54650 | WRITE(MSTU(11),6800) | |
54651 | DO 300 KC=1,MSTU(6) | |
54652 | KF=KCHG(KC,4) | |
54653 | IF(KF.EQ.0) GOTO 300 | |
54654 | IF(KF.LT.MSTU(1).OR.(MSTU(2).GT.0.AND.KF.GT.MSTU(2))) | |
54655 | & GOTO 300 | |
54656 | ||
54657 | C...Find particle name and mass. Print information. | |
54658 | CALL PYNAME(KF,CHAP) | |
54659 | IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 300 | |
54660 | CALL PYNAME(-KF,CHAN) | |
54661 | WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,(KCHG(KC,J1),J1=1,3), | |
54662 | & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) | |
54663 | ||
54664 | C...Particle decay: channel number, branching ratios, matrix element, | |
54665 | C...decay products. | |
54666 | DO 290 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 | |
54667 | DO 280 J=1,5 | |
54668 | CALL PYNAME(KFDP(IDC,J),CHAD(J)) | |
54669 | 280 CONTINUE | |
54670 | WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC), | |
54671 | & (CHAD(J),J=1,5) | |
54672 | 290 CONTINUE | |
54673 | 300 CONTINUE | |
54674 | ||
54675 | C...List parameter value table. | |
54676 | ELSEIF(MLIST.EQ.13) THEN | |
54677 | WRITE(MSTU(11),7100) | |
54678 | DO 310 I=1,200 | |
54679 | WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I) | |
54680 | 310 CONTINUE | |
54681 | ENDIF | |
54682 | ||
54683 | C...Format statements for output on unit MSTU(11) (by default 6). | |
54684 | 5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS', | |
54685 | &5X,'KF orig p_x p_y p_z E m'/) | |
54686 | 5200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet', | |
54687 | &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', | |
54688 | &' P(I,2) P(I,3) P(I,4) P(I,5)'/) | |
54689 | 5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j', | |
54690 | &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', | |
54691 | &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X, | |
54692 | &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/) | |
54693 | 5400 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.3) | |
54694 | 5500 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.2) | |
54695 | 5600 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.1) | |
54696 | 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I1,2I4),5F13.5) | |
54697 | 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I9),5F13.5) | |
54698 | 5900 FORMAT(66X,5(1X,F12.3)) | |
54699 | 6000 FORMAT(1X,78('=')) | |
54700 | 6100 FORMAT(1X,130('=')) | |
54701 | 6200 FORMAT(19X,'sum:',F6.2,5X,5F9.3) | |
54702 | 6300 FORMAT(19X,'sum:',F6.2,5X,5F9.2) | |
54703 | 6400 FORMAT(19X,'sum:',F6.2,5X,5F9.1) | |
54704 | 6500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:', | |
54705 | &5F13.5) | |
54706 | 6600 FORMAT(///20X,'List of KF codes in program'/) | |
54707 | 6700 FORMAT(4X,I9,4X,A16,6X,I9,4X,A16) | |
54708 | 6800 FORMAT(///30X,'Particle/parton data table'//8X,'KF',5X,'KC',4X, | |
54709 | &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X, | |
54710 | &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off', | |
54711 | &1X,'ME',3X,'Br.rat.',4X,'decay products') | |
54712 | 6900 FORMAT(/1X,I9,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5), | |
54713 | &1X,1P,E13.5,3X,I2) | |
54714 | 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F10.6,4X,5A16) | |
54715 | 7100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)', | |
54716 | &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)') | |
54717 | 7200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5) | |
54718 | 7300 FORMAT(/10X,'Event listing of user process at input (simplified)' | |
54719 | &//' I IST ID Mothers Colours p_x p_y p_z', | |
54720 | &' E m') | |
54721 | 7400 FORMAT(1X,I3,I3,I8,2I4,2I5,5F9.3) | |
54722 | 7500 FORMAT(/10X,'Event listing of HEPEVT common block (simplified)' | |
54723 | &//' I IST ID Mothers Daughters p_x p_y p_z', | |
54724 | &' E m') | |
54725 | 7600 FORMAT(1X,I4,I2,I8,4I5,5F9.3) | |
54726 | ||
54727 | RETURN | |
54728 | END | |
54729 | ||
54730 | C********************************************************************* | |
54731 | ||
54732 | C...PYLOGO | |
54733 | C...Writes a logo for the program. | |
54734 | ||
54735 | SUBROUTINE PYLOGO | |
54736 | ||
54737 | C...Double precision and integer declarations. | |
54738 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
54739 | IMPLICIT INTEGER(I-N) | |
54740 | INTEGER PYK,PYCHGE,PYCOMP | |
54741 | C...Parameter for length of information block. | |
54742 | PARAMETER (IREFER=24) | |
54743 | C...Commonblocks. | |
54744 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
54745 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
54746 | SAVE /PYDAT1/,/PYPARS/ | |
54747 | C...Local arrays and character variables. | |
54748 | INTEGER IDATI(6) | |
54749 | CHARACTER MONTH(12)*3, LOGO(48)*32, REFER(2*IREFER)*36, LINE*79, | |
54750 | &VERS*1, SUBV*3, DATE*2, YEAR*4, HOUR*2, MINU*2, SECO*2 | |
54751 | ||
54752 | C...Data on months, logo, titles, and references. | |
54753 | DATA MONTH/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', | |
54754 | &'Oct','Nov','Dec'/ | |
54755 | DATA (LOGO(J),J=1,19)/ | |
54756 | &' *......* ', | |
54757 | &' *:::!!:::::::::::* ', | |
54758 | &' *::::::!!::::::::::::::* ', | |
54759 | &' *::::::::!!::::::::::::::::* ', | |
54760 | &' *:::::::::!!:::::::::::::::::* ', | |
54761 | &' *:::::::::!!:::::::::::::::::* ', | |
54762 | &' *::::::::!!::::::::::::::::*! ', | |
54763 | &' *::::::!!::::::::::::::* !! ', | |
54764 | &' !! *:::!!:::::::::::* !! ', | |
54765 | &' !! !* -><- * !! ', | |
54766 | &' !! !! !! ', | |
54767 | &' !! !! !! ', | |
54768 | &' !! !! ', | |
54769 | &' !! lh !! ', | |
54770 | &' !! !! ', | |
54771 | &' !! hh !! ', | |
54772 | &' !! ll !! ', | |
54773 | &' !! !! ', | |
54774 | &' !! '/ | |
54775 | DATA (LOGO(J),J=20,38)/ | |
54776 | &'Welcome to the Lund Monte Carlo!', | |
54777 | &' ', | |
54778 | &'PPP Y Y TTTTT H H III A ', | |
54779 | &'P P Y Y T H H I A A ', | |
54780 | &'PPP Y T HHHHH I AAAAA', | |
54781 | &'P Y T H H I A A', | |
54782 | &'P Y T H H III A A', | |
54783 | &' ', | |
54784 | &'This is PYTHIA version x.xxx ', | |
54785 | &'Last date of change: xx xxx 199x', | |
54786 | &' ', | |
54787 | &'Now is xx xxx 199x at xx:xx:xx ', | |
54788 | &' ', | |
54789 | &'Disclaimer: this program comes ', | |
54790 | &'without any guarantees. Beware ', | |
54791 | &'of errors and use common sense ', | |
54792 | &'when interpreting results. ', | |
54793 | &' ', | |
54794 | &'Copyright T. Sjostrand (2003) '/ | |
54795 | DATA (REFER(J),J=1,18)/ | |
54796 | &'An archive of program versions and d', | |
54797 | &'ocumentation is found on the web: ', | |
54798 | &'http://www.thep.lu.se/~torbjorn/Pyth', | |
54799 | &'ia.html ', | |
54800 | &' ', | |
54801 | &' ', | |
54802 | &'When you cite this program, currentl', | |
54803 | &'y the official reference is ', | |
54804 | &'T. Sjostrand, P. Eden, C. Friberg, L', | |
54805 | &'. Lonnblad, G. Miu, S. Mrenna and ', | |
54806 | &'E. Norrbin, Computer Physics Commun.', | |
54807 | &' 135 (2001) 238. ', | |
54808 | &'The large manual is ', | |
54809 | &' ', | |
54810 | &'T. Sjostrand, L. Lonnblad and S. Mre', | |
54811 | &'nna, LU TP 01-21 [hep-ph/0108264]. ', | |
54812 | &'Also remember that the program, to a', | |
54813 | &' large extent, represents original '/ | |
54814 | DATA (REFER(J),J=19,36)/ | |
54815 | &'physics research. Other publications', | |
54816 | &' of special relevance to your ', | |
54817 | &'studies may therefore deserve separa', | |
54818 | &'te mention. ', | |
54819 | &' ', | |
54820 | &' ', | |
54821 | &'Main author: Torbjorn Sjostrand; Dep', | |
54822 | &'artment of Theoretical Physics 2, ', | |
54823 | &' Lund University, Solvegatan 14A, S', | |
54824 | &'-223 62 Lund, Sweden; ', | |
54825 | &' phone: + 46 - 46 - 222 48 16; e-ma', | |
54826 | &'il: torbjorn@thep.lu.se ', | |
54827 | &'Author: Leif Lonnblad; Department of', | |
54828 | &' Theoretical Physics 2, ', | |
54829 | &' Lund University, Solvegatan 14A, S', | |
54830 | &'-223 62 Lund, Sweden; ', | |
54831 | &' phone: + 46 - 46 - 222 77 80; e-ma', | |
54832 | &'il: leif@thep.lu.se '/ | |
54833 | DATA (REFER(J),J=37,2*IREFER)/ | |
54834 | &'Author: Stephen Mrenna; Computing Di', | |
54835 | &'vision, Simulations Group, ', | |
54836 | &' Fermi National Accelerator Laborat', | |
54837 | &'ory, MS 234, Batavia, IL 60510, USA;', | |
54838 | &' phone: + 1 - 630 - 840 - 2556; e-m', | |
54839 | &'ail: mrenna@fnal.gov ', | |
54840 | &'Author: Peter Skands; Department of ', | |
54841 | &'Theoretical Physics 2, ', | |
54842 | &' Lund University, Solvegatan 14A, S', | |
54843 | &'-223 62 Lund, Sweden; ', | |
54844 | &' phone: + 46 - 46 - 222 31 92; e-ma', | |
54845 | &'il: zeiler@thep.lu.se '/ | |
54846 | ||
54847 | C...Check that PYDATA linked. | |
54848 | IF(MSTP(183)/10.NE.199.AND.MSTP(183)/10.NE.200) THEN | |
54849 | WRITE(*,'(1X,A)') | |
54850 | & 'Error: PYDATA has not been linked.' | |
54851 | WRITE(*,'(1X,A)') 'Execution stopped!' | |
54852 | STOP | |
54853 | ||
54854 | C...Write current version number and current date+time. | |
54855 | ELSE | |
54856 | WRITE(VERS,'(I1)') MSTP(181) | |
54857 | LOGO(28)(24:24)=VERS | |
54858 | WRITE(SUBV,'(I3)') MSTP(182) | |
54859 | LOGO(28)(26:28)=SUBV | |
54860 | IF(MSTP(182).LT.100) LOGO(28)(26:26)='0' | |
54861 | WRITE(DATE,'(I2)') MSTP(185) | |
54862 | LOGO(29)(22:23)=DATE | |
54863 | LOGO(29)(25:27)=MONTH(MSTP(184)) | |
54864 | WRITE(YEAR,'(I4)') MSTP(183) | |
54865 | LOGO(29)(29:32)=YEAR | |
54866 | CALL PYTIME(IDATI) | |
54867 | IF(IDATI(1).LE.0) THEN | |
54868 | LOGO(31)=' ' | |
54869 | ELSE | |
54870 | WRITE(DATE,'(I2)') IDATI(3) | |
54871 | LOGO(31)(8:9)=DATE | |
54872 | LOGO(31)(11:13)=MONTH(MAX(1,MIN(12,IDATI(2)))) | |
54873 | WRITE(YEAR,'(I4)') IDATI(1) | |
54874 | LOGO(31)(15:18)=YEAR | |
54875 | WRITE(HOUR,'(I2)') IDATI(4) | |
54876 | LOGO(31)(23:24)=HOUR | |
54877 | WRITE(MINU,'(I2)') IDATI(5) | |
54878 | LOGO(31)(26:27)=MINU | |
54879 | IF(IDATI(5).LT.10) LOGO(31)(26:26)='0' | |
54880 | WRITE(SECO,'(I2)') IDATI(6) | |
54881 | LOGO(31)(29:30)=SECO | |
54882 | IF(IDATI(6).LT.10) LOGO(31)(29:29)='0' | |
54883 | ENDIF | |
54884 | ENDIF | |
54885 | ||
54886 | C...Loop over lines in header. Define page feed and side borders. | |
54887 | DO 100 ILIN=1,29+IREFER | |
54888 | LINE=' ' | |
54889 | IF(ILIN.EQ.1) THEN | |
54890 | LINE(1:1)='1' | |
54891 | ELSE | |
54892 | LINE(2:3)='**' | |
54893 | LINE(78:79)='**' | |
54894 | ENDIF | |
54895 | ||
54896 | C...Separator lines and logos. | |
54897 | IF(ILIN.EQ.2.OR.ILIN.EQ.3.OR.ILIN.GE.28+IREFER) THEN | |
54898 | LINE(4:77)='***********************************************'// | |
54899 | & '***************************' | |
54900 | ELSEIF(ILIN.GE.6.AND.ILIN.LE.24) THEN | |
54901 | LINE(6:37)=LOGO(ILIN-5) | |
54902 | LINE(44:75)=LOGO(ILIN+14) | |
54903 | ELSEIF(ILIN.GE.26.AND.ILIN.LE.25+IREFER) THEN | |
54904 | LINE(5:40)=REFER(2*ILIN-51) | |
54905 | LINE(41:76)=REFER(2*ILIN-50) | |
54906 | ENDIF | |
54907 | ||
54908 | C...Write lines to appropriate unit. | |
54909 | WRITE(MSTU(11),'(A79)') LINE | |
54910 | 100 CONTINUE | |
54911 | ||
54912 | RETURN | |
54913 | END | |
54914 | ||
54915 | C********************************************************************* | |
54916 | ||
54917 | C...PYUPDA | |
54918 | C...Facilitates the updating of particle and decay data | |
54919 | C...by allowing it to be done in an external file. | |
54920 | ||
54921 | SUBROUTINE PYUPDA(MUPDA,LFN) | |
54922 | ||
54923 | C...Double precision and integer declarations. | |
54924 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
54925 | IMPLICIT INTEGER(I-N) | |
54926 | INTEGER PYK,PYCHGE,PYCOMP | |
54927 | C...Commonblocks. | |
54928 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
54929 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
54930 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
54931 | COMMON/PYDAT4/CHAF(500,2) | |
54932 | CHARACTER CHAF*16 | |
54933 | COMMON/PYINT4/MWID(500),WIDS(500,5) | |
54934 | SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYINT4/ | |
54935 | C...Local arrays, character variables and data. | |
54936 | CHARACTER CHINL*120,CHKF*9,CHVAR(22)*9,CHLIN*72, | |
54937 | &CHBLK(20)*72,CHOLD*16,CHTMP*16,CHNEW*16,CHCOM*24 | |
54938 | DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','KCHG(I,4)', | |
54939 | &'PMAS(I,1)','PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)', | |
54940 | &'MDCY(I,2)','MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ', | |
54941 | &'KFDP(I,1)','KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)', | |
54942 | &'CHAF(I,1)','CHAF(I,2)','MWID(I) '/ | |
54943 | ||
54944 | C...Write header if not yet done. | |
54945 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
54946 | ||
54947 | C...Write information on file for editing. | |
54948 | IF(MUPDA.EQ.1) THEN | |
54949 | DO 110 KC=1,500 | |
54950 | WRITE(LFN,5000) KCHG(KC,4),(CHAF(KC,J1),J1=1,2), | |
54951 | & (KCHG(KC,J2),J2=1,3),(PMAS(KC,J3),J3=1,4), | |
54952 | & MWID(KC),MDCY(KC,1) | |
54953 | DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 | |
54954 | WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), | |
54955 | & (KFDP(IDC,J),J=1,5) | |
54956 | 100 CONTINUE | |
54957 | 110 CONTINUE | |
54958 | ||
54959 | C...Read complete set of information from edited file or | |
54960 | C...read partial set of new or updated information from edited file. | |
54961 | ELSEIF(MUPDA.EQ.2.OR.MUPDA.EQ.3) THEN | |
54962 | ||
54963 | C...Reset counters. | |
54964 | KCC=100 | |
54965 | NDC=0 | |
54966 | CHKF=' ' | |
54967 | IF(MUPDA.EQ.2) THEN | |
54968 | DO 120 I=1,MSTU(6) | |
54969 | KCHG(I,4)=0 | |
54970 | 120 CONTINUE | |
54971 | ELSE | |
54972 | DO 130 KC=1,MSTU(6) | |
54973 | IF(KC.GT.100.AND.KCHG(KC,4).GT.100) KCC=KC | |
54974 | NDC=MAX(NDC,MDCY(KC,2)+MDCY(KC,3)-1) | |
54975 | 130 CONTINUE | |
54976 | ENDIF | |
54977 | ||
54978 | C...Begin of loop: read new line; unknown whether particle or | |
54979 | C...decay data. | |
54980 | 140 READ(LFN,5200,END=190) CHINL | |
54981 | ||
54982 | C...Identify particle code and whether already defined (for MUPDA=3). | |
54983 | IF(CHINL(2:10).NE.' ') THEN | |
54984 | CHKF=CHINL(2:10) | |
54985 | READ(CHKF,5300) KF | |
54986 | IF(MUPDA.EQ.2) THEN | |
54987 | IF(KF.LE.100) THEN | |
54988 | KC=KF | |
54989 | ELSE | |
54990 | KCC=KCC+1 | |
54991 | KC=KCC | |
54992 | ENDIF | |
54993 | ELSE | |
54994 | KCREP=0 | |
54995 | IF(KF.LE.100) THEN | |
54996 | KCREP=KF | |
54997 | ELSE | |
54998 | DO 150 KCR=101,KCC | |
54999 | IF(KCHG(KCR,4).EQ.KF) KCREP=KCR | |
55000 | 150 CONTINUE | |
55001 | ENDIF | |
55002 | C...Remove duplicate old decay data. | |
5d3dd6f6 | 55003 | IF(KCREP.NE.0) THEN |
55004 | IF(MDCY(KCREP,3).GT.0) THEN | |
55005 | IDCREP=MDCY(KCREP,2) | |
55006 | NDCREP=MDCY(KCREP,3) | |
55007 | DO 160 I=1,KCC | |
55008 | IF(MDCY(I,2).GT.IDCREP) MDCY(I,2)=MDCY(I,2)-NDCREP | |
55009 | 160 CONTINUE | |
55010 | DO 180 I=IDCREP,NDC-NDCREP | |
55011 | MDME(I,1)=MDME(I+NDCREP,1) | |
55012 | MDME(I,2)=MDME(I+NDCREP,2) | |
55013 | BRAT(I)=BRAT(I+NDCREP) | |
55014 | DO 170 J=1,5 | |
55015 | KFDP(I,J)=KFDP(I+NDCREP,J) | |
55016 | 170 CONTINUE | |
55017 | 180 CONTINUE | |
55018 | NDC=NDC-NDCREP | |
55019 | KC=KCREP | |
55020 | ELSE | |
55021 | KC=KCREP | |
55022 | ENDIF | |
2dfa57d1 | 55023 | ELSE |
55024 | KCC=KCC+1 | |
55025 | KC=KCC | |
55026 | ENDIF | |
55027 | ENDIF | |
55028 | ||
55029 | C...Study line with particle data. | |
55030 | IF(KC.GT.MSTU(6)) CALL PYERRM(27, | |
55031 | & '(PYUPDA:) Particle arrays full by KF ='//CHKF) | |
55032 | READ(CHINL,5000) KCHG(KC,4),(CHAF(KC,J1),J1=1,2), | |
55033 | & (KCHG(KC,J2),J2=1,3),(PMAS(KC,J3),J3=1,4), | |
55034 | & MWID(KC),MDCY(KC,1) | |
55035 | MDCY(KC,2)=0 | |
55036 | MDCY(KC,3)=0 | |
55037 | ||
55038 | C...Study line with decay data. | |
55039 | ELSE | |
55040 | NDC=NDC+1 | |
55041 | IF(NDC.GT.MSTU(7)) CALL PYERRM(27, | |
55042 | & '(PYUPDA:) Decay data arrays full by KF ='//CHKF) | |
55043 | IF(MDCY(KC,2).EQ.0) MDCY(KC,2)=NDC | |
55044 | MDCY(KC,3)=MDCY(KC,3)+1 | |
55045 | READ(CHINL,5100) MDME(NDC,1),MDME(NDC,2),BRAT(NDC), | |
55046 | & (KFDP(NDC,J),J=1,5) | |
55047 | ENDIF | |
55048 | ||
55049 | C...End of loop; ensure that PYCOMP tables are updated. | |
55050 | GOTO 140 | |
55051 | 190 CONTINUE | |
55052 | MSTU(20)=0 | |
55053 | ||
55054 | C...Perform possible tests that new information is consistent. | |
55055 | DO 220 KC=1,MSTU(6) | |
55056 | KF=KCHG(KC,4) | |
55057 | IF(KF.EQ.0) GOTO 220 | |
55058 | WRITE(CHKF,5300) KF | |
55059 | IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3), | |
55060 | & PMAS(KC,4)).LT.0D0.OR.MDCY(KC,3).LT.0) CALL PYERRM(17, | |
55061 | & '(PYUPDA:) Mass/width/life/(# channels) wrong for KF ='//CHKF) | |
55062 | BRSUM=0D0 | |
55063 | DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 | |
55064 | IF(MDME(IDC,2).GT.80) GOTO 210 | |
55065 | KQ=KCHG(KC,1) | |
55066 | PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64) | |
55067 | MERR=0 | |
55068 | DO 200 J=1,5 | |
55069 | KP=KFDP(IDC,J) | |
55070 | IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN | |
55071 | IF(KP.EQ.81) KQ=0 | |
55072 | ELSEIF(PYCOMP(KP).EQ.0) THEN | |
55073 | MERR=3 | |
55074 | ELSE | |
55075 | KQ=KQ-PYCHGE(KP) | |
55076 | KPC=PYCOMP(KP) | |
55077 | PMS=PMS-PMAS(KPC,1) | |
55078 | IF(MSTJ(24).GT.0) PMS=PMS+0.5D0*MIN(PMAS(KPC,2), | |
55079 | & PMAS(KPC,3)) | |
55080 | ENDIF | |
55081 | 200 CONTINUE | |
55082 | IF(KQ.NE.0) MERR=MAX(2,MERR) | |
55083 | IF(MWID(KC).EQ.0.AND.KF.NE.311.AND.PMS.LT.0D0) | |
55084 | & MERR=MAX(1,MERR) | |
55085 | IF(MERR.EQ.3) CALL PYERRM(17, | |
55086 | & '(PYUPDA:) Unknown particle code in decay of KF ='//CHKF) | |
55087 | IF(MERR.EQ.2) CALL PYERRM(17, | |
55088 | & '(PYUPDA:) Charge not conserved in decay of KF ='//CHKF) | |
55089 | IF(MERR.EQ.1) CALL PYERRM(7, | |
55090 | & '(PYUPDA:) Kinematically unallowed decay of KF ='//CHKF) | |
55091 | BRSUM=BRSUM+BRAT(IDC) | |
55092 | 210 CONTINUE | |
55093 | WRITE(CHTMP,5500) BRSUM | |
55094 | IF(ABS(BRSUM).GT.0.0005D0.AND.ABS(BRSUM-1D0).GT.0.0005D0) | |
55095 | & CALL PYERRM(7,'(PYUPDA:) Sum of branching ratios is '// | |
55096 | & CHTMP(9:16)//' for KF ='//CHKF) | |
55097 | 220 CONTINUE | |
55098 | ||
55099 | C...Write DATA statements for inclusion in program. | |
55100 | ELSEIF(MUPDA.EQ.4) THEN | |
55101 | ||
55102 | C...Find out how many codes and decay channels are actually used. | |
55103 | KCC=0 | |
55104 | NDC=0 | |
55105 | DO 230 I=1,MSTU(6) | |
55106 | IF(KCHG(I,4).NE.0) THEN | |
55107 | KCC=I | |
55108 | NDC=MAX(NDC,MDCY(I,2)+MDCY(I,3)-1) | |
55109 | ENDIF | |
55110 | 230 CONTINUE | |
55111 | ||
55112 | C...Initialize writing of DATA statements for inclusion in program. | |
55113 | DO 300 IVAR=1,22 | |
55114 | NDIM=MSTU(6) | |
55115 | IF(IVAR.GE.12.AND.IVAR.LE.19) NDIM=MSTU(7) | |
55116 | NLIN=1 | |
55117 | CHLIN=' ' | |
55118 | CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I= 1, )/' | |
55119 | LLIN=35 | |
55120 | CHOLD='START' | |
55121 | ||
55122 | C...Loop through variables for conversion to characters. | |
55123 | DO 280 IDIM=1,NDIM | |
55124 | IF(IVAR.EQ.1) WRITE(CHTMP,5400) KCHG(IDIM,1) | |
55125 | IF(IVAR.EQ.2) WRITE(CHTMP,5400) KCHG(IDIM,2) | |
55126 | IF(IVAR.EQ.3) WRITE(CHTMP,5400) KCHG(IDIM,3) | |
55127 | IF(IVAR.EQ.4) WRITE(CHTMP,5400) KCHG(IDIM,4) | |
55128 | IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,1) | |
55129 | IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,2) | |
55130 | IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,3) | |
55131 | IF(IVAR.EQ.8) WRITE(CHTMP,5500) PMAS(IDIM,4) | |
55132 | IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,1) | |
55133 | IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,2) | |
55134 | IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDCY(IDIM,3) | |
55135 | IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,1) | |
55136 | IF(IVAR.EQ.13) WRITE(CHTMP,5400) MDME(IDIM,2) | |
55137 | IF(IVAR.EQ.14) WRITE(CHTMP,5600) BRAT(IDIM) | |
55138 | IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,1) | |
55139 | IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,2) | |
55140 | IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,3) | |
55141 | IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,4) | |
55142 | IF(IVAR.EQ.19) WRITE(CHTMP,5400) KFDP(IDIM,5) | |
55143 | IF(IVAR.EQ.20) CHTMP=CHAF(IDIM,1) | |
55144 | IF(IVAR.EQ.21) CHTMP=CHAF(IDIM,2) | |
55145 | IF(IVAR.EQ.22) WRITE(CHTMP,5400) MWID(IDIM) | |
55146 | ||
55147 | C...Replace variables beyond what is properly defined. | |
55148 | IF(IVAR.LE.4) THEN | |
55149 | IF(IDIM.GT.KCC) CHTMP=' 0' | |
55150 | ELSEIF(IVAR.LE.8) THEN | |
55151 | IF(IDIM.GT.KCC) CHTMP=' 0.0' | |
55152 | ELSEIF(IVAR.LE.11) THEN | |
55153 | IF(IDIM.GT.KCC) CHTMP=' 0' | |
55154 | ELSEIF(IVAR.LE.13) THEN | |
55155 | IF(IDIM.GT.NDC) CHTMP=' 0' | |
55156 | ELSEIF(IVAR.LE.14) THEN | |
55157 | IF(IDIM.GT.NDC) CHTMP=' 0.0' | |
55158 | ELSEIF(IVAR.LE.19) THEN | |
55159 | IF(IDIM.GT.NDC) CHTMP=' 0' | |
55160 | ELSEIF(IVAR.LE.21) THEN | |
55161 | IF(IDIM.GT.KCC) CHTMP=' ' | |
55162 | ELSE | |
55163 | IF(IDIM.GT.KCC) CHTMP=' 0' | |
55164 | ENDIF | |
55165 | ||
55166 | C...Length of variable, trailing decimal zeros, quotation marks. | |
55167 | LLOW=1 | |
55168 | LHIG=1 | |
55169 | DO 240 LL=1,16 | |
55170 | IF(CHTMP(17-LL:17-LL).NE.' ') LLOW=17-LL | |
55171 | IF(CHTMP(LL:LL).NE.' ') LHIG=LL | |
55172 | 240 CONTINUE | |
55173 | CHNEW=CHTMP(LLOW:LHIG)//' ' | |
55174 | LNEW=1+LHIG-LLOW | |
55175 | IF((IVAR.GE.5.AND.IVAR.LE.8).OR.IVAR.EQ.14) THEN | |
55176 | LNEW=LNEW+1 | |
55177 | 250 LNEW=LNEW-1 | |
55178 | IF(LNEW.GE.2.AND.CHNEW(LNEW:LNEW).EQ.'0') GOTO 250 | |
55179 | IF(CHNEW(LNEW:LNEW).EQ.'.') LNEW=LNEW-1 | |
55180 | IF(LNEW.EQ.0) THEN | |
55181 | CHNEW(1:3)='0D0' | |
55182 | LNEW=3 | |
55183 | ELSE | |
55184 | CHNEW(LNEW+1:LNEW+2)='D0' | |
55185 | LNEW=LNEW+2 | |
55186 | ENDIF | |
55187 | ELSEIF(IVAR.EQ.20.OR.IVAR.EQ.21) THEN | |
55188 | DO 260 LL=LNEW,1,-1 | |
55189 | IF(CHNEW(LL:LL).EQ.'''') THEN | |
55190 | CHTMP=CHNEW | |
55191 | CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11) | |
55192 | LNEW=LNEW+1 | |
55193 | ENDIF | |
55194 | 260 CONTINUE | |
55195 | LNEW=MIN(14,LNEW) | |
55196 | CHTMP=CHNEW | |
55197 | CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//'''' | |
55198 | LNEW=LNEW+2 | |
55199 | ENDIF | |
55200 | ||
55201 | C...Form composite character string, often including repetition counter. | |
55202 | IF(CHNEW.NE.CHOLD) THEN | |
55203 | NRPT=1 | |
55204 | CHOLD=CHNEW | |
55205 | CHCOM=CHNEW | |
55206 | LCOM=LNEW | |
55207 | ELSE | |
55208 | LRPT=LNEW+1 | |
55209 | IF(NRPT.GE.2) LRPT=LNEW+3 | |
55210 | IF(NRPT.GE.10) LRPT=LNEW+4 | |
55211 | IF(NRPT.GE.100) LRPT=LNEW+5 | |
55212 | IF(NRPT.GE.1000) LRPT=LNEW+6 | |
55213 | LLIN=LLIN-LRPT | |
55214 | NRPT=NRPT+1 | |
55215 | WRITE(CHTMP,5400) NRPT | |
55216 | LRPT=1 | |
55217 | IF(NRPT.GE.10) LRPT=2 | |
55218 | IF(NRPT.GE.100) LRPT=3 | |
55219 | IF(NRPT.GE.1000) LRPT=4 | |
55220 | CHCOM(1:LRPT+1+LNEW)=CHTMP(17-LRPT:16)//'*'//CHNEW(1:LNEW) | |
55221 | LCOM=LRPT+1+LNEW | |
55222 | ENDIF | |
55223 | ||
55224 | C...Add characters to end of line, to new line (after storing old line), | |
55225 | C...or to new block of lines (after writing old block). | |
55226 | IF(LLIN+LCOM.LE.70) THEN | |
55227 | CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//',' | |
55228 | LLIN=LLIN+LCOM+1 | |
55229 | ELSEIF(NLIN.LE.19) THEN | |
55230 | CHLIN(LLIN+1:72)=' ' | |
55231 | CHBLK(NLIN)=CHLIN | |
55232 | NLIN=NLIN+1 | |
55233 | CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//',' | |
55234 | LLIN=6+LCOM+1 | |
55235 | ELSE | |
55236 | CHLIN(LLIN:72)='/'//' ' | |
55237 | CHBLK(NLIN)=CHLIN | |
55238 | WRITE(CHTMP,5400) IDIM-NRPT | |
55239 | CHBLK(1)(30:33)=CHTMP(13:16) | |
55240 | DO 270 ILIN=1,NLIN | |
55241 | WRITE(LFN,5700) CHBLK(ILIN) | |
55242 | 270 CONTINUE | |
55243 | NLIN=1 | |
55244 | CHLIN=' ' | |
55245 | CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)// | |
55246 | & ',I= , )/'//CHCOM(1:LCOM)//',' | |
55247 | WRITE(CHTMP,5400) IDIM-NRPT+1 | |
55248 | CHLIN(25:28)=CHTMP(13:16) | |
55249 | LLIN=35+LCOM+1 | |
55250 | ENDIF | |
55251 | 280 CONTINUE | |
55252 | ||
55253 | C...Write final block of lines. | |
55254 | CHLIN(LLIN:72)='/'//' ' | |
55255 | CHBLK(NLIN)=CHLIN | |
55256 | WRITE(CHTMP,5400) NDIM | |
55257 | CHBLK(1)(30:33)=CHTMP(13:16) | |
55258 | DO 290 ILIN=1,NLIN | |
55259 | WRITE(LFN,5700) CHBLK(ILIN) | |
55260 | 290 CONTINUE | |
55261 | 300 CONTINUE | |
55262 | ENDIF | |
55263 | ||
55264 | C...Formats for reading and writing particle data. | |
55265 | 5000 FORMAT(1X,I9,2X,A16,2X,A16,3I3,3F12.5,1P,E13.5,2I3) | |
55266 | 5100 FORMAT(10X,2I5,F12.6,5I10) | |
55267 | 5200 FORMAT(A120) | |
55268 | 5300 FORMAT(I9) | |
55269 | 5400 FORMAT(I16) | |
55270 | 5500 FORMAT(F16.5) | |
55271 | 5600 FORMAT(F16.6) | |
55272 | 5700 FORMAT(A72) | |
55273 | ||
55274 | RETURN | |
55275 | END | |
55276 | ||
55277 | C********************************************************************* | |
55278 | ||
55279 | C...PYK | |
55280 | C...Provides various integer-valued event related data. | |
55281 | ||
55282 | FUNCTION PYK(I,J) | |
55283 | ||
55284 | C...Double precision and integer declarations. | |
55285 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
55286 | IMPLICIT INTEGER(I-N) | |
55287 | INTEGER PYK,PYCHGE,PYCOMP | |
55288 | C...Commonblocks. | |
55289 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
55290 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
55291 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
55292 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
55293 | ||
55294 | C...Default value. For I=0 number of entries, number of stable entries | |
55295 | C...or 3 times total charge. | |
55296 | PYK=0 | |
55297 | IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN | |
55298 | ELSEIF(I.EQ.0.AND.J.EQ.1) THEN | |
55299 | PYK=N | |
55300 | ELSEIF(I.EQ.0.AND.(J.EQ.2.OR.J.EQ.6)) THEN | |
55301 | DO 100 I1=1,N | |
55302 | IF(J.EQ.2.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) PYK=PYK+1 | |
55303 | IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) PYK=PYK+ | |
55304 | & PYCHGE(K(I1,2)) | |
55305 | 100 CONTINUE | |
55306 | ELSEIF(I.EQ.0) THEN | |
55307 | ||
55308 | C...For I > 0 direct readout of K matrix or charge. | |
55309 | ELSEIF(J.LE.5) THEN | |
55310 | PYK=K(I,J) | |
55311 | ELSEIF(J.EQ.6) THEN | |
55312 | PYK=PYCHGE(K(I,2)) | |
55313 | ||
55314 | C...Status (existing/fragmented/decayed), parton/hadron separation. | |
55315 | ELSEIF(J.LE.8) THEN | |
55316 | IF(K(I,1).GE.1.AND.K(I,1).LE.10) PYK=1 | |
55317 | IF(J.EQ.8) PYK=PYK*K(I,2) | |
55318 | ELSEIF(J.LE.12) THEN | |
55319 | KFA=IABS(K(I,2)) | |
55320 | KC=PYCOMP(KFA) | |
55321 | KQ=0 | |
55322 | IF(KC.NE.0) KQ=KCHG(KC,2) | |
55323 | IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) PYK=K(I,2) | |
55324 | IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) PYK=K(I,2) | |
55325 | IF(J.EQ.11) PYK=KC | |
55326 | IF(J.EQ.12) PYK=KQ*ISIGN(1,K(I,2)) | |
55327 | ||
55328 | C...Heaviest flavour in hadron/diquark. | |
55329 | ELSEIF(J.EQ.13) THEN | |
55330 | KFA=IABS(K(I,2)) | |
55331 | PYK=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10) | |
55332 | IF(KFA.LT.10) PYK=KFA | |
55333 | IF(MOD(KFA/1000,10).NE.0) PYK=MOD(KFA/1000,10) | |
55334 | PYK=PYK*ISIGN(1,K(I,2)) | |
55335 | ||
55336 | C...Particle history: generation, ancestor, rank. | |
55337 | ELSEIF(J.LE.15) THEN | |
55338 | I2=I | |
55339 | I1=I | |
55340 | 110 PYK=PYK+1 | |
55341 | I2=I1 | |
55342 | I1=K(I1,3) | |
55343 | IF(I1.GT.0) THEN | |
55344 | IF(K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110 | |
55345 | ENDIF | |
55346 | IF(J.EQ.15) PYK=I2 | |
55347 | ELSEIF(J.EQ.16) THEN | |
55348 | KFA=IABS(K(I,2)) | |
55349 | IF(K(I,1).LE.20.AND.((KFA.GE.11.AND.KFA.LE.20).OR.KFA.EQ.22.OR. | |
55350 | & (KFA.GT.100.AND.MOD(KFA/10,10).NE.0))) THEN | |
55351 | I1=I | |
55352 | 120 I2=I1 | |
55353 | I1=K(I1,3) | |
55354 | IF(I1.GT.0) THEN | |
55355 | KFAM=IABS(K(I1,2)) | |
55356 | ILP=1 | |
55357 | IF(KFAM.NE.0.AND.KFAM.LE.10) ILP=0 | |
55358 | IF(KFAM.EQ.21.OR.KFAM.EQ.91.OR.KFAM.EQ.92.OR.KFAM.EQ.93) | |
55359 | & ILP=0 | |
55360 | IF(KFAM.GT.100.AND.MOD(KFAM/10,10).EQ.0) ILP=0 | |
55361 | IF(ILP.EQ.1) GOTO 120 | |
55362 | ENDIF | |
55363 | IF(K(I1,1).EQ.12) THEN | |
55364 | DO 130 I3=I1+1,I2 | |
55365 | IF(K(I3,3).EQ.K(I2,3).AND.K(I3,2).NE.91.AND.K(I3,2).NE.92 | |
55366 | & .AND.K(I3,2).NE.93) PYK=PYK+1 | |
55367 | 130 CONTINUE | |
55368 | ELSE | |
55369 | I3=I2 | |
55370 | 140 PYK=PYK+1 | |
55371 | I3=I3+1 | |
55372 | IF(I3.LT.N.AND.K(I3,3).EQ.K(I2,3)) GOTO 140 | |
55373 | ENDIF | |
55374 | ENDIF | |
55375 | ||
55376 | C...Particle coming from collapsing jet system or not. | |
55377 | ELSEIF(J.EQ.17) THEN | |
55378 | I1=I | |
55379 | 150 PYK=PYK+1 | |
55380 | I3=I1 | |
55381 | I1=K(I1,3) | |
55382 | I0=MAX(1,I1) | |
55383 | KC=PYCOMP(K(I0,2)) | |
55384 | IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN | |
55385 | IF(PYK.EQ.1) PYK=-1 | |
55386 | IF(PYK.GT.1) PYK=0 | |
55387 | RETURN | |
55388 | ENDIF | |
55389 | IF(KCHG(KC,2).EQ.0) GOTO 150 | |
55390 | IF(K(I1,1).NE.12) PYK=0 | |
55391 | IF(K(I1,1).NE.12) RETURN | |
55392 | I2=I1 | |
55393 | 160 I2=I2+1 | |
55394 | IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 160 | |
55395 | K3M=K(I3-1,3) | |
55396 | IF(K3M.GE.I1.AND.K3M.LE.I2) PYK=0 | |
55397 | K3P=K(I3+1,3) | |
55398 | IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) PYK=0 | |
55399 | ||
55400 | C...Number of decay products. Colour flow. | |
55401 | ELSEIF(J.EQ.18) THEN | |
55402 | IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) PYK=MAX(0,K(I,5)-K(I,4)+1) | |
55403 | IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) PYK=0 | |
55404 | ELSEIF(J.LE.22) THEN | |
55405 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN | |
55406 | IF(J.EQ.19) PYK=MOD(K(I,4)/MSTU(5),MSTU(5)) | |
55407 | IF(J.EQ.20) PYK=MOD(K(I,5)/MSTU(5),MSTU(5)) | |
55408 | IF(J.EQ.21) PYK=MOD(K(I,4),MSTU(5)) | |
55409 | IF(J.EQ.22) PYK=MOD(K(I,5),MSTU(5)) | |
55410 | ELSE | |
55411 | ENDIF | |
55412 | ||
55413 | RETURN | |
55414 | END | |
55415 | ||
55416 | C********************************************************************* | |
55417 | ||
55418 | C...PYP | |
55419 | C...Provides various real-valued event related data. | |
55420 | ||
55421 | FUNCTION PYP(I,J) | |
55422 | ||
55423 | C...Double precision and integer declarations. | |
55424 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
55425 | IMPLICIT INTEGER(I-N) | |
55426 | INTEGER PYK,PYCHGE,PYCOMP | |
55427 | C...Commonblocks. | |
55428 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
55429 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
55430 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
55431 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
55432 | C...Local array. | |
55433 | DIMENSION PSUM(4) | |
55434 | ||
55435 | C...Set default value. For I = 0 sum of momenta or charges, | |
55436 | C...or invariant mass of system. | |
55437 | PYP=0D0 | |
55438 | IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN | |
55439 | ELSEIF(I.EQ.0.AND.J.LE.4) THEN | |
55440 | DO 100 I1=1,N | |
55441 | IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PYP=PYP+P(I1,J) | |
55442 | 100 CONTINUE | |
55443 | ELSEIF(I.EQ.0.AND.J.EQ.5) THEN | |
55444 | DO 120 J1=1,4 | |
55445 | PSUM(J1)=0D0 | |
55446 | DO 110 I1=1,N | |
55447 | IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PSUM(J1)=PSUM(J1)+ | |
55448 | & P(I1,J1) | |
55449 | 110 CONTINUE | |
55450 | 120 CONTINUE | |
55451 | PYP=SQRT(MAX(0D0,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2)) | |
55452 | ELSEIF(I.EQ.0.AND.J.EQ.6) THEN | |
55453 | DO 130 I1=1,N | |
55454 | IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PYP=PYP+PYCHGE(K(I1,2))/3D0 | |
55455 | 130 CONTINUE | |
55456 | ELSEIF(I.EQ.0) THEN | |
55457 | ||
55458 | C...Direct readout of P matrix. | |
55459 | ELSEIF(J.LE.5) THEN | |
55460 | PYP=P(I,J) | |
55461 | ||
55462 | C...Charge, total momentum, transverse momentum, transverse mass. | |
55463 | ELSEIF(J.LE.12) THEN | |
55464 | IF(J.EQ.6) PYP=PYCHGE(K(I,2))/3D0 | |
55465 | IF(J.EQ.7.OR.J.EQ.8) PYP=P(I,1)**2+P(I,2)**2+P(I,3)**2 | |
55466 | IF(J.EQ.9.OR.J.EQ.10) PYP=P(I,1)**2+P(I,2)**2 | |
55467 | IF(J.EQ.11.OR.J.EQ.12) PYP=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
55468 | IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PYP=SQRT(PYP) | |
55469 | ||
55470 | C...Theta and phi angle in radians or degrees. | |
55471 | ELSEIF(J.LE.16) THEN | |
55472 | IF(J.LE.14) PYP=PYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) | |
55473 | IF(J.GE.15) PYP=PYANGL(P(I,1),P(I,2)) | |
55474 | IF(J.EQ.14.OR.J.EQ.16) PYP=PYP*180D0/PARU(1) | |
55475 | ||
55476 | C...True rapidity, rapidity with pion mass, pseudorapidity. | |
55477 | ELSEIF(J.LE.19) THEN | |
55478 | PMR=0D0 | |
55479 | IF(J.EQ.17) PMR=P(I,5) | |
55480 | IF(J.EQ.18) PMR=PYMASS(211) | |
55481 | PR=MAX(1D-20,PMR**2+P(I,1)**2+P(I,2)**2) | |
55482 | PYP=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), | |
55483 | & 1D20)),P(I,3)) | |
55484 | ||
55485 | C...Energy and momentum fractions (only to be used in CM frame). | |
55486 | ELSEIF(J.LE.25) THEN | |
55487 | IF(J.EQ.20) PYP=2D0*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21) | |
55488 | IF(J.EQ.21) PYP=2D0*P(I,3)/PARU(21) | |
55489 | IF(J.EQ.22) PYP=2D0*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21) | |
55490 | IF(J.EQ.23) PYP=2D0*P(I,4)/PARU(21) | |
55491 | IF(J.EQ.24) PYP=(P(I,4)+P(I,3))/PARU(21) | |
55492 | IF(J.EQ.25) PYP=(P(I,4)-P(I,3))/PARU(21) | |
55493 | ENDIF | |
55494 | ||
55495 | RETURN | |
55496 | END | |
55497 | ||
55498 | C********************************************************************* | |
55499 | ||
55500 | C...PYSPHE | |
55501 | C...Performs sphericity tensor analysis to give sphericity, | |
55502 | C...aplanarity and the related event axes. | |
55503 | ||
55504 | SUBROUTINE PYSPHE(SPH,APL) | |
55505 | ||
55506 | C...Double precision and integer declarations. | |
55507 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
55508 | IMPLICIT INTEGER(I-N) | |
55509 | INTEGER PYK,PYCHGE,PYCOMP | |
55510 | C...Commonblocks. | |
55511 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
55512 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
55513 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
55514 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
55515 | C...Local arrays. | |
55516 | DIMENSION SM(3,3),SV(3,3) | |
55517 | ||
55518 | C...Calculate matrix to be diagonalized. | |
55519 | NP=0 | |
55520 | DO 110 J1=1,3 | |
55521 | DO 100 J2=J1,3 | |
55522 | SM(J1,J2)=0D0 | |
55523 | 100 CONTINUE | |
55524 | 110 CONTINUE | |
55525 | PS=0D0 | |
55526 | DO 140 I=1,N | |
55527 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140 | |
55528 | IF(MSTU(41).GE.2) THEN | |
55529 | KC=PYCOMP(K(I,2)) | |
55530 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
55531 | & KC.EQ.18) GOTO 140 | |
55532 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) | |
55533 | & GOTO 140 | |
55534 | ENDIF | |
55535 | NP=NP+1 | |
55536 | PA=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
55537 | PWT=1D0 | |
55538 | IF(ABS(PARU(41)-2D0).GT.0.001D0) PWT= | |
55539 | & MAX(1D-10,PA)**(PARU(41)-2D0) | |
55540 | DO 130 J1=1,3 | |
55541 | DO 120 J2=J1,3 | |
55542 | SM(J1,J2)=SM(J1,J2)+PWT*P(I,J1)*P(I,J2) | |
55543 | 120 CONTINUE | |
55544 | 130 CONTINUE | |
55545 | PS=PS+PWT*PA**2 | |
55546 | 140 CONTINUE | |
55547 | ||
55548 | C...Very low multiplicities (0 or 1) not considered. | |
55549 | IF(NP.LE.1) THEN | |
55550 | CALL PYERRM(8,'(PYSPHE:) too few particles for analysis') | |
55551 | SPH=-1D0 | |
55552 | APL=-1D0 | |
55553 | RETURN | |
55554 | ENDIF | |
55555 | DO 160 J1=1,3 | |
55556 | DO 150 J2=J1,3 | |
55557 | SM(J1,J2)=SM(J1,J2)/PS | |
55558 | 150 CONTINUE | |
55559 | 160 CONTINUE | |
55560 | ||
55561 | C...Find eigenvalues to matrix (third degree equation). | |
55562 | SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)- | |
55563 | &SM(1,2)**2-SM(1,3)**2-SM(2,3)**2)/3D0-1D0/9D0 | |
55564 | SR=-0.5D0*(SQ+1D0/9D0+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+ | |
55565 | &SM(3,3)*SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+ | |
55566 | &SM(1,2)*SM(1,3)*SM(2,3)+1D0/27D0 | |
55567 | SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1D0),-1D0))/3D0) | |
55568 | P(N+1,4)=1D0/3D0+SQRT(-SQ)*MAX(2D0*SP,SQRT(3D0*(1D0-SP**2))-SP) | |
55569 | P(N+3,4)=1D0/3D0+SQRT(-SQ)*MIN(2D0*SP,-SQRT(3D0*(1D0-SP**2))-SP) | |
55570 | P(N+2,4)=1D0-P(N+1,4)-P(N+3,4) | |
55571 | IF(P(N+2,4).LT.1D-5) THEN | |
55572 | CALL PYERRM(8,'(PYSPHE:) all particles back-to-back') | |
55573 | SPH=-1D0 | |
55574 | APL=-1D0 | |
55575 | RETURN | |
55576 | ENDIF | |
55577 | ||
55578 | C...Find first and last eigenvector by solving equation system. | |
55579 | DO 240 I=1,3,2 | |
55580 | DO 180 J1=1,3 | |
55581 | SV(J1,J1)=SM(J1,J1)-P(N+I,4) | |
55582 | DO 170 J2=J1+1,3 | |
55583 | SV(J1,J2)=SM(J1,J2) | |
55584 | SV(J2,J1)=SM(J1,J2) | |
55585 | 170 CONTINUE | |
55586 | 180 CONTINUE | |
55587 | SMAX=0D0 | |
55588 | DO 200 J1=1,3 | |
55589 | DO 190 J2=1,3 | |
55590 | IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 190 | |
55591 | JA=J1 | |
55592 | JB=J2 | |
55593 | SMAX=ABS(SV(J1,J2)) | |
55594 | 190 CONTINUE | |
55595 | 200 CONTINUE | |
55596 | SMAX=0D0 | |
55597 | DO 220 J3=JA+1,JA+2 | |
55598 | J1=J3-3*((J3-1)/3) | |
55599 | RL=SV(J1,JB)/SV(JA,JB) | |
55600 | DO 210 J2=1,3 | |
55601 | SV(J1,J2)=SV(J1,J2)-RL*SV(JA,J2) | |
55602 | IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 210 | |
55603 | JC=J1 | |
55604 | SMAX=ABS(SV(J1,J2)) | |
55605 | 210 CONTINUE | |
55606 | 220 CONTINUE | |
55607 | JB1=JB+1-3*(JB/3) | |
55608 | JB2=JB+2-3*((JB+1)/3) | |
55609 | P(N+I,JB1)=-SV(JC,JB2) | |
55610 | P(N+I,JB2)=SV(JC,JB1) | |
55611 | P(N+I,JB)=-(SV(JA,JB1)*P(N+I,JB1)+SV(JA,JB2)*P(N+I,JB2))/ | |
55612 | & SV(JA,JB) | |
55613 | PA=SQRT(P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2) | |
55614 | SGN=(-1D0)**INT(PYR(0)+0.5D0) | |
55615 | DO 230 J=1,3 | |
55616 | P(N+I,J)=SGN*P(N+I,J)/PA | |
55617 | 230 CONTINUE | |
55618 | 240 CONTINUE | |
55619 | ||
55620 | C...Middle axis orthogonal to other two. Fill other codes. | |
55621 | SGN=(-1D0)**INT(PYR(0)+0.5D0) | |
55622 | P(N+2,1)=SGN*(P(N+1,2)*P(N+3,3)-P(N+1,3)*P(N+3,2)) | |
55623 | P(N+2,2)=SGN*(P(N+1,3)*P(N+3,1)-P(N+1,1)*P(N+3,3)) | |
55624 | P(N+2,3)=SGN*(P(N+1,1)*P(N+3,2)-P(N+1,2)*P(N+3,1)) | |
55625 | DO 260 I=1,3 | |
55626 | K(N+I,1)=31 | |
55627 | K(N+I,2)=95 | |
55628 | K(N+I,3)=I | |
55629 | K(N+I,4)=0 | |
55630 | K(N+I,5)=0 | |
55631 | P(N+I,5)=0D0 | |
55632 | DO 250 J=1,5 | |
55633 | V(I,J)=0D0 | |
55634 | 250 CONTINUE | |
55635 | 260 CONTINUE | |
55636 | ||
55637 | C...Calculate sphericity and aplanarity. Select storing option. | |
55638 | SPH=1.5D0*(P(N+2,4)+P(N+3,4)) | |
55639 | APL=1.5D0*P(N+3,4) | |
55640 | MSTU(61)=N+1 | |
55641 | MSTU(62)=NP | |
55642 | IF(MSTU(43).LE.1) MSTU(3)=3 | |
55643 | IF(MSTU(43).GE.2) N=N+3 | |
55644 | ||
55645 | RETURN | |
55646 | END | |
55647 | ||
55648 | C********************************************************************* | |
55649 | ||
55650 | C...PYTHRU | |
55651 | C...Performs thrust analysis to give thrust, oblateness | |
55652 | C...and the related event axes. | |
55653 | ||
55654 | SUBROUTINE PYTHRU(THR,OBL) | |
55655 | ||
55656 | C...Double precision and integer declarations. | |
55657 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
55658 | IMPLICIT INTEGER(I-N) | |
55659 | INTEGER PYK,PYCHGE,PYCOMP | |
55660 | C...Commonblocks. | |
55661 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
55662 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
55663 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
55664 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
55665 | C...Local arrays. | |
55666 | DIMENSION TDI(3),TPR(3) | |
55667 | ||
55668 | C...Take copy of particles that are to be considered in thrust analysis. | |
55669 | NP=0 | |
55670 | PS=0D0 | |
55671 | DO 100 I=1,N | |
55672 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 | |
55673 | IF(MSTU(41).GE.2) THEN | |
55674 | KC=PYCOMP(K(I,2)) | |
55675 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
55676 | & KC.EQ.18) GOTO 100 | |
55677 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) | |
55678 | & GOTO 100 | |
55679 | ENDIF | |
55680 | IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN | |
55681 | CALL PYERRM(11,'(PYTHRU:) no more memory left in PYJETS') | |
55682 | THR=-2D0 | |
55683 | OBL=-2D0 | |
55684 | RETURN | |
55685 | ENDIF | |
55686 | NP=NP+1 | |
55687 | K(N+NP,1)=23 | |
55688 | P(N+NP,1)=P(I,1) | |
55689 | P(N+NP,2)=P(I,2) | |
55690 | P(N+NP,3)=P(I,3) | |
55691 | P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
55692 | P(N+NP,5)=1D0 | |
55693 | IF(ABS(PARU(42)-1D0).GT.0.001D0) P(N+NP,5)= | |
55694 | & P(N+NP,4)**(PARU(42)-1D0) | |
55695 | PS=PS+P(N+NP,4)*P(N+NP,5) | |
55696 | 100 CONTINUE | |
55697 | ||
55698 | C...Very low multiplicities (0 or 1) not considered. | |
55699 | IF(NP.LE.1) THEN | |
55700 | CALL PYERRM(8,'(PYTHRU:) too few particles for analysis') | |
55701 | THR=-1D0 | |
55702 | OBL=-1D0 | |
55703 | RETURN | |
55704 | ENDIF | |
55705 | ||
55706 | C...Loop over thrust and major. T axis along z direction in latter case. | |
55707 | DO 320 ILD=1,2 | |
55708 | IF(ILD.EQ.2) THEN | |
55709 | K(N+NP+1,1)=31 | |
55710 | PHI=PYANGL(P(N+NP+1,1),P(N+NP+1,2)) | |
55711 | MSTU(33)=1 | |
55712 | CALL PYROBO(N+1,N+NP+1,0D0,-PHI,0D0,0D0,0D0) | |
55713 | THE=PYANGL(P(N+NP+1,3),P(N+NP+1,1)) | |
55714 | CALL PYROBO(N+1,N+NP+1,-THE,0D0,0D0,0D0,0D0) | |
55715 | ENDIF | |
55716 | ||
55717 | C...Find and order particles with highest p (pT for major). | |
55718 | DO 110 ILF=N+NP+4,N+NP+MSTU(44)+4 | |
55719 | P(ILF,4)=0D0 | |
55720 | 110 CONTINUE | |
55721 | DO 160 I=N+1,N+NP | |
55722 | IF(ILD.EQ.2) P(I,4)=SQRT(P(I,1)**2+P(I,2)**2) | |
55723 | DO 130 ILF=N+NP+MSTU(44)+3,N+NP+4,-1 | |
55724 | IF(P(I,4).LE.P(ILF,4)) GOTO 140 | |
55725 | DO 120 J=1,5 | |
55726 | P(ILF+1,J)=P(ILF,J) | |
55727 | 120 CONTINUE | |
55728 | 130 CONTINUE | |
55729 | ILF=N+NP+3 | |
55730 | 140 DO 150 J=1,5 | |
55731 | P(ILF+1,J)=P(I,J) | |
55732 | 150 CONTINUE | |
55733 | 160 CONTINUE | |
55734 | ||
55735 | C...Find and order initial axes with highest thrust (major). | |
55736 | DO 170 ILG=N+NP+MSTU(44)+5,N+NP+MSTU(44)+15 | |
55737 | P(ILG,4)=0D0 | |
55738 | 170 CONTINUE | |
55739 | NC=2**(MIN(MSTU(44),NP)-1) | |
55740 | DO 250 ILC=1,NC | |
55741 | DO 180 J=1,3 | |
55742 | TDI(J)=0D0 | |
55743 | 180 CONTINUE | |
55744 | DO 200 ILF=1,MIN(MSTU(44),NP) | |
55745 | SGN=P(N+NP+ILF+3,5) | |
55746 | IF(2**ILF*((ILC+2**(ILF-1)-1)/2**ILF).GE.ILC) SGN=-SGN | |
55747 | DO 190 J=1,4-ILD | |
55748 | TDI(J)=TDI(J)+SGN*P(N+NP+ILF+3,J) | |
55749 | 190 CONTINUE | |
55750 | 200 CONTINUE | |
55751 | TDS=TDI(1)**2+TDI(2)**2+TDI(3)**2 | |
55752 | DO 220 ILG=N+NP+MSTU(44)+MIN(ILC,10)+4,N+NP+MSTU(44)+5,-1 | |
55753 | IF(TDS.LE.P(ILG,4)) GOTO 230 | |
55754 | DO 210 J=1,4 | |
55755 | P(ILG+1,J)=P(ILG,J) | |
55756 | 210 CONTINUE | |
55757 | 220 CONTINUE | |
55758 | ILG=N+NP+MSTU(44)+4 | |
55759 | 230 DO 240 J=1,3 | |
55760 | P(ILG+1,J)=TDI(J) | |
55761 | 240 CONTINUE | |
55762 | P(ILG+1,4)=TDS | |
55763 | 250 CONTINUE | |
55764 | ||
55765 | C...Iterate direction of axis until stable maximum. | |
55766 | P(N+NP+ILD,4)=0D0 | |
55767 | ILG=0 | |
55768 | 260 ILG=ILG+1 | |
55769 | THP=0D0 | |
55770 | 270 THPS=THP | |
55771 | DO 280 J=1,3 | |
55772 | IF(THP.LE.1D-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J) | |
55773 | IF(THP.GT.1D-10) TDI(J)=TPR(J) | |
55774 | TPR(J)=0D0 | |
55775 | 280 CONTINUE | |
55776 | DO 300 I=N+1,N+NP | |
55777 | SGN=SIGN(P(I,5),TDI(1)*P(I,1)+TDI(2)*P(I,2)+TDI(3)*P(I,3)) | |
55778 | DO 290 J=1,4-ILD | |
55779 | TPR(J)=TPR(J)+SGN*P(I,J) | |
55780 | 290 CONTINUE | |
55781 | 300 CONTINUE | |
55782 | THP=SQRT(TPR(1)**2+TPR(2)**2+TPR(3)**2)/PS | |
55783 | IF(THP.GE.THPS+PARU(48)) GOTO 270 | |
55784 | ||
55785 | C...Save good axis. Try new initial axis until a number of tries agree. | |
55786 | IF(THP.LT.P(N+NP+ILD,4)-PARU(48).AND.ILG.LT.MIN(10,NC)) GOTO 260 | |
55787 | IF(THP.GT.P(N+NP+ILD,4)+PARU(48)) THEN | |
55788 | IAGR=0 | |
55789 | SGN=(-1D0)**INT(PYR(0)+0.5D0) | |
55790 | DO 310 J=1,3 | |
55791 | P(N+NP+ILD,J)=SGN*TPR(J)/(PS*THP) | |
55792 | 310 CONTINUE | |
55793 | P(N+NP+ILD,4)=THP | |
55794 | P(N+NP+ILD,5)=0D0 | |
55795 | ENDIF | |
55796 | IAGR=IAGR+1 | |
55797 | IF(IAGR.LT.MSTU(45).AND.ILG.LT.MIN(10,NC)) GOTO 260 | |
55798 | 320 CONTINUE | |
55799 | ||
55800 | C...Find minor axis and value by orthogonality. | |
55801 | SGN=(-1D0)**INT(PYR(0)+0.5D0) | |
55802 | P(N+NP+3,1)=-SGN*P(N+NP+2,2) | |
55803 | P(N+NP+3,2)=SGN*P(N+NP+2,1) | |
55804 | P(N+NP+3,3)=0D0 | |
55805 | THP=0D0 | |
55806 | DO 330 I=N+1,N+NP | |
55807 | THP=THP+P(I,5)*ABS(P(N+NP+3,1)*P(I,1)+P(N+NP+3,2)*P(I,2)) | |
55808 | 330 CONTINUE | |
55809 | P(N+NP+3,4)=THP/PS | |
55810 | P(N+NP+3,5)=0D0 | |
55811 | ||
55812 | C...Fill axis information. Rotate back to original coordinate system. | |
55813 | DO 350 ILD=1,3 | |
55814 | K(N+ILD,1)=31 | |
55815 | K(N+ILD,2)=96 | |
55816 | K(N+ILD,3)=ILD | |
55817 | K(N+ILD,4)=0 | |
55818 | K(N+ILD,5)=0 | |
55819 | DO 340 J=1,5 | |
55820 | P(N+ILD,J)=P(N+NP+ILD,J) | |
55821 | V(N+ILD,J)=0D0 | |
55822 | 340 CONTINUE | |
55823 | 350 CONTINUE | |
55824 | CALL PYROBO(N+1,N+3,THE,PHI,0D0,0D0,0D0) | |
55825 | ||
55826 | C...Calculate thrust and oblateness. Select storing option. | |
55827 | THR=P(N+1,4) | |
55828 | OBL=P(N+2,4)-P(N+3,4) | |
55829 | MSTU(61)=N+1 | |
55830 | MSTU(62)=NP | |
55831 | IF(MSTU(43).LE.1) MSTU(3)=3 | |
55832 | IF(MSTU(43).GE.2) N=N+3 | |
55833 | ||
55834 | RETURN | |
55835 | END | |
55836 | ||
55837 | C********************************************************************* | |
55838 | ||
55839 | C...PYCLUS | |
55840 | C...Subdivides the particle content of an event into jets/clusters. | |
55841 | ||
55842 | SUBROUTINE PYCLUS(NJET) | |
55843 | ||
55844 | C...Double precision and integer declarations. | |
55845 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
55846 | IMPLICIT INTEGER(I-N) | |
55847 | INTEGER PYK,PYCHGE,PYCOMP | |
55848 | C...Commonblocks. | |
55849 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
55850 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
55851 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
55852 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
55853 | C...Local arrays and saved variables. | |
55854 | DIMENSION PS(5) | |
55855 | SAVE NSAV,NP,PS,PSS,RINIT,NPRE,NREM | |
55856 | ||
55857 | C...Functions: distance measure in pT, (pseudo)mass or Durham pT. | |
55858 | R2T(I1,I2)=(P(I1,5)*P(I2,5)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)- | |
55859 | &P(I1,3)*P(I2,3))*2D0*P(I1,5)*P(I2,5)/(0.0001D0+P(I1,5)+P(I2,5))**2 | |
55860 | R2M(I1,I2)=2D0*P(I1,4)*P(I2,4)*(1D0-(P(I1,1)*P(I2,1)+P(I1,2)* | |
55861 | &P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5))) | |
55862 | R2D(I1,I2)=2D0*MIN(P(I1,4),P(I2,4))**2*(1D0-(P(I1,1)*P(I2,1)+ | |
55863 | &P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5))) | |
55864 | ||
55865 | C...If first time, reset. If reentering, skip preliminaries. | |
55866 | IF(MSTU(48).LE.0) THEN | |
55867 | NP=0 | |
55868 | DO 100 J=1,5 | |
55869 | PS(J)=0D0 | |
55870 | 100 CONTINUE | |
55871 | PSS=0D0 | |
55872 | PIMASS=PMAS(PYCOMP(211),1) | |
55873 | ELSE | |
55874 | NJET=NSAV | |
55875 | IF(MSTU(43).GE.2) N=N-NJET | |
55876 | DO 110 I=N+1,N+NJET | |
55877 | P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
55878 | 110 CONTINUE | |
55879 | IF(MSTU(46).LE.3.OR.MSTU(46).EQ.5) THEN | |
55880 | R2ACC=PARU(44)**2 | |
55881 | ELSE | |
55882 | R2ACC=PARU(45)*PS(5)**2 | |
55883 | ENDIF | |
55884 | NLOOP=0 | |
55885 | GOTO 300 | |
55886 | ENDIF | |
55887 | ||
55888 | C...Find which particles are to be considered in cluster search. | |
55889 | DO 140 I=1,N | |
55890 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140 | |
55891 | IF(MSTU(41).GE.2) THEN | |
55892 | KC=PYCOMP(K(I,2)) | |
55893 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
55894 | & KC.EQ.18) GOTO 140 | |
55895 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) | |
55896 | & GOTO 140 | |
55897 | ENDIF | |
55898 | IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN | |
55899 | CALL PYERRM(11,'(PYCLUS:) no more memory left in PYJETS') | |
55900 | NJET=-1 | |
55901 | RETURN | |
55902 | ENDIF | |
55903 | ||
55904 | C...Take copy of these particles, with space left for jets later on. | |
55905 | NP=NP+1 | |
55906 | K(N+NP,3)=I | |
55907 | DO 120 J=1,5 | |
55908 | P(N+NP,J)=P(I,J) | |
55909 | 120 CONTINUE | |
55910 | IF(MSTU(42).EQ.0) P(N+NP,5)=0D0 | |
55911 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PIMASS | |
55912 | P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
55913 | P(N+NP,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
55914 | DO 130 J=1,4 | |
55915 | PS(J)=PS(J)+P(N+NP,J) | |
55916 | 130 CONTINUE | |
55917 | PSS=PSS+P(N+NP,5) | |
55918 | 140 CONTINUE | |
55919 | DO 160 I=N+1,N+NP | |
55920 | K(I+NP,3)=K(I,3) | |
55921 | DO 150 J=1,5 | |
55922 | P(I+NP,J)=P(I,J) | |
55923 | 150 CONTINUE | |
55924 | 160 CONTINUE | |
55925 | PS(5)=SQRT(MAX(0D0,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2)) | |
55926 | ||
55927 | C...Very low multiplicities not considered. | |
55928 | IF(NP.LT.MSTU(47)) THEN | |
55929 | CALL PYERRM(8,'(PYCLUS:) too few particles for analysis') | |
55930 | NJET=-1 | |
55931 | RETURN | |
55932 | ENDIF | |
55933 | ||
55934 | C...Find precluster configuration. If too few jets, make harder cuts. | |
55935 | NLOOP=0 | |
55936 | IF(MSTU(46).LE.3.OR.MSTU(46).EQ.5) THEN | |
55937 | R2ACC=PARU(44)**2 | |
55938 | ELSE | |
55939 | R2ACC=PARU(45)*PS(5)**2 | |
55940 | ENDIF | |
55941 | RINIT=1.25D0*PARU(43) | |
55942 | IF(NP.LE.MSTU(47)+2) RINIT=0D0 | |
55943 | 170 RINIT=0.8D0*RINIT | |
55944 | NPRE=0 | |
55945 | NREM=NP | |
55946 | DO 180 I=N+NP+1,N+2*NP | |
55947 | K(I,4)=0 | |
55948 | 180 CONTINUE | |
55949 | ||
55950 | C...Sum up small momentum region. Jet if enough absolute momentum. | |
55951 | IF(MSTU(46).LE.2) THEN | |
55952 | DO 190 J=1,4 | |
55953 | P(N+1,J)=0D0 | |
55954 | 190 CONTINUE | |
55955 | DO 210 I=N+NP+1,N+2*NP | |
55956 | IF(P(I,5).GT.2D0*RINIT) GOTO 210 | |
55957 | NREM=NREM-1 | |
55958 | K(I,4)=1 | |
55959 | DO 200 J=1,4 | |
55960 | P(N+1,J)=P(N+1,J)+P(I,J) | |
55961 | 200 CONTINUE | |
55962 | 210 CONTINUE | |
55963 | P(N+1,5)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2) | |
55964 | IF(P(N+1,5).GT.2D0*RINIT) NPRE=1 | |
55965 | IF(RINIT.GE.0.2D0*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170 | |
55966 | IF(NREM.EQ.0) GOTO 170 | |
55967 | ENDIF | |
55968 | ||
55969 | C...Find fastest remaining particle. | |
55970 | 220 NPRE=NPRE+1 | |
55971 | PMAX=0D0 | |
55972 | DO 230 I=N+NP+1,N+2*NP | |
55973 | IF(K(I,4).NE.0.OR.P(I,5).LE.PMAX) GOTO 230 | |
55974 | IMAX=I | |
55975 | PMAX=P(I,5) | |
55976 | 230 CONTINUE | |
55977 | DO 240 J=1,5 | |
55978 | P(N+NPRE,J)=P(IMAX,J) | |
55979 | 240 CONTINUE | |
55980 | NREM=NREM-1 | |
55981 | K(IMAX,4)=NPRE | |
55982 | ||
55983 | C...Sum up precluster around it according to pT separation. | |
55984 | IF(MSTU(46).LE.2) THEN | |
55985 | DO 260 I=N+NP+1,N+2*NP | |
55986 | IF(K(I,4).NE.0) GOTO 260 | |
55987 | R2=R2T(I,IMAX) | |
55988 | IF(R2.GT.RINIT**2) GOTO 260 | |
55989 | NREM=NREM-1 | |
55990 | K(I,4)=NPRE | |
55991 | DO 250 J=1,4 | |
55992 | P(N+NPRE,J)=P(N+NPRE,J)+P(I,J) | |
55993 | 250 CONTINUE | |
55994 | 260 CONTINUE | |
55995 | P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2) | |
55996 | ||
55997 | C...Sum up precluster around it according to mass or | |
55998 | C...Durham pT separation. | |
55999 | ELSE | |
56000 | 270 IMIN=0 | |
56001 | R2MIN=RINIT**2 | |
56002 | DO 280 I=N+NP+1,N+2*NP | |
56003 | IF(K(I,4).NE.0) GOTO 280 | |
56004 | IF(MSTU(46).LE.4) THEN | |
56005 | R2=R2M(I,N+NPRE) | |
56006 | ELSE | |
56007 | R2=R2D(I,N+NPRE) | |
56008 | ENDIF | |
56009 | IF(R2.GE.R2MIN) GOTO 280 | |
56010 | IMIN=I | |
56011 | R2MIN=R2 | |
56012 | 280 CONTINUE | |
56013 | IF(IMIN.NE.0) THEN | |
56014 | DO 290 J=1,4 | |
56015 | P(N+NPRE,J)=P(N+NPRE,J)+P(IMIN,J) | |
56016 | 290 CONTINUE | |
56017 | P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2) | |
56018 | NREM=NREM-1 | |
56019 | K(IMIN,4)=NPRE | |
56020 | GOTO 270 | |
56021 | ENDIF | |
56022 | ENDIF | |
56023 | ||
56024 | C...Check if more preclusters to be found. Start over if too few. | |
56025 | IF(RINIT.GE.0.2D0*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170 | |
56026 | IF(NREM.GT.0) GOTO 220 | |
56027 | NJET=NPRE | |
56028 | ||
56029 | C...Reassign all particles to nearest jet. Sum up new jet momenta. | |
56030 | 300 TSAV=0D0 | |
56031 | PSJT=0D0 | |
56032 | 310 IF(MSTU(46).LE.1) THEN | |
56033 | DO 330 I=N+1,N+NJET | |
56034 | DO 320 J=1,4 | |
56035 | V(I,J)=0D0 | |
56036 | 320 CONTINUE | |
56037 | 330 CONTINUE | |
56038 | DO 360 I=N+NP+1,N+2*NP | |
56039 | R2MIN=PSS**2 | |
56040 | DO 340 IJET=N+1,N+NJET | |
56041 | IF(P(IJET,5).LT.RINIT) GOTO 340 | |
56042 | R2=R2T(I,IJET) | |
56043 | IF(R2.GE.R2MIN) GOTO 340 | |
56044 | IMIN=IJET | |
56045 | R2MIN=R2 | |
56046 | 340 CONTINUE | |
56047 | K(I,4)=IMIN-N | |
56048 | DO 350 J=1,4 | |
56049 | V(IMIN,J)=V(IMIN,J)+P(I,J) | |
56050 | 350 CONTINUE | |
56051 | 360 CONTINUE | |
56052 | PSJT=0D0 | |
56053 | DO 380 I=N+1,N+NJET | |
56054 | DO 370 J=1,4 | |
56055 | P(I,J)=V(I,J) | |
56056 | 370 CONTINUE | |
56057 | P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
56058 | PSJT=PSJT+P(I,5) | |
56059 | 380 CONTINUE | |
56060 | ENDIF | |
56061 | ||
56062 | C...Find two closest jets. | |
56063 | R2MIN=2D0*MAX(R2ACC,PS(5)**2) | |
56064 | DO 400 ITRY1=N+1,N+NJET-1 | |
56065 | DO 390 ITRY2=ITRY1+1,N+NJET | |
56066 | IF(MSTU(46).LE.2) THEN | |
56067 | R2=R2T(ITRY1,ITRY2) | |
56068 | ELSEIF(MSTU(46).LE.4) THEN | |
56069 | R2=R2M(ITRY1,ITRY2) | |
56070 | ELSE | |
56071 | R2=R2D(ITRY1,ITRY2) | |
56072 | ENDIF | |
56073 | IF(R2.GE.R2MIN) GOTO 390 | |
56074 | IMIN1=ITRY1 | |
56075 | IMIN2=ITRY2 | |
56076 | R2MIN=R2 | |
56077 | 390 CONTINUE | |
56078 | 400 CONTINUE | |
56079 | ||
56080 | C...If allowed, join two closest jets and start over. | |
56081 | IF(NJET.GT.MSTU(47).AND.R2MIN.LT.R2ACC) THEN | |
56082 | IREC=MIN(IMIN1,IMIN2) | |
56083 | IDEL=MAX(IMIN1,IMIN2) | |
56084 | DO 410 J=1,4 | |
56085 | P(IREC,J)=P(IMIN1,J)+P(IMIN2,J) | |
56086 | 410 CONTINUE | |
56087 | P(IREC,5)=SQRT(P(IREC,1)**2+P(IREC,2)**2+P(IREC,3)**2) | |
56088 | DO 430 I=IDEL+1,N+NJET | |
56089 | DO 420 J=1,5 | |
56090 | P(I-1,J)=P(I,J) | |
56091 | 420 CONTINUE | |
56092 | 430 CONTINUE | |
56093 | IF(MSTU(46).GE.2) THEN | |
56094 | DO 440 I=N+NP+1,N+2*NP | |
56095 | IORI=N+K(I,4) | |
56096 | IF(IORI.EQ.IDEL) K(I,4)=IREC-N | |
56097 | IF(IORI.GT.IDEL) K(I,4)=K(I,4)-1 | |
56098 | 440 CONTINUE | |
56099 | ENDIF | |
56100 | NJET=NJET-1 | |
56101 | GOTO 300 | |
56102 | ||
56103 | C...Divide up broad jet if empty cluster in list of final ones. | |
56104 | ELSEIF(NJET.EQ.MSTU(47).AND.MSTU(46).LE.1.AND.NLOOP.LE.2) THEN | |
56105 | DO 450 I=N+1,N+NJET | |
56106 | K(I,5)=0 | |
56107 | 450 CONTINUE | |
56108 | DO 460 I=N+NP+1,N+2*NP | |
56109 | K(N+K(I,4),5)=K(N+K(I,4),5)+1 | |
56110 | 460 CONTINUE | |
56111 | IEMP=0 | |
56112 | DO 470 I=N+1,N+NJET | |
56113 | IF(K(I,5).EQ.0) IEMP=I | |
56114 | 470 CONTINUE | |
56115 | IF(IEMP.NE.0) THEN | |
56116 | NLOOP=NLOOP+1 | |
56117 | ISPL=0 | |
56118 | R2MAX=0D0 | |
56119 | DO 480 I=N+NP+1,N+2*NP | |
56120 | IF(K(N+K(I,4),5).LE.1.OR.P(I,5).LT.RINIT) GOTO 480 | |
56121 | IJET=N+K(I,4) | |
56122 | R2=R2T(I,IJET) | |
56123 | IF(R2.LE.R2MAX) GOTO 480 | |
56124 | ISPL=I | |
56125 | R2MAX=R2 | |
56126 | 480 CONTINUE | |
56127 | IF(ISPL.NE.0) THEN | |
56128 | IJET=N+K(ISPL,4) | |
56129 | DO 490 J=1,4 | |
56130 | P(IEMP,J)=P(ISPL,J) | |
56131 | P(IJET,J)=P(IJET,J)-P(ISPL,J) | |
56132 | 490 CONTINUE | |
56133 | P(IEMP,5)=P(ISPL,5) | |
56134 | P(IJET,5)=SQRT(P(IJET,1)**2+P(IJET,2)**2+P(IJET,3)**2) | |
56135 | IF(NLOOP.LE.2) GOTO 300 | |
56136 | ENDIF | |
56137 | ENDIF | |
56138 | ENDIF | |
56139 | ||
56140 | C...If generalized thrust has not yet converged, continue iteration. | |
56141 | IF(MSTU(46).LE.1.AND.NLOOP.LE.2.AND.PSJT/PSS.GT.TSAV+PARU(48)) | |
56142 | &THEN | |
56143 | TSAV=PSJT/PSS | |
56144 | GOTO 310 | |
56145 | ENDIF | |
56146 | ||
56147 | C...Reorder jets according to energy. | |
56148 | DO 510 I=N+1,N+NJET | |
56149 | DO 500 J=1,5 | |
56150 | V(I,J)=P(I,J) | |
56151 | 500 CONTINUE | |
56152 | 510 CONTINUE | |
56153 | DO 540 INEW=N+1,N+NJET | |
56154 | PEMAX=0D0 | |
56155 | DO 520 ITRY=N+1,N+NJET | |
56156 | IF(V(ITRY,4).LE.PEMAX) GOTO 520 | |
56157 | IMAX=ITRY | |
56158 | PEMAX=V(ITRY,4) | |
56159 | 520 CONTINUE | |
56160 | K(INEW,1)=31 | |
56161 | K(INEW,2)=97 | |
56162 | K(INEW,3)=INEW-N | |
56163 | K(INEW,4)=0 | |
56164 | DO 530 J=1,5 | |
56165 | P(INEW,J)=V(IMAX,J) | |
56166 | 530 CONTINUE | |
56167 | V(IMAX,4)=-1D0 | |
56168 | K(IMAX,5)=INEW | |
56169 | 540 CONTINUE | |
56170 | ||
56171 | C...Clean up particle-jet assignments and jet information. | |
56172 | DO 550 I=N+NP+1,N+2*NP | |
56173 | IORI=K(N+K(I,4),5) | |
56174 | K(I,4)=IORI-N | |
56175 | IF(K(K(I,3),1).NE.3) K(K(I,3),4)=IORI-N | |
56176 | K(IORI,4)=K(IORI,4)+1 | |
56177 | 550 CONTINUE | |
56178 | IEMP=0 | |
56179 | PSJT=0D0 | |
56180 | DO 570 I=N+1,N+NJET | |
56181 | K(I,5)=0 | |
56182 | PSJT=PSJT+P(I,5) | |
56183 | P(I,5)=SQRT(MAX(P(I,4)**2-P(I,5)**2,0D0)) | |
56184 | DO 560 J=1,5 | |
56185 | V(I,J)=0D0 | |
56186 | 560 CONTINUE | |
56187 | IF(K(I,4).EQ.0) IEMP=I | |
56188 | 570 CONTINUE | |
56189 | ||
56190 | C...Select storing option. Output variables. Check for failure. | |
56191 | MSTU(61)=N+1 | |
56192 | MSTU(62)=NP | |
56193 | MSTU(63)=NPRE | |
56194 | PARU(61)=PS(5) | |
56195 | PARU(62)=PSJT/PSS | |
56196 | PARU(63)=SQRT(R2MIN) | |
56197 | IF(NJET.LE.1) PARU(63)=0D0 | |
56198 | IF(IEMP.NE.0) THEN | |
56199 | CALL PYERRM(8,'(PYCLUS:) failed to reconstruct as requested') | |
56200 | NJET=-1 | |
56201 | RETURN | |
56202 | ENDIF | |
56203 | IF(MSTU(43).LE.1) MSTU(3)=MAX(0,NJET) | |
56204 | IF(MSTU(43).GE.2) N=N+MAX(0,NJET) | |
56205 | NSAV=NJET | |
56206 | ||
56207 | RETURN | |
56208 | END | |
56209 | ||
56210 | C********************************************************************* | |
56211 | ||
56212 | C...PYCELL | |
56213 | C...Provides a simple way of jet finding in eta-phi-ET coordinates, | |
56214 | C...as used for calorimeters at hadron colliders. | |
56215 | ||
56216 | SUBROUTINE PYCELL(NJET) | |
56217 | ||
56218 | C...Double precision and integer declarations. | |
56219 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
56220 | IMPLICIT INTEGER(I-N) | |
56221 | INTEGER PYK,PYCHGE,PYCOMP | |
56222 | C...Commonblocks. | |
56223 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
56224 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
56225 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
56226 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
56227 | ||
56228 | C...Loop over all particles. Find cell that was hit by given particle. | |
56229 | PTLRAT=1D0/SINH(PARU(51))**2 | |
56230 | NP=0 | |
56231 | NC=N | |
56232 | DO 110 I=1,N | |
56233 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110 | |
56234 | IF(P(I,1)**2+P(I,2)**2.LE.PTLRAT*P(I,3)**2) GOTO 110 | |
56235 | IF(MSTU(41).GE.2) THEN | |
56236 | KC=PYCOMP(K(I,2)) | |
56237 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
56238 | & KC.EQ.18) GOTO 110 | |
56239 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) | |
56240 | & GOTO 110 | |
56241 | ENDIF | |
56242 | NP=NP+1 | |
56243 | PT=SQRT(P(I,1)**2+P(I,2)**2) | |
56244 | ETA=SIGN(LOG((SQRT(PT**2+P(I,3)**2)+ABS(P(I,3)))/PT),P(I,3)) | |
56245 | IETA=MAX(1,MIN(MSTU(51),1+INT(MSTU(51)*0.5D0* | |
56246 | & (ETA/PARU(51)+1D0)))) | |
56247 | PHI=PYANGL(P(I,1),P(I,2)) | |
56248 | IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5D0* | |
56249 | & (PHI/PARU(1)+1D0)))) | |
56250 | IETPH=MSTU(52)*IETA+IPHI | |
56251 | ||
56252 | C...Add to cell already hit, or book new cell. | |
56253 | DO 100 IC=N+1,NC | |
56254 | IF(IETPH.EQ.K(IC,3)) THEN | |
56255 | K(IC,4)=K(IC,4)+1 | |
56256 | P(IC,5)=P(IC,5)+PT | |
56257 | GOTO 110 | |
56258 | ENDIF | |
56259 | 100 CONTINUE | |
56260 | IF(NC.GE.MSTU(4)-MSTU(32)-5) THEN | |
56261 | CALL PYERRM(11,'(PYCELL:) no more memory left in PYJETS') | |
56262 | NJET=-2 | |
56263 | RETURN | |
56264 | ENDIF | |
56265 | NC=NC+1 | |
56266 | K(NC,3)=IETPH | |
56267 | K(NC,4)=1 | |
56268 | K(NC,5)=2 | |
56269 | P(NC,1)=(PARU(51)/MSTU(51))*(2*IETA-1-MSTU(51)) | |
56270 | P(NC,2)=(PARU(1)/MSTU(52))*(2*IPHI-1-MSTU(52)) | |
56271 | P(NC,5)=PT | |
56272 | 110 CONTINUE | |
56273 | ||
56274 | C...Smear true bin content by calorimeter resolution. | |
56275 | IF(MSTU(53).GE.1) THEN | |
56276 | DO 130 IC=N+1,NC | |
56277 | PEI=P(IC,5) | |
56278 | IF(MSTU(53).EQ.2) PEI=P(IC,5)*COSH(P(IC,1)) | |
56279 | 120 PEF=PEI+PARU(55)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0)))*PEI)* | |
56280 | & COS(PARU(2)*PYR(0)) | |
56281 | IF(PEF.LT.0D0.OR.PEF.GT.PARU(56)*PEI) GOTO 120 | |
56282 | P(IC,5)=PEF | |
56283 | IF(MSTU(53).EQ.2) P(IC,5)=PEF/COSH(P(IC,1)) | |
56284 | 130 CONTINUE | |
56285 | ENDIF | |
56286 | ||
56287 | C...Remove cells below threshold. | |
56288 | IF(PARU(58).GT.0D0) THEN | |
56289 | NCC=NC | |
56290 | NC=N | |
56291 | DO 140 IC=N+1,NCC | |
56292 | IF(P(IC,5).GT.PARU(58)) THEN | |
56293 | NC=NC+1 | |
56294 | K(NC,3)=K(IC,3) | |
56295 | K(NC,4)=K(IC,4) | |
56296 | K(NC,5)=K(IC,5) | |
56297 | P(NC,1)=P(IC,1) | |
56298 | P(NC,2)=P(IC,2) | |
56299 | P(NC,5)=P(IC,5) | |
56300 | ENDIF | |
56301 | 140 CONTINUE | |
56302 | ENDIF | |
56303 | ||
56304 | C...Find initiator cell: the one with highest pT of not yet used ones. | |
56305 | NJ=NC | |
56306 | 150 ETMAX=0D0 | |
56307 | DO 160 IC=N+1,NC | |
56308 | IF(K(IC,5).NE.2) GOTO 160 | |
56309 | IF(P(IC,5).LE.ETMAX) GOTO 160 | |
56310 | ICMAX=IC | |
56311 | ETA=P(IC,1) | |
56312 | PHI=P(IC,2) | |
56313 | ETMAX=P(IC,5) | |
56314 | 160 CONTINUE | |
56315 | IF(ETMAX.LT.PARU(52)) GOTO 220 | |
56316 | IF(NJ.GE.MSTU(4)-MSTU(32)-5) THEN | |
56317 | CALL PYERRM(11,'(PYCELL:) no more memory left in PYJETS') | |
56318 | NJET=-2 | |
56319 | RETURN | |
56320 | ENDIF | |
56321 | K(ICMAX,5)=1 | |
56322 | NJ=NJ+1 | |
56323 | K(NJ,4)=0 | |
56324 | K(NJ,5)=1 | |
56325 | P(NJ,1)=ETA | |
56326 | P(NJ,2)=PHI | |
56327 | P(NJ,3)=0D0 | |
56328 | P(NJ,4)=0D0 | |
56329 | P(NJ,5)=0D0 | |
56330 | ||
56331 | C...Sum up unused cells within required distance of initiator. | |
56332 | DO 170 IC=N+1,NC | |
56333 | IF(K(IC,5).EQ.0) GOTO 170 | |
56334 | IF(ABS(P(IC,1)-ETA).GT.PARU(54)) GOTO 170 | |
56335 | DPHIA=ABS(P(IC,2)-PHI) | |
56336 | IF(DPHIA.GT.PARU(54).AND.DPHIA.LT.PARU(2)-PARU(54)) GOTO 170 | |
56337 | PHIC=P(IC,2) | |
56338 | IF(DPHIA.GT.PARU(1)) PHIC=PHIC+SIGN(PARU(2),PHI) | |
56339 | IF((P(IC,1)-ETA)**2+(PHIC-PHI)**2.GT.PARU(54)**2) GOTO 170 | |
56340 | K(IC,5)=-K(IC,5) | |
56341 | K(NJ,4)=K(NJ,4)+K(IC,4) | |
56342 | P(NJ,3)=P(NJ,3)+P(IC,5)*P(IC,1) | |
56343 | P(NJ,4)=P(NJ,4)+P(IC,5)*PHIC | |
56344 | P(NJ,5)=P(NJ,5)+P(IC,5) | |
56345 | 170 CONTINUE | |
56346 | ||
56347 | C...Reject cluster below minimum ET, else accept. | |
56348 | IF(P(NJ,5).LT.PARU(53)) THEN | |
56349 | NJ=NJ-1 | |
56350 | DO 180 IC=N+1,NC | |
56351 | IF(K(IC,5).LT.0) K(IC,5)=-K(IC,5) | |
56352 | 180 CONTINUE | |
56353 | ELSEIF(MSTU(54).LE.2) THEN | |
56354 | P(NJ,3)=P(NJ,3)/P(NJ,5) | |
56355 | P(NJ,4)=P(NJ,4)/P(NJ,5) | |
56356 | IF(ABS(P(NJ,4)).GT.PARU(1)) P(NJ,4)=P(NJ,4)-SIGN(PARU(2), | |
56357 | & P(NJ,4)) | |
56358 | DO 190 IC=N+1,NC | |
56359 | IF(K(IC,5).LT.0) K(IC,5)=0 | |
56360 | 190 CONTINUE | |
56361 | ELSE | |
56362 | DO 200 J=1,4 | |
56363 | P(NJ,J)=0D0 | |
56364 | 200 CONTINUE | |
56365 | DO 210 IC=N+1,NC | |
56366 | IF(K(IC,5).GE.0) GOTO 210 | |
56367 | P(NJ,1)=P(NJ,1)+P(IC,5)*COS(P(IC,2)) | |
56368 | P(NJ,2)=P(NJ,2)+P(IC,5)*SIN(P(IC,2)) | |
56369 | P(NJ,3)=P(NJ,3)+P(IC,5)*SINH(P(IC,1)) | |
56370 | P(NJ,4)=P(NJ,4)+P(IC,5)*COSH(P(IC,1)) | |
56371 | K(IC,5)=0 | |
56372 | 210 CONTINUE | |
56373 | ENDIF | |
56374 | GOTO 150 | |
56375 | ||
56376 | C...Arrange clusters in falling ET sequence. | |
56377 | 220 DO 250 I=1,NJ-NC | |
56378 | ETMAX=0D0 | |
56379 | DO 230 IJ=NC+1,NJ | |
56380 | IF(K(IJ,5).EQ.0) GOTO 230 | |
56381 | IF(P(IJ,5).LT.ETMAX) GOTO 230 | |
56382 | IJMAX=IJ | |
56383 | ETMAX=P(IJ,5) | |
56384 | 230 CONTINUE | |
56385 | K(IJMAX,5)=0 | |
56386 | K(N+I,1)=31 | |
56387 | K(N+I,2)=98 | |
56388 | K(N+I,3)=I | |
56389 | K(N+I,4)=K(IJMAX,4) | |
56390 | K(N+I,5)=0 | |
56391 | DO 240 J=1,5 | |
56392 | P(N+I,J)=P(IJMAX,J) | |
56393 | V(N+I,J)=0D0 | |
56394 | 240 CONTINUE | |
56395 | 250 CONTINUE | |
56396 | NJET=NJ-NC | |
56397 | ||
56398 | C...Convert to massless or massive four-vectors. | |
56399 | IF(MSTU(54).EQ.2) THEN | |
56400 | DO 260 I=N+1,N+NJET | |
56401 | ETA=P(I,3) | |
56402 | P(I,1)=P(I,5)*COS(P(I,4)) | |
56403 | P(I,2)=P(I,5)*SIN(P(I,4)) | |
56404 | P(I,3)=P(I,5)*SINH(ETA) | |
56405 | P(I,4)=P(I,5)*COSH(ETA) | |
56406 | P(I,5)=0D0 | |
56407 | 260 CONTINUE | |
56408 | ELSEIF(MSTU(54).GE.3) THEN | |
56409 | DO 270 I=N+1,N+NJET | |
56410 | P(I,5)=SQRT(MAX(0D0,P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2)) | |
56411 | 270 CONTINUE | |
56412 | ENDIF | |
56413 | ||
56414 | C...Information about storage. | |
56415 | MSTU(61)=N+1 | |
56416 | MSTU(62)=NP | |
56417 | MSTU(63)=NC-N | |
56418 | IF(MSTU(43).LE.1) MSTU(3)=MAX(0,NJET) | |
56419 | IF(MSTU(43).GE.2) N=N+MAX(0,NJET) | |
56420 | ||
56421 | RETURN | |
56422 | END | |
56423 | ||
56424 | C********************************************************************* | |
56425 | ||
56426 | C...PYJMAS | |
56427 | C...Determines, approximately, the two jet masses that minimize | |
56428 | C...the sum m_H^2 + m_L^2, a la Clavelli and Wyler. | |
56429 | ||
56430 | SUBROUTINE PYJMAS(PMH,PML) | |
56431 | ||
56432 | C...Double precision and integer declarations. | |
56433 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
56434 | IMPLICIT INTEGER(I-N) | |
56435 | INTEGER PYK,PYCHGE,PYCOMP | |
56436 | C...Commonblocks. | |
56437 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
56438 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
56439 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
56440 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
56441 | C...Local arrays. | |
56442 | DIMENSION SM(3,3),SAX(3),PS(3,5) | |
56443 | ||
56444 | C...Reset. | |
56445 | NP=0 | |
56446 | DO 120 J1=1,3 | |
56447 | DO 100 J2=J1,3 | |
56448 | SM(J1,J2)=0D0 | |
56449 | 100 CONTINUE | |
56450 | DO 110 J2=1,4 | |
56451 | PS(J1,J2)=0D0 | |
56452 | 110 CONTINUE | |
56453 | 120 CONTINUE | |
56454 | PSS=0D0 | |
56455 | PIMASS=PMAS(PYCOMP(211),1) | |
56456 | ||
56457 | C...Take copy of particles that are to be considered in mass analysis. | |
56458 | DO 170 I=1,N | |
56459 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170 | |
56460 | IF(MSTU(41).GE.2) THEN | |
56461 | KC=PYCOMP(K(I,2)) | |
56462 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
56463 | & KC.EQ.18) GOTO 170 | |
56464 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) | |
56465 | & GOTO 170 | |
56466 | ENDIF | |
56467 | IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN | |
56468 | CALL PYERRM(11,'(PYJMAS:) no more memory left in PYJETS') | |
56469 | PMH=-2D0 | |
56470 | PML=-2D0 | |
56471 | RETURN | |
56472 | ENDIF | |
56473 | NP=NP+1 | |
56474 | DO 130 J=1,5 | |
56475 | P(N+NP,J)=P(I,J) | |
56476 | 130 CONTINUE | |
56477 | IF(MSTU(42).EQ.0) P(N+NP,5)=0D0 | |
56478 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PIMASS | |
56479 | P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
56480 | ||
56481 | C...Fill information in sphericity tensor and total momentum vector. | |
56482 | DO 150 J1=1,3 | |
56483 | DO 140 J2=J1,3 | |
56484 | SM(J1,J2)=SM(J1,J2)+P(I,J1)*P(I,J2) | |
56485 | 140 CONTINUE | |
56486 | 150 CONTINUE | |
56487 | PSS=PSS+(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
56488 | DO 160 J=1,4 | |
56489 | PS(3,J)=PS(3,J)+P(N+NP,J) | |
56490 | 160 CONTINUE | |
56491 | 170 CONTINUE | |
56492 | ||
56493 | C...Very low multiplicities (0 or 1) not considered. | |
56494 | IF(NP.LE.1) THEN | |
56495 | CALL PYERRM(8,'(PYJMAS:) too few particles for analysis') | |
56496 | PMH=-1D0 | |
56497 | PML=-1D0 | |
56498 | RETURN | |
56499 | ENDIF | |
56500 | PARU(61)=SQRT(MAX(0D0,PS(3,4)**2-PS(3,1)**2-PS(3,2)**2- | |
56501 | &PS(3,3)**2)) | |
56502 | ||
56503 | C...Find largest eigenvalue to matrix (third degree equation). | |
56504 | DO 190 J1=1,3 | |
56505 | DO 180 J2=J1,3 | |
56506 | SM(J1,J2)=SM(J1,J2)/PSS | |
56507 | 180 CONTINUE | |
56508 | 190 CONTINUE | |
56509 | SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)- | |
56510 | &SM(1,2)**2-SM(1,3)**2-SM(2,3)**2)/3D0-1D0/9D0 | |
56511 | SR=-0.5D0*(SQ+1D0/9D0+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+ | |
56512 | &SM(3,3)*SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+ | |
56513 | &SM(1,2)*SM(1,3)*SM(2,3)+1D0/27D0 | |
56514 | SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1D0),-1D0))/3D0) | |
56515 | SMA=1D0/3D0+SQRT(-SQ)*MAX(2D0*SP,SQRT(3D0*(1D0-SP**2))-SP) | |
56516 | ||
56517 | C...Find largest eigenvector by solving equation system. | |
56518 | DO 210 J1=1,3 | |
56519 | SM(J1,J1)=SM(J1,J1)-SMA | |
56520 | DO 200 J2=J1+1,3 | |
56521 | SM(J2,J1)=SM(J1,J2) | |
56522 | 200 CONTINUE | |
56523 | 210 CONTINUE | |
56524 | SMAX=0D0 | |
56525 | DO 230 J1=1,3 | |
56526 | DO 220 J2=1,3 | |
56527 | IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 220 | |
56528 | JA=J1 | |
56529 | JB=J2 | |
56530 | SMAX=ABS(SM(J1,J2)) | |
56531 | 220 CONTINUE | |
56532 | 230 CONTINUE | |
56533 | SMAX=0D0 | |
56534 | DO 250 J3=JA+1,JA+2 | |
56535 | J1=J3-3*((J3-1)/3) | |
56536 | RL=SM(J1,JB)/SM(JA,JB) | |
56537 | DO 240 J2=1,3 | |
56538 | SM(J1,J2)=SM(J1,J2)-RL*SM(JA,J2) | |
56539 | IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 240 | |
56540 | JC=J1 | |
56541 | SMAX=ABS(SM(J1,J2)) | |
56542 | 240 CONTINUE | |
56543 | 250 CONTINUE | |
56544 | JB1=JB+1-3*(JB/3) | |
56545 | JB2=JB+2-3*((JB+1)/3) | |
56546 | SAX(JB1)=-SM(JC,JB2) | |
56547 | SAX(JB2)=SM(JC,JB1) | |
56548 | SAX(JB)=-(SM(JA,JB1)*SAX(JB1)+SM(JA,JB2)*SAX(JB2))/SM(JA,JB) | |
56549 | ||
56550 | C...Divide particles into two initial clusters by hemisphere. | |
56551 | DO 270 I=N+1,N+NP | |
56552 | PSAX=P(I,1)*SAX(1)+P(I,2)*SAX(2)+P(I,3)*SAX(3) | |
56553 | IS=1 | |
56554 | IF(PSAX.LT.0D0) IS=2 | |
56555 | K(I,3)=IS | |
56556 | DO 260 J=1,4 | |
56557 | PS(IS,J)=PS(IS,J)+P(I,J) | |
56558 | 260 CONTINUE | |
56559 | 270 CONTINUE | |
56560 | PMS=MAX(1D-10,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+ | |
56561 | &MAX(1D-10,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2) | |
56562 | ||
56563 | C...Reassign one particle at a time; find maximum decrease of m^2 sum. | |
56564 | 280 PMD=0D0 | |
56565 | IM=0 | |
56566 | DO 290 J=1,4 | |
56567 | PS(3,J)=PS(1,J)-PS(2,J) | |
56568 | 290 CONTINUE | |
56569 | DO 300 I=N+1,N+NP | |
56570 | 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) | |
56571 | IF(K(I,3).EQ.1) PMDI=2D0*(P(I,5)**2-PPS) | |
56572 | IF(K(I,3).EQ.2) PMDI=2D0*(P(I,5)**2+PPS) | |
56573 | IF(PMDI.LT.PMD) THEN | |
56574 | PMD=PMDI | |
56575 | IM=I | |
56576 | ENDIF | |
56577 | 300 CONTINUE | |
56578 | ||
56579 | C...Loop back if significant reduction in sum of m^2. | |
56580 | IF(PMD.LT.-PARU(48)*PMS) THEN | |
56581 | PMS=PMS+PMD | |
56582 | IS=K(IM,3) | |
56583 | DO 310 J=1,4 | |
56584 | PS(IS,J)=PS(IS,J)-P(IM,J) | |
56585 | PS(3-IS,J)=PS(3-IS,J)+P(IM,J) | |
56586 | 310 CONTINUE | |
56587 | K(IM,3)=3-IS | |
56588 | GOTO 280 | |
56589 | ENDIF | |
56590 | ||
56591 | C...Final masses and output. | |
56592 | MSTU(61)=N+1 | |
56593 | MSTU(62)=NP | |
56594 | PS(1,5)=SQRT(MAX(0D0,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)) | |
56595 | PS(2,5)=SQRT(MAX(0D0,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2)) | |
56596 | PMH=MAX(PS(1,5),PS(2,5)) | |
56597 | PML=MIN(PS(1,5),PS(2,5)) | |
56598 | ||
56599 | RETURN | |
56600 | END | |
56601 | ||
56602 | C********************************************************************* | |
56603 | ||
56604 | C...PYFOWO | |
56605 | C...Calculates the first few Fox-Wolfram moments. | |
56606 | ||
56607 | SUBROUTINE PYFOWO(H10,H20,H30,H40) | |
56608 | ||
56609 | C...Double precision and integer declarations. | |
56610 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
56611 | IMPLICIT INTEGER(I-N) | |
56612 | INTEGER PYK,PYCHGE,PYCOMP | |
56613 | C...Commonblocks. | |
56614 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
56615 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
56616 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
56617 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
56618 | ||
56619 | C...Copy momenta for particles and calculate H0. | |
56620 | NP=0 | |
56621 | H0=0D0 | |
56622 | HD=0D0 | |
56623 | DO 110 I=1,N | |
56624 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110 | |
56625 | IF(MSTU(41).GE.2) THEN | |
56626 | KC=PYCOMP(K(I,2)) | |
56627 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
56628 | & KC.EQ.18) GOTO 110 | |
56629 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) | |
56630 | & GOTO 110 | |
56631 | ENDIF | |
56632 | IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN | |
56633 | CALL PYERRM(11,'(PYFOWO:) no more memory left in PYJETS') | |
56634 | H10=-1D0 | |
56635 | H20=-1D0 | |
56636 | H30=-1D0 | |
56637 | H40=-1D0 | |
56638 | RETURN | |
56639 | ENDIF | |
56640 | NP=NP+1 | |
56641 | DO 100 J=1,3 | |
56642 | P(N+NP,J)=P(I,J) | |
56643 | 100 CONTINUE | |
56644 | P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
56645 | H0=H0+P(N+NP,4) | |
56646 | HD=HD+P(N+NP,4)**2 | |
56647 | 110 CONTINUE | |
56648 | H0=H0**2 | |
56649 | ||
56650 | C...Very low multiplicities (0 or 1) not considered. | |
56651 | IF(NP.LE.1) THEN | |
56652 | CALL PYERRM(8,'(PYFOWO:) too few particles for analysis') | |
56653 | H10=-1D0 | |
56654 | H20=-1D0 | |
56655 | H30=-1D0 | |
56656 | H40=-1D0 | |
56657 | RETURN | |
56658 | ENDIF | |
56659 | ||
56660 | C...Calculate H1 - H4. | |
56661 | H10=0D0 | |
56662 | H20=0D0 | |
56663 | H30=0D0 | |
56664 | H40=0D0 | |
56665 | DO 130 I1=N+1,N+NP | |
56666 | DO 120 I2=I1+1,N+NP | |
56667 | CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/ | |
56668 | & (P(I1,4)*P(I2,4)) | |
56669 | H10=H10+P(I1,4)*P(I2,4)*CTHE | |
56670 | H20=H20+P(I1,4)*P(I2,4)*(1.5D0*CTHE**2-0.5D0) | |
56671 | H30=H30+P(I1,4)*P(I2,4)*(2.5D0*CTHE**3-1.5D0*CTHE) | |
56672 | H40=H40+P(I1,4)*P(I2,4)*(4.375D0*CTHE**4-3.75D0*CTHE**2+ | |
56673 | & 0.375D0) | |
56674 | 120 CONTINUE | |
56675 | 130 CONTINUE | |
56676 | ||
56677 | C...Calculate H1/H0 - H4/H0. Output. | |
56678 | MSTU(61)=N+1 | |
56679 | MSTU(62)=NP | |
56680 | H10=(HD+2D0*H10)/H0 | |
56681 | H20=(HD+2D0*H20)/H0 | |
56682 | H30=(HD+2D0*H30)/H0 | |
56683 | H40=(HD+2D0*H40)/H0 | |
56684 | ||
56685 | RETURN | |
56686 | END | |
56687 | ||
56688 | C********************************************************************* | |
56689 | ||
56690 | C...PYTABU | |
56691 | C...Evaluates various properties of an event, with statistics | |
56692 | C...accumulated during the course of the run and | |
56693 | C...printed at the end. | |
56694 | ||
56695 | SUBROUTINE PYTABU(MTABU) | |
56696 | ||
56697 | C...Double precision and integer declarations. | |
56698 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
56699 | IMPLICIT INTEGER(I-N) | |
56700 | INTEGER PYK,PYCHGE,PYCOMP | |
56701 | C...Commonblocks. | |
56702 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
56703 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
56704 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
56705 | COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) | |
56706 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ | |
56707 | C...Local arrays, character variables, saved variables and data. | |
56708 | DIMENSION KFIS(100,2),NPIS(100,0:10),KFFS(400),NPFS(400,4), | |
56709 | &FEVFM(10,4),FM1FM(3,10,4),FM2FM(3,10,4),FMOMA(4),FMOMS(4), | |
56710 | &FEVEE(50),FE1EC(50),FE2EC(50),FE1EA(25),FE2EA(25), | |
56711 | &KFDM(8),KFDC(200,0:8),NPDC(200) | |
56712 | SAVE NEVIS,NKFIS,KFIS,NPIS,NEVFS,NPRFS,NFIFS,NCHFS,NKFFS, | |
56713 | &KFFS,NPFS,NEVFM,NMUFM,FM1FM,FM2FM,NEVEE,FE1EC,FE2EC,FE1EA, | |
56714 | &FE2EA,NEVDC,NKFDC,NREDC,KFDC,NPDC | |
56715 | CHARACTER CHAU*16,CHIS(2)*12,CHDC(8)*12 | |
56716 | DATA NEVIS/0/,NKFIS/0/,NEVFS/0/,NPRFS/0/,NFIFS/0/,NCHFS/0/, | |
56717 | &NKFFS/0/,NEVFM/0/,NMUFM/0/,FM1FM/120*0D0/,FM2FM/120*0D0/, | |
56718 | &NEVEE/0/,FE1EC/50*0D0/,FE2EC/50*0D0/,FE1EA/25*0D0/,FE2EA/25*0D0/, | |
56719 | &NEVDC/0/,NKFDC/0/,NREDC/0/ | |
56720 | ||
56721 | C...Reset statistics on initial parton state. | |
56722 | IF(MTABU.EQ.10) THEN | |
56723 | NEVIS=0 | |
56724 | NKFIS=0 | |
56725 | ||
56726 | C...Identify and order flavour content of initial state. | |
56727 | ELSEIF(MTABU.EQ.11) THEN | |
56728 | NEVIS=NEVIS+1 | |
56729 | KFM1=2*IABS(MSTU(161)) | |
56730 | IF(MSTU(161).GT.0) KFM1=KFM1-1 | |
56731 | KFM2=2*IABS(MSTU(162)) | |
56732 | IF(MSTU(162).GT.0) KFM2=KFM2-1 | |
56733 | KFMN=MIN(KFM1,KFM2) | |
56734 | KFMX=MAX(KFM1,KFM2) | |
56735 | DO 100 I=1,NKFIS | |
56736 | IF(KFMN.EQ.KFIS(I,1).AND.KFMX.EQ.KFIS(I,2)) THEN | |
56737 | IKFIS=-I | |
56738 | GOTO 110 | |
56739 | ELSEIF(KFMN.LT.KFIS(I,1).OR.(KFMN.EQ.KFIS(I,1).AND. | |
56740 | & KFMX.LT.KFIS(I,2))) THEN | |
56741 | IKFIS=I | |
56742 | GOTO 110 | |
56743 | ENDIF | |
56744 | 100 CONTINUE | |
56745 | IKFIS=NKFIS+1 | |
56746 | 110 IF(IKFIS.LT.0) THEN | |
56747 | IKFIS=-IKFIS | |
56748 | ELSE | |
56749 | IF(NKFIS.GE.100) RETURN | |
56750 | DO 130 I=NKFIS,IKFIS,-1 | |
56751 | KFIS(I+1,1)=KFIS(I,1) | |
56752 | KFIS(I+1,2)=KFIS(I,2) | |
56753 | DO 120 J=0,10 | |
56754 | NPIS(I+1,J)=NPIS(I,J) | |
56755 | 120 CONTINUE | |
56756 | 130 CONTINUE | |
56757 | NKFIS=NKFIS+1 | |
56758 | KFIS(IKFIS,1)=KFMN | |
56759 | KFIS(IKFIS,2)=KFMX | |
56760 | DO 140 J=0,10 | |
56761 | NPIS(IKFIS,J)=0 | |
56762 | 140 CONTINUE | |
56763 | ENDIF | |
56764 | NPIS(IKFIS,0)=NPIS(IKFIS,0)+1 | |
56765 | ||
56766 | C...Count number of partons in initial state. | |
56767 | NP=0 | |
56768 | DO 160 I=1,N | |
56769 | IF(K(I,1).LE.0.OR.K(I,1).GT.12) THEN | |
56770 | ELSEIF(IABS(K(I,2)).GT.80.AND.IABS(K(I,2)).LE.100) THEN | |
56771 | ELSEIF(IABS(K(I,2)).GT.100.AND.MOD(IABS(K(I,2))/10,10).NE.0) | |
56772 | & THEN | |
56773 | ELSE | |
56774 | IM=I | |
56775 | 150 IM=K(IM,3) | |
56776 | IF(IM.LE.0.OR.IM.GT.N) THEN | |
56777 | NP=NP+1 | |
56778 | ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN | |
56779 | NP=NP+1 | |
56780 | ELSEIF(IABS(K(IM,2)).GT.80.AND.IABS(K(IM,2)).LE.100) THEN | |
56781 | ELSEIF(IABS(K(IM,2)).GT.100.AND.MOD(IABS(K(IM,2))/10,10) | |
56782 | & .NE.0) THEN | |
56783 | ELSE | |
56784 | GOTO 150 | |
56785 | ENDIF | |
56786 | ENDIF | |
56787 | 160 CONTINUE | |
56788 | NPCO=MAX(NP,1) | |
56789 | IF(NP.GE.6) NPCO=6 | |
56790 | IF(NP.GE.8) NPCO=7 | |
56791 | IF(NP.GE.11) NPCO=8 | |
56792 | IF(NP.GE.16) NPCO=9 | |
56793 | IF(NP.GE.26) NPCO=10 | |
56794 | NPIS(IKFIS,NPCO)=NPIS(IKFIS,NPCO)+1 | |
56795 | MSTU(62)=NP | |
56796 | ||
56797 | C...Write statistics on initial parton state. | |
56798 | ELSEIF(MTABU.EQ.12) THEN | |
56799 | FAC=1D0/MAX(1,NEVIS) | |
56800 | WRITE(MSTU(11),5000) NEVIS | |
56801 | DO 170 I=1,NKFIS | |
56802 | KFMN=KFIS(I,1) | |
56803 | IF(KFMN.EQ.0) KFMN=KFIS(I,2) | |
56804 | KFM1=(KFMN+1)/2 | |
56805 | IF(2*KFM1.EQ.KFMN) KFM1=-KFM1 | |
56806 | CALL PYNAME(KFM1,CHAU) | |
56807 | CHIS(1)=CHAU(1:12) | |
56808 | IF(CHAU(13:13).NE.' ') CHIS(1)(12:12)='?' | |
56809 | KFMX=KFIS(I,2) | |
56810 | IF(KFIS(I,1).EQ.0) KFMX=0 | |
56811 | KFM2=(KFMX+1)/2 | |
56812 | IF(2*KFM2.EQ.KFMX) KFM2=-KFM2 | |
56813 | CALL PYNAME(KFM2,CHAU) | |
56814 | CHIS(2)=CHAU(1:12) | |
56815 | IF(CHAU(13:13).NE.' ') CHIS(2)(12:12)='?' | |
56816 | WRITE(MSTU(11),5100) CHIS(1),CHIS(2),FAC*NPIS(I,0), | |
56817 | & (NPIS(I,J)/DBLE(NPIS(I,0)),J=1,10) | |
56818 | 170 CONTINUE | |
56819 | ||
56820 | C...Copy statistics on initial parton state into /PYJETS/. | |
56821 | ELSEIF(MTABU.EQ.13) THEN | |
56822 | FAC=1D0/MAX(1,NEVIS) | |
56823 | DO 190 I=1,NKFIS | |
56824 | KFMN=KFIS(I,1) | |
56825 | IF(KFMN.EQ.0) KFMN=KFIS(I,2) | |
56826 | KFM1=(KFMN+1)/2 | |
56827 | IF(2*KFM1.EQ.KFMN) KFM1=-KFM1 | |
56828 | KFMX=KFIS(I,2) | |
56829 | IF(KFIS(I,1).EQ.0) KFMX=0 | |
56830 | KFM2=(KFMX+1)/2 | |
56831 | IF(2*KFM2.EQ.KFMX) KFM2=-KFM2 | |
56832 | K(I,1)=32 | |
56833 | K(I,2)=99 | |
56834 | K(I,3)=KFM1 | |
56835 | K(I,4)=KFM2 | |
56836 | K(I,5)=NPIS(I,0) | |
56837 | DO 180 J=1,5 | |
56838 | P(I,J)=FAC*NPIS(I,J) | |
56839 | V(I,J)=FAC*NPIS(I,J+5) | |
56840 | 180 CONTINUE | |
56841 | 190 CONTINUE | |
56842 | N=NKFIS | |
56843 | DO 200 J=1,5 | |
56844 | K(N+1,J)=0 | |
56845 | P(N+1,J)=0D0 | |
56846 | V(N+1,J)=0D0 | |
56847 | 200 CONTINUE | |
56848 | K(N+1,1)=32 | |
56849 | K(N+1,2)=99 | |
56850 | K(N+1,5)=NEVIS | |
56851 | MSTU(3)=1 | |
56852 | ||
56853 | C...Reset statistics on number of particles/partons. | |
56854 | ELSEIF(MTABU.EQ.20) THEN | |
56855 | NEVFS=0 | |
56856 | NPRFS=0 | |
56857 | NFIFS=0 | |
56858 | NCHFS=0 | |
56859 | NKFFS=0 | |
56860 | ||
56861 | C...Identify whether particle/parton is primary or not. | |
56862 | ELSEIF(MTABU.EQ.21) THEN | |
56863 | NEVFS=NEVFS+1 | |
56864 | MSTU(62)=0 | |
56865 | DO 260 I=1,N | |
56866 | IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,1).EQ.13) GOTO 260 | |
56867 | MSTU(62)=MSTU(62)+1 | |
56868 | KC=PYCOMP(K(I,2)) | |
56869 | MPRI=0 | |
56870 | IF(K(I,3).LE.0.OR.K(I,3).GT.N) THEN | |
56871 | MPRI=1 | |
56872 | ELSEIF(K(K(I,3),1).LE.0.OR.K(K(I,3),1).GT.20) THEN | |
56873 | MPRI=1 | |
56874 | ELSEIF(K(K(I,3),2).GE.91.AND.K(K(I,3),2).LE.93) THEN | |
56875 | MPRI=1 | |
56876 | ELSEIF(KC.EQ.0) THEN | |
56877 | ELSEIF(K(K(I,3),1).EQ.13) THEN | |
56878 | IM=K(K(I,3),3) | |
56879 | IF(IM.LE.0.OR.IM.GT.N) THEN | |
56880 | MPRI=1 | |
56881 | ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN | |
56882 | MPRI=1 | |
56883 | ENDIF | |
56884 | ELSEIF(KCHG(KC,2).EQ.0) THEN | |
56885 | KCM=PYCOMP(K(K(I,3),2)) | |
56886 | IF(KCM.NE.0) THEN | |
56887 | IF(KCHG(KCM,2).NE.0) MPRI=1 | |
56888 | ENDIF | |
56889 | ENDIF | |
56890 | IF(KC.NE.0.AND.MPRI.EQ.1) THEN | |
56891 | IF(KCHG(KC,2).EQ.0) NPRFS=NPRFS+1 | |
56892 | ENDIF | |
56893 | IF(K(I,1).LE.10) THEN | |
56894 | NFIFS=NFIFS+1 | |
56895 | IF(PYCHGE(K(I,2)).NE.0) NCHFS=NCHFS+1 | |
56896 | ENDIF | |
56897 | ||
56898 | C...Fill statistics on number of particles/partons in event. | |
56899 | KFA=IABS(K(I,2)) | |
56900 | KFS=3-ISIGN(1,K(I,2))-MPRI | |
56901 | DO 210 IP=1,NKFFS | |
56902 | IF(KFA.EQ.KFFS(IP)) THEN | |
56903 | IKFFS=-IP | |
56904 | GOTO 220 | |
56905 | ELSEIF(KFA.LT.KFFS(IP)) THEN | |
56906 | IKFFS=IP | |
56907 | GOTO 220 | |
56908 | ENDIF | |
56909 | 210 CONTINUE | |
56910 | IKFFS=NKFFS+1 | |
56911 | 220 IF(IKFFS.LT.0) THEN | |
56912 | IKFFS=-IKFFS | |
56913 | ELSE | |
56914 | IF(NKFFS.GE.400) RETURN | |
56915 | DO 240 IP=NKFFS,IKFFS,-1 | |
56916 | KFFS(IP+1)=KFFS(IP) | |
56917 | DO 230 J=1,4 | |
56918 | NPFS(IP+1,J)=NPFS(IP,J) | |
56919 | 230 CONTINUE | |
56920 | 240 CONTINUE | |
56921 | NKFFS=NKFFS+1 | |
56922 | KFFS(IKFFS)=KFA | |
56923 | DO 250 J=1,4 | |
56924 | NPFS(IKFFS,J)=0 | |
56925 | 250 CONTINUE | |
56926 | ENDIF | |
56927 | NPFS(IKFFS,KFS)=NPFS(IKFFS,KFS)+1 | |
56928 | 260 CONTINUE | |
56929 | ||
56930 | C...Write statistics on particle/parton composition of events. | |
56931 | ELSEIF(MTABU.EQ.22) THEN | |
56932 | FAC=1D0/MAX(1,NEVFS) | |
56933 | WRITE(MSTU(11),5200) NEVFS,FAC*NPRFS,FAC*NFIFS,FAC*NCHFS | |
56934 | DO 270 I=1,NKFFS | |
56935 | CALL PYNAME(KFFS(I),CHAU) | |
56936 | KC=PYCOMP(KFFS(I)) | |
56937 | MDCYF=0 | |
56938 | IF(KC.NE.0) MDCYF=MDCY(KC,1) | |
56939 | WRITE(MSTU(11),5300) KFFS(I),CHAU,MDCYF,(FAC*NPFS(I,J),J=1,4), | |
56940 | & FAC*(NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4)) | |
56941 | 270 CONTINUE | |
56942 | ||
56943 | C...Copy particle/parton composition information into /PYJETS/. | |
56944 | ELSEIF(MTABU.EQ.23) THEN | |
56945 | FAC=1D0/MAX(1,NEVFS) | |
56946 | DO 290 I=1,NKFFS | |
56947 | K(I,1)=32 | |
56948 | K(I,2)=99 | |
56949 | K(I,3)=KFFS(I) | |
56950 | K(I,4)=0 | |
56951 | K(I,5)=NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4) | |
56952 | DO 280 J=1,4 | |
56953 | P(I,J)=FAC*NPFS(I,J) | |
56954 | V(I,J)=0D0 | |
56955 | 280 CONTINUE | |
56956 | P(I,5)=FAC*K(I,5) | |
56957 | V(I,5)=0D0 | |
56958 | 290 CONTINUE | |
56959 | N=NKFFS | |
56960 | DO 300 J=1,5 | |
56961 | K(N+1,J)=0 | |
56962 | P(N+1,J)=0D0 | |
56963 | V(N+1,J)=0D0 | |
56964 | 300 CONTINUE | |
56965 | K(N+1,1)=32 | |
56966 | K(N+1,2)=99 | |
56967 | K(N+1,5)=NEVFS | |
56968 | P(N+1,1)=FAC*NPRFS | |
56969 | P(N+1,2)=FAC*NFIFS | |
56970 | P(N+1,3)=FAC*NCHFS | |
56971 | MSTU(3)=1 | |
56972 | ||
56973 | C...Reset factorial moments statistics. | |
56974 | ELSEIF(MTABU.EQ.30) THEN | |
56975 | NEVFM=0 | |
56976 | NMUFM=0 | |
56977 | DO 330 IM=1,3 | |
56978 | DO 320 IB=1,10 | |
56979 | DO 310 IP=1,4 | |
56980 | FM1FM(IM,IB,IP)=0D0 | |
56981 | FM2FM(IM,IB,IP)=0D0 | |
56982 | 310 CONTINUE | |
56983 | 320 CONTINUE | |
56984 | 330 CONTINUE | |
56985 | ||
56986 | C...Find particles to include, with (pion,pseudo)rapidity and azimuth. | |
56987 | ELSEIF(MTABU.EQ.31) THEN | |
56988 | NEVFM=NEVFM+1 | |
56989 | NLOW=N+MSTU(3) | |
56990 | NUPP=NLOW | |
56991 | DO 410 I=1,N | |
56992 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 410 | |
56993 | IF(MSTU(41).GE.2) THEN | |
56994 | KC=PYCOMP(K(I,2)) | |
56995 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
56996 | & KC.EQ.18) GOTO 410 | |
56997 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND. | |
56998 | & PYCHGE(K(I,2)).EQ.0) GOTO 410 | |
56999 | ENDIF | |
57000 | PMR=0D0 | |
57001 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=PYMASS(211) | |
57002 | IF(MSTU(42).GE.2) PMR=P(I,5) | |
57003 | PR=MAX(1D-20,PMR**2+P(I,1)**2+P(I,2)**2) | |
57004 | YETA=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), | |
57005 | & 1D20)),P(I,3)) | |
57006 | IF(ABS(YETA).GT.PARU(57)) GOTO 410 | |
57007 | PHI=PYANGL(P(I,1),P(I,2)) | |
57008 | IYETA=512D0*(YETA+PARU(57))/(2D0*PARU(57)) | |
57009 | IYETA=MAX(0,MIN(511,IYETA)) | |
57010 | IPHI=512D0*(PHI+PARU(1))/PARU(2) | |
57011 | IPHI=MAX(0,MIN(511,IPHI)) | |
57012 | IYEP=0 | |
57013 | DO 340 IB=0,9 | |
57014 | IYEP=IYEP+4**IB*(2*MOD(IYETA/2**IB,2)+MOD(IPHI/2**IB,2)) | |
57015 | 340 CONTINUE | |
57016 | ||
57017 | C...Order particles in (pseudo)rapidity and/or azimuth. | |
57018 | IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN | |
57019 | CALL PYERRM(11,'(PYTABU:) no more memory left in PYJETS') | |
57020 | RETURN | |
57021 | ENDIF | |
57022 | NUPP=NUPP+1 | |
57023 | IF(NUPP.EQ.NLOW+1) THEN | |
57024 | K(NUPP,1)=IYETA | |
57025 | K(NUPP,2)=IPHI | |
57026 | K(NUPP,3)=IYEP | |
57027 | ELSE | |
57028 | DO 350 I1=NUPP-1,NLOW+1,-1 | |
57029 | IF(IYETA.GE.K(I1,1)) GOTO 360 | |
57030 | K(I1+1,1)=K(I1,1) | |
57031 | 350 CONTINUE | |
57032 | 360 K(I1+1,1)=IYETA | |
57033 | DO 370 I1=NUPP-1,NLOW+1,-1 | |
57034 | IF(IPHI.GE.K(I1,2)) GOTO 380 | |
57035 | K(I1+1,2)=K(I1,2) | |
57036 | 370 CONTINUE | |
57037 | 380 K(I1+1,2)=IPHI | |
57038 | DO 390 I1=NUPP-1,NLOW+1,-1 | |
57039 | IF(IYEP.GE.K(I1,3)) GOTO 400 | |
57040 | K(I1+1,3)=K(I1,3) | |
57041 | 390 CONTINUE | |
57042 | 400 K(I1+1,3)=IYEP | |
57043 | ENDIF | |
57044 | 410 CONTINUE | |
57045 | K(NUPP+1,1)=2**10 | |
57046 | K(NUPP+1,2)=2**10 | |
57047 | K(NUPP+1,3)=4**10 | |
57048 | ||
57049 | C...Calculate sum of factorial moments in event. | |
57050 | DO 480 IM=1,3 | |
57051 | DO 430 IB=1,10 | |
57052 | DO 420 IP=1,4 | |
57053 | FEVFM(IB,IP)=0D0 | |
57054 | 420 CONTINUE | |
57055 | 430 CONTINUE | |
57056 | DO 450 IB=1,10 | |
57057 | IF(IM.LE.2) IBIN=2**(10-IB) | |
57058 | IF(IM.EQ.3) IBIN=4**(10-IB) | |
57059 | IAGR=K(NLOW+1,IM)/IBIN | |
57060 | NAGR=1 | |
57061 | DO 440 I=NLOW+2,NUPP+1 | |
57062 | ICUT=K(I,IM)/IBIN | |
57063 | IF(ICUT.EQ.IAGR) THEN | |
57064 | NAGR=NAGR+1 | |
57065 | ELSE | |
57066 | IF(NAGR.EQ.1) THEN | |
57067 | ELSEIF(NAGR.EQ.2) THEN | |
57068 | FEVFM(IB,1)=FEVFM(IB,1)+2D0 | |
57069 | ELSEIF(NAGR.EQ.3) THEN | |
57070 | FEVFM(IB,1)=FEVFM(IB,1)+6D0 | |
57071 | FEVFM(IB,2)=FEVFM(IB,2)+6D0 | |
57072 | ELSEIF(NAGR.EQ.4) THEN | |
57073 | FEVFM(IB,1)=FEVFM(IB,1)+12D0 | |
57074 | FEVFM(IB,2)=FEVFM(IB,2)+24D0 | |
57075 | FEVFM(IB,3)=FEVFM(IB,3)+24D0 | |
57076 | ELSE | |
57077 | FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1D0) | |
57078 | FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1D0)*(NAGR-2D0) | |
57079 | FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1D0)*(NAGR-2D0)* | |
57080 | & (NAGR-3D0) | |
57081 | FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1D0)*(NAGR-2D0)* | |
57082 | & (NAGR-3D0)*(NAGR-4D0) | |
57083 | ENDIF | |
57084 | IAGR=ICUT | |
57085 | NAGR=1 | |
57086 | ENDIF | |
57087 | 440 CONTINUE | |
57088 | 450 CONTINUE | |
57089 | ||
57090 | C...Add results to total statistics. | |
57091 | DO 470 IB=10,1,-1 | |
57092 | DO 460 IP=1,4 | |
57093 | IF(FEVFM(1,IP).LT.0.5D0) THEN | |
57094 | FEVFM(IB,IP)=0D0 | |
57095 | ELSEIF(IM.LE.2) THEN | |
57096 | FEVFM(IB,IP)=2D0**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) | |
57097 | ELSE | |
57098 | FEVFM(IB,IP)=4D0**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) | |
57099 | ENDIF | |
57100 | FM1FM(IM,IB,IP)=FM1FM(IM,IB,IP)+FEVFM(IB,IP) | |
57101 | FM2FM(IM,IB,IP)=FM2FM(IM,IB,IP)+FEVFM(IB,IP)**2 | |
57102 | 460 CONTINUE | |
57103 | 470 CONTINUE | |
57104 | 480 CONTINUE | |
57105 | NMUFM=NMUFM+(NUPP-NLOW) | |
57106 | MSTU(62)=NUPP-NLOW | |
57107 | ||
57108 | C...Write accumulated statistics on factorial moments. | |
57109 | ELSEIF(MTABU.EQ.32) THEN | |
57110 | FAC=1D0/MAX(1,NEVFM) | |
57111 | IF(MSTU(42).LE.0) WRITE(MSTU(11),5400) NEVFM,'eta' | |
57112 | IF(MSTU(42).EQ.1) WRITE(MSTU(11),5400) NEVFM,'ypi' | |
57113 | IF(MSTU(42).GE.2) WRITE(MSTU(11),5400) NEVFM,'y ' | |
57114 | DO 510 IM=1,3 | |
57115 | WRITE(MSTU(11),5500) | |
57116 | DO 500 IB=1,10 | |
57117 | BYETA=2D0*PARU(57) | |
57118 | IF(IM.NE.2) BYETA=BYETA/2**(IB-1) | |
57119 | BPHI=PARU(2) | |
57120 | IF(IM.NE.1) BPHI=BPHI/2**(IB-1) | |
57121 | IF(IM.LE.2) BNAVE=FAC*NMUFM/DBLE(2**(IB-1)) | |
57122 | IF(IM.EQ.3) BNAVE=FAC*NMUFM/DBLE(4**(IB-1)) | |
57123 | DO 490 IP=1,4 | |
57124 | FMOMA(IP)=FAC*FM1FM(IM,IB,IP) | |
57125 | FMOMS(IP)=SQRT(MAX(0D0,FAC*(FAC*FM2FM(IM,IB,IP)- | |
57126 | & FMOMA(IP)**2))) | |
57127 | 490 CONTINUE | |
57128 | WRITE(MSTU(11),5600) BYETA,BPHI,BNAVE,(FMOMA(IP),FMOMS(IP), | |
57129 | & IP=1,4) | |
57130 | 500 CONTINUE | |
57131 | 510 CONTINUE | |
57132 | ||
57133 | C...Copy statistics on factorial moments into /PYJETS/. | |
57134 | ELSEIF(MTABU.EQ.33) THEN | |
57135 | FAC=1D0/MAX(1,NEVFM) | |
57136 | DO 540 IM=1,3 | |
57137 | DO 530 IB=1,10 | |
57138 | I=10*(IM-1)+IB | |
57139 | K(I,1)=32 | |
57140 | K(I,2)=99 | |
57141 | K(I,3)=1 | |
57142 | IF(IM.NE.2) K(I,3)=2**(IB-1) | |
57143 | K(I,4)=1 | |
57144 | IF(IM.NE.1) K(I,4)=2**(IB-1) | |
57145 | K(I,5)=0 | |
57146 | P(I,1)=2D0*PARU(57)/K(I,3) | |
57147 | V(I,1)=PARU(2)/K(I,4) | |
57148 | DO 520 IP=1,4 | |
57149 | P(I,IP+1)=FAC*FM1FM(IM,IB,IP) | |
57150 | V(I,IP+1)=SQRT(MAX(0D0,FAC*(FAC*FM2FM(IM,IB,IP)- | |
57151 | & P(I,IP+1)**2))) | |
57152 | 520 CONTINUE | |
57153 | 530 CONTINUE | |
57154 | 540 CONTINUE | |
57155 | N=30 | |
57156 | DO 550 J=1,5 | |
57157 | K(N+1,J)=0 | |
57158 | P(N+1,J)=0D0 | |
57159 | V(N+1,J)=0D0 | |
57160 | 550 CONTINUE | |
57161 | K(N+1,1)=32 | |
57162 | K(N+1,2)=99 | |
57163 | K(N+1,5)=NEVFM | |
57164 | MSTU(3)=1 | |
57165 | ||
57166 | C...Reset statistics on Energy-Energy Correlation. | |
57167 | ELSEIF(MTABU.EQ.40) THEN | |
57168 | NEVEE=0 | |
57169 | DO 560 J=1,25 | |
57170 | FE1EC(J)=0D0 | |
57171 | FE2EC(J)=0D0 | |
57172 | FE1EC(51-J)=0D0 | |
57173 | FE2EC(51-J)=0D0 | |
57174 | FE1EA(J)=0D0 | |
57175 | FE2EA(J)=0D0 | |
57176 | 560 CONTINUE | |
57177 | ||
57178 | C...Find particles to include, with proper assumed mass. | |
57179 | ELSEIF(MTABU.EQ.41) THEN | |
57180 | NEVEE=NEVEE+1 | |
57181 | NLOW=N+MSTU(3) | |
57182 | NUPP=NLOW | |
57183 | ECM=0D0 | |
57184 | DO 570 I=1,N | |
57185 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 570 | |
57186 | IF(MSTU(41).GE.2) THEN | |
57187 | KC=PYCOMP(K(I,2)) | |
57188 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
57189 | & KC.EQ.18) GOTO 570 | |
57190 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND. | |
57191 | & PYCHGE(K(I,2)).EQ.0) GOTO 570 | |
57192 | ENDIF | |
57193 | PMR=0D0 | |
57194 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=PYMASS(211) | |
57195 | IF(MSTU(42).GE.2) PMR=P(I,5) | |
57196 | IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN | |
57197 | CALL PYERRM(11,'(PYTABU:) no more memory left in PYJETS') | |
57198 | RETURN | |
57199 | ENDIF | |
57200 | NUPP=NUPP+1 | |
57201 | P(NUPP,1)=P(I,1) | |
57202 | P(NUPP,2)=P(I,2) | |
57203 | P(NUPP,3)=P(I,3) | |
57204 | P(NUPP,4)=SQRT(PMR**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
57205 | P(NUPP,5)=MAX(1D-10,SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)) | |
57206 | ECM=ECM+P(NUPP,4) | |
57207 | 570 CONTINUE | |
57208 | IF(NUPP.EQ.NLOW) RETURN | |
57209 | ||
57210 | C...Analyze Energy-Energy Correlation in event. | |
57211 | FAC=(2D0/ECM**2)*50D0/PARU(1) | |
57212 | DO 580 J=1,50 | |
57213 | FEVEE(J)=0D0 | |
57214 | 580 CONTINUE | |
57215 | DO 600 I1=NLOW+2,NUPP | |
57216 | DO 590 I2=NLOW+1,I1-1 | |
57217 | CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/ | |
57218 | & (P(I1,5)*P(I2,5)) | |
57219 | THE=ACOS(MAX(-1D0,MIN(1D0,CTHE))) | |
57220 | ITHE=MAX(1,MIN(50,1+INT(50D0*THE/PARU(1)))) | |
57221 | FEVEE(ITHE)=FEVEE(ITHE)+FAC*P(I1,4)*P(I2,4) | |
57222 | 590 CONTINUE | |
57223 | 600 CONTINUE | |
57224 | DO 610 J=1,25 | |
57225 | FE1EC(J)=FE1EC(J)+FEVEE(J) | |
57226 | FE2EC(J)=FE2EC(J)+FEVEE(J)**2 | |
57227 | FE1EC(51-J)=FE1EC(51-J)+FEVEE(51-J) | |
57228 | FE2EC(51-J)=FE2EC(51-J)+FEVEE(51-J)**2 | |
57229 | FE1EA(J)=FE1EA(J)+(FEVEE(51-J)-FEVEE(J)) | |
57230 | FE2EA(J)=FE2EA(J)+(FEVEE(51-J)-FEVEE(J))**2 | |
57231 | 610 CONTINUE | |
57232 | MSTU(62)=NUPP-NLOW | |
57233 | ||
57234 | C...Write statistics on Energy-Energy Correlation. | |
57235 | ELSEIF(MTABU.EQ.42) THEN | |
57236 | FAC=1D0/MAX(1,NEVEE) | |
57237 | WRITE(MSTU(11),5700) NEVEE | |
57238 | DO 620 J=1,25 | |
57239 | FEEC1=FAC*FE1EC(J) | |
57240 | FEES1=SQRT(MAX(0D0,FAC*(FAC*FE2EC(J)-FEEC1**2))) | |
57241 | FEEC2=FAC*FE1EC(51-J) | |
57242 | FEES2=SQRT(MAX(0D0,FAC*(FAC*FE2EC(51-J)-FEEC2**2))) | |
57243 | FEECA=FAC*FE1EA(J) | |
57244 | FEESA=SQRT(MAX(0D0,FAC*(FAC*FE2EA(J)-FEECA**2))) | |
57245 | WRITE(MSTU(11),5800) 3.6D0*(J-1),3.6D0*J,FEEC1,FEES1, | |
57246 | & FEEC2,FEES2,FEECA,FEESA | |
57247 | 620 CONTINUE | |
57248 | ||
57249 | C...Copy statistics on Energy-Energy Correlation into /PYJETS/. | |
57250 | ELSEIF(MTABU.EQ.43) THEN | |
57251 | FAC=1D0/MAX(1,NEVEE) | |
57252 | DO 630 I=1,25 | |
57253 | K(I,1)=32 | |
57254 | K(I,2)=99 | |
57255 | K(I,3)=0 | |
57256 | K(I,4)=0 | |
57257 | K(I,5)=0 | |
57258 | P(I,1)=FAC*FE1EC(I) | |
57259 | V(I,1)=SQRT(MAX(0D0,FAC*(FAC*FE2EC(I)-P(I,1)**2))) | |
57260 | P(I,2)=FAC*FE1EC(51-I) | |
57261 | V(I,2)=SQRT(MAX(0D0,FAC*(FAC*FE2EC(51-I)-P(I,2)**2))) | |
57262 | P(I,3)=FAC*FE1EA(I) | |
57263 | V(I,3)=SQRT(MAX(0D0,FAC*(FAC*FE2EA(I)-P(I,3)**2))) | |
57264 | P(I,4)=PARU(1)*(I-1)/50D0 | |
57265 | P(I,5)=PARU(1)*I/50D0 | |
57266 | V(I,4)=3.6D0*(I-1) | |
57267 | V(I,5)=3.6D0*I | |
57268 | 630 CONTINUE | |
57269 | N=25 | |
57270 | DO 640 J=1,5 | |
57271 | K(N+1,J)=0 | |
57272 | P(N+1,J)=0D0 | |
57273 | V(N+1,J)=0D0 | |
57274 | 640 CONTINUE | |
57275 | K(N+1,1)=32 | |
57276 | K(N+1,2)=99 | |
57277 | K(N+1,5)=NEVEE | |
57278 | MSTU(3)=1 | |
57279 | ||
57280 | C...Reset statistics on decay channels. | |
57281 | ELSEIF(MTABU.EQ.50) THEN | |
57282 | NEVDC=0 | |
57283 | NKFDC=0 | |
57284 | NREDC=0 | |
57285 | ||
57286 | C...Identify and order flavour content of final state. | |
57287 | ELSEIF(MTABU.EQ.51) THEN | |
57288 | NEVDC=NEVDC+1 | |
57289 | NDS=0 | |
57290 | DO 670 I=1,N | |
57291 | IF(K(I,1).LE.0.OR.K(I,1).GE.6) GOTO 670 | |
57292 | NDS=NDS+1 | |
57293 | IF(NDS.GT.8) THEN | |
57294 | NREDC=NREDC+1 | |
57295 | RETURN | |
57296 | ENDIF | |
57297 | KFM=2*IABS(K(I,2)) | |
57298 | IF(K(I,2).LT.0) KFM=KFM-1 | |
57299 | DO 650 IDS=NDS-1,1,-1 | |
57300 | IIN=IDS+1 | |
57301 | IF(KFM.LT.KFDM(IDS)) GOTO 660 | |
57302 | KFDM(IDS+1)=KFDM(IDS) | |
57303 | 650 CONTINUE | |
57304 | IIN=1 | |
57305 | 660 KFDM(IIN)=KFM | |
57306 | 670 CONTINUE | |
57307 | ||
57308 | C...Find whether old or new final state. | |
57309 | DO 690 IDC=1,NKFDC | |
57310 | IF(NDS.LT.KFDC(IDC,0)) THEN | |
57311 | IKFDC=IDC | |
57312 | GOTO 700 | |
57313 | ELSEIF(NDS.EQ.KFDC(IDC,0)) THEN | |
57314 | DO 680 I=1,NDS | |
57315 | IF(KFDM(I).LT.KFDC(IDC,I)) THEN | |
57316 | IKFDC=IDC | |
57317 | GOTO 700 | |
57318 | ELSEIF(KFDM(I).GT.KFDC(IDC,I)) THEN | |
57319 | GOTO 690 | |
57320 | ENDIF | |
57321 | 680 CONTINUE | |
57322 | IKFDC=-IDC | |
57323 | GOTO 700 | |
57324 | ENDIF | |
57325 | 690 CONTINUE | |
57326 | IKFDC=NKFDC+1 | |
57327 | 700 IF(IKFDC.LT.0) THEN | |
57328 | IKFDC=-IKFDC | |
57329 | ELSEIF(NKFDC.GE.200) THEN | |
57330 | NREDC=NREDC+1 | |
57331 | RETURN | |
57332 | ELSE | |
57333 | DO 720 IDC=NKFDC,IKFDC,-1 | |
57334 | NPDC(IDC+1)=NPDC(IDC) | |
57335 | DO 710 I=0,8 | |
57336 | KFDC(IDC+1,I)=KFDC(IDC,I) | |
57337 | 710 CONTINUE | |
57338 | 720 CONTINUE | |
57339 | NKFDC=NKFDC+1 | |
57340 | KFDC(IKFDC,0)=NDS | |
57341 | DO 730 I=1,NDS | |
57342 | KFDC(IKFDC,I)=KFDM(I) | |
57343 | 730 CONTINUE | |
57344 | NPDC(IKFDC)=0 | |
57345 | ENDIF | |
57346 | NPDC(IKFDC)=NPDC(IKFDC)+1 | |
57347 | ||
57348 | C...Write statistics on decay channels. | |
57349 | ELSEIF(MTABU.EQ.52) THEN | |
57350 | FAC=1D0/MAX(1,NEVDC) | |
57351 | WRITE(MSTU(11),5900) NEVDC | |
57352 | DO 750 IDC=1,NKFDC | |
57353 | DO 740 I=1,KFDC(IDC,0) | |
57354 | KFM=KFDC(IDC,I) | |
57355 | KF=(KFM+1)/2 | |
57356 | IF(2*KF.NE.KFM) KF=-KF | |
57357 | CALL PYNAME(KF,CHAU) | |
57358 | CHDC(I)=CHAU(1:12) | |
57359 | IF(CHAU(13:13).NE.' ') CHDC(I)(12:12)='?' | |
57360 | 740 CONTINUE | |
57361 | WRITE(MSTU(11),6000) FAC*NPDC(IDC),(CHDC(I),I=1,KFDC(IDC,0)) | |
57362 | 750 CONTINUE | |
57363 | IF(NREDC.NE.0) WRITE(MSTU(11),6100) FAC*NREDC | |
57364 | ||
57365 | C...Copy statistics on decay channels into /PYJETS/. | |
57366 | ELSEIF(MTABU.EQ.53) THEN | |
57367 | FAC=1D0/MAX(1,NEVDC) | |
57368 | DO 780 IDC=1,NKFDC | |
57369 | K(IDC,1)=32 | |
57370 | K(IDC,2)=99 | |
57371 | K(IDC,3)=0 | |
57372 | K(IDC,4)=0 | |
57373 | K(IDC,5)=KFDC(IDC,0) | |
57374 | DO 760 J=1,5 | |
57375 | P(IDC,J)=0D0 | |
57376 | V(IDC,J)=0D0 | |
57377 | 760 CONTINUE | |
57378 | DO 770 I=1,KFDC(IDC,0) | |
57379 | KFM=KFDC(IDC,I) | |
57380 | KF=(KFM+1)/2 | |
57381 | IF(2*KF.NE.KFM) KF=-KF | |
57382 | IF(I.LE.5) P(IDC,I)=KF | |
57383 | IF(I.GE.6) V(IDC,I-5)=KF | |
57384 | 770 CONTINUE | |
57385 | V(IDC,5)=FAC*NPDC(IDC) | |
57386 | 780 CONTINUE | |
57387 | N=NKFDC | |
57388 | DO 790 J=1,5 | |
57389 | K(N+1,J)=0 | |
57390 | P(N+1,J)=0D0 | |
57391 | V(N+1,J)=0D0 | |
57392 | 790 CONTINUE | |
57393 | K(N+1,1)=32 | |
57394 | K(N+1,2)=99 | |
57395 | K(N+1,5)=NEVDC | |
57396 | V(N+1,5)=FAC*NREDC | |
57397 | MSTU(3)=1 | |
57398 | ENDIF | |
57399 | ||
57400 | C...Format statements for output on unit MSTU(11) (default 6). | |
57401 | 5000 FORMAT(///20X,'Event statistics - initial state'/ | |
57402 | &20X,'based on an analysis of ',I6,' events'// | |
57403 | &3X,'Main flavours after',8X,'Fraction',4X,'Subfractions ', | |
57404 | &'according to fragmenting system multiplicity'/ | |
57405 | &4X,'hard interaction',24X,'1',7X,'2',7X,'3',7X,'4',7X,'5', | |
57406 | &6X,'6-7',5X,'8-10',3X,'11-15',3X,'16-25',4X,'>25'/) | |
57407 | 5100 FORMAT(3X,A12,1X,A12,F10.5,1X,10F8.4) | |
57408 | 5200 FORMAT(///20X,'Event statistics - final state'/ | |
57409 | &20X,'based on an analysis of ',I7,' events'// | |
57410 | &5X,'Mean primary multiplicity =',F10.4/ | |
57411 | &5X,'Mean final multiplicity =',F10.4/ | |
57412 | &5X,'Mean charged multiplicity =',F10.4// | |
57413 | &5X,'Number of particles produced per event (directly and via ', | |
57414 | &'decays/branchings)'/ | |
57415 | &8X,'KF Particle/jet MDCY',10X,'Particles',13X,'Antiparticles', | |
57416 | &8X,'Total'/35X,'prim seco prim seco'/) | |
57417 | 5300 FORMAT(1X,I9,4X,A16,I2,5(1X,F11.6)) | |
57418 | 5400 FORMAT(///20X,'Factorial moments analysis of multiplicity'/ | |
57419 | &20X,'based on an analysis of ',I6,' events'// | |
57420 | &3X,'delta-',A3,' delta-phi <n>/bin',10X,'<F2>',18X,'<F3>', | |
57421 | &18X,'<F4>',18X,'<F5>'/35X,4(' value error ')) | |
57422 | 5500 FORMAT(10X) | |
57423 | 5600 FORMAT(2X,2F10.4,F12.4,4(F12.4,F10.4)) | |
57424 | 5700 FORMAT(///20X,'Energy-Energy Correlation and Asymmetry'/ | |
57425 | &20X,'based on an analysis of ',I6,' events'// | |
57426 | &2X,'theta range',8X,'EEC(theta)',8X,'EEC(180-theta)',7X, | |
57427 | &'EECA(theta)'/2X,'in degrees ',3(' value error')/) | |
57428 | 5800 FORMAT(2X,F4.1,' - ',F4.1,3(F11.4,F9.4)) | |
57429 | 5900 FORMAT(///20X,'Decay channel analysis - final state'/ | |
57430 | &20X,'based on an analysis of ',I6,' events'// | |
57431 | &2X,'Probability',10X,'Complete final state'/) | |
57432 | 6000 FORMAT(2X,F9.5,5X,8(A12,1X)) | |
57433 | 6100 FORMAT(2X,F9.5,5X,'into other channels (more than 8 particles ', | |
57434 | &'or table overflow)') | |
57435 | ||
57436 | RETURN | |
57437 | END | |
57438 | ||
57439 | C********************************************************************* | |
57440 | ||
57441 | C...PYEEVT | |
57442 | C...Handles the generation of an e+e- annihilation jet event. | |
57443 | ||
57444 | SUBROUTINE PYEEVT(KFL,ECM) | |
57445 | ||
57446 | C...Double precision and integer declarations. | |
57447 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
57448 | IMPLICIT INTEGER(I-N) | |
57449 | INTEGER PYK,PYCHGE,PYCOMP | |
57450 | C...Commonblocks. | |
57451 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
57452 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
57453 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
57454 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
57455 | ||
57456 | C...Check input parameters. | |
57457 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
57458 | IF(KFL.LT.0.OR.KFL.GT.8) THEN | |
57459 | CALL PYERRM(16,'(PYEEVT:) called with unknown flavour code') | |
57460 | IF(MSTU(21).GE.1) RETURN | |
57461 | ENDIF | |
57462 | IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02D0*PARF(100+MAX(1,KFL)) | |
57463 | IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02D0*PMAS(KFL,1) | |
57464 | IF(ECM.LT.ECMMIN) THEN | |
57465 | CALL PYERRM(16,'(PYEEVT:) called with too small CM energy') | |
57466 | IF(MSTU(21).GE.1) RETURN | |
57467 | ENDIF | |
57468 | ||
57469 | C...Check consistency of MSTJ options set. | |
57470 | IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN | |
57471 | CALL PYERRM(6, | |
57472 | & '(PYEEVT:) MSTJ(109) value requires MSTJ(110) = 1') | |
57473 | MSTJ(110)=1 | |
57474 | ENDIF | |
57475 | IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN | |
57476 | CALL PYERRM(6, | |
57477 | & '(PYEEVT:) MSTJ(109) value requires MSTJ(111) = 0') | |
57478 | MSTJ(111)=0 | |
57479 | ENDIF | |
57480 | ||
57481 | C...Initialize alpha_strong and total cross-section. | |
57482 | MSTU(111)=MSTJ(108) | |
57483 | IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) | |
57484 | &MSTU(111)=1 | |
57485 | PARU(112)=PARJ(121) | |
57486 | IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) | |
57487 | IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE. | |
57488 | &PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL PYXTEE(KFL,ECM, | |
57489 | &XTOT) | |
57490 | IF(MSTJ(116).GE.3) MSTJ(116)=1 | |
57491 | PARJ(171)=0D0 | |
57492 | ||
57493 | C...Add initial e+e- to event record (documentation only). | |
57494 | NTRY=0 | |
57495 | 100 NTRY=NTRY+1 | |
57496 | IF(NTRY.GT.100) THEN | |
57497 | CALL PYERRM(14,'(PYEEVT:) caught in an infinite loop') | |
57498 | RETURN | |
57499 | ENDIF | |
57500 | MSTU(24)=0 | |
57501 | NC=0 | |
57502 | IF(MSTJ(115).GE.2) THEN | |
57503 | NC=NC+2 | |
57504 | CALL PY1ENT(NC-1,11,0.5D0*ECM,0D0,0D0) | |
57505 | K(NC-1,1)=21 | |
57506 | CALL PY1ENT(NC,-11,0.5D0*ECM,PARU(1),0D0) | |
57507 | K(NC,1)=21 | |
57508 | ENDIF | |
57509 | ||
57510 | C...Radiative photon (in initial state). | |
57511 | MK=0 | |
57512 | ECMC=ECM | |
57513 | IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL PYRADK(ECM,MK,PAK, | |
57514 | &THEK,PHIK,ALPK) | |
57515 | IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2D0*PAK)) | |
57516 | IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN | |
57517 | NC=NC+1 | |
57518 | CALL PY1ENT(NC,22,PAK,THEK,PHIK) | |
57519 | K(NC,3)=MIN(MSTJ(115)/2,1) | |
57520 | ENDIF | |
57521 | ||
57522 | C...Virtual exchange boson (gamma or Z0). | |
57523 | IF(MSTJ(115).GE.3) THEN | |
57524 | NC=NC+1 | |
57525 | KF=22 | |
57526 | IF(MSTJ(102).EQ.2) KF=23 | |
57527 | MSTU10=MSTU(10) | |
57528 | MSTU(10)=1 | |
57529 | P(NC,5)=ECMC | |
57530 | CALL PY1ENT(NC,KF,ECMC,0D0,0D0) | |
57531 | K(NC,1)=21 | |
57532 | K(NC,3)=1 | |
57533 | MSTU(10)=MSTU10 | |
57534 | ENDIF | |
57535 | ||
57536 | C...Choice of flavour and jet configuration. | |
57537 | CALL PYXKFL(KFL,ECM,ECMC,KFLC) | |
57538 | IF(KFLC.EQ.0) GOTO 100 | |
57539 | CALL PYXJET(ECMC,NJET,CUT) | |
57540 | KFLN=21 | |
57541 | IF(NJET.EQ.4) CALL PYX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4, | |
57542 | &X12,X14) | |
57543 | IF(NJET.EQ.3) CALL PYX3JT(NJET,CUT,KFLC,ECMC,X1,X3) | |
57544 | IF(NJET.EQ.2) MSTJ(120)=1 | |
57545 | ||
57546 | C...Fill jet configuration and origin. | |
57547 | IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL PY2ENT(NC+1,KFLC,-KFLC,ECMC) | |
57548 | IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL PY2ENT(-(NC+1),KFLC,-KFLC, | |
57549 | &ECMC) | |
57550 | IF(NJET.EQ.3) CALL PY3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3) | |
57551 | IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL PY4ENT(NC+1,KFLC,KFLN,KFLN, | |
57552 | &-KFLC,ECMC,X1,X2,X4,X12,X14) | |
57553 | IF(NJET.EQ.4.AND.KFLN.NE.21) CALL PY4ENT(NC+1,KFLC,-KFLN,KFLN, | |
57554 | &-KFLC,ECMC,X1,X2,X4,X12,X14) | |
57555 | IF(MSTU(24).NE.0) GOTO 100 | |
57556 | DO 110 IP=NC+1,N | |
57557 | K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1) | |
57558 | 110 CONTINUE | |
57559 | ||
57560 | C...Angular orientation according to matrix element. | |
57561 | IF(MSTJ(106).EQ.1) THEN | |
57562 | CALL PYXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI) | |
57563 | CALL PYROBO(NC+1,N,0D0,CHI,0D0,0D0,0D0) | |
57564 | CALL PYROBO(NC+1,N,THE,PHI,0D0,0D0,0D0) | |
57565 | ENDIF | |
57566 | ||
57567 | C...Rotation and boost from radiative photon. | |
57568 | IF(MK.EQ.1) THEN | |
57569 | DBEK=-PAK/(ECM-PAK) | |
57570 | NMIN=NC+1-MSTJ(115)/3 | |
57571 | CALL PYROBO(NMIN,N,0D0,-PHIK,0D0,0D0,0D0) | |
57572 | CALL PYROBO(NMIN,N,ALPK,0D0,DBEK*SIN(THEK),0D0,DBEK*COS(THEK)) | |
57573 | CALL PYROBO(NMIN,N,0D0,PHIK,0D0,0D0,0D0) | |
57574 | ENDIF | |
57575 | ||
57576 | C...Generate parton shower. Rearrange along strings and check. | |
57577 | IF(MSTJ(101).EQ.5) THEN | |
57578 | CALL PYSHOW(N-1,N,ECMC) | |
57579 | MSTJ14=MSTJ(14) | |
57580 | IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 | |
57581 | IF(MSTJ(105).GE.0) MSTU(28)=0 | |
57582 | CALL PYPREP(0) | |
57583 | MSTJ(14)=MSTJ14 | |
57584 | IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 | |
57585 | ENDIF | |
57586 | ||
57587 | C...Fragmentation/decay generation. Information for PYTABU. | |
57588 | IF(MSTJ(105).EQ.1) CALL PYEXEC | |
57589 | MSTU(161)=KFLC | |
57590 | MSTU(162)=-KFLC | |
57591 | ||
57592 | RETURN | |
57593 | END | |
57594 | ||
57595 | C********************************************************************* | |
57596 | ||
57597 | C...PYXTEE | |
57598 | C...Calculates total cross-section, including initial state | |
57599 | C...radiation effects. | |
57600 | ||
57601 | SUBROUTINE PYXTEE(KFL,ECM,XTOT) | |
57602 | ||
57603 | C...Double precision and integer declarations. | |
57604 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
57605 | IMPLICIT INTEGER(I-N) | |
57606 | INTEGER PYK,PYCHGE,PYCOMP | |
57607 | C...Commonblocks. | |
57608 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
57609 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
57610 | SAVE /PYDAT1/,/PYDAT2/ | |
57611 | ||
57612 | C...Status, (optimized) Q^2 scale, alpha_strong. | |
57613 | PARJ(151)=ECM | |
57614 | MSTJ(119)=10*MSTJ(102)+KFL | |
57615 | IF(MSTJ(111).EQ.0) THEN | |
57616 | Q2R=ECM**2 | |
57617 | ELSEIF(MSTU(111).EQ.0) THEN | |
57618 | PARJ(168)=MIN(1D0,MAX(PARJ(128),EXP(-12D0*PARU(1)/ | |
57619 | & ((33D0-2D0*MSTU(112))*PARU(111))))) | |
57620 | Q2R=PARJ(168)*ECM**2 | |
57621 | ELSE | |
57622 | PARJ(168)=MIN(1D0,MAX(PARJ(128),PARU(112)/ECM, | |
57623 | & (2D0*PARU(112)/ECM)**2)) | |
57624 | Q2R=PARJ(168)*ECM**2 | |
57625 | ENDIF | |
57626 | ALSPI=PYALPS(Q2R)/PARU(1) | |
57627 | ||
57628 | C...QCD corrections factor in R. | |
57629 | IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN | |
57630 | RQCD=1D0 | |
57631 | ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN | |
57632 | RQCD=1D0+ALSPI | |
57633 | ELSEIF(MSTJ(109).EQ.0) THEN | |
57634 | RQCD=1D0+ALSPI+(1.986D0-0.115D0*MSTU(118))*ALSPI**2 | |
57635 | IF(MSTJ(111).EQ.1) RQCD=MAX(1D0,RQCD+(33D0-2D0*MSTU(112))/12D0* | |
57636 | & LOG(PARJ(168))*ALSPI**2) | |
57637 | ELSEIF(IABS(MSTJ(101)).EQ.1) THEN | |
57638 | RQCD=1D0+(3D0/4D0)*ALSPI | |
57639 | ELSE | |
57640 | RQCD=1D0+(3D0/4D0)*ALSPI-(3D0/32D0+0.519D0*MSTU(118))*ALSPI**2 | |
57641 | ENDIF | |
57642 | ||
57643 | C...Calculate Z0 width if default value not acceptable. | |
57644 | IF(MSTJ(102).GE.3) THEN | |
57645 | RVA=3D0*(3D0+(4D0*PARU(102)-1D0)**2)+6D0*RQCD*(2D0+ | |
57646 | & (1D0-8D0*PARU(102)/3D0)**2+(4D0*PARU(102)/3D0-1D0)**2) | |
57647 | DO 100 KFLC=5,6 | |
57648 | VQ=1D0 | |
57649 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,1D0- | |
57650 | & (2D0*PYMASS(KFLC)/ ECM)**2)) | |
57651 | IF(KFLC.EQ.5) VF=4D0*PARU(102)/3D0-1D0 | |
57652 | IF(KFLC.EQ.6) VF=1D0-8D0*PARU(102)/3D0 | |
57653 | RVA=RVA+3D0*RQCD*(0.5D0*VQ*(3D0-VQ**2)*VF**2+VQ**3) | |
57654 | 100 CONTINUE | |
57655 | PARJ(124)=PARU(101)*PARJ(123)*RVA/(48D0*PARU(102)* | |
57656 | & (1D0-PARU(102))) | |
57657 | ENDIF | |
57658 | ||
57659 | C...Calculate propagator and related constants for QFD case. | |
57660 | POLL=1D0-PARJ(131)*PARJ(132) | |
57661 | IF(MSTJ(102).GE.2) THEN | |
57662 | SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102))) | |
57663 | SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) | |
57664 | SFI=SFW*(1D0-(PARJ(123)/ECM)**2) | |
57665 | VE=4D0*PARU(102)-1D0 | |
57666 | SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131)) | |
57667 | SF1W=SFF**2*((VE**2+1D0)*POLL+2D0*VE*(PARJ(132)-PARJ(131))) | |
57668 | HF1I=SFI*SF1I | |
57669 | HF1W=SFW*SF1W | |
57670 | ENDIF | |
57671 | ||
57672 | C...Loop over different flavours: charge, velocity. | |
57673 | RTOT=0D0 | |
57674 | RQQ=0D0 | |
57675 | RQV=0D0 | |
57676 | RVA=0D0 | |
57677 | DO 110 KFLC=1,MAX(MSTJ(104),KFL) | |
57678 | IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110 | |
57679 | MSTJ(93)=1 | |
57680 | PMQ=PYMASS(KFLC) | |
57681 | IF(ECM.LT.2D0*PMQ+PARJ(127)) GOTO 110 | |
57682 | QF=KCHG(KFLC,1)/3D0 | |
57683 | VQ=1D0 | |
57684 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1D0-(2D0*PMQ/ECM)**2) | |
57685 | ||
57686 | C...Calculate R and sum of charges for QED or QFD case. | |
57687 | RQQ=RQQ+3D0*QF**2*POLL | |
57688 | IF(MSTJ(102).LE.1) THEN | |
57689 | RTOT=RTOT+3D0*0.5D0*VQ*(3D0-VQ**2)*QF**2*POLL | |
57690 | ELSE | |
57691 | VF=SIGN(1D0,QF)-4D0*QF*PARU(102) | |
57692 | RQV=RQV-6D0*QF*VF*SF1I | |
57693 | RVA=RVA+3D0*(VF**2+1D0)*SF1W | |
57694 | RTOT=RTOT+3D0*(0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL- | |
57695 | & 2D0*QF*VF*HF1I+VF**2*HF1W)+VQ**3*HF1W) | |
57696 | ENDIF | |
57697 | 110 CONTINUE | |
57698 | RSUM=RQQ | |
57699 | IF(MSTJ(102).GE.2) RSUM=RQQ+SFI*RQV+SFW*RVA | |
57700 | ||
57701 | C...Calculate cross-section, including QCD corrections. | |
57702 | PARJ(141)=RQQ | |
57703 | PARJ(142)=RTOT | |
57704 | PARJ(143)=RTOT*RQCD | |
57705 | PARJ(144)=PARJ(143) | |
57706 | PARJ(145)=PARJ(141)*86.8D0/ECM**2 | |
57707 | PARJ(146)=PARJ(142)*86.8D0/ECM**2 | |
57708 | PARJ(147)=PARJ(143)*86.8D0/ECM**2 | |
57709 | PARJ(148)=PARJ(147) | |
57710 | PARJ(157)=RSUM*RQCD | |
57711 | PARJ(158)=0D0 | |
57712 | PARJ(159)=0D0 | |
57713 | XTOT=PARJ(147) | |
57714 | IF(MSTJ(107).LE.0) RETURN | |
57715 | ||
57716 | C...Virtual cross-section. | |
57717 | XKL=PARJ(135) | |
57718 | XKU=MIN(PARJ(136),1D0-(2D0*PARJ(127)/ECM)**2) | |
57719 | ALE=2D0*LOG(ECM/PYMASS(11))-1D0 | |
57720 | SIGV=ALE/3D0+2D0*LOG(ECM**2/(PYMASS(13)*PYMASS(15)))/3D0-4D0/3D0+ | |
57721 | &1.526D0*LOG(ECM**2/0.932D0) | |
57722 | ||
57723 | C...Soft and hard radiative cross-section in QED case. | |
57724 | IF(MSTJ(102).LE.1) THEN | |
57725 | SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+2D0*SIGV | |
57726 | SIGS=ALE*(2D0*LOG(XKL)-LOG(1D0-XKL)-XKL) | |
57727 | SIGH=ALE*(2D0*LOG(XKU/XKL)-LOG((1D0-XKU)/(1D0-XKL))-(XKU-XKL)) | |
57728 | ||
57729 | C...Soft and hard radiative cross-section in QFD case. | |
57730 | ELSE | |
57731 | SZM=1D0-(PARJ(123)/ECM)**2 | |
57732 | SZW=PARJ(123)*PARJ(124)/ECM**2 | |
57733 | PARJ(161)=-RQQ/RSUM | |
57734 | PARJ(162)=-(RQQ+RQV+RVA)/RSUM | |
57735 | PARJ(163)=(RQV*(1D0-0.5D0*SZM-SFI)+RVA*(1.5D0-SZM-SFW))/RSUM | |
57736 | PARJ(164)=(RQV*SZW**2*(1D0-2D0*SFW)+RVA*(2D0*SFI+SZW**2- | |
57737 | & 4D0+3D0*SZM-SZM**2))/(SZW*RSUM) | |
57738 | SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+((2D0*RQQ+SFI*RQV)/ | |
57739 | & RSUM)*SIGV+(SZW*SFW*RQV/RSUM)*PARU(1)*20D0/9D0 | |
57740 | SIGS=ALE*(2D0*LOG(XKL)+PARJ(161)*LOG(1D0-XKL)+PARJ(162)*XKL+ | |
57741 | & PARJ(163)*LOG(((XKL-SZM)**2+SZW**2)/(SZM**2+SZW**2))+ | |
57742 | & PARJ(164)*(ATAN((XKL-SZM)/SZW)-ATAN(-SZM/SZW))) | |
57743 | SIGH=ALE*(2D0*LOG(XKU/XKL)+PARJ(161)*LOG((1D0-XKU)/ | |
57744 | & (1D0-XKL))+PARJ(162)*(XKU-XKL)+PARJ(163)* | |
57745 | & LOG(((XKU-SZM)**2+SZW**2)/((XKL-SZM)**2+SZW**2))+ | |
57746 | & PARJ(164)*(ATAN((XKU-SZM)/SZW)-ATAN((XKL-SZM)/SZW))) | |
57747 | ENDIF | |
57748 | ||
57749 | C...Total cross-section and fraction of hard photon events. | |
57750 | PARJ(160)=SIGH/(PARU(1)/PARU(101)+SIGV+SIGS+SIGH) | |
57751 | PARJ(157)=RSUM*(1D0+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD | |
57752 | PARJ(144)=PARJ(157) | |
57753 | PARJ(148)=PARJ(144)*86.8D0/ECM**2 | |
57754 | XTOT=PARJ(148) | |
57755 | ||
57756 | RETURN | |
57757 | END | |
57758 | ||
57759 | C********************************************************************* | |
57760 | ||
57761 | C...PYRADK | |
57762 | C...Generates initial state photon radiation. | |
57763 | ||
57764 | SUBROUTINE PYRADK(ECM,MK,PAK,THEK,PHIK,ALPK) | |
57765 | ||
57766 | C...Double precision and integer declarations. | |
57767 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
57768 | IMPLICIT INTEGER(I-N) | |
57769 | INTEGER PYK,PYCHGE,PYCOMP | |
57770 | C...Commonblocks. | |
57771 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
57772 | SAVE /PYDAT1/ | |
57773 | ||
57774 | C...Function: cumulative hard photon spectrum in QFD case. | |
57775 | FXK(XX)=2D0*LOG(XX)+PARJ(161)*LOG(1D0-XX)+PARJ(162)*XX+ | |
57776 | &PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW) | |
57777 | ||
57778 | C...Determine whether radiative photon or not. | |
57779 | MK=0 | |
57780 | PAK=0D0 | |
57781 | IF(PARJ(160).LT.PYR(0)) RETURN | |
57782 | MK=1 | |
57783 | ||
57784 | C...Photon energy range. Find photon momentum in QED case. | |
57785 | XKL=PARJ(135) | |
57786 | XKU=MIN(PARJ(136),1D0-(2D0*PARJ(127)/ECM)**2) | |
57787 | IF(MSTJ(102).LE.1) THEN | |
57788 | 100 XK=1D0/(1D0+(1D0/XKL-1D0)*((1D0/XKU-1D0)/(1D0/XKL-1D0))**PYR(0)) | |
57789 | IF(1D0+(1D0-XK)**2.LT.2D0*PYR(0)) GOTO 100 | |
57790 | ||
57791 | C...Ditto in QFD case, by numerical inversion of integrated spectrum. | |
57792 | ELSE | |
57793 | SZM=1D0-(PARJ(123)/ECM)**2 | |
57794 | SZW=PARJ(123)*PARJ(124)/ECM**2 | |
57795 | FXKL=FXK(XKL) | |
57796 | FXKU=FXK(XKU) | |
57797 | FXKD=1D-4*(FXKU-FXKL) | |
57798 | FXKR=FXKL+PYR(0)*(FXKU-FXKL) | |
57799 | NXK=0 | |
57800 | 110 NXK=NXK+1 | |
57801 | XK=0.5D0*(XKL+XKU) | |
57802 | FXKV=FXK(XK) | |
57803 | IF(FXKV.GT.FXKR) THEN | |
57804 | XKU=XK | |
57805 | FXKU=FXKV | |
57806 | ELSE | |
57807 | XKL=XK | |
57808 | FXKL=FXKV | |
57809 | ENDIF | |
57810 | IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110 | |
57811 | XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL) | |
57812 | ENDIF | |
57813 | PAK=0.5D0*ECM*XK | |
57814 | ||
57815 | C...Photon polar and azimuthal angle. | |
57816 | PME=2D0*(PYMASS(11)/ECM)**2 | |
57817 | 120 CTHM=PME*(2D0/PME)**PYR(0) | |
57818 | IF(1D0-(XK**2*CTHM*(1D0-0.5D0*CTHM)+2D0*(1D0-XK)*PME/MAX(PME, | |
57819 | &CTHM*(1D0-0.5D0*CTHM)))/(1D0+(1D0-XK)**2).LT.PYR(0)) GOTO 120 | |
57820 | CTHE=1D0-CTHM | |
57821 | IF(PYR(0).GT.0.5D0) CTHE=-CTHE | |
57822 | STHE=SQRT(MAX(0D0,(CTHM-PME)*(2D0-CTHM))) | |
57823 | THEK=PYANGL(CTHE,STHE) | |
57824 | PHIK=PARU(2)*PYR(0) | |
57825 | ||
57826 | C...Rotation angle for hadronic system. | |
57827 | SGN=1D0 | |
57828 | IF(0.5D0*(2D0-XK*(1D0-CTHE))**2/((2D0-XK)**2+(XK*CTHE)**2).GT. | |
57829 | &PYR(0)) SGN=-1D0 | |
57830 | ALPK=ASIN(SGN*STHE*(XK-SGN*(2D0*SQRT(1D0-XK)-2D0+XK)*CTHE)/ | |
57831 | &(2D0-XK*(1D0-SGN*CTHE))) | |
57832 | ||
57833 | RETURN | |
57834 | END | |
57835 | ||
57836 | C********************************************************************* | |
57837 | ||
57838 | C...PYXKFL | |
57839 | C...Selects flavour for produced qqbar pair. | |
57840 | ||
57841 | SUBROUTINE PYXKFL(KFL,ECM,ECMC,KFLC) | |
57842 | ||
57843 | C...Double precision and integer declarations. | |
57844 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
57845 | IMPLICIT INTEGER(I-N) | |
57846 | INTEGER PYK,PYCHGE,PYCOMP | |
57847 | C...Commonblocks. | |
57848 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
57849 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
57850 | SAVE /PYDAT1/,/PYDAT2/ | |
57851 | ||
57852 | C...Calculate maximum weight in QED or QFD case. | |
57853 | IF(MSTJ(102).LE.1) THEN | |
57854 | RFMAX=4D0/9D0 | |
57855 | ELSE | |
57856 | POLL=1D0-PARJ(131)*PARJ(132) | |
57857 | SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102))) | |
57858 | SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) | |
57859 | SFI=SFW*(1D0-(PARJ(123)/ECMC)**2) | |
57860 | VE=4D0*PARU(102)-1D0 | |
57861 | HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) | |
57862 | HF1W=SFW*SFF**2*((VE**2+1D0)*POLL+2D0*VE*(PARJ(132)-PARJ(131))) | |
57863 | RFMAX=MAX(4D0/9D0*POLL-4D0/3D0*(1D0-8D0*PARU(102)/3D0)*HF1I+ | |
57864 | & ((1D0-8D0*PARU(102)/3D0)**2+1D0)*HF1W,1D0/9D0*POLL+2D0/3D0* | |
57865 | & (-1D0+4D0*PARU(102)/3D0)*HF1I+((-1D0+4D0*PARU(102)/3D0)**2+ | |
57866 | & 1D0)*HF1W) | |
57867 | ENDIF | |
57868 | ||
57869 | C...Choose flavour. Gives charge and velocity. | |
57870 | NTRY=0 | |
57871 | 100 NTRY=NTRY+1 | |
57872 | IF(NTRY.GT.100) THEN | |
57873 | CALL PYERRM(14,'(PYXKFL:) caught in an infinite loop') | |
57874 | KFLC=0 | |
57875 | RETURN | |
57876 | ENDIF | |
57877 | KFLC=KFL | |
57878 | IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*PYR(0)) | |
57879 | MSTJ(93)=1 | |
57880 | PMQ=PYMASS(KFLC) | |
57881 | IF(ECM.LT.2D0*PMQ+PARJ(127)) GOTO 100 | |
57882 | QF=KCHG(KFLC,1)/3D0 | |
57883 | VQ=1D0 | |
57884 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,1D0-(2D0*PMQ/ECMC)**2)) | |
57885 | ||
57886 | C...Calculate weight in QED or QFD case. | |
57887 | IF(MSTJ(102).LE.1) THEN | |
57888 | RF=QF**2 | |
57889 | RFV=0.5D0*VQ*(3D0-VQ**2)*QF**2 | |
57890 | ELSE | |
57891 | VF=SIGN(1D0,QF)-4D0*QF*PARU(102) | |
57892 | RF=QF**2*POLL-2D0*QF*VF*HF1I+(VF**2+1D0)*HF1W | |
57893 | RFV=0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-2D0*QF*VF*HF1I+VF**2*HF1W)+ | |
57894 | & VQ**3*HF1W | |
57895 | IF(RFV.GT.0D0) PARJ(171)=MIN(1D0,VQ**3*HF1W/RFV) | |
57896 | ENDIF | |
57897 | ||
57898 | C...Weighting or new event (radiative photon). Cross-section update. | |
57899 | IF(KFL.LE.0.AND.RF.LT.PYR(0)*RFMAX) GOTO 100 | |
57900 | PARJ(158)=PARJ(158)+1D0 | |
57901 | IF(ECMC.LT.2D0*PMQ+PARJ(127).OR.RFV.LT.PYR(0)*RF) KFLC=0 | |
57902 | IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100 | |
57903 | IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1D0 | |
57904 | PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158) | |
57905 | PARJ(148)=PARJ(144)*86.8D0/ECM**2 | |
57906 | ||
57907 | RETURN | |
57908 | END | |
57909 | ||
57910 | C********************************************************************* | |
57911 | ||
57912 | C...PYXJET | |
57913 | C...Selects number of jets in matrix element approach. | |
57914 | ||
57915 | SUBROUTINE PYXJET(ECM,NJET,CUT) | |
57916 | ||
57917 | C...Double precision and integer declarations. | |
57918 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
57919 | IMPLICIT INTEGER(I-N) | |
57920 | INTEGER PYK,PYCHGE,PYCOMP | |
57921 | C...Commonblocks. | |
57922 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
57923 | SAVE /PYDAT1/ | |
57924 | C...Local array and data. | |
57925 | DIMENSION ZHUT(5) | |
57926 | DATA ZHUT/3.0922D0, 6.2291D0, 7.4782D0, 7.8440D0, 8.2560D0/ | |
57927 | ||
57928 | C...Trivial result for two-jets only, including parton shower. | |
57929 | IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN | |
57930 | CUT=0D0 | |
57931 | ||
57932 | C...QCD and Abelian vector gluon theory: Q^2 for jet rate and R. | |
57933 | ELSEIF(MSTJ(109).EQ.0.OR.MSTJ(109).EQ.2) THEN | |
57934 | CF=4D0/3D0 | |
57935 | IF(MSTJ(109).EQ.2) CF=1D0 | |
57936 | IF(MSTJ(111).EQ.0) THEN | |
57937 | Q2=ECM**2 | |
57938 | Q2R=ECM**2 | |
57939 | ELSEIF(MSTU(111).EQ.0) THEN | |
57940 | PARJ(169)=MIN(1D0,PARJ(129)) | |
57941 | Q2=PARJ(169)*ECM**2 | |
57942 | PARJ(168)=MIN(1D0,MAX(PARJ(128),EXP(-12D0*PARU(1)/ | |
57943 | & ((33D0-2D0*MSTU(112))*PARU(111))))) | |
57944 | Q2R=PARJ(168)*ECM**2 | |
57945 | ELSE | |
57946 | PARJ(169)=MIN(1D0,MAX(PARJ(129),(2D0*PARU(112)/ECM)**2)) | |
57947 | Q2=PARJ(169)*ECM**2 | |
57948 | PARJ(168)=MIN(1D0,MAX(PARJ(128),PARU(112)/ECM, | |
57949 | & (2D0*PARU(112)/ECM)**2)) | |
57950 | Q2R=PARJ(168)*ECM**2 | |
57951 | ENDIF | |
57952 | ||
57953 | C...alpha_strong for R and R itself. | |
57954 | ALSPI=(3D0/4D0)*CF*PYALPS(Q2R)/PARU(1) | |
57955 | IF(IABS(MSTJ(101)).EQ.1) THEN | |
57956 | RQCD=1D0+ALSPI | |
57957 | ELSEIF(MSTJ(109).EQ.0) THEN | |
57958 | RQCD=1D0+ALSPI+(1.986D0-0.115D0*MSTU(118))*ALSPI**2 | |
57959 | IF(MSTJ(111).EQ.1) RQCD=MAX(1D0,RQCD+ | |
57960 | & (33D0-2D0*MSTU(112))/12D0*LOG(PARJ(168))*ALSPI**2) | |
57961 | ELSE | |
57962 | RQCD=1D0+ALSPI-(3D0/32D0+0.519D0*MSTU(118))*(4D0*ALSPI/3D0)**2 | |
57963 | ENDIF | |
57964 | ||
57965 | C...alpha_strong for jet rate. Initial value for y cut. | |
57966 | ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1) | |
57967 | CUT=MAX(0.001D0,PARJ(125),(PARJ(126)/ECM)**2) | |
57968 | IF(IABS(MSTJ(101)).LE.1.OR.(MSTJ(109).EQ.0.AND.MSTJ(111).EQ.0)) | |
57969 | & CUT=MAX(CUT,EXP(-SQRT(0.75D0/ALSPI))/2D0) | |
57970 | IF(MSTJ(110).EQ.2) CUT=MAX(0.01D0,MIN(0.05D0,CUT)) | |
57971 | ||
57972 | C...Parametrization of first order three-jet cross-section. | |
57973 | 100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25D0) THEN | |
57974 | PARJ(152)=0D0 | |
57975 | ELSE | |
57976 | PARJ(152)=(2D0*ALSPI/3D0)*((3D0-6D0*CUT+2D0*LOG(CUT))* | |
57977 | & LOG(CUT/(1D0-2D0*CUT))+(2.5D0+1.5D0*CUT-6.571D0)* | |
57978 | & (1D0-3D0*CUT)+5.833D0*(1D0-3D0*CUT)**2-3.894D0* | |
57979 | & (1D0-3D0*CUT)**3+1.342D0*(1D0-3D0*CUT)**4)/RQCD | |
57980 | IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2)) | |
57981 | & PARJ(152)=0D0 | |
57982 | ENDIF | |
57983 | ||
57984 | C...Parametrization of second order three-jet cross-section. | |
57985 | IF(IABS(MSTJ(101)).LE.1.OR.MSTJ(101).EQ.3.OR.MSTJ(109).EQ.2.OR. | |
57986 | & CUT.GE.0.25D0) THEN | |
57987 | PARJ(153)=0D0 | |
57988 | ELSEIF(MSTJ(110).LE.1) THEN | |
57989 | CT=LOG(1D0/CUT-2D0) | |
57990 | PARJ(153)=ALSPI**2*CT**2*(2.419D0+0.5989D0*CT+0.6782D0*CT**2- | |
57991 | & 0.2661D0*CT**3+0.01159D0*CT**4)/RQCD | |
57992 | ||
57993 | C...Interpolation in second/first order ratio for Zhu parametrization. | |
57994 | ELSEIF(MSTJ(110).EQ.2) THEN | |
57995 | IZA=0 | |
57996 | DO 110 IY=1,5 | |
57997 | IF(ABS(CUT-0.01D0*IY).LT.0.0001D0) IZA=IY | |
57998 | 110 CONTINUE | |
57999 | IF(IZA.NE.0) THEN | |
58000 | ZHURAT=ZHUT(IZA) | |
58001 | ELSE | |
58002 | IZ=100D0*CUT | |
58003 | ZHURAT=ZHUT(IZ)+(100D0*CUT-IZ)*(ZHUT(IZ+1)-ZHUT(IZ)) | |
58004 | ENDIF | |
58005 | PARJ(153)=ALSPI*PARJ(152)*ZHURAT | |
58006 | ENDIF | |
58007 | ||
58008 | C...Shift in second order three-jet cross-section with optimized Q^2. | |
58009 | IF(MSTJ(111).EQ.1.AND.IABS(MSTJ(101)).GE.2.AND.MSTJ(101).NE.3 | |
58010 | & .AND.CUT.LT.0.25D0) PARJ(153)=PARJ(153)+ | |
58011 | & (33D0-2D0*MSTU(112))/12D0*LOG(PARJ(169))*ALSPI*PARJ(152) | |
58012 | ||
58013 | C...Parametrization of second order four-jet cross-section. | |
58014 | IF(IABS(MSTJ(101)).LE.1.OR.CUT.GE.0.125D0) THEN | |
58015 | PARJ(154)=0D0 | |
58016 | ELSE | |
58017 | CT=LOG(1D0/CUT-5D0) | |
58018 | IF(CUT.LE.0.018D0) THEN | |
58019 | XQQGG=6.349D0-4.330D0*CT+0.8304D0*CT**2 | |
58020 | IF(MSTJ(109).EQ.2) XQQGG=(4D0/3D0)**2*(3.035D0-2.091D0*CT+ | |
58021 | & 0.4059D0*CT**2) | |
58022 | XQQQQ=1.25D0*(-0.1080D0+0.01486D0*CT+0.009364D0*CT**2) | |
58023 | IF(MSTJ(109).EQ.2) XQQQQ=8D0*XQQQQ | |
58024 | ELSE | |
58025 | XQQGG=-0.09773D0+0.2959D0*CT-0.2764D0*CT**2+0.08832D0*CT**3 | |
58026 | IF(MSTJ(109).EQ.2) XQQGG=(4D0/3D0)**2*(-0.04079D0+ | |
58027 | & 0.1340D0*CT-0.1326D0*CT**2+0.04365D0*CT**3) | |
58028 | XQQQQ=1.25D0*(0.003661D0-0.004888D0*CT-0.001081D0*CT**2+ | |
58029 | & 0.002093D0*CT**3) | |
58030 | IF(MSTJ(109).EQ.2) XQQQQ=8D0*XQQQQ | |
58031 | ENDIF | |
58032 | PARJ(154)=ALSPI**2*CT**2*(XQQGG+XQQQQ)/RQCD | |
58033 | PARJ(155)=XQQQQ/(XQQGG+XQQQQ) | |
58034 | ENDIF | |
58035 | ||
58036 | C...If negative three-jet rate, change y' optimization parameter. | |
58037 | IF(MSTJ(111).EQ.1.AND.PARJ(152)+PARJ(153).LT.0D0.AND. | |
58038 | & PARJ(169).LT.0.99D0) THEN | |
58039 | PARJ(169)=MIN(1D0,1.2D0*PARJ(169)) | |
58040 | Q2=PARJ(169)*ECM**2 | |
58041 | ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1) | |
58042 | GOTO 100 | |
58043 | ENDIF | |
58044 | ||
58045 | C...If too high cross-section, use harder cuts, or fail. | |
58046 | IF(PARJ(152)+PARJ(153)+PARJ(154).GE.1) THEN | |
58047 | IF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499D0.AND.MSTJ(111).EQ.1.AND. | |
58048 | & PARJ(169).LT.0.99D0) THEN | |
58049 | PARJ(169)=MIN(1D0,1.2D0*PARJ(169)) | |
58050 | Q2=PARJ(169)*ECM**2 | |
58051 | ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1) | |
58052 | GOTO 100 | |
58053 | ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499D0) THEN | |
58054 | CALL PYERRM(26, | |
58055 | & '(PYXJET:) no allowed y cut value for Zhu parametrization') | |
58056 | ENDIF | |
58057 | CUT=0.26D0*(4D0*CUT)**(PARJ(152)+PARJ(153)+ | |
58058 | & PARJ(154))**(-1D0/3D0) | |
58059 | IF(MSTJ(110).EQ.2) CUT=MAX(0.01D0,MIN(0.05D0,CUT)) | |
58060 | GOTO 100 | |
58061 | ENDIF | |
58062 | ||
58063 | C...Scalar gluon (first order only). | |
58064 | ELSE | |
58065 | ALSPI=PYALPS(ECM**2)/PARU(1) | |
58066 | CUT=MAX(0.001D0,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3D0/ALSPI)) | |
58067 | PARJ(152)=0D0 | |
58068 | IF(CUT.LT.0.25D0) PARJ(152)=(ALSPI/3D0)*((1D0-2D0*CUT)* | |
58069 | & LOG((1D0-2D0*CUT)/CUT)+0.5D0*(9D0*CUT**2-1D0)) | |
58070 | PARJ(153)=0D0 | |
58071 | PARJ(154)=0D0 | |
58072 | ENDIF | |
58073 | ||
58074 | C...Select number of jets. | |
58075 | PARJ(150)=CUT | |
58076 | IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN | |
58077 | NJET=2 | |
58078 | ELSEIF(MSTJ(101).LE.0) THEN | |
58079 | NJET=MIN(4,2-MSTJ(101)) | |
58080 | ELSE | |
58081 | RNJ=PYR(0) | |
58082 | NJET=2 | |
58083 | IF(PARJ(152)+PARJ(153)+PARJ(154).GT.RNJ) NJET=3 | |
58084 | IF(PARJ(154).GT.RNJ) NJET=4 | |
58085 | ENDIF | |
58086 | ||
58087 | RETURN | |
58088 | END | |
58089 | ||
58090 | C********************************************************************* | |
58091 | ||
58092 | C...PYX3JT | |
58093 | C...Selects the kinematical variables of three-jet events. | |
58094 | ||
58095 | SUBROUTINE PYX3JT(NJET,CUT,KFL,ECM,X1,X2) | |
58096 | ||
58097 | C...Double precision and integer declarations. | |
58098 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
58099 | IMPLICIT INTEGER(I-N) | |
58100 | INTEGER PYK,PYCHGE,PYCOMP | |
58101 | C...Commonblocks. | |
58102 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
58103 | SAVE /PYDAT1/ | |
58104 | C...Local array. | |
58105 | DIMENSION ZHUP(5,12) | |
58106 | ||
58107 | C...Coefficients of Zhu second order parametrization. | |
58108 | DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/ | |
58109 | &18.29D0, 89.56D0, 4.541D0, -52.09D0, -109.8D0, 24.90D0, | |
58110 | &11.63D0, 3.683D0, 17.50D0,0.002440D0, -1.362D0,-0.3537D0, | |
58111 | &11.42D0, 6.299D0, -22.55D0, -8.915D0, 59.25D0, -5.855D0, | |
58112 | &-32.85D0, -1.054D0, -16.90D0,0.006489D0,-0.8156D0,0.01095D0, | |
58113 | &7.847D0, -3.964D0, -35.83D0, 1.178D0, 29.39D0, 0.2806D0, | |
58114 | &47.82D0, -12.36D0, -56.72D0, 0.04054D0,-0.4365D0, 0.6062D0, | |
58115 | &5.441D0, -56.89D0, -50.27D0, 15.13D0, 114.3D0, -18.19D0, | |
58116 | &97.05D0, -1.890D0, -139.9D0, 0.08153D0,-0.4984D0, 0.9439D0, | |
58117 | &-17.65D0, 51.44D0, -58.32D0, 70.95D0, -255.7D0, -78.99D0, | |
58118 | &476.9D0, 29.65D0, -239.3D0, 0.4745D0, -1.174D0, 6.081D0/ | |
58119 | ||
58120 | C...Dilogarithm of x for x<0.5 (x>0.5 obtained by analytic trick). | |
58121 | DILOG(X)=X+X**2/4D0+X**3/9D0+X**4/16D0+X**5/25D0+X**6/36D0+ | |
58122 | &X**7/49D0 | |
58123 | ||
58124 | C...Event type. Mass effect factors and other common constants. | |
58125 | MSTJ(120)=2 | |
58126 | MSTJ(121)=0 | |
58127 | PMQ=PYMASS(KFL) | |
58128 | QME=(2D0*PMQ/ECM)**2 | |
58129 | IF(MSTJ(109).NE.1) THEN | |
58130 | CUTL=LOG(CUT) | |
58131 | CUTD=LOG(1D0/CUT-2D0) | |
58132 | IF(MSTJ(109).EQ.0) THEN | |
58133 | CF=4D0/3D0 | |
58134 | CN=3D0 | |
58135 | TR=2D0 | |
58136 | WTMX=MIN(20D0,37D0-6D0*CUTD) | |
58137 | IF(MSTJ(110).EQ.2) WTMX=2D0*(7.5D0+80D0*CUT) | |
58138 | ELSE | |
58139 | CF=1D0 | |
58140 | CN=0D0 | |
58141 | TR=12D0 | |
58142 | WTMX=0D0 | |
58143 | ENDIF | |
58144 | ||
58145 | C...Alpha_strong and effects of optimized Q^2 scale. Maximum weight. | |
58146 | ALS2PI=PARU(118)/PARU(2) | |
58147 | WTOPT=0D0 | |
58148 | IF(MSTJ(111).EQ.1) WTOPT=(33D0-2D0*MSTU(112))/6D0* | |
58149 | & LOG(PARJ(169))*ALS2PI | |
58150 | WTMAX=MAX(0D0,1D0+WTOPT+ALS2PI*WTMX) | |
58151 | ||
58152 | C...Choose three-jet events in allowed region. | |
58153 | 100 NJET=3 | |
58154 | 110 Y13L=CUTL+CUTD*PYR(0) | |
58155 | Y23L=CUTL+CUTD*PYR(0) | |
58156 | Y13=EXP(Y13L) | |
58157 | Y23=EXP(Y23L) | |
58158 | Y12=1D0-Y13-Y23 | |
58159 | IF(Y12.LE.CUT) GOTO 110 | |
58160 | IF(Y13**2+Y23**2+2D0*Y12.LE.2D0*PYR(0)) GOTO 110 | |
58161 | ||
58162 | C...Second order corrections. | |
58163 | IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN | |
58164 | Y12L=LOG(Y12) | |
58165 | Y13M=LOG(1D0-Y13) | |
58166 | Y23M=LOG(1D0-Y23) | |
58167 | Y12M=LOG(1D0-Y12) | |
58168 | IF(Y13.LE.0.5D0) Y13I=DILOG(Y13) | |
58169 | IF(Y13.GE.0.5D0) Y13I=1.644934D0-Y13L*Y13M-DILOG(1D0-Y13) | |
58170 | IF(Y23.LE.0.5D0) Y23I=DILOG(Y23) | |
58171 | IF(Y23.GE.0.5D0) Y23I=1.644934D0-Y23L*Y23M-DILOG(1D0-Y23) | |
58172 | IF(Y12.LE.0.5D0) Y12I=DILOG(Y12) | |
58173 | IF(Y12.GE.0.5D0) Y12I=1.644934D0-Y12L*Y12M-DILOG(1D0-Y12) | |
58174 | WT1=(Y13**2+Y23**2+2D0*Y12)/(Y13*Y23) | |
58175 | WT2=CF*(-2D0*(CUTL-Y12L)**2-3D0*CUTL-1D0+3.289868D0+ | |
58176 | & 2D0*(2D0*CUTL-Y12L)*CUT/Y12)+ | |
58177 | & CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2- | |
58178 | & 11D0*CUTL/6D0+67D0/18D0+1.644934D0-(2D0*CUTL-Y12L)*CUT/Y12+ | |
58179 | & (2D0*CUTL-Y13L)*CUT/Y13+(2D0*CUTL-Y23L)*CUT/Y23)+ | |
58180 | & TR*(2D0*CUTL/3D0-10D0/9D0)+ | |
58181 | & CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+ | |
58182 | & Y13L*(4D0*Y12**2+2D0*Y12*Y13+4D0*Y12*Y23+Y13*Y23)/ | |
58183 | & (Y12+Y23)**2+Y23L*(4D0*Y12**2+2D0*Y12*Y23+4D0*Y12*Y13+ | |
58184 | & Y13*Y23)/(Y12+Y13)**2)/WT1+ | |
58185 | & CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+(CN-2D0*CF)* | |
58186 | & ((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L* | |
58187 | & Y23M+1.644934D0-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)* | |
58188 | & (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934D0-Y12I-Y13I)/ | |
58189 | & (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))- | |
58190 | & 2D0*Y12L*Y12**2/(Y13+Y23)**2-4D0*Y12L*Y12/(Y13+Y23))/WT1- | |
58191 | & CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934D0-Y13I-Y23I) | |
58192 | IF(1D0+WTOPT+ALS2PI*WT2.LE.0D0) MSTJ(121)=1 | |
58193 | IF(1D0+WTOPT+ALS2PI*WT2.LE.WTMAX*PYR(0)) GOTO 110 | |
58194 | PARJ(156)=(WTOPT+ALS2PI*WT2)/(1D0+WTOPT+ALS2PI*WT2) | |
58195 | ||
58196 | ELSEIF(MSTJ(101).EQ.2.AND.MSTJ(110).EQ.2) THEN | |
58197 | C...Second order corrections; Zhu parametrization of ERT. | |
58198 | ZX=(Y23-Y13)**2 | |
58199 | ZY=1D0-Y12 | |
58200 | IZA=0 | |
58201 | DO 120 IY=1,5 | |
58202 | IF(ABS(CUT-0.01D0*IY).LT.0.0001D0) IZA=IY | |
58203 | 120 CONTINUE | |
58204 | IF(IZA.NE.0) THEN | |
58205 | IZ=IZA | |
58206 | WT2=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ | |
58207 | & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ | |
58208 | & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ | |
58209 | & ZHUP(IZ,11)/(1D0-ZY)+ZHUP(IZ,12)/ZY | |
58210 | ELSE | |
58211 | IZ=100D0*CUT | |
58212 | WTL=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ | |
58213 | & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ | |
58214 | & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ | |
58215 | & ZHUP(IZ,11)/(1D0-ZY)+ZHUP(IZ,12)/ZY | |
58216 | IZ=IZ+1 | |
58217 | WTU=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ | |
58218 | & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ | |
58219 | & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ | |
58220 | & ZHUP(IZ,11)/(1D0-ZY)+ZHUP(IZ,12)/ZY | |
58221 | WT2=WTL+(WTU-WTL)*(100D0*CUT+1D0-IZ) | |
58222 | ENDIF | |
58223 | IF(1D0+WTOPT+2D0*ALS2PI*WT2.LE.0D0) MSTJ(121)=1 | |
58224 | IF(1D0+WTOPT+2D0*ALS2PI*WT2.LE.WTMAX*PYR(0)) GOTO 110 | |
58225 | PARJ(156)=(WTOPT+2D0*ALS2PI*WT2)/(1D0+WTOPT+2D0*ALS2PI*WT2) | |
58226 | ENDIF | |
58227 | ||
58228 | C...Impose mass cuts (gives two jets). For fixed jet number new try. | |
58229 | X1=1D0-Y23 | |
58230 | X2=1D0-Y13 | |
58231 | X3=1D0-Y12 | |
58232 | IF(4D0*Y23*Y13*Y12/X3**2.LE.QME) NJET=2 | |
58233 | IF(MOD(MSTJ(103),4).GE.2.AND.IABS(MSTJ(101)).LE.1.AND.QME*X3+ | |
58234 | & 0.5D0*QME**2+(0.5D0*QME+0.25D0*QME**2)*((1D0-X2)/(1D0-X1)+ | |
58235 | & (1D0-X1)/(1D0-X2)).GT.(X1**2+X2**2)*PYR(0)) NJET=2 | |
58236 | IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 100 | |
58237 | ||
58238 | C...Scalar gluon model (first order only, no mass effects). | |
58239 | ELSE | |
58240 | 130 NJET=3 | |
58241 | 140 X3=SQRT(4D0*CUT**2+PYR(0)*((1D0-CUT)**2-4D0*CUT**2)) | |
58242 | IF(LOG((X3-CUT)/CUT).LE.PYR(0)*LOG((1D0-2D0*CUT)/CUT)) GOTO 140 | |
58243 | YD=SIGN(2D0*CUT*((X3-CUT)/CUT)**PYR(0)-X3,PYR(0)-0.5D0) | |
58244 | X1=1D0-0.5D0*(X3+YD) | |
58245 | X2=1D0-0.5D0*(X3-YD) | |
58246 | IF(4D0*(1D0-X1)*(1D0-X2)*(1D0-X3)/X3**2.LE.QME) NJET=2 | |
58247 | IF(MSTJ(102).GE.2) THEN | |
58248 | IF(X3**2-2D0*(1D0+X3)*(1D0-X1)*(1D0-X2)*PARJ(171).LT. | |
58249 | & X3**2*PYR(0)) NJET=2 | |
58250 | ENDIF | |
58251 | IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 130 | |
58252 | ENDIF | |
58253 | ||
58254 | RETURN | |
58255 | END | |
58256 | ||
58257 | C********************************************************************* | |
58258 | ||
58259 | C...PYX4JT | |
58260 | C...Selects the kinematical variables of four-jet events. | |
58261 | ||
58262 | SUBROUTINE PYX4JT(NJET,CUT,KFL,ECM,KFLN,X1,X2,X4,X12,X14) | |
58263 | ||
58264 | C...Double precision and integer declarations. | |
58265 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
58266 | IMPLICIT INTEGER(I-N) | |
58267 | INTEGER PYK,PYCHGE,PYCOMP | |
58268 | C...Commonblocks. | |
58269 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
58270 | SAVE /PYDAT1/ | |
58271 | C...Local arrays. | |
58272 | DIMENSION WTA(4),WTB(4),WTC(4),WTD(4),WTE(4) | |
58273 | ||
58274 | C...Common constants. Colour factors for QCD and Abelian gluon theory. | |
58275 | PMQ=PYMASS(KFL) | |
58276 | QME=(2D0*PMQ/ECM)**2 | |
58277 | CT=LOG(1D0/CUT-5D0) | |
58278 | IF(MSTJ(109).EQ.0) THEN | |
58279 | CF=4D0/3D0 | |
58280 | CN=3D0 | |
58281 | TR=2.5D0 | |
58282 | ELSE | |
58283 | CF=1D0 | |
58284 | CN=0D0 | |
58285 | TR=15D0 | |
58286 | ENDIF | |
58287 | ||
58288 | C...Choice of process (qqbargg or qqbarqqbar). | |
58289 | 100 NJET=4 | |
58290 | IT=1 | |
58291 | IF(PARJ(155).GT.PYR(0)) IT=2 | |
58292 | IF(MSTJ(101).LE.-3) IT=-MSTJ(101)-2 | |
58293 | IF(IT.EQ.1) WTMX=0.7D0/CUT**2 | |
58294 | IF(IT.EQ.1.AND.MSTJ(109).EQ.2) WTMX=0.6D0/CUT**2 | |
58295 | IF(IT.EQ.2) WTMX=0.1125D0*CF*TR/CUT**2 | |
58296 | ID=1 | |
58297 | ||
58298 | C...Sample the five kinematical variables (for qqgg preweighted in y34). | |
58299 | 110 Y134=3D0*CUT+(1D0-6D0*CUT)*PYR(0) | |
58300 | Y234=3D0*CUT+(1D0-6D0*CUT)*PYR(0) | |
58301 | IF(IT.EQ.1) Y34=(1D0-5D0*CUT)*EXP(-CT*PYR(0)) | |
58302 | IF(IT.EQ.2) Y34=CUT+(1D0-6D0*CUT)*PYR(0) | |
58303 | IF(Y34.LE.Y134+Y234-1D0.OR.Y34.GE.Y134*Y234) GOTO 110 | |
58304 | VT=PYR(0) | |
58305 | CP=COS(PARU(1)*PYR(0)) | |
58306 | Y14=(Y134-Y34)*VT | |
58307 | Y13=Y134-Y14-Y34 | |
58308 | VB=Y34*(1D0-Y134-Y234+Y34)/((Y134-Y34)*(Y234-Y34)) | |
58309 | Y24=0.5D0*(Y234-Y34)*(1D0-4D0*SQRT(MAX(0D0,VT*(1D0-VT)* | |
58310 | &VB*(1D0-VB)))*CP-(1D0-2D0*VT)*(1D0-2D0*VB)) | |
58311 | Y23=Y234-Y34-Y24 | |
58312 | Y12=1D0-Y134-Y23-Y24 | |
58313 | IF(MIN(Y12,Y13,Y14,Y23,Y24).LE.CUT) GOTO 110 | |
58314 | Y123=Y12+Y13+Y23 | |
58315 | Y124=Y12+Y14+Y24 | |
58316 | ||
58317 | C...Calculate matrix elements for qqgg or qqqq process. | |
58318 | IC=0 | |
58319 | WTTOT=0D0 | |
58320 | 120 IC=IC+1 | |
58321 | IF(IT.EQ.1) THEN | |
58322 | WTA(IC)=(Y12*Y34**2-Y13*Y24*Y34+Y14*Y23*Y34+3D0*Y12*Y23*Y34+ | |
58323 | & 3D0*Y12*Y14*Y34+4D0*Y12**2*Y34-Y13*Y23*Y24+2D0*Y12*Y23*Y24- | |
58324 | & Y13*Y14*Y24-2D0*Y12*Y13*Y24+2D0*Y12**2*Y24+Y14*Y23**2+2D0*Y12* | |
58325 | & Y23**2+Y14**2*Y23+4D0*Y12*Y14*Y23+4D0*Y12**2*Y23+2D0*Y12*Y14**2+ | |
58326 | & 2D0*Y12*Y13*Y14+4D0*Y12**2*Y14+2D0*Y12**2*Y13+2D0*Y12**3)/ | |
58327 | & (2D0*Y13*Y134*Y234*Y24)+(Y24*Y34+Y12*Y34+Y13*Y24- | |
58328 | & Y14*Y23+Y12*Y13)/(Y13*Y134**2)+2D0*Y23*(1D0-Y13)/ | |
58329 | & (Y13*Y134*Y24)+Y34/(2D0*Y13*Y24) | |
58330 | WTB(IC)=(Y12*Y24*Y34+Y12*Y14*Y34-Y13*Y24**2+Y13*Y14*Y24+2D0*Y12* | |
58331 | & Y14*Y24)/(Y13*Y134*Y23*Y14)+Y12*(1D0+Y34)*Y124/(Y134*Y234*Y14* | |
58332 | & Y24)-(2D0*Y13*Y24+Y14**2+Y13*Y23+2D0*Y12*Y13)/(Y13*Y134*Y14)+ | |
58333 | & Y12*Y123*Y124/(2D0*Y13*Y14*Y23*Y24) | |
58334 | WTC(IC)=-(5D0*Y12*Y34**2+2D0*Y12*Y24*Y34+2D0*Y12*Y23*Y34+ | |
58335 | & 2D0*Y12*Y14*Y34+2D0*Y12*Y13*Y34+4D0*Y12**2*Y34-Y13*Y24**2+ | |
58336 | & Y14*Y23*Y24+Y13*Y23*Y24+Y13*Y14*Y24-Y12*Y14*Y24-Y13**2*Y24- | |
58337 | & 3D0*Y12*Y13*Y24-Y14*Y23**2-Y14**2*Y23+Y13*Y14*Y23- | |
58338 | & 3D0*Y12*Y14*Y23-Y12*Y13*Y23)/(4D0*Y134*Y234*Y34**2)+ | |
58339 | & (3D0*Y12*Y34**2-3D0*Y13*Y24*Y34+3D0*Y12*Y24*Y34+ | |
58340 | & 3D0*Y14*Y23*Y34-Y13*Y24**2-Y12*Y23*Y34+6D0*Y12*Y14*Y34+ | |
58341 | & 2D0*Y12*Y13*Y34-2D0*Y12**2*Y34+Y14*Y23*Y24-3D0*Y13*Y23*Y24- | |
58342 | & 2D0*Y13*Y14*Y24+4D0*Y12*Y14*Y24+2D0*Y12*Y13*Y24+ | |
58343 | & 3D0*Y14*Y23**2+2D0*Y14**2*Y23+2D0*Y14**2*Y12+ | |
58344 | & 2D0*Y12**2*Y14+6D0*Y12*Y14*Y23-2D0*Y12*Y13**2- | |
58345 | & 2D0*Y12**2*Y13)/(4D0*Y13*Y134*Y234*Y34) | |
58346 | WTC(IC)=WTC(IC)+(2D0*Y12*Y34**2-2D0*Y13*Y24*Y34+Y12*Y24*Y34+ | |
58347 | & 4D0*Y13*Y23*Y34+4D0*Y12*Y14*Y34+2D0*Y12*Y13*Y34+2D0*Y12**2*Y34- | |
58348 | & Y13*Y24**2+3D0*Y14*Y23*Y24+4D0*Y13*Y23*Y24-2D0*Y13*Y14*Y24+ | |
58349 | & 4D0*Y12*Y14*Y24+2D0*Y12*Y13*Y24+2D0*Y14*Y23**2+4D0*Y13*Y23**2+ | |
58350 | & 2D0*Y13*Y14*Y23+2D0*Y12*Y14*Y23+4D0*Y12*Y13*Y23+2D0*Y12*Y14**2+ | |
58351 | & 4D0*Y12**2*Y13+4D0*Y12*Y13*Y14+2D0*Y12**2*Y14)/ | |
58352 | & (4D0*Y13*Y134*Y24*Y34)-(Y12*Y34**2-2D0*Y14*Y24*Y34- | |
58353 | & 2D0*Y13*Y24*Y34-Y14*Y23*Y34+Y13*Y23*Y34+Y12*Y14*Y34+ | |
58354 | & 2D0*Y12*Y13*Y34-2D0*Y14**2*Y24-4D0*Y13*Y14*Y24- | |
58355 | & 4D0*Y13**2*Y24-Y14**2*Y23-Y13**2*Y23+Y12*Y13*Y14- | |
58356 | & Y12*Y13**2)/(2D0*Y13*Y34*Y134**2)+(Y12*Y34**2- | |
58357 | & 4D0*Y14*Y24*Y34-2D0*Y13*Y24*Y34-2D0*Y14*Y23*Y34- | |
58358 | & 4D0*Y13*Y23*Y34-4D0*Y12*Y14*Y34-4D0*Y12*Y13*Y34- | |
58359 | & 2D0*Y13*Y14*Y24+2D0*Y13**2*Y24+2D0*Y14**2*Y23- | |
58360 | & 2D0*Y13*Y14*Y23-Y12*Y14**2-6D0*Y12*Y13*Y14- | |
58361 | & Y12*Y13**2)/(4D0*Y34**2*Y134**2) | |
58362 | WTTOT=WTTOT+Y34*CF*(CF*WTA(IC)+(CF-0.5D0*CN)*WTB(IC)+ | |
58363 | & CN*WTC(IC))/8D0 | |
58364 | ELSE | |
58365 | WTD(IC)=(Y13*Y23*Y34+Y12*Y23*Y34-Y12**2*Y34+Y13*Y23*Y24+2D0*Y12* | |
58366 | & Y23*Y24-Y14*Y23**2+Y12*Y13*Y24+Y12*Y14*Y23+Y12*Y13*Y14)/(Y13**2* | |
58367 | & Y123**2)-(Y12*Y34**2-Y13*Y24*Y34+Y12*Y24*Y34-Y14*Y23*Y34-Y12* | |
58368 | & Y23*Y34-Y13*Y24**2+Y14*Y23*Y24-Y13*Y23*Y24-Y13**2*Y24+Y14* | |
58369 | & Y23**2)/(Y13**2*Y123*Y134)+(Y13*Y14*Y12+Y34*Y14*Y12-Y34**2*Y12+ | |
58370 | & Y13*Y14*Y24+2D0*Y34*Y14*Y24-Y23*Y14**2+Y34*Y13*Y24+Y34*Y23*Y14+ | |
58371 | & Y34*Y13*Y23)/(Y13**2*Y134**2)-(Y34*Y12**2-Y13*Y24*Y12+Y34*Y24* | |
58372 | & Y12-Y23*Y14*Y12-Y34*Y14*Y12-Y13*Y24**2+Y23*Y14*Y24-Y13*Y14*Y24- | |
58373 | & Y13**2*Y24+Y23*Y14**2)/(Y13**2*Y134*Y123) | |
58374 | WTE(IC)=(Y12*Y34*(Y23-Y24+Y14+Y13)+Y13*Y24**2-Y14*Y23*Y24+Y13* | |
58375 | & Y23*Y24+Y13*Y14*Y24+Y13**2*Y24-Y14*Y23*(Y14+Y23+Y13))/(Y13*Y23* | |
58376 | & Y123*Y134)-Y12*(Y12*Y34-Y23*Y24-Y13*Y24-Y14*Y23-Y14*Y13)/(Y13* | |
58377 | & Y23*Y123**2)-(Y14+Y13)*(Y24+Y23)*Y34/(Y13*Y23*Y134*Y234)+ | |
58378 | & (Y12*Y34*(Y14-Y24+Y23+Y13)+Y13*Y24**2-Y23*Y14*Y24+Y13*Y14*Y24+ | |
58379 | & Y13*Y23*Y24+Y13**2*Y24-Y23*Y14*(Y14+Y23+Y13))/(Y13*Y14*Y134* | |
58380 | & Y123)-Y34*(Y34*Y12-Y14*Y24-Y13*Y24-Y23*Y14-Y23*Y13)/(Y13*Y14* | |
58381 | & Y134**2)-(Y23+Y13)*(Y24+Y14)*Y12/(Y13*Y14*Y123*Y124) | |
58382 | WTTOT=WTTOT+CF*(TR*WTD(IC)+(CF-0.5D0*CN)*WTE(IC))/16D0 | |
58383 | ENDIF | |
58384 | ||
58385 | C...Permutations of momenta in matrix element. Weighting. | |
58386 | 130 IF(IC.EQ.1.OR.IC.EQ.3.OR.ID.EQ.2.OR.ID.EQ.3) THEN | |
58387 | YSAV=Y13 | |
58388 | Y13=Y14 | |
58389 | Y14=YSAV | |
58390 | YSAV=Y23 | |
58391 | Y23=Y24 | |
58392 | Y24=YSAV | |
58393 | YSAV=Y123 | |
58394 | Y123=Y124 | |
58395 | Y124=YSAV | |
58396 | ENDIF | |
58397 | IF(IC.EQ.2.OR.IC.EQ.4.OR.ID.EQ.3.OR.ID.EQ.4) THEN | |
58398 | YSAV=Y13 | |
58399 | Y13=Y23 | |
58400 | Y23=YSAV | |
58401 | YSAV=Y14 | |
58402 | Y14=Y24 | |
58403 | Y24=YSAV | |
58404 | YSAV=Y134 | |
58405 | Y134=Y234 | |
58406 | Y234=YSAV | |
58407 | ENDIF | |
58408 | IF(IC.LE.3) GOTO 120 | |
58409 | IF(ID.EQ.1.AND.WTTOT.LT.PYR(0)*WTMX) GOTO 110 | |
58410 | IC=5 | |
58411 | ||
58412 | C...qqgg events: string configuration and event type. | |
58413 | IF(IT.EQ.1) THEN | |
58414 | IF(MSTJ(109).EQ.0.AND.ID.EQ.1) THEN | |
58415 | PARJ(156)=Y34*(2D0*(WTA(1)+WTA(2)+WTA(3)+WTA(4))+4D0*(WTC(1)+ | |
58416 | & WTC(2)+WTC(3)+WTC(4)))/(9D0*WTTOT) | |
58417 | IF(WTA(2)+WTA(4)+2D0*(WTC(2)+WTC(4)).GT.PYR(0)*(WTA(1)+WTA(2)+ | |
58418 | & WTA(3)+WTA(4)+2D0*(WTC(1)+WTC(2)+WTC(3)+WTC(4)))) ID=2 | |
58419 | IF(ID.EQ.2) GOTO 130 | |
58420 | ELSEIF(MSTJ(109).EQ.2.AND.ID.EQ.1) THEN | |
58421 | PARJ(156)=Y34*(WTA(1)+WTA(2)+WTA(3)+WTA(4))/(8D0*WTTOT) | |
58422 | IF(WTA(2)+WTA(4).GT.PYR(0)*(WTA(1)+WTA(2)+WTA(3)+WTA(4))) ID=2 | |
58423 | IF(ID.EQ.2) GOTO 130 | |
58424 | ENDIF | |
58425 | MSTJ(120)=3 | |
58426 | IF(MSTJ(109).EQ.0.AND.0.5D0*Y34*(WTC(1)+WTC(2)+WTC(3)+ | |
58427 | & WTC(4)).GT.PYR(0)*WTTOT) MSTJ(120)=4 | |
58428 | KFLN=21 | |
58429 | ||
58430 | C...Mass cuts. Kinematical variables out. | |
58431 | IF(Y12.LE.CUT+QME) NJET=2 | |
58432 | IF(NJET.EQ.2) GOTO 150 | |
58433 | Q12=0.5D0*(1D0-SQRT(1D0-QME/Y12)) | |
58434 | X1=1D0-(1D0-Q12)*Y234-Q12*Y134 | |
58435 | X4=1D0-(1D0-Q12)*Y134-Q12*Y234 | |
58436 | X2=1D0-Y124 | |
58437 | X12=(1D0-Q12)*Y13+Q12*Y23 | |
58438 | X14=Y12-0.5D0*QME | |
58439 | IF(Y134*Y234/((1D0-X1)*(1D0-X4)).LE.PYR(0)) NJET=2 | |
58440 | ||
58441 | C...qqbarqqbar events: string configuration, choose new flavour. | |
58442 | ELSE | |
58443 | IF(ID.EQ.1) THEN | |
58444 | WTR=PYR(0)*(WTD(1)+WTD(2)+WTD(3)+WTD(4)) | |
58445 | IF(WTR.LT.WTD(2)+WTD(3)+WTD(4)) ID=2 | |
58446 | IF(WTR.LT.WTD(3)+WTD(4)) ID=3 | |
58447 | IF(WTR.LT.WTD(4)) ID=4 | |
58448 | IF(ID.GE.2) GOTO 130 | |
58449 | ENDIF | |
58450 | MSTJ(120)=5 | |
58451 | PARJ(156)=CF*TR*(WTD(1)+WTD(2)+WTD(3)+WTD(4))/(16D0*WTTOT) | |
58452 | 140 KFLN=1+INT(5D0*PYR(0)) | |
58453 | IF(KFLN.NE.KFL.AND.0.2D0*PARJ(156).LE.PYR(0)) GOTO 140 | |
58454 | IF(KFLN.EQ.KFL.AND.1D0-0.8D0*PARJ(156).LE.PYR(0)) GOTO 140 | |
58455 | IF(KFLN.GT.MSTJ(104)) NJET=2 | |
58456 | PMQN=PYMASS(KFLN) | |
58457 | QMEN=(2D0*PMQN/ECM)**2 | |
58458 | ||
58459 | C...Mass cuts. Kinematical variables out. | |
58460 | IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1D0*QMEN) NJET=2 | |
58461 | IF(NJET.EQ.2) GOTO 150 | |
58462 | Q24=0.5D0*(1D0-SQRT(1D0-QME/Y24)) | |
58463 | Q13=0.5D0*(1D0-SQRT(1D0-QMEN/Y13)) | |
58464 | X1=1D0-(1D0-Q24)*Y123-Q24*Y134 | |
58465 | X4=1D0-(1D0-Q24)*Y134-Q24*Y123 | |
58466 | X2=1D0-(1D0-Q13)*Y234-Q13*Y124 | |
58467 | X12=(1D0-Q24)*((1D0-Q13)*Y14+Q13*Y34)+Q24*((1D0-Q13)*Y12+ | |
58468 | & Q13*Y23) | |
58469 | X14=Y24-0.5D0*QME | |
58470 | X34=(1D0-Q24)*((1D0-Q13)*Y23+Q13*Y12)+Q24*((1D0-Q13)*Y34+ | |
58471 | & Q13*Y14) | |
58472 | IF(PMQ**2+PMQN**2+MIN(X12,X34)*ECM**2.LE. | |
58473 | & (PARJ(127)+PMQ+PMQN)**2) NJET=2 | |
58474 | IF(Y123*Y134/((1D0-X1)*(1D0-X4)).LE.PYR(0)) NJET=2 | |
58475 | ENDIF | |
58476 | 150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100 | |
58477 | ||
58478 | RETURN | |
58479 | END | |
58480 | ||
58481 | C********************************************************************* | |
58482 | ||
58483 | C...PYXDIF | |
58484 | C...Gives the angular orientation of events. | |
58485 | ||
58486 | SUBROUTINE PYXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI) | |
58487 | ||
58488 | C...Double precision and integer declarations. | |
58489 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
58490 | IMPLICIT INTEGER(I-N) | |
58491 | INTEGER PYK,PYCHGE,PYCOMP | |
58492 | C...Commonblocks. | |
58493 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
58494 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
58495 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
58496 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
58497 | ||
58498 | C...Charge. Factors depending on polarization for QED case. | |
58499 | QF=KCHG(KFL,1)/3D0 | |
58500 | POLL=1D0-PARJ(131)*PARJ(132) | |
58501 | POLD=PARJ(132)-PARJ(131) | |
58502 | IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN | |
58503 | HF1=POLL | |
58504 | HF2=0D0 | |
58505 | HF3=PARJ(133)**2 | |
58506 | HF4=0D0 | |
58507 | ||
58508 | C...Factors depending on flavour, energy and polarization for QFD case. | |
58509 | ELSE | |
58510 | SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102))) | |
58511 | SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) | |
58512 | SFI=SFW*(1D0-(PARJ(123)/ECM)**2) | |
58513 | AE=-1D0 | |
58514 | VE=4D0*PARU(102)-1D0 | |
58515 | AF=SIGN(1D0,QF) | |
58516 | VF=AF-4D0*QF*PARU(102) | |
58517 | HF1=QF**2*POLL-2D0*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+ | |
58518 | & (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2D0*VE*AE*POLD) | |
58519 | HF2=-2D0*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2D0*VF*AF*SFW*SFF**2* | |
58520 | & (2D0*VE*AE*POLL-(VE**2+AE**2)*POLD) | |
58521 | HF3=PARJ(133)**2*(QF**2-2D0*QF*VF*SFI*SFF*VE+(VF**2+AF**2)* | |
58522 | & SFW*SFF**2*(VE**2-AE**2)) | |
58523 | HF4=-PARJ(133)**2*2D0*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)* | |
58524 | & SFF*AE | |
58525 | ENDIF | |
58526 | ||
58527 | C...Mass factor. Differential cross-sections for two-jet events. | |
58528 | SQ2=SQRT(2D0) | |
58529 | QME=0D0 | |
58530 | IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND. | |
58531 | &MSTJ(109).NE.1) QME=(2D0*PYMASS(KFL)/ECM)**2 | |
58532 | IF(NJET.EQ.2) THEN | |
58533 | SIGU=4D0*SQRT(1D0-QME) | |
58534 | SIGL=2D0*QME*SQRT(1D0-QME) | |
58535 | SIGT=0D0 | |
58536 | SIGI=0D0 | |
58537 | SIGA=0D0 | |
58538 | SIGP=4D0 | |
58539 | ||
58540 | C...Kinematical variables. Reduce four-jet event to three-jet one. | |
58541 | ELSE | |
58542 | IF(NJET.EQ.3) THEN | |
58543 | X1=2D0*P(NC+1,4)/ECM | |
58544 | X2=2D0*P(NC+3,4)/ECM | |
58545 | ELSE | |
58546 | ECMR=P(NC+1,4)+P(NC+4,4)+SQRT((P(NC+2,1)+P(NC+3,1))**2+ | |
58547 | & (P(NC+2,2)+P(NC+3,2))**2+(P(NC+2,3)+P(NC+3,3))**2) | |
58548 | X1=2D0*P(NC+1,4)/ECMR | |
58549 | X2=2D0*P(NC+4,4)/ECMR | |
58550 | ENDIF | |
58551 | ||
58552 | C...Differential cross-sections for three-jet (or reduced four-jet). | |
58553 | XQ=(1D0-X1)/(1D0-X2) | |
58554 | CT12=(X1*X2-2D0*X1-2D0*X2+2D0+QME)/SQRT((X1**2-QME)*(X2**2-QME)) | |
58555 | ST12=SQRT(1D0-CT12**2) | |
58556 | IF(MSTJ(109).NE.1) THEN | |
58557 | SIGU=2D0*X1**2+X2**2*(1D0+CT12**2)-QME*(3D0+CT12**2-X1-X2)- | |
58558 | & QME*X1/XQ+0.5D0*QME*((X2**2-QME)*ST12**2-2D0*X2)*XQ | |
58559 | SIGL=(X2*ST12)**2-QME*(3D0-CT12**2-2.5D0*(X1+X2)+X1*X2+QME)+ | |
58560 | & 0.5D0*QME*(X1**2-X1-QME)/XQ+0.5D0*QME*((X2**2-QME)*CT12**2- | |
58561 | & X2)*XQ | |
58562 | SIGT=0.5D0*(X2**2-QME-0.5D0*QME*(X2**2-QME)/XQ)*ST12**2 | |
58563 | SIGI=((1D0-0.5D0*QME*XQ)*(X2**2-QME)*ST12*CT12+ | |
58564 | & QME*(1D0-X1-X2+0.5D0*X1*X2+0.5D0*QME)*ST12/CT12)/SQ2 | |
58565 | SIGA=X2**2*ST12/SQ2 | |
58566 | SIGP=2D0*(X1**2-X2**2*CT12) | |
58567 | ||
58568 | C...Differential cross-sect for scalar gluons (no mass effects). | |
58569 | ELSE | |
58570 | X3=2D0-X1-X2 | |
58571 | XT=X2*ST12 | |
58572 | CT13=SQRT(MAX(0D0,1D0-(XT/X3)**2)) | |
58573 | SIGU=(1D0-PARJ(171))*(X3**2-0.5D0*XT**2)+ | |
58574 | & PARJ(171)*(X3**2-0.5D0*XT**2-4D0*(1D0-X1)*(1D0-X2)**2/X1) | |
58575 | SIGL=(1D0-PARJ(171))*0.5D0*XT**2+ | |
58576 | & PARJ(171)*0.5D0*(1D0-X1)**2*XT**2 | |
58577 | SIGT=(1D0-PARJ(171))*0.25D0*XT**2+ | |
58578 | & PARJ(171)*0.25D0*XT**2*(1D0-2D0*X1) | |
58579 | SIGI=-(0.5D0/SQ2)*((1D0-PARJ(171))*XT*X3*CT13+ | |
58580 | & PARJ(171)*XT*((1D0-2D0*X1)*X3*CT13-X1*(X1-X2))) | |
58581 | SIGA=(0.25D0/SQ2)*XT*(2D0*(1D0-X1)-X1*X3) | |
58582 | SIGP=X3**2-2D0*(1D0-X1)*(1D0-X2)/X1 | |
58583 | ENDIF | |
58584 | ENDIF | |
58585 | ||
58586 | C...Upper bounds for differential cross-section. | |
58587 | HF1A=ABS(HF1) | |
58588 | HF2A=ABS(HF2) | |
58589 | HF3A=ABS(HF3) | |
58590 | HF4A=ABS(HF4) | |
58591 | SIGMAX=(2D0*HF1A+HF3A+HF4A)*ABS(SIGU)+2D0*(HF1A+HF3A+HF4A)* | |
58592 | &ABS(SIGL)+2D0*(HF1A+2D0*HF3A+2D0*HF4A)*ABS(SIGT)+2D0*SQ2* | |
58593 | &(HF1A+2D0*HF3A+2D0*HF4A)*ABS(SIGI)+4D0*SQ2*HF2A*ABS(SIGA)+ | |
58594 | &2D0*HF2A*ABS(SIGP) | |
58595 | ||
58596 | C...Generate angular orientation according to differential cross-sect. | |
58597 | 100 CHI=PARU(2)*PYR(0) | |
58598 | CTHE=2D0*PYR(0)-1D0 | |
58599 | PHI=PARU(2)*PYR(0) | |
58600 | CCHI=COS(CHI) | |
58601 | SCHI=SIN(CHI) | |
58602 | C2CHI=COS(2D0*CHI) | |
58603 | S2CHI=SIN(2D0*CHI) | |
58604 | THE=ACOS(CTHE) | |
58605 | STHE=SIN(THE) | |
58606 | C2PHI=COS(2D0*(PHI-PARJ(134))) | |
58607 | S2PHI=SIN(2D0*(PHI-PARJ(134))) | |
58608 | SIG=((1D0+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+ | |
58609 | &2D0*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+ | |
58610 | &2D0*(STHE**2*C2CHI*HF1+((1D0+CTHE**2)*C2CHI*C2PHI-2D0*CTHE*S2CHI* | |
58611 | &S2PHI)*HF3-((1D0+CTHE**2)*C2CHI*S2PHI+2D0*CTHE*S2CHI*C2PHI)*HF4)* | |
58612 | &SIGT-2D0*SQ2*(2D0*STHE*CTHE*CCHI*HF1-2D0*STHE*(CTHE*CCHI*C2PHI- | |
58613 | &SCHI*S2PHI)*HF3+2D0*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+ | |
58614 | &4D0*SQ2*STHE*CCHI*HF2*SIGA+2D0*CTHE*HF2*SIGP | |
58615 | IF(SIG.LT.SIGMAX*PYR(0)) GOTO 100 | |
58616 | ||
58617 | RETURN | |
58618 | END | |
58619 | ||
58620 | C********************************************************************* | |
58621 | ||
58622 | C...PYONIA | |
58623 | C...Generates Upsilon and toponium decays into three gluons | |
58624 | C...or two gluons and a photon. | |
58625 | ||
58626 | SUBROUTINE PYONIA(KFL,ECM) | |
58627 | ||
58628 | C...Double precision and integer declarations. | |
58629 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
58630 | IMPLICIT INTEGER(I-N) | |
58631 | INTEGER PYK,PYCHGE,PYCOMP | |
58632 | C...Commonblocks. | |
58633 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
58634 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
58635 | COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) | |
58636 | SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ | |
58637 | ||
58638 | C...Printout. Check input parameters. | |
58639 | IF(MSTU(12).GE.1) CALL PYLIST(0) | |
58640 | IF(KFL.LT.0.OR.KFL.GT.8) THEN | |
58641 | CALL PYERRM(16,'(PYONIA:) called with unknown flavour code') | |
58642 | IF(MSTU(21).GE.1) RETURN | |
58643 | ENDIF | |
58644 | IF(ECM.LT.PARJ(127)+2.02D0*PARF(101)) THEN | |
58645 | CALL PYERRM(16,'(PYONIA:) called with too small CM energy') | |
58646 | IF(MSTU(21).GE.1) RETURN | |
58647 | ENDIF | |
58648 | ||
58649 | C...Initial e+e- and onium state (optional). | |
58650 | NC=0 | |
58651 | IF(MSTJ(115).GE.2) THEN | |
58652 | NC=NC+2 | |
58653 | CALL PY1ENT(NC-1,11,0.5D0*ECM,0D0,0D0) | |
58654 | K(NC-1,1)=21 | |
58655 | CALL PY1ENT(NC,-11,0.5D0*ECM,PARU(1),0D0) | |
58656 | K(NC,1)=21 | |
58657 | ENDIF | |
58658 | KFLC=IABS(KFL) | |
58659 | IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN | |
58660 | NC=NC+1 | |
58661 | KF=110*KFLC+3 | |
58662 | MSTU10=MSTU(10) | |
58663 | MSTU(10)=1 | |
58664 | P(NC,5)=ECM | |
58665 | CALL PY1ENT(NC,KF,ECM,0D0,0D0) | |
58666 | K(NC,1)=21 | |
58667 | K(NC,3)=1 | |
58668 | MSTU(10)=MSTU10 | |
58669 | ENDIF | |
58670 | ||
58671 | C...Choose x1 and x2 according to matrix element. | |
58672 | NTRY=0 | |
58673 | 100 X1=PYR(0) | |
58674 | X2=PYR(0) | |
58675 | X3=2D0-X1-X2 | |
58676 | IF(X3.GE.1D0.OR.((1D0-X1)/(X2*X3))**2+((1D0-X2)/(X1*X3))**2+ | |
58677 | &((1D0-X3)/(X1*X2))**2.LE.2D0*PYR(0)) GOTO 100 | |
58678 | NTRY=NTRY+1 | |
58679 | NJET=3 | |
58680 | IF(MSTJ(101).LE.4) CALL PY3ENT(NC+1,21,21,21,ECM,X1,X3) | |
58681 | IF(MSTJ(101).GE.5) CALL PY3ENT(-(NC+1),21,21,21,ECM,X1,X3) | |
58682 | ||
58683 | C...Photon-gluon-gluon events. Small system modifications. Jet origin. | |
58684 | MSTU(111)=MSTJ(108) | |
58685 | IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) | |
58686 | &MSTU(111)=1 | |
58687 | PARU(112)=PARJ(121) | |
58688 | IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) | |
58689 | QF=0D0 | |
58690 | IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3D0 | |
58691 | RGAM=7.2D0*QF**2*PARU(101)/PYALPS(ECM**2) | |
58692 | MK=0 | |
58693 | ECMC=ECM | |
58694 | IF(PYR(0).GT.RGAM/(1D0+RGAM)) THEN | |
58695 | IF(1D0-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125))) | |
58696 | & NJET=2 | |
58697 | IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL PY2ENT(NC+1,21,21,ECM) | |
58698 | IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL PY2ENT(-(NC+1),21,21,ECM) | |
58699 | ELSE | |
58700 | MK=1 | |
58701 | ECMC=SQRT(1D0-X1)*ECM | |
58702 | IF(ECMC.LT.2D0*PARJ(127)) GOTO 100 | |
58703 | K(NC+1,1)=1 | |
58704 | K(NC+1,2)=22 | |
58705 | K(NC+1,4)=0 | |
58706 | K(NC+1,5)=0 | |
58707 | IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3) | |
58708 | IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3) | |
58709 | IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2) | |
58710 | IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2) | |
58711 | NJET=2 | |
58712 | IF(ECMC.LT.4D0*PARJ(127)) THEN | |
58713 | MSTU10=MSTU(10) | |
58714 | MSTU(10)=1 | |
58715 | P(NC+2,5)=ECMC | |
58716 | CALL PY1ENT(NC+2,83,0.5D0*(X2+X3)*ECM,PARU(1),0D0) | |
58717 | MSTU(10)=MSTU10 | |
58718 | NJET=0 | |
58719 | ENDIF | |
58720 | ENDIF | |
58721 | DO 110 IP=NC+1,N | |
58722 | K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1) | |
58723 | 110 CONTINUE | |
58724 | ||
58725 | C...Differential cross-sections. Upper limit for cross-section. | |
58726 | IF(MSTJ(106).EQ.1) THEN | |
58727 | SQ2=SQRT(2D0) | |
58728 | HF1=1D0-PARJ(131)*PARJ(132) | |
58729 | HF3=PARJ(133)**2 | |
58730 | CT13=(X1*X3-2D0*X1-2D0*X3+2D0)/(X1*X3) | |
58731 | ST13=SQRT(1D0-CT13**2) | |
58732 | SIGL=0.5D0*X3**2*((1D0-X2)**2+(1D0-X3)**2)*ST13**2 | |
58733 | SIGU=(X1*(1D0-X1))**2+(X2*(1D0-X2))**2+(X3*(1D0-X3))**2-SIGL | |
58734 | SIGT=0.5D0*SIGL | |
58735 | SIGI=(SIGL*CT13/ST13+0.5D0*X1*X3*(1D0-X2)**2*ST13)/SQ2 | |
58736 | SIGMAX=(2D0*HF1+HF3)*ABS(SIGU)+2D0*(HF1+HF3)*ABS(SIGL)+2D0*(HF1+ | |
58737 | & 2D0*HF3)*ABS(SIGT)+2D0*SQ2*(HF1+2D0*HF3)*ABS(SIGI) | |
58738 | ||
58739 | C...Angular orientation of event. | |
58740 | 120 CHI=PARU(2)*PYR(0) | |
58741 | CTHE=2D0*PYR(0)-1D0 | |
58742 | PHI=PARU(2)*PYR(0) | |
58743 | CCHI=COS(CHI) | |
58744 | SCHI=SIN(CHI) | |
58745 | C2CHI=COS(2D0*CHI) | |
58746 | S2CHI=SIN(2D0*CHI) | |
58747 | THE=ACOS(CTHE) | |
58748 | STHE=SIN(THE) | |
58749 | C2PHI=COS(2D0*(PHI-PARJ(134))) | |
58750 | S2PHI=SIN(2D0*(PHI-PARJ(134))) | |
58751 | SIG=((1D0+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2D0*(STHE**2*HF1- | |
58752 | & STHE**2*C2PHI*HF3)*SIGL+2D0*(STHE**2*C2CHI*HF1+((1D0+CTHE**2)* | |
58753 | & C2CHI*C2PHI-2D0*CTHE*S2CHI*S2PHI)*HF3)*SIGT- | |
58754 | & 2D0*SQ2*(2D0*STHE*CTHE*CCHI*HF1-2D0*STHE* | |
58755 | & (CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI | |
58756 | IF(SIG.LT.SIGMAX*PYR(0)) GOTO 120 | |
58757 | CALL PYROBO(NC+1,N,0D0,CHI,0D0,0D0,0D0) | |
58758 | CALL PYROBO(NC+1,N,THE,PHI,0D0,0D0,0D0) | |
58759 | ENDIF | |
58760 | ||
58761 | C...Generate parton shower. Rearrange along strings and check. | |
58762 | IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN | |
58763 | CALL PYSHOW(NC+MK+1,-NJET,ECMC) | |
58764 | MSTJ14=MSTJ(14) | |
58765 | IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 | |
58766 | IF(MSTJ(105).GE.0) MSTU(28)=0 | |
58767 | CALL PYPREP(0) | |
58768 | MSTJ(14)=MSTJ14 | |
58769 | IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 | |
58770 | ENDIF | |
58771 | ||
58772 | C...Generate fragmentation. Information for PYTABU: | |
58773 | IF(MSTJ(105).EQ.1) CALL PYEXEC | |
58774 | MSTU(161)=110*KFLC+3 | |
58775 | MSTU(162)=0 | |
58776 | ||
58777 | RETURN | |
58778 | END | |
58779 | ||
58780 | C********************************************************************* | |
58781 | ||
58782 | C...PYBOOK | |
58783 | C...Books a histogram. | |
58784 | ||
58785 | SUBROUTINE PYBOOK(ID,TITLE,NX,XL,XU) | |
58786 | ||
58787 | C...Double precision declaration. | |
58788 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
58789 | IMPLICIT INTEGER(I-N) | |
58790 | C...Commonblock. | |
58791 | COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) | |
58792 | SAVE /PYBINS/ | |
58793 | C...Local character variables. | |
58794 | CHARACTER TITLE*(*), TITFX*60 | |
58795 | ||
58796 | C...Check that input is sensible. Find initial address in memory. | |
58797 | IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28, | |
58798 | &'(PYBOOK:) not allowed histogram number') | |
58799 | IF(NX.LE.0.OR.NX.GT.100) CALL PYERRM(28, | |
58800 | &'(PYBOOK:) not allowed number of bins') | |
58801 | IF(XL.GE.XU) CALL PYERRM(28, | |
58802 | &'(PYBOOK:) x limits in wrong order') | |
58803 | INDX(ID)=IHIST(4) | |
58804 | IHIST(4)=IHIST(4)+28+NX | |
58805 | IF(IHIST(4).GT.IHIST(2)) CALL PYERRM(28, | |
58806 | &'(PYBOOK:) out of histogram space') | |
58807 | IS=INDX(ID) | |
58808 | ||
58809 | C...Store histogram size and reset contents. | |
58810 | BIN(IS+1)=NX | |
58811 | BIN(IS+2)=XL | |
58812 | BIN(IS+3)=XU | |
58813 | BIN(IS+4)=(XU-XL)/NX | |
58814 | CALL PYNULL(ID) | |
58815 | ||
58816 | C...Store title by conversion to integer to double precision. | |
58817 | TITFX=TITLE//' ' | |
58818 | DO 100 IT=1,20 | |
58819 | BIN(IS+8+NX+IT)=256**2*ICHAR(TITFX(3*IT-2:3*IT-2))+ | |
58820 | & 256*ICHAR(TITFX(3*IT-1:3*IT-1))+ICHAR(TITFX(3*IT:3*IT)) | |
58821 | 100 CONTINUE | |
58822 | ||
58823 | RETURN | |
58824 | END | |
58825 | ||
58826 | C********************************************************************* | |
58827 | ||
58828 | C...PYFILL | |
58829 | C...Fills entry in histogram. | |
58830 | ||
58831 | SUBROUTINE PYFILL(ID,X,W) | |
58832 | ||
58833 | C...Double precision declaration. | |
58834 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
58835 | IMPLICIT INTEGER(I-N) | |
58836 | C...Commonblock. | |
58837 | COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) | |
58838 | SAVE /PYBINS/ | |
58839 | ||
58840 | C...Find initial address in memory. Increase number of entries. | |
58841 | IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28, | |
58842 | &'(PYFILL:) not allowed histogram number') | |
58843 | IS=INDX(ID) | |
58844 | IF(IS.EQ.0) CALL PYERRM(28, | |
58845 | &'(PYFILL:) filling unbooked histogram') | |
58846 | BIN(IS+5)=BIN(IS+5)+1D0 | |
58847 | ||
58848 | C...Find bin in x, including under/overflow, and fill. | |
58849 | IF(X.LT.BIN(IS+2)) THEN | |
58850 | BIN(IS+6)=BIN(IS+6)+W | |
58851 | ELSEIF(X.GE.BIN(IS+3)) THEN | |
58852 | BIN(IS+8)=BIN(IS+8)+W | |
58853 | ELSE | |
58854 | BIN(IS+7)=BIN(IS+7)+W | |
58855 | IX=(X-BIN(IS+2))/BIN(IS+4) | |
58856 | IX=MAX(0,MIN(NINT(BIN(IS+1))-1,IX)) | |
58857 | BIN(IS+9+IX)=BIN(IS+9+IX)+W | |
58858 | ENDIF | |
58859 | ||
58860 | RETURN | |
58861 | END | |
58862 | ||
58863 | C********************************************************************* | |
58864 | ||
58865 | C...PYFACT | |
58866 | C...Multiplies histogram contents by factor. | |
58867 | ||
58868 | SUBROUTINE PYFACT(ID,F) | |
58869 | ||
58870 | C...Double precision declaration. | |
58871 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
58872 | IMPLICIT INTEGER(I-N) | |
58873 | C...Commonblock. | |
58874 | COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) | |
58875 | SAVE /PYBINS/ | |
58876 | ||
58877 | C...Find initial address in memory. Multiply all contents bins. | |
58878 | IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28, | |
58879 | &'(PYFACT:) not allowed histogram number') | |
58880 | IS=INDX(ID) | |
58881 | IF(IS.EQ.0) CALL PYERRM(28, | |
58882 | &'(PYFACT:) scaling unbooked histogram') | |
58883 | DO 100 IX=IS+6,IS+8+NINT(BIN(IS+1)) | |
58884 | BIN(IX)=F*BIN(IX) | |
58885 | 100 CONTINUE | |
58886 | ||
58887 | RETURN | |
58888 | END | |
58889 | ||
58890 | C********************************************************************* | |
58891 | ||
58892 | C...PYOPER | |
58893 | C...Performs operations between histograms. | |
58894 | ||
58895 | SUBROUTINE PYOPER(ID1,OPER,ID2,ID3,F1,F2) | |
58896 | ||
58897 | C...Double precision declaration. | |
58898 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
58899 | IMPLICIT INTEGER(I-N) | |
58900 | C...Commonblock. | |
58901 | COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) | |
58902 | SAVE /PYBINS/ | |
58903 | C...Character variable. | |
58904 | CHARACTER OPER*(*) | |
58905 | ||
58906 | C...Find initial addresses in memory, and histogram size. | |
58907 | IF(ID1.LE.0.OR.ID1.GT.IHIST(1)) CALL PYERRM(28, | |
58908 | &'(PYFACT:) not allowed histogram number') | |
58909 | IS1=INDX(ID1) | |
58910 | IS2=INDX(MIN(IHIST(1),MAX(1,ID2))) | |
58911 | IS3=INDX(MIN(IHIST(1),MAX(1,ID3))) | |
58912 | NX=NINT(BIN(IS3+1)) | |
58913 | IF(OPER.EQ.'M'.AND.ID3.EQ.0) NX=NINT(BIN(IS2+1)) | |
58914 | ||
58915 | C...Update info on number of histogram entries. | |
58916 | IF(OPER.EQ.'+'.OR.OPER.EQ.'-'.OR.OPER.EQ.'*'.OR.OPER.EQ.'/') THEN | |
58917 | BIN(IS3+5)=BIN(IS1+5)+BIN(IS2+5) | |
58918 | ELSEIF(OPER.EQ.'A'.OR.OPER.EQ.'S'.OR.OPER.EQ.'L') THEN | |
58919 | BIN(IS3+5)=BIN(IS1+5) | |
58920 | ENDIF | |
58921 | ||
58922 | C...Operations on pair of histograms: addition, subtraction, | |
58923 | C...multiplication, division. | |
58924 | IF(OPER.EQ.'+') THEN | |
58925 | DO 100 IX=6,8+NX | |
58926 | BIN(IS3+IX)=F1*BIN(IS1+IX)+F2*BIN(IS2+IX) | |
58927 | 100 CONTINUE | |
58928 | ELSEIF(OPER.EQ.'-') THEN | |
58929 | DO 110 IX=6,8+NX | |
58930 | BIN(IS3+IX)=F1*BIN(IS1+IX)-F2*BIN(IS2+IX) | |
58931 | 110 CONTINUE | |
58932 | ELSEIF(OPER.EQ.'*') THEN | |
58933 | DO 120 IX=6,8+NX | |
58934 | BIN(IS3+IX)=F1*BIN(IS1+IX)*F2*BIN(IS2+IX) | |
58935 | 120 CONTINUE | |
58936 | ELSEIF(OPER.EQ.'/') THEN | |
58937 | DO 130 IX=6,8+NX | |
58938 | FA2=F2*BIN(IS2+IX) | |
58939 | IF(ABS(FA2).LE.1D-20) THEN | |
58940 | BIN(IS3+IX)=0D0 | |
58941 | ELSE | |
58942 | BIN(IS3+IX)=F1*BIN(IS1+IX)/FA2 | |
58943 | ENDIF | |
58944 | 130 CONTINUE | |
58945 | ||
58946 | C...Operations on single histogram: multiplication+addition, | |
58947 | C...square root+addition, logarithm+addition. | |
58948 | ELSEIF(OPER.EQ.'A') THEN | |
58949 | DO 140 IX=6,8+NX | |
58950 | BIN(IS3+IX)=F1*BIN(IS1+IX)+F2 | |
58951 | 140 CONTINUE | |
58952 | ELSEIF(OPER.EQ.'S') THEN | |
58953 | DO 150 IX=6,8+NX | |
58954 | BIN(IS3+IX)=F1*SQRT(MAX(0D0,BIN(IS1+IX)))+F2 | |
58955 | 150 CONTINUE | |
58956 | ELSEIF(OPER.EQ.'L') THEN | |
58957 | ZMIN=1D20 | |
58958 | DO 160 IX=9,8+NX | |
58959 | IF(BIN(IS1+IX).LT.ZMIN.AND.BIN(IS1+IX).GT.1D-20) | |
58960 | & ZMIN=0.8D0*BIN(IS1+IX) | |
58961 | 160 CONTINUE | |
58962 | DO 170 IX=6,8+NX | |
58963 | BIN(IS3+IX)=F1*LOG10(MAX(ZMIN,BIN(IS1+IX)))+F2 | |
58964 | 170 CONTINUE | |
58965 | ||
58966 | C...Operation on two or three histograms: average and | |
58967 | C...standard deviation. | |
58968 | ELSEIF(OPER.EQ.'M') THEN | |
58969 | DO 180 IX=6,8+NX | |
58970 | IF(ABS(BIN(IS1+IX)).LE.1D-20) THEN | |
58971 | BIN(IS2+IX)=0D0 | |
58972 | ELSE | |
58973 | BIN(IS2+IX)=BIN(IS2+IX)/BIN(IS1+IX) | |
58974 | ENDIF | |
58975 | IF(ID3.NE.0) THEN | |
58976 | IF(ABS(BIN(IS1+IX)).LE.1D-20) THEN | |
58977 | BIN(IS3+IX)=0D0 | |
58978 | ELSE | |
58979 | BIN(IS3+IX)=SQRT(MAX(0D0,BIN(IS3+IX)/BIN(IS1+IX)- | |
58980 | & BIN(IS2+IX)**2)) | |
58981 | ENDIF | |
58982 | ENDIF | |
58983 | BIN(IS1+IX)=F1*BIN(IS1+IX) | |
58984 | 180 CONTINUE | |
58985 | ENDIF | |
58986 | ||
58987 | RETURN | |
58988 | END | |
58989 | ||
58990 | C********************************************************************* | |
58991 | ||
58992 | C...PYHIST | |
58993 | C...Prints and resets all histograms. | |
58994 | ||
58995 | SUBROUTINE PYHIST | |
58996 | ||
58997 | C...Double precision declaration. | |
58998 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
58999 | IMPLICIT INTEGER(I-N) | |
59000 | C...Commonblock. | |
59001 | COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) | |
59002 | SAVE /PYBINS/ | |
59003 | ||
59004 | C...Loop over histograms, print and reset used ones. | |
59005 | DO 100 ID=1,IHIST(1) | |
59006 | IS=INDX(ID) | |
59007 | IF(IS.NE.0.AND.NINT(BIN(IS+5)).GT.0) THEN | |
59008 | CALL PYPLOT(ID) | |
59009 | CALL PYNULL(ID) | |
59010 | ENDIF | |
59011 | 100 CONTINUE | |
59012 | ||
59013 | RETURN | |
59014 | END | |
59015 | ||
59016 | C********************************************************************* | |
59017 | ||
59018 | C...PYPLOT | |
59019 | C...Prints a histogram (but does not reset it). | |
59020 | ||
59021 | SUBROUTINE PYPLOT(ID) | |
59022 | ||
59023 | C...Double precision declaration. | |
59024 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59025 | IMPLICIT INTEGER(I-N) | |
59026 | C...Commonblocks. | |
59027 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
59028 | COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) | |
59029 | SAVE /PYDAT1/,/PYBINS/ | |
59030 | C...Local arrays and character variables. | |
59031 | DIMENSION IDATI(6), IROW(100), IFRA(100), DYAC(10) | |
59032 | CHARACTER TITLE*60, OUT*100, CHA(0:11)*1 | |
59033 | ||
59034 | C...Steps in histogram scale. Character sequence. | |
59035 | DATA DYAC/.04,.05,.06,.08,.10,.12,.15,.20,.25,.30/ | |
59036 | DATA CHA/'0','1','2','3','4','5','6','7','8','9','X','-'/ | |
59037 | ||
59038 | C...Find initial address in memory; skip if empty histogram. | |
59039 | IF(ID.LE.0.OR.ID.GT.IHIST(1)) RETURN | |
59040 | IS=INDX(ID) | |
59041 | IF(IS.EQ.0) RETURN | |
59042 | IF(NINT(BIN(IS+5)).LE.0) THEN | |
59043 | WRITE(MSTU(11),5000) ID | |
59044 | RETURN | |
59045 | ENDIF | |
59046 | ||
59047 | C...Number of histogram lines and x bins. | |
59048 | LIN=IHIST(3)-18 | |
59049 | NX=NINT(BIN(IS+1)) | |
59050 | ||
59051 | C...Extract title by conversion from double precision via integer. | |
59052 | DO 100 IT=1,20 | |
59053 | IEQ=NINT(BIN(IS+8+NX+IT)) | |
59054 | TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)//CHAR(MOD(IEQ,256**2)/256) | |
59055 | & //CHAR(MOD(IEQ,256)) | |
59056 | 100 CONTINUE | |
59057 | ||
59058 | C...Find time; print title. | |
59059 | CALL PYTIME(IDATI) | |
59060 | IF(IDATI(1).GT.0) THEN | |
59061 | WRITE(MSTU(11),5100) ID, TITLE, (IDATI(J),J=1,5) | |
59062 | ELSE | |
59063 | WRITE(MSTU(11),5200) ID, TITLE | |
59064 | ENDIF | |
59065 | ||
59066 | C...Find minimum and maximum bin content. | |
59067 | YMIN=BIN(IS+9) | |
59068 | YMAX=BIN(IS+9) | |
59069 | DO 110 IX=IS+10,IS+8+NX | |
59070 | IF(BIN(IX).LT.YMIN) YMIN=BIN(IX) | |
59071 | IF(BIN(IX).GT.YMAX) YMAX=BIN(IX) | |
59072 | 110 CONTINUE | |
59073 | ||
59074 | C...Determine scale and step size for y axis. | |
59075 | IF(YMAX-YMIN.GT.LIN*DYAC(1)*1D-9) THEN | |
59076 | IF(YMIN.GT.0D0.AND.YMIN.LT.0.1D0*YMAX) YMIN=0D0 | |
59077 | IF(YMAX.LT.0D0.AND.YMAX.GT.0.1D0*YMIN) YMAX=0D0 | |
59078 | IPOT=INT(LOG10(YMAX-YMIN)+10D0)-10 | |
59079 | IF(YMAX-YMIN.LT.LIN*DYAC(1)*10D0**IPOT) IPOT=IPOT-1 | |
59080 | IF(YMAX-YMIN.GT.LIN*DYAC(10)*10D0**IPOT) IPOT=IPOT+1 | |
59081 | DELY=DYAC(1) | |
59082 | DO 120 IDEL=1,9 | |
59083 | IF(YMAX-YMIN.GE.LIN*DYAC(IDEL)*10D0**IPOT) DELY=DYAC(IDEL+1) | |
59084 | 120 CONTINUE | |
59085 | DY=DELY*10D0**IPOT | |
59086 | ||
59087 | C...Convert bin contents to integer form; fractional fill in top row. | |
59088 | DO 130 IX=1,NX | |
59089 | CTA=ABS(BIN(IS+8+IX))/DY | |
59090 | IROW(IX)=SIGN(CTA+0.95D0,BIN(IS+8+IX)) | |
59091 | IFRA(IX)=10D0*(CTA+1.05D0-DBLE(INT(CTA+0.95D0))) | |
59092 | 130 CONTINUE | |
59093 | IRMI=SIGN(ABS(YMIN)/DY+0.95D0,YMIN) | |
59094 | IRMA=SIGN(ABS(YMAX)/DY+0.95D0,YMAX) | |
59095 | ||
59096 | C...Print histogram row by row. | |
59097 | DO 150 IR=IRMA,IRMI,-1 | |
59098 | IF(IR.EQ.0) GOTO 150 | |
59099 | OUT=' ' | |
59100 | DO 140 IX=1,NX | |
59101 | IF(IR.EQ.IROW(IX)) OUT(IX:IX)=CHA(IFRA(IX)) | |
59102 | IF(IR*(IROW(IX)-IR).GT.0) OUT(IX:IX)=CHA(10) | |
59103 | 140 CONTINUE | |
59104 | WRITE(MSTU(11),5300) IR*DELY, IPOT, OUT | |
59105 | 150 CONTINUE | |
59106 | ||
59107 | C...Print sign and value of bin contents. | |
59108 | IPOT=INT(LOG10(MAX(YMAX,-YMIN))+10.0001D0)-10 | |
59109 | OUT=' ' | |
59110 | DO 160 IX=1,NX | |
59111 | IF(BIN(IS+8+IX).LT.-10D0**(IPOT-4)) OUT(IX:IX)=CHA(11) | |
59112 | IROW(IX)=NINT(10D0**(3-IPOT)*ABS(BIN(IS+8+IX))) | |
59113 | 160 CONTINUE | |
59114 | WRITE(MSTU(11),5400) OUT | |
59115 | DO 180 IR=4,1,-1 | |
59116 | DO 170 IX=1,NX | |
59117 | OUT(IX:IX)=CHA(MOD(IROW(IX),10**IR)/10**(IR-1)) | |
59118 | 170 CONTINUE | |
59119 | WRITE(MSTU(11),5500) IPOT+IR-4, OUT | |
59120 | 180 CONTINUE | |
59121 | ||
59122 | C...Print sign and value of lower bin edge. | |
59123 | IPOT=INT(LOG10(MAX(-BIN(IS+2),BIN(IS+3)-BIN(IS+4)))+ | |
59124 | & 10.0001D0)-10 | |
59125 | OUT=' ' | |
59126 | DO 190 IX=1,NX | |
59127 | IF(BIN(IS+2)+(IX-1)*BIN(IS+4).LT.-10D0**(IPOT-3)) | |
59128 | & OUT(IX:IX)=CHA(11) | |
59129 | IROW(IX)=NINT(10D0**(2-IPOT)*ABS(BIN(IS+2)+(IX-1)*BIN(IS+4))) | |
59130 | 190 CONTINUE | |
59131 | WRITE(MSTU(11),5600) OUT | |
59132 | DO 210 IR=3,1,-1 | |
59133 | DO 200 IX=1,NX | |
59134 | OUT(IX:IX)=CHA(MOD(IROW(IX),10**IR)/10**(IR-1)) | |
59135 | 200 CONTINUE | |
59136 | WRITE(MSTU(11),5500) IPOT+IR-3, OUT | |
59137 | 210 CONTINUE | |
59138 | ENDIF | |
59139 | ||
59140 | C...Calculate and print statistics. | |
59141 | CSUM=0D0 | |
59142 | CXSUM=0D0 | |
59143 | CXXSUM=0D0 | |
59144 | DO 220 IX=1,NX | |
59145 | CTA=ABS(BIN(IS+8+IX)) | |
59146 | X=BIN(IS+2)+(IX-0.5D0)*BIN(IS+4) | |
59147 | CSUM=CSUM+CTA | |
59148 | CXSUM=CXSUM+CTA*X | |
59149 | CXXSUM=CXXSUM+CTA*X**2 | |
59150 | 220 CONTINUE | |
59151 | XMEAN=CXSUM/MAX(CSUM,1D-20) | |
59152 | XRMS=SQRT(MAX(0D0,CXXSUM/MAX(CSUM,1D-20)-XMEAN**2)) | |
59153 | WRITE(MSTU(11),5700) NINT(BIN(IS+5)),XMEAN,BIN(IS+6), | |
59154 | &BIN(IS+2),BIN(IS+7),XRMS,BIN(IS+8),BIN(IS+3) | |
59155 | ||
59156 | C...Formats for output. | |
59157 | 5000 FORMAT(/5X,'Histogram no',I5,' : no entries') | |
59158 | 5100 FORMAT('1'/5X,'Histogram no',I5,6X,A60,5X,I4,'-',I2,'-',I2,1X, | |
59159 | &I2,':',I2/) | |
59160 | 5200 FORMAT('1'/5X,'Histogram no',I5,6X,A60/) | |
59161 | 5300 FORMAT(2X,F7.2,'*10**',I2,3X,A100) | |
59162 | 5400 FORMAT(/8X,'Contents',3X,A100) | |
59163 | 5500 FORMAT(9X,'*10**',I2,3X,A100) | |
59164 | 5600 FORMAT(/8X,'Low edge',3X,A100) | |
59165 | 5700 FORMAT(/5X,'Entries =',I12,1P,6X,'Mean =',D12.4,6X,'Underflow =' | |
59166 | &,D12.4,6X,'Low edge =',D12.4/5X,'All chan =',D12.4,6X, | |
59167 | &'Rms =',D12.4,6X,'Overflow =',D12.4,6X,'High edge =',D12.4) | |
59168 | ||
59169 | RETURN | |
59170 | END | |
59171 | ||
59172 | C********************************************************************* | |
59173 | ||
59174 | C...PYNULL | |
59175 | C...Resets bin contents of a histogram. | |
59176 | ||
59177 | SUBROUTINE PYNULL(ID) | |
59178 | ||
59179 | C...Double precision declaration. | |
59180 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59181 | IMPLICIT INTEGER(I-N) | |
59182 | C...Commonblock. | |
59183 | COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) | |
59184 | SAVE /PYBINS/ | |
59185 | ||
59186 | IF(ID.LE.0.OR.ID.GT.IHIST(1)) RETURN | |
59187 | IS=INDX(ID) | |
59188 | IF(IS.EQ.0) RETURN | |
59189 | DO 100 IX=IS+5,IS+8+NINT(BIN(IS+1)) | |
59190 | BIN(IX)=0D0 | |
59191 | 100 CONTINUE | |
59192 | ||
59193 | RETURN | |
59194 | END | |
59195 | ||
59196 | C********************************************************************* | |
59197 | ||
59198 | C...PYDUMP | |
59199 | C...Dumps histogram contents on file for reading by other program. | |
59200 | C...Can also read back own dump. | |
59201 | ||
59202 | SUBROUTINE PYDUMP(MDUMP,LFN,NHI,IHI) | |
59203 | ||
59204 | C...Double precision declaration. | |
59205 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59206 | IMPLICIT INTEGER(I-N) | |
59207 | C...Commonblock. | |
59208 | COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) | |
59209 | SAVE /PYBINS/ | |
59210 | C...Local arrays and character variables. | |
59211 | DIMENSION IHI(*),ISS(100),VAL(5) | |
59212 | CHARACTER TITLE*60,FORMAT*13 | |
59213 | ||
59214 | C...Dump all histograms that have been booked, | |
59215 | C...including titles and ranges, one after the other. | |
59216 | IF(MDUMP.EQ.1) THEN | |
59217 | ||
59218 | C...Loop over histograms and find which are wanted and booked. | |
59219 | IF(NHI.LE.0) THEN | |
59220 | NW=IHIST(1) | |
59221 | ELSE | |
59222 | NW=NHI | |
59223 | ENDIF | |
59224 | DO 130 IW=1,NW | |
59225 | IF(NHI.EQ.0) THEN | |
59226 | ID=IW | |
59227 | ELSE | |
59228 | ID=IHI(IW) | |
59229 | ENDIF | |
59230 | IS=INDX(ID) | |
59231 | IF(IS.NE.0) THEN | |
59232 | ||
59233 | C...Write title, histogram size, filling statistics. | |
59234 | NX=NINT(BIN(IS+1)) | |
59235 | DO 100 IT=1,20 | |
59236 | IEQ=NINT(BIN(IS+8+NX+IT)) | |
59237 | TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)// | |
59238 | & CHAR(MOD(IEQ,256**2)/256)//CHAR(MOD(IEQ,256)) | |
59239 | 100 CONTINUE | |
59240 | WRITE(LFN,5100) ID,TITLE | |
59241 | WRITE(LFN,5200) NX,BIN(IS+2),BIN(IS+3) | |
59242 | WRITE(LFN,5300) NINT(BIN(IS+5)),BIN(IS+6),BIN(IS+7), | |
59243 | & BIN(IS+8) | |
59244 | ||
59245 | ||
59246 | C...Write histogram contents, in groups of five. | |
59247 | DO 120 IXG=1,(NX+4)/5 | |
59248 | DO 110 IXV=1,5 | |
59249 | IX=5*IXG+IXV-5 | |
59250 | IF(IX.LE.NX) THEN | |
59251 | VAL(IXV)=BIN(IS+8+IX) | |
59252 | ELSE | |
59253 | VAL(IXV)=0D0 | |
59254 | ENDIF | |
59255 | 110 CONTINUE | |
59256 | WRITE(LFN,5400) (VAL(IXV),IXV=1,5) | |
59257 | 120 CONTINUE | |
59258 | ||
59259 | C...Go to next histogram; finish. | |
59260 | ELSEIF(NHI.GT.0) THEN | |
59261 | CALL PYERRM(8,'(PYDUMP:) unknown histogram number') | |
59262 | ENDIF | |
59263 | 130 CONTINUE | |
59264 | ||
59265 | C...Read back in histograms dumped MDUMP=1. | |
59266 | ELSEIF(MDUMP.EQ.2) THEN | |
59267 | ||
59268 | C...Read histogram number, title and range, and book. | |
59269 | 140 READ(LFN,5100,END=170) ID,TITLE | |
59270 | READ(LFN,5200) NX,XL,XU | |
59271 | CALL PYBOOK(ID,TITLE,NX,XL,XU) | |
59272 | IS=INDX(ID) | |
59273 | ||
59274 | C...Read filling statistics. | |
59275 | READ(LFN,5300) NENTRY,BIN(IS+6),BIN(IS+7),BIN(IS+8) | |
59276 | BIN(IS+5)=DBLE(NENTRY) | |
59277 | ||
59278 | C...Read histogram contents, in groups of five. | |
59279 | DO 160 IXG=1,(NX+4)/5 | |
59280 | READ(LFN,5400) (VAL(IXV),IXV=1,5) | |
59281 | DO 150 IXV=1,5 | |
59282 | IX=5*IXG+IXV-5 | |
59283 | IF(IX.LE.NX) BIN(IS+8+IX)=VAL(IXV) | |
59284 | 150 CONTINUE | |
59285 | 160 CONTINUE | |
59286 | ||
59287 | C...Go to next histogram; finish. | |
59288 | GOTO 140 | |
59289 | 170 CONTINUE | |
59290 | ||
59291 | C...Write histogram contents in column format, | |
59292 | C...convenient e.g. for GNUPLOT input. | |
59293 | ELSEIF(MDUMP.EQ.3) THEN | |
59294 | ||
59295 | C...Find addresses to wanted histograms. | |
59296 | NSS=0 | |
59297 | IF(NHI.LE.0) THEN | |
59298 | NW=IHIST(1) | |
59299 | ELSE | |
59300 | NW=NHI | |
59301 | ENDIF | |
59302 | DO 180 IW=1,NW | |
59303 | IF(NHI.EQ.0) THEN | |
59304 | ID=IW | |
59305 | ELSE | |
59306 | ID=IHI(IW) | |
59307 | ENDIF | |
59308 | IS=INDX(ID) | |
59309 | IF(IS.NE.0.AND.NSS.LT.100) THEN | |
59310 | NSS=NSS+1 | |
59311 | ISS(NSS)=IS | |
59312 | ELSEIF(NSS.GE.100) THEN | |
59313 | CALL PYERRM(8,'(PYDUMP:) too many histograms requested') | |
59314 | ELSEIF(NHI.GT.0) THEN | |
59315 | CALL PYERRM(8,'(PYDUMP:) unknown histogram number') | |
59316 | ENDIF | |
59317 | 180 CONTINUE | |
59318 | ||
59319 | C...Check that they have common number of x bins. Fix format. | |
59320 | NX=NINT(BIN(ISS(1)+1)) | |
59321 | DO 190 IW=2,NSS | |
59322 | IF(NINT(BIN(ISS(IW)+1)).NE.NX) THEN | |
59323 | CALL PYERRM(8,'(PYDUMP:) different number of bins') | |
59324 | RETURN | |
59325 | ENDIF | |
59326 | 190 CONTINUE | |
59327 | FORMAT='(1P,000E12.4)' | |
59328 | WRITE(FORMAT(5:7),'(I3)') NSS+1 | |
59329 | ||
59330 | C...Write histogram contents; first column x values. | |
59331 | DO 200 IX=1,NX | |
59332 | X=BIN(ISS(1)+2)+(IX-0.5D0)*BIN(ISS(1)+4) | |
59333 | WRITE(LFN,FORMAT) X, (BIN(ISS(IW)+8+IX),IW=1,NSS) | |
59334 | 200 CONTINUE | |
59335 | ||
59336 | ENDIF | |
59337 | ||
59338 | C...Formats for output. | |
59339 | 5100 FORMAT(I5,5X,A60) | |
59340 | 5200 FORMAT(I5,1P,2D12.4) | |
59341 | 5300 FORMAT(I12,1P,3D12.4) | |
59342 | 5400 FORMAT(1P,5D12.4) | |
59343 | ||
59344 | RETURN | |
59345 | END | |
59346 | ||
59347 | C********************************************************************* | |
59348 | ||
59349 | C...PYKCUT | |
59350 | C...Dummy routine, which the user can replace in order to make cuts on | |
59351 | C...the kinematics on the parton level before the matrix elements are | |
59352 | C...evaluated and the event is generated. The cross-section estimates | |
59353 | C...will automatically take these cuts into account, so the given | |
59354 | C...values are for the allowed phase space region only. MCUT=0 means | |
59355 | C...that the event has passed the cuts, MCUT=1 that it has failed. | |
59356 | ||
59357 | SUBROUTINE PYKCUT(MCUT) | |
59358 | ||
59359 | C...Double precision and integer declarations. | |
59360 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59361 | IMPLICIT INTEGER(I-N) | |
59362 | INTEGER PYK,PYCHGE,PYCOMP | |
59363 | C...Commonblocks. | |
59364 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
59365 | COMMON/PYINT1/MINT(400),VINT(400) | |
59366 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
59367 | SAVE /PYDAT1/,/PYINT1/,/PYINT2/ | |
59368 | ||
59369 | C...Set default value (accepting event) for MCUT. | |
59370 | MCUT=0 | |
59371 | ||
59372 | C...Read out subprocess number. | |
59373 | ISUB=MINT(1) | |
59374 | ISTSB=ISET(ISUB) | |
59375 | ||
59376 | C...Read out tau, y*, cos(theta), tau' (where defined, else =0). | |
59377 | TAU=VINT(21) | |
59378 | YST=VINT(22) | |
59379 | CTH=0D0 | |
59380 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) CTH=VINT(23) | |
59381 | TAUP=0D0 | |
59382 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUP=VINT(26) | |
59383 | ||
59384 | C...Calculate x_1, x_2, x_F. | |
59385 | IF(ISTSB.LE.2.OR.ISTSB.GE.5) THEN | |
59386 | X1=SQRT(TAU)*EXP(YST) | |
59387 | X2=SQRT(TAU)*EXP(-YST) | |
59388 | ELSE | |
59389 | X1=SQRT(TAUP)*EXP(YST) | |
59390 | X2=SQRT(TAUP)*EXP(-YST) | |
59391 | ENDIF | |
59392 | XF=X1-X2 | |
59393 | ||
59394 | C...Calculate shat, that, uhat, p_T^2. | |
59395 | SHAT=TAU*VINT(2) | |
59396 | SQM3=VINT(63) | |
59397 | SQM4=VINT(64) | |
59398 | RM3=SQM3/SHAT | |
59399 | RM4=SQM4/SHAT | |
59400 | BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) | |
59401 | RPTS=4D0*VINT(71)**2/SHAT | |
59402 | BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) | |
59403 | RM34=2D0*RM3*RM4 | |
59404 | RSQM=1D0+RM34 | |
59405 | RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) | |
59406 | THAT=-0.5D0*SHAT*MAX(RTHM,1D0-RM3-RM4-BE34*CTH) | |
59407 | UHAT=-0.5D0*SHAT*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) | |
59408 | PT2=MAX(VINT(71)**2,0.25D0*SHAT*BE34**2*(1D0-CTH**2)) | |
59409 | ||
59410 | C...Decisions by user to be put here. | |
59411 | ||
59412 | C...Stop program if this routine is ever called. | |
59413 | C...You should not copy these lines to your own routine. | |
59414 | WRITE(MSTU(11),5000) | |
59415 | IF(PYR(0).LT.10D0) STOP | |
59416 | ||
59417 | C...Format for error printout. | |
59418 | 5000 FORMAT(1X,'Error: you did not link your PYKCUT routine ', | |
59419 | &'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/ | |
59420 | &1X,'Execution stopped!') | |
59421 | ||
59422 | RETURN | |
59423 | END | |
59424 | ||
59425 | C********************************************************************* | |
59426 | ||
59427 | C...PYEVWT | |
59428 | C...Dummy routine, which the user can replace in order to multiply the | |
59429 | C...standard PYTHIA differential cross-section by a process- and | |
59430 | C...kinematics-dependent factor WTXS. For MSTP(142)=1 this corresponds | |
59431 | C...to generation of weighted events, with weight 1/WTXS, while for | |
59432 | C...MSTP(142)=2 it corresponds to a modification of the underlying | |
59433 | C...physics. | |
59434 | ||
59435 | SUBROUTINE PYEVWT(WTXS) | |
59436 | ||
59437 | C...Double precision and integer declarations. | |
59438 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59439 | IMPLICIT INTEGER(I-N) | |
59440 | INTEGER PYK,PYCHGE,PYCOMP | |
59441 | C...Commonblocks. | |
59442 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
59443 | COMMON/PYINT1/MINT(400),VINT(400) | |
59444 | COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
59445 | SAVE /PYDAT1/,/PYINT1/,/PYINT2/ | |
59446 | ||
59447 | C...Set default weight for WTXS. | |
59448 | WTXS=1D0 | |
59449 | ||
59450 | C...Read out subprocess number. | |
59451 | ISUB=MINT(1) | |
59452 | ISTSB=ISET(ISUB) | |
59453 | ||
59454 | C...Read out tau, y*, cos(theta), tau' (where defined, else =0). | |
59455 | TAU=VINT(21) | |
59456 | YST=VINT(22) | |
59457 | CTH=0D0 | |
59458 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) CTH=VINT(23) | |
59459 | TAUP=0D0 | |
59460 | IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUP=VINT(26) | |
59461 | ||
59462 | C...Read out x_1, x_2, x_F, shat, that, uhat, p_T^2. | |
59463 | X1=VINT(41) | |
59464 | X2=VINT(42) | |
59465 | XF=X1-X2 | |
59466 | SHAT=VINT(44) | |
59467 | THAT=VINT(45) | |
59468 | UHAT=VINT(46) | |
59469 | PT2=VINT(48) | |
59470 | ||
59471 | C...Modifications by user to be put here. | |
59472 | ||
59473 | C...Stop program if this routine is ever called. | |
59474 | C...You should not copy these lines to your own routine. | |
59475 | WRITE(MSTU(11),5000) | |
59476 | IF(PYR(0).LT.10D0) STOP | |
59477 | ||
59478 | C...Format for error printout. | |
59479 | 5000 FORMAT(1X,'Error: you did not link your PYEVWT routine ', | |
59480 | &'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/ | |
59481 | &1X,'Execution stopped!') | |
59482 | ||
59483 | RETURN | |
59484 | END | |
59485 | ||
59486 | C********************************************************************* | |
59487 | ||
59488 | C...UPINIT | |
59489 | C...Dummy routine, to be replaced by a user implementing external | |
59490 | C...processes. Is supposed to fill the HEPRUP commonblock with info | |
59491 | C...on incoming beams and allowed processes. | |
59492 | ||
59493 | SUBROUTINE UPINIT | |
59494 | ||
59495 | C...Double precision and integer declarations. | |
59496 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59497 | IMPLICIT INTEGER(I-N) | |
59498 | ||
59499 | C...User process initialization commonblock. | |
59500 | INTEGER MAXPUP | |
59501 | PARAMETER (MAXPUP=100) | |
59502 | INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP | |
59503 | DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP | |
59504 | COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), | |
59505 | &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), | |
59506 | &LPRUP(MAXPUP) | |
59507 | SAVE /HEPRUP/ | |
59508 | ||
59509 | RETURN | |
59510 | END | |
59511 | ||
59512 | C********************************************************************* | |
59513 | ||
59514 | C...UPEVNT | |
59515 | C...Dummy routine, to be replaced by a user implementing external | |
59516 | C...processes. Depending on cross section model chosen, it either has | |
59517 | C...to generate a process of the type IDPRUP requested, or pick a type | |
59518 | C...itself and generate this event. The event is to be stored in the | |
59519 | C...HEPEUP commonblock, including (often) an event weight. | |
59520 | ||
59521 | SUBROUTINE UPEVNT | |
59522 | ||
59523 | C...Double precision and integer declarations. | |
59524 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59525 | IMPLICIT INTEGER(I-N) | |
59526 | ||
59527 | C...User process event common block. | |
59528 | INTEGER MAXNUP | |
59529 | PARAMETER (MAXNUP=500) | |
59530 | INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP | |
59531 | DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP | |
59532 | COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), | |
59533 | &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), | |
59534 | &VTIMUP(MAXNUP),SPINUP(MAXNUP) | |
59535 | SAVE /HEPEUP/ | |
59536 | ||
59537 | RETURN | |
59538 | END | |
59539 | ||
59540 | C********************************************************************* | |
59541 | C...SUGRA | |
59542 | C...Dummy routine, to be removed when ISAJET (ISASUSY) is to be linked. | |
59543 | ||
59544 | SUBROUTINE SUGRA(MZERO,MHLF,AZERO,TANB,SGNMU,MTOP,IMODL) | |
59545 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59546 | IMPLICIT INTEGER(I-N) | |
59547 | REAL MZERO,MHLF,AZERO,TANB,SGNMU,MTOP | |
59548 | INTEGER IMODL | |
59549 | C...Commonblocks. | |
59550 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
59551 | SAVE /PYDAT1/ | |
59552 | ||
59553 | C...Stop program if this routine is ever called. | |
59554 | WRITE(MSTU(11),5000) | |
59555 | IF(PYR(0).LT.10D0) STOP | |
59556 | ||
59557 | C...Format for error printout. | |
59558 | 5000 FORMAT(1X,'Error: you did not link ISAJET correctly.'/ | |
59559 | &1X,'Dummy routine SUGRA in PYTHIA file called instead.'/ | |
59560 | &1X,'Execution stopped!') | |
59561 | ||
59562 | RETURN | |
59563 | END | |
59564 | ||
59565 | C********************************************************************* | |
59566 | ||
59567 | C...VISAJE | |
59568 | C...Dummy function, to be removed when ISAJET (ISASUSY) is to be linked. | |
59569 | ||
59570 | FUNCTION VISAJE() | |
59571 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59572 | IMPLICIT INTEGER(I-N) | |
59573 | CHARACTER*40 VISAJE | |
59574 | ||
59575 | C...Commonblocks. | |
59576 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
59577 | SAVE /PYDAT1/ | |
59578 | ||
59579 | C...Assign default value. | |
59580 | VISAJE='Undefined' | |
59581 | ||
59582 | C...Stop program if this routine is ever called. | |
59583 | WRITE(MSTU(11),5000) | |
59584 | IF(PYR(0).LT.10D0) STOP | |
59585 | ||
59586 | C...Format for error printout. | |
59587 | 5000 FORMAT(1X,'Error: you did not link ISAJET correctly.'/ | |
59588 | &1X,'Dummy function VISAJE in PYTHIA file called instead.'/ | |
59589 | &1X,'Execution stopped!') | |
59590 | ||
59591 | RETURN | |
59592 | END | |
59593 | ||
59594 | C********************************************************************* | |
59595 | ||
59596 | C...PYTAUD | |
59597 | C...Dummy routine, to be replaced by user, to handle the decay of a | |
59598 | C...polarized tau lepton. | |
59599 | C...Input: | |
59600 | C...ITAU is the position where the decaying tau is stored in /PYJETS/. | |
59601 | C...IORIG is the position where the mother of the tau is stored; | |
59602 | C... is 0 when the mother is not stored. | |
59603 | C...KFORIG is the flavour of the mother of the tau; | |
59604 | C... is 0 when the mother is not known. | |
59605 | C...Note that IORIG=0 does not necessarily imply KFORIG=0; | |
59606 | C... e.g. in B hadron semileptonic decays the W propagator | |
59607 | C... is not explicitly stored but the W code is still unambiguous. | |
59608 | C...Output: | |
59609 | C...NDECAY is the number of decay products in the current tau decay. | |
59610 | C...These decay products should be added to the /PYJETS/ common block, | |
59611 | C...in positions N+1 through N+NDECAY. For each product I you must | |
59612 | C...give the flavour codes K(I,2) and the five-momenta P(I,1), P(I,2), | |
59613 | C...P(I,3), P(I,4) and P(I,5). The rest will be stored automatically. | |
59614 | ||
59615 | SUBROUTINE PYTAUD(ITAU,IORIG,KFORIG,NDECAY) | |
59616 | ||
59617 | C...Double precision and integer declarations. | |
59618 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59619 | IMPLICIT INTEGER(I-N) | |
59620 | INTEGER PYK,PYCHGE,PYCOMP | |
59621 | C...Commonblocks. | |
59622 | COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) | |
59623 | COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
59624 | SAVE /PYJETS/,/PYDAT1/ | |
59625 | ||
59626 | C...Stop program if this routine is ever called. | |
59627 | C...You should not copy these lines to your own routine. | |
59628 | NDECAY=ITAU+IORIG+KFORIG | |
59629 | WRITE(MSTU(11),5000) | |
59630 | IF(PYR(0).LT.10D0) STOP | |
59631 | ||
59632 | C...Format for error printout. | |
59633 | 5000 FORMAT(1X,'Error: you did not link your PYTAUD routine ', | |
59634 | &'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/ | |
59635 | &1X,'Execution stopped!') | |
59636 | ||
59637 | RETURN | |
59638 | END | |
59639 | ||
59640 | C********************************************************************* | |
59641 | ||
59642 | C...PYTIME | |
59643 | C...Finds current date and time. | |
59644 | C...Since this task is not standardized in Fortran 77, the routine | |
59645 | C...is dummy, to be replaced by the user. Examples are given for | |
59646 | C...the Fortran 90 routine and DEC Fortran 77, and what to do if | |
59647 | C...you do not have access to suitable routines. | |
59648 | ||
59649 | SUBROUTINE PYTIME(IDATI) | |
59650 | ||
59651 | C...Double precision and integer declarations. | |
59652 | IMPLICIT DOUBLE PRECISION(A-H, O-Z) | |
59653 | IMPLICIT INTEGER(I-N) | |
59654 | INTEGER PYK,PYCHGE,PYCOMP | |
59655 | CHARACTER*8 ATIME | |
59656 | C...Local array. | |
59657 | INTEGER IDATI(6),IDTEMP(3) | |
59658 | ||
59659 | C...Example 0: if you do not have suitable routines. | |
59660 | DO 100 J=1,6 | |
59661 | IDATI(J)=0 | |
59662 | 100 CONTINUE | |
59663 | ||
59664 | C...Example 1: Fortran 90 routine. | |
59665 | C INTEGER IVAL(8) | |
59666 | C CALL DATE_AND_TIME(VALUES=IVAL) | |
59667 | C IDATI(1)=IVAL(1) | |
59668 | C IDATI(2)=IVAL(2) | |
59669 | C IDATI(3)=IVAL(3) | |
59670 | C IDATI(4)=IVAL(5) | |
59671 | C IDATI(5)=IVAL(6) | |
59672 | C IDATI(6)=IVAL(7) | |
59673 | ||
59674 | C...Example 2: DEC Fortran 77. AIX. | |
59675 | C CALL IDATE(IMON,IDAY,IYEAR) | |
59676 | C IDATI(1)=IYEAR | |
59677 | C IDATI(2)=IMON | |
59678 | C IDATI(3)=IDAY | |
59679 | C CALL ITIME(IHOUR,IMIN,ISEC) | |
59680 | C IDATI(4)=IHOUR | |
59681 | C IDATI(5)=IMIN | |
59682 | C IDATI(6)=ISEC | |
59683 | ||
59684 | C...Example 3: DEC Fortran, IRIX, IRIX64. | |
59685 | C CALL IDATE(IMON,IDAY,IYEAR) | |
59686 | C IDATI(1)=IYEAR | |
59687 | C IDATI(2)=IMON | |
59688 | C IDATI(3)=IDAY | |
59689 | C CALL TIME(ATIME) | |
59690 | C IHOUR=0 | |
59691 | C IMIN=0 | |
59692 | C ISEC=0 | |
59693 | C READ(ATIME(1:2),'(I2)') IHOUR | |
59694 | C READ(ATIME(4:5),'(I2)') IMIN | |
59695 | C READ(ATIME(7:8),'(I2)') ISEC | |
59696 | C IDATI(4)=IHOUR | |
59697 | C IDATI(5)=IMIN | |
59698 | C IDATI(6)=ISEC | |
59699 | ||
59700 | C...Example 4: GNU LINUX libU77, SunOS. | |
286fd514 | 59701 | c CALL IDATE(IDTEMP) |
59702 | c IDATI(1)=IDTEMP(3) | |
59703 | c IDATI(2)=IDTEMP(2) | |
59704 | c IDATI(3)=IDTEMP(1) | |
59705 | c CALL ITIME(IDTEMP) | |
59706 | c IDATI(4)=IDTEMP(1) | |
59707 | c IDATI(5)=IDTEMP(2) | |
59708 | c IDATI(6)=IDTEMP(3) | |
2dfa57d1 | 59709 | |
59710 | C...Common code to ensure right century. | |
59711 | IDATI(1)=2000+MOD(IDATI(1),100) | |
59712 | ||
59713 | RETURN | |
59714 | END |