+++ /dev/null
-*
-* $Id$
-*
-* $Log$
-* Revision 1.1.1.1 1996/03/08 17:32:28 mclareni
-* jetset74
-*
-*
-* This directory was created from jetset74.car patch update
-
-
-
- 23 August 1995
-
-
- Updates to
-
- PYTHIA 5.7 and JETSET 7.4
- Physics and Manual
-
- Torbjorn Sjostrand
- Department of theoretical physics 2
- University of Lund
- Solvegatan 14A
- S-223 62 Lund
- Sweden
-
------------------------------------------------------------------
-
-1) Introduction.
-
-Since the PYTHIA/JETSET programs are being updated frequently,
-it is also important to keep the documentation up to date.
-The big manual that appeared as CERN-TH.7112/93 described the
-status as of 15 December 1993. The LaTeX file with this manual
-will be updated, though less frequently than the programs.
-Further, it is not very economical to have to get a new copy
-of a long manual just to see if any interesting new features
-have been added recently. Therefore I have here collected the
-main changes that have taken place since the beginning of 1994.
-The changes are indexed by sub-subversion number and date. This
-file will be updated as regularly as the programs themselves.
-It is not intended to be as complete as the ordinary manual,
-but should be sufficient for the intended purpose.
-
------------------------------------------------------------------
-
-2) Changes in JETSET 7.4
-
------------
-
-00, 13 December 1993: baseline version.
-
------------
-
-01, 11 February 1994:
-
-LUZDIS has been changed to protect against an overflow in an exponent
-(harmless physicswise, but enough to crash the program on some
-machines).
-
------------
-
-02, 7 April 1994:
-
-A possibility has been introduced into LUSHOW to suppress either hard
-or soft radiation, in the connection of radiation off rapidly decaying
-objects. The algorithm used is not exact, but still gives some
-impression of potential effects. The switch ought to have appeared at
-the end of the current list of shower switches, but because of lack of
-space it appears immediately before.
-
-MSTJ(40) : (D=0) possibility to suppress the branching probability for
-a branching q -> q + g (or q -> q + gamma) of a quark produced in the
-decay of an unstable particle with width Gamma, where this width has to
-be specified by the user in PARJ(89). Can be changed for each new
-LUSHOW call.
-= 0 : no suppression, i.e. the standard parton-shower machinery.
-= 1 : suppress radiation by a factor chi(omega) =
- Gamma**2 / (Gamma**2 + omega**2), where omega is the energy of the
- gluon (or photon) in the rest frame of the radiating dipole.
- Essentially this means that hard radiation with omega > Gamma
- is removed.
-= 2 : suppress radiation by a factor 1 - chi(omega) =
- omega**2 / (Gamma**2 + omega**2), where omega is the energy of the
- gluon (or photon) in the rest frame of the radiating dipole.
- Essentially this means that soft radiation with omega < Gamma
- is removed.
-
-PARJ(89) : (D=0. GeV) the width of the unstable particle studied for the
- MSTJ(40) > 0 options; to be set by the user (separately for each
- LUSHOW call, if need be).
-
------
-
-A generic interface has been included to an external tau decay library.
-This should allow the handling of tau polarization, which is not done
-by JETSET. To use this facility you have to set the switch MSTJ(28),
-include your own interface routine LUTAUD and see to it that the dummy
-routine LUTAUD in JETSET is not linked. The dummy routine is there
-only to avoid unresolved external references when no user-supplied
-interface is linked.
-
-MSTJ(28) : (D=0) call to an external tau decay library.
-= 0 : not done, i.e. the internal LUDECY treatment is used.
-= 1 : done whenever the tau mother particle species can be identified,
- else the internal LUDECY treatment is used. Normally the mother
- particle should always be identified, but it is possible for
- a user to remove event history information or to add extra taus
- directly to the event record, and then the mother is not known.
-= 2 : always done.
-
-CALL LUTAUD(ITAU,IORIG,KFORIG,NDECAY)
-Purpose: to act as an interface between the generic decay routine
- LUDECY and a user-supplied tau decay library. The latter library
- would normally know how to handle polarized taus, given the tau
- polarization, so one task of the interface routine is to construct
- the tau polarization/helicity from the information available.
- Input to the routine is provided in the first three arguments,
- while the last argument and some event record information have
- to be set before return.
-ITAU : line number in the event record where the tau is stored.
- The four-momentum of this tau has first been boosted back to the
- rest frame of the decaying mother and thereafter rotated to move
- out along the +z axis. This choice of frame should help the
- calculation of the helicity configuration. After the LUTAUD call
- the tau (and its decay products) will be rotated and boosted back.
- However, seemingly, the event record does not conserve momentum
- at this intermediate stage.
-IORIG : line number where the mother particle to the tau is stored.
- Is 0 if the mother is not stored. This does not have to mean the
- mother is unknown, e.g. in semileptonic B decay the mother is a
- W+-, and its momentum can be obtained by adding the tau and
- nu_tau momentum, but there is no line in the event record.
- When several copies of the mother is stored (e.g. one in the
- documentation section of the event record and one in the main
- section), IORIG points to the last. If a branchings like
- tau -> tau + gamma occurs, the 'grandmother' is given, i.e. the
- mother of the direct tau before branching.
-KFORIG : flavour code for the mother particle. Is 0 if the mother
- is unknown. The mother would typically be a resonance such as
- Z0 (23), W+- (+-24), H0 (25), or H+- (+-37).
- Often the helicity choice would be clear just by the knowledge
- of this mother species, e.g. W+- vs. H+-. However, sometimes
- further complications may exist. For instance, the KF code 23
- represents a mixture of gamma* and Z0; a knowledge of the mother
- mass (in P(IORIG,5)) would here be required to make the choice
- of helicities. Further, a W and Z may either be (predominantly)
- transverse or longitudinal, depending on the production process
- under study.
-NDECAY : the number of decay products of the tau; to be given by the
- user. You must also store the KF flavour codes of those decay
- products in the positions K(I,2), N+1 <= I <= N+NDECAY, of the
- event record. The corresponding five-momentum (momentum, energy
- and mass) should be stored in the associated P(I,J) positions,
- 1 <= J <= 5. The four-momenta are expected to add up to the
- four-momentum of the tau in position ITAU. You should not change
- the N value or any of the other K or V values (neither for the
- tau nor for its decay products) since this is automatically done
- in LUDECY.
-
------
-
-In a few places, a dot has been moved from the end of one line to the
-beginning of the next continuation line, or the other way around,
-to keep together tokens such as .EQ. or .AND., since some debuggers
-may otherwise complain.
-
-A source of (harmless) division by zero in LUSHOW has been removed.
-
------------
-
-03, 15 July 1994:
-
-The LUBOEI routine has been changed to avoid an unintentional gap
-in the limits of the very first bin.
-
-Further, leptons and photons which are unrelated to the system
-feeling the Bose-Einstein effects do not have their energies and
-momenta changed in the global rescaling step. (Example: W+W- events,
-where one W decays leptonically; before these lepton momenta could be
-slightly changed, but now not.)
-
------
-
-The option LUEDIT(16) (used e.g. from PYEVNT) has been improved with
-a more extensive search for missing daughter pointers.
-
------
-
-The KLU(I,16) procedure for finding rank has been rewritten to work
-in the current JETSET version, which it did not before. However, note
-that it will only work for MSTU(16)=2. As a general comment, the
-options 14 - 17 of KLU were written at a time when possible event
-histories were less complex, and can not be guaranteed always to work
-today.
-
------------
-
-04, 25 August 1994:
-
-LUSHOW has been corrected, so that if t, l or h quarks (or d* or u*
-quarks masked as l or h) are given with masses that vary from event
-to event (a Breit-Wigner shape, e.g.), the current mass rather than the
-nominal mass is used to define the cut-off scales of parton shower
-evolution.
-
------
-
-LULOGO has been modified to take into account that a new PYTHIA/JETSET
-description has been published in
-T. Sjostrand, Computer Phys. Commun. 82 (1994) 74
-and is from now on the standard reference to these two programs.
-
------------
-
-05, 27 January 1995:
-
-LUCELL has been corrected, in that in the option with smearing of
-energy rather than transverse energy, the conversion factor between
-the two was applied in the wrong direction.
-
------
-
-LUSHOW has been corrected in one place where the PMTH array was
-addressed with the wrong order of the indices. This affected quark
-mass corrections in the matching to the three-jet matrix elements.
-
------
-
-An additional check has been included in LUBOEI that there are at
-least two particles involved in the Bose-Einstein effects. (No
-problem except in some bizarre situations.)
-
------------
-
-06, 20 February 1995:
-
-A new option has been added for the behaviour of the running
-alpha_em(Q2) in ULALEM. This is not added as a true physics scenario,
-but only to produce results with a given, fixed value for the hard
-events, while still keeping the conventional value in the Q2=0 limit.
-MSTU(101) = 2 : if Q2 is less than PARU(104) then alpha_em is
- assigned the value PARU(101) (=1/137), while for Q2 above
- PARU(104) the fixed value PARU(103) (=1/128.8) is used.
-PARU(103) : (D=0.007764=1/128.8) alpha_em used for hard processes
- in the option MSTU(101)=2.
-PARU(104) : (D=1 GeV^2) dividing line for 'low' and 'high'
- Q2 values in the MSTU(101)=2 option of ULALEM.
-
-Additionally, the G_F constant has been added to the parameter list.
-PARU(105) : (D=1.16639E-5 GeV^-2) G_F, the Fermi constant of weak
- interactions.
-
------
-
-The LULOGO routine has been updated to reflect my change of
-affiliation.
-
------------
-
-07, 21 June 1995:
-
-Header and LULOGO have been updated with respect to phone number
-and WWW access.
-
------
-
-The PHEP and VHEP variables in the /HEPEVT/ common block are now
-assumed to be in DOUBLE PRECISION, in accord with the proposed
-LEP 2 workshop addendum to the standard.
-
------
-
-In LUTEST a missing decimal point on the energy check has been
-reinstated (0001 -> 0.0001).
-
------
-
-In LUINDF the expression PR/(Z*W) has been protected against vanishing
-denominator.
-
------------
-
-08, 23 August 1995:
-
-Check against division by zero in LUSHOW.
-
------------------------------------------------------------------
-
-3) Changes in PYTHIA 5.7
-
------------
-
-00, 13 December 1993: baseline version.
-
------------
-
-01, 27 January 1994:
-
-The machinery to handle gamma-gamma interactions is expanded.
-In particular, several new options have been added to MSTP(14).
-The updated description of this variable reads as follows.
-
-MSTP(14) : (D=0) structure of incoming photon beam or target
- (does not affect photon inside electron, only photons appearing
- as argument in the PYINIT call).
- = 0 : a photon is assumed to be point-like (a direct photon),
- i.e. can only interact in processes which explicitly contain
- the incoming photon, such as f_i gamma -> f_i g for gamma-p
- interactions. In gamma-gamma interactions both photons are
- direct, i.e the main process is gamma gamma -> f_i fbar_i.
- = 1 : a photon is assumed to be resolved, i.e. can only interact
- through its constituent quarks and gluons, giving either high-pT
- parton-parton scatterings or low-pT events. Hard processes are
- calculated with the use of the full photon parton distributions.
- In gamma-gamma interactions both photons are resolved.
- = 2 : a photon is assumed resolved, but only the VMD piece is
- included in the parton distributions, which therefore mainly
- are scaled-down versions of the rho0/pi0 ones. Both high-pT
- parton-parton scatterings and low-pT events are allowed. In
- gamma-gamma interactions both photons are VMD-like.
- = 3 : a photon is assumed resolved, but only the anomalous piece of
- the photon parton distributions is included. Only high-pT
- parton-parton scatterings are allowed. In gamma-gamma
- interactions both photons are anomalous.
- = 4 : in gamma-gamma interactions one photon is direct and the other
- resolved. A typical process is thus f_i gamma -> f_i g. Hard
- processes are calculated with the use of the full photon
- parton distributions for the resolved photon. Both possibilities
- of which photon is direct are included, in event topologies and
- in cross sections. This option cannot be used in configurations
- with only one incoming photon.
- = 5 : in gamma-gamma interactions one photon is direct and the other
- VMD-like. Both possibilities of which photon is direct are
- included, in event topologies and in cross sections. This option
- cannot be used in configurations with only one incoming photon.
- = 6 : in gamma-gamma interactions one photon is direct and the other
- anomalous. Both possibilities of which photon is direct are
- included, in event topologies and in cross sections. This option
- cannot be used in configurations with only one incoming photon.
- = 7 : in gamma-gamma interactions one photon is VMD-like and the other
- anomalous. Only high-pT parton-parton scatterings are allowed.
- Both possibilities of which photon is VMD-like are included,
- in event topologies and in cross sections. This option cannot be
- used in configurations with only one incoming photon.
- Note: a complete description requires separate runs for the components
- above, i.e. it is not possible to mix them in a single run. Our
- best understanding of gamma-p interactions [Sch93,Sch93a] is to
- have three separate components, 0 + 2 + 3. A simpler alternative
- is based on two only, 0 + 1. Our best understanding of gamma-gamma
- interactions [in preparation] requires six separate components,
- 0 + 2 + 3 + 5 + 6 + 7. A simpler alternative is based on three
- only, 0 + 1 + 4.
-
-In addition, one new option has been introduced and a few internal
-variables modified.
-
-MSTP(59) : (D=0) possibility to modify the Q2 scale used in the
- anomalous parton distributions of the photon, as used in the
- options MSTP(14) = 3, 6 and 7.
- = 0 : no change of Q2 scale compared to what is normally used.
- = 1 : the input Q2 scaled is divided by PARP(59)**2 to define
- the Q2 scale used as argument for the anomalous parton
- distributions.
-
-PARP(59) : (D=1.) rescaling factor used for the Q2 argument of the
- anomalous parton distributions of the photon, see MSTP(59).
-
-MINT(105) : is MINT(103) or MINT(104), depending on which side
- of the event currently is being studied.
-
-MINT(107), MINT(108) : if either or both of the two incoming particles
- is a photon, then the respective value gives the nature assumed for
- that photon. The code follows the one used for MSTP(14):
- = 0 : direct photon.
- = 1 : resolved photon.
- = 2 : VMD-like photon.
- = 3 : anomalous photon.
-
-MINT(109) : is either MINT(107) or MINT(108), depending on which side
- of the event currently is being studied.
-
-VINT(282) : no longer used.
-
-VINT(283), VINT(284): virtuality scale at which an anomalous photon
- on the beam or target side of the event is being resolved. More
- precisely, it gives the p_T^2 pf the gamma -> q qbar vertex.
-
------
-
-A number of bugs have also been corrected:
-* Jet + low-pT event generation could give incorrect cross section
- information with PYSTAT(1) at low energies. The event generation
- itself is correct. (The error was introduced when variable energies
- became allowed.)
-* Introduce rejection of top events where top mass (in the tails of the
- Breit-Wigner distribution) is too low to allow decays t -> W + b.
-* Plus a few minor bugs, probably harmless.
-
------------
-
-02, 13 February 1994:
-
-The interface to PDFLIB has been modified to reflect that 'TMAS' should
-no longer be set except in first PDFSET call. (Else a huge amount of
-irrelevant warning messages are generated by PDFLIB.)
-
------
-
-The STOP statement in a few dummy routines has been modifed to avoid
-irrelevant compilation warning messages on IBM mainframes.
-
------
-
-A few labels have been renumbered.
-
------------
-
-03, 22 February 1994:
-
-Removal of a bug in PYRESD, which could give (under some specific
-conditions) errors in the colour flow.
-
------------
-
-04, 7 April 1994:
-
-Process 11 has been corrected, for the part that concerns anomalous
-couplings (contact interactions) in the q + q' -> q + q' process.
-The error was present in the expression for u + dbar -> u + dbar
-and obvious permutations, while u + d -> u + d, u + ubar -> u + ubar
-and the others were correct. Thanks to J.-J. Dugne, M. Perrottet and
-K. Lane for communications on this point.
-
------
-
-The option MSTP(23)=1 for post-facto (x,Q^2) conservation in deep
-inelastic scattering can give infinite loops when applied to process
-83, in particular if one asks for the production of a top. (Remember
-that the standard DIS kinematics only is defined for massless quarks.)
-Therefore the switch MSTP(23) has been modifed as follows:
-MSTP(23) : (D=1) (x, Q^2) correction level in DIS.
- = 0 : no correction procedure applied.
- = 1 : correction applied for process 10, but not for process 83.
- = 2 : correction applied both for process 10 and 83. This latter
- option could still work fine for charm and bottom, if the
- energy is sufficient.
-
------
-
-PYRESD is modified to ensure isotropic angular distributions in the
-decays of the top or a fourth generation particle, i.e. in t -> b + W+.
-This may not be the correct distribution but, unless explicit knowledge
-exists for a given process, this should always be the default.
-
------
-
-In processes 16, 20, 31 and 36 the W propagator has been modified to
-include s-dependent widths in the Breit-Wigner shape. The most notable
-effect is a suppression of the low-mass tail of the W mass spectrum.
-
------
-
-When PDFLIB is used, PDFSET is now only called whenever a different
-structure function is requested. For pp events therefore only one call
-is made, while gamma-p interactions still involves a call to PDFSET
-for each STRUCTM one, since gamma and p structure functions have to be
-called alternatingly. To this end, MINT(93) is reset to
-1000000 * Nptype + 1000 * Ngroup + Nset after each PDFSET call.
-
------
-
-In a few places, a dot has been moved from the end of one line to the
-beginning of the next continuation line, or the other way around,
-to keep together tokens such as .EQ. or .AND., since some debuggers
-may otherwise complain. Also some other purely cosmetics changes
-for the same reason.
-
-A number of minor errors have been corrected.
-
------------
-
-05, 15 July 1994:
-
-A new option has been introduced, MSTP(14)=10, whereby it is possible
-to obtain a mixture of the various allowed photon components. For
-gamma-hadron collisions, this means a mixture of VMD, direct and
-anomalous events, for gamma-gamma collisions a mixture of VMD*VMD,
-VMD*direct, VMD*anomalous, direct*direct, direct*anomalous and
-anomalous*anomalous. The mixture is properly given according to
-the relative cross sections.
-
-Note that this introduces a completely new layer of administration in
-PYTHIA. For instance, a subprocess such as q + g -> q + g is allowed
-in the VMD*VMD, VMD*anomalous and anomalous*anomalous classes, but
-appear with different sets of parton distributions and with different
-pT cut-offs. In order to handle this, various information is initialized
-separately for each event class, and subsequently saved and restored
-as the generation switches back and forth between the event classes.
-This introduces some limitations on what you may and may not do.
-
-First of all, the MSTP(14) switch is only applicable for incoming photon
-beams, i.e. when 'gamma' is the argument in the PYINIT call. A
-convolution with the bremsstrahlung photon spectrum in an electron beam
-may come one day, but not in the immediate future.
-
-Secondly, the machinery has only been set up to generate standard
-QCD physics, specifically either 'minimum bias' one or high-pT jets.
-For minimum bias, you are not allowed to use the CKIN variables at all.
-This is not a major limitation, since it is in the spirit of minimum
-bias physics not to impose any contraints on allowed jet production.
-(If you still do, these cuts will be ineffective for the VMD processes
-but take effect for the other ones, giving inconsistencies.) Further,
-some variables are internally recalculated and reset: CKIN(1), CKIN(3),
-CKIN(5), CKIN(6), MSTP(57), MSTP(85), PARP(2), PARP(81), PARP(82),
-PARU(115) and MDME(22,J). These can not be modified without changing
-PYINPR and recompiling the program. The minimum bias physics option
-is obtained by default; by switching from MSEL=1 to MSEL=2 also the
-elastic and diffractive components of the VMD part are included.
-High-pT jet production is obtained by setting the CKIN(3) cut-off
-larger than the (energy-dependent) cut-off scales for the VMD, direct
-and anomalous components; typically this means at least 3 GeV. For
-lower input CKIN(3) the program will automatically switch back to
-minimum bias physics.
-
-Finally, pileup events are not at all allowed.
-
-Here is a survey of common block variables affected:
-
-MSTP(14) (D=0) strucure of incoming photon beam or target;
- see description above for PYTHIA 5.701.
- = 10 : new option where the VMD, direct and anomalous components
- are automatically mixed, as described above. Works equally well
- for gamma-p and gamma-gamma.
-
-MSTI(9) : event class used in current event.
- = 1 : VMD (for gamma-p) or VMD*VMD (for gamma-gamma).
- = 2 : direct (for gamma-p) or VMD*direct (for gamma-gamma).
- = 3 : anomalous (for gamma-p) or VMD*anomalous (for gamma-gamma).
- = 4 : direct*direct (for gamma-gamma).
- = 5 : direct*anomalous (for gamma-gamma).
- = 6 : anomalous*anomalous (for gamma-gamma).
-
-MINT(121) : number of separate event classes to initialize and mix.
- = 1 : the normal value.
- = 3 : for a gamma-hadron interaction when MSTP(14)=10.
- = 6 : for a gamma-gamma interaction when MSTP(14)=10.
-
-MINT(122) : event class used in current event. Code as explained for
- MSTI(9).
-
-MINT(123) : event class used in the current event, with the same list
- of possibilities as MSTP(14), except that MSTP(14) = 1, 4 or 10
- do not appear.
-
-VINT(285) : the CKIN(3) value provided by the user at initialization;
- subsequently CKIN(3) may be overwritten (for MSTP(14)=10) but
- VINT(285) stays.
-
-In addition, the structure of the initialization has been partly
-reorganized. The routine PYEVKI has been removed, new routines
-PYINBM, PYINPR and PYSAVE created, and some material has been moved
-to or from PYINIT, PYINRE and PYINKI.
-
-SUBROUTINE PYINBM : to read in and identify beam and target particles
- and frame as given in the PYINIT call (used to be done in PYINKI).
-
-SUBROUTINE PYINKI(MODKI) : to set up event kinematics, either at
- initialization (MODKI=0) or for each separate event when varying
- kinematics (MODKI=1). (The latter task used to be done in PYEVKI.)
-
-SUBROUTINE PYINPR : to set up the partonic subprocesses selected with
- MSEL and, for gamma-p and gamma-gamma, MSTP(14).
-
-SUBROUTINE PYSAVE : saves and restores parameters and cross section
- values between the 3 gamma-p and the 6 gamma-gamma alternatives
- of MSTP(14)=10. Also makes a random choice for each new event
- between the allowed alternatives.
-
-Among other changes, note that PYSTAT(1) now has been extended so
-that the subdivision into the various gamma-p and gamma-gamma classes
-is shown.
-
------
-
-Further changes of particular relevance for gamma-p and gamma-gamma,
-but independent of the major revisions above:
-
-MSTP(59) and PARP(59) have been removed. Instead the following options
-are available:
-
-MSTP(15) : (D=5) possibility to modify the nature of the anomalous
-photon component, in particular with respect to the scale choices and
-cut-offs of hard processes.
- = 0 : none, i.e. the same treatment as for the VMD component.
- = 1 : evaluate the anomalous structure functions at a scale
- Q2/PARP(17)^2.
- = 2 : as =1, but instead of PARP(17) use PARP(81)/PARP(15) or
- PARP(82)/PARP(15), depending on MSTP(82) value.
- = 3 : evaluate anomalous structure function as
- f^(anom)(x, Q2, p_0^2) - f^(anom)(x, Q2, r^2*Q2)
- with r = PARP(17).
- = 4 : as =3, but instead of PARP(17) use PARP(81)/PARP(15) or
- PARP(82)/PARP(15), depending on MSTP(82) value.
- = 5 : use larger pTmin for anomalous component than for VMD one,
- but otherwise no difference.
-
-PARP(17) : (D=1) rescaling factor used as described for MSTP(15).
-
-MSTP(51) : new option added.
- = 11 : the GRV p LO parametrization.
-
-MSTP(53) : new option added.
- = 3 : the GRV pi LO parametrization.
-
-MSTP(56) : new option added.
- = 3 : when the anomalous photon structure function is requested,
- the homogeneous solution is provided, evolved from a starting
- value PARP(15) to the requested Q scale. The homogeneous
- solution is normalized so that the net momentum is unity,
- i.e. any factors of alpha_em/2pi and charge have been left out.
- The flavour of the original q is given in MSTP(55) (1, 2, 3, 4
- or 5 for d, u, s, c or b); the value 0 gives a mixture
- according to squared charge, with the exception that c and b
- are only allowed above the respective mass threshold (Q > m_q).
- The four-flavour Lambda value is assumed given in PARP(1);
- it is automatically recalculated for 3 or 5 flavours at
- thresholds. This option is not intended for standard event
- generation, but is useful for some theoretical studies.
-
------
-
-Option MSTP(92)=5 for beam remnant treatment erroneously missed some
-statements which now have been inserted.
-
-Further, new options have been added for the splitting of momentum
-between two beam remnants. MSTP(92) keeps its current role for the
-production of diquark or quark jets. However, for the splitting into
-a hadron plus a quark/diquark jet, MSTP(94) should now be used.
-
-MSTP(94) : (D=2) (C) energy partitioning in hadron or resolved photon
-remnant, when this is split into a hadron plus a remainder-jet. The
-energy fraction chi is taken by one of the two objects, with
-conventions as described below or for PARP(95) and PARP(97).
- = 1 : 1 for meson or resolved photon, 2(1-chi) for baryon, i.e.
- simple counting rules.
- = 2 : (k+1)*(1-chi)**k, with k as given in PARP(95) or PARP(97).
- = 3 : the chi of the hadron is selected according to the normal
- fragmentation function used for the hadron in jet fragmentation,
- see MSTJ(11). The possibility of a changed fragmentation
- function shape in diquark fragmentation (see PARJ(45)) is not
- included.
- = 4 : as =3, but the shape is changed as allowed in diquark
- fragmentation (see PARJ(45)); this change is here also allowed
- for meson production.
-
------
-
-In PYDIFF the recoiling gluon energy is calculated in a numerically more
-stable fashion.
-
------
-
-A counter has been added to PYSSPA to avoid infinite loops in the
-angular ordering constraint due to interference with the final state
-colour charges.
-
------------
-
-06, 25 August 1994:
-
-New processes 167 and 168 have been added for the contact interaction
-production of d* or u* excited quarks
-167 q q' -> q" d*
-168 q q' -> q" u*
-where the different allowed quark and antiquark combinations are given
-according to eqs. (15) - (19) in U. Baur, M. Spira and P.M. Zerwas,
-Phys. Rev. D42 (1990) 815. The d* and u* are defined in the same
-way as for processes 147 and 148. Thus one needs to put MSTP(6)=1 to
-use l (7) and h (8) for representing the d* and u*. The couplings of
-the allowed decay channels are given by PARU(157) - PARU(159), and
-the Lambda scale parameter by PARU(155).
-
-At the same time, some minor changes has been introduced in the code
-for processes 147 and 148, for uniformity.
-
------
-
-Option MSTP(57)=3 now also allows a dampening of pi+- parton
-distributions.
-
------
-
-A few minor errors have been corrected.
-
------------
-
-07, 20 October 1994:
-
-A major bug discovered in processes 121 and 122 (and thus also affecting
-181, 182, 186 and 187), g g or q qbar -> Q Qbar H: the kinematics was
-incorrectly handed on to the Kunszt matrix elements. This affected the
-default option Q = t, but effects were especially dramatic when the
-alternative Q = b was used.
-
-The choice of appropriate Q2 scale for structure functions introduces
-a further uncertainty in cross sections for the processes above. So long
-as only t quarks are considered, the t mass is a reasonable choice, but
-for the Q = b alternative this is presumably too low. Therefore new
-options have been introduced as below, with the default behaviour
-changed (the old one is obtainable with MSTP(39)=1).
-
-MSTP(39) : (D=2) choice of Q2 scale for structure functions and initial
-state parton showers in processes g g or q qbar -> Q Qbar H.
- = 1 : m_Q**2.
- = 2 : max(mT_Q**2 , mT_Qbar**2) =
- m_Q**2 + max(pT_Q**2 , pT_Qbar**2).
- = 3 : m_H**2.
- = 4 : shat = (p_H + p_Q + p_Qbar)**2.
-
------
-
-Another important bug corrected in the calculation of the reduction of
-t+tbar cross section when decay modes are forced. This occured when both
-t and tbar produced a W, and W+ and W- decay modes were set differently.
-
------------
-
-08, 25 October 1994:
-
-A few further places changed to make processes 181, 182, 186 and 187
-work (see version 5.707 above).
-
------------
-
-09, 26 October 1994:
-
-The matrix element for f + fbar -> W+ + W- has been replaced, using the
-formulae of
-D. Bardin, M. Bilenky, D. Lehner, A. Olchevski and T. Riemann,
-CERN-TH.7295/94,
-but with the dependence on the t-hat variable not integrated out
-(D. Bardin, private communication).
-This avoids some problems encountered in the old expressions when
-one or both W's were far off the mass shell.
-
------
-
-Change in calls to PDFLIB, so that the input Q is always at least the
-QMIN of the respective set.
-
------
-
-Extra protection against infinite loops in PYSSPA.
-
------------
-
-10, 27 January 1995:
-
-The dimensions of the HGZ array in PYRESD has been expanded to avoid
-accidental writing outside the bounds.
-
------
-
-VINT(41) - VINT(66) are saved and restored in PYSCAT, for use in low-pT
-events, when beam remnant treatment has failed (with nonzero MINT(57)).
-
------
-
-The routine PYSTGH has been replaced by the routine PYSTHG. This
-contains an improved parametrization of the homogeneous evolution
-of an anomalous photon from some given initial scale. The argument
-NF of the PYSTGH routine has been removed; now Lambda is always
-automatically converted to the relevant NF-flavour value from its
-4-flavour one, at flavour thresholds.
-
------------
-
-11, 20 February 1995:
-
-New possibilities have been added to switch between electroweak
-couplings being expressed in terms of a running alpha_em(Q2) or
-in terms of a fixed Fermi constant G_F. This affects both decay widths
-and process cross sections, in the routines PYINRE, PYRESD, PYWIDT and
-PYSIGH. There are three main options, with default agreeing with the
-old standard.
-
-MSTP(8) : (D=0) choice of electroweak parameters to use in decay
- widths of resonances (W, Z, H, ...) and cross sections (production
- of W's, Z's, H's, ...).
- = 0 : everything is expressed in terms of a running alpha_em(Q2)
- and a fixed sin^2(theta_W), i.e. G_F is nowhere used.
- = 1 : a replacement is made according to
- alpha_em(Q2) -> sqrt(2) G_F m_W^2 sin^2(theta_W) / pi
- in all widths and cross sections. If G_F and m_Z are considered
- as given, this means that sin^2(theta_W) and m_W are the only
- free electroweak parameter.
- = 2 : a replacement is made as for =1, but additionally
- sin^2(theta_W) is constrained by the relation
- sin^2(theta_W) = 1 - m_W^2/m_Z^2
- This means that m_W remains as a free parameter, but that the
- sin^(theta_W) value in PARU(102) is never used, EXCEPT in
- the vector couplings in the combination
- v = a - 4 sin^2(theta_W) e.
- This degree of freedom enters e.g. for forward-backward
- asymmetries in Z^0 decays.
-Note : This option does not affect the emission of real photons in the
- initial and final state, where alpha_em is always used. However,
- it does affect also purely electromagnetic hard processes, such as
- q + qbar -> gamma + gamma.
-
------
-
-The option MSTP(37)=1, with running quark masses in couplings to Higgs
-bosons, only works when alpha_s is allowed to run (so one can define
-a Lambda value). Therefore a check has been introduced in PYWIDT and
-PYSIGH that the option MSTP(37)=1 is only executed if additionally
-MSTP(2) is 1 or bigger.
-
------
-
-Some non-physics changes have been made in the RKBBV and STRUCTM codes
-so as to avoid some (in principle harmless) compiler warnings.
-
------------
-
-12, 15 March 1995:
-
-A serious error has been corrected in the MSTP(173)=1 option, i.e. when
-the program is run with user-defined weights that should compensate for
-a biased choice of variable beam energies. This both affected the
-relative admixture of low- and high-pT events and the total cross
-section obtained by Monte Carlo integration. (PYRAND changed.)
-
-In order to improve the flexibility and efficiency of the variable-energy
-option, the user should now set PARP(174) before the PYINIT call, and
-thereafter not change it. This allows PARP(173) weights of arbitrary
-size. (PYRAND and PYMAXI changed.)
-PARP(174) : (D=1.) maximum event weight that will be encountered in
- PARP(173) during the course of a run with MSTP(173)=1; to be used
- to optimize the efficiency of the event generation. It is always
- allowed to use a larger bound than the true one, but with a
- corresponding loss in efficiency.
-
-MSTI(5) (and MINT(5)) are now changed so they count the number of
-successfully generated events, rather than the number of tries made.
-This change only affects runs with variable energies, MSTP(171)=1 and
-MSTP(172)=2, where MSTI(61)=1 signals that a user-provided energy
-has been rejected in the weighting. This change also affects PARI(2),
-which becomes the cross section per fully generated event. (PYEVNT
-changed.)
-
------
-
-The option MSTP(14)=10 has now been extended so that it also works for
-deep inelastic sacattering of an electron off a (real) photon, i.e.
-process ISUB = 10. What is obtained is a mixture of the photon acting
-as a vector meson and it acting as an anomalous state. This should
-therefore be the sum of what can be obtained with MSTP(14)=2 and =3.
-It is distinct from MSTP(14)=1 in that different sets are used for
-the parton distributions - in MSTP(14)=1 all the contributions to the
-photon distributions are lumped together, while they are split in
-VMD and anomalous parts for MSTP(14)=10. Also the beam remnant treatment
-is different, with a simple Gaussian distribution (at least by default)
-for MSTP(14)=1 and the VMD part of MSTP(14)=10, but a powerlike
-distribution d(kT^2)/kT^2 between PARP(15) and Q for the anomalous
-part of MSTP(14)=10. (PYINIT, PYINPR and PYSTAT changed.)
-
-To access this option for e and gamma as incoming beams, it is only
-necessary to set MSTP(14)=10 and keep MSEL at its default value.
-Unlike the corresponding option for gamma-p and gamma-gamma, no
-cuts are overwritten, i.e. it is still the responsability of the user
-to set these appropriately. Those especially appropriate for DIS usage
-are CKIN(21)-CKIN(22) or CKIN(23)-CKIN(24) for the x range (former or
-latter depending on which side is the incoming real photon),
-and CKIN(35)-CKIN(36) for the Q2 range. A further new option has been
-added (in PYKLIM):
-CKIN(39), CKIN(40) : (D=4., -1. GeV^2) the W2 range allowed in DIS
- processes, i.e. subprocess number 10. If CKIN(40) < 0., the upper
- limit is inactive. Here W2 is defined in terms of W2 = Q2 * (1-x)/x.
- This formula is not quite correct, in that (i) it neglects the
- target mass (for a proton), and (ii) it neglects initial-state
- photon radiation off the incoming electron. It should be good
- enough for loose cuts, however.
-
-A warning about the usage of PDFLIB for photons. So long as MSTP(14)=1,
-i.e. the photon is not split up, PDFLIB is accessed by MSTP(56)=2 and
-MSTP(55) = parton distribution set, as described in the manual.
-However, when the VMD and anomalous pieces are split, the VMD part
-is based on a rescaling of pion distributions by VMD factors
-(except for the SaS sets, that already come with a separate VMD piece).
-Therefore, to access PDFLIB for MSTP(14)=10, it is not correct to set
-MSTP(56)=2 and a photon distribution in MSTP(55). Instead, one should
-put MSTP(56)=2, MSTP(54)=2 and a pion distribution code in MSTP(53),
-while MSTP(55) has no function. The anomalous part is still based on
-the SaS parametrization, with PARP(15) as main free parameter.
-
------
-
-A change has been made in PYREMN to reduce the possibility of infinite
-loops.
-
------------
-
-13, 22 March 1995:
-
-The SaS parton distributions of the photons are now available.
-For details on these sets, see
-G.A. Schuler and T. Sjostrand,
-"Low- and high-mass components of the photon distribution functions",
-CERN-TH/95-62 and LU TP 95-6.
-There are four new sets. These differ in that two use a Q0=0.6 GeV and
-two a Q0=2 GeV, and in that two use the DIS and two the MSbar conventions
-for the dominant non-leading contributions. (However, the fits are
-formally still leading-order, in that not all next-to-leading
-contributions have been included.) New default is the SaS 1D set.
-Furthermore, for the definition of F_2^gamma, additional terms appear
-that do not form part of the parton distributions itself. To partly
-take this into account, an additional doubling of the possibilities
-has been included. These possibilites can be accesed with MSTP(55):
-
-MSTP(55) : (D=5) choice of parton-distribution set of the photon;
- see also MSTP(56).
- = 1 : Drees-Grassie.
- = 5 : SaS 1D (in DIS scheme, with Q0=0.6 GeV).
- = 6 : SaS 1M (in MSbar scheme, with Q0=0.6 GeV).
- = 7 : SaS 2D (in DIS scheme, with Q0=2 GeV).
- = 8 : SaS 2M (in MSbar scheme, with Q0=2 GeV).
- = 9 : SaS 1D (in DIS scheme, with Q0=0.6 GeV).
- = 10 : SaS 1M (in MSbar scheme, with Q0=0.6 GeV).
- = 11 : SaS 2D (in DIS scheme, with Q0=2 GeV).
- = 12 : SaS 2M (in MSbar scheme, with Q0=2 GeV).
- Note 1 : sets 5 - 8 use the parton distributions of the respective
- set, and nothing else. These are appropriate for most
- applications, e.g. jet production in gamma-p and gamma-gamma
- collisions. Sets 9 - 12 instead are appropriate for
- gamma*-gamma processes, i.e. DIS scattering on a photon,
- as measured in F_2^gamma. Here the anomalous contribution
- for c and b quarks are handled by the Bethe-Heitler formulae,
- and the direct term is artificially lumped with the anomalous
- one, so that the event simulation more closely agrees with what
- will be experimentally observed in these processes. The agreement
- with the F_2^gamma parametrization is still not perfect, e.g.
- in the treatment of heavy flavours close to threshold.
- Note 2 : Sets 5 - 12 contain both VMD pieces and anomalous pieces,
- separately parametrized. Therefore the respective piece is
- automatically called, whatever MSTP(14) value is used to select
- only a part of allowed photon interactions. For other sets
- (set 1 above or PDFLIB sets), usually there is no corresponding
- subdivision. Then an option like MSTP(14)=2 (VMD part of photon
- only) is based on a rescaling of the pion distributions, while
- MSTP(14)=3 gives the SaS anomalous parametrization.
- Note 3 : Formally speaking, the k0 (or p0) cut-off in PARP(15)
- need not be set in any relation to the Q0 cut-off scales used by
- the various parametrizations. Indeed, due to the familiar scale
- choice ambiguity problem, there could well be some offset between
- the two. However, unless you know what you are doing, it is
- strongly recommended that you let the two agree, i.e. set
- PARP(15)=0.6 for the SaS 1 sets and =2 for the SaS 2 sets.
-
-PARP(15) : (D=0.6 GeV) default value changed for k0 cut-off for
- separation between direct, VMD and anomalous photons; see Note 3
- for MSTP(55) above.
-
-The generic routine PYSTFU has been rewritten to handle the interfacing.
-The old routines PYSTAG, PYSTGS, PYDILN and PYSTHG have been removed.
-Instead the routines of the SaSgam library have been inserted. In order
-to avoid any clashes, the routines SAS*** have been renamed PYG***.
-Thus new routines are PYGGAM, PYGVMD, PYGANO, PYGBEH and PYGDIR.
-The common block SASCOM is renamed PYINT8. If you want to use the
-parton distributions for standalone purposes, you are encouraged to
-use the original SaSgam routines rather than going the way via the
-Pythia adaptations.
-
- COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
- &XPDIR(-6:6)
-Purpose: to store the various components of the parton distributions
- when the PYGGAM routine is called.
-XPVMD(KFL) : gives distributions of the VMD part (rho, omega and
- phi).
-XPANL(KFL) : gives distributions of the anomalous part of light quarks
- (d, u and s).
-XPANH(KFL) : gives distributions of the anomalous part of heavy quarks
- (c and b).
-XPBEH(KFL) : gives Bethe-Heitler distributions of heavy quarks (c and b).
- This provides an alternative to XPANH, i.e. both should not be used
- at the same time.
-XPDIR(KFL) : gives direct correction to the production of light quarks
- (d, u and s). This term is nonvanishing only in the MSbar scheme,
- and is applicable for F_2^gamma rather than for the parton
- distributions themselves.
-
------
-
-PYDOCU has been corrected so that PARI(2) refers to the full cross
-section for gamma-p and gamma-gamma processes, rather than that of
-the latest subprocess considered.
-
-An additional check has been inserted into PYREMN.
-
------------
-
-14, 23 March 1995:
-
-Some minor modifications to PYSTFU and PYGGAM in the wake of the
-changes of the previous version.
-
------------
-
-15, 24 April 1995:
-
-An unfortunate choice of default values has been corrected:
-the old MSTP(3)=2 value implied that Lambda_QCD was entirely based on
-the Lambda value of the proton structure function; also e.g. for e+e-
-annihilation events. Thus the Lambda in PARJ(81) was overwritten,
-i.e. did not keep the value required by standard phenomenology, which
-typically gave too narrow jets. (While switching to MSTP(3)=1 it worked
-fine.) In the modified option MSTP(3)=2 this has been corrected, to
-better agree with user expectations. Change affects PYINIT and
-PYRESD. (See further version 16 for additional changes.)
-
-MSTP(3) : (D=2) choice of Lambda_QCD values.
- = 1 : separate for hard scattering, initial showers and final
- showers, as before. Additionally separate for resonance
- decays, given in PARP(3).
- = 2 : most Lambda values are set to that of the proton structure
- function used, except for the Lambda used in the decay of
- a resonance (as treated in PYRESD). There the PARP(3) value
- is used, with default as in e+e-.
- = 3 : all Lambda values are set to that of the proton structure
- function used, as was the case for =2 before.
-
-PARP(3) : (D=0.29 GeV) the Lambda value used in timelike parton showers
- in the decay of a resonance (in PYRESD).
-
------
-
-The form for PTMANO, the pTmin for anomalous processes, as used in
-PYINPR when processes are mixed for gamma-p or gamma-gamma events,
-has been updated to match (as well as can be expected) the SaS 1D
-photon distributions.
-
------------
-
-16, 30 June 1995:
-
-The strategy for the changes to MSTP(3) in version 15 above have been
-modified for better transparency. The parameter PARP(3) has been removed,
-and instead PARP(72) has been introduced. Now PARJ(81) is used for
-resonance decays (including e.g. Z0 decay, from which it is determined),
-and PARP(72) for other timelike showers. PARJ(81) is not overwritten
-for MSTP(3) = 2, but only for = 3. Changes affect PYINIT, PYEVNT and
-PYRESD.
-
-PARP(72) : (D=0.25 GeV) the Lambda value used in timelike parton showers
- except in the decay of a resonance.
-
------
-
-A new multiplicative factor has been introduced for the hard scattering
-in PYSIGH.
-
-PARP(34) : (D=1.) the Q2 scale defined by MSTP(32) is multiplied by PARP(34)
- when it is used as argument for structure functions and alpha_s at the
- hard interaction. It does not affect alpha_s when MSTP(33)=3, nor
- does it change the Q2 argument of parton showers.
-
------
-
-PYREMN has been corrected for occasional too large boost factors.
-
-An error in PYSIGH for process 148 has been corrected.
-
-The MSTP(62)=1 option of PYSSPA is modified to avoid division by zero.
-
-Header has been updated with WWW-information.
-
------------
-
-17, 23 August 1995:
-
-MIN1, MIN2, MAX1, MAX2, MINA and MAXA in PYSIGH have had an extra M
-prefixed to avoid confusion with Fortran functions.
-
-Protect against MDCY(0,1) being accessed in PYSIGH.
-
-Protect against THB=0 in PYRAND.
-
-Protect against YSTMAX-YSTMIN = 0 in PYSIGH.
-
-Check for moved leptoquark at beginning of PYRESD just like for
-other particles with colour.
-
------------------------------------------------------------------
+++ /dev/null
- subroutine dummypythia
- common / lujets / d00
- common / ludatr / d01
- common / ludat1 / d02
- common / ludat2 / d03
- common / ludat3 / d04
- common / ludat4 / d05
- common / pysubs / d06
- common / pypars / d07
- common / pyint1 / d08
- common / pyint2 / d09
- common / pyint3 / d10
- common / pyint4 / d11
- common / pyint5 / d12
- end
+++ /dev/null
-
-C*********************************************************************
-
- FUNCTION KLU(I,J)
-
-C...Purpose: to provide various integer-valued event related data.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Default value. For I=0 number of entries, number of stable entries
-C...or 3 times total charge.
- KLU=0
- IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN
- ELSEIF(I.EQ.0.AND.J.EQ.1) THEN
- KLU=N
- ELSEIF(I.EQ.0.AND.(J.EQ.2.OR.J.EQ.6)) THEN
- DO 100 I1=1,N
- IF(J.EQ.2.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+1
- IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+
- & LUCHGE(K(I1,2))
- 100 CONTINUE
- ELSEIF(I.EQ.0) THEN
-
-C...For I > 0 direct readout of K matrix or charge.
- ELSEIF(J.LE.5) THEN
- KLU=K(I,J)
- ELSEIF(J.EQ.6) THEN
- KLU=LUCHGE(K(I,2))
-
-C...Status (existing/fragmented/decayed), parton/hadron separation.
- ELSEIF(J.LE.8) THEN
- IF(K(I,1).GE.1.AND.K(I,1).LE.10) KLU=1
- IF(J.EQ.8) KLU=KLU*K(I,2)
- ELSEIF(J.LE.12) THEN
- KFA=IABS(K(I,2))
- KC=LUCOMP(KFA)
- KQ=0
- IF(KC.NE.0) KQ=KCHG(KC,2)
- IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) KLU=K(I,2)
- IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) KLU=K(I,2)
- IF(J.EQ.11) KLU=KC
- IF(J.EQ.12) KLU=KQ*ISIGN(1,K(I,2))
-
-C...Heaviest flavour in hadron/diquark.
- ELSEIF(J.EQ.13) THEN
- KFA=IABS(K(I,2))
- KLU=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10)
- IF(KFA.LT.10) KLU=KFA
- IF(MOD(KFA/1000,10).NE.0) KLU=MOD(KFA/1000,10)
- KLU=KLU*ISIGN(1,K(I,2))
-
-C...Particle history: generation, ancestor, rank.
- ELSEIF(J.LE.15) THEN
- I2=I
- I1=I
- 110 KLU=KLU+1
- I2=I1
- I1=K(I1,3)
- IF(I1.GT.0.AND.K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110
- IF(J.EQ.15) KLU=I2
- ELSEIF(J.EQ.16) THEN
- KFA=IABS(K(I,2))
- IF(K(I,1).LE.20.AND.((KFA.GE.11.AND.KFA.LE.20).OR.KFA.EQ.22.OR.
- & (KFA.GT.100.AND.MOD(KFA/10,10).NE.0))) THEN
- I1=I
- 120 I2=I1
- I1=K(I1,3)
- IF(I1.GT.0) THEN
- KFAM=IABS(K(I1,2))
- ILP=1
- IF(KFAM.NE.0.AND.KFAM.LE.10) ILP=0
- IF(KFAM.EQ.21.OR.KFAM.EQ.91.OR.KFAM.EQ.92.OR.KFAM.EQ.93)
- & ILP=0
- IF(KFAM.GT.100.AND.MOD(KFAM/10,10).EQ.0) ILP=0
- IF(ILP.EQ.1) GOTO 120
- ENDIF
- IF(K(I1,1).EQ.12) THEN
- DO 130 I3=I1+1,I2
- IF(K(I3,3).EQ.K(I2,3).AND.K(I3,2).NE.91.AND.K(I3,2).NE.92
- & .AND.K(I3,2).NE.93) KLU=KLU+1
- 130 CONTINUE
- ELSE
- I3=I2
- 140 KLU=KLU+1
- I3=I3+1
- IF(I3.LT.N.AND.K(I3,3).EQ.K(I2,3)) GOTO 140
- ENDIF
- ENDIF
-
-C...Particle coming from collapsing jet system or not.
- ELSEIF(J.EQ.17) THEN
- I1=I
- 150 KLU=KLU+1
- I3=I1
- I1=K(I1,3)
- I0=MAX(1,I1)
- KC=LUCOMP(K(I0,2))
- IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN
- IF(KLU.EQ.1) KLU=-1
- IF(KLU.GT.1) KLU=0
- RETURN
- ENDIF
- IF(KCHG(KC,2).EQ.0) GOTO 150
- IF(K(I1,1).NE.12) KLU=0
- IF(K(I1,1).NE.12) RETURN
- I2=I1
- 160 I2=I2+1
- IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 160
- K3M=K(I3-1,3)
- IF(K3M.GE.I1.AND.K3M.LE.I2) KLU=0
- K3P=K(I3+1,3)
- IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) KLU=0
-
-C...Number of decay products. Colour flow.
- ELSEIF(J.EQ.18) THEN
- IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) KLU=MAX(0,K(I,5)-K(I,4)+1)
- IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) KLU=0
- ELSEIF(J.LE.22) THEN
- IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN
- IF(J.EQ.19) KLU=MOD(K(I,4)/MSTU(5),MSTU(5))
- IF(J.EQ.20) KLU=MOD(K(I,5)/MSTU(5),MSTU(5))
- IF(J.EQ.21) KLU=MOD(K(I,4),MSTU(5))
- IF(J.EQ.22) KLU=MOD(K(I,5),MSTU(5))
- ELSE
- ENDIF
-
- RETURN
- END
+++ /dev/null
-C*********************************************************************
-C*********************************************************************
-C* **
-C* December 1993 **
-C* **
-C* The Lund Monte Carlo for Jet Fragmentation and e+e- Physics **
-C* **
-C* JETSET version 7.4 **
-C* **
-C* Torbjorn Sjostrand **
-C* Department of theoretical physics 2 **
-C* University of Lund **
-C* Solvegatan 14A, S-223 62 Lund, Sweden **
-C* E-mail torbjorn@thep.lu.se **
-C* phone +46 - 46 - 222 48 16 **
-C* **
-C* LUSHOW is written together with Mats Bengtsson **
-C* **
-C* The latest program version and documentation is found on WWW **
-C* http://thep.lu.se/tf2/staff/torbjorn/Welcome.html **
-C* **
-C* Copyright Torbjorn Sjostrand and CERN, Geneva 1993 **
-C* **
-C*********************************************************************
-C*********************************************************************
-C *
-C List of subprograms in order of appearance, with main purpose *
-C (S = subroutine, F = function, B = block data) *
-C *
-C S LU1ENT to fill one entry (= parton or particle) *
-C S LU2ENT to fill two entries *
-C S LU3ENT to fill three entries *
-C S LU4ENT to fill four entries *
-C S LUJOIN to connect entries with colour flow information *
-C S LUGIVE to fill (or query) commonblock variables *
-C S LUEXEC to administrate fragmentation and decay chain *
-C S LUPREP to rearrange showered partons along strings *
-C S LUSTRF to do string fragmentation of jet system *
-C S LUINDF to do independent fragmentation of one or many jets *
-C S LUDECY to do the decay of a particle *
-C S LUKFDI to select parton and hadron flavours in fragm *
-C S LUPTDI to select transverse momenta in fragm *
-C S LUZDIS to select longitudinal scaling variable in fragm *
-C S LUSHOW to do timelike parton shower evolution *
-C S LUBOEI to include Bose-Einstein effects (crudely) *
-C F ULMASS to give the mass of a particle or parton *
-C S LUNAME to give the name of a particle or parton *
-C F LUCHGE to give three times the electric charge *
-C F LUCOMP to compress standard KF flavour code to internal KC *
-C S LUERRM to write error messages and abort faulty run *
-C F ULALEM to give the alpha_electromagnetic value *
-C F ULALPS to give the alpha_strong value *
-C F ULANGL to give the angle from known x and y components *
-C F RLU to provide a random number generator *
-C S RLUGET to save the state of the random number generator *
-C S RLUSET to set the state of the random number generator *
-C S LUROBO to rotate and/or boost an event *
-C S LUEDIT to remove unwanted entries from record *
-C S LULIST to list event record or particle data *
-C S LULOGO to write a logo for JETSET and PYTHIA *
-C S LUUPDA to update particle data *
-C F KLU to provide integer-valued event information *
-C F PLU to provide real-valued event information *
-C S LUSPHE to perform sphericity analysis *
-C S LUTHRU to perform thrust analysis *
-C S LUCLUS to perform three-dimensional cluster analysis *
-C S LUCELL to perform cluster analysis in (eta, phi, E_T) *
-C S LUJMAS to give high and low jet mass of event *
-C S LUFOWO to give Fox-Wolfram moments *
-C S LUTABU to analyze events, with tabular output *
-C *
-C S LUEEVT to administrate the generation of an e+e- event *
-C S LUXTOT to give the total cross-section at given CM energy *
-C S LURADK to generate initial state photon radiation *
-C S LUXKFL to select flavour of primary qqbar pair *
-C S LUXJET to select (matrix element) jet multiplicity *
-C S LUX3JT to select kinematics of three-jet event *
-C S LUX4JT to select kinematics of four-jet event *
-C S LUXDIF to select angular orientation of event *
-C S LUONIA to perform generation of onium decay to gluons *
-C *
-C S LUHEPC to convert between /LUJETS/ and /HEPEVT/ records *
-C S LUTEST to test the proper functioning of the package *
-C B LUDATA to contain default values and particle data *
-C *
-C*********************************************************************
-
- SUBROUTINE LU1ENT(IP,KF,PE,THE,PHI)
-
-C...Purpose: to store one parton/particle in commonblock LUJETS.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Standard checks.
- MSTU(28)=0
- IF(MSTU(12).GE.1) CALL LULIST(0)
- IPA=MAX(1,IABS(IP))
- IF(IPA.GT.MSTU(4)) CALL LUERRM(21,
- &'(LU1ENT:) writing outside LUJETS memory')
- KC=LUCOMP(KF)
- IF(KC.EQ.0) CALL LUERRM(12,'(LU1ENT:) unknown flavour code')
-
-C...Find mass. Reset K, P and V vectors.
- PM=0.
- IF(MSTU(10).EQ.1) PM=P(IPA,5)
- IF(MSTU(10).GE.2) PM=ULMASS(KF)
- DO 100 J=1,5
- K(IPA,J)=0
- P(IPA,J)=0.
- V(IPA,J)=0.
- 100 CONTINUE
-
-C...Store parton/particle in K and P vectors.
- K(IPA,1)=1
- IF(IP.LT.0) K(IPA,1)=2
- K(IPA,2)=KF
- P(IPA,5)=PM
- P(IPA,4)=MAX(PE,PM)
- PA=SQRT(P(IPA,4)**2-P(IPA,5)**2)
- P(IPA,1)=PA*SIN(THE)*COS(PHI)
- P(IPA,2)=PA*SIN(THE)*SIN(PHI)
- P(IPA,3)=PA*COS(THE)
-
-C...Set N. Optionally fragment/decay.
- N=IPA
- IF(IP.EQ.0) CALL LUEXEC
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LU2ENT(IP,KF1,KF2,PECM)
-
-C...Purpose: to store two partons/particles in their CM frame,
-C...with the first along the +z axis.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Standard checks.
- MSTU(28)=0
- IF(MSTU(12).GE.1) CALL LULIST(0)
- IPA=MAX(1,IABS(IP))
- IF(IPA.GT.MSTU(4)-1) CALL LUERRM(21,
- &'(LU2ENT:) writing outside LUJETS memory')
- KC1=LUCOMP(KF1)
- KC2=LUCOMP(KF2)
- IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LUERRM(12,
- &'(LU2ENT:) unknown flavour code')
-
-C...Find masses. Reset K, P and V vectors.
- PM1=0.
- IF(MSTU(10).EQ.1) PM1=P(IPA,5)
- IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
- PM2=0.
- IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
- IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
- DO 110 I=IPA,IPA+1
- DO 100 J=1,5
- K(I,J)=0
- P(I,J)=0.
- V(I,J)=0.
- 100 CONTINUE
- 110 CONTINUE
-
-C...Check flavours.
- KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
- KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
- IF(MSTU(19).EQ.1) THEN
- MSTU(19)=0
- ELSE
- IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LUERRM(2,
- & '(LU2ENT:) unphysical flavour combination')
- ENDIF
- K(IPA,2)=KF1
- K(IPA+1,2)=KF2
-
-C...Store partons/particles in K vectors for normal case.
- IF(IP.GE.0) THEN
- K(IPA,1)=1
- IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2
- K(IPA+1,1)=1
-
-C...Store partons in K vectors for parton shower evolution.
- ELSE
- K(IPA,1)=3
- K(IPA+1,1)=3
- K(IPA,4)=MSTU(5)*(IPA+1)
- K(IPA,5)=K(IPA,4)
- K(IPA+1,4)=MSTU(5)*IPA
- K(IPA+1,5)=K(IPA+1,4)
- ENDIF
-
-C...Check kinematics and store partons/particles in P vectors.
- IF(PECM.LE.PM1+PM2) CALL LUERRM(13,
- &'(LU2ENT:) energy smaller than sum of masses')
- PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/
- &(2.*PECM)
- P(IPA,3)=PA
- P(IPA,4)=SQRT(PM1**2+PA**2)
- P(IPA,5)=PM1
- P(IPA+1,3)=-PA
- P(IPA+1,4)=SQRT(PM2**2+PA**2)
- P(IPA+1,5)=PM2
-
-C...Set N. Optionally fragment/decay.
- N=IPA+1
- IF(IP.EQ.0) CALL LUEXEC
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LU3ENT(IP,KF1,KF2,KF3,PECM,X1,X3)
-
-C...Purpose: to store three partons or particles in their CM frame,
-C...with the first along the +z axis and the third in the (x,z)
-C...plane with x > 0.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Standard checks.
- MSTU(28)=0
- IF(MSTU(12).GE.1) CALL LULIST(0)
- IPA=MAX(1,IABS(IP))
- IF(IPA.GT.MSTU(4)-2) CALL LUERRM(21,
- &'(LU3ENT:) writing outside LUJETS memory')
- KC1=LUCOMP(KF1)
- KC2=LUCOMP(KF2)
- KC3=LUCOMP(KF3)
- IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL LUERRM(12,
- &'(LU3ENT:) unknown flavour code')
-
-C...Find masses. Reset K, P and V vectors.
- PM1=0.
- IF(MSTU(10).EQ.1) PM1=P(IPA,5)
- IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
- PM2=0.
- IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
- IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
- PM3=0.
- IF(MSTU(10).EQ.1) PM3=P(IPA+2,5)
- IF(MSTU(10).GE.2) PM3=ULMASS(KF3)
- DO 110 I=IPA,IPA+2
- DO 100 J=1,5
- K(I,J)=0
- P(I,J)=0.
- V(I,J)=0.
- 100 CONTINUE
- 110 CONTINUE
-
-C...Check flavours.
- KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
- KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
- KQ3=KCHG(KC3,2)*ISIGN(1,KF3)
- IF(MSTU(19).EQ.1) THEN
- MSTU(19)=0
- ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0) THEN
- ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.(KQ1+KQ3.EQ.0.OR.
- &KQ1+KQ3.EQ.4)) THEN
- ELSE
- CALL LUERRM(2,'(LU3ENT:) unphysical flavour combination')
- ENDIF
- K(IPA,2)=KF1
- K(IPA+1,2)=KF2
- K(IPA+2,2)=KF3
-
-C...Store partons/particles in K vectors for normal case.
- IF(IP.GE.0) THEN
- K(IPA,1)=1
- IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0)) K(IPA,1)=2
- K(IPA+1,1)=1
- IF(KQ2.NE.0.AND.KQ3.NE.0) K(IPA+1,1)=2
- K(IPA+2,1)=1
-
-C...Store partons in K vectors for parton shower evolution.
- ELSE
- K(IPA,1)=3
- K(IPA+1,1)=3
- K(IPA+2,1)=3
- KCS=4
- IF(KQ1.EQ.-1) KCS=5
- K(IPA,KCS)=MSTU(5)*(IPA+1)
- K(IPA,9-KCS)=MSTU(5)*(IPA+2)
- K(IPA+1,KCS)=MSTU(5)*(IPA+2)
- K(IPA+1,9-KCS)=MSTU(5)*IPA
- K(IPA+2,KCS)=MSTU(5)*IPA
- K(IPA+2,9-KCS)=MSTU(5)*(IPA+1)
- ENDIF
-
-C...Check kinematics.
- MKERR=0
- IF(0.5*X1*PECM.LE.PM1.OR.0.5*(2.-X1-X3)*PECM.LE.PM2.OR.
- &0.5*X3*PECM.LE.PM3) MKERR=1
- PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2))
- PA2=SQRT(MAX(1E-10,(0.5*(2.-X1-X3)*PECM)**2-PM2**2))
- PA3=SQRT(MAX(1E-10,(0.5*X3*PECM)**2-PM3**2))
- CTHE2=(PA3**2-PA1**2-PA2**2)/(2.*PA1*PA2)
- CTHE3=(PA2**2-PA1**2-PA3**2)/(2.*PA1*PA3)
- IF(ABS(CTHE2).GE.1.001.OR.ABS(CTHE3).GE.1.001) MKERR=1
- CTHE3=MAX(-1.,MIN(1.,CTHE3))
- IF(MKERR.NE.0) CALL LUERRM(13,
- &'(LU3ENT:) unphysical kinematical variable setup')
-
-C...Store partons/particles in P vectors.
- P(IPA,3)=PA1
- P(IPA,4)=SQRT(PA1**2+PM1**2)
- P(IPA,5)=PM1
- P(IPA+2,1)=PA3*SQRT(1.-CTHE3**2)
- P(IPA+2,3)=PA3*CTHE3
- P(IPA+2,4)=SQRT(PA3**2+PM3**2)
- P(IPA+2,5)=PM3
- P(IPA+1,1)=-P(IPA+2,1)
- P(IPA+1,3)=-P(IPA,3)-P(IPA+2,3)
- P(IPA+1,4)=SQRT(P(IPA+1,1)**2+P(IPA+1,3)**2+PM2**2)
- P(IPA+1,5)=PM2
-
-C...Set N. Optionally fragment/decay.
- N=IPA+2
- IF(IP.EQ.0) CALL LUEXEC
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LU4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14)
-
-C...Purpose: to store four partons or particles in their CM frame, with
-C...the first along the +z axis, the last in the xz plane with x > 0
-C...and the second having y < 0 and y > 0 with equal probability.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Standard checks.
- MSTU(28)=0
- IF(MSTU(12).GE.1) CALL LULIST(0)
- IPA=MAX(1,IABS(IP))
- IF(IPA.GT.MSTU(4)-3) CALL LUERRM(21,
- &'(LU4ENT:) writing outside LUJETS momory')
- KC1=LUCOMP(KF1)
- KC2=LUCOMP(KF2)
- KC3=LUCOMP(KF3)
- KC4=LUCOMP(KF4)
- IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL LUERRM(12,
- &'(LU4ENT:) unknown flavour code')
-
-C...Find masses. Reset K, P and V vectors.
- PM1=0.
- IF(MSTU(10).EQ.1) PM1=P(IPA,5)
- IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
- PM2=0.
- IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
- IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
- PM3=0.
- IF(MSTU(10).EQ.1) PM3=P(IPA+2,5)
- IF(MSTU(10).GE.2) PM3=ULMASS(KF3)
- PM4=0.
- IF(MSTU(10).EQ.1) PM4=P(IPA+3,5)
- IF(MSTU(10).GE.2) PM4=ULMASS(KF4)
- DO 110 I=IPA,IPA+3
- DO 100 J=1,5
- K(I,J)=0
- P(I,J)=0.
- V(I,J)=0.
- 100 CONTINUE
- 110 CONTINUE
-
-C...Check flavours.
- KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
- KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
- KQ3=KCHG(KC3,2)*ISIGN(1,KF3)
- KQ4=KCHG(KC4,2)*ISIGN(1,KF4)
- IF(MSTU(19).EQ.1) THEN
- MSTU(19)=0
- ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0.AND.KQ4.EQ.0) THEN
- ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.KQ3.EQ.2.AND.(KQ1+KQ4.EQ.0.OR.
- &KQ1+KQ4.EQ.4)) THEN
- ELSEIF(KQ1.NE.0.AND.KQ1+KQ2.EQ.0.AND.KQ3.NE.0.AND.KQ3+KQ4.EQ.0.)
- &THEN
- ELSE
- CALL LUERRM(2,'(LU4ENT:) unphysical flavour combination')
- ENDIF
- K(IPA,2)=KF1
- K(IPA+1,2)=KF2
- K(IPA+2,2)=KF3
- K(IPA+3,2)=KF4
-
-C...Store partons/particles in K vectors for normal case.
- IF(IP.GE.0) THEN
- K(IPA,1)=1
- IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0.OR.KQ4.NE.0)) K(IPA,1)=2
- K(IPA+1,1)=1
- IF(KQ2.NE.0.AND.KQ1+KQ2.NE.0.AND.(KQ3.NE.0.OR.KQ4.NE.0))
- & K(IPA+1,1)=2
- K(IPA+2,1)=1
- IF(KQ3.NE.0.AND.KQ4.NE.0) K(IPA+2,1)=2
- K(IPA+3,1)=1
-
-C...Store partons for parton shower evolution from q-g-g-qbar or
-C...g-g-g-g event.
- ELSEIF(KQ1+KQ2.NE.0) THEN
- K(IPA,1)=3
- K(IPA+1,1)=3
- K(IPA+2,1)=3
- K(IPA+3,1)=3
- KCS=4
- IF(KQ1.EQ.-1) KCS=5
- K(IPA,KCS)=MSTU(5)*(IPA+1)
- K(IPA,9-KCS)=MSTU(5)*(IPA+3)
- K(IPA+1,KCS)=MSTU(5)*(IPA+2)
- K(IPA+1,9-KCS)=MSTU(5)*IPA
- K(IPA+2,KCS)=MSTU(5)*(IPA+3)
- K(IPA+2,9-KCS)=MSTU(5)*(IPA+1)
- K(IPA+3,KCS)=MSTU(5)*IPA
- K(IPA+3,9-KCS)=MSTU(5)*(IPA+2)
-
-C...Store partons for parton shower evolution from q-qbar-q-qbar event.
- ELSE
- K(IPA,1)=3
- K(IPA+1,1)=3
- K(IPA+2,1)=3
- K(IPA+3,1)=3
- K(IPA,4)=MSTU(5)*(IPA+1)
- K(IPA,5)=K(IPA,4)
- K(IPA+1,4)=MSTU(5)*IPA
- K(IPA+1,5)=K(IPA+1,4)
- K(IPA+2,4)=MSTU(5)*(IPA+3)
- K(IPA+2,5)=K(IPA+2,4)
- K(IPA+3,4)=MSTU(5)*(IPA+2)
- K(IPA+3,5)=K(IPA+3,4)
- ENDIF
-
-C...Check kinematics.
- MKERR=0
- IF(0.5*X1*PECM.LE.PM1.OR.0.5*X2*PECM.LE.PM2.OR.0.5*(2.-X1-X2-X4)*
- &PECM.LE.PM3.OR.0.5*X4*PECM.LE.PM4) MKERR=1
- PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2))
- PA2=SQRT(MAX(1E-10,(0.5*X2*PECM)**2-PM2**2))
- PA4=SQRT(MAX(1E-10,(0.5*X4*PECM)**2-PM4**2))
- X24=X1+X2+X4-1.-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2
- CTHE4=(X1*X4-2.*X14)*PECM**2/(4.*PA1*PA4)
- IF(ABS(CTHE4).GE.1.002) MKERR=1
- CTHE4=MAX(-1.,MIN(1.,CTHE4))
- STHE4=SQRT(1.-CTHE4**2)
- CTHE2=(X1*X2-2.*X12)*PECM**2/(4.*PA1*PA2)
- IF(ABS(CTHE2).GE.1.002) MKERR=1
- CTHE2=MAX(-1.,MIN(1.,CTHE2))
- STHE2=SQRT(1.-CTHE2**2)
- CPHI2=((X2*X4-2.*X24)*PECM**2-4.*PA2*CTHE2*PA4*CTHE4)/
- &MAX(1E-8*PECM**2,4.*PA2*STHE2*PA4*STHE4)
- IF(ABS(CPHI2).GE.1.05) MKERR=1
- CPHI2=MAX(-1.,MIN(1.,CPHI2))
- IF(MKERR.EQ.1) CALL LUERRM(13,
- &'(LU4ENT:) unphysical kinematical variable setup')
-
-C...Store partons/particles in P vectors.
- P(IPA,3)=PA1
- P(IPA,4)=SQRT(PA1**2+PM1**2)
- P(IPA,5)=PM1
- P(IPA+3,1)=PA4*STHE4
- P(IPA+3,3)=PA4*CTHE4
- P(IPA+3,4)=SQRT(PA4**2+PM4**2)
- P(IPA+3,5)=PM4
- P(IPA+1,1)=PA2*STHE2*CPHI2
- P(IPA+1,2)=PA2*STHE2*SQRT(1.-CPHI2**2)*(-1.)**INT(RLU(0)+0.5)
- P(IPA+1,3)=PA2*CTHE2
- P(IPA+1,4)=SQRT(PA2**2+PM2**2)
- P(IPA+1,5)=PM2
- P(IPA+2,1)=-P(IPA+1,1)-P(IPA+3,1)
- P(IPA+2,2)=-P(IPA+1,2)
- P(IPA+2,3)=-P(IPA,3)-P(IPA+1,3)-P(IPA+3,3)
- P(IPA+2,4)=SQRT(P(IPA+2,1)**2+P(IPA+2,2)**2+P(IPA+2,3)**2+PM3**2)
- P(IPA+2,5)=PM3
-
-C...Set N. Optionally fragment/decay.
- N=IPA+3
- IF(IP.EQ.0) CALL LUEXEC
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUBOEI(NSAV)
-
-C...Purpose: to modify event so as to approximately take into account
-C...Bose-Einstein effects according to a simple phenomenological
-C...parametrization.
- IMPLICIT DOUBLE PRECISION(D)
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- SAVE /LUJETS/,/LUDAT1/
- DIMENSION DPS(4),KFBE(9),NBE(0:9),BEI(100)
- DATA KFBE/211,-211,111,321,-321,130,310,221,331/
-
-C...Boost event to overall CM frame. Calculate CM energy.
- IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN
- DO 100 J=1,4
- DPS(J)=0.
- 100 CONTINUE
- DO 120 I=1,N
- KFA=IABS(K(I,2))
- IF(K(I,1).LE.10.AND.((KFA.GT.10.AND.KFA.LE.20).OR.KFA.EQ.22).AND.
- &K(I,3).GT.0) THEN
- KFMA=IABS(K(K(I,3),2))
- IF(KFMA.GT.10.AND.KFMA.LE.80) K(I,1)=-K(I,1)
- ENDIF
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120
- DO 110 J=1,4
- DPS(J)=DPS(J)+P(I,J)
- 110 CONTINUE
- 120 CONTINUE
- CALL LUDBRB(0,0,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4),
- &-DPS(3)/DPS(4))
- PECM=0.
- DO 130 I=1,N
- IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4)
- 130 CONTINUE
-
-C...Reserve copy of particles by species at end of record.
- NBE(0)=N+MSTU(3)
- DO 160 IBE=1,MIN(9,MSTJ(52))
- NBE(IBE)=NBE(IBE-1)
- DO 150 I=NSAV+1,N
- IF(K(I,2).NE.KFBE(IBE)) GOTO 150
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150
- IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN
- CALL LUERRM(11,'(LUBOEI:) no more memory left in LUJETS')
- RETURN
- ENDIF
- NBE(IBE)=NBE(IBE)+1
- K(NBE(IBE),1)=I
- DO 140 J=1,3
- P(NBE(IBE),J)=0.
- 140 CONTINUE
- 150 CONTINUE
- 160 CONTINUE
- IF(NBE(MIN(9,MSTJ(52)))-NBE(0).LE.1) GOTO 280
-
-C...Tabulate integral for subsequent momentum shift.
- DO 220 IBE=1,MIN(9,MSTJ(52))
- IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 180
- IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2))
- &.LE.1) GOTO 180
- IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5),
- &NBE(7)-NBE(6)).LE.1) GOTO 180
- IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 180
- IF(IBE.EQ.1) PMHQ=2.*ULMASS(211)
- IF(IBE.EQ.4) PMHQ=2.*ULMASS(321)
- IF(IBE.EQ.8) PMHQ=2.*ULMASS(221)
- IF(IBE.EQ.9) PMHQ=2.*ULMASS(331)
- QDEL=0.1*MIN(PMHQ,PARJ(93))
- IF(MSTJ(51).EQ.1) THEN
- NBIN=MIN(100,NINT(9.*PARJ(93)/QDEL))
- BEEX=EXP(0.5*QDEL/PARJ(93))
- BERT=EXP(-QDEL/PARJ(93))
- ELSE
- NBIN=MIN(100,NINT(3.*PARJ(93)/QDEL))
- ENDIF
- DO 170 IBIN=1,NBIN
- QBIN=QDEL*(IBIN-0.5)
- BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12.)/SQRT(QBIN**2+PMHQ**2)
- IF(MSTJ(51).EQ.1) THEN
- BEEX=BEEX*BERT
- BEI(IBIN)=BEI(IBIN)*BEEX
- ELSE
- BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2)
- ENDIF
- IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1)
- 170 CONTINUE
-
-C...Loop through particle pairs and find old relative momentum.
- 180 DO 210 I1M=NBE(IBE-1)+1,NBE(IBE)-1
- I1=K(I1M,1)
- DO 200 I2M=I1M+1,NBE(IBE)
- I2=K(I2M,1)
- Q2OLD=MAX(0.,(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+
- &P(I2,2))**2-(P(I1,3)+P(I2,3))**2-(P(I1,5)+P(I2,5))**2)
- QOLD=SQRT(Q2OLD)
-
-C...Calculate new relative momentum.
- IF(QOLD.LT.1E-3*QDEL) THEN
- GOTO 200
- ELSEIF(QOLD.LE.QDEL) THEN
- QMOV=QOLD/3.
- ELSEIF(QOLD.LT.(NBIN-0.1)*QDEL) THEN
- RBIN=QOLD/QDEL
- IBIN=RBIN
- RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1)
- QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))*
- & SQRT(Q2OLD+PMHQ**2)/Q2OLD
- ELSE
- QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD
- ENDIF
- Q2NEW=Q2OLD*(QOLD/(QOLD+3.*PARJ(92)*QMOV))**(2./3.)
-
-C...Calculate and save shift to be performed on three-momenta.
- HC1=(P(I1,4)+P(I2,4))**2-(Q2OLD-Q2NEW)
- HC2=(Q2OLD-Q2NEW)*(P(I1,4)-P(I2,4))**2
- HA=0.5*(1.-SQRT(HC1*Q2NEW/(HC1*Q2OLD-HC2)))
- DO 190 J=1,3
- PD=HA*(P(I2,J)-P(I1,J))
- P(I1M,J)=P(I1M,J)+PD
- P(I2M,J)=P(I2M,J)-PD
- 190 CONTINUE
- 200 CONTINUE
- 210 CONTINUE
- 220 CONTINUE
-
-C...Shift momenta and recalculate energies.
- DO 240 IM=NBE(0)+1,NBE(MIN(9,MSTJ(52)))
- I=K(IM,1)
- DO 230 J=1,3
- P(I,J)=P(I,J)+P(IM,J)
- 230 CONTINUE
- P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
- 240 CONTINUE
-
-C...Rescale all momenta for energy conservation.
- PES=0.
- PQS=0.
- DO 250 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 250
- PES=PES+P(I,4)
- PQS=PQS+P(I,5)**2/P(I,4)
- 250 CONTINUE
- FAC=(PECM-PQS)/(PES-PQS)
- DO 270 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270
- DO 260 J=1,3
- P(I,J)=FAC*P(I,J)
- 260 CONTINUE
- P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
- 270 CONTINUE
-
-C...Boost back to correct reference frame.
- 280 CALL LUDBRB(0,0,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4))
- DO 290 I=1,N
- IF(K(I,1).LT.0) K(I,1)=-K(I,1)
- 290 CONTINUE
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUCELL(NJET)
-
-C...Purpose: to provide a simple way of jet finding in an eta-phi-ET
-C...coordinate frame, as used for calorimeters at hadron colliders.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Loop over all particles. Find cell that was hit by given particle.
- PTLRAT=1./SINH(PARU(51))**2
- NP=0
- NC=N
- DO 110 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110
- IF(P(I,1)**2+P(I,2)**2.LE.PTLRAT*P(I,3)**2) GOTO 110
- IF(MSTU(41).GE.2) THEN
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
- & KC.EQ.18) GOTO 110
- IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
- & GOTO 110
- ENDIF
- NP=NP+1
- PT=SQRT(P(I,1)**2+P(I,2)**2)
- ETA=SIGN(LOG((SQRT(PT**2+P(I,3)**2)+ABS(P(I,3)))/PT),P(I,3))
- IETA=MAX(1,MIN(MSTU(51),1+INT(MSTU(51)*0.5*(ETA/PARU(51)+1.))))
- PHI=ULANGL(P(I,1),P(I,2))
- IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5*(PHI/PARU(1)+1.))))
- IETPH=MSTU(52)*IETA+IPHI
-
-C...Add to cell already hit, or book new cell.
- DO 100 IC=N+1,NC
- IF(IETPH.EQ.K(IC,3)) THEN
- K(IC,4)=K(IC,4)+1
- P(IC,5)=P(IC,5)+PT
- GOTO 110
- ENDIF
- 100 CONTINUE
- IF(NC.GE.MSTU(4)-MSTU(32)-5) THEN
- CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS')
- NJET=-2
- RETURN
- ENDIF
- NC=NC+1
- K(NC,3)=IETPH
- K(NC,4)=1
- K(NC,5)=2
- P(NC,1)=(PARU(51)/MSTU(51))*(2*IETA-1-MSTU(51))
- P(NC,2)=(PARU(1)/MSTU(52))*(2*IPHI-1-MSTU(52))
- P(NC,5)=PT
- 110 CONTINUE
-
-C...Smear true bin content by calorimeter resolution.
- IF(MSTU(53).GE.1) THEN
- DO 130 IC=N+1,NC
- PEI=P(IC,5)
- IF(MSTU(53).EQ.2) PEI=P(IC,5)*COSH(P(IC,1))
- 120 PEF=PEI+PARU(55)*SQRT(-2.*LOG(MAX(1E-10,RLU(0)))*PEI)*
- & COS(PARU(2)*RLU(0))
- IF(PEF.LT.0..OR.PEF.GT.PARU(56)*PEI) GOTO 120
- P(IC,5)=PEF
- IF(MSTU(53).EQ.2) P(IC,5)=PEF/COSH(P(IC,1))
- 130 CONTINUE
- ENDIF
-
-C...Remove cells below threshold.
- IF(PARU(58).GT.0.) THEN
- NCC=NC
- NC=N
- DO 140 IC=N+1,NCC
- IF(P(IC,5).GT.PARU(58)) THEN
- NC=NC+1
- K(NC,3)=K(IC,3)
- K(NC,4)=K(IC,4)
- K(NC,5)=K(IC,5)
- P(NC,1)=P(IC,1)
- P(NC,2)=P(IC,2)
- P(NC,5)=P(IC,5)
- ENDIF
- 140 CONTINUE
- ENDIF
-
-C...Find initiator cell: the one with highest pT of not yet used ones.
- NJ=NC
- 150 ETMAX=0.
- DO 160 IC=N+1,NC
- IF(K(IC,5).NE.2) GOTO 160
- IF(P(IC,5).LE.ETMAX) GOTO 160
- ICMAX=IC
- ETA=P(IC,1)
- PHI=P(IC,2)
- ETMAX=P(IC,5)
- 160 CONTINUE
- IF(ETMAX.LT.PARU(52)) GOTO 220
- IF(NJ.GE.MSTU(4)-MSTU(32)-5) THEN
- CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS')
- NJET=-2
- RETURN
- ENDIF
- K(ICMAX,5)=1
- NJ=NJ+1
- K(NJ,4)=0
- K(NJ,5)=1
- P(NJ,1)=ETA
- P(NJ,2)=PHI
- P(NJ,3)=0.
- P(NJ,4)=0.
- P(NJ,5)=0.
-
-C...Sum up unused cells within required distance of initiator.
- DO 170 IC=N+1,NC
- IF(K(IC,5).EQ.0) GOTO 170
- IF(ABS(P(IC,1)-ETA).GT.PARU(54)) GOTO 170
- DPHIA=ABS(P(IC,2)-PHI)
- IF(DPHIA.GT.PARU(54).AND.DPHIA.LT.PARU(2)-PARU(54)) GOTO 170
- PHIC=P(IC,2)
- IF(DPHIA.GT.PARU(1)) PHIC=PHIC+SIGN(PARU(2),PHI)
- IF((P(IC,1)-ETA)**2+(PHIC-PHI)**2.GT.PARU(54)**2) GOTO 170
- K(IC,5)=-K(IC,5)
- K(NJ,4)=K(NJ,4)+K(IC,4)
- P(NJ,3)=P(NJ,3)+P(IC,5)*P(IC,1)
- P(NJ,4)=P(NJ,4)+P(IC,5)*PHIC
- P(NJ,5)=P(NJ,5)+P(IC,5)
- 170 CONTINUE
-
-C...Reject cluster below minimum ET, else accept.
- IF(P(NJ,5).LT.PARU(53)) THEN
- NJ=NJ-1
- DO 180 IC=N+1,NC
- IF(K(IC,5).LT.0) K(IC,5)=-K(IC,5)
- 180 CONTINUE
- ELSEIF(MSTU(54).LE.2) THEN
- P(NJ,3)=P(NJ,3)/P(NJ,5)
- P(NJ,4)=P(NJ,4)/P(NJ,5)
- IF(ABS(P(NJ,4)).GT.PARU(1)) P(NJ,4)=P(NJ,4)-SIGN(PARU(2),
- & P(NJ,4))
- DO 190 IC=N+1,NC
- IF(K(IC,5).LT.0) K(IC,5)=0
- 190 CONTINUE
- ELSE
- DO 200 J=1,4
- P(NJ,J)=0.
- 200 CONTINUE
- DO 210 IC=N+1,NC
- IF(K(IC,5).GE.0) GOTO 210
- P(NJ,1)=P(NJ,1)+P(IC,5)*COS(P(IC,2))
- P(NJ,2)=P(NJ,2)+P(IC,5)*SIN(P(IC,2))
- P(NJ,3)=P(NJ,3)+P(IC,5)*SINH(P(IC,1))
- P(NJ,4)=P(NJ,4)+P(IC,5)*COSH(P(IC,1))
- K(IC,5)=0
- 210 CONTINUE
- ENDIF
- GOTO 150
-
-C...Arrange clusters in falling ET sequence.
- 220 DO 250 I=1,NJ-NC
- ETMAX=0.
- DO 230 IJ=NC+1,NJ
- IF(K(IJ,5).EQ.0) GOTO 230
- IF(P(IJ,5).LT.ETMAX) GOTO 230
- IJMAX=IJ
- ETMAX=P(IJ,5)
- 230 CONTINUE
- K(IJMAX,5)=0
- K(N+I,1)=31
- K(N+I,2)=98
- K(N+I,3)=I
- K(N+I,4)=K(IJMAX,4)
- K(N+I,5)=0
- DO 240 J=1,5
- P(N+I,J)=P(IJMAX,J)
- V(N+I,J)=0.
- 240 CONTINUE
- 250 CONTINUE
- NJET=NJ-NC
-
-C...Convert to massless or massive four-vectors.
- IF(MSTU(54).EQ.2) THEN
- DO 260 I=N+1,N+NJET
- ETA=P(I,3)
- P(I,1)=P(I,5)*COS(P(I,4))
- P(I,2)=P(I,5)*SIN(P(I,4))
- P(I,3)=P(I,5)*SINH(ETA)
- P(I,4)=P(I,5)*COSH(ETA)
- P(I,5)=0.
- 260 CONTINUE
- ELSEIF(MSTU(54).GE.3) THEN
- DO 270 I=N+1,N+NJET
- P(I,5)=SQRT(MAX(0.,P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2))
- 270 CONTINUE
- ENDIF
-
-C...Information about storage.
- MSTU(61)=N+1
- MSTU(62)=NP
- MSTU(63)=NC-N
- IF(MSTU(43).LE.1) MSTU(3)=NJET
- IF(MSTU(43).GE.2) N=N+NJET
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- FUNCTION LUCHGE(KF)
-
-C...Purpose: to give three times the charge for a particle/parton.
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUDAT2/
-
-C...Initial values. Simple case of direct readout.
- LUCHGE=0
- KFA=IABS(KF)
- KC=LUCOMP(KFA)
- IF(KC.EQ.0) THEN
- ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN
- LUCHGE=KCHG(KC,1)
-
-C...Construction from quark content for heavy meson, diquark, baryon.
- ELSEIF(MOD(KFA/1000,10).EQ.0) THEN
- LUCHGE=(KCHG(MOD(KFA/100,10),1)-KCHG(MOD(KFA/10,10),1))*
- & (-1)**MOD(KFA/100,10)
- ELSEIF(MOD(KFA/10,10).EQ.0) THEN
- LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)
- ELSE
- LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)+
- & KCHG(MOD(KFA/10,10),1)
- ENDIF
-
-C...Add on correct sign.
- LUCHGE=LUCHGE*ISIGN(1,KF)
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUCLUS(NJET)
-
-C...Purpose: to subdivide the particle content of an event into
-C...jets/clusters.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
- DIMENSION PS(5)
- SAVE NSAV,NP,PS,PSS,RINIT,NPRE,NREM
-
-C...Functions: distance measure in pT or (pseudo)mass.
- R2T(I1,I2)=(P(I1,5)*P(I2,5)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-
- &P(I1,3)*P(I2,3))*2.*P(I1,5)*P(I2,5)/(0.0001+P(I1,5)+P(I2,5))**2
- R2M(I1,I2)=2.*P(I1,4)*P(I2,4)*(1.-(P(I1,1)*P(I2,1)+P(I1,2)*
- &P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5)))
-
-C...If first time, reset. If reentering, skip preliminaries.
- IF(MSTU(48).LE.0) THEN
- NP=0
- DO 100 J=1,5
- PS(J)=0.
- 100 CONTINUE
- PSS=0.
- ELSE
- NJET=NSAV
- IF(MSTU(43).GE.2) N=N-NJET
- DO 110 I=N+1,N+NJET
- P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
- 110 CONTINUE
- IF(MSTU(46).LE.3) R2ACC=PARU(44)**2
- IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2
- NLOOP=0
- GOTO 300
- ENDIF
-
-C...Find which particles are to be considered in cluster search.
- DO 140 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140
- IF(MSTU(41).GE.2) THEN
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
- & KC.EQ.18) GOTO 140
- IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
- & GOTO 140
- ENDIF
- IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN
- CALL LUERRM(11,'(LUCLUS:) no more memory left in LUJETS')
- NJET=-1
- RETURN
- ENDIF
-
-C...Take copy of these particles, with space left for jets later on.
- NP=NP+1
- K(N+NP,3)=I
- DO 120 J=1,5
- P(N+NP,J)=P(I,J)
- 120 CONTINUE
- IF(MSTU(42).EQ.0) P(N+NP,5)=0.
- IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1)
- P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
- P(N+NP,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
- DO 130 J=1,4
- PS(J)=PS(J)+P(N+NP,J)
- 130 CONTINUE
- PSS=PSS+P(N+NP,5)
- 140 CONTINUE
- DO 160 I=N+1,N+NP
- K(I+NP,3)=K(I,3)
- DO 150 J=1,5
- P(I+NP,J)=P(I,J)
- 150 CONTINUE
- 160 CONTINUE
- PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))
-
-C...Very low multiplicities not considered.
- IF(NP.LT.MSTU(47)) THEN
- CALL LUERRM(8,'(LUCLUS:) too few particles for analysis')
- NJET=-1
- RETURN
- ENDIF
-
-C...Find precluster configuration. If too few jets, make harder cuts.
- NLOOP=0
- IF(MSTU(46).LE.3) R2ACC=PARU(44)**2
- IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2
- RINIT=1.25*PARU(43)
- IF(NP.LE.MSTU(47)+2) RINIT=0.
- 170 RINIT=0.8*RINIT
- NPRE=0
- NREM=NP
- DO 180 I=N+NP+1,N+2*NP
- K(I,4)=0
- 180 CONTINUE
-
-C...Sum up small momentum region. Jet if enough absolute momentum.
- IF(MSTU(46).LE.2) THEN
- DO 190 J=1,4
- P(N+1,J)=0.
- 190 CONTINUE
- DO 210 I=N+NP+1,N+2*NP
- IF(P(I,5).GT.2.*RINIT) GOTO 210
- NREM=NREM-1
- K(I,4)=1
- DO 200 J=1,4
- P(N+1,J)=P(N+1,J)+P(I,J)
- 200 CONTINUE
- 210 CONTINUE
- P(N+1,5)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2)
- IF(P(N+1,5).GT.2.*RINIT) NPRE=1
- IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170
- IF(NREM.EQ.0) GOTO 170
- ENDIF
-
-C...Find fastest remaining particle.
- 220 NPRE=NPRE+1
- PMAX=0.
- DO 230 I=N+NP+1,N+2*NP
- IF(K(I,4).NE.0.OR.P(I,5).LE.PMAX) GOTO 230
- IMAX=I
- PMAX=P(I,5)
- 230 CONTINUE
- DO 240 J=1,5
- P(N+NPRE,J)=P(IMAX,J)
- 240 CONTINUE
- NREM=NREM-1
- K(IMAX,4)=NPRE
-
-C...Sum up precluster around it according to pT separation.
- IF(MSTU(46).LE.2) THEN
- DO 260 I=N+NP+1,N+2*NP
- IF(K(I,4).NE.0) GOTO 260
- R2=R2T(I,IMAX)
- IF(R2.GT.RINIT**2) GOTO 260
- NREM=NREM-1
- K(I,4)=NPRE
- DO 250 J=1,4
- P(N+NPRE,J)=P(N+NPRE,J)+P(I,J)
- 250 CONTINUE
- 260 CONTINUE
- P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2)
-
-C...Sum up precluster around it according to mass separation.
- ELSE
- 270 IMIN=0
- R2MIN=RINIT**2
- DO 280 I=N+NP+1,N+2*NP
- IF(K(I,4).NE.0) GOTO 280
- R2=R2M(I,N+NPRE)
- IF(R2.GE.R2MIN) GOTO 280
- IMIN=I
- R2MIN=R2
- 280 CONTINUE
- IF(IMIN.NE.0) THEN
- DO 290 J=1,4
- P(N+NPRE,J)=P(N+NPRE,J)+P(IMIN,J)
- 290 CONTINUE
- P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2)
- NREM=NREM-1
- K(IMIN,4)=NPRE
- GOTO 270
- ENDIF
- ENDIF
-
-C...Check if more preclusters to be found. Start over if too few.
- IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170
- IF(NREM.GT.0) GOTO 220
- NJET=NPRE
-
-C...Reassign all particles to nearest jet. Sum up new jet momenta.
- 300 TSAV=0.
- PSJT=0.
- 310 IF(MSTU(46).LE.1) THEN
- DO 330 I=N+1,N+NJET
- DO 320 J=1,4
- V(I,J)=0.
- 320 CONTINUE
- 330 CONTINUE
- DO 360 I=N+NP+1,N+2*NP
- R2MIN=PSS**2
- DO 340 IJET=N+1,N+NJET
- IF(P(IJET,5).LT.RINIT) GOTO 340
- R2=R2T(I,IJET)
- IF(R2.GE.R2MIN) GOTO 340
- IMIN=IJET
- R2MIN=R2
- 340 CONTINUE
- K(I,4)=IMIN-N
- DO 350 J=1,4
- V(IMIN,J)=V(IMIN,J)+P(I,J)
- 350 CONTINUE
- 360 CONTINUE
- PSJT=0.
- DO 380 I=N+1,N+NJET
- DO 370 J=1,4
- P(I,J)=V(I,J)
- 370 CONTINUE
- P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
- PSJT=PSJT+P(I,5)
- 380 CONTINUE
- ENDIF
-
-C...Find two closest jets.
- R2MIN=2.*MAX(R2ACC,PS(5)**2)
- DO 400 ITRY1=N+1,N+NJET-1
- DO 390 ITRY2=ITRY1+1,N+NJET
- IF(MSTU(46).LE.2) R2=R2T(ITRY1,ITRY2)
- IF(MSTU(46).GE.3) R2=R2M(ITRY1,ITRY2)
- IF(R2.GE.R2MIN) GOTO 390
- IMIN1=ITRY1
- IMIN2=ITRY2
- R2MIN=R2
- 390 CONTINUE
- 400 CONTINUE
-
-C...If allowed, join two closest jets and start over.
- IF(NJET.GT.MSTU(47).AND.R2MIN.LT.R2ACC) THEN
- IREC=MIN(IMIN1,IMIN2)
- IDEL=MAX(IMIN1,IMIN2)
- DO 410 J=1,4
- P(IREC,J)=P(IMIN1,J)+P(IMIN2,J)
- 410 CONTINUE
- P(IREC,5)=SQRT(P(IREC,1)**2+P(IREC,2)**2+P(IREC,3)**2)
- DO 430 I=IDEL+1,N+NJET
- DO 420 J=1,5
- P(I-1,J)=P(I,J)
- 420 CONTINUE
- 430 CONTINUE
- IF(MSTU(46).GE.2) THEN
- DO 440 I=N+NP+1,N+2*NP
- IORI=N+K(I,4)
- IF(IORI.EQ.IDEL) K(I,4)=IREC-N
- IF(IORI.GT.IDEL) K(I,4)=K(I,4)-1
- 440 CONTINUE
- ENDIF
- NJET=NJET-1
- GOTO 300
-
-C...Divide up broad jet if empty cluster in list of final ones.
- ELSEIF(NJET.EQ.MSTU(47).AND.MSTU(46).LE.1.AND.NLOOP.LE.2) THEN
- DO 450 I=N+1,N+NJET
- K(I,5)=0
- 450 CONTINUE
- DO 460 I=N+NP+1,N+2*NP
- K(N+K(I,4),5)=K(N+K(I,4),5)+1
- 460 CONTINUE
- IEMP=0
- DO 470 I=N+1,N+NJET
- IF(K(I,5).EQ.0) IEMP=I
- 470 CONTINUE
- IF(IEMP.NE.0) THEN
- NLOOP=NLOOP+1
- ISPL=0
- R2MAX=0.
- DO 480 I=N+NP+1,N+2*NP
- IF(K(N+K(I,4),5).LE.1.OR.P(I,5).LT.RINIT) GOTO 480
- IJET=N+K(I,4)
- R2=R2T(I,IJET)
- IF(R2.LE.R2MAX) GOTO 480
- ISPL=I
- R2MAX=R2
- 480 CONTINUE
- IF(ISPL.NE.0) THEN
- IJET=N+K(ISPL,4)
- DO 490 J=1,4
- P(IEMP,J)=P(ISPL,J)
- P(IJET,J)=P(IJET,J)-P(ISPL,J)
- 490 CONTINUE
- P(IEMP,5)=P(ISPL,5)
- P(IJET,5)=SQRT(P(IJET,1)**2+P(IJET,2)**2+P(IJET,3)**2)
- IF(NLOOP.LE.2) GOTO 300
- ENDIF
- ENDIF
- ENDIF
-
-C...If generalized thrust has not yet converged, continue iteration.
- IF(MSTU(46).LE.1.AND.NLOOP.LE.2.AND.PSJT/PSS.GT.TSAV+PARU(48))
- &THEN
- TSAV=PSJT/PSS
- GOTO 310
- ENDIF
-
-C...Reorder jets according to energy.
- DO 510 I=N+1,N+NJET
- DO 500 J=1,5
- V(I,J)=P(I,J)
- 500 CONTINUE
- 510 CONTINUE
- DO 540 INEW=N+1,N+NJET
- PEMAX=0.
- DO 520 ITRY=N+1,N+NJET
- IF(V(ITRY,4).LE.PEMAX) GOTO 520
- IMAX=ITRY
- PEMAX=V(ITRY,4)
- 520 CONTINUE
- K(INEW,1)=31
- K(INEW,2)=97
- K(INEW,3)=INEW-N
- K(INEW,4)=0
- DO 530 J=1,5
- P(INEW,J)=V(IMAX,J)
- 530 CONTINUE
- V(IMAX,4)=-1.
- K(IMAX,5)=INEW
- 540 CONTINUE
-
-C...Clean up particle-jet assignments and jet information.
- DO 550 I=N+NP+1,N+2*NP
- IORI=K(N+K(I,4),5)
- K(I,4)=IORI-N
- IF(K(K(I,3),1).NE.3) K(K(I,3),4)=IORI-N
- K(IORI,4)=K(IORI,4)+1
- 550 CONTINUE
- IEMP=0
- PSJT=0.
- DO 570 I=N+1,N+NJET
- K(I,5)=0
- PSJT=PSJT+P(I,5)
- P(I,5)=SQRT(MAX(P(I,4)**2-P(I,5)**2,0.))
- DO 560 J=1,5
- V(I,J)=0.
- 560 CONTINUE
- IF(K(I,4).EQ.0) IEMP=I
- 570 CONTINUE
-
-C...Select storing option. Output variables. Check for failure.
- MSTU(61)=N+1
- MSTU(62)=NP
- MSTU(63)=NPRE
- PARU(61)=PS(5)
- PARU(62)=PSJT/PSS
- PARU(63)=SQRT(R2MIN)
- IF(NJET.LE.1) PARU(63)=0.
- IF(IEMP.NE.0) THEN
- CALL LUERRM(8,'(LUCLUS:) failed to reconstruct as requested')
- NJET=-1
- ENDIF
- IF(MSTU(43).LE.1) MSTU(3)=NJET
- IF(MSTU(43).GE.2) N=N+NJET
- NSAV=NJET
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- FUNCTION LUCOMP(KF)
-
-C...Purpose: to compress the standard KF codes for use in mass and decay
-C...arrays; also to check whether a given code actually is defined.
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUDAT2/
- DIMENSION KFTAB(25),KCTAB(25)
- DATA KFTAB/211,111,221,311,321,130,310,213,113,223,
- &313,323,2112,2212,210,2110,2210,110,220,330,440,30443,30553,0,0/
- DATA KCTAB/101,111,112,102,103,221,222,121,131,132,
- &122,123,332,333,281,282,283,284,285,286,287,231,235,0,0/
-
-C...Starting values.
- LUCOMP=0
- KFA=IABS(KF)
-
-C...Simple cases: direct translation or table.
- IF(KFA.EQ.0.OR.KFA.GE.100000) THEN
- RETURN
- ELSEIF(KFA.LE.100) THEN
- LUCOMP=KFA
- IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) LUCOMP=0
- RETURN
- ELSE
- DO 100 IKF=1,23
- IF(KFA.EQ.KFTAB(IKF)) THEN
- LUCOMP=KCTAB(IKF)
- IF(KF.LT.0.AND.KCHG(LUCOMP,3).EQ.0) LUCOMP=0
- RETURN
- ENDIF
- 100 CONTINUE
- ENDIF
-
-C...Subdivide KF code into constituent pieces.
- KFLA=MOD(KFA/1000,10)
- KFLB=MOD(KFA/100,10)
- KFLC=MOD(KFA/10,10)
- KFLS=MOD(KFA,10)
- KFLR=MOD(KFA/10000,10)
-
-C...Mesons.
- IF(KFA-10000*KFLR.LT.1000) THEN
- IF(KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.0.OR.KFLC.EQ.9) THEN
- ELSEIF(KFLB.LT.KFLC) THEN
- ELSEIF(KF.LT.0.AND.KFLB.EQ.KFLC) THEN
- ELSEIF(KFLB.EQ.KFLC) THEN
- IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
- LUCOMP=110+KFLB
- ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
- LUCOMP=130+KFLB
- ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
- LUCOMP=150+KFLB
- ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
- LUCOMP=170+KFLB
- ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN
- LUCOMP=190+KFLB
- ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN
- LUCOMP=210+KFLB
- ENDIF
- ELSEIF(KFLB.LE.5) THEN
- IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
- LUCOMP=100+((KFLB-1)*(KFLB-2))/2+KFLC
- ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
- LUCOMP=120+((KFLB-1)*(KFLB-2))/2+KFLC
- ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
- LUCOMP=140+((KFLB-1)*(KFLB-2))/2+KFLC
- ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
- LUCOMP=160+((KFLB-1)*(KFLB-2))/2+KFLC
- ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN
- LUCOMP=180+((KFLB-1)*(KFLB-2))/2+KFLC
- ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN
- LUCOMP=200+((KFLB-1)*(KFLB-2))/2+KFLC
- ENDIF
- ELSEIF((KFLS.EQ.1.AND.KFLR.LE.1).OR.(KFLS.EQ.3.AND.KFLR.LE.2)
- & .OR.(KFLS.EQ.5.AND.KFLR.EQ.0)) THEN
- LUCOMP=80+KFLB
- ENDIF
-
-C...Diquarks.
- ELSEIF((KFLR.EQ.0.OR.KFLR.EQ.1).AND.KFLC.EQ.0) THEN
- IF(KFLS.NE.1.AND.KFLS.NE.3) THEN
- ELSEIF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9) THEN
- ELSEIF(KFLA.LT.KFLB) THEN
- ELSEIF(KFLS.EQ.1.AND.KFLA.EQ.KFLB) THEN
- ELSE
- LUCOMP=90
- ENDIF
-
-C...Spin 1/2 baryons.
- ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.2) THEN
- IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN
- ELSEIF(KFLA.LE.KFLC.OR.KFLA.LT.KFLB) THEN
- ELSEIF(KFLA.GE.6.OR.KFLB.GE.4.OR.KFLC.GE.4) THEN
- LUCOMP=80+KFLA
- ELSEIF(KFLB.LT.KFLC) THEN
- LUCOMP=300+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLC*(KFLC-1))/2+KFLB
- ELSE
- LUCOMP=330+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC
- ENDIF
-
-C...Spin 3/2 baryons.
- ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.4) THEN
- IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN
- ELSEIF(KFLA.LT.KFLB.OR.KFLB.LT.KFLC) THEN
- ELSEIF(KFLA.GE.6.OR.KFLB.GE.4) THEN
- LUCOMP=80+KFLA
- ELSE
- LUCOMP=360+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC
- ENDIF
- ENDIF
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- BLOCK DATA LUDATA
-
-C...Purpose: to give default values to parameters and particle and
-C...decay data.
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
- COMMON/LUDAT4/CHAF(500)
- CHARACTER CHAF*8
- COMMON/LUDATR/MRLU(6),RRLU(100)
- SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/
-
-C...LUDAT1, containing status codes and most parameters.
- DATA MSTU/
- & 0, 0, 0, 4000,10000, 500, 2000, 0, 0, 2,
- 1 6, 1, 1, 0, 1, 1, 0, 0, 0, 0,
- 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0,
- 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0,
- 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0,
- 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 7 30*0,
- & 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 1 1, 5, 3, 5, 0, 0, 0, 0, 0, 0,
- 2 60*0,
- 8 7, 408, 1995, 08, 23, 700, 0, 0, 0, 0,
- 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
- DATA PARU/
- & 3.1415927, 6.2831854, 0.1973, 5.068, 0.3894, 2.568, 4*0.,
- 1 0.001, 0.09, 0.01, 0., 0., 0., 0., 0., 0., 0.,
- 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
- 3 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
- 4 2.0, 1.0, 0.25, 2.5, 0.05, 0., 0., 0.0001, 0., 0.,
- 5 2.5, 1.5, 7.0, 1.0, 0.5, 2.0, 3.2, 0., 0., 0.,
- 6 40*0.,
- & 0.00729735, 0.232, 0.007764, 1.0, 1.16639E-5, 0., 0., 0.,
- & 0., 0.,
- 1 0.20, 0.25, 1.0, 4.0, 10., 0., 0., 0., 0., 0.,
- 2 -0.693, -1.0, 0.387, 1.0, -0.08, -1.0, 1.0, 1.0, 1.0, 0.,
- 3 1.0, -1.0, 1.0, -1.0, 1.0, 0., 0., 0., 0., 0.,
- 4 5.0, 1.0, 1.0, 0., 1.0, 1.0, 0., 0., 0., 0.,
- 5 1.0, 0., 0., 0., 1000., 1.0, 1.0, 1.0, 1.0, 0.,
- 6 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., 0., 0.,
- 7 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0.,
- 8 1.0, 1.0, 1.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0.,
- 9 0., 0., 0., 0., 1.0, 0., 0., 0., 0., 0./
- DATA MSTJ/
- & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0,
- 1 4, 2, 0, 1, 0, 0, 0, 0, 0, 0,
- 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0,
- 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 0,
- 5 0, 3, 0, 0, 0, 0, 0, 0, 0, 0,
- 6 40*0,
- & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2,
- 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0,
- 2 80*0/
- DATA PARJ/
- & 0.10, 0.30, 0.40, 0.05, 0.50, 0.50, 0.50, 0., 0., 0.,
- 1 0.50, 0.60, 0.75, 0., 0., 0., 0., 1.0, 1.0, 0.,
- 2 0.36, 1.0, 0.01, 2.0, 1.0, 0.4, 0., 0., 0., 0.,
- 3 0.10, 1.0, 0.8, 1.5, 0., 2.0, 0.2, 2.5, 0.6, 0.,
- 4 0.3, 0.58, 0.5, 0.9, 0.5, 1.0, 1.0, 1.0, 0., 0.,
- 5 0.77,0.77,0.77,-0.05,-0.005,-0.00001,-0.00001,-0.00001,1.0,0.,
- 6 4.5, 0.7, 0., 0.003, 0.5, 0.5, 0., 0., 0., 0.,
- 7 10., 1000., 100., 1000., 0., 0.7, 10., 0., 0., 0.,
- 8 0.29, 1.0, 1.0, 0., 10., 10., 0., 0., 0., 0.,
- 9 0.02, 1.0, 0.2, 0., 0., 0., 0., 0., 0., 0.,
- & 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
- 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
- 2 1.0, 0.25,91.187,2.489, 0.01, 2.0, 1.0, 0.25,0.002, 0.,
- 3 0., 0., 0., 0., 0.01, 0.99, 0., 0., 0.2, 0.,
- 4 60*0./
-
-C...LUDAT2, with particle data and flavour treatment parameters.
- DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0,
- &-3,0,-3,6*0,3,9*0,3,2*0,3,0,-1,44*0,2,-1,2,-1,2,3,11*0,3,0,2*3,0,
- &3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,
- &3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,
- &3,0,3,70*0,3,0,3,28*0,3,2*0,3,8*0,-3,8*0,3,0,-3,0,3,-3,3*0,3,6,0,
- &3,5*0,-3,0,3,-3,0,-3,4*0,-3,0,3,6,-3,0,3,-3,0,-3,0,3,6,0,3,5*0,
- &-3,0,3,-3,0,-3,114*0/
- DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,16*0,2,1,50*0,-1,410*0/
- DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,0,2*1,
- &41*0,1,0,7*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1,
- &10*0,10*1,70*0,3*1,22*0,1,5*0,1,0,2*1,6*0,1,0,2*1,6*0,2*1,0,5*1,
- &0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/
- DATA (PMAS(I,1),I= 1, 500)/0.0099,0.0056,0.199,1.35,5.,160.,
- &2*250.,2*0.,0.00051,0.,0.1057,0.,1.777,0.,250.,5*0.,91.187,80.25,
- &80.,6*0.,500.,900.,500.,3*300.,350.,200.,5000.,60*0.,0.1396,
- &0.4977,0.4936,1.8693,1.8645,1.9688,5.2787,5.2786,5.47972,6.594,
- &0.135,0.5475,0.9578,2.9788,9.4,320.,2*500.,2*0.,0.7669,0.8961,
- &0.8916,2.0101,2.0071,2.11,2*5.325,5.5068,6.602,0.7683,0.782,
- &1.0194,3.0969,9.4603,320.,2*500.,2*0.,1.232,2*1.29,2*2.424,2.536,
- &2*5.73,5.97,7.3,1.232,1.17,1.4,3.46,9.875,320.,2*500.,2*0.,0.983,
- &2*1.429,2*2.272,2.5,2*5.68,5.92,7.25,0.9827,1.,1.4,3.4151,9.8598,
- &320.,2*500.,2*0.,1.26,2*1.402,2*2.372,2.56,2*5.78,6.02,7.3,1.26,
- &1.282,1.42,3.5106,9.8919,320.,2*500.,2*0.,1.318,1.432,1.425,
- &2*2.46,2.61,2*5.83,6.07,7.35,1.318,1.275,1.525,3.5562,9.9132,
- &320.,2*500.,2*0.,2*0.4977,8*0.,3.686,3*0.,10.0233,70*0.,1.1156,
- &5*0.,2.2849,0.,2.473,2.466,6*0.,5.641,0.,2*5.84,6*0.,0.9396,
- &0.9383,0.,1.1974,1.1926,1.1894,1.3213,1.3149,0.,2.4525,2.4529,
- &2.4527,2*2.55,2.73,4*0.,3*5.8,2*5.96,6.12,4*0.,1.234,1.233,1.232,
- &1.231,1.3872,1.3837,1.3828,1.535,1.5318,1.6724,3*2.5,2*2.63,2.8,
- &4*0.,3*5.81,2*5.97,6.13,114*0./
- DATA (PMAS(I,2),I= 1, 500)/22*0.,2.489,2.066,88*0.,0.0002,
- &0.001,6*0.,0.149,0.0505,0.0498,7*0.,0.151,0.00843,0.0044,7*0.,
- &0.155,2*0.09,2*0.02,0.,4*0.05,0.155,0.36,0.08,2*0.01,5*0.,0.057,
- &2*0.287,7*0.05,0.057,0.,0.25,0.014,6*0.,0.4,2*0.174,7*0.05,0.4,
- &0.024,0.06,0.0009,6*0.,0.11,0.109,0.098,2*0.019,5*0.02,0.11,
- &0.185,0.076,0.002,146*0.,4*0.12,0.0394,0.036,0.0358,0.0099,
- &0.0091,131*0./
- DATA (PMAS(I,3),I= 1, 500)/22*0.,2*20.,88*0.,0.002,0.005,6*0.,
- &0.4,2*0.2,7*0.,0.4,0.1,0.015,7*0.,0.25,0.005,0.01,2*0.08,0.,
- &4*0.1,0.25,0.2,0.001,2*0.02,5*0.,0.05,2*0.4,6*0.1,2*0.05,0.,0.35,
- &0.05,6*0.,3*0.3,2*0.1,0.03,4*0.1,0.3,0.05,0.02,0.001,6*0.,0.25,
- &4*0.12,5*0.05,0.25,0.17,0.2,0.01,146*0.,4*0.14,0.04,2*0.035,
- &2*0.05,131*0./
- DATA (PMAS(I,4),I= 1, 500)/12*0.,658650.,0.,0.0914,68*0.,0.1,
- &0.387,15*0.,7804.,0.,3709.,0.32,0.1259,0.135,3*0.387,0.15,110*0.,
- &15500.,26.75,83*0.,78.88,5*0.,0.057,0.,0.025,0.09,6*0.,0.387,0.,
- &2*0.387,9*0.,44.3,0.,23.95,49.1,86.9,6*0.,0.13,9*0.,0.387,13*0.,
- &24.60001,130*0./
- DATA PARF/
- & 0.5, 0.25, 0.5, 0.25, 1., 0.5, 0., 0., 0., 0.,
- 1 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
- 2 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
- 3 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
- 4 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
- 5 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
- 6 0.75, 0.5, 0., 0.1667, 0.0833, 0.1667, 0., 0., 0., 0.,
- 7 0., 0., 1., 0.3333, 0.6667, 0.3333, 0., 0., 0., 0.,
- 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
- 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
- & 0.325, 0.325, 0.5, 1.6, 5.0, 0., 0., 0., 0., 0.,
- 1 0., 0.11, 0.16, 0.048, 0.50, 0.45, 0.55, 0.60, 0., 0.,
- 2 0.2, 0.1, 0., 0., 0., 0., 0., 0., 0., 0.,
- 3 1870*0./
- DATA ((VCKM(I,J),J=1,4),I=1,4)/
- 1 0.95113, 0.04884, 0.00003, 0.00000,
- 2 0.04884, 0.94940, 0.00176, 0.00000,
- 3 0.00003, 0.00176, 0.99821, 0.00000,
- 4 0.00000, 0.00000, 0.00000, 1.00000/
-
-C...LUDAT3, with particle decay parameters and data.
- DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0,1,
- &2*0,4*1,42*0,7*1,12*0,1,0,15*1,2*0,18*1,2*0,18*1,2*0,18*1,2*0,
- &18*1,2*0,18*1,3*0,1,8*0,1,3*0,1,70*0,1,5*0,1,0,2*1,6*0,1,0,2*1,
- &9*0,5*1,0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/
- DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,50,60,2*0,70,74,76,
- &81,83,124,126,132,2*0,135,144,156,172,192,6*0,209,0,231,254,274,
- &292,301,304,305,42*0,314,315,319,328,331,336,338,11*0,358,359,
- &361,367,430,491,524,560,596,635,666,668,675,681,682,683,684,685,
- &2*0,686,688,691,694,697,699,700,701,702,703,704,708,713,721,724,
- &733,734,735,2*0,736,737,742,747,749,751,753,755,757,759,761,762,
- &765,769,770,771,772,773,2*0,774,775,777,779,781,783,785,787,789,
- &791,793,794,799,804,806,808,809,810,2*0,811,813,815,817,819,821,
- &823,825,827,829,831,833,846,850,852,854,855,856,2*0,857,863,873,
- &884,892,900,904,912,920,924,928,936,945,951,953,955,956,957,2*0,
- &958,966,8*0,968,3*0,979,70*0,993,5*0,997,0,1073,1074,6*0,1075,0,
- &1092,1093,9*0,1094,1096,1097,1100,1101,0,1103,1104,1105,1106,
- &1107,1108,4*0,1109,1110,1111,1112,1113,1114,4*0,1115,1116,1119,
- &1122,1123,1126,1129,1132,1134,1136,1140,1141,1142,1143,1145,1147,
- &4*0,1148,1149,1150,1151,1152,1153,114*0/
- DATA (MDCY(I,3),I= 1, 500)/5*8,9,2*10,2*0,4,2,5,2,41,2,6,3,2*0,
- &9,12,16,20,17,6*0,22,0,23,20,18,9,3,1,9,42*0,1,4,9,3,5,2,20,11*0,
- &1,2,6,63,61,33,2*36,39,31,2,7,6,5*1,2*0,2,3*3,2,5*1,4,5,8,3,9,
- &3*1,2*0,1,2*5,7*2,1,3,4,5*1,2*0,1,9*2,1,2*5,2*2,3*1,2*0,11*2,13,
- &4,2*2,3*1,2*0,6,10,11,2*8,4,2*8,2*4,8,9,6,2*2,3*1,2*0,8,2,8*0,11,
- &3*0,14,70*0,4,5*0,76,0,2*1,6*0,17,0,2*1,9*0,2,1,3,1,2,0,6*1,4*0,
- &6*1,4*0,1,2*3,1,3*3,2*2,4,3*1,2*2,1,4*0,6*1,114*0/
- DATA (MDME(I,1),I= 1,2000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1,
- &7*1,-1,1,-1,8*1,2*-1,8*1,2*-1,61*1,-1,2*1,-1,6*1,2*-1,7*1,2*-1,
- &3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,-1,6*1,2*-1,
- &3*1,-1,11*1,2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,6*1,
- &2*-1,3*1,-1,5*1,-1,8*1,2*-1,3*1,-1,9*1,-1,3*1,-1,9*1,2*-1,2*1,-1,
- &16*1,-1,2*1,3*-1,1665*1/
- DATA (MDME(I,2),I= 1,2000)/75*102,42,6*102,2*42,2*0,7*41,2*0,
- &24*41,6*102,45,29*102,8*32,8*0,16*32,4*0,8*32,4*0,32,4*0,8*32,
- &14*0,16*32,7*0,8*32,4*0,32,7*0,8*32,4*0,32,5*0,4*32,5*0,3*32,0,
- &6*32,3*0,12,2*42,2*11,9*42,2*45,31,2*45,2*33,31,2*45,20*46,7*0,
- &24*42,41*0,16*42,46*0,10*42,20*0,2*13,14*42,16*0,48,3*13,16*42,
- &16*0,48,3*13,16*42,19*0,48,3*13,2*42,0,2*11,28*42,0,2,4*0,2,8*0,
- &12,32,86,87,88,3,0,2*3,0,2*3,0,2*3,0,3,6*0,3,3*0,1,0,3,2*0,2*3,
- &3*0,1,4*0,12,3*0,4*32,2*4,86,87,88,33*0,12,32,86,87,88,31*0,12,0,
- &32,86,87,88,40*0,12,0,32,86,87,88,95*0,12,0,32,86,87,88,2*0,4*42,
- &6*0,12,11*0,4*32,2*4,9*0,14*42,52*0,10*13,2*84,3*42,8*0,48,3*13,
- &2*42,2*85,14*0,84,5*0,85,886*0/
- DATA (BRAT(I) ,I= 1, 439)/75*0.,1.,6*0.,0.179,0.178,0.116,
- &0.235,0.005,0.056,0.018,0.023,0.011,2*0.004,0.0067,0.014,2*0.002,
- &2*0.001,0.0022,0.054,0.002,0.016,0.005,0.011,0.0101,5*0.006,
- &0.002,2*0.001,5*0.002,6*0.,1.,29*0.,0.15394,0.11936,0.15394,
- &0.11926,0.15254,3*0.,0.03368,0.06664,0.03368,0.06664,0.03368,
- &0.06664,2*0.,0.3214,0.0165,2*0.,0.0165,0.3207,2*0.,0.00001,
- &0.00059,6*0.,3*0.1081,3*0.,0.0003,0.048,0.8705,4*0.,0.0002,
- &0.0603,0.,0.0199,0.0008,3*0.,0.143,0.111,0.143,0.111,0.143,0.085,
- &2*0.,0.03,0.058,0.03,0.058,0.03,0.058,8*0.,0.25,0.01,2*0.,0.01,
- &0.25,4*0.,0.24,5*0.,3*0.08,6*0.,0.01,0.08,0.82,5*0.,0.09,11*0.,
- &0.01,0.08,0.82,5*0.,0.09,9*0.,1.,6*0.,0.01,0.98,0.01,1.,4*0.215,
- &2*0.,2*0.07,0.,1.,2*0.08,0.76,0.08,2*0.105,0.04,0.5,0.08,0.14,
- &0.01,0.015,0.005,1.,3*0.,1.,4*0.,1.,0.25,0.01,2*0.,0.01,0.25,
- &4*0.,0.24,5*0.,3*0.08,0.,1.,2*0.5,0.635,0.212,0.056,0.017,0.048,
- &0.032,0.07,0.065,2*0.005,2*0.011,5*0.001,0.07,0.065,2*0.005,
- &2*0.011,5*0.001,0.026,0.019,0.066,0.041,0.045,0.076,0.0073,
- &2*0.0047,0.026,0.001,0.0006,0.0066,0.005,2*0.003,2*0.0006,
- &2*0.001,0.006,0.005,0.012,0.0057,0.067,0.008,0.0022,0.027,0.004,
- &0.019,0.012,0.002,0.009,0.0218,0.001,0.022,0.087,0.001,0.0019,
- &0.0015,0.0028,0.034,0.027,2*0.002,2*0.004,2*0.002,0.034,0.027/
- DATA (BRAT(I) ,I= 440, 655)/2*0.002,2*0.004,2*0.002,0.0365,
- &0.045,0.073,0.062,3*0.021,0.0061,0.015,0.025,0.0088,0.074,0.0109,
- &0.0041,0.002,0.0035,0.0011,0.001,0.0027,2*0.0016,0.0018,0.011,
- &0.0063,0.0052,0.018,0.016,0.0034,0.0036,0.0009,0.0006,0.015,
- &0.0923,0.018,0.022,0.0077,0.009,0.0075,0.024,0.0085,0.067,0.0511,
- &0.017,0.0004,0.0028,0.01,2*0.02,0.03,2*0.005,2*0.02,0.03,2*0.005,
- &0.015,0.037,0.028,0.079,0.095,0.052,0.0078,4*0.001,0.028,0.033,
- &0.026,0.05,0.01,4*0.005,0.25,0.0952,0.02,0.055,2*0.005,0.008,
- &0.012,0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011,
- &0.0055,0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,0.0004,
- &0.0007,0.0008,0.0014,0.0019,0.0025,0.4291,0.08,0.07,0.02,0.015,
- &0.005,0.02,0.055,2*0.005,0.008,0.012,0.02,0.055,2*0.005,0.008,
- &0.012,0.01,0.03,0.0035,0.011,0.0055,0.0042,0.009,0.018,0.015,
- &0.0185,0.0135,0.025,0.0004,0.0007,0.0008,0.0014,0.0019,0.0025,
- &0.4291,0.08,0.07,0.02,0.015,0.005,0.02,0.055,2*0.005,0.008,0.012,
- &0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011,0.0055,
- &0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,2*0.0002,0.0007,
- &2*0.0004,0.0014,0.001,0.0009,0.0025,0.4291,0.08,0.07,0.02,0.015,
- &0.005,0.047,0.122,0.006,0.012,0.035,0.012,0.035,0.003,0.007,0.15,
- &0.037,0.008,0.002,0.05,0.015,0.003,0.001,0.014,0.042,0.014,0.042/
- DATA (BRAT(I) ,I= 656, 931)/0.24,0.065,0.012,0.003,0.001,0.002,
- &0.001,0.002,0.014,0.003,0.988,0.012,0.389,0.319,0.2367,0.049,
- &0.005,0.001,0.0003,0.441,0.206,0.3,0.03,0.022,0.001,5*1.,0.99955,
- &0.00045,0.665,0.333,0.002,0.666,0.333,0.001,0.65,0.3,0.05,0.56,
- &0.44,5*1.,0.99912,0.00079,0.00005,0.00004,0.888,0.085,0.021,
- &2*0.003,0.49,0.344,3*0.043,0.023,0.013,0.001,0.0627,0.0597,
- &0.8776,3*0.027,0.015,0.045,0.015,0.045,0.77,0.029,4*1.,0.28,0.14,
- &0.313,0.157,0.11,0.28,0.14,0.313,0.157,0.11,0.667,0.333,0.667,
- &0.333,2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.333,0.334,0.333,
- &4*0.25,6*1.,0.667,0.333,0.667,0.333,0.667,0.333,0.667,0.333,
- &2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.52,0.26,0.11,2*0.055,
- &0.62,0.31,0.035,2*0.0175,0.007,0.993,0.02,0.98,3*1.,2*0.5,0.667,
- &0.333,0.667,0.333,0.667,0.333,0.667,0.333,2*0.5,0.667,0.333,
- &0.667,0.333,6*0.5,3*0.12,0.097,0.043,4*0.095,4*0.03,4*0.25,0.273,
- &0.727,0.35,0.65,3*1.,2*0.35,0.144,0.105,0.048,0.003,0.333,0.166,
- &0.168,0.084,0.087,0.043,0.059,2*0.029,0.002,0.332,0.166,0.168,
- &0.084,0.086,0.043,0.059,2*0.029,2*0.002,0.3,0.15,0.16,0.08,0.13,
- &0.06,0.08,0.04,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,2*0.3,
- &2*0.2,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,0.3,0.15,0.16,0.08,
- &0.13,0.06,0.08,0.04,2*0.3,2*0.2,2*0.3,2*0.2,2*0.35,0.144,0.105/
- DATA (BRAT(I) ,I= 932,2000)/0.024,2*0.012,0.003,0.566,0.283,
- &0.069,0.028,0.023,2*0.0115,0.005,0.003,0.356,2*0.178,0.28,
- &2*0.004,0.135,0.865,0.22,0.78,3*1.,0.217,0.124,2*0.193,2*0.135,
- &0.002,0.001,0.686,0.314,2*0.0083,0.1866,0.324,0.184,0.027,0.001,
- &0.093,0.087,0.078,0.0028,3*0.014,0.008,0.024,0.008,0.024,0.425,
- &0.02,0.185,0.088,0.043,0.067,0.066,0.641,0.357,2*0.001,0.018,
- &2*0.005,0.003,0.002,2*0.006,0.018,2*0.005,0.003,0.002,2*0.006,
- &0.0066,0.025,0.016,0.0088,2*0.005,0.0058,0.005,0.0055,4*0.004,
- &2*0.002,2*0.004,0.003,0.002,2*0.003,3*0.002,2*0.001,0.002,
- &2*0.001,2*0.002,0.0013,0.0018,5*0.001,4*0.003,2*0.005,2*0.002,
- &2*0.001,2*0.002,2*0.001,0.2432,0.057,2*0.035,0.15,2*0.075,0.03,
- &2*0.015,2*1.,2*0.105,0.04,0.0077,0.02,0.0235,0.0285,0.0435,
- &0.0011,0.0022,0.0044,0.4291,0.08,0.07,0.02,0.015,0.005,2*1.,
- &0.999,0.001,1.,0.516,0.483,0.001,1.,0.995,0.005,13*1.,0.331,
- &0.663,0.006,0.663,0.331,0.006,1.,0.88,2*0.06,0.88,2*0.06,0.88,
- &2*0.06,0.667,2*0.333,0.667,0.676,0.234,0.085,0.005,3*1.,4*0.5,
- &7*1.,847*0./
- DATA (KFDP(I,1),I= 1, 507)/21,22,23,4*-24,25,21,22,23,4*24,25,
- &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23,
- &4*24,25,37,21,22,23,4*-24,25,2*-37,21,22,23,4*24,25,2*37,22,23,
- &-24,25,23,24,-12,22,23,-24,25,23,24,-12,-14,35*16,22,23,-24,25,
- &23,24,-89,22,23,-24,25,-37,23,24,37,1,2,3,4,5,6,7,8,21,1,2,3,4,5,
- &6,7,8,11,13,15,17,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1,
- &4*-3,4*-5,4*-7,-11,-13,-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,
- &2*22,23,24,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,24,37,2*23,25,
- &35,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,3*24,1,2,3,4,5,6,7,8,11,
- &13,15,17,21,2*22,23,24,23,25,36,1,2,3,4,5,6,7,8,11,13,15,17,21,
- &2*22,23,24,23,-1,-3,-5,-7,-11,-13,-15,-17,24,5,6,21,2,1,2,3,4,5,
- &6,11,13,15,82,-11,-13,2*2,-12,-14,-16,2*-2,2*-4,-2,-4,2*89,37,
- &2*-89,2*5,-37,2*89,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,-13,130,
- &310,-13,3*211,12,14,11*-11,11*-13,-311,-313,-311,-313,-20313,
- &2*-311,-313,-311,-313,2*111,2*221,2*331,2*113,2*223,2*333,-311,
- &-313,2*-321,211,-311,-321,333,-311,-313,-321,211,2*-321,2*-311,
- &-321,211,113,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311,
- &-313,2*-311,-321,-10323,-321,-323,-321,-311,2*-313,211,111,333,
- &3*-321,-311,-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211,
- &-321,3*-311,211,113,321,-15,5*-11,5*-13,221,331,333,221,331,333/
- DATA (KFDP(I,1),I= 508, 924)/10221,211,213,211,213,321,323,321,
- &323,2212,221,331,333,221,2*2,6*12,6*14,2*16,3*-411,3*-413,2*-411,
- &2*-413,2*441,2*443,2*20443,2*2,2*4,2,4,6*12,6*14,2*16,3*-421,
- &3*-423,2*-421,2*-423,2*441,2*443,2*20443,2*2,2*4,2,4,6*12,6*14,
- &2*16,3*-431,3*-433,2*-431,2*-433,3*441,3*443,3*20443,2*2,2*4,2,4,
- &16,2*4,2*12,2*14,2*16,4*2,4*4,2*-11,2*-13,2*-1,2*-3,2*-11,2*-13,
- &2*-1,3*22,111,211,2*22,211,22,211,111,3*22,111,82,21,3*0,2*211,
- &321,3*311,2*321,421,2*411,2*421,431,511,521,531,541,211,111,13,
- &11,211,22,211,2*111,321,130,-213,113,213,211,22,111,11,13,82,11,
- &13,15,1,2,3,4,21,22,3*0,223,321,311,323,313,2*311,321,313,323,
- &321,423,2*413,2*423,413,523,2*513,2*523,2*513,523,223,213,113,
- &-213,313,-313,323,-323,82,21,3*0,221,321,2*311,321,421,2*411,421,
- &411,421,521,2*511,2*521,2*511,521,221,211,111,321,130,310,211,
- &111,321,130,310,443,82,553,21,3*0,113,213,323,2*313,323,423,
- &2*413,2*423,413,523,2*513,2*523,2*513,523,213,-213,10211,10111,
- &-10211,2*221,213,2*113,-213,2*321,2*311,313,-313,323,-323,443,82,
- &553,21,3*0,213,113,221,223,321,211,321,311,323,313,323,313,321,
- &4*311,321,313,323,313,323,311,4*321,421,411,423,413,423,413,421,
- &2*411,421,413,423,413,423,411,2*421,411,423,413,521,511,523,513,
- &523,513,521,2*511,521,513,523,513,523,511,2*521,511,523,513,511/
- DATA (KFDP(I,1),I= 925,2000)/521,513,523,213,-213,221,223,321,
- &130,310,111,211,111,2*211,321,130,310,221,111,321,130,310,221,
- &211,111,443,82,553,21,3*0,111,211,-12,12,-14,14,211,111,211,111,
- &11,13,82,4*443,10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553,
- &10551,20553,555,2212,2*2112,-12,7*-11,7*-13,2*2224,2*2212,2*2214,
- &2*3122,2*3212,2*3214,5*3222,4*3224,2*3322,3324,2*2224,7*2212,
- &5*2214,2*2112,2*2114,2*3122,2*3212,2*3214,2*3222,2*3224,4*2,3,
- &2*2,1,2*2,2*0,-12,-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4,
- &2*0,2112,-12,3122,2212,2112,2212,3*3122,3*4122,4132,4232,0,
- &3*5122,5132,5232,0,2112,2212,2*2112,2212,2112,2*2212,3122,3212,
- &3112,3122,3222,3112,3122,3222,3212,3322,3312,3322,3312,3122,3322,
- &3312,-12,3*4122,2*4132,2*4232,4332,3*5122,5132,5232,5332,847*0/
- DATA (KFDP(I,2),I= 1, 476)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4,
- &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,5,3*7,2,4,6,8,7,
- &4,6,3*8,1,3,5,7,8,5,7,2*11,12,11,12,2*11,2*13,14,13,14,13,11,13,
- &-211,-213,-211,-213,-211,-213,3*-211,-321,-323,-321,-323,3*-321,
- &4*-211,-213,-211,-213,-211,-213,-211,-213,-211,-213,6*-211,2*15,
- &16,15,16,15,18,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21,
- &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8,
- &-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,
- &12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,
- &-24,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,
- &-37,22,25,2*36,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22,
- &25,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25,
- &36,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,25,2,4,
- &6,8,12,14,16,18,25,-5,-6,21,11,-3,-4,-5,-6,-7,-8,-13,-15,-17,-82,
- &12,14,-1,-3,11,13,15,1,4,3,4,1,3,5,3,5,6,4,21,22,4,7,5,2,4,6,8,2,
- &4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,14,2*0,14,111,211,111,-11,-13,
- &11*12,11*14,2*211,2*213,211,20213,2*321,2*323,211,213,211,213,
- &211,213,211,213,211,213,211,213,3*211,213,211,2*321,8*211,2*113,
- &2*211,8*12,8*14,2*211,2*213,2*111,221,2*113,223,333,20213,211,
- &2*321,323,2*311,313,-211,111,113,2*211,321,2*211,311,321,310,211/
- DATA (KFDP(I,2),I= 477, 857)/-211,4*211,321,4*211,113,2*211,-321,
- &16,5*12,5*14,3*211,3*213,211,2*111,2*113,2*-311,2*-313,-2112,
- &3*321,323,2*-1,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,431,
- &433,431,433,311,313,311,313,311,313,-1,-4,-3,-4,-1,-3,6*-11,
- &6*-13,2*-15,211,213,20213,211,213,20213,431,433,431,433,321,323,
- &321,323,321,323,-1,-4,-3,-4,-1,-3,6*-11,6*-13,2*-15,211,213,
- &20213,211,213,20213,431,433,431,433,221,331,333,221,331,333,221,
- &331,333,-1,-4,-3,-4,-1,-3,-15,-3,-1,2*-11,2*-13,2*-15,-1,-4,-3,
- &-4,-3,-4,-1,-4,2*12,2*14,2,3,2,3,2*12,2*14,2,1,22,11,22,111,-211,
- &211,11,-211,13,-211,111,113,223,22,111,-82,21,3*0,111,22,-211,
- &111,22,211,111,22,211,111,22,111,6*22,-211,22,-13,-11,-211,111,
- &-211,2*111,-321,310,211,111,2*-211,221,22,-11,-13,-82,-11,-13,
- &-15,-1,-2,-3,-4,2*21,3*0,211,-213,113,-211,111,223,213,113,211,
- &111,223,211,111,-211,111,321,311,-211,111,211,111,-321,-311,411,
- &421,111,-211,111,211,-311,311,-321,321,-82,21,3*0,211,-211,111,
- &211,111,211,111,-211,111,311,321,-211,111,211,111,-321,-311,411,
- &421,111,-211,111,-321,130,310,-211,111,-321,130,310,22,-82,22,21,
- &3*0,211,111,-211,111,211,111,211,111,-211,111,321,311,-211,111,
- &211,111,-321,-311,411,421,-211,211,-211,111,2*211,111,-211,211,
- &111,211,-321,2*-311,-321,-311,311,-321,321,22,-82,22,21,3*0,111/
- DATA (KFDP(I,2),I= 858,2000)/3*211,-311,22,-211,111,-211,111,
- &-211,211,-213,113,223,221,211,111,211,111,2*211,213,113,223,221,
- &22,211,111,211,111,4*211,-211,111,-211,111,-211,211,-211,211,321,
- &311,321,311,-211,111,-211,111,-211,211,-211,2*211,111,211,111,
- &4*211,-321,-311,-321,-311,411,421,411,421,-211,211,111,211,-321,
- &130,310,22,-211,111,2*-211,-321,130,310,221,111,-321,130,310,221,
- &-211,111,22,-82,22,21,3*0,111,-211,11,-11,13,-13,-211,111,-211,
- &111,-11,-13,-82,211,111,221,111,4*22,-11,-13,-15,-1,-2,-3,-4,
- &2*21,211,111,3*22,-211,111,22,11,7*12,7*14,-321,-323,-311,-313,
- &-311,-313,211,213,211,213,211,213,111,221,331,113,223,111,221,
- &113,223,321,323,321,-211,-213,111,221,331,113,223,333,10221,111,
- &221,331,113,223,211,213,211,213,321,323,321,323,321,323,311,313,
- &311,313,2*-1,-3,-1,2203,3201,3203,2203,2101,2103,2*0,11,13,15,
- &-211,-213,-20213,-431,-433,3*3122,1,4,3,4,1,3,2*0,-211,11,22,111,
- &211,22,-211,111,22,-211,111,211,2*22,0,-211,111,211,2*22,0,
- &2*-211,111,22,111,211,22,211,2*-211,2*111,-211,2*211,111,211,
- &-211,2*111,211,-321,-211,111,11,-211,111,211,111,22,111,2*22,
- &-211,111,211,3*22,847*0/
- DATA (KFDP(I,3),I= 1, 944)/75*0,14,6*0,2*16,2*0,5*111,310,130,
- &2*0,2*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221,
- &2*113,221,113,2*213,-213,195*0,4*3,4*4,1,4,3,2*2,10*81,25*0,-211,
- &3*111,-311,-313,-311,-321,-313,-323,111,221,331,113,223,-311,
- &-313,-311,-321,-313,-323,111,221,331,113,223,22*0,111,113,2*211,
- &-211,-311,211,111,3*211,-211,7*211,-321,-323,-311,-321,-313,-323,
- &-211,-213,-321,-323,-311,-321,-313,-323,-211,-213,22*0,111,113,
- &-311,2*-211,211,-211,310,-211,2*111,211,2*-211,-321,-211,2*211,
- &-211,111,-211,2*211,0,221,331,333,321,311,221,331,333,321,311,
- &20*0,3,0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413,
- &-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,-421,-423,
- &-10423,-10421,-20423,-425,-421,-423,-10423,-10421,-20423,-425,
- &-421,-423,16*0,-4,-1,-4,-3,2*-2,-431,-433,-10433,-10431,-20433,
- &-435,-431,-433,-10433,-10431,-20433,-435,-431,-433,19*0,-4,-1,-4,
- &-3,2*-2,3*0,441,443,441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531,
- &533,531,533,3,2,3,2,511,513,511,513,1,2,0,-11,0,2*111,-211,-11,
- &11,-13,2*221,3*0,111,27*0,111,2*0,22,111,5*0,111,12*0,2*21,103*0,
- &-211,2*111,-211,3*111,-211,111,211,14*0,111,6*0,111,-211,8*0,111,
- &-211,9*0,111,-211,111,-211,4*0,111,-211,111,-211,8*0,111,-211,
- &111,-211,4*0,111,-211,111,-211,11*0,-211,6*0,111,211,4*0,111/
- DATA (KFDP(I,3),I= 945,2000)/13*0,2*111,211,-211,211,-211,7*0,
- &-211,111,13*0,2*21,-211,111,6*0,2212,3122,3212,3214,2112,2114,
- &2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,8*0,
- &3*4122,8*0,4,1,4,3,2*2,3*0,2112,43*0,3322,861*0/
- DATA (KFDP(I,4),I= 1,2000)/88*0,3*111,8*0,-211,0,-211,3*0,111,
- &2*-211,0,111,0,2*111,113,221,111,-213,-211,211,195*0,13*81,41*0,
- &111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111,
- &-211,2*211,2*-211,2*0,-211,111,-211,111,4*0,-211,111,-211,111,
- &34*0,111,-211,3*111,3*-211,2*111,3*-211,4*0,-321,-311,3*0,-321,
- &-311,20*0,-3,31*0,6*1,30*0,6*2,33*0,6*3,9*0,8*4,4*0,4*-5,4*0,
- &2*-5,7*0,-11,264*0,111,-211,4*0,111,57*0,-211,111,5*0,-211,111,
- &52*0,2101,2103,2*2101,19*0,6*2101,909*0/
- DATA (KFDP(I,5),I= 1,2000)/90*0,111,16*0,111,7*0,111,0,2*111,
- &303*0,-211,2*111,-211,111,-211,111,54*0,111,-211,3*111,-211,111,
- &1510*0/
-
-C...LUDAT4, with character strings.
- DATA (CHAF(I) ,I= 1, 281)/'d','u','s','c','b','t','l','h',
- &2*' ','e','nu_e','mu','nu_mu','tau','nu_tau','chi','nu_chi',
- &2*' ','g','gamma','Z','W','H',2*' ','reggeon','pomeron',2*' ',
- &'Z''','Z"','W''','H''','A','H','eta_tech','LQ_ue','R',40*' ',
- &'specflav','rndmflav','phasespa','c-hadron','b-hadron',
- &'t-hadron','l-hadron','h-hadron','Wvirt','diquark','cluster',
- &'string','indep.','CMshower','SPHEaxis','THRUaxis','CLUSjet',
- &'CELLjet','table',' ','pi',2*'K',2*'D','D_s',2*'B','B_s','B_c',
- &'pi','eta','eta''','eta_c','eta_b','eta_t','eta_l','eta_h',2*' ',
- &'rho',2*'K*',2*'D*','D*_s',2*'B*','B*_s','B*_c','rho','omega',
- &'phi','J/psi','Upsilon','Theta','Theta_l','Theta_h',2*' ','b_1',
- &2*'K_1',2*'D_1','D_1s',2*'B_1','B_1s','B_1c','b_1','h_1','h''_1',
- &'h_1c','h_1b','h_1t','h_1l','h_1h',2*' ','a_0',2*'K*_0',2*'D*_0',
- &'D*_0s',2*'B*_0','B*_0s','B*_0c','a_0','f_0','f''_0','chi_0c',
- &'chi_0b','chi_0t','chi_0l','chi_0h',2*' ','a_1',2*'K*_1',
- &2*'D*_1','D*_1s',2*'B*_1','B*_1s','B*_1c','a_1','f_1','f''_1',
- &'chi_1c','chi_1b','chi_1t','chi_1l','chi_1h',2*' ','a_2',
- &2*'K*_2',2*'D*_2','D*_2s',2*'B*_2','B*_2s','B*_2c','a_2','f_2',
- &'f''_2','chi_2c','chi_2b','chi_2t','chi_2l','chi_2h',2*' ','K_L',
- &'K_S',8*' ','psi''',3*' ','Upsilon''',45*' ','pi_diffr'/
- DATA (CHAF(I) ,I= 282, 500)/'n_diffr','p_diffr','rho_diff',
- &'omega_di','phi_diff','J/psi_di',18*' ','Lambda',5*' ',
- &'Lambda_c',' ',2*'Xi_c',6*' ','Lambda_b',' ',2*'Xi_b',6*' ','n',
- &'p',' ',3*'Sigma',2*'Xi',' ',3*'Sigma_c',2*'Xi''_c','Omega_c',
- &4*' ',3*'Sigma_b',2*'Xi''_b','Omega_b',4*' ',4*'Delta',
- &3*'Sigma*',2*'Xi*','Omega',3*'Sigma*_c',2*'Xi*_c','Omega*_c',
- &4*' ',3*'Sigma*_b',2*'Xi*_b','Omega*_b',114*' '/
-
-C...LUDATR, with initial values for the random number generator.
- DATA MRLU/19780503,0,0,97,33,0/
-
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUDECY(IP)
-
-C...Purpose: to handle the decay of unstable particles.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
- DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3),
- &WTCOR(10),PTAU(4),PCMTAU(4)
- DOUBLE PRECISION DBETAU(3)
- DATA WTCOR/2.,5.,15.,60.,250.,1500.,1.2E4,1.2E5,150.,16./
-
-C...Functions: momentum in two-particle decays, four-product and
-C...matrix element times phase space in weak decays.
- PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A)
- FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3)
- HMEPS(HA)=((1.-HRQ-HA)**2+3.*HA*(1.+HRQ-HA))*
- &SQRT((1.-HRQ-HA)**2-4.*HRQ*HA)
-
-C...Initial values.
- NTRY=0
- NSAV=N
- KFA=IABS(K(IP,2))
- KFS=ISIGN(1,K(IP,2))
- KC=LUCOMP(KFA)
- MSTJ(92)=0
-
-C...Choose lifetime and determine decay vertex.
- IF(K(IP,1).EQ.5) THEN
- V(IP,5)=0.
- ELSEIF(K(IP,1).NE.4) THEN
- V(IP,5)=-PMAS(KC,4)*LOG(RLU(0))
- ENDIF
- DO 100 J=1,4
- VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5)
- 100 CONTINUE
-
-C...Determine whether decay allowed or not.
- MOUT=0
- IF(MSTJ(22).EQ.2) THEN
- IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1
- ELSEIF(MSTJ(22).EQ.3) THEN
- IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1
- ELSEIF(MSTJ(22).EQ.4) THEN
- IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1
- IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1
- ENDIF
- IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN
- K(IP,1)=4
- RETURN
- ENDIF
-
-C...Interface to external tau decay library (for tau polarization).
- IF(KFA.EQ.15.AND.MSTJ(28).GE.1) THEN
-
-C...Starting values for pointers and momenta.
- ITAU=IP
- DO 110 J=1,4
- PTAU(J)=P(ITAU,J)
- PCMTAU(J)=P(ITAU,J)
- 110 CONTINUE
-
-C...Iterate to find position and code of mother of tau.
- IMTAU=ITAU
- 120 IMTAU=K(IMTAU,3)
-
- IF(IMTAU.EQ.0) THEN
-C...If no known origin then impossible to do anything further.
- KFORIG=0
- IORIG=0
-
- ELSEIF(K(IMTAU,2).EQ.K(ITAU,2)) THEN
-C...If tau -> tau + gamma then add gamma energy and loop.
- IF(K(K(IMTAU,4),2).EQ.22) THEN
- DO 130 J=1,4
- PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,4),J)
- 130 CONTINUE
- ELSEIF(K(K(IMTAU,5),2).EQ.22) THEN
- DO 140 J=1,4
- PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,5),J)
- 140 CONTINUE
- ENDIF
- GOTO 120
-
- ELSEIF(IABS(K(IMTAU,2)).GT.100) THEN
-C...If coming from weak decay of hadron then W is not stored in record,
-C...but can be reconstructed by adding neutrino momentum.
- KFORIG=-ISIGN(24,K(ITAU,2))
- IORIG=0
- DO 160 II=K(IMTAU,4),K(IMTAU,5)
- IF(K(II,2)*ISIGN(1,K(ITAU,2)).EQ.-16) THEN
- DO 150 J=1,4
- PCMTAU(J)=PCMTAU(J)+P(II,J)
- 150 CONTINUE
- ENDIF
- 160 CONTINUE
-
- ELSE
-C...If coming from resonance decay then find latest copy of this
-C...resonance (may not completely agree).
- KFORIG=K(IMTAU,2)
- IORIG=IMTAU
- DO 170 II=IMTAU+1,IP-1
- IF(K(II,2).EQ.KFORIG.AND.K(II,3).EQ.IORIG.AND.
- & ABS(P(II,5)-P(IORIG,5)).LT.1E-5*P(IORIG,5)) IORIG=II
- 170 CONTINUE
- DO 180 J=1,4
- PCMTAU(J)=P(IORIG,J)
- 180 CONTINUE
- ENDIF
-
-C...Boost tau to rest frame of production process (where known)
-C...and rotate it to sit along +z axis.
- DO 190 J=1,3
- DBETAU(J)=PCMTAU(J)/PCMTAU(4)
- 190 CONTINUE
- IF(KFORIG.NE.0) CALL LUDBRB(ITAU,ITAU,0.,0.,-DBETAU(1),
- & -DBETAU(2),-DBETAU(3))
- PHITAU=ULANGL(P(ITAU,1),P(ITAU,2))
- CALL LUDBRB(ITAU,ITAU,0.,-PHITAU,0D0,0D0,0D0)
- THETAU=ULANGL(P(ITAU,3),P(ITAU,1))
- CALL LUDBRB(ITAU,ITAU,-THETAU,0.,0D0,0D0,0D0)
-
-C...Call tau decay routine (if meaningful) and fill extra info.
- IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN
- CALL LUTAUD(ITAU,IORIG,KFORIG,NDECAY)
- DO 200 II=NSAV+1,NSAV+NDECAY
- K(II,1)=1
- K(II,3)=IP
- K(II,4)=0
- K(II,5)=0
- 200 CONTINUE
- N=NSAV+NDECAY
- ENDIF
-
-C...Boost back decay tau and decay products.
- DO 210 J=1,4
- P(ITAU,J)=PTAU(J)
- 210 CONTINUE
- IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN
- CALL LUDBRB(NSAV+1,N,THETAU,PHITAU,0D0,0D0,0D0)
- IF(KFORIG.NE.0) CALL LUDBRB(NSAV+1,N,0.,0.,DBETAU(1),
- & DBETAU(2),DBETAU(3))
-
-C...Skip past ordinary tau decay treatment.
- MMAT=0
- MBST=0
- ND=0
- GOTO 660
- ENDIF
- ENDIF
-
-C...B-B~ mixing: flip sign of meson appropriately.
- MMIX=0
- IF((KFA.EQ.511.OR.KFA.EQ.531).AND.MSTJ(26).GE.1) THEN
- XBBMIX=PARJ(76)
- IF(KFA.EQ.531) XBBMIX=PARJ(77)
- IF(SIN(0.5*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.RLU(0)) MMIX=1
- IF(MMIX.EQ.1) KFS=-KFS
- ENDIF
-
-C...Check existence of decay channels. Particle/antiparticle rules.
- KCA=KC
- IF(MDCY(KC,2).GT.0) THEN
- MDMDCY=MDME(MDCY(KC,2),2)
- IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY
- ENDIF
- IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN
- CALL LUERRM(9,'(LUDECY:) no decay channel defined')
- RETURN
- ENDIF
- IF(MOD(KFA/1000,10).EQ.0.AND.(KCA.EQ.85.OR.KCA.EQ.87)) KFS=-KFS
- IF(KCHG(KC,3).EQ.0) THEN
- KFSP=1
- KFSN=0
- IF(RLU(0).GT.0.5) KFS=-KFS
- ELSEIF(KFS.GT.0) THEN
- KFSP=1
- KFSN=0
- ELSE
- KFSP=0
- KFSN=1
- ENDIF
-
-C...Sum branching ratios of allowed decay channels.
- 220 NOPE=0
- BRSU=0.
- DO 230 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1
- IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND.
- &KFSN*MDME(IDL,1).NE.3) GOTO 230
- IF(MDME(IDL,2).GT.100) GOTO 230
- NOPE=NOPE+1
- BRSU=BRSU+BRAT(IDL)
- 230 CONTINUE
- IF(NOPE.EQ.0) THEN
- CALL LUERRM(2,'(LUDECY:) all decay channels closed by user')
- RETURN
- ENDIF
-
-C...Select decay channel among allowed ones.
- 240 RBR=BRSU*RLU(0)
- IDL=MDCY(KCA,2)-1
- 250 IDL=IDL+1
- IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND.
- &KFSN*MDME(IDL,1).NE.3) THEN
- IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250
- ELSEIF(MDME(IDL,2).GT.100) THEN
- IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250
- ELSE
- IDC=IDL
- RBR=RBR-BRAT(IDL)
- IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0.) GOTO 250
- ENDIF
-
-C...Start readout of decay channel: matrix element, reset counters.
- MMAT=MDME(IDC,2)
- 260 NTRY=NTRY+1
- IF(NTRY.GT.1000) THEN
- CALL LUERRM(14,'(LUDECY:) caught in infinite loop')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
- I=N
- NP=0
- NQ=0
- MBST=0
- IF(MMAT.GE.11.AND.MMAT.NE.46.AND.P(IP,4).GT.20.*P(IP,5)) MBST=1
- DO 270 J=1,4
- PV(1,J)=0.
- IF(MBST.EQ.0) PV(1,J)=P(IP,J)
- 270 CONTINUE
- IF(MBST.EQ.1) PV(1,4)=P(IP,5)
- PV(1,5)=P(IP,5)
- PS=0.
- PSQ=0.
- MREM=0
- MHADDY=0
- IF(KFA.GT.80) MHADDY=1
-
-C...Read out decay products. Convert to standard flavour code.
- JTMAX=5
- IF(MDME(IDC+1,2).EQ.101) JTMAX=10
- DO 280 JT=1,JTMAX
- IF(JT.LE.5) KP=KFDP(IDC,JT)
- IF(JT.GE.6) KP=KFDP(IDC+1,JT-5)
- IF(KP.EQ.0) GOTO 280
- KPA=IABS(KP)
- KCP=LUCOMP(KPA)
- IF(KPA.GT.80) MHADDY=1
- IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN
- KFP=KP
- ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN
- KFP=KFS*KP
- ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN
- KFP=-KFS*MOD(KFA/10,10)
- ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN
- KFP=KFS*(100*MOD(KFA/10,100)+3)
- ELSEIF(KPA.EQ.81) THEN
- KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1)
- ELSEIF(KP.EQ.82) THEN
- CALL LUKFDI(-KFS*INT(1.+(2.+PARJ(2))*RLU(0)),0,KFP,KDUMP)
- IF(KFP.EQ.0) GOTO 260
- MSTJ(93)=1
- IF(PV(1,5).LT.PARJ(32)+2.*ULMASS(KFP)) GOTO 260
- ELSEIF(KP.EQ.-82) THEN
- KFP=-KFP
- IF(IABS(KFP).GT.10) KFP=KFP+ISIGN(10000,KFP)
- ENDIF
- IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=LUCOMP(KFP)
-
-C...Add decay product to event record or to quark flavour list.
- KFPA=IABS(KFP)
- KQP=KCHG(KCP,2)
- IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN
- NQ=NQ+1
- KFLO(NQ)=KFP
- MSTJ(93)=2
- PSQ=PSQ+ULMASS(KFLO(NQ))
- ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.48).AND.NP.EQ.3.AND.
- &MOD(NQ,2).EQ.1) THEN
- NQ=NQ-1
- PS=PS-P(I,5)
- K(I,1)=1
- KFI=K(I,2)
- CALL LUKFDI(KFP,KFI,KFLDMP,K(I,2))
- IF(K(I,2).EQ.0) GOTO 260
- MSTJ(93)=1
- P(I,5)=ULMASS(K(I,2))
- PS=PS+P(I,5)
- ELSE
- I=I+1
- NP=NP+1
- IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1
- IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1
- K(I,1)=1+MOD(NQ,2)
- IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2
- IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1
- K(I,2)=KFP
- K(I,3)=IP
- K(I,4)=0
- K(I,5)=0
- P(I,5)=ULMASS(KFP)
- IF(MMAT.EQ.45.AND.KFPA.EQ.89) P(I,5)=PARJ(32)
- PS=PS+P(I,5)
- ENDIF
- 280 CONTINUE
-
-C...Check masses for resonance decays.
- IF(MHADDY.EQ.0) THEN
- IF(PS+PARJ(64).GT.PV(1,5)) GOTO 240
- ENDIF
-
-C...Choose decay multiplicity in phase space model.
- 290 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN
- PSP=PS
- CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1))
- IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63)
- 300 NTRY=NTRY+1
- IF(NTRY.GT.1000) THEN
- CALL LUERRM(14,'(LUDECY:) caught in infinite loop')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
- IF(MMAT.LE.20) THEN
- GAUSS=SQRT(-2.*CNDE*LOG(MAX(1E-10,RLU(0))))*
- & SIN(PARU(2)*RLU(0))
- ND=0.5+0.5*NP+0.25*NQ+CNDE+GAUSS
- IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 300
- IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 300
- IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 300
- IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 300
- ELSE
- ND=MMAT-20
- ENDIF
-
-C...Form hadrons from flavour content.
- DO 310 JT=1,4
- KFL1(JT)=KFLO(JT)
- 310 CONTINUE
- IF(ND.EQ.NP+NQ/2) GOTO 330
- DO 320 I=N+NP+1,N+ND-NQ/2
- JT=1+INT((NQ-1)*RLU(0))
- CALL LUKFDI(KFL1(JT),0,KFL2,K(I,2))
- IF(K(I,2).EQ.0) GOTO 300
- KFL1(JT)=-KFL2
- 320 CONTINUE
- 330 JT=2
- JT2=3
- JT3=4
- IF(NQ.EQ.4.AND.RLU(0).LT.PARJ(66)) JT=4
- IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))*
- & ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3
- IF(JT.EQ.3) JT2=2
- IF(JT.EQ.4) JT3=2
- CALL LUKFDI(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2))
- IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 300
- IF(NQ.EQ.4) CALL LUKFDI(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2))
- IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 300
-
-C...Check that sum of decay product masses not too large.
- PS=PSP
- DO 340 I=N+NP+1,N+ND
- K(I,1)=1
- K(I,3)=IP
- K(I,4)=0
- K(I,5)=0
- P(I,5)=ULMASS(K(I,2))
- PS=PS+P(I,5)
- 340 CONTINUE
- IF(PS+PARJ(64).GT.PV(1,5)) GOTO 300
-
-C...Rescale energy to subtract off spectator quark mass.
- ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44.OR.MMAT.EQ.45)
- &.AND.NP.GE.3) THEN
- PS=PS-P(N+NP,5)
- PQT=(P(N+NP,5)+PARJ(65))/PV(1,5)
- DO 350 J=1,5
- P(N+NP,J)=PQT*PV(1,J)
- PV(1,J)=(1.-PQT)*PV(1,J)
- 350 CONTINUE
- IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260
- ND=NP-1
- MREM=1
-
-C...Phase space factors imposed in W decay.
- ELSEIF(MMAT.EQ.46) THEN
- MSTJ(93)=1
- PSMC=ULMASS(K(N+1,2))
- MSTJ(93)=1
- PSMC=PSMC+ULMASS(K(N+2,2))
- IF(MAX(PS,PSMC)+PARJ(32).GT.PV(1,5)) GOTO 240
- HR1=(P(N+1,5)/PV(1,5))**2
- HR2=(P(N+2,5)/PV(1,5))**2
- IF((1.-HR1-HR2)*(2.+HR1+HR2)*SQRT((1.-HR1-HR2)**2-4.*HR1*HR2)
- & .LT.2.*RLU(0)) GOTO 240
- ND=NP
-
-C...Fully specified final state: check mass broadening effects.
- ELSE
- IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 260
- ND=NP
- ENDIF
-
-C...Select W mass in decay Q -> W + q, without W propagator.
- IF(MMAT.EQ.45.AND.MSTJ(25).LE.0) THEN
- HLQ=(PARJ(32)/PV(1,5))**2
- HUQ=(1.-(P(N+2,5)+PARJ(64))/PV(1,5))**2
- HRQ=(P(N+2,5)/PV(1,5))**2
- 360 HW=HLQ+RLU(0)*(HUQ-HLQ)
- IF(HMEPS(HW).LT.RLU(0)) GOTO 360
- P(N+1,5)=PV(1,5)*SQRT(HW)
-
-C...Ditto, including W propagator. Divide mass range into three regions.
- ELSEIF(MMAT.EQ.45) THEN
- HQW=(PV(1,5)/PMAS(24,1))**2
- HLW=(PARJ(32)/PMAS(24,1))**2
- HUW=((PV(1,5)-P(N+2,5)-PARJ(64))/PMAS(24,1))**2
- HRQ=(P(N+2,5)/PV(1,5))**2
- HG=PMAS(24,2)/PMAS(24,1)
- HATL=ATAN((HLW-1.)/HG)
- HM=MIN(1.,HUW-0.001)
- HMV1=HMEPS(HM/HQW)/((HM-1.)**2+HG**2)
- 370 HM=HM-HG
- HMV2=HMEPS(HM/HQW)/((HM-1.)**2+HG**2)
- IF(HMV2.GT.HMV1.AND.HM-HG.GT.HLW) THEN
- HMV1=HMV2
- GOTO 370
- ENDIF
- HMV=MIN(2.*HMV1,HMEPS(HM/HQW)/HG**2)
- HM1=1.-SQRT(1./HMV-HG**2)
- IF(HM1.GT.HLW.AND.HM1.LT.HM) THEN
- HM=HM1
- ELSEIF(HMV2.LE.HMV1) THEN
- HM=MAX(HLW,HM-MIN(0.1,1.-HM))
- ENDIF
- HATM=ATAN((HM-1.)/HG)
- HWT1=(HATM-HATL)/HG
- HWT2=HMV*(MIN(1.,HUW)-HM)
- HWT3=0.
- IF(HUW.GT.1.) THEN
- HATU=ATAN((HUW-1.)/HG)
- HMP1=HMEPS(1./HQW)
- HWT3=HMP1*HATU/HG
- ENDIF
-
-C...Select mass region and W mass there. Accept according to weight.
- 380 HREG=RLU(0)*(HWT1+HWT2+HWT3)
- IF(HREG.LE.HWT1) THEN
- HW=1.+HG*TAN(HATL+RLU(0)*(HATM-HATL))
- HACC=HMEPS(HW/HQW)
- ELSEIF(HREG.LE.HWT1+HWT2) THEN
- HW=HM+RLU(0)*(MIN(1.,HUW)-HM)
- HACC=HMEPS(HW/HQW)/((HW-1.)**2+HG**2)/HMV
- ELSE
- HW=1.+HG*TAN(RLU(0)*HATU)
- HACC=HMEPS(HW/HQW)/HMP1
- ENDIF
- IF(HACC.LT.RLU(0)) GOTO 380
- P(N+1,5)=PMAS(24,1)*SQRT(HW)
- ENDIF
-
-C...Determine position of grandmother, number of sisters, Q -> W sign.
- NM=0
- KFAS=0
- MSGN=0
- IF(MMAT.EQ.3.OR.MMAT.EQ.46) THEN
- IM=K(IP,3)
- IF(IM.LT.0.OR.IM.GE.IP) IM=0
- IF(MMAT.EQ.46.AND.MSTJ(27).EQ.1) THEN
- IM=0
- ELSEIF(MMAT.EQ.46.AND.MSTJ(27).GE.2.AND.IM.NE.0) THEN
- IF(K(IM,2).EQ.94) THEN
- IM=K(K(IM,3),3)
- IF(IM.LT.0.OR.IM.GE.IP) IM=0
- ENDIF
- ENDIF
- IF(IM.NE.0) KFAM=IABS(K(IM,2))
- IF(IM.NE.0.AND.MMAT.EQ.3) THEN
- DO 390 IL=MAX(IP-2,IM+1),MIN(IP+2,N)
- IF(K(IL,3).EQ.IM) NM=NM+1
- IF(K(IL,3).EQ.IM.AND.IL.NE.IP) ISIS=IL
- 390 CONTINUE
- IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR.
- & MOD(KFAM/1000,10).NE.0) NM=0
- IF(NM.EQ.2) THEN
- KFAS=IABS(K(ISIS,2))
- IF((KFAS.LE.100.OR.MOD(KFAS,10).NE.1.OR.
- & MOD(KFAS/1000,10).NE.0).AND.KFAS.NE.22) NM=0
- ENDIF
- ELSEIF(IM.NE.0.AND.MMAT.EQ.46) THEN
- MSGN=ISIGN(1,K(IM,2)*K(IP,2))
- IF(KFAM.GT.100.AND.MOD(KFAM/1000,10).EQ.0) MSGN=
- & MSGN*(-1)**MOD(KFAM/100,10)
- ENDIF
- ENDIF
-
-C...Kinematics of one-particle decays.
- IF(ND.EQ.1) THEN
- DO 400 J=1,4
- P(N+1,J)=P(IP,J)
- 400 CONTINUE
- GOTO 660
- ENDIF
-
-C...Calculate maximum weight ND-particle decay.
- PV(ND,5)=P(N+ND,5)
- IF(ND.GE.3) THEN
- WTMAX=1./WTCOR(ND-2)
- PMAX=PV(1,5)-PS+P(N+ND,5)
- PMIN=0.
- DO 410 IL=ND-1,1,-1
- PMAX=PMAX+P(N+IL,5)
- PMIN=PMIN+P(N+IL+1,5)
- WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5))
- 410 CONTINUE
- ENDIF
-
-C...Find virtual gamma mass in Dalitz decay.
- 420 IF(ND.EQ.2) THEN
- ELSEIF(MMAT.EQ.2) THEN
- PMES=4.*PMAS(11,1)**2
- PMRHO2=PMAS(131,1)**2
- PGRHO2=PMAS(131,2)**2
- 430 PMST=PMES*(P(IP,5)**2/PMES)**RLU(0)
- WT=(1+0.5*PMES/PMST)*SQRT(MAX(0.,1.-PMES/PMST))*
- & (1.-PMST/P(IP,5)**2)**3*(1.+PGRHO2/PMRHO2)/
- & ((1.-PMST/PMRHO2)**2+PGRHO2/PMRHO2)
- IF(WT.LT.RLU(0)) GOTO 430
- PV(2,5)=MAX(2.00001*PMAS(11,1),SQRT(PMST))
-
-C...M-generator gives weight. If rejected, try again.
- ELSE
- 440 RORD(1)=1.
- DO 470 IL1=2,ND-1
- RSAV=RLU(0)
- DO 450 IL2=IL1-1,1,-1
- IF(RSAV.LE.RORD(IL2)) GOTO 460
- RORD(IL2+1)=RORD(IL2)
- 450 CONTINUE
- 460 RORD(IL2+1)=RSAV
- 470 CONTINUE
- RORD(ND)=0.
- WT=1.
- DO 480 IL=ND-1,1,-1
- PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS)
- WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))
- 480 CONTINUE
- IF(WT.LT.RLU(0)*WTMAX) GOTO 440
- ENDIF
-
-C...Perform two-particle decays in respective CM frame.
- 490 DO 510 IL=1,ND-1
- PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))
- UE(3)=2.*RLU(0)-1.
- PHI=PARU(2)*RLU(0)
- UE(1)=SQRT(1.-UE(3)**2)*COS(PHI)
- UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI)
- DO 500 J=1,3
- P(N+IL,J)=PA*UE(J)
- PV(IL+1,J)=-PA*UE(J)
- 500 CONTINUE
- P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2)
- PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2)
- 510 CONTINUE
-
-C...Lorentz transform decay products to lab frame.
- DO 520 J=1,4
- P(N+ND,J)=PV(ND,J)
- 520 CONTINUE
- DO 560 IL=ND-1,1,-1
- DO 530 J=1,3
- BE(J)=PV(IL,J)/PV(IL,4)
- 530 CONTINUE
- GA=PV(IL,4)/PV(IL,5)
- DO 550 I=N+IL,N+ND
- BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
- DO 540 J=1,3
- P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
- 540 CONTINUE
- P(I,4)=GA*(P(I,4)+BEP)
- 550 CONTINUE
- 560 CONTINUE
-
-C...Check that no infinite loop in matrix element weight.
- NTRY=NTRY+1
- IF(NTRY.GT.800) GOTO 590
-
-C...Matrix elements for omega and phi decays.
- IF(MMAT.EQ.1) THEN
- WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2
- & -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2
- & +2.*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3)
- IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001).LT.RLU(0)) GOTO 420
-
-C...Matrix elements for pi0 or eta Dalitz decay to gamma e+ e-.
- ELSEIF(MMAT.EQ.2) THEN
- FOUR12=FOUR(N+1,N+2)
- FOUR13=FOUR(N+1,N+3)
- WT=(PMST-0.5*PMES)*(FOUR12**2+FOUR13**2)+
- & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2)
- IF(WT.LT.RLU(0)*0.25*PMST*(P(IP,5)**2-PMST)**2) GOTO 490
-
-C...Matrix element for S0 -> S1 + V1 -> S1 + S2 + S3 (S scalar,
-C...V vector), of form cos**2(theta02) in V1 rest frame, and for
-C...S0 -> gamma + V1 -> gamma + S2 + S3, of form sin**2(theta02).
- ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN
- FOUR10=FOUR(IP,IM)
- FOUR12=FOUR(IP,N+1)
- FOUR02=FOUR(IM,N+1)
- PMS1=P(IP,5)**2
- PMS0=P(IM,5)**2
- PMS2=P(N+1,5)**2
- IF(KFAS.NE.22) HNUM=(FOUR10*FOUR12-PMS1*FOUR02)**2
- IF(KFAS.EQ.22) HNUM=PMS1*(2.*FOUR10*FOUR12*FOUR02-
- & PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2)
- HNUM=MAX(1E-6*PMS1**2*PMS0*PMS2,HNUM)
- HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2)
- IF(HNUM.LT.RLU(0)*HDEN) GOTO 490
-
-C...Matrix element for "onium" -> g + g + g or gamma + g + g.
- ELSEIF(MMAT.EQ.4) THEN
- HX1=2.*FOUR(IP,N+1)/P(IP,5)**2
- HX2=2.*FOUR(IP,N+2)/P(IP,5)**2
- HX3=2.*FOUR(IP,N+3)/P(IP,5)**2
- WT=((1.-HX1)/(HX2*HX3))**2+((1.-HX2)/(HX1*HX3))**2+
- & ((1.-HX3)/(HX1*HX2))**2
- IF(WT.LT.2.*RLU(0)) GOTO 420
- IF(K(IP+1,2).EQ.22.AND.(1.-HX1)*P(IP,5)**2.LT.4.*PARJ(32)**2)
- & GOTO 420
-
-C...Effective matrix element for nu spectrum in tau -> nu + hadrons.
- ELSEIF(MMAT.EQ.41) THEN
- HX1=2.*FOUR(IP,N+1)/P(IP,5)**2
- HXM=MIN(0.75,2.*(1.-PS/P(IP,5)))
- IF(HX1*(3.-2.*HX1).LT.RLU(0)*HXM*(3.-2.*HXM)) GOTO 420
-
-C...Matrix elements for weak decays (only semileptonic for c and b)
- ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48)
- &.AND.ND.EQ.3) THEN
- IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3)
- IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3)
- IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 420
- ELSEIF(MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) THEN
- DO 580 J=1,4
- P(N+NP+1,J)=0.
- DO 570 IS=N+3,N+NP
- P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J)
- 570 CONTINUE
- 580 CONTINUE
- IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1)
- IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1)
- IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 420
-
-C...Angular distribution in W decay.
- ELSEIF(MMAT.EQ.46.AND.MSGN.NE.0) THEN
- IF(MSGN.GT.0) WT=FOUR(IM,N+1)*FOUR(N+2,IP+1)
- IF(MSGN.LT.0) WT=FOUR(IM,N+2)*FOUR(N+1,IP+1)
- IF(WT.LT.RLU(0)*P(IM,5)**4/WTCOR(10)) GOTO 490
- ENDIF
-
-C...Scale back energy and reattach spectator.
- 590 IF(MREM.EQ.1) THEN
- DO 600 J=1,5
- PV(1,J)=PV(1,J)/(1.-PQT)
- 600 CONTINUE
- ND=ND+1
- MREM=0
- ENDIF
-
-C...Low invariant mass for system with spectator quark gives particle,
-C...not two jets. Readjust momenta accordingly.
- IF((MMAT.EQ.31.OR.MMAT.EQ.45).AND.ND.EQ.3) THEN
- MSTJ(93)=1
- PM2=ULMASS(K(N+2,2))
- MSTJ(93)=1
- PM3=ULMASS(K(N+3,2))
- IF(P(N+2,5)**2+P(N+3,5)**2+2.*FOUR(N+2,N+3).GE.
- & (PARJ(32)+PM2+PM3)**2) GOTO 660
- K(N+2,1)=1
- KFTEMP=K(N+2,2)
- CALL LUKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2))
- IF(K(N+2,2).EQ.0) GOTO 260
- P(N+2,5)=ULMASS(K(N+2,2))
- PS=P(N+1,5)+P(N+2,5)
- PV(2,5)=P(N+2,5)
- MMAT=0
- ND=2
- GOTO 490
- ELSEIF(MMAT.EQ.44) THEN
- MSTJ(93)=1
- PM3=ULMASS(K(N+3,2))
- MSTJ(93)=1
- PM4=ULMASS(K(N+4,2))
- IF(P(N+3,5)**2+P(N+4,5)**2+2.*FOUR(N+3,N+4).GE.
- & (PARJ(32)+PM3+PM4)**2) GOTO 630
- K(N+3,1)=1
- KFTEMP=K(N+3,2)
- CALL LUKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2))
- IF(K(N+3,2).EQ.0) GOTO 260
- P(N+3,5)=ULMASS(K(N+3,2))
- DO 610 J=1,3
- P(N+3,J)=P(N+3,J)+P(N+4,J)
- 610 CONTINUE
- P(N+3,4)=SQRT(P(N+3,1)**2+P(N+3,2)**2+P(N+3,3)**2+P(N+3,5)**2)
- HA=P(N+1,4)**2-P(N+2,4)**2
- HB=HA-(P(N+1,5)**2-P(N+2,5)**2)
- HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+
- & (P(N+1,3)-P(N+2,3))**2
- HD=(PV(1,4)-P(N+3,4))**2
- HE=HA**2-2.*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2
- HF=HD*HC-HB**2
- HG=HD*HC-HA*HB
- HH=(SQRT(HG**2+HE*HF)-HG)/(2.*HF)
- DO 620 J=1,3
- PCOR=HH*(P(N+1,J)-P(N+2,J))
- P(N+1,J)=P(N+1,J)+PCOR
- P(N+2,J)=P(N+2,J)-PCOR
- 620 CONTINUE
- P(N+1,4)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2+P(N+1,5)**2)
- P(N+2,4)=SQRT(P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2+P(N+2,5)**2)
- ND=ND-1
- ENDIF
-
-C...Check invariant mass of W jets. May give one particle or start over.
- 630 IF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48)
- &.AND.IABS(K(N+1,2)).LT.10) THEN
- PMR=SQRT(MAX(0.,P(N+1,5)**2+P(N+2,5)**2+2.*FOUR(N+1,N+2)))
- MSTJ(93)=1
- PM1=ULMASS(K(N+1,2))
- MSTJ(93)=1
- PM2=ULMASS(K(N+2,2))
- IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 640
- KFLDUM=INT(1.5+RLU(0))
- CALL LUKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1)
- CALL LUKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2)
- IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 260
- PSM=ULMASS(KF1)+ULMASS(KF2)
- IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.PMR.GT.PARJ(64)+PSM) GOTO 640
- IF(MMAT.GE.43.AND.PMR.GT.0.2*PARJ(32)+PSM) GOTO 640
- IF(MMAT.EQ.48) GOTO 420
- IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 260
- K(N+1,1)=1
- KFTEMP=K(N+1,2)
- CALL LUKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2))
- IF(K(N+1,2).EQ.0) GOTO 260
- P(N+1,5)=ULMASS(K(N+1,2))
- K(N+2,2)=K(N+3,2)
- P(N+2,5)=P(N+3,5)
- PS=P(N+1,5)+P(N+2,5)
- IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260
- PV(2,5)=P(N+3,5)
- MMAT=0
- ND=2
- GOTO 490
- ENDIF
-
-C...Phase space decay of partons from W decay.
- 640 IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.IABS(K(N+1,2)).LT.10) THEN
- KFLO(1)=K(N+1,2)
- KFLO(2)=K(N+2,2)
- K(N+1,1)=K(N+3,1)
- K(N+1,2)=K(N+3,2)
- DO 650 J=1,5
- PV(1,J)=P(N+1,J)+P(N+2,J)
- P(N+1,J)=P(N+3,J)
- 650 CONTINUE
- PV(1,5)=PMR
- N=N+1
- NP=0
- NQ=2
- PS=0.
- MSTJ(93)=2
- PSQ=ULMASS(KFLO(1))
- MSTJ(93)=2
- PSQ=PSQ+ULMASS(KFLO(2))
- MMAT=11
- GOTO 290
- ENDIF
-
-C...Boost back for rapidly moving particle.
- 660 N=N+ND
- IF(MBST.EQ.1) THEN
- DO 670 J=1,3
- BE(J)=P(IP,J)/P(IP,4)
- 670 CONTINUE
- GA=P(IP,4)/P(IP,5)
- DO 690 I=NSAV+1,N
- BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
- DO 680 J=1,3
- P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
- 680 CONTINUE
- P(I,4)=GA*(P(I,4)+BEP)
- 690 CONTINUE
- ENDIF
-
-C...Fill in position of decay vertex.
- DO 710 I=NSAV+1,N
- DO 700 J=1,4
- V(I,J)=VDCY(J)
- 700 CONTINUE
- V(I,5)=0.
- 710 CONTINUE
-
-C...Set up for parton shower evolution from jets.
- IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN
- K(NSAV+1,1)=3
- K(NSAV+2,1)=3
- K(NSAV+3,1)=3
- K(NSAV+1,4)=MSTU(5)*(NSAV+2)
- K(NSAV+1,5)=MSTU(5)*(NSAV+3)
- K(NSAV+2,4)=MSTU(5)*(NSAV+3)
- K(NSAV+2,5)=MSTU(5)*(NSAV+1)
- K(NSAV+3,4)=MSTU(5)*(NSAV+1)
- K(NSAV+3,5)=MSTU(5)*(NSAV+2)
- MSTJ(92)=-(NSAV+1)
- ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN
- K(NSAV+2,1)=3
- K(NSAV+3,1)=3
- K(NSAV+2,4)=MSTU(5)*(NSAV+3)
- K(NSAV+2,5)=MSTU(5)*(NSAV+3)
- K(NSAV+3,4)=MSTU(5)*(NSAV+2)
- K(NSAV+3,5)=MSTU(5)*(NSAV+2)
- MSTJ(92)=NSAV+2
- ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46)
- &.AND.IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN
- K(NSAV+1,1)=3
- K(NSAV+2,1)=3
- K(NSAV+1,4)=MSTU(5)*(NSAV+2)
- K(NSAV+1,5)=MSTU(5)*(NSAV+2)
- K(NSAV+2,4)=MSTU(5)*(NSAV+1)
- K(NSAV+2,5)=MSTU(5)*(NSAV+1)
- MSTJ(92)=NSAV+1
- ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46)
- &.AND.IABS(K(NSAV+1,2)).LE.20.AND.IABS(K(NSAV+2,2)).LE.20) THEN
- MSTJ(92)=NSAV+1
- ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21)
- &THEN
- K(NSAV+1,1)=3
- K(NSAV+2,1)=3
- K(NSAV+3,1)=3
- KCP=LUCOMP(K(NSAV+1,2))
- KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2))
- JCON=4
- IF(KQP.LT.0) JCON=5
- K(NSAV+1,JCON)=MSTU(5)*(NSAV+2)
- K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1)
- K(NSAV+2,JCON)=MSTU(5)*(NSAV+3)
- K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2)
- MSTJ(92)=NSAV+1
- ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN
- K(NSAV+1,1)=3
- K(NSAV+3,1)=3
- K(NSAV+1,4)=MSTU(5)*(NSAV+3)
- K(NSAV+1,5)=MSTU(5)*(NSAV+3)
- K(NSAV+3,4)=MSTU(5)*(NSAV+1)
- K(NSAV+3,5)=MSTU(5)*(NSAV+1)
- MSTJ(92)=NSAV+1
-
-C...Set up for parton shower evolution in t -> W + b.
- ELSEIF(MSTJ(27).GE.1.AND.MMAT.EQ.45.AND.ND.EQ.3) THEN
- K(NSAV+2,1)=3
- K(NSAV+3,1)=3
- K(NSAV+2,4)=MSTU(5)*(NSAV+3)
- K(NSAV+2,5)=MSTU(5)*(NSAV+3)
- K(NSAV+3,4)=MSTU(5)*(NSAV+2)
- K(NSAV+3,5)=MSTU(5)*(NSAV+2)
- MSTJ(92)=NSAV+1
- ENDIF
-
-C...Mark decayed particle; special option for B-B~ mixing.
- IF(K(IP,1).EQ.5) K(IP,1)=15
- IF(K(IP,1).LE.10) K(IP,1)=11
- IF(MMIX.EQ.1.AND.MSTJ(26).EQ.2.AND.K(IP,1).EQ.11) K(IP,1)=12
- K(IP,4)=NSAV+1
- K(IP,5)=N
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUEDIT(MEDIT)
-
-C...Purpose: to perform global manipulations on the event record,
-C...in particular to exclude unstable or undetectable partons/particles.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
- DIMENSION NS(2),PTS(2),PLS(2)
-
-C...Remove unwanted partons/particles.
- IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN
- IMAX=N
- IF(MSTU(2).GT.0) IMAX=MSTU(2)
- I1=MAX(1,MSTU(1))-1
- DO 110 I=MAX(1,MSTU(1)),IMAX
- IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110
- IF(MEDIT.EQ.1) THEN
- IF(K(I,1).GT.10) GOTO 110
- ELSEIF(MEDIT.EQ.2) THEN
- IF(K(I,1).GT.10) GOTO 110
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18)
- & GOTO 110
- ELSEIF(MEDIT.EQ.3) THEN
- IF(K(I,1).GT.10) GOTO 110
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0) GOTO 110
- IF(KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) GOTO 110
- ELSEIF(MEDIT.EQ.5) THEN
- IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0) GOTO 110
- IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110
- ENDIF
-
-C...Pack remaining partons/particles. Origin no longer known.
- I1=I1+1
- DO 100 J=1,5
- K(I1,J)=K(I,J)
- P(I1,J)=P(I,J)
- V(I1,J)=V(I,J)
- 100 CONTINUE
- K(I1,3)=0
- 110 CONTINUE
- IF(I1.LT.N) MSTU(3)=0
- IF(I1.LT.N) MSTU(70)=0
- N=I1
-
-C...Selective removal of class of entries. New position of retained.
- ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN
- I1=0
- DO 120 I=1,N
- K(I,3)=MOD(K(I,3),MSTU(5))
- IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120
- IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120
- IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR.
- & K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120
- IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.
- & K(I,2).EQ.94)) GOTO 120
- IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120
- I1=I1+1
- K(I,3)=K(I,3)+MSTU(5)*I1
- 120 CONTINUE
-
-C...Find new event history information and replace old.
- DO 140 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140
- ID=I
- 130 IM=MOD(K(ID,3),MSTU(5))
- IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN
- IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND.
- & K(IM,2).NE.94) THEN
- ID=IM
- GOTO 130
- ENDIF
- ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN
- IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN
- ID=IM
- GOTO 130
- ENDIF
- ENDIF
- K(I,3)=MSTU(5)*(K(I,3)/MSTU(5))
- IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5)
- IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
- IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)=
- & K(K(I,4),3)/MSTU(5)
- IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)=
- & K(K(I,5),3)/MSTU(5)
- ELSE
- KCM=MOD(K(I,4)/MSTU(5),MSTU(5))
- IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
- KCD=MOD(K(I,4),MSTU(5))
- IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
- K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD
- KCM=MOD(K(I,5)/MSTU(5),MSTU(5))
- IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
- KCD=MOD(K(I,5),MSTU(5))
- IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
- K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD
- ENDIF
- 140 CONTINUE
-
-C...Pack remaining entries.
- I1=0
- MSTU90=MSTU(90)
- MSTU(90)=0
- DO 170 I=1,N
- IF(K(I,3)/MSTU(5).EQ.0) GOTO 170
- I1=I1+1
- DO 150 J=1,5
- K(I1,J)=K(I,J)
- P(I1,J)=P(I,J)
- V(I1,J)=V(I,J)
- 150 CONTINUE
- K(I1,3)=MOD(K(I1,3),MSTU(5))
- DO 160 IZ=1,MSTU90
- IF(I.EQ.MSTU(90+IZ)) THEN
- MSTU(90)=MSTU(90)+1
- MSTU(90+MSTU(90))=I1
- PARU(90+MSTU(90))=PARU(90+IZ)
- ENDIF
- 160 CONTINUE
- 170 CONTINUE
- IF(I1.LT.N) MSTU(3)=0
- IF(I1.LT.N) MSTU(70)=0
- N=I1
-
-C...Fill in some missing daughter pointers (lost in colour flow).
- ELSEIF(MEDIT.EQ.16) THEN
- DO 190 I=1,N
- IF(K(I,1).LE.10.OR.K(I,1).GT.20) GOTO 190
- IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 190
-C...Find daughters who point to mother.
- DO 180 I1=I+1,N
- IF(K(I1,3).NE.I) THEN
- ELSEIF(K(I,4).EQ.0) THEN
- K(I,4)=I1
- ELSE
- K(I,5)=I1
- ENDIF
- 180 CONTINUE
- IF(K(I,5).EQ.0) K(I,5)=K(I,4)
- IF(K(I,4).NE.0) GOTO 190
-C...Find daughters who point to documentation version of mother.
- IM=K(I,3)
- IF(IM.LE.0.OR.IM.GE.I) GOTO 190
- IF(K(IM,1).LE.20.OR.K(IM,1).GT.30) GOTO 190
- IF(K(IM,2).NE.K(I,2).OR.ABS(P(IM,5)-P(I,5)).GT.1E-2) GOTO 190
- DO 182 I1=I+1,N
- IF(K(I1,3).NE.IM) THEN
- ELSEIF(K(I,4).EQ.0) THEN
- K(I,4)=I1
- ELSE
- K(I,5)=I1
- ENDIF
- 182 CONTINUE
- IF(K(I,5).EQ.0) K(I,5)=K(I,4)
- IF(K(I,4).NE.0) GOTO 190
-C...Find daughters who point to documentation daughters who,
-C...in their turn, point to documentation mother.
- ID1=IM
- ID2=IM
- DO 184 I1=IM+1,I-1
- IF(K(I1,3).EQ.IM.AND.K(I1,1).GT.20.AND.K(I1,1).LE.30) THEN
- ID2=I1
- IF(ID1.EQ.IM) ID1=I1
- ENDIF
- 184 CONTINUE
- DO 186 I1=I+1,N
- IF(K(I1,3).NE.ID1.AND.K(I1,3).NE.ID2) THEN
- ELSEIF(K(I,4).EQ.0) THEN
- K(I,4)=I1
- ELSE
- K(I,5)=I1
- ENDIF
- 186 CONTINUE
- IF(K(I,5).EQ.0) K(I,5)=K(I,4)
- 190 CONTINUE
-
-C...Save top entries at bottom of LUJETS commonblock.
- ELSEIF(MEDIT.EQ.21) THEN
- IF(2*N.GE.MSTU(4)) THEN
- CALL LUERRM(11,'(LUEDIT:) no more memory left in LUJETS')
- RETURN
- ENDIF
- DO 210 I=1,N
- DO 200 J=1,5
- K(MSTU(4)-I,J)=K(I,J)
- P(MSTU(4)-I,J)=P(I,J)
- V(MSTU(4)-I,J)=V(I,J)
- 200 CONTINUE
- 210 CONTINUE
- MSTU(32)=N
-
-C...Restore bottom entries of commonblock LUJETS to top.
- ELSEIF(MEDIT.EQ.22) THEN
- DO 230 I=1,MSTU(32)
- DO 220 J=1,5
- K(I,J)=K(MSTU(4)-I,J)
- P(I,J)=P(MSTU(4)-I,J)
- V(I,J)=V(MSTU(4)-I,J)
- 220 CONTINUE
- 230 CONTINUE
- N=MSTU(32)
-
-C...Mark primary entries at top of commonblock LUJETS as untreated.
- ELSEIF(MEDIT.EQ.23) THEN
- I1=0
- DO 240 I=1,N
- KH=K(I,3)
- IF(KH.GE.1) THEN
- IF(K(KH,1).GT.20) KH=0
- ENDIF
- IF(KH.NE.0) GOTO 250
- I1=I1+1
- IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10
- 240 CONTINUE
- 250 N=I1
-
-C...Place largest axis along z axis and second largest in xy plane.
- ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN
- CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61),1),
- & P(MSTU(61),2)),0D0,0D0,0D0)
- CALL LUDBRB(1,N+MSTU(3),-ULANGL(P(MSTU(61),3),
- & P(MSTU(61),1)),0.,0D0,0D0,0D0)
- CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61)+1,1),
- & P(MSTU(61)+1,2)),0D0,0D0,0D0)
- IF(MEDIT.EQ.31) RETURN
-
-C...Rotate to put slim jet along +z axis.
- DO 260 IS=1,2
- NS(IS)=0
- PTS(IS)=0.
- PLS(IS)=0.
- 260 CONTINUE
- DO 270 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270
- IF(MSTU(41).GE.2) THEN
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
- & KC.EQ.18) GOTO 270
- IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
- & GOTO 270
- ENDIF
- IS=2.-SIGN(0.5,P(I,3))
- NS(IS)=NS(IS)+1
- PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2)
- 270 CONTINUE
- IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2)
- & CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0)
-
-C...Rotate to put second largest jet into -z,+x quadrant.
- DO 280 I=1,N
- IF(P(I,3).GE.0.) GOTO 280
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 280
- IF(MSTU(41).GE.2) THEN
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
- & KC.EQ.18) GOTO 280
- IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
- & GOTO 280
- ENDIF
- IS=2.-SIGN(0.5,P(I,1))
- PLS(IS)=PLS(IS)-P(I,3)
- 280 CONTINUE
- IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1),
- & 0D0,0D0,0D0)
- ENDIF
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUEEVT(KFL,ECM)
-
-C...Purpose: to handle the generation of an e+e- annihilation jet event.
- IMPLICIT DOUBLE PRECISION(D)
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Check input parameters.
- IF(MSTU(12).GE.1) CALL LULIST(0)
- IF(KFL.LT.0.OR.KFL.GT.8) THEN
- CALL LUERRM(16,'(LUEEVT:) called with unknown flavour code')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
- IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02*PARF(100+MAX(1,KFL))
- IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02*PMAS(KFL,1)
- IF(ECM.LT.ECMMIN) THEN
- CALL LUERRM(16,'(LUEEVT:) called with too small CM energy')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
-
-C...Check consistency of MSTJ options set.
- IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN
- CALL LUERRM(6,
- & '(LUEEVT:) MSTJ(109) value requires MSTJ(110) = 1')
- MSTJ(110)=1
- ENDIF
- IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN
- CALL LUERRM(6,
- & '(LUEEVT:) MSTJ(109) value requires MSTJ(111) = 0')
- MSTJ(111)=0
- ENDIF
-
-C...Initialize alpha_strong and total cross-section.
- MSTU(111)=MSTJ(108)
- IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
- &MSTU(111)=1
- PARU(112)=PARJ(121)
- IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
- IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE.
- &PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL LUXTOT(KFL,ECM,
- &XTOT)
- IF(MSTJ(116).GE.3) MSTJ(116)=1
- PARJ(171)=0.
-
-C...Add initial e+e- to event record (documentation only).
- NTRY=0
- 100 NTRY=NTRY+1
- IF(NTRY.GT.100) THEN
- CALL LUERRM(14,'(LUEEVT:) caught in an infinite loop')
- RETURN
- ENDIF
- MSTU(24)=0
- NC=0
- IF(MSTJ(115).GE.2) THEN
- NC=NC+2
- CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)
- K(NC-1,1)=21
- CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.)
- K(NC,1)=21
- ENDIF
-
-C...Radiative photon (in initial state).
- MK=0
- ECMC=ECM
- IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL LURADK(ECM,MK,PAK,
- &THEK,PHIK,ALPK)
- IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2.*PAK))
- IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN
- NC=NC+1
- CALL LU1ENT(NC,22,PAK,THEK,PHIK)
- K(NC,3)=MIN(MSTJ(115)/2,1)
- ENDIF
-
-C...Virtual exchange boson (gamma or Z0).
- IF(MSTJ(115).GE.3) THEN
- NC=NC+1
- KF=22
- IF(MSTJ(102).EQ.2) KF=23
- MSTU10=MSTU(10)
- MSTU(10)=1
- P(NC,5)=ECMC
- CALL LU1ENT(NC,KF,ECMC,0.,0.)
- K(NC,1)=21
- K(NC,3)=1
- MSTU(10)=MSTU10
- ENDIF
-
-C...Choice of flavour and jet configuration.
- CALL LUXKFL(KFL,ECM,ECMC,KFLC)
- IF(KFLC.EQ.0) GOTO 100
- CALL LUXJET(ECMC,NJET,CUT)
- KFLN=21
- IF(NJET.EQ.4) CALL LUX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4,
- &X12,X14)
- IF(NJET.EQ.3) CALL LUX3JT(NJET,CUT,KFLC,ECMC,X1,X3)
- IF(NJET.EQ.2) MSTJ(120)=1
-
-C...Fill jet configuration and origin.
- IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL LU2ENT(NC+1,KFLC,-KFLC,ECMC)
- IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL LU2ENT(-(NC+1),KFLC,-KFLC,
- &ECMC)
- IF(NJET.EQ.3) CALL LU3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3)
- IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL LU4ENT(NC+1,KFLC,KFLN,KFLN,
- &-KFLC,ECMC,X1,X2,X4,X12,X14)
- IF(NJET.EQ.4.AND.KFLN.NE.21) CALL LU4ENT(NC+1,KFLC,-KFLN,KFLN,
- &-KFLC,ECMC,X1,X2,X4,X12,X14)
- IF(MSTU(24).NE.0) GOTO 100
- DO 110 IP=NC+1,N
- K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1)
- 110 CONTINUE
-
-C...Angular orientation according to matrix element.
- IF(MSTJ(106).EQ.1) THEN
- CALL LUXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI)
- CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0)
- CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0)
- ENDIF
-
-C...Rotation and boost from radiative photon.
- IF(MK.EQ.1) THEN
- DBEK=-PAK/(ECM-PAK)
- NMIN=NC+1-MSTJ(115)/3
- CALL LUDBRB(NMIN,N,0.,-PHIK,0D0,0D0,0D0)
- CALL LUDBRB(NMIN,N,ALPK,0.,DBEK*SIN(THEK),0D0,DBEK*COS(THEK))
- CALL LUDBRB(NMIN,N,0.,PHIK,0D0,0D0,0D0)
- ENDIF
-
-C...Generate parton shower. Rearrange along strings and check.
- IF(MSTJ(101).EQ.5) THEN
- CALL LUSHOW(N-1,N,ECMC)
- MSTJ14=MSTJ(14)
- IF(MSTJ(105).EQ.-1) MSTJ(14)=-1
- IF(MSTJ(105).GE.0) MSTU(28)=0
- CALL LUPREP(0)
- MSTJ(14)=MSTJ14
- IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
- ENDIF
-
-C...Fragmentation/decay generation. Information for LUTABU.
- IF(MSTJ(105).EQ.1) CALL LUEXEC
- MSTU(161)=KFLC
- MSTU(162)=-KFLC
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUERRM(MERR,CHMESS)
-
-C...Purpose: to inform user of errors in program execution.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- SAVE /LUJETS/,/LUDAT1/
- CHARACTER CHMESS*(*)
-
-C...Write first few warnings, then be silent.
- IF(MERR.LE.10) THEN
- MSTU(27)=MSTU(27)+1
- MSTU(28)=MERR
- IF(MSTU(25).EQ.1.AND.MSTU(27).LE.MSTU(26)) WRITE(MSTU(11),5000)
- & MERR,MSTU(31),CHMESS
-
-C...Write first few errors, then be silent or stop program.
- ELSEIF(MERR.LE.20) THEN
- MSTU(23)=MSTU(23)+1
- MSTU(24)=MERR-10
- IF(MSTU(21).GE.1.AND.MSTU(23).LE.MSTU(22)) WRITE(MSTU(11),5100)
- & MERR-10,MSTU(31),CHMESS
- IF(MSTU(21).GE.2.AND.MSTU(23).GT.MSTU(22)) THEN
- WRITE(MSTU(11),5100) MERR-10,MSTU(31),CHMESS
- WRITE(MSTU(11),5200)
- IF(MERR.NE.17) CALL LULIST(2)
- STOP
- ENDIF
-
-C...Stop program in case of irreparable error.
- ELSE
- WRITE(MSTU(11),5300) MERR-20,MSTU(31),CHMESS
- STOP
- ENDIF
-
-C...Formats for output.
- 5000 FORMAT(/5X,'Advisory warning type',I2,' given after',I6,
- &' LUEXEC calls:'/5X,A)
- 5100 FORMAT(/5X,'Error type',I2,' has occured after',I6,
- &' LUEXEC calls:'/5X,A)
- 5200 FORMAT(5X,'Execution will be stopped after listing of last ',
- &'event!')
- 5300 FORMAT(/5X,'Fatal error type',I2,' has occured after',I6,
- &' LUEXEC calls:'/5X,A/5X,'Execution will now be stopped!')
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUEXEC
-
-C...Purpose: to administrate the fragmentation and decay chain.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
- DIMENSION PS(2,6)
-
-C...Initialize and reset.
- MSTU(24)=0
- IF(MSTU(12).GE.1) CALL LULIST(0)
- MSTU(31)=MSTU(31)+1
- MSTU(1)=0
- MSTU(2)=0
- MSTU(3)=0
- IF(MSTU(17).LE.0) MSTU(90)=0
- MCONS=1
-
-C...Sum up momentum, energy and charge for starting entries.
- NSAV=N
- DO 110 I=1,2
- DO 100 J=1,6
- PS(I,J)=0.
- 100 CONTINUE
- 110 CONTINUE
- DO 130 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 130
- DO 120 J=1,4
- PS(1,J)=PS(1,J)+P(I,J)
- 120 CONTINUE
- PS(1,6)=PS(1,6)+LUCHGE(K(I,2))
- 130 CONTINUE
- PARU(21)=PS(1,4)
-
-C...Prepare system for subsequent fragmentation/decay.
- CALL LUPREP(0)
-
-C...Loop through jet fragmentation and particle decays.
- MBE=0
- 140 MBE=MBE+1
- IP=0
- 150 IP=IP+1
- KC=0
- IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=LUCOMP(K(IP,2))
- IF(KC.EQ.0) THEN
-
-C...Particle decay if unstable and allowed. Save long-lived particle
-C...decays until second pass after Bose-Einstein effects.
- ELSEIF(KCHG(KC,2).EQ.0) THEN
- IF(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1.AND.(MSTJ(51).LE.0.OR.MBE
- & .EQ.2.OR.PMAS(KC,2).GE.PARJ(91).OR.IABS(K(IP,2)).EQ.311))
- & CALL LUDECY(IP)
-
-C...Decay products may develop a shower.
- IF(MSTJ(92).GT.0) THEN
- IP1=MSTJ(92)
- QMAX=SQRT(MAX(0.,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1,
- & 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2))
- CALL LUSHOW(IP1,IP1+1,QMAX)
- CALL LUPREP(IP1)
- MSTJ(92)=0
- ELSEIF(MSTJ(92).LT.0) THEN
- IP1=-MSTJ(92)
- CALL LUSHOW(IP1,-3,P(IP,5))
- CALL LUPREP(IP1)
- MSTJ(92)=0
- ENDIF
-
-C...Jet fragmentation: string or independent fragmentation.
- ELSEIF(K(IP,1).EQ.1.OR.K(IP,1).EQ.2) THEN
- MFRAG=MSTJ(1)
- IF(MFRAG.GE.1.AND.K(IP,1).EQ.1) MFRAG=2
- IF(MSTJ(21).GE.2.AND.K(IP,1).EQ.2.AND.N.GT.IP) THEN
- IF(K(IP+1,1).EQ.1.AND.K(IP+1,3).EQ.K(IP,3).AND.
- & K(IP,3).GT.0.AND.K(IP,3).LT.IP) THEN
- IF(KCHG(LUCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG)
- ENDIF
- ENDIF
- IF(MFRAG.EQ.1) CALL LUSTRF(IP)
- IF(MFRAG.EQ.2) CALL LUINDF(IP)
- IF(MFRAG.EQ.2.AND.K(IP,1).EQ.1) MCONS=0
- IF(MFRAG.EQ.2.AND.(MSTJ(3).LE.0.OR.MOD(MSTJ(3),5).EQ.0)) MCONS=0
- ENDIF
-
-C...Loop back if enough space left in LUJETS and no error abort.
- IF(MSTU(24).NE.0.AND.MSTU(21).GE.2) THEN
- ELSEIF(IP.LT.N.AND.N.LT.MSTU(4)-20-MSTU(32)) THEN
- GOTO 150
- ELSEIF(IP.LT.N) THEN
- CALL LUERRM(11,'(LUEXEC:) no more memory left in LUJETS')
- ENDIF
-
-C...Include simple Bose-Einstein effect parametrization if desired.
- IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN
- CALL LUBOEI(NSAV)
- GOTO 140
- ENDIF
-
-C...Check that momentum, energy and charge were conserved.
- DO 170 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170
- DO 160 J=1,4
- PS(2,J)=PS(2,J)+P(I,J)
- 160 CONTINUE
- PS(2,6)=PS(2,6)+LUCHGE(K(I,2))
- 170 CONTINUE
- PDEV=(ABS(PS(2,1)-PS(1,1))+ABS(PS(2,2)-PS(1,2))+ABS(PS(2,3)-
- &PS(1,3))+ABS(PS(2,4)-PS(1,4)))/(1.+ABS(PS(2,4))+ABS(PS(1,4)))
- IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL LUERRM(15,
- &'(LUEXEC:) four-momentum was not conserved')
- IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1) CALL LUERRM(15,
- &'(LUEXEC:) charge was not conserved')
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUFOWO(H10,H20,H30,H40)
-
-C...Purpose: to calculate the first few Fox-Wolfram moments.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Copy momenta for particles and calculate H0.
- NP=0
- H0=0.
- HD=0.
- DO 110 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110
- IF(MSTU(41).GE.2) THEN
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
- & KC.EQ.18) GOTO 110
- IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
- & GOTO 110
- ENDIF
- IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN
- CALL LUERRM(11,'(LUFOWO:) no more memory left in LUJETS')
- H10=-1.
- H20=-1.
- H30=-1.
- H40=-1.
- RETURN
- ENDIF
- NP=NP+1
- DO 100 J=1,3
- P(N+NP,J)=P(I,J)
- 100 CONTINUE
- P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
- H0=H0+P(N+NP,4)
- HD=HD+P(N+NP,4)**2
- 110 CONTINUE
- H0=H0**2
-
-C...Very low multiplicities (0 or 1) not considered.
- IF(NP.LE.1) THEN
- CALL LUERRM(8,'(LUFOWO:) too few particles for analysis')
- H10=-1.
- H20=-1.
- H30=-1.
- H40=-1.
- RETURN
- ENDIF
-
-C...Calculate H1 - H4.
- H10=0.
- H20=0.
- H30=0.
- H40=0.
- DO 130 I1=N+1,N+NP
- DO 120 I2=I1+1,N+NP
- CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/
- &(P(I1,4)*P(I2,4))
- H10=H10+P(I1,4)*P(I2,4)*CTHE
- H20=H20+P(I1,4)*P(I2,4)*(1.5*CTHE**2-0.5)
- H30=H30+P(I1,4)*P(I2,4)*(2.5*CTHE**3-1.5*CTHE)
- H40=H40+P(I1,4)*P(I2,4)*(4.375*CTHE**4-3.75*CTHE**2+0.375)
- 120 CONTINUE
- 130 CONTINUE
-
-C...Calculate H1/H0 - H4/H0. Output.
- MSTU(61)=N+1
- MSTU(62)=NP
- H10=(HD+2.*H10)/H0
- H20=(HD+2.*H20)/H0
- H30=(HD+2.*H30)/H0
- H40=(HD+2.*H40)/H0
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUGIVE(CHIN)
-
-C...Purpose: to set values of commonblock variables (also in PYTHIA!).
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
- COMMON/LUDAT4/CHAF(500)
- CHARACTER CHAF*8
- COMMON/LUDATR/MRLU(6),RRLU(100)
- COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
- COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
- COMMON/PYINT1/MINT(400),VINT(400)
- COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
- COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
- COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
- COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
- COMMON/PYINT6/PROC(0:200)
- COMMON/PYINT7/SIGT(0:6,0:6,0:5)
- CHARACTER PROC*28
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/
- SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,
- &/PYINT5/,/PYINT6/,/PYINT7/
- CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28,
- &CHNEW2*28,CHNAM*4,CHVAR(43)*4,CHALP(2)*26,CHIND*8,CHINI*10,
- &CHINR*16
- DIMENSION MSVAR(43,8)
-
-C...For each variable to be translated give: name,
-C...integer/real/character, no. of indices, lower&upper index bounds.
- DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
- &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRLU',
- &'RRLU','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI',
- &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH',
- &'WIDP','WIDE','WIDS','NGEN','XSEC','PROC','SIGT'/
- DATA ((MSVAR(I,J),J=1,8),I=1,43)/ 1,7*0, 1,2,1,4000,1,5,2*0,
- & 2,2,1,4000,1,5,2*0, 2,2,1,4000,1,5,2*0, 1,1,1,200,4*0,
- & 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
- & 1,2,1,500,1,3,2*0, 2,2,1,500,1,4,2*0, 2,1,1,2000,4*0,
- & 2,2,1,4,1,4,2*0, 1,2,1,500,1,3,2*0, 1,2,1,2000,1,2,2*0,
- & 2,1,1,2000,4*0, 1,2,1,2000,1,5,2*0, 3,1,1,500,4*0,
- & 1,1,1,6,4*0, 2,1,1,100,4*0,
- & 1,7*0, 1,1,1,200,4*0, 1,2,1,2,-40,40,2*0, 2,1,1,200,4*0,
- & 1,1,1,200,4*0, 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
- & 1,1,1,400,4*0, 2,1,1,400,4*0, 1,1,1,200,4*0,
- & 1,2,1,200,1,2,2*0, 2,2,1,200,1,20,2*0, 1,3,1,40,1,4,1,2,
- & 2,2,1,2,-40,40,2*0, 1,2,1,1000,1,3,2*0, 2,1,1,1000,4*0,
- & 2,2,21,40,0,40,2*0, 2,2,21,40,0,40,2*0, 2,2,21,40,1,3,2*0,
- & 1,2,0,200,1,3,2*0, 2,2,0,200,1,3,2*0, 4,1,0,200,4*0,
- & 2,3,0,6,0,6,0,5/
- DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
- &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
-
-C...Length of character variable. Subdivide it into instructions.
- IF(MSTU(12).GE.1) CALL LULIST(0)
- CHBIT=CHIN//' '
- LBIT=101
- 100 LBIT=LBIT-1
- IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100
- LTOT=0
- DO 110 LCOM=1,LBIT
- IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110
- LTOT=LTOT+1
- CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM)
- 110 CONTINUE
- LLOW=0
- 120 LHIG=LLOW+1
- 130 LHIG=LHIG+1
- IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130
- LBIT=LHIG-LLOW-1
- CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1)
-
-C...Identify commonblock variable.
- LNAM=1
- 140 LNAM=LNAM+1
- IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND.
- &LNAM.LE.4) GOTO 140
- CHNAM=CHBIT(1:LNAM-1)//' '
- DO 160 LCOM=1,LNAM-1
- DO 150 LALP=1,26
- IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)=
- &CHALP(2)(LALP:LALP)
- 150 CONTINUE
- 160 CONTINUE
- IVAR=0
- DO 170 IV=1,43
- IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV
- 170 CONTINUE
- IF(IVAR.EQ.0) THEN
- CALL LUERRM(18,'(LUGIVE:) do not recognize variable '//CHNAM)
- LLOW=LHIG
- IF(LLOW.LT.LTOT) GOTO 120
- RETURN
- ENDIF
-
-C...Identify any indices.
- I1=0
- I2=0
- I3=0
- NINDX=0
- IF(CHBIT(LNAM:LNAM).EQ.'(') THEN
- LIND=LNAM
- 180 LIND=LIND+1
- IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180
- CHIND=' '
- IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c').
- & AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN
- CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1)
- READ(CHIND,'(I8)') KF
- I1=LUCOMP(KF)
- ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.
- & 'c') THEN
- CALL LUERRM(18,'(LUGIVE:) not allowed to use C index for '//
- & CHNAM)
- LLOW=LHIG
- IF(LLOW.LT.LTOT) GOTO 120
- RETURN
- ELSE
- CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
- READ(CHIND,'(I8)') I1
- ENDIF
- LNAM=LIND
- IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
- NINDX=1
- ENDIF
- IF(CHBIT(LNAM:LNAM).EQ.',') THEN
- LIND=LNAM
- 190 LIND=LIND+1
- IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190
- CHIND=' '
- CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
- READ(CHIND,'(I8)') I2
- LNAM=LIND
- IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
- NINDX=2
- ENDIF
- IF(CHBIT(LNAM:LNAM).EQ.',') THEN
- LIND=LNAM
- 200 LIND=LIND+1
- IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 200
- CHIND=' '
- CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
- READ(CHIND,'(I8)') I3
- LNAM=LIND+1
- NINDX=3
- ENDIF
-
-C...Check that indices allowed.
- IERR=0
- IF(NINDX.NE.MSVAR(IVAR,2)) IERR=1
- IF(NINDX.GE.1.AND.(I1.LT.MSVAR(IVAR,3).OR.I1.GT.MSVAR(IVAR,4)))
- &IERR=2
- IF(NINDX.GE.2.AND.(I2.LT.MSVAR(IVAR,5).OR.I2.GT.MSVAR(IVAR,6)))
- &IERR=3
- IF(NINDX.EQ.3.AND.(I3.LT.MSVAR(IVAR,7).OR.I3.GT.MSVAR(IVAR,8)))
- &IERR=4
- IF(CHBIT(LNAM:LNAM).NE.'=') IERR=5
- IF(IERR.GE.1) THEN
- CALL LUERRM(18,'(LUGIVE:) unallowed indices for '//
- & CHBIT(1:LNAM-1))
- LLOW=LHIG
- IF(LLOW.LT.LTOT) GOTO 120
- RETURN
- ENDIF
-
-C...Save old value of variable.
- IF(IVAR.EQ.1) THEN
- IOLD=N
- ELSEIF(IVAR.EQ.2) THEN
- IOLD=K(I1,I2)
- ELSEIF(IVAR.EQ.3) THEN
- ROLD=P(I1,I2)
- ELSEIF(IVAR.EQ.4) THEN
- ROLD=V(I1,I2)
- ELSEIF(IVAR.EQ.5) THEN
- IOLD=MSTU(I1)
- ELSEIF(IVAR.EQ.6) THEN
- ROLD=PARU(I1)
- ELSEIF(IVAR.EQ.7) THEN
- IOLD=MSTJ(I1)
- ELSEIF(IVAR.EQ.8) THEN
- ROLD=PARJ(I1)
- ELSEIF(IVAR.EQ.9) THEN
- IOLD=KCHG(I1,I2)
- ELSEIF(IVAR.EQ.10) THEN
- ROLD=PMAS(I1,I2)
- ELSEIF(IVAR.EQ.11) THEN
- ROLD=PARF(I1)
- ELSEIF(IVAR.EQ.12) THEN
- ROLD=VCKM(I1,I2)
- ELSEIF(IVAR.EQ.13) THEN
- IOLD=MDCY(I1,I2)
- ELSEIF(IVAR.EQ.14) THEN
- IOLD=MDME(I1,I2)
- ELSEIF(IVAR.EQ.15) THEN
- ROLD=BRAT(I1)
- ELSEIF(IVAR.EQ.16) THEN
- IOLD=KFDP(I1,I2)
- ELSEIF(IVAR.EQ.17) THEN
- CHOLD=CHAF(I1)
- ELSEIF(IVAR.EQ.18) THEN
- IOLD=MRLU(I1)
- ELSEIF(IVAR.EQ.19) THEN
- ROLD=RRLU(I1)
- ELSEIF(IVAR.EQ.20) THEN
- IOLD=MSEL
- ELSEIF(IVAR.EQ.21) THEN
- IOLD=MSUB(I1)
- ELSEIF(IVAR.EQ.22) THEN
- IOLD=KFIN(I1,I2)
- ELSEIF(IVAR.EQ.23) THEN
- ROLD=CKIN(I1)
- ELSEIF(IVAR.EQ.24) THEN
- IOLD=MSTP(I1)
- ELSEIF(IVAR.EQ.25) THEN
- ROLD=PARP(I1)
- ELSEIF(IVAR.EQ.26) THEN
- IOLD=MSTI(I1)
- ELSEIF(IVAR.EQ.27) THEN
- ROLD=PARI(I1)
- ELSEIF(IVAR.EQ.28) THEN
- IOLD=MINT(I1)
- ELSEIF(IVAR.EQ.29) THEN
- ROLD=VINT(I1)
- ELSEIF(IVAR.EQ.30) THEN
- IOLD=ISET(I1)
- ELSEIF(IVAR.EQ.31) THEN
- IOLD=KFPR(I1,I2)
- ELSEIF(IVAR.EQ.32) THEN
- ROLD=COEF(I1,I2)
- ELSEIF(IVAR.EQ.33) THEN
- IOLD=ICOL(I1,I2,I3)
- ELSEIF(IVAR.EQ.34) THEN
- ROLD=XSFX(I1,I2)
- ELSEIF(IVAR.EQ.35) THEN
- IOLD=ISIG(I1,I2)
- ELSEIF(IVAR.EQ.36) THEN
- ROLD=SIGH(I1)
- ELSEIF(IVAR.EQ.37) THEN
- ROLD=WIDP(I1,I2)
- ELSEIF(IVAR.EQ.38) THEN
- ROLD=WIDE(I1,I2)
- ELSEIF(IVAR.EQ.39) THEN
- ROLD=WIDS(I1,I2)
- ELSEIF(IVAR.EQ.40) THEN
- IOLD=NGEN(I1,I2)
- ELSEIF(IVAR.EQ.41) THEN
- ROLD=XSEC(I1,I2)
- ELSEIF(IVAR.EQ.42) THEN
- CHOLD2=PROC(I1)
- ELSEIF(IVAR.EQ.43) THEN
- ROLD=SIGT(I1,I2,I3)
- ENDIF
-
-C...Print current value of variable. Loop back.
- IF(LNAM.GE.LBIT) THEN
- CHBIT(LNAM:14)=' '
- CHBIT(15:60)=' has the value '
- IF(MSVAR(IVAR,1).EQ.1) THEN
- WRITE(CHBIT(51:60),'(I10)') IOLD
- ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
- WRITE(CHBIT(47:60),'(F14.5)') ROLD
- ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
- CHBIT(53:60)=CHOLD
- ELSE
- CHBIT(33:60)=CHOLD
- ENDIF
- IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
- LLOW=LHIG
- IF(LLOW.LT.LTOT) GOTO 120
- RETURN
- ENDIF
-
-C...Read in new variable value.
- IF(MSVAR(IVAR,1).EQ.1) THEN
- CHINI=' '
- CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT)
- READ(CHINI,'(I10)') INEW
- ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
- CHINR=' '
- CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT)
- READ(CHINR,'(F16.2)') RNEW
- ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
- CHNEW=CHBIT(LNAM+1:LBIT)//' '
- ELSE
- CHNEW2=CHBIT(LNAM+1:LBIT)//' '
- ENDIF
-
-C...Store new variable value.
- IF(IVAR.EQ.1) THEN
- N=INEW
- ELSEIF(IVAR.EQ.2) THEN
- K(I1,I2)=INEW
- ELSEIF(IVAR.EQ.3) THEN
- P(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.4) THEN
- V(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.5) THEN
- MSTU(I1)=INEW
- ELSEIF(IVAR.EQ.6) THEN
- PARU(I1)=RNEW
- ELSEIF(IVAR.EQ.7) THEN
- MSTJ(I1)=INEW
- ELSEIF(IVAR.EQ.8) THEN
- PARJ(I1)=RNEW
- ELSEIF(IVAR.EQ.9) THEN
- KCHG(I1,I2)=INEW
- ELSEIF(IVAR.EQ.10) THEN
- PMAS(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.11) THEN
- PARF(I1)=RNEW
- ELSEIF(IVAR.EQ.12) THEN
- VCKM(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.13) THEN
- MDCY(I1,I2)=INEW
- ELSEIF(IVAR.EQ.14) THEN
- MDME(I1,I2)=INEW
- ELSEIF(IVAR.EQ.15) THEN
- BRAT(I1)=RNEW
- ELSEIF(IVAR.EQ.16) THEN
- KFDP(I1,I2)=INEW
- ELSEIF(IVAR.EQ.17) THEN
- CHAF(I1)=CHNEW
- ELSEIF(IVAR.EQ.18) THEN
- MRLU(I1)=INEW
- ELSEIF(IVAR.EQ.19) THEN
- RRLU(I1)=RNEW
- ELSEIF(IVAR.EQ.20) THEN
- MSEL=INEW
- ELSEIF(IVAR.EQ.21) THEN
- MSUB(I1)=INEW
- ELSEIF(IVAR.EQ.22) THEN
- KFIN(I1,I2)=INEW
- ELSEIF(IVAR.EQ.23) THEN
- CKIN(I1)=RNEW
- ELSEIF(IVAR.EQ.24) THEN
- MSTP(I1)=INEW
- ELSEIF(IVAR.EQ.25) THEN
- PARP(I1)=RNEW
- ELSEIF(IVAR.EQ.26) THEN
- MSTI(I1)=INEW
- ELSEIF(IVAR.EQ.27) THEN
- PARI(I1)=RNEW
- ELSEIF(IVAR.EQ.28) THEN
- MINT(I1)=INEW
- ELSEIF(IVAR.EQ.29) THEN
- VINT(I1)=RNEW
- ELSEIF(IVAR.EQ.30) THEN
- ISET(I1)=INEW
- ELSEIF(IVAR.EQ.31) THEN
- KFPR(I1,I2)=INEW
- ELSEIF(IVAR.EQ.32) THEN
- COEF(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.33) THEN
- ICOL(I1,I2,I3)=INEW
- ELSEIF(IVAR.EQ.34) THEN
- XSFX(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.35) THEN
- ISIG(I1,I2)=INEW
- ELSEIF(IVAR.EQ.36) THEN
- SIGH(I1)=RNEW
- ELSEIF(IVAR.EQ.37) THEN
- WIDP(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.38) THEN
- WIDE(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.39) THEN
- WIDS(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.40) THEN
- NGEN(I1,I2)=INEW
- ELSEIF(IVAR.EQ.41) THEN
- XSEC(I1,I2)=RNEW
- ELSEIF(IVAR.EQ.42) THEN
- PROC(I1)=CHNEW2
- ELSEIF(IVAR.EQ.43) THEN
- SIGT(I1,I2,I3)=RNEW
- ENDIF
-
-C...Write old and new value. Loop back.
- CHBIT(LNAM:14)=' '
- CHBIT(15:60)=' changed from to '
- IF(MSVAR(IVAR,1).EQ.1) THEN
- WRITE(CHBIT(33:42),'(I10)') IOLD
- WRITE(CHBIT(51:60),'(I10)') INEW
- IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
- ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
- WRITE(CHBIT(29:42),'(F14.5)') ROLD
- WRITE(CHBIT(47:60),'(F14.5)') RNEW
- IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
- ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
- CHBIT(35:42)=CHOLD
- CHBIT(53:60)=CHNEW
- IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
- ELSE
- CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2
- IF(MSTU(13).GE.1) WRITE(MSTU(11),5100) CHBIT(1:88)
- ENDIF
- LLOW=LHIG
- IF(LLOW.LT.LTOT) GOTO 120
-
-C...Format statement for output on unit MSTU(11) (by default 6).
- 5000 FORMAT(5X,A60)
- 5100 FORMAT(5X,A88)
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUHEPC(MCONV)
-
-C...Purpose: to convert JETSET event record contents to or from
-C...the standard event record commonblock.
-C...Note that HEPEVT is in double precision according to LEP 2 standard.
- PARAMETER (NMXHEP=2000)
- COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
- &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
- DOUBLE PRECISION PHEP,VHEP
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /HEPEVT/
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Conversion from JETSET to standard, the easy part.
- IF(MCONV.EQ.1) THEN
- NEVHEP=0
- IF(N.GT.NMXHEP) CALL LUERRM(8,
- & '(LUHEPC:) no more space in /HEPEVT/')
- NHEP=MIN(N,NMXHEP)
- DO 140 I=1,NHEP
- ISTHEP(I)=0
- IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1
- IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2
- IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3
- IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)
- IDHEP(I)=K(I,2)
- JMOHEP(1,I)=K(I,3)
- JMOHEP(2,I)=0
- IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
- JDAHEP(1,I)=K(I,4)
- JDAHEP(2,I)=K(I,5)
- ELSE
- JDAHEP(1,I)=0
- JDAHEP(2,I)=0
- ENDIF
- DO 100 J=1,5
- PHEP(J,I)=P(I,J)
- 100 CONTINUE
- DO 110 J=1,4
- VHEP(J,I)=V(I,J)
- 110 CONTINUE
-
-C...Check if new event (from pileup).
- IF(I.EQ.1) THEN
- INEW=1
- ELSE
- IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I
- ENDIF
-
-C...Fill in missing mother information.
- IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN
- IMO1=I-2
- IF(I.GE.INEW+3.AND.K(I-1,1).EQ.21.AND.K(I-1,3).EQ.0)
- & IMO1=IMO1-1
- JMOHEP(1,I)=IMO1
- JMOHEP(2,I)=IMO1+1
- ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN
- I1=K(I,3)-1
- 120 I1=I1+1
- IF(I1.GE.I) CALL LUERRM(8,
- & '(LUHEPC:) translation of inconsistent event history')
- IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120
- KC=LUCOMP(K(I1,2))
- IF(I1.LT.I.AND.KC.EQ.0) GOTO 120
- IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120
- JMOHEP(2,I)=I1
- ELSEIF(K(I,2).EQ.94) THEN
- NJET=2
- IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3
- IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4
- JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5))
- IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)=
- & MOD(K(I+1,4)/MSTU(5),MSTU(5))
- ENDIF
-
-C...Fill in missing daughter information.
- IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN
- DO 130 I1=JDAHEP(1,I),JDAHEP(2,I)
- I2=MOD(K(I1,4)/MSTU(5),MSTU(5))
- JDAHEP(1,I2)=I
- 130 CONTINUE
- ENDIF
- IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140
- I1=JMOHEP(1,I)
- IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140
- IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140
- IF(JDAHEP(1,I1).EQ.0) THEN
- JDAHEP(1,I1)=I
- ELSE
- JDAHEP(2,I1)=I
- ENDIF
- 140 CONTINUE
- DO 150 I=1,NHEP
- IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150
- IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I)
- 150 CONTINUE
-
-C...Conversion from standard to JETSET, the easy part.
- ELSE
- IF(NHEP.GT.MSTU(4)) CALL LUERRM(8,
- & '(LUHEPC:) no more space in /LUJETS/')
- N=MIN(NHEP,MSTU(4))
- NKQ=0
- KQSUM=0
- DO 180 I=1,N
- K(I,1)=0
- IF(ISTHEP(I).EQ.1) K(I,1)=1
- IF(ISTHEP(I).EQ.2) K(I,1)=11
- IF(ISTHEP(I).EQ.3) K(I,1)=21
- K(I,2)=IDHEP(I)
- K(I,3)=JMOHEP(1,I)
- K(I,4)=JDAHEP(1,I)
- K(I,5)=JDAHEP(2,I)
- DO 160 J=1,5
- P(I,J)=PHEP(J,I)
- 160 CONTINUE
- DO 170 J=1,4
- V(I,J)=VHEP(J,I)
- 170 CONTINUE
- V(I,5)=0.
- IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN
- I1=JDAHEP(1,I)
- IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*
- & PHEP(5,I)/PHEP(4,I)
- ENDIF
-
-C...Fill in missing information on colour connection in jet systems.
- IF(ISTHEP(I).EQ.1) THEN
- KC=LUCOMP(K(I,2))
- KQ=0
- IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
- IF(KQ.NE.0) NKQ=NKQ+1
- IF(KQ.NE.2) KQSUM=KQSUM+KQ
- IF(KQ.NE.0.AND.KQSUM.NE.0) THEN
- K(I,1)=2
- ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN
- IF(K(I+1,2).EQ.21) K(I,1)=2
- ENDIF
- ENDIF
- 180 CONTINUE
- IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LUERRM(8,
- & '(LUHEPC:) input parton configuration not colour singlet')
- ENDIF
-
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUINDF(IP)
-
-C...Purpose: to handle the fragmentation of a jet system (or a single
-C...jet) according to independent fragmentation models.
- IMPLICIT DOUBLE PRECISION(D)
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
- DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3),
- &KFLO(2),PXO(2),PYO(2),WO(2)
-
-C...Reset counters. Identify parton system and take copy. Check flavour.
- NSAV=N
- MSTU90=MSTU(90)
- NJET=0
- KQSUM=0
- DO 100 J=1,5
- DPS(J)=0.
- 100 CONTINUE
- I=IP-1
- 110 I=I+1
- IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN
- CALL LUERRM(12,'(LUINDF:) failed to reconstruct jet system')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
- IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0) GOTO 110
- KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
- IF(KQ.EQ.0) GOTO 110
- NJET=NJET+1
- IF(KQ.NE.2) KQSUM=KQSUM+KQ
- DO 120 J=1,5
- K(NSAV+NJET,J)=K(I,J)
- P(NSAV+NJET,J)=P(I,J)
- DPS(J)=DPS(J)+P(I,J)
- 120 CONTINUE
- K(NSAV+NJET,3)=I
- IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND.
- &K(I+1,1).EQ.2)) GOTO 110
- IF(NJET.NE.1.AND.KQSUM.NE.0) THEN
- CALL LUERRM(12,'(LUINDF:) unphysical flavour combination')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
-
-C...Boost copied system to CM frame. Find CM energy and sum flavours.
- IF(NJET.NE.1) THEN
- MSTU(33)=1
- CALL LUDBRB(NSAV+1,NSAV+NJET,0.,0.,-DPS(1)/DPS(4),
- & -DPS(2)/DPS(4),-DPS(3)/DPS(4))
- ENDIF
- PECM=0.
- DO 130 J=1,3
- NFI(J)=0
- 130 CONTINUE
- DO 140 I=NSAV+1,NSAV+NJET
- PECM=PECM+P(I,4)
- KFA=IABS(K(I,2))
- IF(KFA.LE.3) THEN
- NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2))
- ELSEIF(KFA.GT.1000) THEN
- KFLA=MOD(KFA/1000,10)
- KFLB=MOD(KFA/100,10)
- IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2))
- IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2))
- ENDIF
- 140 CONTINUE
-
-C...Loop over attempts made. Reset counters.
- NTRY=0
- 150 NTRY=NTRY+1
- IF(NTRY.GT.200) THEN
- CALL LUERRM(14,'(LUINDF:) caught in infinite loop')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
- N=NSAV+NJET
- MSTU(90)=MSTU90
- DO 160 J=1,3
- NFL(J)=NFI(J)
- IFET(J)=0
- KFLF(J)=0
- 160 CONTINUE
-
-C...Loop over jets to be fragmented.
- DO 230 IP1=NSAV+1,NSAV+NJET
- MSTJ(91)=0
- NSAV1=N
- MSTU91=MSTU(90)
-
-C...Initial flavour and momentum values. Jet along +z axis.
- KFLH=IABS(K(IP1,2))
- IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10)
- KFLO(2)=0
- WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2)
-
-C...Initial values for quark or diquark jet.
- 170 IF(IABS(K(IP1,2)).NE.21) THEN
- NSTR=1
- KFLO(1)=K(IP1,2)
- CALL LUPTDI(0,PXO(1),PYO(1))
- WO(1)=WF
-
-C...Initial values for gluon treated like random quark jet.
- ELSEIF(MSTJ(2).LE.2) THEN
- NSTR=1
- IF(MSTJ(2).EQ.2) MSTJ(91)=1
- KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)
- CALL LUPTDI(0,PXO(1),PYO(1))
- WO(1)=WF
-
-C...Initial values for gluon treated like quark-antiquark jet pair,
-C...sharing energy according to Altarelli-Parisi splitting function.
- ELSE
- NSTR=2
- IF(MSTJ(2).EQ.4) MSTJ(91)=1
- KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)
- KFLO(2)=-KFLO(1)
- CALL LUPTDI(0,PXO(1),PYO(1))
- PXO(2)=-PXO(1)
- PYO(2)=-PYO(1)
- WO(1)=WF*RLU(0)**(1./3.)
- WO(2)=WF-WO(1)
- ENDIF
-
-C...Initial values for rank, flavour, pT and W+.
- DO 220 ISTR=1,NSTR
- 180 I=N
- MSTU(90)=MSTU91
- IRANK=0
- KFL1=KFLO(ISTR)
- PX1=PXO(ISTR)
- PY1=PYO(ISTR)
- W=WO(ISTR)
-
-C...New hadron. Generate flavour and hadron species.
- 190 I=I+1
- IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN
- CALL LUERRM(11,'(LUINDF:) no more memory left in LUJETS')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
- IRANK=IRANK+1
- K(I,1)=1
- K(I,3)=IP1
- K(I,4)=0
- K(I,5)=0
- 200 CALL LUKFDI(KFL1,0,KFL2,K(I,2))
- IF(K(I,2).EQ.0) GOTO 180
- IF(MSTJ(12).GE.3.AND.IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND.
- &IABS(KFL2).GT.10) THEN
- IF(RLU(0).GT.PARJ(19)) GOTO 200
- ENDIF
-
-C...Find hadron mass. Generate four-momentum.
- P(I,5)=ULMASS(K(I,2))
- CALL LUPTDI(KFL1,PX2,PY2)
- P(I,1)=PX1+PX2
- P(I,2)=PY1+PY2
- PR=P(I,5)**2+P(I,1)**2+P(I,2)**2
- CALL LUZDIS(KFL1,KFL2,PR,Z)
- MZSAV=0
- IF(IABS(KFL1).GE.4.AND.IABS(KFL1).LE.8.AND.MSTU(90).LT.8) THEN
- MZSAV=1
- MSTU(90)=MSTU(90)+1
- MSTU(90+MSTU(90))=I
- PARU(90+MSTU(90))=Z
- ENDIF
- P(I,3)=0.5*(Z*W-PR/MAX(1E-4,Z*W))
- P(I,4)=0.5*(Z*W+PR/MAX(1E-4,Z*W))
- IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND.
- &P(I,3).LE.0.001) THEN
- IF(W.GE.P(I,5)+0.5*PARJ(32)) GOTO 180
- P(I,3)=0.0001
- P(I,4)=SQRT(PR)
- Z=P(I,4)/W
- ENDIF
-
-C...Remaining flavour and momentum.
- KFL1=-KFL2
- PX1=-PX2
- PY1=-PY2
- W=(1.-Z)*W
- DO 210 J=1,5
- V(I,J)=0.
- 210 CONTINUE
-
-C...Check if pL acceptable. Go back for new hadron if enough energy.
- IF(MSTJ(3).GE.0.AND.P(I,3).LT.0.) THEN
- I=I-1
- IF(MZSAV.EQ.1) MSTU(90)=MSTU(90)-1
- ENDIF
- IF(W.GT.PARJ(31)) GOTO 190
- N=I
- 220 CONTINUE
- IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1*PARJ(32)
- IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170
-
-C...Rotate jet to new direction.
- THE=ULANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2))
- PHI=ULANGL(P(IP1,1),P(IP1,2))
- MSTU(33)=1
- CALL LUDBRB(NSAV1+1,N,THE,PHI,0D0,0D0,0D0)
- K(K(IP1,3),4)=NSAV1+1
- K(K(IP1,3),5)=N
-
-C...End of jet generation loop. Skip conservation in some cases.
- 230 CONTINUE
- IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 490
- IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150
-
-C...Subtract off produced hadron flavours, finished if zero.
- DO 240 I=NSAV+NJET+1,N
- KFA=IABS(K(I,2))
- KFLA=MOD(KFA/1000,10)
- KFLB=MOD(KFA/100,10)
- KFLC=MOD(KFA/10,10)
- IF(KFLA.EQ.0) THEN
- IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB
- IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB
- ELSE
- IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2))
- IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))
- IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2))
- ENDIF
- 240 CONTINUE
- NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
- &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
- IF(NREQ.EQ.0) GOTO 320
-
-C...Take away flavour of low-momentum particles until enough freedom.
- NREM=0
- 250 IREM=0
- P2MIN=PECM**2
- DO 260 I=NSAV+NJET+1,N
- P2=P(I,1)**2+P(I,2)**2+P(I,3)**2
- IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I
- IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2
- 260 CONTINUE
- IF(IREM.EQ.0) GOTO 150
- K(IREM,1)=7
- KFA=IABS(K(IREM,2))
- KFLA=MOD(KFA/1000,10)
- KFLB=MOD(KFA/100,10)
- KFLC=MOD(KFA/10,10)
- IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8
- IF(K(IREM,1).EQ.8) GOTO 250
- IF(KFLA.EQ.0) THEN
- ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB
- IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN
- IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN
- ELSE
- IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2))
- IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2))
- IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2))
- ENDIF
- NREM=NREM+1
- NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
- &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
- IF(NREQ.GT.NREM) GOTO 250
- DO 270 I=NSAV+NJET+1,N
- IF(K(I,1).EQ.8) K(I,1)=1
- 270 CONTINUE
-
-C...Find combination of existing and new flavours for hadron.
- 280 NFET=2
- IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3
- IF(NREQ.LT.NREM) NFET=1
- IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0
- DO 290 J=1,NFET
- IFET(J)=1+(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*RLU(0)
- KFLF(J)=ISIGN(1,NFL(1))
- IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2))
- IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3))
- 290 CONTINUE
- IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0))
- &GOTO 280
- IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR.
- &IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3)
- &.LT.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280
- IF(NFET.EQ.0) KFLF(1)=1+INT((2.+PARJ(2))*RLU(0))
- IF(NFET.EQ.0) KFLF(2)=-KFLF(1)
- IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2.+PARJ(2))*RLU(0)),-KFLF(1))
- IF(NFET.LE.2) KFLF(3)=0
- IF(KFLF(3).NE.0) THEN
- KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+
- & 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1))
- IF(KFLF(1).EQ.KFLF(3).OR.(1.+3.*PARJ(4))*RLU(0).GT.1.)
- & KFLFC=KFLFC+ISIGN(2,KFLFC)
- ELSE
- KFLFC=KFLF(1)
- ENDIF
- CALL LUKFDI(KFLFC,KFLF(2),KFLDMP,KF)
- IF(KF.EQ.0) GOTO 280
- DO 300 J=1,MAX(2,NFET)
- NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J))
- 300 CONTINUE
-
-C...Store hadron at random among free positions.
- NPOS=MIN(1+INT(RLU(0)*NREM),NREM)
- DO 310 I=NSAV+NJET+1,N
- IF(K(I,1).EQ.7) NPOS=NPOS-1
- IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310
- K(I,1)=1
- K(I,2)=KF
- P(I,5)=ULMASS(K(I,2))
- P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
- 310 CONTINUE
- NREM=NREM-1
- NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
- &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
- IF(NREM.GT.0) GOTO 280
-
-C...Compensate for missing momentum in global scheme (3 options).
- 320 IF(MOD(MSTJ(3),5).NE.0.AND.MOD(MSTJ(3),5).NE.4) THEN
- DO 340 J=1,3
- PSI(J)=0.
- DO 330 I=NSAV+NJET+1,N
- PSI(J)=PSI(J)+P(I,J)
- 330 CONTINUE
- 340 CONTINUE
- PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2
- PWS=0.
- DO 350 I=NSAV+NJET+1,N
- IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4)
- IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+
- & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4))
- IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1.
- 350 CONTINUE
- DO 370 I=NSAV+NJET+1,N
- IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4)
- IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+
- & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4))
- IF(MOD(MSTJ(3),5).EQ.3) PW=1.
- DO 360 J=1,3
- P(I,J)=P(I,J)-PSI(J)*PW/PWS
- 360 CONTINUE
- P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
- 370 CONTINUE
-
-C...Compensate for missing momentum withing each jet separately.
- ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN
- DO 390 I=N+1,N+NJET
- K(I,1)=0
- DO 380 J=1,5
- P(I,J)=0.
- 380 CONTINUE
- 390 CONTINUE
- DO 410 I=NSAV+NJET+1,N
- IR1=K(I,3)
- IR2=N+IR1-NSAV
- K(IR2,1)=K(IR2,1)+1
- PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/
- & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)
- DO 400 J=1,3
- P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J)
- 400 CONTINUE
- P(IR2,4)=P(IR2,4)+P(I,4)
- P(IR2,5)=P(IR2,5)+PLS
- 410 CONTINUE
- PSS=0.
- DO 420 I=N+1,N+NJET
- IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8*P(I,5)+0.2))
- 420 CONTINUE
- DO 440 I=NSAV+NJET+1,N
- IR1=K(I,3)
- IR2=N+IR1-NSAV
- PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/
- & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)
- DO 430 J=1,3
- P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1./(P(IR2,5)*PSS)-1.)*PLS*
- & P(IR1,J)
- 430 CONTINUE
- P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
- 440 CONTINUE
- ENDIF
-
-C...Scale momenta for energy conservation.
- IF(MOD(MSTJ(3),5).NE.0) THEN
- PMS=0.
- PES=0.
- PQS=0.
- DO 450 I=NSAV+NJET+1,N
- PMS=PMS+P(I,5)
- PES=PES+P(I,4)
- PQS=PQS+P(I,5)**2/P(I,4)
- 450 CONTINUE
- IF(PMS.GE.PECM) GOTO 150
- NECO=0
- 460 NECO=NECO+1
- PFAC=(PECM-PQS)/(PES-PQS)
- PES=0.
- PQS=0.
- DO 480 I=NSAV+NJET+1,N
- DO 470 J=1,3
- P(I,J)=PFAC*P(I,J)
- 470 CONTINUE
- P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
- PES=PES+P(I,4)
- PQS=PQS+P(I,5)**2/P(I,4)
- 480 CONTINUE
- IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2E-6*PECM) GOTO 460
- ENDIF
-
-C...Origin of produced particles and parton daughter pointers.
- 490 DO 500 I=NSAV+NJET+1,N
- IF(MSTU(16).NE.2) K(I,3)=NSAV+1
- IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3)
- 500 CONTINUE
- DO 510 I=NSAV+1,NSAV+NJET
- I1=K(I,3)
- K(I1,1)=K(I1,1)+10
- IF(MSTU(16).NE.2) THEN
- K(I1,4)=NSAV+1
- K(I1,5)=NSAV+1
- ELSE
- K(I1,4)=K(I1,4)-NJET+1
- K(I1,5)=K(I1,5)-NJET+1
- IF(K(I1,5).LT.K(I1,4)) THEN
- K(I1,4)=0
- K(I1,5)=0
- ENDIF
- ENDIF
- 510 CONTINUE
-
-C...Document independent fragmentation system. Remove copy of jets.
- NSAV=NSAV+1
- K(NSAV,1)=11
- K(NSAV,2)=93
- K(NSAV,3)=IP
- K(NSAV,4)=NSAV+1
- K(NSAV,5)=N-NJET+1
- DO 520 J=1,4
- P(NSAV,J)=DPS(J)
- V(NSAV,J)=V(IP,J)
- 520 CONTINUE
- P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))
- V(NSAV,5)=0.
- DO 540 I=NSAV+NJET,N
- DO 530 J=1,5
- K(I-NJET+1,J)=K(I,J)
- P(I-NJET+1,J)=P(I,J)
- V(I-NJET+1,J)=V(I,J)
- 530 CONTINUE
- 540 CONTINUE
- N=N-NJET+1
- DO 550 IZ=MSTU90+1,MSTU(90)
- MSTU(90+IZ)=MSTU(90+IZ)-NJET+1
- 550 CONTINUE
-
-C...Boost back particle system. Set production vertices.
- IF(NJET.NE.1) CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),
- &DPS(2)/DPS(4),DPS(3)/DPS(4))
- DO 570 I=NSAV+1,N
- DO 560 J=1,4
- V(I,J)=V(IP,J)
- 560 CONTINUE
- 570 CONTINUE
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUJMAS(PMH,PML)
-
-C...Purpose: to determine, approximately, the two jet masses that
-C...minimize the sum m_H^2 + m_L^2, a la Clavelli and Wyler.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
- DIMENSION SM(3,3),SAX(3),PS(3,5)
-
-C...Reset.
- NP=0
- DO 120 J1=1,3
- DO 100 J2=J1,3
- SM(J1,J2)=0.
- 100 CONTINUE
- DO 110 J2=1,4
- PS(J1,J2)=0.
- 110 CONTINUE
- 120 CONTINUE
- PSS=0.
-
-C...Take copy of particles that are to be considered in mass analysis.
- DO 170 I=1,N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170
- IF(MSTU(41).GE.2) THEN
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
- & KC.EQ.18) GOTO 170
- IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
- & GOTO 170
- ENDIF
- IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN
- CALL LUERRM(11,'(LUJMAS:) no more memory left in LUJETS')
- PMH=-2.
- PML=-2.
- RETURN
- ENDIF
- NP=NP+1
- DO 130 J=1,5
- P(N+NP,J)=P(I,J)
- 130 CONTINUE
- IF(MSTU(42).EQ.0) P(N+NP,5)=0.
- IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1)
- P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
-
-C...Fill information in sphericity tensor and total momentum vector.
- DO 150 J1=1,3
- DO 140 J2=J1,3
- SM(J1,J2)=SM(J1,J2)+P(I,J1)*P(I,J2)
- 140 CONTINUE
- 150 CONTINUE
- PSS=PSS+(P(I,1)**2+P(I,2)**2+P(I,3)**2)
- DO 160 J=1,4
- PS(3,J)=PS(3,J)+P(N+NP,J)
- 160 CONTINUE
- 170 CONTINUE
-
-C...Very low multiplicities (0 or 1) not considered.
- IF(NP.LE.1) THEN
- CALL LUERRM(8,'(LUJMAS:) too few particles for analysis')
- PMH=-1.
- PML=-1.
- RETURN
- ENDIF
- PARU(61)=SQRT(MAX(0.,PS(3,4)**2-PS(3,1)**2-PS(3,2)**2-PS(3,3)**2))
-
-C...Find largest eigenvalue to matrix (third degree equation).
- DO 190 J1=1,3
- DO 180 J2=J1,3
- SM(J1,J2)=SM(J1,J2)/PSS
- 180 CONTINUE
- 190 CONTINUE
- SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2-
- &SM(1,3)**2-SM(2,3)**2)/3.-1./9.
- SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)*
- &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27.
- SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.)
- SMA=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP)
-
-C...Find largest eigenvector by solving equation system.
- DO 210 J1=1,3
- SM(J1,J1)=SM(J1,J1)-SMA
- DO 200 J2=J1+1,3
- SM(J2,J1)=SM(J1,J2)
- 200 CONTINUE
- 210 CONTINUE
- SMAX=0.
- DO 230 J1=1,3
- DO 220 J2=1,3
- IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 220
- JA=J1
- JB=J2
- SMAX=ABS(SM(J1,J2))
- 220 CONTINUE
- 230 CONTINUE
- SMAX=0.
- DO 250 J3=JA+1,JA+2
- J1=J3-3*((J3-1)/3)
- RL=SM(J1,JB)/SM(JA,JB)
- DO 240 J2=1,3
- SM(J1,J2)=SM(J1,J2)-RL*SM(JA,J2)
- IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 240
- JC=J1
- SMAX=ABS(SM(J1,J2))
- 240 CONTINUE
- 250 CONTINUE
- JB1=JB+1-3*(JB/3)
- JB2=JB+2-3*((JB+1)/3)
- SAX(JB1)=-SM(JC,JB2)
- SAX(JB2)=SM(JC,JB1)
- SAX(JB)=-(SM(JA,JB1)*SAX(JB1)+SM(JA,JB2)*SAX(JB2))/SM(JA,JB)
-
-C...Divide particles into two initial clusters by hemisphere.
- DO 270 I=N+1,N+NP
- PSAX=P(I,1)*SAX(1)+P(I,2)*SAX(2)+P(I,3)*SAX(3)
- IS=1
- IF(PSAX.LT.0.) IS=2
- K(I,3)=IS
- DO 260 J=1,4
- PS(IS,J)=PS(IS,J)+P(I,J)
- 260 CONTINUE
- 270 CONTINUE
- PMS=MAX(1E-10,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+
- &MAX(1E-10,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2)
-
-C...Reassign one particle at a time; find maximum decrease of m^2 sum.
- 280 PMD=0.
- IM=0
- DO 290 J=1,4
- PS(3,J)=PS(1,J)-PS(2,J)
- 290 CONTINUE
- DO 300 I=N+1,N+NP
- PPS=P(I,4)*PS(3,4)-P(I,1)*PS(3,1)-P(I,2)*PS(3,2)-P(I,3)*PS(3,3)
- IF(K(I,3).EQ.1) PMDI=2.*(P(I,5)**2-PPS)
- IF(K(I,3).EQ.2) PMDI=2.*(P(I,5)**2+PPS)
- IF(PMDI.LT.PMD) THEN
- PMD=PMDI
- IM=I
- ENDIF
- 300 CONTINUE
-
-C...Loop back if significant reduction in sum of m^2.
- IF(PMD.LT.-PARU(48)*PMS) THEN
- PMS=PMS+PMD
- IS=K(IM,3)
- DO 310 J=1,4
- PS(IS,J)=PS(IS,J)-P(IM,J)
- PS(3-IS,J)=PS(3-IS,J)+P(IM,J)
- 310 CONTINUE
- K(IM,3)=3-IS
- GOTO 280
- ENDIF
-
-C...Final masses and output.
- MSTU(61)=N+1
- MSTU(62)=NP
- PS(1,5)=SQRT(MAX(0.,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2))
- PS(2,5)=SQRT(MAX(0.,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2))
- PMH=MAX(PS(1,5),PS(2,5))
- PML=MIN(PS(1,5),PS(2,5))
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUJOIN(NJOIN,IJOIN)
-
-C...Purpose: to connect a sequence of partons with colour flow indices,
-C...as required for subsequent shower evolution (or other operations).
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
- DIMENSION IJOIN(*)
-
-C...Check that partons are of right types to be connected.
- IF(NJOIN.LT.2) GOTO 120
- KQSUM=0
- DO 100 IJN=1,NJOIN
- I=IJOIN(IJN)
- IF(I.LE.0.OR.I.GT.N) GOTO 120
- IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0) GOTO 120
- KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
- IF(KQ.EQ.0) GOTO 120
- IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120
- IF(KQ.NE.2) KQSUM=KQSUM+KQ
- IF(IJN.EQ.1) KQS=KQ
- 100 CONTINUE
- IF(KQSUM.NE.0) GOTO 120
-
-C...Connect the partons sequentially (closing for gluon loop).
- KCS=(9-KQS)/2
- IF(KQS.EQ.2) KCS=INT(4.5+RLU(0))
- DO 110 IJN=1,NJOIN
- I=IJOIN(IJN)
- K(I,1)=3
- IF(IJN.NE.1) IP=IJOIN(IJN-1)
- IF(IJN.EQ.1) IP=IJOIN(NJOIN)
- IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1)
- IF(IJN.EQ.NJOIN) IN=IJOIN(1)
- K(I,KCS)=MSTU(5)*IN
- K(I,9-KCS)=MSTU(5)*IP
- IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0
- IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0
- 110 CONTINUE
-
-C...Error exit: no action taken.
- RETURN
- 120 CALL LUERRM(12,
- &'(LUJOIN:) given entries can not be joined by one string')
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUKFDI(KFL1,KFL2,KFL3,KF)
-
-C...Purpose: to generate a new flavour pair and combine off a hadron.
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUDAT1/,/LUDAT2/
-
-C...Default flavour values. Input consistency checks.
- KF1A=IABS(KFL1)
- KF2A=IABS(KFL2)
- KFL3=0
- KF=0
- IF(KF1A.EQ.0) RETURN
- IF(KF2A.NE.0) THEN
- IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN
- IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN
- IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN
- ENDIF
-
-C...Check if tabulated flavour probabilities are to be used.
- IF(MSTJ(15).EQ.1) THEN
- KTAB1=-1
- IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A
- KFL1A=MOD(KF1A/1000,10)
- KFL1B=MOD(KF1A/100,10)
- KFL1S=MOD(KF1A,10)
- IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4)
- & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2
- IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1
- IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A
- KTAB2=0
- IF(KF2A.NE.0) THEN
- KTAB2=-1
- IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A
- KFL2A=MOD(KF2A/1000,10)
- KFL2B=MOD(KF2A/100,10)
- KFL2S=MOD(KF2A,10)
- IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4)
- & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2
- IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1
- ENDIF
- IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 150
- ENDIF
-
-C...Parameters and breaking diquark parameter combinations.
- 100 PAR2=PARJ(2)
- PAR3=PARJ(3)
- PAR4=3.*PARJ(4)
- IF(MSTJ(12).GE.2) THEN
- PAR3M=SQRT(PARJ(3))
- PAR4M=1./(3.*SQRT(PARJ(4)))
- PARDM=PARJ(7)/(PARJ(7)+PAR3M*PARJ(6))
- PARS0=PARJ(5)*(2.+(1.+PAR2*PAR3M*PARJ(7))*(1.+PAR4M))
- PARS1=PARJ(7)*PARS0/(2.*PAR3M)+PARJ(5)*(PARJ(6)*(1.+PAR4M)+
- & PAR2*PAR3M*PARJ(6)*PARJ(7))
- PARS2=PARJ(5)*2.*PARJ(6)*PARJ(7)*(PAR2*PARJ(7)+(1.+PAR4M)/PAR3M)
- PARSM=MAX(PARS0,PARS1,PARS2)
- PAR4=PAR4*(1.+PARSM)/(1.+PARSM/(3.*PAR4M))
- ENDIF
-
-C...Choice of whether to generate meson or baryon.
- 110 MBARY=0
- KFDA=0
- IF(KF1A.LE.10) THEN
- IF(KF2A.EQ.0.AND.MSTJ(12).GE.1.AND.(1.+PARJ(1))*RLU(0).GT.1.)
- & MBARY=1
- IF(KF2A.GT.10) MBARY=2
- IF(KF2A.GT.10.AND.KF2A.LE.10000) KFDA=KF2A
- ELSE
- MBARY=2
- IF(KF1A.LE.10000) KFDA=KF1A
- ENDIF
-
-C...Possibility of process diquark -> meson + new diquark.
- IF(KFDA.NE.0.AND.MSTJ(12).GE.2) THEN
- KFLDA=MOD(KFDA/1000,10)
- KFLDB=MOD(KFDA/100,10)
- KFLDS=MOD(KFDA,10)
- WTDQ=PARS0
- IF(MAX(KFLDA,KFLDB).EQ.3) WTDQ=PARS1
- IF(MIN(KFLDA,KFLDB).EQ.3) WTDQ=PARS2
- IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M)
- IF((1.+WTDQ)*RLU(0).GT.1.) MBARY=-1
- IF(MBARY.EQ.-1.AND.KF2A.NE.0) RETURN
- ENDIF
-
-C...Flavour for meson, possibly with new flavour.
- IF(MBARY.LE.0) THEN
- KFS=ISIGN(1,KFL1)
- IF(MBARY.EQ.0) THEN
- IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),-KFL1)
- KFLA=MAX(KF1A,KF2A+IABS(KFL3))
- KFLB=MIN(KF1A,KF2A+IABS(KFL3))
- IF(KFLA.NE.KF1A) KFS=-KFS
-
-C...Splitting of diquark into meson plus new diquark.
- ELSE
- KFL1A=MOD(KF1A/1000,10)
- KFL1B=MOD(KF1A/100,10)
- 120 KFL1D=KFL1A+INT(RLU(0)+0.5)*(KFL1B-KFL1A)
- KFL1E=KFL1A+KFL1B-KFL1D
- IF((KFL1D.EQ.3.AND.RLU(0).GT.PARDM).OR.(KFL1E.EQ.3.AND.
- & RLU(0).LT.PARDM)) THEN
- KFL1D=KFL1A+KFL1B-KFL1D
- KFL1E=KFL1A+KFL1B-KFL1E
- ENDIF
- KFL3A=1+INT((2.+PAR2*PAR3M*PARJ(7))*RLU(0))
- IF((KFL1E.NE.KFL3A.AND.RLU(0).GT.(1.+PAR4M)/MAX(2.,1.+PAR4M))
- & .OR.(KFL1E.EQ.KFL3A.AND.RLU(0).GT.2./MAX(2.,1.+PAR4M)))
- & GOTO 120
- KFLDS=3
- IF(KFL1E.NE.KFL3A) KFLDS=2*INT(RLU(0)+1./(1.+PAR4M))+1
- KFL3=ISIGN(10000+1000*MAX(KFL1E,KFL3A)+100*MIN(KFL1E,KFL3A)+
- & KFLDS,-KFL1)
- KFLA=MAX(KFL1D,KFL3A)
- KFLB=MIN(KFL1D,KFL3A)
- IF(KFLA.NE.KFL1D) KFS=-KFS
- ENDIF
-
-C...Form meson, with spin and flavour mixing for diagonal states.
- IF(KFLA.LE.2) KMUL=INT(PARJ(11)+RLU(0))
- IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+RLU(0))
- IF(KFLA.GE.4) KMUL=INT(PARJ(13)+RLU(0))
- IF(KMUL.EQ.0.AND.PARJ(14).GT.0.) THEN
- IF(RLU(0).LT.PARJ(14)) KMUL=2
- ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0.) THEN
- RMUL=RLU(0)
- IF(RMUL.LT.PARJ(15)) KMUL=3
- IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4
- IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5
- ENDIF
- KFLS=3
- IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
- IF(KMUL.EQ.5) KFLS=5
- IF(KFLA.NE.KFLB) THEN
- KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA
- ELSE
- RMIX=RLU(0)
- IMIX=2*KFLA+10*KMUL
- IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+
- & INT(RMIX+PARF(IMIX)))+KFLS
- IF(KFLA.GE.4) KF=110*KFLA+KFLS
- ENDIF
- IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF)
- IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF)
-
-C...Optional extra suppression of eta and eta'.
- IF(KF.EQ.221) THEN
- IF(RLU(0).GT.PARJ(25)) GOTO 110
- ELSEIF(KF.EQ.331) THEN
- IF(RLU(0).GT.PARJ(26)) GOTO 110
- ENDIF
-
-C...Generate diquark flavour.
- ELSE
- 130 IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN
- KFLA=KF1A
- 140 KFLB=1+INT((2.+PAR2*PAR3)*RLU(0))
- KFLC=1+INT((2.+PAR2*PAR3)*RLU(0))
- KFLDS=1
- IF(KFLB.GE.KFLC) KFLDS=3
- IF(KFLDS.EQ.1.AND.PAR4*RLU(0).GT.1.) GOTO 140
- IF(KFLDS.EQ.3.AND.PAR4.LT.RLU(0)) GOTO 140
- KFL3=ISIGN(1000*MAX(KFLB,KFLC)+100*MIN(KFLB,KFLC)+KFLDS,KFL1)
-
-C...Take diquark flavour from input.
- ELSEIF(KF1A.LE.10) THEN
- KFLA=KF1A
- KFLB=MOD(KF2A/1000,10)
- KFLC=MOD(KF2A/100,10)
- KFLDS=MOD(KF2A,10)
-
-C...Generate (or take from input) quark to go with diquark.
- ELSE
- IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),KFL1)
- KFLA=KF2A+IABS(KFL3)
- KFLB=MOD(KF1A/1000,10)
- KFLC=MOD(KF1A/100,10)
- KFLDS=MOD(KF1A,10)
- ENDIF
-
-C...SU(6) factors for formation of baryon. Try again if fails.
- KBARY=KFLDS
- IF(KFLDS.EQ.3.AND.KFLB.NE.KFLC) KBARY=5
- IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC) KBARY=KBARY+1
- WT=PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY)
- IF(MBARY.EQ.1.AND.MSTJ(12).GE.2) THEN
- WTDQ=PARS0
- IF(MAX(KFLB,KFLC).EQ.3) WTDQ=PARS1
- IF(MIN(KFLB,KFLC).EQ.3) WTDQ=PARS2
- IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M)
- IF(KFLDS.EQ.1) WT=WT*(1.+WTDQ)/(1.+PARSM/(3.*PAR4M))
- IF(KFLDS.EQ.3) WT=WT*(1.+WTDQ)/(1.+PARSM)
- ENDIF
- IF(KF2A.EQ.0.AND.WT.LT.RLU(0)) GOTO 130
-
-C...Form baryon. Distinguish Lambda- and Sigmalike baryons.
- KFLD=MAX(KFLA,KFLB,KFLC)
- KFLF=MIN(KFLA,KFLB,KFLC)
- KFLE=KFLA+KFLB+KFLC-KFLD-KFLF
- KFLS=2
- IF((PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY))*RLU(0).GT.
- & PARF(60+KBARY)) KFLS=4
- KFLL=0
- IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF) THEN
- IF(KFLDS.EQ.1.AND.KFLA.EQ.KFLD) KFLL=1
- IF(KFLDS.EQ.1.AND.KFLA.NE.KFLD) KFLL=INT(0.25+RLU(0))
- IF(KFLDS.EQ.3.AND.KFLA.NE.KFLD) KFLL=INT(0.75+RLU(0))
- ENDIF
- IF(KFLL.EQ.0) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1)
- IF(KFLL.EQ.1) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1)
- ENDIF
- RETURN
-
-C...Use tabulated probabilities to select new flavour and hadron.
- 150 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN
- KT3L=1
- KT3U=6
- ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN
- KT3L=1
- KT3U=6
- ELSEIF(KTAB2.EQ.0) THEN
- KT3L=1
- KT3U=22
- ELSE
- KT3L=KTAB2
- KT3U=KTAB2
- ENDIF
- RFL=0.
- DO 170 KTS=0,2
- DO 160 KT3=KT3L,KT3U
- RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3)
- 160 CONTINUE
- 170 CONTINUE
- RFL=RLU(0)*RFL
- DO 190 KTS=0,2
- KTABS=KTS
- DO 180 KT3=KT3L,KT3U
- KTAB3=KT3
- RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3)
- IF(RFL.LE.0.) GOTO 200
- 180 CONTINUE
- 190 CONTINUE
- 200 CONTINUE
-
-C...Reconstruct flavour of produced quark/diquark.
- IF(KTAB3.LE.6) THEN
- KFL3A=KTAB3
- KFL3B=0
- KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13))
- ELSE
- KFL3A=1
- IF(KTAB3.GE.8) KFL3A=2
- IF(KTAB3.GE.11) KFL3A=3
- IF(KTAB3.GE.16) KFL3A=4
- KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2
- KFL3=1000*KFL3A+100*KFL3B+1
- IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3=
- & KFL3+2
- KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1))
- ENDIF
-
-C...Reconstruct meson code.
- IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR.
- &KFL3B.NE.0)) THEN
- RFL=RLU(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+
- & 25*KTABS)+PARF(145+80*KTAB1+25*KTABS))
- KF=110+2*KTABS+1
- IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1
- IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+
- & 25*KTABS)) KF=330+2*KTABS+1
- ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN
- KFLA=MAX(KTAB1,KTAB3)
- KFLB=MIN(KTAB1,KTAB3)
- KFS=ISIGN(1,KFL1)
- IF(KFLA.NE.KF1A) KFS=-KFS
- KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA
- ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN
- KFS=ISIGN(1,KFL1)
- IF(KFL1A.EQ.KFL3A) THEN
- KFLA=MAX(KFL1B,KFL3B)
- KFLB=MIN(KFL1B,KFL3B)
- IF(KFLA.NE.KFL1B) KFS=-KFS
- ELSEIF(KFL1A.EQ.KFL3B) THEN
- KFLA=KFL3A
- KFLB=KFL1B
- KFS=-KFS
- ELSEIF(KFL1B.EQ.KFL3A) THEN
- KFLA=KFL1A
- KFLB=KFL3B
- ELSEIF(KFL1B.EQ.KFL3B) THEN
- KFLA=MAX(KFL1A,KFL3A)
- KFLB=MIN(KFL1A,KFL3A)
- IF(KFLA.NE.KFL1A) KFS=-KFS
- ELSE
- CALL LUERRM(2,'(LUKFDI:) no matching flavours for qq -> qq')
- GOTO 100
- ENDIF
- KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA
-
-C...Reconstruct baryon code.
- ELSE
- IF(KTAB1.GE.7) THEN
- KFLA=KFL3A
- KFLB=KFL1A
- KFLC=KFL1B
- ELSE
- KFLA=KFL1A
- KFLB=KFL3A
- KFLC=KFL3B
- ENDIF
- KFLD=MAX(KFLA,KFLB,KFLC)
- KFLF=MIN(KFLA,KFLB,KFLC)
- KFLE=KFLA+KFLB+KFLC-KFLD-KFLF
- IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1)
- IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1)
- ENDIF
-
-C...Check that constructed flavour code is an allowed one.
- IF(KFL2.NE.0) KFL3=0
- KC=LUCOMP(KF)
- IF(KC.EQ.0) THEN
- CALL LUERRM(2,'(LUKFDI:) user-defined flavour probabilities '//
- & 'failed')
- GOTO 100
- ENDIF
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LULIST(MLIST)
-
-C...Purpose: to give program heading, or list an event, or particle
-C...data, or current parameter values.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
- CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHDL(7)*4
- DIMENSION PS(6)
- DATA CHDL/'(())',' ','()','!!','<>','==','(==)'/
-
-C...Initialization printout: version number and date of last change.
- IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN
- CALL LULOGO
- MSTU(12)=0
- IF(MLIST.EQ.0) RETURN
- ENDIF
-
-C...List event data, including additional lines after N.
- IF(MLIST.GE.1.AND.MLIST.LE.3) THEN
- IF(MLIST.EQ.1) WRITE(MSTU(11),5100)
- IF(MLIST.EQ.2) WRITE(MSTU(11),5200)
- IF(MLIST.EQ.3) WRITE(MSTU(11),5300)
- LMX=12
- IF(MLIST.GE.2) LMX=16
- ISTR=0
- IMAX=N
- IF(MSTU(2).GT.0) IMAX=MSTU(2)
- DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3)))
- IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120
-
-C...Get particle name, pad it and check it is not too long.
- CALL LUNAME(K(I,2),CHAP)
- LEN=0
- DO 100 LEM=1,16
- IF(CHAP(LEM:LEM).NE.' ') LEN=LEM
- 100 CONTINUE
- MDL=(K(I,1)+19)/10
- LDL=0
- IF(MDL.EQ.2.OR.MDL.GE.8) THEN
- CHAC=CHAP
- IF(LEN.GT.LMX) CHAC(LMX:LMX)='?'
- ELSE
- LDL=1
- IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2
- IF(LEN.EQ.0) THEN
- CHAC=CHDL(MDL)(1:2*LDL)//' '
- ELSE
- CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))//
- & CHDL(MDL)(LDL+1:2*LDL)//' '
- IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?'
- ENDIF
- ENDIF
-
-C...Add information on string connection.
- IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12)
- & THEN
- KC=LUCOMP(K(I,2))
- KCC=0
- IF(KC.NE.0) KCC=KCHG(KC,2)
- IF(IABS(K(I,2)).EQ.39) THEN
- IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X'
- ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN
- ISTR=1
- IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A'
- ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN
- IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I'
- ELSEIF(KCC.NE.0) THEN
- ISTR=0
- IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V'
- ENDIF
- ENDIF
-
-C...Write data for particle/jet.
- IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN
- WRITE(MSTU(11),5400) I,CHAC(1:12),(K(I,J1),J1=1,3),
- & (P(I,J2),J2=1,5)
- ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN
- WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3),
- & (P(I,J2),J2=1,5)
- ELSEIF(MLIST.EQ.1) THEN
- WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3),
- & (P(I,J2),J2=1,5)
- ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.
- & K(I,1).EQ.14)) THEN
- WRITE(MSTU(11),5700) I,CHAC,(K(I,J1),J1=1,3),
- & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000),
- & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000),
- & (P(I,J2),J2=1,5)
- ELSE
- WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5)
- ENDIF
- IF(MLIST.EQ.3) WRITE(MSTU(11),5900) (V(I,J),J=1,5)
-
-C...Insert extra separator lines specified by user.
- IF(MSTU(70).GE.1) THEN
- ISEP=0
- DO 110 J=1,MIN(10,MSTU(70))
- IF(I.EQ.MSTU(70+J)) ISEP=1
- 110 CONTINUE
- IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),6000)
- IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),6100)
- ENDIF
- 120 CONTINUE
-
-C...Sum of charges and momenta.
- DO 130 J=1,6
- PS(J)=PLU(0,J)
- 130 CONTINUE
- IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN
- WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5)
- ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN
- WRITE(MSTU(11),6300) PS(6),(PS(J),J=1,5)
- ELSEIF(MLIST.EQ.1) THEN
- WRITE(MSTU(11),6400) PS(6),(PS(J),J=1,5)
- ELSE
- WRITE(MSTU(11),6500) PS(6),(PS(J),J=1,5)
- ENDIF
-
-C...Give simple list of KF codes defined in program.
- ELSEIF(MLIST.EQ.11) THEN
- WRITE(MSTU(11),6600)
- DO 140 KF=1,40
- CALL LUNAME(KF,CHAP)
- CALL LUNAME(-KF,CHAN)
- IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP
- IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
- 140 CONTINUE
- DO 170 KFLS=1,3,2
- DO 160 KFLA=1,8
- DO 150 KFLB=1,KFLA-(3-KFLS)/2
- KF=1000*KFLA+100*KFLB+KFLS
- CALL LUNAME(KF,CHAP)
- CALL LUNAME(-KF,CHAN)
- WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
- 150 CONTINUE
- 160 CONTINUE
- 170 CONTINUE
- KF=130
- CALL LUNAME(KF,CHAP)
- WRITE(MSTU(11),6700) KF,CHAP
- KF=310
- CALL LUNAME(KF,CHAP)
- WRITE(MSTU(11),6700) KF,CHAP
- DO 200 KMUL=0,5
- KFLS=3
- IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
- IF(KMUL.EQ.5) KFLS=5
- KFLR=0
- IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1
- IF(KMUL.EQ.4) KFLR=2
- DO 190 KFLB=1,8
- DO 180 KFLC=1,KFLB-1
- KF=10000*KFLR+100*KFLB+10*KFLC+KFLS
- CALL LUNAME(KF,CHAP)
- CALL LUNAME(-KF,CHAN)
- WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
- 180 CONTINUE
- KF=10000*KFLR+110*KFLB+KFLS
- CALL LUNAME(KF,CHAP)
- WRITE(MSTU(11),6700) KF,CHAP
- 190 CONTINUE
- 200 CONTINUE
- KF=30443
- CALL LUNAME(KF,CHAP)
- WRITE(MSTU(11),6700) KF,CHAP
- KF=30553
- CALL LUNAME(KF,CHAP)
- WRITE(MSTU(11),6700) KF,CHAP
- DO 240 KFLSP=1,3
- KFLS=2+2*(KFLSP/3)
- DO 230 KFLA=1,8
- DO 220 KFLB=1,KFLA
- DO 210 KFLC=1,KFLB
- IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 210
- IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 210
- IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS
- IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS
- CALL LUNAME(KF,CHAP)
- CALL LUNAME(-KF,CHAN)
- WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
- 210 CONTINUE
- 220 CONTINUE
- 230 CONTINUE
- 240 CONTINUE
-
-C...List parton/particle data table. Check whether to be listed.
- ELSEIF(MLIST.EQ.12) THEN
- WRITE(MSTU(11),6800)
- MSTJ24=MSTJ(24)
- MSTJ(24)=0
- KFMAX=30553
- IF(MSTU(2).NE.0) KFMAX=MSTU(2)
- DO 270 KF=MAX(1,MSTU(1)),KFMAX
- KC=LUCOMP(KF)
- IF(KC.EQ.0) GOTO 270
- IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 270
- IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10),
- & MOD(KF/100,10)).GT.MSTU(14)) GOTO 270
- IF(MSTU(14).GT.0.AND.KF.GT.100.AND.KC.EQ.90) GOTO 270
-
-C...Find particle name and mass. Print information.
- CALL LUNAME(KF,CHAP)
- IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 270
- CALL LUNAME(-KF,CHAN)
- PM=ULMASS(KF)
- WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2),
- & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1)
-
-C...Particle decay: channel number, branching ration, matrix element,
-C...decay products.
- IF(KF.GT.100.AND.KC.LE.100) GOTO 270
- DO 260 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
- DO 250 J=1,5
- CALL LUNAME(KFDP(IDC,J),CHAD(J))
- 250 CONTINUE
- WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
- & (CHAD(J),J=1,5)
- 260 CONTINUE
- 270 CONTINUE
- MSTJ(24)=MSTJ24
-
-C...List parameter value table.
- ELSEIF(MLIST.EQ.13) THEN
- WRITE(MSTU(11),7100)
- DO 280 I=1,200
- WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I)
- 280 CONTINUE
- ENDIF
-
-C...Format statements for output on unit MSTU(11) (by default 6).
- 5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS',
- &5X,'KF orig p_x p_y p_z E m'/)
- 5200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet',
- &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
- &' P(I,2) P(I,3) P(I,4) P(I,5)'/)
- 5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j',
- &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
- &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X,
- &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/)
- 5400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3)
- 5500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2)
- 5600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1)
- 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5)
- 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5)
- 5900 FORMAT(66X,5(1X,F12.3))
- 6000 FORMAT(1X,78('='))
- 6100 FORMAT(1X,130('='))
- 6200 FORMAT(19X,'sum:',F6.2,5X,5F9.3)
- 6300 FORMAT(19X,'sum:',F6.2,5X,5F9.2)
- 6400 FORMAT(19X,'sum:',F6.2,5X,5F9.1)
- 6500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:',
- &5F13.5)
- 6600 FORMAT(///20X,'List of KF codes in program'/)
- 6700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16)
- 6800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X,
- &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X,
- &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off',
- &1X,'ME',3X,'Br.rat.',4X,'decay products')
- 6900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5),
- &2X,F12.5,3X,I2)
- 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16)
- 7100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)',
- &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)')
- 7200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5)
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LULOGO
-
-C...Purpose: to write logo for JETSET and PYTHIA programs.
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
- SAVE /LUDAT1/
- SAVE /PYPARS/
- CHARACTER MONTH(12)*3, LOGO(48)*32, REFER(22)*36, LINE*79,
- &VERS*1, SUBV*3, DATE*2, YEAR*4
-
-C...Data on months, logo, titles, and references.
- DATA MONTH/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',
- &'Oct','Nov','Dec'/
- DATA (LOGO(J),J=1,10)/
- &'PPP Y Y TTTTT H H III A ',
- &'P P Y Y T H H I A A ',
- &'PPP Y T HHHHH I AAAAA',
- &'P Y T H H I A A',
- &'P Y T H H III A A',
- &'JJJJ EEEE TTTTT SSS EEEE TTTTT',
- &' J E T S E T ',
- &' J EEE T SSS EEE T ',
- &'J J E T S E T ',
- &' JJ EEEE T SSS EEEE T '/
- DATA (LOGO(J),J=11,29)/
- &' *......* ',
- &' *:::!!:::::::::::* ',
- &' *::::::!!::::::::::::::* ',
- &' *::::::::!!::::::::::::::::* ',
- &' *:::::::::!!:::::::::::::::::* ',
- &' *:::::::::!!:::::::::::::::::* ',
- &' *::::::::!!::::::::::::::::*! ',
- &' *::::::!!::::::::::::::* !! ',
- &' !! *:::!!:::::::::::* !! ',
- &' !! !* -><- * !! ',
- &' !! !! !! ',
- &' !! !! !! ',
- &' !! !! ',
- &' !! ep !! ',
- &' !! !! ',
- &' !! pp !! ',
- &' !! e+e- !! ',
- &' !! !! ',
- &' !! '/
- DATA (LOGO(J),J=30,48)/
- &'Welcome to the Lund Monte Carlo!',
- &' ',
- &' This is PYTHIA version x.xxx ',
- &'Last date of change: xx xxx 199x',
- &' ',
- &' This is JETSET version x.xxx ',
- &'Last date of change: xx xxx 199x',
- &' ',
- &' Main author: ',
- &' Torbjorn Sjostrand ',
- &' Dept. of theoretical physics 2 ',
- &' University of Lund ',
- &' Solvegatan 14A ',
- &' S-223 62 Lund, Sweden ',
- &' phone: +46 - 46 - 222 48 16 ',
- &' E-mail: torbjorn@thep.lu.se ',
- &' ',
- &' Copyright Torbjorn Sjostrand ',
- &' and CERN, Geneva 1993 '/
- DATA (REFER(J),J=1,6)/
- &'The latest program versions and docu',
- &'mentation is found on WWW address ',
- &'http://thep.lu.se/tf2/staff/torbjorn',
- &'/Welcome.html ',
- &' ',
- &' '/
- DATA (REFER(J),J=7,22)/
- &'When you cite these programs, priori',
- &'ty should always be given to the ',
- &'latest published description. Curren',
- &'tly this is ',
- &'T. Sjostrand, Computer Physics Commu',
- &'n. 82 (1994) 74. ',
- &'The most recent long description (un',
- &'published) is ',
- &'T. Sjostrand, LU TP 95-20 and CERN-T',
- &'H.7112/93 (revised August 1995). ',
- &'Also remember that the programs, to ',
- &'a large extent, represent original ',
- &'physics research. Other publications',
- &' of special relevance to your ',
- &'studies may therefore deserve separa',
- &'te mention. '/
-
-C...Check if PYTHIA linked.
- IF(MSTP(183)/10.NE.199) THEN
- LOGO(32)=' Warning: PYTHIA is not loaded! '
- LOGO(33)='Did you remember to link PYDATA?'
- ELSE
- WRITE(VERS,'(I1)') MSTP(181)
- LOGO(32)(26:26)=VERS
- WRITE(SUBV,'(I3)') MSTP(182)
- LOGO(32)(28:30)=SUBV
- WRITE(DATE,'(I2)') MSTP(185)
- LOGO(33)(22:23)=DATE
- LOGO(33)(25:27)=MONTH(MSTP(184))
- WRITE(YEAR,'(I4)') MSTP(183)
- LOGO(33)(29:32)=YEAR
- ENDIF
-
-C...Check if JETSET linked.
- IF(MSTU(183)/10.NE.199) THEN
- LOGO(35)=' Error: JETSET is not loaded! '
- LOGO(36)='Did you remember to link LUDATA?'
- ELSE
- WRITE(VERS,'(I1)') MSTU(181)
- LOGO(35)(26:26)=VERS
- WRITE(SUBV,'(I3)') MSTU(182)
- LOGO(35)(28:30)=SUBV
- WRITE(DATE,'(I2)') MSTU(185)
- LOGO(36)(22:23)=DATE
- LOGO(36)(25:27)=MONTH(MSTU(184))
- WRITE(YEAR,'(I4)') MSTU(183)
- LOGO(36)(29:32)=YEAR
- ENDIF
-
-C...Loop over lines in header. Define page feed and side borders.
- DO 100 ILIN=1,48
- LINE=' '
- IF(ILIN.EQ.1) THEN
- LINE(1:1)='1'
- ELSE
- LINE(2:3)='**'
- LINE(78:79)='**'
- ENDIF
-
-C...Separator lines and logos.
- IF(ILIN.EQ.2.OR.ILIN.EQ.3.OR.ILIN.EQ.47.OR.ILIN.EQ.48) THEN
- LINE(4:77)='***********************************************'//
- & '***************************'
- ELSEIF(ILIN.GE.6.AND.ILIN.LE.10) THEN
- LINE(6:37)=LOGO(ILIN-5)
- LINE(44:75)=LOGO(ILIN)
- ELSEIF(ILIN.GE.13.AND.ILIN.LE.31) THEN
- LINE(6:37)=LOGO(ILIN-2)
- LINE(44:75)=LOGO(ILIN+17)
- ELSEIF(ILIN.GE.34.AND.ILIN.LE.44) THEN
- LINE(5:40)=REFER(2*ILIN-67)
- LINE(41:76)=REFER(2*ILIN-66)
- ENDIF
-
-C...Write lines to appropriate unit.
- IF(MSTU(183)/10.EQ.199) THEN
- WRITE(MSTU(11),'(A79)') LINE
- ELSE
- WRITE(*,'(A79)') LINE
- ENDIF
- 100 CONTINUE
-
-C...Check that matching subversions are linked.
- IF(MSTU(183)/10.EQ.199.AND.MSTP(183)/10.EQ.199) THEN
- IF(MSTU(182).LT.MSTP(186)) WRITE(MSTU(11),
- & '(/'' Warning: JETSET subversion too old for PYTHIA''/)')
- IF(MSTP(182).LT.MSTU(186)) WRITE(MSTU(11),
- & '(/'' Warning: PYTHIA subversion too old for JETSET''/)')
- ENDIF
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUNAME(KF,CHAU)
-
-C...Purpose: to give the particle/parton name as a character string.
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- COMMON/LUDAT4/CHAF(500)
- CHARACTER CHAF*8
- SAVE /LUDAT1/,/LUDAT2/,/LUDAT4/
- CHARACTER CHAU*16
-
-C...Initial values. Charge. Subdivide code.
- CHAU=' '
- KFA=IABS(KF)
- KC=LUCOMP(KF)
- IF(KC.EQ.0) RETURN
- KQ=LUCHGE(KF)
- KFLA=MOD(KFA/1000,10)
- KFLB=MOD(KFA/100,10)
- KFLC=MOD(KFA/10,10)
- KFLS=MOD(KFA,10)
- KFLR=MOD(KFA/10000,10)
-
-C...Read out root name and spin for simple particle.
- IF(KFA.LE.100.OR.(KFA.GT.100.AND.KC.GT.100)) THEN
- CHAU=CHAF(KC)
- LEN=0
- DO 100 LEM=1,8
- IF(CHAU(LEM:LEM).NE.' ') LEN=LEM
- 100 CONTINUE
-
-C...Construct root name for diquark. Add on spin.
- ELSEIF(KFLC.EQ.0) THEN
- CHAU(1:2)=CHAF(KFLA)(1:1)//CHAF(KFLB)(1:1)
- IF(KFLS.EQ.1) CHAU(3:4)='_0'
- IF(KFLS.EQ.3) CHAU(3:4)='_1'
- LEN=4
-
-C...Construct root name for heavy meson. Add on spin and heavy flavour.
- ELSEIF(KFLA.EQ.0) THEN
- IF(KFLB.EQ.5) CHAU(1:1)='B'
- IF(KFLB.EQ.6) CHAU(1:1)='T'
- IF(KFLB.EQ.7) CHAU(1:1)='L'
- IF(KFLB.EQ.8) CHAU(1:1)='H'
- LEN=1
- IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
- ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
- CHAU(2:2)='*'
- LEN=2
- ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
- CHAU(2:3)='_1'
- LEN=3
- ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
- CHAU(2:4)='*_0'
- LEN=4
- ELSEIF(KFLR.EQ.2) THEN
- CHAU(2:4)='*_1'
- LEN=4
- ELSEIF(KFLS.EQ.5) THEN
- CHAU(2:4)='*_2'
- LEN=4
- ENDIF
- IF(KFLC.GE.3.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN
- CHAU(LEN+1:LEN+2)='_'//CHAF(KFLC)(1:1)
- LEN=LEN+2
- ELSEIF(KFLC.GE.3) THEN
- CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1)
- LEN=LEN+1
- ENDIF
-
-C...Construct root name and spin for heavy baryon.
- ELSE
- IF(KFLB.LE.2.AND.KFLC.LE.2) THEN
- CHAU='Sigma '
- IF(KFLC.GT.KFLB) CHAU='Lambda'
- IF(KFLS.EQ.4) CHAU='Sigma*'
- LEN=5
- IF(CHAU(6:6).NE.' ') LEN=6
- ELSEIF(KFLB.LE.2.OR.KFLC.LE.2) THEN
- CHAU='Xi '
- IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Xi'''
- IF(KFLS.EQ.4) CHAU='Xi*'
- LEN=2
- IF(CHAU(3:3).NE.' ') LEN=3
- ELSE
- CHAU='Omega '
- IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Omega'''
- IF(KFLS.EQ.4) CHAU='Omega*'
- LEN=5
- IF(CHAU(6:6).NE.' ') LEN=6
- ENDIF
-
-C...Add on heavy flavour content for heavy baryon.
- CHAU(LEN+1:LEN+2)='_'//CHAF(KFLA)(1:1)
- LEN=LEN+2
- IF(KFLB.GE.KFLC.AND.KFLC.GE.4) THEN
- CHAU(LEN+1:LEN+2)=CHAF(KFLB)(1:1)//CHAF(KFLC)(1:1)
- LEN=LEN+2
- ELSEIF(KFLB.GE.KFLC.AND.KFLB.GE.4) THEN
- CHAU(LEN+1:LEN+1)=CHAF(KFLB)(1:1)
- LEN=LEN+1
- ELSEIF(KFLC.GT.KFLB.AND.KFLB.GE.4) THEN
- CHAU(LEN+1:LEN+2)=CHAF(KFLC)(1:1)//CHAF(KFLB)(1:1)
- LEN=LEN+2
- ELSEIF(KFLC.GT.KFLB.AND.KFLC.GE.4) THEN
- CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1)
- LEN=LEN+1
- ENDIF
- ENDIF
-
-C...Add on bar sign for antiparticle (where necessary).
- IF(KF.GT.0.OR.LEN.EQ.0) THEN
- ELSEIF(KFA.GT.10.AND.KFA.LE.40.AND.KQ.NE.0.AND.MOD(KQ,3).EQ.0)
- &THEN
- ELSEIF(KFA.EQ.89.OR.(KFA.GE.91.AND.KFA.LE.99)) THEN
- ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KQ.NE.0) THEN
- ELSEIF(MSTU(15).LE.1) THEN
- CHAU(LEN+1:LEN+1)='~'
- LEN=LEN+1
- ELSE
- CHAU(LEN+1:LEN+3)='bar'
- LEN=LEN+3
- ENDIF
-
-C...Add on charge where applicable (conventional cases skipped).
- IF(KQ.EQ.6) CHAU(LEN+1:LEN+2)='++'
- IF(KQ.EQ.-6) CHAU(LEN+1:LEN+2)='--'
- IF(KQ.EQ.3) CHAU(LEN+1:LEN+1)='+'
- IF(KQ.EQ.-3) CHAU(LEN+1:LEN+1)='-'
- IF(KQ.EQ.0.AND.(KFA.LE.22.OR.LEN.EQ.0)) THEN
- ELSEIF(KQ.EQ.0.AND.(KFA.GE.81.AND.KFA.LE.100)) THEN
- ELSEIF(KFA.EQ.28.OR.KFA.EQ.29) THEN
- ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KFLB.EQ.KFLC.AND.
- &KFLB.NE.1) THEN
- ELSEIF(KQ.EQ.0) THEN
- CHAU(LEN+1:LEN+1)='0'
- ENDIF
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUONIA(KFL,ECM)
-
-C...Purpose: to generate Upsilon and toponium decays into three
-C...gluons or two gluons and a photon.
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
-
-C...Printout. Check input parameters.
- IF(MSTU(12).GE.1) CALL LULIST(0)
- IF(KFL.LT.0.OR.KFL.GT.8) THEN
- CALL LUERRM(16,'(LUONIA:) called with unknown flavour code')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
- IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN
- CALL LUERRM(16,'(LUONIA:) called with too small CM energy')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
-
-C...Initial e+e- and onium state (optional).
- NC=0
- IF(MSTJ(115).GE.2) THEN
- NC=NC+2
- CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)
- K(NC-1,1)=21
- CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.)
- K(NC,1)=21
- ENDIF
- KFLC=IABS(KFL)
- IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN
- NC=NC+1
- KF=110*KFLC+3
- MSTU10=MSTU(10)
- MSTU(10)=1
- P(NC,5)=ECM
- CALL LU1ENT(NC,KF,ECM,0.,0.)
- K(NC,1)=21
- K(NC,3)=1
- MSTU(10)=MSTU10
- ENDIF
-
-C...Choose x1 and x2 according to matrix element.
- NTRY=0
- 100 X1=RLU(0)
- X2=RLU(0)
- X3=2.-X1-X2
- IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+
- &((1.-X3)/(X1*X2))**2.LE.2.*RLU(0)) GOTO 100
- NTRY=NTRY+1
- NJET=3
- IF(MSTJ(101).LE.4) CALL LU3ENT(NC+1,21,21,21,ECM,X1,X3)
- IF(MSTJ(101).GE.5) CALL LU3ENT(-(NC+1),21,21,21,ECM,X1,X3)
-
-C...Photon-gluon-gluon events. Small system modifications. Jet origin.
- MSTU(111)=MSTJ(108)
- IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
- &MSTU(111)=1
- PARU(112)=PARJ(121)
- IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
- QF=0.
- IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3.
- RGAM=7.2*QF**2*PARU(101)/ULALPS(ECM**2)
- MK=0
- ECMC=ECM
- IF(RLU(0).GT.RGAM/(1.+RGAM)) THEN
- IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125)))
- & NJET=2
- IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LU2ENT(NC+1,21,21,ECM)
- IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LU2ENT(-(NC+1),21,21,ECM)
- ELSE
- MK=1
- ECMC=SQRT(1.-X1)*ECM
- IF(ECMC.LT.2.*PARJ(127)) GOTO 100
- K(NC+1,1)=1
- K(NC+1,2)=22
- K(NC+1,4)=0
- K(NC+1,5)=0
- IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3)
- IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3)
- IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2)
- IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2)
- NJET=2
- IF(ECMC.LT.4.*PARJ(127)) THEN
- MSTU10=MSTU(10)
- MSTU(10)=1
- P(NC+2,5)=ECMC
- CALL LU1ENT(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.)
- MSTU(10)=MSTU10
- NJET=0
- ENDIF
- ENDIF
- DO 110 IP=NC+1,N
- K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1)
- 110 CONTINUE
-
-C...Differential cross-sections. Upper limit for cross-section.
- IF(MSTJ(106).EQ.1) THEN
- SQ2=SQRT(2.)
- HF1=1.-PARJ(131)*PARJ(132)
- HF3=PARJ(133)**2
- CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3)
- ST13=SQRT(1.-CT13**2)
- SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2
- SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL
- SIGT=0.5*SIGL
- SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2
- SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+
- & 2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI)
-
-C...Angular orientation of event.
- 120 CHI=PARU(2)*RLU(0)
- CTHE=2.*RLU(0)-1.
- PHI=PARU(2)*RLU(0)
- CCHI=COS(CHI)
- SCHI=SIN(CHI)
- C2CHI=COS(2.*CHI)
- S2CHI=SIN(2.*CHI)
- THE=ACOS(CTHE)
- STHE=SIN(THE)
- C2PHI=COS(2.*(PHI-PARJ(134)))
- S2PHI=SIN(2.*(PHI-PARJ(134)))
- SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1-
- & STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*
- & C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE*
- & CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI
- IF(SIG.LT.SIGMAX*RLU(0)) GOTO 120
- CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0)
- CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0)
- ENDIF
-
-C...Generate parton shower. Rearrange along strings and check.
- IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN
- CALL LUSHOW(NC+MK+1,-NJET,ECMC)
- MSTJ14=MSTJ(14)
- IF(MSTJ(105).EQ.-1) MSTJ(14)=-1
- IF(MSTJ(105).GE.0) MSTU(28)=0
- CALL LUPREP(0)
- MSTJ(14)=MSTJ14
- IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
- ENDIF
-
-C...Generate fragmentation. Information for LUTABU:
- IF(MSTJ(105).EQ.1) CALL LUEXEC
- MSTU(161)=110*KFLC+3
- MSTU(162)=0
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUPREP(IP)
-
-C...Purpose: to rearrange partons along strings, to allow small systems
-C...to collapse into one or two particles and to check flavours.
- IMPLICIT DOUBLE PRECISION(D)
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
- DIMENSION DPS(5),DPC(5),UE(3)
-
-C...Rearrange parton shower product listing along strings: begin loop.
- I1=N
- DO 130 MQGST=1,2
- DO 120 I=MAX(1,IP),N
- IF(K(I,1).NE.3) GOTO 120
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0) GOTO 120
- KQ=KCHG(KC,2)
- IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 120
-
-C...Pick up loose string end.
- KCS=4
- IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5
- IA=I
- NSTP=0
- 100 NSTP=NSTP+1
- IF(NSTP.GT.4*N) THEN
- CALL LUERRM(14,'(LUPREP:) caught in infinite loop')
- RETURN
- ENDIF
-
-C...Copy undecayed parton.
- IF(K(IA,1).EQ.3) THEN
- IF(I1.GE.MSTU(4)-MSTU(32)-5) THEN
- CALL LUERRM(11,'(LUPREP:) no more memory left in LUJETS')
- RETURN
- ENDIF
- I1=I1+1
- K(I1,1)=2
- IF(NSTP.GE.2.AND.IABS(K(IA,2)).NE.21) K(I1,1)=1
- K(I1,2)=K(IA,2)
- K(I1,3)=IA
- K(I1,4)=0
- K(I1,5)=0
- DO 110 J=1,5
- P(I1,J)=P(IA,J)
- V(I1,J)=V(IA,J)
- 110 CONTINUE
- K(IA,1)=K(IA,1)+10
- IF(K(I1,1).EQ.1) GOTO 120
- ENDIF
-
-C...Go to next parton in colour space.
- IB=IA
- IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5))
- &.NE.0) THEN
- IA=MOD(K(IB,KCS),MSTU(5))
- K(IB,KCS)=K(IB,KCS)+MSTU(5)**2
- MREV=0
- ELSE
- IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5),MSTU(5))
- & .EQ.0) KCS=9-KCS
- IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5))
- K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2
- MREV=1
- ENDIF
- IF(IA.LE.0.OR.IA.GT.N) THEN
- CALL LUERRM(12,'(LUPREP:) colour rearrangement failed')
- RETURN
- ENDIF
- IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5),
- &MSTU(5)).EQ.IB) THEN
- IF(MREV.EQ.1) KCS=9-KCS
- IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS
- K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2
- ELSE
- IF(MREV.EQ.0) KCS=9-KCS
- IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS
- K(IA,KCS)=K(IA,KCS)+MSTU(5)**2
- ENDIF
- IF(IA.NE.I) GOTO 100
- K(I1,1)=1
- 120 CONTINUE
- 130 CONTINUE
- N=I1
- IF(MSTJ(14).LT.0) RETURN
-
-C...Find lowest-mass colour singlet jet system, OK if above threshold.
- IF(MSTJ(14).EQ.0) GOTO 320
- NS=N
- 140 NSIN=N-NS
- PDM=1.+PARJ(32)
- IC=0
- DO 190 I=MAX(1,IP),NS
- IF(K(I,1).NE.1.AND.K(I,1).NE.2) THEN
- ELSEIF(K(I,1).EQ.2.AND.IC.EQ.0) THEN
- NSIN=NSIN+1
- IC=I
- DO 150 J=1,4
- DPS(J)=P(I,J)
- 150 CONTINUE
- MSTJ(93)=1
- DPS(5)=ULMASS(K(I,2))
- ELSEIF(K(I,1).EQ.2) THEN
- DO 160 J=1,4
- DPS(J)=DPS(J)+P(I,J)
- 160 CONTINUE
- ELSEIF(IC.NE.0.AND.KCHG(LUCOMP(K(I,2)),2).NE.0) THEN
- DO 170 J=1,4
- DPS(J)=DPS(J)+P(I,J)
- 170 CONTINUE
- MSTJ(93)=1
- DPS(5)=DPS(5)+ULMASS(K(I,2))
- PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))-DPS(5)
- IF(PD.LT.PDM) THEN
- PDM=PD
- DO 180 J=1,5
- DPC(J)=DPS(J)
- 180 CONTINUE
- IC1=IC
- IC2=I
- ENDIF
- IC=0
- ELSE
- NSIN=NSIN+1
- ENDIF
- 190 CONTINUE
- IF(PDM.GE.PARJ(32)) GOTO 320
-
-C...Fill small-mass system as cluster.
- NSAV=N
- PECM=SQRT(MAX(0D0,DPC(4)**2-DPC(1)**2-DPC(2)**2-DPC(3)**2))
- K(N+1,1)=11
- K(N+1,2)=91
- K(N+1,3)=IC1
- K(N+1,4)=N+2
- K(N+1,5)=N+3
- P(N+1,1)=DPC(1)
- P(N+1,2)=DPC(2)
- P(N+1,3)=DPC(3)
- P(N+1,4)=DPC(4)
- P(N+1,5)=PECM
-
-C...Form two particles from flavours of lowest-mass system, if feasible.
- K(N+2,1)=1
- K(N+3,1)=1
- IF(MSTU(16).NE.2) THEN
- K(N+2,3)=N+1
- K(N+3,3)=N+1
- ELSE
- K(N+2,3)=IC1
- K(N+3,3)=IC2
- ENDIF
- K(N+2,4)=0
- K(N+3,4)=0
- K(N+2,5)=0
- K(N+3,5)=0
- IF(IABS(K(IC1,2)).NE.21) THEN
- KC1=LUCOMP(K(IC1,2))
- KC2=LUCOMP(K(IC2,2))
- IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 320
- KQ1=KCHG(KC1,2)*ISIGN(1,K(IC1,2))
- KQ2=KCHG(KC2,2)*ISIGN(1,K(IC2,2))
- IF(KQ1+KQ2.NE.0) GOTO 320
- 200 CALL LUKFDI(K(IC1,2),0,KFLN,K(N+2,2))
- CALL LUKFDI(K(IC2,2),-KFLN,KFLDMP,K(N+3,2))
- IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 200
- ELSE
- IF(IABS(K(IC2,2)).NE.21) GOTO 320
- 210 CALL LUKFDI(1+INT((2.+PARJ(2))*RLU(0)),0,KFLN,KFDMP)
- CALL LUKFDI(KFLN,0,KFLM,K(N+2,2))
- CALL LUKFDI(-KFLN,-KFLM,KFLDMP,K(N+3,2))
- IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 210
- ENDIF
- P(N+2,5)=ULMASS(K(N+2,2))
- P(N+3,5)=ULMASS(K(N+3,2))
- IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM.AND.NSIN.EQ.1) GOTO 320
- IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) GOTO 260
-
-C...Perform two-particle decay of jet system, if possible.
- IF(PECM.GE.0.02*DPC(4)) THEN
- PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2-
- & (P(N+2,5)-P(N+3,5))**2))/(2.*PECM)
- UE(3)=2.*RLU(0)-1.
- PHI=PARU(2)*RLU(0)
- UE(1)=SQRT(1.-UE(3)**2)*COS(PHI)
- UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI)
- DO 220 J=1,3
- P(N+2,J)=PA*UE(J)
- P(N+3,J)=-PA*UE(J)
- 220 CONTINUE
- P(N+2,4)=SQRT(PA**2+P(N+2,5)**2)
- P(N+3,4)=SQRT(PA**2+P(N+3,5)**2)
- MSTU(33)=1
- CALL LUDBRB(N+2,N+3,0.,0.,DPC(1)/DPC(4),DPC(2)/DPC(4),
- & DPC(3)/DPC(4))
- ELSE
- NP=0
- DO 230 I=IC1,IC2
- IF(K(I,1).EQ.1.OR.K(I,1).EQ.2) NP=NP+1
- 230 CONTINUE
- HA=P(IC1,4)*P(IC2,4)-P(IC1,1)*P(IC2,1)-P(IC1,2)*P(IC2,2)-
- & P(IC1,3)*P(IC2,3)
- IF(NP.GE.3.OR.HA.LE.1.25*P(IC1,5)*P(IC2,5)) GOTO 260
- HD1=0.5*(P(N+2,5)**2-P(IC1,5)**2)
- HD2=0.5*(P(N+3,5)**2-P(IC2,5)**2)
- HR=SQRT(MAX(0.,((HA-HD1-HD2)**2-(P(N+2,5)*P(N+3,5))**2)/
- & (HA**2-(P(IC1,5)*P(IC2,5))**2)))-1.
- HC=P(IC1,5)**2+2.*HA+P(IC2,5)**2
- HK1=((P(IC2,5)**2+HA)*HR+HD1-HD2)/HC
- HK2=((P(IC1,5)**2+HA)*HR+HD2-HD1)/HC
- DO 240 J=1,4
- P(N+2,J)=(1.+HK1)*P(IC1,J)-HK2*P(IC2,J)
- P(N+3,J)=(1.+HK2)*P(IC2,J)-HK1*P(IC1,J)
- 240 CONTINUE
- ENDIF
- DO 250 J=1,4
- V(N+1,J)=V(IC1,J)
- V(N+2,J)=V(IC1,J)
- V(N+3,J)=V(IC2,J)
- 250 CONTINUE
- V(N+1,5)=0.
- V(N+2,5)=0.
- V(N+3,5)=0.
- N=N+3
- GOTO 300
-
-C...Else form one particle from the flavours available, if possible.
- 260 K(N+1,5)=N+2
- IF(IABS(K(IC1,2)).GT.100.AND.IABS(K(IC2,2)).GT.100) THEN
- GOTO 320
- ELSEIF(IABS(K(IC1,2)).NE.21) THEN
- CALL LUKFDI(K(IC1,2),K(IC2,2),KFLDMP,K(N+2,2))
- ELSE
- KFLN=1+INT((2.+PARJ(2))*RLU(0))
- CALL LUKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2))
- ENDIF
- IF(K(N+2,2).EQ.0) GOTO 260
- P(N+2,5)=ULMASS(K(N+2,2))
-
-C...Find parton/particle which combines to largest extra mass.
- IR=0
- HA=0.
- HSM=0.
- DO 280 MCOMB=1,3
- IF(IR.NE.0) GOTO 280
- DO 270 I=MAX(1,IP),N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10.OR.(I.GE.IC1.AND.I.LE.IC2
- &.AND.K(I,1).GE.1.AND.K(I,1).LE.2)) GOTO 270
- IF(MCOMB.EQ.1) KCI=LUCOMP(K(I,2))
- IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 270
- IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 270
- IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100)
- &GOTO 270
- HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3)
- HSR=2.*HCR+PECM**2-P(N+2,5)**2-2.*P(N+2,5)*P(I,5)
- IF(HSR.GT.HSM) THEN
- IR=I
- HA=HCR
- HSM=HSR
- ENDIF
- 270 CONTINUE
- 280 CONTINUE
-
-C...Shuffle energy and momentum to put new particle on mass shell.
- IF(IR.NE.0) THEN
- HB=PECM**2+HA
- HC=P(N+2,5)**2+HA
- HD=P(IR,5)**2+HA
- HK2=0.5*(HB*SQRT(MAX(0.,((HB+HC)**2-4.*(HB+HD)*P(N+2,5)**2)/
- & (HA**2-(PECM*P(IR,5))**2)))-(HB+HC))/(HB+HD)
- HK1=(0.5*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB
- DO 290 J=1,4
- P(N+2,J)=(1.+HK1)*DPC(J)-HK2*P(IR,J)
- P(IR,J)=(1.+HK2)*P(IR,J)-HK1*DPC(J)
- V(N+1,J)=V(IC1,J)
- V(N+2,J)=V(IC1,J)
- 290 CONTINUE
- V(N+1,5)=0.
- V(N+2,5)=0.
- N=N+2
- ELSE
- CALL LUERRM(3,'(LUPREP:) no match for collapsing cluster')
- RETURN
- ENDIF
-
-C...Mark collapsed system and store daughter pointers. Iterate.
- 300 DO 310 I=IC1,IC2
- IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.KCHG(LUCOMP(K(I,2)),2).NE.0)
- &THEN
- K(I,1)=K(I,1)+10
- IF(MSTU(16).NE.2) THEN
- K(I,4)=NSAV+1
- K(I,5)=NSAV+1
- ELSE
- K(I,4)=NSAV+2
- K(I,5)=N
- ENDIF
- ENDIF
- 310 CONTINUE
- IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 140
-
-C...Check flavours and invariant masses in parton systems.
- 320 NP=0
- KFN=0
- KQS=0
- DO 330 J=1,5
- DPS(J)=0.
- 330 CONTINUE
- DO 360 I=MAX(1,IP),N
- IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360
- KC=LUCOMP(K(I,2))
- IF(KC.EQ.0) GOTO 360
- KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
- IF(KQ.EQ.0) GOTO 360
- NP=NP+1
- IF(KQ.NE.2) THEN
- KFN=KFN+1
- KQS=KQS+KQ
- MSTJ(93)=1
- DPS(5)=DPS(5)+ULMASS(K(I,2))
- ENDIF
- DO 340 J=1,4
- DPS(J)=DPS(J)+P(I,J)
- 340 CONTINUE
- IF(K(I,1).EQ.1) THEN
- IF(NP.NE.1.AND.(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0)) CALL
- & LUERRM(2,'(LUPREP:) unphysical flavour combination')
- IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT.
- & (0.9*PARJ(32)+DPS(5))**2) CALL LUERRM(3,
- & '(LUPREP:) too small mass in jet system')
- NP=0
- KFN=0
- KQS=0
- DO 350 J=1,5
- DPS(J)=0.
- 350 CONTINUE
- ENDIF
- 360 CONTINUE
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUPTDI(KFL,PX,PY)
-
-C...Purpose: to generate transverse momentum according to a Gaussian.
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- SAVE /LUDAT1/
-
-C...Generate p_T and azimuthal angle, gives p_x and p_y.
- KFLA=IABS(KFL)
- PT=PARJ(21)*SQRT(-LOG(MAX(1E-10,RLU(0))))
- IF(PARJ(23).GT.RLU(0)) PT=PARJ(24)*PT
- IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT
- IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0.
- PHI=PARU(2)*RLU(0)
- PX=PT*COS(PHI)
- PY=PT*SIN(PHI)
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LURADK(ECM,MK,PAK,THEK,PHIK,ALPK)
-
-C...Purpose: to generate initial state photon radiation.
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- SAVE /LUDAT1/
-
-C...Function: cumulative hard photon spectrum in QFD case.
- FXK(XX)=2.*LOG(XX)+PARJ(161)*LOG(1.-XX)+PARJ(162)*XX+
- &PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW)
-
-C...Determine whether radiative photon or not.
- MK=0
- PAK=0.
- IF(PARJ(160).LT.RLU(0)) RETURN
- MK=1
-
-C...Photon energy range. Find photon momentum in QED case.
- XKL=PARJ(135)
- XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2)
- IF(MSTJ(102).LE.1) THEN
- 100 XK=1./(1.+(1./XKL-1.)*((1./XKU-1.)/(1./XKL-1.))**RLU(0))
- IF(1.+(1.-XK)**2.LT.2.*RLU(0)) GOTO 100
-
-C...Ditto in QFD case, by numerical inversion of integrated spectrum.
- ELSE
- SZM=1.-(PARJ(123)/ECM)**2
- SZW=PARJ(123)*PARJ(124)/ECM**2
- FXKL=FXK(XKL)
- FXKU=FXK(XKU)
- FXKD=1E-4*(FXKU-FXKL)
- FXKR=FXKL+RLU(0)*(FXKU-FXKL)
- NXK=0
- 110 NXK=NXK+1
- XK=0.5*(XKL+XKU)
- FXKV=FXK(XK)
- IF(FXKV.GT.FXKR) THEN
- XKU=XK
- FXKU=FXKV
- ELSE
- XKL=XK
- FXKL=FXKV
- ENDIF
- IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110
- XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL)
- ENDIF
- PAK=0.5*ECM*XK
-
-C...Photon polar and azimuthal angle.
- PME=2.*(ULMASS(11)/ECM)**2
- 120 CTHM=PME*(2./PME)**RLU(0)
- IF(1.-(XK**2*CTHM*(1.-0.5*CTHM)+2.*(1.-XK)*PME/MAX(PME,
- &CTHM*(1.-0.5*CTHM)))/(1.+(1.-XK)**2).LT.RLU(0)) GOTO 120
- CTHE=1.-CTHM
- IF(RLU(0).GT.0.5) CTHE=-CTHE
- STHE=SQRT(MAX(0.,(CTHM-PME)*(2.-CTHM)))
- THEK=ULANGL(CTHE,STHE)
- PHIK=PARU(2)*RLU(0)
-
-C...Rotation angle for hadronic system.
- SGN=1.
- IF(0.5*(2.-XK*(1.-CTHE))**2/((2.-XK)**2+(XK*CTHE)**2).GT.
- &RLU(0)) SGN=-1.
- ALPK=ASIN(SGN*STHE*(XK-SGN*(2.*SQRT(1.-XK)-2.+XK)*CTHE)/
- &(2.-XK*(1.-SGN*CTHE)))
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ)
-
-C...Purpose: to perform rotations and boosts.
- IMPLICIT DOUBLE PRECISION(D)
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- SAVE /LUJETS/,/LUDAT1/
- DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4)
-
-C...Find range of rotation/boost. Convert boost to double precision.
- IMIN=1
- IF(MSTU(1).GT.0) IMIN=MSTU(1)
- IMAX=N
- IF(MSTU(2).GT.0) IMAX=MSTU(2)
- DBX=BEX
- DBY=BEY
- DBZ=BEZ
- GOTO 120
-
-C...Entry for specific range and double precision boost.
- ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ)
- IMIN=IMI
- IF(IMIN.LE.0) IMIN=1
- IMAX=IMA
- IF(IMAX.LE.0) IMAX=N
- DBX=DBEX
- DBY=DBEY
- DBZ=DBEZ
-
-C...Optional resetting of V (when not set before.)
- IF(MSTU(33).NE.0) THEN
- DO 110 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4))
- DO 100 J=1,5
- V(I,J)=0.
- 100 CONTINUE
- 110 CONTINUE
- MSTU(33)=0
- ENDIF
-
-C...Check range of rotation/boost.
- 120 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN
- CALL LUERRM(11,'(LUROBO:) range outside LUJETS memory')
- RETURN
- ENDIF
-
-C...Rotate, typically from z axis to direction (theta,phi).
- IF(THE**2+PHI**2.GT.1E-20) THEN
- ROT(1,1)=COS(THE)*COS(PHI)
- ROT(1,2)=-SIN(PHI)
- ROT(1,3)=SIN(THE)*COS(PHI)
- ROT(2,1)=COS(THE)*SIN(PHI)
- ROT(2,2)=COS(PHI)
- ROT(2,3)=SIN(THE)*SIN(PHI)
- ROT(3,1)=-SIN(THE)
- ROT(3,2)=0.
- ROT(3,3)=COS(THE)
- DO 150 I=IMIN,IMAX
- IF(K(I,1).LE.0) GOTO 150
- DO 130 J=1,3
- PR(J)=P(I,J)
- VR(J)=V(I,J)
- 130 CONTINUE
- DO 140 J=1,3
- P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3)
- V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3)
- 140 CONTINUE
- 150 CONTINUE
- ENDIF
-
-C...Boost, typically from rest to momentum/energy=beta.
- IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN
- DB=SQRT(DBX**2+DBY**2+DBZ**2)
- IF(DB.GT.0.99999999D0) THEN
-C...Rescale boost vector if too close to unity.
- CALL LUERRM(3,'(LUROBO:) boost vector too large')
- DBX=DBX*(0.99999999D0/DB)
- DBY=DBY*(0.99999999D0/DB)
- DBZ=DBZ*(0.99999999D0/DB)
- DB=0.99999999D0
- ENDIF
- DGA=1D0/SQRT(1D0-DB**2)
- DO 170 I=IMIN,IMAX
- IF(K(I,1).LE.0) GOTO 170
- DO 160 J=1,4
- DP(J)=P(I,J)
- DV(J)=V(I,J)
- 160 CONTINUE
- DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3)
- DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4))
- P(I,1)=DP(1)+DGABP*DBX
- P(I,2)=DP(2)+DGABP*DBY
- P(I,3)=DP(3)+DGABP*DBZ
- P(I,4)=DGA*(DP(4)+DBP)
- DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3)
- DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4))
- V(I,1)=DV(1)+DGABV*DBX
- V(I,2)=DV(2)+DGABV*DBY
- V(I,3)=DV(3)+DGABV*DBZ
- V(I,4)=DGA*(DV(4)+DBV)
- 170 CONTINUE
- ENDIF
-
- RETURN
- END
+++ /dev/null
-
-C*********************************************************************
-
- SUBROUTINE LUSHOW(IP1,IP2,QMAX)
-
-C...Purpose: to generate timelike parton showers from given partons.
- IMPLICIT DOUBLE PRECISION(D)
- COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
- COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
- COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
- SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
- DIMENSION PMTH(5,50),PS(5),PMA(4),PMSD(4),IEP(4),IPA(4),
- &KFLA(4),KFLD(4),KFL(4),ITRY(4),ISI(4),ISL(4),DP(4),DPT(5,4),
- &KSH(0:40),KCII(2),NIIS(2),IIIS(2,2),THEIIS(2,2),PHIIIS(2,2),
- &ISII(2)
-
-C...Initialization of cutoff masses etc.
- IF(MSTJ(41).LE.0.OR.(MSTJ(41).EQ.1.AND.QMAX.LE.PARJ(82)).OR.
- &QMAX.LE.MIN(PARJ(82),PARJ(83))) RETURN
- DO 100 IFL=0,40
- KSH(IFL)=0
- 100 CONTINUE
- KSH(21)=1
- PMTH(1,21)=ULMASS(21)
- PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25*PARJ(82)**2)
- PMTH(3,21)=2.*PMTH(2,21)
- PMTH(4,21)=PMTH(3,21)
- PMTH(5,21)=PMTH(3,21)
- PMTH(1,22)=ULMASS(22)
- PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25*PARJ(83)**2)
- PMTH(3,22)=2.*PMTH(2,22)
- PMTH(4,22)=PMTH(3,22)
- PMTH(5,22)=PMTH(3,22)
- PMQTH1=PARJ(82)
- IF(MSTJ(41).GE.2) PMQTH1=MIN(PARJ(82),PARJ(83))
- PMQTH2=PMTH(2,21)
- IF(MSTJ(41).GE.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22))
- DO 110 IFL=1,8
- KSH(IFL)=1
- PMTH(1,IFL)=ULMASS(IFL)
- PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PMQTH1**2)
- PMTH(3,IFL)=PMTH(2,IFL)+PMQTH2
- PMTH(4,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(82)**2)+PMTH(2,21)
- PMTH(5,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(83)**2)+PMTH(2,22)
- 110 CONTINUE
- DO 120 IFL=11,17,2
- IF(MSTJ(41).GE.2) KSH(IFL)=1
- PMTH(1,IFL)=ULMASS(IFL)
- PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(83)**2)
- PMTH(3,IFL)=PMTH(2,IFL)+PMTH(2,22)
- PMTH(4,IFL)=PMTH(3,IFL)
- PMTH(5,IFL)=PMTH(3,IFL)
- 120 CONTINUE
- PT2MIN=MAX(0.5*PARJ(82),1.1*PARJ(81))**2
- ALAMS=PARJ(81)**2
- ALFM=LOG(PT2MIN/ALAMS)
-
-C...Store positions of shower initiating partons.
- IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN
- NPA=1
- IPA(1)=IP1
- ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)-
- &MSTU(32))) THEN
- NPA=2
- IPA(1)=IP1
- IPA(2)=IP2
- ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0
- &.AND.IP2.GE.-3) THEN
- NPA=IABS(IP2)
- DO 130 I=1,NPA
- IPA(I)=IP1+I-1
- 130 CONTINUE
- ELSE
- CALL LUERRM(12,
- & '(LUSHOW:) failed to reconstruct showering system')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
-
-C...Check on phase space available for emission.
- IREJ=0
- DO 140 J=1,5
- PS(J)=0.
- 140 CONTINUE
- PM=0.
- DO 160 I=1,NPA
- KFLA(I)=IABS(K(IPA(I),2))
- PMA(I)=P(IPA(I),5)
-C...Special cutoff masses for t, l, h with variable masses.
- IFLA=KFLA(I)
- IF(KFLA(I).GE.6.AND.KFLA(I).LE.8) THEN
- IFLA=37+KFLA(I)+ISIGN(2,K(IPA(I),2))
- PMTH(1,IFLA)=PMA(I)
- PMTH(2,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PMQTH1**2)
- PMTH(3,IFLA)=PMTH(2,IFLA)+PMQTH2
- PMTH(4,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PARJ(82)**2)+PMTH(2,21)
- PMTH(5,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PARJ(83)**2)+PMTH(2,22)
- ENDIF
- IF(KFLA(I).LE.40) THEN
- IF(KSH(KFLA(I)).EQ.1) PMA(I)=PMTH(3,IFLA)
- ENDIF
- PM=PM+PMA(I)
- IF(KFLA(I).GT.40) THEN
- IREJ=IREJ+1
- ELSE
- IF(KSH(KFLA(I)).EQ.0.OR.PMA(I).GT.QMAX) IREJ=IREJ+1
- ENDIF
- DO 150 J=1,4
- PS(J)=PS(J)+P(IPA(I),J)
- 150 CONTINUE
- 160 CONTINUE
- IF(IREJ.EQ.NPA) RETURN
- PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))
- IF(NPA.EQ.1) PS(5)=PS(4)
- IF(PS(5).LE.PM+PMQTH1) RETURN
-
-C...Check if 3-jet matrix elements to be used.
- M3JC=0
- IF(NPA.EQ.2.AND.MSTJ(47).GE.1) THEN
- IF(KFLA(1).GE.1.AND.KFLA(1).LE.8.AND.KFLA(2).GE.1.AND.
- & KFLA(2).LE.8) M3JC=1
- IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR.
- & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)) M3JC=1
- IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR.
- & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)+1) M3JC=1
- IF((KFLA(1).EQ.12.OR.KFLA(1).EQ.14.OR.KFLA(1).EQ.16.OR.
- & KFLA(1).EQ.18).AND.KFLA(2).EQ.KFLA(1)-1) M3JC=1
- IF(MSTJ(47).EQ.2.OR.MSTJ(47).EQ.4) M3JC=1
- M3JCM=0
- IF(M3JC.EQ.1.AND.MSTJ(47).GE.3.AND.KFLA(1).EQ.KFLA(2)) THEN
- M3JCM=1
- QME=(2.*PMTH(1,KFLA(1))/PS(5))**2
- ENDIF
- ENDIF
-
-C...Find if interference with initial state partons.
- MIIS=0
- IF(MSTJ(50).GE.1.AND.MSTJ(50).LE.3.AND.NPA.EQ.2) MIIS=MSTJ(50)
- IF(MIIS.NE.0) THEN
- DO 180 I=1,2
- KCII(I)=0
- KCA=LUCOMP(KFLA(I))
- IF(KCA.NE.0) KCII(I)=KCHG(KCA,2)*ISIGN(1,K(IPA(I),2))
- NIIS(I)=0
- IF(KCII(I).NE.0) THEN
- DO 170 J=1,2
- ICSI=MOD(K(IPA(I),3+J)/MSTU(5),MSTU(5))
- IF(ICSI.GT.0.AND.ICSI.NE.IPA(1).AND.ICSI.NE.IPA(2).AND.
- & (KCII(I).EQ.(-1)**(J+1).OR.KCII(I).EQ.2)) THEN
- NIIS(I)=NIIS(I)+1
- IIIS(I,NIIS(I))=ICSI
- ENDIF
- 170 CONTINUE
- ENDIF
- 180 CONTINUE
- IF(NIIS(1)+NIIS(2).EQ.0) MIIS=0
- ENDIF
-
-C...Boost interfering initial partons to rest frame
-C...and reconstruct their polar and azimuthal angles.
- IF(MIIS.NE.0) THEN
- DO 200 I=1,2
- DO 190 J=1,5
- K(N+I,J)=K(IPA(I),J)
- P(N+I,J)=P(IPA(I),J)
- V(N+I,J)=0.
- 190 CONTINUE
- 200 CONTINUE
- DO 220 I=3,2+NIIS(1)
- DO 210 J=1,5
- K(N+I,J)=K(IIIS(1,I-2),J)
- P(N+I,J)=P(IIIS(1,I-2),J)
- V(N+I,J)=0.
- 210 CONTINUE
- 220 CONTINUE
- DO 240 I=3+NIIS(1),2+NIIS(1)+NIIS(2)
- DO 230 J=1,5
- K(N+I,J)=K(IIIS(2,I-2-NIIS(1)),J)
- P(N+I,J)=P(IIIS(2,I-2-NIIS(1)),J)
- V(N+I,J)=0.
- 230 CONTINUE
- 240 CONTINUE
- CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),0.,0.,-DBLE(PS(1)/PS(4)),
- & -DBLE(PS(2)/PS(4)),-DBLE(PS(3)/PS(4)))
- PHI=ULANGL(P(N+1,1),P(N+1,2))
- CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),0.,-PHI,0D0,0D0,0D0)
- THE=ULANGL(P(N+1,3),P(N+1,1))
- CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),-THE,0.,0D0,0D0,0D0)
- DO 250 I=3,2+NIIS(1)
- THEIIS(1,I-2)=ULANGL(P(N+I,3),SQRT(P(N+I,1)**2+P(N+I,2)**2))
- PHIIIS(1,I-2)=ULANGL(P(N+I,1),P(N+I,2))
- 250 CONTINUE
- DO 260 I=3+NIIS(1),2+NIIS(1)+NIIS(2)
- THEIIS(2,I-2-NIIS(1))=PARU(1)-ULANGL(P(N+I,3),
- & SQRT(P(N+I,1)**2+P(N+I,2)**2))
- PHIIIS(2,I-2-NIIS(1))=ULANGL(P(N+I,1),P(N+I,2))
- 260 CONTINUE
- ENDIF
-
-C...Define imagined single initiator of shower for parton system.
- NS=N
- IF(N.GT.MSTU(4)-MSTU(32)-5) THEN
- CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
- IF(NPA.GE.2) THEN
- K(N+1,1)=11
- K(N+1,2)=21
- K(N+1,3)=0
- K(N+1,4)=0
- K(N+1,5)=0
- P(N+1,1)=0.
- P(N+1,2)=0.
- P(N+1,3)=0.
- P(N+1,4)=PS(5)
- P(N+1,5)=PS(5)
- V(N+1,5)=PS(5)**2
- N=N+1
- ENDIF
-
-C...Loop over partons that may branch.
- NEP=NPA
- IM=NS
- IF(NPA.EQ.1) IM=NS-1
- 270 IM=IM+1
- IF(N.GT.NS) THEN
- IF(IM.GT.N) GOTO 510
- KFLM=IABS(K(IM,2))
- IF(KFLM.GT.40) GOTO 270
- IF(KSH(KFLM).EQ.0) GOTO 270
- IFLM=KFLM
- IF(KFLM.GE.6.AND.KFLM.LE.8) IFLM=37+KFLM+ISIGN(2,K(IM,2))
- IF(P(IM,5).LT.PMTH(2,IFLM)) GOTO 270
- IGM=K(IM,3)
- ELSE
- IGM=-1
- ENDIF
- IF(N+NEP.GT.MSTU(4)-MSTU(32)-5) THEN
- CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
-
-C...Position of aunt (sister to branching parton).
-C...Origin and flavour of daughters.
- IAU=0
- IF(IGM.GT.0) THEN
- IF(K(IM-1,3).EQ.IGM) IAU=IM-1
- IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1
- ENDIF
- IF(IGM.GE.0) THEN
- K(IM,4)=N+1
- DO 280 I=1,NEP
- K(N+I,3)=IM
- 280 CONTINUE
- ELSE
- K(N+1,3)=IPA(1)
- ENDIF
- IF(IGM.LE.0) THEN
- DO 290 I=1,NEP
- K(N+I,2)=K(IPA(I),2)
- 290 CONTINUE
- ELSEIF(KFLM.NE.21) THEN
- K(N+1,2)=K(IM,2)
- K(N+2,2)=K(IM,5)
- ELSEIF(K(IM,5).EQ.21) THEN
- K(N+1,2)=21
- K(N+2,2)=21
- ELSE
- K(N+1,2)=K(IM,5)
- K(N+2,2)=-K(IM,5)
- ENDIF
-
-C...Reset flags on daughers and tries made.
- DO 300 IP=1,NEP
- K(N+IP,1)=3
- K(N+IP,4)=0
- K(N+IP,5)=0
- KFLD(IP)=IABS(K(N+IP,2))
- IF(KCHG(LUCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1
- ITRY(IP)=0
- ISL(IP)=0
- ISI(IP)=0
- IF(KFLD(IP).LE.40) THEN
- IF(KSH(KFLD(IP)).EQ.1) ISI(IP)=1
- ENDIF
- 300 CONTINUE
- ISLM=0
-
-C...Maximum virtuality of daughters.
- IF(IGM.LE.0) THEN
- DO 310 I=1,NPA
- IF(NPA.GE.3) P(N+I,4)=(PS(4)*P(IPA(I),4)-PS(1)*P(IPA(I),1)-
- & PS(2)*P(IPA(I),2)-PS(3)*P(IPA(I),3))/PS(5)
- P(N+I,5)=MIN(QMAX,PS(5))
- IF(NPA.GE.3) P(N+I,5)=MIN(P(N+I,5),P(N+I,4))
- IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5)
- 310 CONTINUE
- ELSE
- IF(MSTJ(43).LE.2) PEM=V(IM,2)
- IF(MSTJ(43).GE.3) PEM=P(IM,4)
- P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM)
- P(N+2,5)=MIN(P(IM,5),(1.-V(IM,1))*PEM)
- IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22)
- ENDIF
- DO 320 I=1,NEP
- PMSD(I)=P(N+I,5)
- IF(ISI(I).EQ.1) THEN
- IFLD=KFLD(I)
- IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+
- & ISIGN(2,K(N+I,2))
- IF(P(N+I,5).LE.PMTH(3,IFLD)) P(N+I,5)=PMTH(1,IFLD)
- ENDIF
- V(N+I,5)=P(N+I,5)**2
- 320 CONTINUE
-
-C...Choose one of the daughters for evolution.
- 330 INUM=0
- IF(NEP.EQ.1) INUM=1
- DO 340 I=1,NEP
- IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I
- 340 CONTINUE
- DO 350 I=1,NEP
- IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN
- IFLD=KFLD(I)
- IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+
- & ISIGN(2,K(N+I,2))
- IF(P(N+I,5).GE.PMTH(2,IFLD)) INUM=I
- ENDIF
- 350 CONTINUE
- IF(INUM.EQ.0) THEN
- RMAX=0.
- DO 360 I=1,NEP
- IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN
- RPM=P(N+I,5)/PMSD(I)
- IFLD=KFLD(I)
- IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+
- & ISIGN(2,K(N+I,2))
- IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,IFLD)) THEN
- RMAX=RPM
- INUM=I
- ENDIF
- ENDIF
- 360 CONTINUE
- ENDIF
-
-C...Store information on choice of evolving daughter.
- INUM=MAX(1,INUM)
- IEP(1)=N+INUM
- DO 370 I=2,NEP
- IEP(I)=IEP(I-1)+1
- IF(IEP(I).GT.N+NEP) IEP(I)=N+1
- 370 CONTINUE
- DO 380 I=1,NEP
- KFL(I)=IABS(K(IEP(I),2))
- 380 CONTINUE
- ITRY(INUM)=ITRY(INUM)+1
- IF(ITRY(INUM).GT.200) THEN
- CALL LUERRM(14,'(LUSHOW:) caught in infinite loop')
- IF(MSTU(21).GE.1) RETURN
- ENDIF
- Z=0.5
- IF(KFL(1).GT.40) GOTO 430
- IF(KSH(KFL(1)).EQ.0) GOTO 430
- IFL=KFL(1)
- IF(KFL(1).GE.6.AND.KFL(1).LE.8) IFL=37+KFL(1)+
- &ISIGN(2,K(IEP(1),2))
- IF(P(IEP(1),5).LT.PMTH(2,IFL)) GOTO 430
-
-C...Select side for interference with initial state partons.
- IF(MIIS.GE.1.AND.IEP(1).LE.NS+3) THEN
- III=IEP(1)-NS-1
- ISII(III)=0
- IF(IABS(KCII(III)).EQ.1.AND.NIIS(III).EQ.1) THEN
- ISII(III)=1
- ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.1) THEN
- IF(RLU(0).GT.0.5) ISII(III)=1
- ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.2) THEN
- ISII(III)=1
- IF(RLU(0).GT.0.5) ISII(III)=2
- ENDIF
- ENDIF
-
-C...Calculate allowed z range.
- IF(NEP.EQ.1) THEN
- PMED=PS(4)
- ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
- PMED=P(IM,5)
- ELSE
- IF(INUM.EQ.1) PMED=V(IM,1)*PEM
- IF(INUM.EQ.2) PMED=(1.-V(IM,1))*PEM
- ENDIF
- IF(MOD(MSTJ(43),2).EQ.1) THEN
- ZC=PMTH(2,21)/PMED
- ZCE=PMTH(2,22)/PMED
- ELSE
- ZC=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,21)/PMED)**2)))
- IF(ZC.LT.1E-4) ZC=(PMTH(2,21)/PMED)**2
- ZCE=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,22)/PMED)**2)))
- IF(ZCE.LT.1E-4) ZCE=(PMTH(2,22)/PMED)**2
- ENDIF
- ZC=MIN(ZC,0.491)
- ZCE=MIN(ZCE,0.491)
- IF((MSTJ(41).EQ.1.AND.ZC.GT.0.49).OR.(MSTJ(41).GE.2.AND.
- &MIN(ZC,ZCE).GT.0.49)) THEN
- P(IEP(1),5)=PMTH(1,IFL)
- V(IEP(1),5)=P(IEP(1),5)**2
- GOTO 430
- ENDIF
-
-C...Integral of Altarelli-Parisi z kernel for QCD.
- IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN
- FBR=6.*LOG((1.-ZC)/ZC)+MSTJ(45)*(0.5-ZC)
- ELSEIF(MSTJ(49).EQ.0) THEN
- FBR=(8./3.)*LOG((1.-ZC)/ZC)
-
-C...Integral of Altarelli-Parisi z kernel for scalar gluon.
- ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN
- FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1.-2.*ZC)
- ELSEIF(MSTJ(49).EQ.1) THEN
- FBR=(1.-2.*ZC)/3.
- IF(IGM.EQ.0.AND.M3JC.EQ.1) FBR=4.*FBR
-
-C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon.
- ELSEIF(KFL(1).EQ.21) THEN
- FBR=6.*MSTJ(45)*(0.5-ZC)
- ELSE
- FBR=2.*LOG((1.-ZC)/ZC)
- ENDIF
-
-C...Reset QCD probability for lepton.
- IF(KFL(1).GE.11.AND.KFL(1).LE.18) FBR=0.
-
-C...Integral of Altarelli-Parisi kernel for photon emission.
- IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN
- FBRE=(KCHG(KFL(1),1)/3.)**2*2.*LOG((1.-ZCE)/ZCE)
- IF(MSTJ(41).EQ.10) FBRE=PARJ(84)*FBRE
- ENDIF
-
-C...Inner veto algorithm starts. Find maximum mass for evolution.
- 390 PMS=V(IEP(1),5)
- IF(IGM.GE.0) THEN
- PM2=0.
- DO 400 I=2,NEP
- PM=P(IEP(I),5)
- IF(KFL(I).LE.40) THEN
- IFLI=KFL(I)
- IF(KFL(I).GE.6.AND.KFL(I).LE.8) IFLI=37+KFL(I)+
- & ISIGN(2,K(IEP(I),2))
- IF(KSH(KFL(I)).EQ.1) PM=PMTH(2,IFLI)
- ENDIF
- PM2=PM2+PM
- 400 CONTINUE
- PMS=MIN(PMS,(P(IM,5)-PM2)**2)
- ENDIF
-
-C...Select mass for daughter in QCD evolution.
- B0=27./6.
- DO 410 IFF=4,MSTJ(45)
- IF(PMS.GT.4.*PMTH(2,IFF)**2) B0=(33.-2.*IFF)/6.
- 410 CONTINUE
- IF(FBR.LT.1E-3) THEN
- PMSQCD=0.
- ELSEIF(MSTJ(44).LE.0) THEN
- PMSQCD=PMS*EXP(MAX(-50.,LOG(RLU(0))*PARU(2)/(PARU(111)*FBR)))
- ELSEIF(MSTJ(44).EQ.1) THEN
- PMSQCD=4.*ALAMS*(0.25*PMS/ALAMS)**(RLU(0)**(B0/FBR))
- ELSE
- PMSQCD=PMS*EXP(MAX(-50.,ALFM*B0*LOG(RLU(0))/FBR))
- ENDIF
- IF(ZC.GT.0.49.OR.PMSQCD.LE.PMTH(4,IFL)**2) PMSQCD=PMTH(2,IFL)**2
- V(IEP(1),5)=PMSQCD
- MCE=1
-
-C...Select mass for daughter in QED evolution.
- IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN
- PMSQED=PMS*EXP(MAX(-50.,LOG(RLU(0))*PARU(2)/(PARU(101)*FBRE)))
- IF(ZCE.GT.0.49.OR.PMSQED.LE.PMTH(5,IFL)**2) PMSQED=
- & PMTH(2,IFL)**2
- IF(PMSQED.GT.PMSQCD) THEN
- V(IEP(1),5)=PMSQED
- MCE=2
- ENDIF
- ENDIF
-
-C...Check whether daughter mass below cutoff.
- P(IEP(1),5)=SQRT(V(IEP(1),5))
- IF(P(IEP(1),5).LE.PMTH(3,IFL)) THEN
- P(IEP(1),5)=PMTH(1,IFL)
- V(IEP(1),5)=P(IEP(1),5)**2
- GOTO 430
- ENDIF
-
-C...Select z value of branching: q -> qgamma.
- IF(MCE.EQ.2) THEN
- Z=1.-(1.-ZCE)*(ZCE/(1.-ZCE))**RLU(0)
- IF(1.+Z**2.LT.2.*RLU(0)) GOTO 390
- K(IEP(1),5)=22
-
-C...Select z value of branching: q -> qg, g -> gg, g -> qqbar.
- ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN
- Z=1.-(1.-ZC)*(ZC/(1.-ZC))**RLU(0)
- IF(1.+Z**2.LT.2.*RLU(0)) GOTO 390
- K(IEP(1),5)=21
- ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*(0.5-ZC).LT.RLU(0)*FBR) THEN
- Z=(1.-ZC)*(ZC/(1.-ZC))**RLU(0)
- IF(RLU(0).GT.0.5) Z=1.-Z
- IF((1.-Z*(1.-Z))**2.LT.RLU(0)) GOTO 390
- K(IEP(1),5)=21
- ELSEIF(MSTJ(49).NE.1) THEN
- Z=ZC+(1.-2.*ZC)*RLU(0)
- IF(Z**2+(1.-Z)**2.LT.RLU(0)) GOTO 390
- KFLB=1+INT(MSTJ(45)*RLU(0))
- PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5)
- IF(PMQ.GE.1.) GOTO 390
- PMQ0=4.*PMTH(2,21)**2/V(IEP(1),5)
- IF(MOD(MSTJ(43),2).EQ.0.AND.(1.+0.5*PMQ)*SQRT(1.-PMQ).LT.
- & RLU(0)*(1.+0.5*PMQ0)*SQRT(1.-PMQ0)) GOTO 390
- K(IEP(1),5)=KFLB
-
-C...Ditto for scalar gluon model.
- ELSEIF(KFL(1).NE.21) THEN
- Z=1.-SQRT(ZC**2+RLU(0)*(1.-2.*ZC))
- K(IEP(1),5)=21
- ELSEIF(RLU(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN
- Z=ZC+(1.-2.*ZC)*RLU(0)
- K(IEP(1),5)=21
- ELSE
- Z=ZC+(1.-2.*ZC)*RLU(0)
- KFLB=1+INT(MSTJ(45)*RLU(0))
- PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5)
- IF(PMQ.GE.1.) GOTO 390
- K(IEP(1),5)=KFLB
- ENDIF
- IF(MCE.EQ.1.AND.MSTJ(44).GE.2) THEN
- IF(Z*(1.-Z)*V(IEP(1),5).LT.PT2MIN) GOTO 390
- IF(ALFM/LOG(V(IEP(1),5)*Z*(1.-Z)/ALAMS).LT.RLU(0)) GOTO 390
- ENDIF
-
-C...Check if z consistent with chosen m.
- IF(KFL(1).EQ.21) THEN
- KFLGD1=IABS(K(IEP(1),5))
- KFLGD2=KFLGD1
- ELSE
- KFLGD1=KFL(1)
- KFLGD2=IABS(K(IEP(1),5))
- ENDIF
- IF(NEP.EQ.1) THEN
- PED=PS(4)
- ELSEIF(NEP.GE.3) THEN
- PED=P(IEP(1),4)
- ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
- PED=0.5*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5)
- ELSE
- IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM
- IF(IEP(1).EQ.N+2) PED=(1.-V(IM,1))*PEM
- ENDIF
- IF(MOD(MSTJ(43),2).EQ.1) THEN
- IFLGD1=KFLGD1
- IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFL
- PMQTH3=0.5*PARJ(82)
- IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83)
- PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(IEP(1),5)
- PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(IEP(1),5)
- ZD=SQRT(MAX(0.,(1.-V(IEP(1),5)/PED**2)*((1.-PMQ1-PMQ2)**2-
- & 4.*PMQ1*PMQ2)))
- ZH=1.+PMQ1-PMQ2
- ELSE
- ZD=SQRT(MAX(0.,1.-V(IEP(1),5)/PED**2))
- ZH=1.
- ENDIF
- ZL=0.5*(ZH-ZD)
- ZU=0.5*(ZH+ZD)
- IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 390
- IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*
- &(1.-ZU)))
- IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1.-ZL)/MAX(1E-10,1.-ZU))
-
-C...Width suppression for q -> q + g.
- IF(MSTJ(40).NE.0.AND.KFL(1).NE.21) THEN
- IF(IGM.EQ.0) THEN
- EGLU=0.5*PS(5)*(1.-Z)*(1.+V(IEP(1),5)/V(NS+1,5))
- ELSE
- EGLU=PMED*(1.-Z)
- ENDIF
- CHI=PARJ(89)**2/(PARJ(89)**2+EGLU**2)
- IF(MSTJ(40).EQ.1) THEN
- IF(CHI.LT.RLU(0)) GOTO 390
- ELSEIF(MSTJ(40).EQ.2) THEN
- IF(1.-CHI.LT.RLU(0)) GOTO 390
- ENDIF
- ENDIF
-
-C...Three-jet matrix element correction.
- IF(IGM.EQ.0.AND.M3JC.EQ.1) THEN
- X1=Z*(1.+V(IEP(1),5)/V(NS+1,5))
- X2=1.-V(IEP(1),5)/V(NS+1,5)
- X3=(1.-X1)+(1.-X2)
- IF(MCE.EQ.2) THEN
- KI1=K(IPA(INUM),2)
- KI2=K(IPA(3-INUM),2)
- QF1=KCHG(IABS(KI1),1)*ISIGN(1,KI1)/3.
- QF2=KCHG(IABS(KI2),1)*ISIGN(1,KI2)/3.
- WSHOW=QF1**2*(1.-X1)/X3*(1.+(X1/(2.-X2))**2)+
- & QF2**2*(1.-X2)/X3*(1.+(X2/(2.-X1))**2)
- WME=(QF1*(1.-X1)/X3-QF2*(1.-X2)/X3)**2*(X1**2+X2**2)
- ELSEIF(MSTJ(49).NE.1) THEN
- WSHOW=1.+(1.-X1)/X3*(X1/(2.-X2))**2+
- & (1.-X2)/X3*(X2/(2.-X1))**2
- WME=X1**2+X2**2
- IF(M3JCM.EQ.1) WME=WME-QME*X3-0.5*QME**2-
- & (0.5*QME+0.25*QME**2)*((1.-X2)/MAX(1E-7,1.-X1)+
- & (1.-X1)/MAX(1E-7,1.-X2))
- ELSE
- WSHOW=4.*X3*((1.-X1)/(2.-X2)**2+(1.-X2)/(2.-X1)**2)
- WME=X3**2
- IF(MSTJ(102).GE.2) WME=X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)*
- & PARJ(171)
- ENDIF
- IF(WME.LT.RLU(0)*WSHOW) GOTO 390
-
-C...Impose angular ordering by rejection of nonordered emission.
- ELSEIF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2) THEN
- MAOM=1
- ZM=V(IM,1)
- IF(IEP(1).EQ.N+2) ZM=1.-V(IM,1)
- THE2ID=Z*(1.-Z)*(ZM*P(IM,4))**2/V(IEP(1),5)
- IAOM=IM
- 420 IF(K(IAOM,5).EQ.22) THEN
- IAOM=K(IAOM,3)
- IF(K(IAOM,3).LE.NS) MAOM=0
- IF(MAOM.EQ.1) GOTO 420
- ENDIF
- IF(MAOM.EQ.1) THEN
- THE2IM=V(IAOM,1)*(1.-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5)
- IF(THE2ID.LT.THE2IM) GOTO 390
- ENDIF
- ENDIF
-
-C...Impose user-defined maximum angle at first branching.
- IF(MSTJ(48).EQ.1) THEN
- IF(NEP.EQ.1.AND.IM.EQ.NS) THEN
- THE2ID=Z*(1.-Z)*PS(4)**2/V(IEP(1),5)
- IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390
- ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN
- THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5)
- IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390
- ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN
- THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5)
- IF(THE2ID.LT.1./PARJ(86)**2) GOTO 390
- ENDIF
- ENDIF
-
-C...Impose angular constraint in first branching from interference
-C...with initial state partons.
- IF(MIIS.GE.2.AND.IEP(1).LE.NS+3) THEN
- THE2D=MAX((1.-Z)/Z,Z/(1.-Z))*V(IEP(1),5)/(0.5*P(IM,4))**2
- IF(IEP(1).EQ.NS+2.AND.ISII(1).GE.1) THEN
- IF(THE2D.GT.THEIIS(1,ISII(1))**2) GOTO 390
- ELSEIF(IEP(1).EQ.NS+3.AND.ISII(2).GE.1) THEN
- IF(THE2D.GT.THEIIS(2,ISII(2))**2) GOTO 390
- ENDIF
- ENDIF
-
-C...End of inner veto algorithm. Check if only one leg evolved so far.
- 430 V(IEP(1),1)=Z
- ISL(1)=0
- ISL(2)=0
- IF(NEP.EQ.1) GOTO 460
- IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 330
- DO 440 I=1,NEP
- IF(ITRY(I).EQ.0.AND.KFLD(I).LE.40) THEN
- IF(KSH(KFLD(I)).EQ.1) THEN
- IFLD=KFLD(I)
- IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+
- & ISIGN(2,K(N+I,2))
- IF(P(N+I,5).GE.PMTH(2,IFLD)) GOTO 330
- ENDIF
- ENDIF
- 440 CONTINUE
-
-C...Check if chosen multiplet m1,m2,z1,z2 is physical.
- IF(NEP.EQ.3) THEN
- PA1S=(P(N+1,4)+P(N+1,5))*(P(N+1,4)-P(N+1,5))
- PA2S=(P(N+2,4)+P(N+2,5))*(P(N+2,4)-P(N+2,5))
- PA3S=(P(N+3,4)+P(N+3,5))*(P(N+3,4)-P(N+3,5))
- PTS=0.25*(2.*PA1S*PA2S+2.*PA1S*PA3S+2.*PA2S*PA3S-
- & PA1S**2-PA2S**2-PA3S**2)/PA1S
- IF(PTS.LE.0.) GOTO 330
- ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN
- DO 450 I1=N+1,N+2
- KFLDA=IABS(K(I1,2))
- IF(KFLDA.GT.40) GOTO 450
- IF(KSH(KFLDA).EQ.0) GOTO 450
- IFLDA=KFLDA
- IF(KFLDA.GE.6.AND.KFLDA.LE.8) IFLDA=37+KFLDA+
- & ISIGN(2,K(I1,2))
- IF(P(I1,5).LT.PMTH(2,IFLDA)) GOTO 450
- IF(KFLDA.EQ.21) THEN
- KFLGD1=IABS(K(I1,5))
- KFLGD2=KFLGD1
- ELSE
- KFLGD1=KFLDA
- KFLGD2=IABS(K(I1,5))
- ENDIF
- I2=2*N+3-I1
- IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
- PED=0.5*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5)
- ELSE
- IF(I1.EQ.N+1) ZM=V(IM,1)
- IF(I1.EQ.N+2) ZM=1.-V(IM,1)
- PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2-
- & 4.*V(N+1,5)*V(N+2,5))
- PED=PEM*(0.5*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/V(IM,5)
- ENDIF
- IF(MOD(MSTJ(43),2).EQ.1) THEN
- PMQTH3=0.5*PARJ(82)
- IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83)
- IFLGD1=KFLGD1
- IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFLDA
- PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(I1,5)
- PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(I1,5)
- ZD=SQRT(MAX(0.,(1.-V(I1,5)/PED**2)*((1.-PMQ1-PMQ2)**2-
- & 4.*PMQ1*PMQ2)))
- ZH=1.+PMQ1-PMQ2
- ELSE
- ZD=SQRT(MAX(0.,1.-V(I1,5)/PED**2))
- ZH=1.
- ENDIF
- ZL=0.5*(ZH-ZD)
- ZU=0.5*(ZH+ZD)
- IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(1)=1
- IF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(2)=1
- IF(KFLDA.EQ.21) V(I1,4)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*(1.-ZU)))
- IF(KFLDA.NE.21) V(I1,4)=LOG((1.-ZL)/MAX(1E-10,1.-ZU))
- 450 CONTINUE
- IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN
- ISL(3-ISLM)=0
- ISLM=3-ISLM
- ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN
- ZDR1=MAX(0.,V(N+1,3)/MAX(1E-6,V(N+1,4))-1.)
- ZDR2=MAX(0.,V(N+2,3)/MAX(1E-6,V(N+2,4))-1.)
- IF(ZDR2.GT.RLU(0)*(ZDR1+ZDR2)) ISL(1)=0
- IF(ISL(1).EQ.1) ISL(2)=0
- IF(ISL(1).EQ.0) ISLM=1
- IF(ISL(2).EQ.0) ISLM=2
- ENDIF
- IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 330
- ENDIF
- IFLD1=KFLD(1)
- IF(KFLD(1).GE.6.AND.KFLD(1).LE.8) IFLD1=37+KFLD(1)+
- &ISIGN(2,K(N+1,2))
- IFLD2=KFLD(2)
- IF(KFLD(2).GE.6.AND.KFLD(2).LE.8) IFLD2=37+KFLD(2)+
- &ISIGN(2,K(N+2,2))
- IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE.
- &PMTH(2,IFLD1).OR.P(N+2,5).GE.PMTH(2,IFLD2))) THEN
- PMQ1=V(N+1,5)/V(IM,5)
- PMQ2=V(N+2,5)/V(IM,5)
- ZD=SQRT(MAX(0.,(1.-V(IM,5)/PEM**2)*((1.-PMQ1-PMQ2)**2-
- & 4.*PMQ1*PMQ2)))
- ZH=1.+PMQ1-PMQ2
- ZL=0.5*(ZH-ZD)
- ZU=0.5*(ZH+ZD)
- IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 330
- ENDIF
-
-C...Accepted branch. Construct four-momentum for initial partons.
git://git.uio.no / u / mrichter / AliRoot.git / commitdiff