This commit was generated by cvs2svn to compensate for changes in r18048,
authorhristov <hristov@f7af4fe6-9843-0410-8265-dc069ae4e863>
Fri, 20 Apr 2007 06:38:54 +0000 (06:38 +0000)
committerhristov <hristov@f7af4fe6-9843-0410-8265-dc069ae4e863>
Fri, 20 Apr 2007 06:38:54 +0000 (06:38 +0000)
which included commits to RCS files with non-trunk default branches.

17 files changed:
THydjet/AliGenHydjet.cxx [new file with mode: 0755]
THydjet/AliGenHydjet.h [new file with mode: 0755]
THydjet/AliGenHydjetEventHeader.cxx [new file with mode: 0755]
THydjet/AliGenHydjetEventHeader.h [new file with mode: 0755]
THydjet/HydCommon.h [new file with mode: 0755]
THydjet/THydjet.cxx [new file with mode: 0755]
THydjet/THydjet.h [new file with mode: 0755]
THydjet/THydjetLinkDef.h [new file with mode: 0755]
THydjet/hydjet1_1/hep-ph0312204.ps.gz [new file with mode: 0644]
THydjet/hydjet1_1/hydjet.txt [new file with mode: 0644]
THydjet/hydjet1_1/hydjet1_1.f [new file with mode: 0644]
THydjet/hydjet1_1/hydjet1_1.update [new file with mode: 0644]
THydjet/hydjet1_1/jetset_73.f [new file with mode: 0644]
THydjet/hydjet1_1/pyquen1_1.f [new file with mode: 0644]
THydjet/hydjet1_1/pyquen1_1.update [new file with mode: 0644]
THydjet/hydjet1_1/test_hydjet.f [new file with mode: 0644]
THydjet/libTHydjet.pkg [new file with mode: 0755]

diff --git a/THydjet/AliGenHydjet.cxx b/THydjet/AliGenHydjet.cxx
new file mode 100755 (executable)
index 0000000..3d90a42
--- /dev/null
@@ -0,0 +1,293 @@
+/**************************************************************************
+ * Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
+ *                                                                        *
+ * Author: The ALICE Off-line Project.                                    *
+ * Contributors are mentioned in the code where appropriate.              *
+ *                                                                        *
+ * Permission to use, copy, modify and distribute this software and its   *
+ * documentation strictly for non-commercial purposes is hereby granted   *
+ * without fee, provided that the above copyright notice appears in all   *
+ * copies and that both the copyright notice and this permission notice   *
+ * appear in the supporting documentation. The authors make no claims     *
+ * about the suitability of this software for any purpose. It is          *
+ * provided "as is" without express or implied warranty.                  *
+ **************************************************************************/
+
+/* $Id$ */
+
+// Generator using Hydjet as an external generator
+// The main Hydjet options are accessable for the user through this interface.
+// Uses the THydjet implementation of TGenerator.
+// Author:
+// Rafael Diaz Valdes    (rafael.diaz.valdes@cern.ch)
+//
+#include <Riostream.h>
+#include <THydjet.h>
+#include <TParticle.h>
+#include <TClonesArray.h>
+
+#include "AliGenHydjet.h"
+#include "AliGenHydjetEventHeader.h"
+#include "AliRun.h"
+#include "AliPythiaRndm.h"
+
+ClassImp(AliGenHydjet)
+
+AliGenHydjet::AliGenHydjet(Int_t npart) :
+  AliGenMC(npart),
+    //initial parameters
+  fEnergyCMS(5500.),      //Energy cms
+  fFrame("CMS"),      // Reference frame
+  fAtomicWeigth(207),        // Projectile-Target atomic weight
+  fIfbtype(0),          // centrality type
+  fFixImpactParam(0),          // fixed impact parameter
+  fMinImpactParam(0.),         // minimum impact parameter
+  fMaxImpactParam(1.),         // maximum impact parameter
+  fSoftMult(20000),      // mean soft multiplicity
+  //hydro parameters
+  fJetProd(2),          // flag Jet production (nhsel)
+  fYflow(5.),         // max longitudinal flow
+  fTflow(1.),         // max transverse flow
+  fSoftFract(1.),         // Soft multiplicity fraction
+  // PYTHIA parameters
+  fDijetProd(1),          // flag dijet production
+  fMinPtHard(10.),        // min pt hard
+  fStructFunction(7),          // Structure Function (default CTEQ5M)
+  fMultipleInt(0),          // flag multiple interaction
+
+  fHydjet(0),
+
+  fSelectAll(0),
+  fFlavor(0)
+    
+{
+// Default PbPb collisions at 5. 5 TeV
+//
+  fName = "Hydjet";
+  fTitle = "Particle Generator using Hydjet";
+  fParticles = new TClonesArray("TParticle",10000);
+   // Set random number generator 
+    if (!AliPythiaRndm::GetPythiaRandom()) 
+      AliPythiaRndm::SetPythiaRandom(GetRandom());
+}
+
+AliGenHydjet::~AliGenHydjet()
+{
+// Destructor
+    delete fParticles;
+}
+
+void AliGenHydjet::Init()
+{
+// Initialisation
+
+    SetMC(new THydjet(fEnergyCMS, fFrame,fAtomicWeigth,
+                      fIfbtype,fMinImpactParam, fMaxImpactParam,
+                      fFixImpactParam,fSoftMult));
+
+    fHydjet=(THydjet*) fMCEvGen;
+
+    // init hydro common blocks
+    fHydjet->SetNHSEL(fJetProd);
+    fHydjet->SetYLFL(fYflow);
+    fHydjet->SetYTFL(fTflow);
+    fHydjet->SetFPART(fSoftFract);
+    // init PYTHIA common block
+    fHydjet->SetMSEL(fDijetProd);
+    fHydjet->SetPTMIN(fMinPtHard);
+    fHydjet->SetCKIN(3,fMinPtHard);
+    fHydjet->SetMSTP(51,fStructFunction);
+    fHydjet->SetMSTP(81,0);
+    fHydjet->SetMSTU(21,1); 
+    fHydjet->SetPARU(14,1.);
+    
+//  Initialize Hydjet  
+    fHydjet->Initialize();
+
+}
+
+void AliGenHydjet::Generate()
+{
+
+///////////////////////////////////////////////////////////////////////////////////////////
+  Float_t polar[3]    =   {0,0,0};
+  Float_t origin[3]   =   {0,0,0};
+  Float_t origin0[3]  =   {0,0,0};
+  Float_t p[3];
+  Float_t tof;
+
+//  converts from mm/c to s
+  const Float_t kconv = 0.001/2.999792458e8;
+//
+  Int_t nt  = 0;
+  Int_t j, kf, ks, imo;
+  kf = 0;
+
+  for (j = 0;j < 3; j++) origin0[j] = fOrigin[j];
+  if(fVertexSmear == kPerEvent) {
+      Vertex();
+      for (j=0; j < 3; j++) origin0[j] = fVertex[j];
+  }
+
+  while(1)
+  {
+//    Generate one event
+      fHydjet->GenerateEvent();
+      fHydjet->ImportParticles(fParticles,"All");
+
+      Int_t np = fParticles->GetEntriesFast();
+      printf("\n **************************************************%d\n",np);
+      Int_t nc = 0;
+      if (np == 0 ) continue;
+      Int_t i;
+      Int_t* pSelected  = new Int_t[np];
+
+      for (i = 0; i < np; i++) {
+           pSelected[i] = 0;
+      }
+
+//      Get event vertex
+      fVertex[0] = origin0[0];
+      fVertex[1] = origin0[1];
+      fVertex[2] = origin0[2];
+
+//
+// Now select the final state particles
+//
+
+      for(i = 0; i<np; i++){
+         TParticle *  iparticle = (TParticle *) fParticles->At(i);
+         // Is this a final state particle ?
+         if (!Stable(iparticle)) continue;
+         Bool_t selected = kTRUE;
+         kf = iparticle->GetPdgCode();
+         ks = iparticle->GetStatusCode();
+         if(!fSelectAll) selected = KinematicSelection(iparticle,0)&&SelectFlavor(kf);
+         // Put particle on the stack if selected
+         if(selected) {
+           nc++;
+           pSelected[i] = 1;
+         } // selected
+      } // particle loop final state
+
+
+//
+// Write particles to stack
+//
+
+      for(i = 0; i<np; i++) {
+         TParticle *  iparticle = (TParticle *) fParticles->At(i);
+         Bool_t  hasDaughter = (iparticle->GetFirstDaughter() > 0);
+         if(pSelected[i]){
+           kf = iparticle->GetPdgCode();
+           ks = iparticle->GetStatusCode();
+           p[0] = iparticle->Px();
+           p[1] = iparticle->Py();
+           p[2] = iparticle->Pz();
+           origin[0] = fVertex[0]+iparticle->Vx()/10;
+           origin[1] = fVertex[1]+iparticle->Vy()/10;
+           origin[2] = fVertex[2]+iparticle->Vz()/10;
+           tof   = kconv*iparticle->T();
+
+           imo = -1;
+           //imo = iparticle->GetFirstMother();
+           //if(imo == 0) imo =-1;
+           Bool_t tFlag = (fTrackIt && !hasDaughter);
+           PushTrack(tFlag,imo,kf,p,origin,polar,tof,kPNoProcess,nt, 1., ks);
+           KeepTrack(nt);
+         } // if selected
+      } // particle loop
+      delete[] pSelected;
+
+      printf("\n I've put %i particles on the stack \n",nc);
+      if (nc > 0) break;
+  } // event loop
+  MakeHeader();
+}
+
+
+Bool_t AliGenHydjet::SelectFlavor(Int_t pid)
+{
+// Select flavor of particle
+// 0: all
+// 4: charm and beauty
+// 5: beauty
+    Bool_t res = 0;
+    if (fFlavor == 0) {
+       res = kTRUE;
+    } else {
+       Int_t ifl = TMath::Abs(pid/100);
+       if (ifl > 10) ifl/=10;
+       res = (fFlavor == ifl);
+    }
+    return res;
+}
+
+Bool_t AliGenHydjet::Stable(TParticle*  particle) const
+{
+// Return true for a stable particle
+    if (particle->GetFirstDaughter() == 0 )
+    {
+       return kTRUE;
+    } else {
+       return kFALSE;
+    }
+}
+
+
+///////////////////////////////////
+void AliGenHydjet::MakeHeader()
+{
+// Builds the event header, to be called after each event
+    AliGenEventHeader* header = new AliGenHydjetEventHeader("Hydjet");
+    ((AliGenHydjetEventHeader*) header)->SetNProduced(fHydjet->GetN());
+    ((AliGenHydjetEventHeader*) header)->SetImpactParameter(fHydjet->GetBGEN());
+    ((AliGenHydjetEventHeader*) header)->SetNbcol(fHydjet->GetNBCOL());
+    ((AliGenHydjetEventHeader*) header)->SetNpart(fHydjet->GetNPART());
+    ((AliGenHydjetEventHeader*) header)->SetNpyt(fHydjet->GetNPYT());
+    ((AliGenHydjetEventHeader*) header)->SetNhyd(fHydjet->GetNHYD());
+  // draw generation values
+  cout << "*********Hyflow ********** " << endl;
+  cout << " YTFL " << fHydjet->GetYTFL() << endl;
+  cout << " YLFL " << fHydjet->GetYLFL() << endl;
+  cout << " FPART " << fHydjet->GetFPART() << endl;
+  cout << "*********Hyjpar ********* " << endl;
+  cout << " GetNHSEL() " << fHydjet->GetNHSEL() << endl;
+  cout << " GetPTMIN() " << fHydjet->GetPTMIN() << endl;
+  cout << " GetNJET() " << fHydjet->GetNJET() << endl;
+  cout << "*********Hyfpar ********* " << endl;
+  cout << " GetBGEN() " << fHydjet->GetBGEN() << endl;
+  cout << " GetNBCOL() " << fHydjet->GetNBCOL() << endl;
+  cout << " GetNPART() " << fHydjet->GetNPART() << endl;
+  cout << " GetNPYT() " << fHydjet->GetNPYT() << endl;
+  cout << " GetNHYD() " << fHydjet->GetNHYD() << endl;
+  
+
+// Event Vertex
+    header->SetPrimaryVertex(fVertex);
+    AddHeader(header);
+    fCollisionGeometry = (AliGenHydjetEventHeader*)  header;
+}
+
+void AliGenHydjet::AddHeader(AliGenEventHeader* header)
+{
+    // Passes header either to the container or to gAlice
+    if (fContainer) {
+       fContainer->AddHeader(header);
+    } else {
+       gAlice->SetGenEventHeader(header);
+    }
+}
+
+
+void AliGenHydjet::Copy(TObject &) const
+{
+  Fatal("Copy","Not implemented!\n");
+}
+
+AliGenHydjet& AliGenHydjet::operator=(const  AliGenHydjet& rhs)
+{
+    rhs.Copy(*this); 
+    return (*this);
+}
+
diff --git a/THydjet/AliGenHydjet.h b/THydjet/AliGenHydjet.h
new file mode 100755 (executable)
index 0000000..7f04e6d
--- /dev/null
@@ -0,0 +1,100 @@
+#ifndef ALIGENHYDJET_H
+#define ALIGENHYDJET_H
+/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
+ * See cxx source for full Copyright notice                               */
+
+/* $Id$ */
+
+// Generator using Hydjet as an external generator
+// The main Hydjet options are accessable for the user through this interface.
+// rafael.diaz.valdes@cern.ch
+
+
+#include "AliGenMC.h"
+#include <TString.h>
+
+class THydjet;
+class TParticle;
+class TClonesArray;
+
+class AliGenHydjet : public AliGenMC
+{
+
+ public:
+    AliGenHydjet(Int_t npart=0);
+    virtual ~AliGenHydjet();
+    virtual void    Generate();
+    virtual void    Init();
+    // set initial beam parameters
+    virtual void    SetEnergyCMS(Float_t energy=5500.) {fEnergyCMS=energy;}
+    virtual void    SetReferenceFrame(TString frame="CMS") {fFrame=frame;}
+    virtual void    SetProjectileWeigth(Int_t a=207){fAtomicWeigth=a;}
+    virtual void    SetCentralityType(Int_t ifb=0){fIfbtype = ifb;}
+    virtual void    SetFixedImpactParameter(Float_t bfix=0) {fFixImpactParam = bfix;}
+    virtual void    SetImpactParameterRange(Float_t bmin = 0., Float_t bmax = 1.)
+                                     {fMinImpactParam=bmin; fMaxImpactParam=bmax;}
+    virtual void    SetMeanSoftMultiplicity(Int_t mult=20000){fSoftMult=mult;}
+    // set hydro parameters
+    virtual void    SetJetProduction(Int_t nhsel = 2){fJetProd=nhsel;}
+    virtual void    SetMaxLongitudinalFlow(Float_t yflow = 5.){fYflow=yflow;}
+    virtual void    SetMaxTransverseFlow(Float_t tflow = 1.){fTflow=tflow;}
+    virtual void    SetSoftMultFraction(Float_t softfract = 1.){fSoftFract=softfract;}
+    // set input PYTHIA parameters
+    virtual void    SetDiJetProd(Int_t flag=1){fDijetProd=flag;}
+    virtual void    SetMinPtHard(Float_t ptmin=10.){fMinPtHard=ptmin;}
+    virtual void    SetStructFunction(Int_t mstp =7){fStructFunction=mstp;} // CTEQ5M
+    virtual void    SetMultipleInteractions(Int_t flag=0){fMultipleInt=flag;}
+
+    virtual void    SetFlavor(Int_t flag=0)           {fFlavor     = flag;}
+    virtual void    SetSelectAll(Int_t flag=0)        {fSelectAll  = flag;}
+    virtual void    AddHeader(AliGenEventHeader* header);
+
+// Getters
+   // virtual Float_t GetEnergyCMS()       const {return fEnergyCMS;}
+   // virtual TString GetReferenceFrame()  const {return fFrame;}
+
+//
+    AliGenHydjet &  operator=(const AliGenHydjet & rhs);
+ protected:
+    Bool_t SelectFlavor(Int_t pid);
+    void   MakeHeader();
+ protected:
+    //initial parameters
+    Float_t     fEnergyCMS;      //Energy cms
+    TString     fFrame;          // Reference frame
+    Float_t     fAtomicWeigth;   // Projectile-Target atomic weight
+    Int_t       fIfbtype;        // centrality type
+    Float_t     fFixImpactParam; // fixed impact parameter
+    Float_t     fMinImpactParam; // minimum impact parameter
+    Float_t     fMaxImpactParam; // maximum impact parameter
+    Int_t       fSoftMult;       // mean soft multiplicity
+    //hydro parameters
+    Int_t       fJetProd;        // flag Jet production (nhsel)
+    Float_t     fYflow;          // max longitudinal flow
+    Float_t     fTflow;          // max transverse flow
+    Float_t     fSoftFract;      // Soft multiplicity fraction
+    // PYTHIA parameters
+    Int_t       fDijetProd;      // flag dijet production
+    Float_t     fMinPtHard;      // min pt hard
+    Int_t       fStructFunction; // Structure Function (default CTEQ5M)
+    Int_t       fMultipleInt;    // flag multiple interaction
+
+    THydjet    *fHydjet;         //!Hydjet
+
+    Int_t       fSelectAll;      // Flag to write the full event
+    Int_t       fFlavor;         // Selected particle flavor 4: charm+beauty 5: beauty
+
+ private:
+    AliGenHydjet(const AliGenHydjet &Hijing);
+    void Copy(TObject &rhs) const;
+    // check if stable
+    Bool_t Stable(TParticle*  particle) const;
+
+    ClassDef(AliGenHydjet, 1) // AliGenerator interface to Hydjet
+};
+#endif
+
+
+
+
+
diff --git a/THydjet/AliGenHydjetEventHeader.cxx b/THydjet/AliGenHydjetEventHeader.cxx
new file mode 100755 (executable)
index 0000000..1cbeb4b
--- /dev/null
@@ -0,0 +1,49 @@
+/**************************************************************************
+ * Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
+ *                                                                        *
+ * Author: The ALICE Off-line Project.                                    *
+ * Contributors are mentioned in the code where appropriate.              *
+ *                                                                        *
+ * Permission to use, copy, modify and distribute this software and its   *
+ * documentation strictly for non-commercial purposes is hereby granted   *
+ * without fee, provided that the above copyright notice appears in all   *
+ * copies and that both the copyright notice and this permission notice   *
+ * appear in the supporting documentation. The authors make no claims     *
+ * about the suitability of this software for any purpose. It is          *
+ * provided "as is" without express or implied warranty.                  *
+ **************************************************************************/
+
+/* $Id$ */
+
+// Event Header for Hydjet generator
+// Output generator parameters are accessable
+// for the user through this interface.
+// Author: Rafael Diaz Valdes
+// (rafael.diaz.valdes@cern.ch)
+//
+
+#include "AliGenHydjetEventHeader.h"
+ClassImp(AliGenHydjetEventHeader)
+
+AliGenHydjetEventHeader::AliGenHydjetEventHeader():
+    fNjet(0),
+    fImpactParam(0),
+    fNbcol(0),
+    fNpart(0),
+    fNpyt(0),
+    fNhyd(0)
+{
+    // Constructor
+}
+
+AliGenHydjetEventHeader::AliGenHydjetEventHeader(const char* name):
+    AliGenEventHeader(name),
+    fNjet(0),
+    fImpactParam(0),
+    fNbcol(0),
+    fNpart(0),
+    fNpyt(0),
+    fNhyd(0)
+{
+    // Copy Constructor
+}
diff --git a/THydjet/AliGenHydjetEventHeader.h b/THydjet/AliGenHydjetEventHeader.h
new file mode 100755 (executable)
index 0000000..7f201aa
--- /dev/null
@@ -0,0 +1,48 @@
+#ifndef ALIGENHYDJETEVENTHEADER_H
+#define ALIGENHYDJETEVENTHEADER_H
+
+/* Copyright(c) 1998-1999, ALICE Experiment at CERN, All rights reserved. *
+ * See cxx source for full Copyright notice                               */
+
+/* $Id$ */
+
+// Event Header for Hydjet generator
+// Output generator parameters are accessable
+// for the user through this interface.
+// Author: Rafael Diaz Valdes
+// (rafael.diaz.valdes@cern.ch)
+
+#include "AliGenEventHeader.h"
+#include "AliCollisionGeometry.h"
+
+class AliGenHydjetEventHeader : public AliGenEventHeader, public AliCollisionGeometry
+{
+ public:
+
+  AliGenHydjetEventHeader(const char* name);
+  AliGenHydjetEventHeader();
+  virtual ~AliGenHydjetEventHeader() {}
+
+  // Setters
+  virtual void   SetNJets(Int_t njet) {fNjet=njet;}
+  virtual void   SetImpactParameter(Float_t bgen) {fImpactParam=bgen;}
+  virtual void   SetNbcol(Float_t nbcol){fNbcol=nbcol;}
+  virtual void   SetNpart(Float_t npart){fNpart=npart;}
+  virtual void   SetNpyt(Float_t npyt){fNpyt=npyt;}
+  virtual void   SetNhyd(Float_t nhyd){fNhyd=nhyd;}
+
+protected:
+
+  Float_t fNjet;         //number of hard parton-parton scatterings with pt>ptmin in event.
+  Float_t fImpactParam;  //generated value of impact parameter in units of nucleus radius RA
+                         //(i.e the value in [fm] will be bgen*RA).
+  Float_t fNbcol;        //mean number of nucleon-nucleon binary sub-collisions at given 'bgen'.
+  Float_t fNpart;        //mean number of nucleon participants at given 'bgen'.
+  Float_t fNpyt;         //multiplicity of hard PYTHIA/PYQUEN-induced particles in event
+                         //(including full parton story).
+  Float_t fNhyd;         //multiplicity of soft HYDRO-induced hadrons in event.
+
+  ClassDef(AliGenHydjetEventHeader,1) // Event header for Hydjet event
+};
+
+#endif
diff --git a/THydjet/HydCommon.h b/THydjet/HydCommon.h
new file mode 100755 (executable)
index 0000000..b0b63c8
--- /dev/null
@@ -0,0 +1,229 @@
+#ifndef ROOT_HydCommon
+#define ROOT_HydCommon
+//****************************************************************************//
+//      -------------------------------------------------------------         //
+//      HYDJET, fast MC code to simulate flow effects, jet production         // 
+//      and jet quenching in heavy ion AA collisions at the LHC               //
+//      -------------------------------------------------------------         //
+//      This code is merging HYDRO (flow effects), PYTHIA6.4 (hard jet        // 
+//      production) and PYQUEN (jet quenching)                                //
+//      --------------------------------------------------------------        //
+//                                                                            //
+//      Igor Lokhtin, SINP MSU, Moscow, RU                                    //
+//        e-mail: Igor.Lokhtin@cern.ch                                        // 
+//                                                                            //
+//      Reference for HYDJET:                                                 // 
+//      I.P. Lokhtin, A.M. Snigirev,                                          // 
+//      Eur. Phys. J. C 46 (2006) 211.                                        //
+//                                                                            //
+//      References for HYDRO:                                                 // 
+//      N.A.Kruglov, I.P.Lokhtin, L.I.Sarycheva, A.M.Snigirev,                // 
+//      Z. Phys. C 76 (1997) 99;                                              //  
+//      I.P.Lokhtin, L.I.Sarycheva, A.M.Snigirev,                             // 
+//      Phys. Lett. B 537 (2002) 261;                                         //   
+//    I.P.Lokhtin, A.M.Snigirev, Preprint SINP MSU 2004-14/753,hep-ph/0312204.//
+//                                                                            //
+//      References for PYQUEN:                                                // 
+//      I.P.Lokhtin, A.M.Snigirev, Eur.Phys.J. C16 (2000) 527;                //   
+//    I.P.Lokhtin, A.M.Snigirev, Preprint SINP MSU 2004-13/752, hep-ph/0406038.//
+//                                                                             //
+//      References for PYTHIA:                                                 //
+//      T.Sjostrand et al., Comput.Phys.Commun. 135 (2001) 238;                // 
+//      T.Sjostrand, S. Mrena and P. Skands, hep-ph/0603175.                   //
+//                                                                             //
+//      Reference for JETSET event format:                                     //
+//      T.Sjostrand, Comput.Phys.Commun. 82 (1994) 74.                         //
+//                                                                             // 
+//      --------------------------------------------------------------         //
+//      Web-page:                                                              //
+//      http://cern.ch/lokhtin/hydro                                           //
+//      --------------------------------------------------------------         //
+//                                                                             //
+//**************************************************************************** //
+#ifndef __CFORTRAN_LOADED
+//*KEEP,cfortran.
+#include "cfortran.h"
+//*KEND.
+#endif
+
+extern "C" {
+
+
+/*=========================================================*/
+/* COMMON/HYFLOW/YTFL,YLFL,FPART */
+/*---------------------------------------------------------*/
+typedef struct {
+   float    ytfl;
+   float    ylfl;
+   float    fpart;
+} HyflowCommon;
+
+#define HYFLOW COMMON_BLOCK(HYFLOW,hyflow)
+COMMON_BLOCK_DEF(HyflowCommon,HYFLOW);
+
+/**************************************************************************/
+/*           D E S C R I P T I O N :                                      */
+/*------------------------------------------------------------------------*/
+/*COMMON /hyflow/ ytfl,ylfl,fpart
+ytfl - maximum transverse collective rapidity, controls slope of low-pt spectra
+(allowed range is 0.01<ytfl<3.0, default value is ytfl=1.).
+ylfl - maximum longitudinal collective rapidity, controls width of eta-spectra
+(allowed range is 0.01<ylfl<7.0, default value is ylfl=5.).
+fpart - fraction of soft multiplicity proportional to the number of nucleon
+participants; then (1.-fpart) will be the fraction of soft multiplicity
+proportional to the number of nucleon-nucleon binary sub-collisions
+(allowed range is 0.01<fpart<1.0, default value is fpart=1.).
+========================================================================*/
+
+/*========================================================================*/
+/* COMMON/HYJPAR/NHSEL,PTMIN,NJET                                         */
+/*------------------------------------------------------------------------*/
+typedef struct {
+   Int_t      nhsel;
+   float      ptmin;
+   Int_t      njet;
+} HyjparCommon;
+
+#define HYJPAR COMMON_BLOCK(HYJPAR,hyjpar)
+COMMON_BLOCK_DEF(HyjparCommon,HYJPAR);
+/*************************************************************************/
+/*           D E S C R I P T I O N :                                     */
+/*-----------------------------------------------------------------------*/
+/*COMMON /hyjpar/ nhsel,ptmin,njet
+Input Parameters:
+nhsel - flag to include jet production in hydro event:
+nhsel=0 - jet production off (pure HYDRO event);
+nhsel=1 - jet production on, jet quenching off (HYDRO+njet*PYTHIA events);
+nhsel=2 - jet production & jet quenching on (HYDRO+njet*PYQUEN events);
+nhsel=3 - jet production on, jet quenching off, HYDRO off (njet*PYTHIA events);
+nhsel=4 - jet production & jet quenching on, HYDRO off (njet*PYQUEN events);
+(default value is nhsel = 0).
+ptmin - minimal pt of parton-parton scattering in PYTHIA event, parameter
+ckin(3) in PYTHIA common block /pysubs/ should be set equal to ptmin
+(allowed range is 5 GeV < ptmin < 500 GeV, default value ptmin=10 GeV).
+
+Output Parameters:
+njet - number of hard parton-parton scatterings with pt>ptmin in event.
+*/
+/*=======================================================================*/
+
+
+
+/*========================================================*/
+/* COMMON/HYFPAR/ BGEN,NBCOL,NPART.NPYT,NHYD              */
+/*--------------------------------------------------------*/
+typedef struct {
+   float  bgen;
+   int  nbcol;
+   int  npart;
+   int  npyt;
+   int  nhyd;
+} HyfparCommon;
+
+#define HYFPAR COMMON_BLOCK(HYFPAR,hyfpar)
+COMMON_BLOCK_DEF(HyfparCommon,HYFPAR);
+/*************************************************************************/
+/*           D E S C R I P T I O N :                                     */
+/*-----------------------------------------------------------------------*/
+/*common /hyfpar/ bgen,nbcol,npart,npyt,nhyd
+bgen - generated value of impact parameter in units of nucleus radius RA
+(i.e the value in [fm] will be bgen*RA).
+nbcol - mean number of nucleon-nucleon binary sub-collisions at given 'bgen'.
+npart - mean number of nucleon participants at given 'bgen'.
+npyt - multiplicity of hard PYTHIA/PYQUEN-induced particles in event
+       (including full parton story).
+nhyd - multiplicity of soft HYDRO-induced hadrons in event.
+                                                                        */
+/*=======================================================================*/
+
+/*=======================================================================*/
+// COMMON/LUJETS/ N,K(150000,5),P(150000,5),V(150000,5)
+/*-----------------------------------------------------------------------*/
+typedef struct {
+   Int_t    n;
+   Int_t    k[5][150000];
+   Float_t p[5][150000];
+   Float_t v[5][150000];
+} LujetsCommon;
+
+#define LUJETS COMMON_BLOCK(LUJETS,lujets)
+COMMON_BLOCK_DEF(LujetsCommon,LUJETS);
+/*************************************************************************/
+/*          D E S C R I P T I O N :                                     */
+/*-----------------------------------------------------------------------*/
+/*COMMON /lujets/ n,k(150000,5),p(150000,5),v(150000,5)
+n - total event multiplicity
+k(i,1-5) - particle codes
+p(i,1-5) - particle four-momentum and mass
+v(i,1-5) - particle vertex, production time and lifetime
+
+NOTE! First 'npyt' lines in event list correspond to PYTHIA/PYQUEN-induced
+      particles, last 'nhyd' lines -- HYDRO-induced hadrons.
+                                                                        */
+/*=======================================================================*/
+
+/*=======================================================================*/
+// COMMON/HYJETS/ NL,KL(150000,5),PL(150000,5),VL(150000,5)
+/*-----------------------------------------------------------------------*/
+typedef struct {
+   Int_t     nl;
+   Int_t     kl[5][150000];
+   Float_t  pl[5][150000];
+   Float_t  vl[5][150000];
+} HyjetsCommon;
+
+#define HYJETS COMMON_BLOCK(HYJETS,hyjets)
+COMMON_BLOCK_DEF(HyjetsCommon,HYJETS);
+/*************************************************************************/
+/*           D E S C R I P T I O N :                                     */
+/*-----------------------------------------------------------------------*/
+/*COMMON /hyjets/ nl,kl(150000,5),pl(150000,5),vl(150000,5)
+contains list of parton history of event in the same format as /lujets/ */
+/*=======================================================================*/
+
+/* COMMON from Pythia */
+
+/*=======================================================================*/
+/* COMMON/PYDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)                */
+/*-----------------------------------------------------------------------*/
+typedef struct {
+  Int_t     mstu[200];
+  Double_t  paru[200];
+  Int_t     mstj[200];
+  Double_t  parj[200];
+} Pydat1Common;
+
+#define PYDAT1 COMMON_BLOCK(PYDAT1,pydat1)
+COMMON_BLOCK_DEF(Pydat1Common,PYDAT1);
+
+
+/*=======================================================================*/
+// COMMON/PYSUBS/ MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
+/*-----------------------------------------------------------------------*/
+typedef struct {
+  Int_t    msel;
+  Int_t    mselpd;
+  Int_t    msub[500];
+  Int_t    kfin[2][81];
+  Double_t ckin[200];
+} PysubsCommon;
+
+#define PYSUBS COMMON_BLOCK(PYSUBS,pysubs)
+COMMON_BLOCK_DEF(PysubsCommon,PYSUBS);
+
+/*=======================================================================*/
+// COMMON/PYPARS/ MSTP(200),PARP(200),MSTI(200),PARI(200)
+/*-----------------------------------------------------------------------*/
+typedef struct {
+  Int_t     mstp[200];
+  Double_t  parp[200];
+  Int_t     msti[200];
+  Double_t  pari[200];
+} PyparsCommon;
+
+#define PYPARS COMMON_BLOCK(PYPARS,pypars)
+COMMON_BLOCK_DEF(PyparsCommon,PYPARS);
+
+}
+
+#endif
diff --git a/THydjet/THydjet.cxx b/THydjet/THydjet.cxx
new file mode 100755 (executable)
index 0000000..8f11707
--- /dev/null
@@ -0,0 +1,705 @@
+////////////////////////////////////////////////////////////////////////////////
+//                                                                            //
+// THydjet                                                                    //
+//                                                                            //
+// THydjet is an interface class to fortran version of Hydjet event generator //
+//                                                                            //
+//      -------------------------------------------------------------         //
+//      HYDJET, fast MC code to simulate flow effects, jet production         // 
+//      and jet quenching in heavy ion AA collisions at the LHC               //
+//      -------------------------------------------------------------         //
+//      This code is merging HYDRO (flow effects), PYTHIA6.4 (hard jet        // 
+//      production) and PYQUEN (jet quenching)                                //
+//      --------------------------------------------------------------        //
+//                                                                            //
+//      Igor Lokhtin, SINP MSU, Moscow, RU                                    //
+//        e-mail: Igor.Lokhtin@cern.ch                                        // 
+//                                                                            //
+//      Reference for HYDJET:                                                 // 
+//      I.P. Lokhtin, A.M. Snigirev,                                          // 
+//      Eur. Phys. J. C 46 (2006) 211.                                        //
+//                                                                            //
+//      References for HYDRO:                                                 // 
+//      N.A.Kruglov, I.P.Lokhtin, L.I.Sarycheva, A.M.Snigirev,                // 
+//      Z. Phys. C 76 (1997) 99;                                              //  
+//      I.P.Lokhtin, L.I.Sarycheva, A.M.Snigirev,                             // 
+//      Phys. Lett. B 537 (2002) 261;                                         //   
+//    I.P.Lokhtin, A.M.Snigirev, Preprint SINP MSU 2004-14/753,hep-ph/0312204.//
+//                                                                            //
+//      References for PYQUEN:                                                // 
+//      I.P.Lokhtin, A.M.Snigirev, Eur.Phys.J. C16 (2000) 527;                //   
+//    I.P.Lokhtin, A.M.Snigirev, Preprint SINP MSU 2004-13/752, hep-ph/0406038.//
+//                                                                             //
+//      References for PYTHIA:                                                 //
+//      T.Sjostrand et al., Comput.Phys.Commun. 135 (2001) 238;                // 
+//      T.Sjostrand, S. Mrena and P. Skands, hep-ph/0603175.                   //
+//                                                                             //
+//      Reference for JETSET event format:                                     //
+//      T.Sjostrand, Comput.Phys.Commun. 82 (1994) 74.                         //
+//                                                                             // 
+//      --------------------------------------------------------------         //
+//      Web-page:                                                              //
+//      http://cern.ch/lokhtin/hydro                                           //
+//      --------------------------------------------------------------         //
+//                                                                             //
+//**************************************************************************** //
+
+#include "THydjet.h"
+#include "TObjArray.h"
+#include "HydCommon.h"
+#include "TParticle.h"
+#include "TROOT.h"
+
+#ifndef WIN32
+# define pyinit pyinit_
+# define hydro hydro_
+# define type_of_call
+#else
+# define pyinit PYINIT
+# define hydro HYDRO
+# define type_of_call _stdcall
+#endif
+
+extern "C" void type_of_call hydro(float* A, int* ifb, float* bmin,
+                                    float* bmax, float* bfix, int* nh);
+//extern "C" void type_of_call luedit(Int_t& medit);
+#ifndef WIN32
+extern "C" void type_of_call pyinit( const char *frame, const char *beam, const char *target,
+                                     double *win, Long_t l_frame, Long_t l_beam,
+                                     Long_t l_target);
+#else
+extern "C" void type_of_call pyinit( const char *frame,  Long_t l_frame,
+                                    const char *beam,   Long_t l_beam,
+                                    const char *target, Long_t l_target,
+                                    double *win
+                                    );
+#endif
+
+#include <TClonesArray.h>
+
+ClassImp(THydjet)
+
+THydjet::THydjet() :
+  TGenerator("Hydjet","Hydjet"),
+  fEfrm(5500),
+  fFrame("CMS"),
+  fAw(207),
+  fIfb(0),
+  fBmin(0.),
+  fBmax(1.),
+  fBfix(0.),
+  fNh(20000)
+{
+// Default constructor
+}
+
+//______________________________________________________________________________
+THydjet::THydjet(Float_t efrm, const char *frame="CMS",
+                Float_t aw=207., Int_t ifb=0, Float_t bmin=0, Float_t bmax=1, Float_t bfix=0,
+                Int_t nh=20000) :
+  TGenerator("Hydjet","Hydjet"),
+  fEfrm(efrm),
+  fFrame(frame),
+  fAw(aw),
+  fIfb(ifb),
+  fBmin(bmin),
+  fBmax(bmax),
+  fBfix(bfix),
+  fNh(nh)
+{
+// THydjet constructor:
+}
+
+//______________________________________________________________________________
+THydjet::~THydjet()
+{
+// Destructor
+}
+
+
+TObjArray* THydjet::ImportParticles(Option_t *option)
+{
+//
+//  Default primary creation method. It reads the /LUJETS common block which
+//  has been filled by the GenerateEvent method.
+//  The function loops on the generated particles and store them in
+//  the TClonesArray pointed by the argument particles.
+//  The default action is to store only the stable particles (LUJETS.k[0][i] == 1)
+//  This can be demanded explicitly by setting the option = "Final"
+//  If the option = "All", all the particles are stored.
+//
+    fParticles->Clear();
+    Int_t numpart = LUJETS.n;
+    printf("\n THydjet: Hydjet stack contains %d particles.", numpart);
+    Int_t nump = 0;
+    if(!strcmp(option,"") || !strcmp(option,"Final")) {
+        for(Int_t i = 0; i < numpart; i++) {
+            if(LUJETS.k[0][i] == 1) {
+              //Use the common block values for the TParticle constructor
+              nump++;
+              TParticle* p = new TParticle(
+              LUJETS.k[1][i], LUJETS.k[0][i] ,
+              LUJETS.k[2][i], -1, LUJETS.k[3][i], LUJETS.k[4][i],
+              LUJETS.p[0][i], LUJETS.p[1][i], LUJETS.p[2][i], LUJETS.p[3][i] ,
+              LUJETS.v[0][i], LUJETS.v[1][i], LUJETS.v[2][i], LUJETS.v[3][i]
+              );
+              fParticles->Add(p);
+                }
+            }
+    }
+    else if(!strcmp(option,"All")) {
+              nump = numpart;
+              for(Int_t i = 0; i < numpart; i++){
+              TParticle* p = new TParticle(
+              LUJETS.k[1][i], LUJETS.k[0][i] ,
+              LUJETS.k[2][i], -1, LUJETS.k[3][i], LUJETS.k[4][i],
+              LUJETS.p[0][i], LUJETS.p[1][i], LUJETS.p[2][i], LUJETS.p[3][i] ,
+              LUJETS.v[0][i], LUJETS.v[1][i], LUJETS.v[2][i], LUJETS.v[3][i]
+              );
+              fParticles->Add(p);
+          }
+    }
+    return fParticles;
+}
+
+Int_t THydjet::ImportParticles(TClonesArray *particles, Option_t *option)
+{
+//
+//  Default primary creation method. It reads the /LUJETS common block which
+//  has been filled by the GenerateEvent method.
+//  The function loops on the generated particles and store them in
+//  the TClonesArray pointed by the argument particles.
+//  The default action is to store only the stable particles (LUJETS.k[0][i] == 1)
+//  This can be demanded explicitly by setting the option = "Final"
+//  If the option = "All", all the particles are stored.
+//
+  if (particles == 0) return 0;
+  TClonesArray &particlesR = *particles;
+  particlesR.Clear();
+  Int_t numpart = LUJETS.n;
+  printf("\n THydjet: Hydjet stack contains %d particles.", numpart);
+  Int_t nump = 0;
+  if(!strcmp(option,"") || !strcmp(option,"Final")) {
+        for(Int_t i = 0; i < numpart; i++) {
+            if(LUJETS.k[0][i] == 1) {
+              //Use the common block values for the TParticle constructor
+              nump++;
+              new(particlesR[i]) TParticle(
+              LUJETS.k[1][i], LUJETS.k[0][i] ,
+              LUJETS.k[2][i], -1, LUJETS.k[3][i], LUJETS.k[4][i],
+              LUJETS.p[0][i], LUJETS.p[1][i], LUJETS.p[2][i], LUJETS.p[3][i] ,
+              LUJETS.v[0][i], LUJETS.v[1][i], LUJETS.v[2][i], LUJETS.v[3][i]
+              );
+                }
+            }
+    }
+    else if(!strcmp(option,"All")){
+              nump = numpart;
+              for(Int_t i = 0; i < numpart; i++){
+              new(particlesR[i]) TParticle(
+              LUJETS.k[1][i], LUJETS.k[0][i] ,
+              LUJETS.k[2][i], -1, LUJETS.k[3][i], LUJETS.k[4][i],
+              LUJETS.p[0][i], LUJETS.p[1][i], LUJETS.p[2][i], LUJETS.p[3][i] ,
+              LUJETS.v[0][i], LUJETS.v[1][i], LUJETS.v[2][i], LUJETS.v[3][i]
+              );
+          }
+    }
+    return nump;
+}
+
+//______________________________________________________________________________
+void THydjet::SetEfrm(Float_t efrm)
+{
+// Set the centre of mass (CMS) or lab-energy (LAB)
+   fEfrm=efrm;
+}
+//______________________________________________________________________________
+void THydjet::SetFrame(const char* frame)
+{
+// Set the frame type ("CMS" or "LAB")
+   fFrame=frame;
+}
+//______________________________________________________________________________
+/*void THydjet::SetProj(const char* proj)
+{
+// Set the projectile type
+   fProj=proj;
+}
+//______________________________________________________________________________
+void THydjet::SetTarg(const char* targ)
+{
+// Set the target type
+   fTarg=targ;
+}
+*/
+//______________________________________________________________________________
+void THydjet::SetAw(Float_t aw)
+{
+// Set the projectile-targed atomic number
+   fAw=aw;
+}
+//______________________________________________________________________________
+void THydjet::SetIfb(Int_t ifb)
+{
+// flag of type of centrality generation
+   fIfb=ifb;
+} 
+//______________________________________________________________________________
+void THydjet::SetBmin(Float_t bmin)
+{
+// set minimum impact parameter in units of nucleus radius RA
+   fBmin=bmin;
+}
+//______________________________________________________________________________
+void THydjet::SetBmax(Float_t bmax)
+{
+// set maximum impact parameter in units of nucleus radius RA
+   fBmax=bmax;
+} 
+//______________________________________________________________________________
+void THydjet::SetBfix(Float_t bfix)
+{
+// Set fixed impact parameter in units of nucleus radius RA
+   fBfix=bfix;
+} 
+//______________________________________________________________________________
+void THydjet::SetNh(Int_t nh)
+{
+// Set mean soft hadron multiplicity in central Pb-Pb collisions
+   fNh=nh;
+} 
+//______________________________________________________________________________
+Float_t THydjet::GetEfrm() const
+{
+// Get the centre of mass (CMS) or lab-energy (LAB)
+   return fEfrm;
+}
+//______________________________________________________________________________
+const char* THydjet::GetFrame() const
+{
+// Get the frame type ("CMS" or "LAB")
+   return fFrame.Data();
+}
+//______________________________________________________________________________
+/*const char* THydjet::GetProj() const
+{
+// Get the projectile type
+   return fProj;
+}
+//______________________________________________________________________________
+const char* THydjet::GetTarg() const
+{
+// Set the target type
+   return fTarg;
+}
+*/
+//______________________________________________________________________________
+Float_t THydjet::GetAw() const
+{
+// Get the projectile atomic number
+   return fAw;
+}
+//______________________________________________________________________________
+Int_t THydjet::GetIfb() const
+{
+// Get flag of type of centrality generation
+   return fIfb;
+}
+//______________________________________________________________________________
+Float_t THydjet::GetBmin() const
+{
+// Get minimum impact parameter in units of nucleus radius RA
+   return fBmin;
+} 
+//______________________________________________________________________________
+Float_t THydjet::GetBmax() const
+{
+// Get maximum impact parameter in units of nucleus radius RA
+   return fBmax;
+}
+//______________________________________________________________________________
+Float_t THydjet::GetBfix() const
+{
+// Get fixed impact parameter in units of nucleus radius RA
+   return fBfix;
+}
+//______________________________________________________________________________
+Int_t THydjet::GetNh() const
+{
+// Get mean soft hadron multiplicity in central Pb-Pb collisions
+   return fNh;
+} 
+
+//====================== access to common HYFLOW ===============================
+
+//______________________________________________________________________________
+const void THydjet::SetYTFL(Float_t value) const
+{
+   HYFLOW.ytfl=value;
+}
+
+//______________________________________________________________________________
+Float_t THydjet::GetYTFL() const
+{
+   return HYFLOW.ytfl;
+}
+
+//______________________________________________________________________________
+const void THydjet::SetYLFL(Float_t value) const
+{
+   HYFLOW.ylfl=value;
+}
+
+//______________________________________________________________________________
+Float_t THydjet::GetYLFL() const
+{
+   return HYFLOW.ylfl;
+}
+
+//______________________________________________________________________________
+const void THydjet::SetFPART(Float_t value) const
+{
+   HYFLOW.fpart=value;
+}
+
+
+//______________________________________________________________________________
+Float_t THydjet::GetFPART() const
+{
+   return HYFLOW.fpart;
+}
+
+
+//====================== access to common HYJPAR ===============================
+
+//______________________________________________________________________________
+const void THydjet::SetNHSEL(Int_t value) const
+{
+   HYJPAR.nhsel=value;
+}
+
+//______________________________________________________________________________
+Int_t THydjet::GetNHSEL() const
+{
+   return HYJPAR.nhsel;
+}
+
+//______________________________________________________________________________
+const void THydjet::SetPTMIN(Float_t value) const
+{
+   HYJPAR.ptmin=value;
+}
+
+//______________________________________________________________________________
+Float_t THydjet::GetPTMIN() const
+{
+   return HYJPAR.ptmin;
+}
+
+//______________________________________________________________________________
+const void THydjet::SetNJET(Int_t value) const
+{
+  HYJPAR.njet=value;
+}
+
+//______________________________________________________________________________
+Int_t  THydjet::GetNJET() const
+{
+   return HYJPAR.njet;
+}
+
+//====================== access to common HYFPAR ===============================
+
+//______________________________________________________________________________
+Float_t THydjet::GetBGEN() const
+{
+   return HYFPAR.bgen;
+}
+
+//______________________________________________________________________________
+Int_t THydjet::GetNBCOL() const
+{
+   return HYFPAR.nbcol;
+}
+
+//______________________________________________________________________________
+Int_t THydjet::GetNPART() const
+{
+   return HYFPAR.npart;
+}
+
+//______________________________________________________________________________
+Int_t THydjet::GetNPYT() const
+{
+   return HYFPAR.npyt;
+}
+
+//______________________________________________________________________________
+Int_t THydjet::GetNHYD() const
+{
+   return HYFPAR.nhyd;
+}
+
+
+//====================== access to common LUJETS ===============================
+
+//______________________________________________________________________________
+Int_t THydjet::GetN() const
+{
+   return LUJETS.n;
+}
+
+//______________________________________________________________________________
+Int_t THydjet::GetK(Int_t key1, Int_t key2) const
+{
+  // Get Particle codes information
+   if ( key1<1 || key1>150000 ) {
+      printf("ERROR in THydjet::GetK(key1,key2):\n");
+      printf("      key1=%i is out of range [1..150000]\n",key1);
+      return 0;
+   }
+
+   if ( key2<1 || key2>5 ) {
+      printf("ERROR in THydjet::GetK(key1,key2):\n");
+      printf("      key2=%i is out of range [1..5]\n",key2);
+      return 0;
+   }
+
+   return   LUJETS.k[key2-1][key1-1];
+}
+
+//______________________________________________________________________________
+Float_t THydjet::GetP(Int_t key1, Int_t key2) const
+{
+   // Get Particle four momentum and mass
+   if ( key1<1 || key1>150000 ) {
+      printf("ERROR in THydjet::GetP(key1,key2):\n");
+      printf("      key1=%i is out of range [1..150000]\n",key1);
+      return 0;
+   }
+
+   if ( key2<1 || key2>5 ) {
+      printf("ERROR in THydjet::GetP(key1,key2):\n");
+      printf("      key2=%i is out of range [1..5]\n",key2);
+      return 0;
+   }
+
+   return   LUJETS.p[key2-1][key1-1];
+}
+
+//______________________________________________________________________________
+Float_t THydjet::GetV(Int_t key1, Int_t key2) const
+{
+   // Get particle vertex, production time and lifetime
+   if ( key1<1 || key1>150000 ) {
+      printf("ERROR in THydjet::GetV(key1,key2):\n");
+      printf("      key1=%i is out of range [1..150000]\n",key1);
+      return 0;
+   }
+
+   if ( key2<1 || key2>5 ) {
+      printf("ERROR in THydjet::GetV(key1,key2):\n");
+      printf("      key2=%i is out of range [1..5]\n",key2);
+      return 0;
+   }
+
+   return   LUJETS.v[key2-1][key1-1];
+}
+
+//====================== access to common HYJETS ===============================
+
+//______________________________________________________________________________
+Int_t THydjet::GetNL() const
+{
+   return HYJETS.nl;
+}
+
+//______________________________________________________________________________
+Int_t THydjet::GetKL(Int_t key1, Int_t key2) const
+{
+   // Get Particle codes information
+   if ( key1<1 || key1>150000 ) {
+      printf("ERROR in THydjet::GetKL(key1,key2):\n");
+      printf("      key1=%i is out of range [1..150000]\n",key1);
+      return 0;
+   }
+
+   if ( key2<1 || key2>5 ) {
+      printf("ERROR in THydjet::GetKL(key1,key2):\n");
+      printf("      key2=%i is out of range [1..5]\n",key2);
+      return 0;
+   }
+
+   return   HYJETS.kl[key2-1][key1-1];
+}
+
+//______________________________________________________________________________
+Float_t THydjet::GetPL(Int_t key1, Int_t key2) const
+{
+   // Get Particle four momentum and mass
+   if ( key1<1 || key1>150000 ) {
+      printf("ERROR in THydjet::GetPL(key1,key2):\n");
+      printf("      key1=%i is out of range [1..150000]\n",key1);
+      return 0;
+   }
+
+   if ( key2<1 || key2>5 ) {
+      printf("ERROR in THydjet::GetPL(key1,key2):\n");
+      printf("      key2=%i is out of range [1..5]\n",key2);
+      return 0;
+   }
+
+   return   HYJETS.pl[key2-1][key1-1];
+}
+
+//______________________________________________________________________________
+Float_t THydjet::GetVL(Int_t key1, Int_t key2) const
+{
+   // Get particle vertex, production time and lifetime
+   if ( key1<1 || key1>150000 ) {
+      printf("ERROR in THydjet::GetVL(key1,key2):\n");
+      printf("      key1=%i is out of range [1..150000]\n",key1);
+      return 0;
+   }
+
+   if ( key2<1 || key2>5 ) {
+      printf("ERROR in THydjet::GetVL(key1,key2):\n");
+      printf("      key2=%i is out of range [1..5]\n",key2);
+      return 0;
+   }
+
+   return   HYJETS.vl[key2-1][key1-1];
+}
+
+
+//====================== access to common PYDAT1 ===============================
+
+//______________________________________________________________________________
+void THydjet::SetMSTU(Int_t key, Int_t value)
+{
+   //Set MSTU in Pythia 
+   if ( key<1 || key>200 ) {
+      printf("ERROR in THydjet::SetMSTU(key,value):\n");
+      printf("      key=%i is out of range [1..200]\n",key);
+   }
+   PYDAT1.mstu[key-1] = value;
+}
+
+//______________________________________________________________________________
+void THydjet::SetPARU(Int_t key, Double_t value)
+{
+   //Set PARU in Pythia 
+   if ( key<1 || key>200 ) {
+      printf("ERROR in THydjet::SetPARU(key,value):\n");
+      printf("      key=%i is out of range [1..200]\n",key);
+   }
+   PYDAT1.paru[key-1] = value;
+}
+
+//______________________________________________________________________________
+void THydjet::SetMSTJ(Int_t key, Int_t value)
+{
+   //Set MSTJ in Pythia 
+   if ( key<1 || key>200 ) {
+      printf("ERROR in THydjet::SetMSTJ(key,value):\n");
+      printf("      key=%i is out of range [1..200]\n",key);
+   }
+   PYDAT1.mstj[key-1] = value;
+}
+
+//______________________________________________________________________________
+void THydjet::SetPARJ(Int_t key, Double_t value)
+{
+   //Set PARJ in Pythia 
+   if ( key<1 || key>200 ) {
+      printf("ERROR in THydjet::SetPARJ(key,value):\n");
+      printf("      key=%i is out of range [1..200]\n",key);
+   }
+   PYDAT1.parj[key-1] = value;
+}
+
+
+//====================== access to common PYSUBS ===============================
+
+//______________________________________________________________________________
+const void THydjet::SetMSEL(Int_t value) const
+{
+  PYSUBS.msel=value;
+}
+
+//______________________________________________________________________________
+void THydjet::SetCKIN(Int_t key, Double_t value)
+{
+   //Set CKIN in Pythia 
+   if ( key<1 || key>200 ) {
+      printf("ERROR in THydjet::SetCKIN(key,value):\n");
+      printf("      key=%i is out of range [1..200]\n",key);
+   }
+   PYSUBS.ckin[key-1] = value;
+}
+
+//====================== access to common PYPARS ===============================
+
+//______________________________________________________________________________
+void THydjet::SetMSTP(Int_t key, Int_t value)
+{
+   //Set MSTP in Pythia 
+   if ( key<1 || key>200 ) {
+      printf("ERROR in THydjet::SetMSTP(key,value):\n");
+      printf("      key=%i is out of range [1..200]\n",key);
+   }
+   PYPARS.mstp[key-1] = value;
+}
+
+
+//====================== access to Hijing subroutines =========================
+
+
+//______________________________________________________________________________
+void THydjet::Initialize()
+{
+
+   // Initialize PYTHIA for hard parton-parton scattering
+   if ( (!strcmp(fFrame.Data(), "CMS     "  )) &&
+        (!strcmp(fFrame.Data(), "LAB     "  ))){
+      printf("WARNING! In THydjet:Initialize():\n");
+      printf(" specified frame=%s is neither CMS or LAB\n",fFrame.Data());
+      printf(" resetting to default \"CMS\" .");
+      fFrame="CMS";
+   }
+   Int_t nhselflag = GetNHSEL();
+   if(nhselflag != 0) {
+      Double_t lwin = fEfrm;
+      Long_t  s1    = strlen(fFrame);
+      Long_t  s2    = strlen("p");
+      Long_t  s3    = strlen("p");
+#ifndef WIN32
+     pyinit(fFrame,"p","p",&lwin,s1,s2,s3);
+#else
+     pyinit(fFrame, s1, "p" , s2, "p", s3, &lwin);
+#endif
+   }
+}
+
+
+//______________________________________________________________________________
+void THydjet::GenerateEvent()
+{
+// Generates one event;
+  float xbmin = fBmin;
+  float xbmax = fBmax;
+  float xbfix = fBfix;
+  float xAw   = fAw;
+  hydro(&xAw,&fIfb,&xbmin,&xbmax,&xbfix,&fNh);
+
+}
+//______________________________________________________________________________
+void THydjet::Hydro()
+{
+  // Generates one event;
+  float xbmin = fBmin;
+  float xbmax = fBmax;
+  float xbfix = fBfix;
+  float xAw   = fAw;
+  hydro(&xAw,&fIfb,&xbmin,&xbmax,&xbfix,&fNh);
+}
diff --git a/THydjet/THydjet.h b/THydjet/THydjet.h
new file mode 100755 (executable)
index 0000000..e98e671
--- /dev/null
@@ -0,0 +1,177 @@
+#ifndef THYDJET_H
+#define THYDJET_H
+
+
+//////////////////////////////////////////////////////////////////////////
+//                                                                      //
+// THydjet                                                              //
+//                                                                      //
+// This class implements an interface to the Hydjet event generator.    //
+//                                                                      //
+//////////////////////////////////////////////////////////////////////////
+
+#ifndef ROOT_TGenerator
+#include "TGenerator.h"
+#endif
+class TObjArray;
+
+class THydjet : public TGenerator {
+
+
+public:
+
+   THydjet();
+   THydjet(Float_t efrm, const char *frame, Float_t aw,
+           Int_t ifb, Float_t bmin, Float_t bmax, Float_t bfix, Int_t nh);
+   virtual            ~THydjet();
+
+   virtual void        Initialize();
+
+   virtual void        GenerateEvent();
+
+   virtual Int_t       ImportParticles(TClonesArray *particles, Option_t *option="");
+   virtual TObjArray*  ImportParticles(Option_t *option="");
+
+
+   //Parameters for the generation:
+   
+   virtual void        SetEfrm(Float_t efrm);
+   virtual Float_t     GetEfrm() const;
+
+   virtual void        SetFrame(const char *frame);
+   virtual const char *GetFrame() const;
+
+   virtual void        SetAw(Float_t aw);
+   virtual Float_t     GetAw() const;
+
+   virtual void        SetIfb(Int_t ifb);
+   virtual Int_t       GetIfb() const;
+
+   virtual void        SetBmin(Float_t bmin);
+   virtual Float_t     GetBmin() const;
+
+   virtual void        SetBmax(Float_t bmax);
+   virtual Float_t     GetBmax() const;
+
+   virtual void        SetBfix(Float_t bfix);
+   virtual Float_t     GetBfix() const;
+
+   virtual void        SetNh(Int_t nh);
+   virtual Int_t       GetNh() const;
+
+
+
+   //common HYFLOW access routines:
+
+   virtual const void  SetYTFL(Float_t ytfl) const;
+   virtual Float_t     GetYTFL() const;
+
+   virtual const void  SetYLFL(Float_t ylfl) const;
+   virtual Float_t     GetYLFL() const;
+
+   virtual const void  SetFPART(Float_t fpart) const;
+   virtual Float_t     GetFPART() const;
+
+   //common HYJPAR access routines
+
+   virtual const void  SetNHSEL(Int_t nhsel) const;
+   virtual Int_t       GetNHSEL() const;
+
+   virtual const void  SetPTMIN(Float_t ptmin) const;
+   virtual Float_t     GetPTMIN() const;
+
+   virtual const void  SetNJET(Int_t njet) const;
+   virtual Int_t       GetNJET() const;
+
+   // common HYFPAR access routines - read-only common:
+
+   virtual Float_t     GetBGEN() const;
+
+   virtual Int_t     GetNBCOL() const;
+
+   virtual Int_t     GetNPART() const;
+
+   virtual Int_t     GetNPYT() const;
+
+   virtual Int_t     GetNHYD() const;
+
+
+   // common LUJETS access routines - read-only common:
+
+   virtual Int_t       GetN() const;
+
+   virtual Int_t       GetK(Int_t key1, Int_t key2) const;
+
+   virtual Float_t     GetP(Int_t key1, Int_t key2) const;
+
+   virtual Float_t     GetV(Int_t key1, Int_t key2) const;
+
+
+   // common HYJETS access routines - read-only common:
+
+   virtual Int_t       GetNL() const;
+
+   virtual Int_t       GetKL(Int_t key1, Int_t key2) const;
+
+   virtual Float_t     GetPL(Int_t key1, Int_t key2) const;
+
+   virtual Float_t     GetVL(Int_t key1, Int_t key2) const;
+
+   // common PYDAT1 access routines:
+
+   virtual void        SetMSTU(Int_t key, Int_t value);
+
+   virtual void        SetPARU(Int_t key, Double_t value);
+
+   virtual void        SetMSTJ(Int_t key, Int_t value);
+
+   virtual void        SetPARJ(Int_t key, Double_t value);
+
+   // common PYSUBS access routines:
+
+   virtual const void  SetMSEL(Int_t msel) const;
+
+   virtual void        SetCKIN(Int_t key, Double_t value);
+
+   // common PYPARS access routines:
+
+   virtual void        SetMSTP(Int_t key, Int_t value);
+
+   // access to HYDJET routines:
+
+   virtual void         Hydro();
+
+
+   protected:
+
+    Float_t      fEfrm;     // Energy in the centre of mass (CMS) or lab-frame (LAB)
+    TString      fFrame;    // Reference frame CMS or LAB
+    Float_t      fAw;       // Beam and target nucleus atomic weight
+    Int_t        fIfb;       // flag of type of centrality generation
+                            //    0 impact parameter fixed (bfix)
+                            //    else impact parameter is generated with standard Glauber geometry
+                                //    between minimum (bmin) and maximum (bmax) values
+    Float_t      fBmin;     // Minimum impact parameter in units of nucleus radius RA
+                            // (i.e. minimum value in [fm] will be bmin*RA),
+                            // valid only if ifb not equal to zero
+    Float_t      fBmax;     // Maximum impact parameter in units of nucleus radius RA
+                            // (i.e. maximum value in [fm] will be bmax*RA),
+                            // valid only if ifb not equal to zero
+    Float_t      fBfix;     // Fixed impact parameter in units of nucleus radius RA
+                            // (i.e. fixed value in [fm] will be bfix*RA),
+                            // valid only if ifb=0
+    Int_t        fNh;       // Mean soft hadron multiplicity in central Pb-Pb collisions
+                            // (multiplicity for other centralities and atomic numbers
+                            // will be calculated automatically).
+
+    ClassDef(THydjet,1)  //Interface to Hydjet Event Generator
+};
+
+#endif
+
+
+
+
+
+
+
diff --git a/THydjet/THydjetLinkDef.h b/THydjet/THydjetLinkDef.h
new file mode 100755 (executable)
index 0000000..c03e938
--- /dev/null
@@ -0,0 +1,10 @@
+#ifdef __CINT__
+#pragma link off all globals;
+#pragma link off all classes;
+#pragma link off all functions;
+#pragma link C++ class THydjet+;
+#pragma link C++ class AliGenHydjet+;
+#pragma link C++ class AliGenHydjetEventHeader+;
+#endif
diff --git a/THydjet/hydjet1_1/hep-ph0312204.ps.gz b/THydjet/hydjet1_1/hep-ph0312204.ps.gz
new file mode 100644 (file)
index 0000000..6304ded
--- /dev/null
@@ -0,0 +1,1103 @@
+%!PS-Adobe-2.0
+%%Creator: dvips(k) 5.86 Copyright 1999 Radical Eye Software
+%%Title: arXiv:hep-ph/0312204 v2   21 Jun 2004
+%%Pages: 6
+%%PageOrder: Ascend
+%%BoundingBox: 0 0 612 792
+%%EndComments
+%DVIPSWebPage: (www.radicaleye.com)
+%DVIPSCommandLine: dvips -z -R -K1 hep-ph0312204.dvi -o
+%DVIPSParameters: dpi=300, compressed, comments removed
+%DVIPSSource:  TeX output 2004.09.07:0807
+%%BeginProcSet: texc.pro
+/TeXDict 300 dict def TeXDict begin/N{def}def/B{bind def}N/S{exch}N/X{S
+N}B/A{dup}B/TR{translate}N/isls false N/vsize 11 72 mul N/hsize 8.5 72
+mul N/landplus90{false}def/@rigin{isls{[0 landplus90{1 -1}{-1 1}ifelse 0
+0 0]concat}if 72 Resolution div 72 VResolution div neg scale isls{
+landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div hsize
+mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul TR[
+matrix currentmatrix{A A round sub abs 0.00001 lt{round}if}forall round
+exch round exch]setmatrix}N/@landscape{/isls true N}B/@manualfeed{
+statusdict/manualfeed true put}B/@copies{/#copies X}B/FMat[1 0 0 -1 0 0]
+N/FBB[0 0 0 0]N/nn 0 N/IEn 0 N/ctr 0 N/df-tail{/nn 8 dict N nn begin
+/FontType 3 N/FontMatrix fntrx N/FontBBox FBB N string/base X array
+/BitMaps X/BuildChar{CharBuilder}N/Encoding IEn N end A{/foo setfont}2
+array copy cvx N load 0 nn put/ctr 0 N[}B/sf 0 N/df{/sf 1 N/fntrx FMat N
+df-tail}B/dfs{div/sf X/fntrx[sf 0 0 sf neg 0 0]N df-tail}B/E{pop nn A
+definefont setfont}B/Cw{Cd A length 5 sub get}B/Ch{Cd A length 4 sub get
+}B/Cx{128 Cd A length 3 sub get sub}B/Cy{Cd A length 2 sub get 127 sub}
+B/Cdx{Cd A length 1 sub get}B/Ci{Cd A type/stringtype ne{ctr get/ctr ctr
+1 add N}if}B/id 0 N/rw 0 N/rc 0 N/gp 0 N/cp 0 N/G 0 N/CharBuilder{save 3
+1 roll S A/base get 2 index get S/BitMaps get S get/Cd X pop/ctr 0 N Cdx
+0 Cx Cy Ch sub Cx Cw add Cy setcachedevice Cw Ch true[1 0 0 -1 -.1 Cx
+sub Cy .1 sub]/id Ci N/rw Cw 7 add 8 idiv string N/rc 0 N/gp 0 N/cp 0 N{
+rc 0 ne{rc 1 sub/rc X rw}{G}ifelse}imagemask restore}B/G{{id gp get/gp
+gp 1 add N A 18 mod S 18 idiv pl S get exec}loop}B/adv{cp add/cp X}B
+/chg{rw cp id gp 4 index getinterval putinterval A gp add/gp X adv}B/nd{
+/cp 0 N rw exit}B/lsh{rw cp 2 copy get A 0 eq{pop 1}{A 255 eq{pop 254}{
+A A add 255 and S 1 and or}ifelse}ifelse put 1 adv}B/rsh{rw cp 2 copy
+get A 0 eq{pop 128}{A 255 eq{pop 127}{A 2 idiv S 128 and or}ifelse}
+ifelse put 1 adv}B/clr{rw cp 2 index string putinterval adv}B/set{rw cp
+fillstr 0 4 index getinterval putinterval adv}B/fillstr 18 string 0 1 17
+{2 copy 255 put pop}for N/pl[{adv 1 chg}{adv 1 chg nd}{1 add chg}{1 add
+chg nd}{adv lsh}{adv lsh nd}{adv rsh}{adv rsh nd}{1 add adv}{/rc X nd}{
+1 add set}{1 add clr}{adv 2 chg}{adv 2 chg nd}{pop nd}]A{bind pop}
+forall N/D{/cc X A type/stringtype ne{]}if nn/base get cc ctr put nn
+/BitMaps get S ctr S sf 1 ne{A A length 1 sub A 2 index S get sf div put
+}if put/ctr ctr 1 add N}B/I{cc 1 add D}B/bop{userdict/bop-hook known{
+bop-hook}if/SI save N @rigin 0 0 moveto/V matrix currentmatrix A 1 get A
+mul exch 0 get A mul add .99 lt{/QV}{/RV}ifelse load def pop pop}N/eop{
+SI restore userdict/eop-hook known{eop-hook}if showpage}N/@start{
+userdict/start-hook known{start-hook}if pop/VResolution X/Resolution X
+1000 div/DVImag X/IEn 256 array N 2 string 0 1 255{IEn S A 360 add 36 4
+index cvrs cvn put}for pop 65781.76 div/vsize X 65781.76 div/hsize X}N
+/p{show}N/RMat[1 0 0 -1 0 0]N/BDot 260 string N/Rx 0 N/Ry 0 N/V{}B/RV/v{
+/Ry X/Rx X V}B statusdict begin/product where{pop false[(Display)(NeXT)
+(LaserWriter 16/600)]{A length product length le{A length product exch 0
+exch getinterval eq{pop true exit}if}{pop}ifelse}forall}{false}ifelse
+end{{gsave TR -.1 .1 TR 1 1 scale Rx Ry false RMat{BDot}imagemask
+grestore}}{{gsave TR -.1 .1 TR Rx Ry scale 1 1 false RMat{BDot}
+imagemask grestore}}ifelse B/QV{gsave newpath transform round exch round
+exch itransform moveto Rx 0 rlineto 0 Ry neg rlineto Rx neg 0 rlineto
+fill grestore}B/a{moveto}B/delta 0 N/tail{A/delta X 0 rmoveto}B/M{S p
+delta add tail}B/b{S p tail}B/c{-4 M}B/d{-3 M}B/e{-2 M}B/f{-1 M}B/g{0 M}
+B/h{1 M}B/i{2 M}B/j{3 M}B/k{4 M}B/w{0 rmoveto}B/l{p -4 w}B/m{p -3 w}B/n{
+p -2 w}B/o{p -1 w}B/q{p 1 w}B/r{p 2 w}B/s{p 3 w}B/t{p 4 w}B/x{0 S
+rmoveto}B/y{3 2 roll p a}B/bos{/SS save N}B/eos{SS restore}B end
+
+%%EndProcSet
+%%BeginProcSet: hps.pro
+/HPSdict 20 dict dup begin/braindeaddistill 50 def/rfch{dup length 1 sub
+1 exch getinterval}bind def/splituri{dup(#)search{exch pop}{()exch}
+ifelse dup(file:)anchorsearch{pop exch pop 3 -1 roll pop false}{pop 3 -1
+roll exch pop true}ifelse}bind def/lookuptarget{exch rfch dup
+/TargetAnchors where{pop TargetAnchors dup 3 -1 roll known{exch get true
+}{pop(target unknown:)print == false}ifelse}{pop pop
+(target dictionary unknown\012)print false}ifelse}bind def/savecount 0
+def/stackstopped{count counttomark sub/savecount exch store stopped
+count savecount sub 1 sub dup 0 gt{{exch pop}repeat}{pop}ifelse}bind def
+/tempstring 256 string def/targetvalidate{1 index dup length 255 gt exch
+dup(/)search{pop pop pop exch pop true exch}{pop}ifelse cvn tempstring
+cvs token pop pop length 0 ne or not}bind def/targetdump-hook where{pop}
+{/targetdump-hook{dup mark exch gsave initmat setmatrix{{mark/Dest 4 2
+roll targetvalidate{aload pop exch pop/Page 3 1 roll/View exch[exch
+/FitH exch]/DEST pdfmark}{cleartomark}ifelse}forall}stackstopped pop
+grestore}bind def}ifelse/baseurl{mark exch 1 dict dup 3 -1 roll/Base
+exch put/URI exch/DOCVIEW{pdfmark}stackstopped pop}bind def
+/externalhack systemdict/PDF known def/oldstyle true def/initmat matrix
+currentmatrix def/actiondict 2 dict dup/Subtype/URI put def
+/weblinkhandler{dup 3 1 roll mark 4 1 roll/Title 4 1 roll splituri 3 -1
+roll dup length 0 gt{cvn/Dest exch 4 2 roll}{pop}ifelse{externalhack{
+/HTTPFile exch}{actiondict dup 3 -1 roll/URI exch put/Action exch}
+ifelse}{externalhack{/HTTPFile exch}{/File exch/Action/GoToR}ifelse}
+ifelse counttomark 2 sub -1 roll aload pop/Rect 4 1 roll/Border 3 1 roll
+/Color exch oldstyle{/LNK}{/Subtype/Link/ANN}ifelse gsave initmat
+setmatrix{pdfmark}stackstopped grestore}bind def/externalhandler where{
+pop}{/externalhandler{2 copy{weblinkhandler}exec{/externalhack
+externalhack not store 2 copy{weblinkhandler}exec{/externalhack
+externalhack not store/oldstyle false store 2 copy{weblinkhandler}exec{
+(WARNING: external refs disabled\012)print/externalhandler{pop pop}bind
+store externalhandler}{pop pop}ifelse}{pop pop/externalhack externalhack
+not store}ifelse}{pop pop/externalhandler{weblinkhandler pop}bind store}
+ifelse}bind def}ifelse/pdfmnew{dup type/stringtype eq{externalhandler}{
+exch dup rfch exch 3 -1 roll lookuptarget{mark 4 1 roll/Title 4 1 roll
+aload pop exch pop/Page 3 1 roll/View exch[exch/FitH exch]5 -1 roll
+aload pop/Rect 4 1 roll/Border 3 1 roll/Color exch/LNK gsave initmat
+setmatrix pdfmark grestore}{pop pop}ifelse}ifelse}bind def/pdfmold{dup
+type/stringtype eq{externalhandler}{exch dup rfch exch 3 -1 roll
+lookuptarget{mark 4 1 roll/Title 4 1 roll aload pop exch pop/Page 3 1
+roll/View exch[exch/FitH exch]5 -1 roll aload pop pop 0 3 getinterval
+/Rect 3 1 roll/Border exch/LNK gsave initmat setmatrix pdfmark grestore}
+{pop pop}ifelse}ifelse}bind def/pdfm where{pop}{/pdfm
+/currentdistillerparams where{pop currentdistillerparams dup
+/CoreDistVersion known{/CoreDistVersion get}{0}ifelse dup
+braindeaddistill le{(WARNING: switching to old pdfm because version =)
+print ==/pdfmold}{pop/pdfmnew}ifelse load}{/pdfmark where{pop{dup type
+/stringtype eq{externalhandler}{2 copy mark 3 1 roll{pdfmnew}
+stackstopped{2 copy mark 3 1 roll{pdfmold}stackstopped{
+(WARNING: pdfm disabled\012)print/pdfm{pop pop}store}{
+(WARNING: new pdfm failed, switching to old pdfm\012)print/pdfm/pdfmold
+load store}ifelse}{/pdfm/pdfmnew load store}ifelse pop pop}ifelse}}{{
+pop pop}}ifelse}ifelse bind def}ifelse end def
+
+%%EndProcSet
+TeXDict begin 40258431 52099146 1000 300 300 (hep-ph0312204.dvi)
+@start
+%DVIPSBitmapFont: Fa cmti12 12 15
+/Fa 15 120 df<127012F8A212F012E005057A840F>46 D<1403A25CA25CA25C142FA2EC
+4F80A21487A2EB01071302A21304A21308131813101320A290387FFFC0EB40031380EA01
+00A21202A25AA2120C003CEB07E0B4EB3FFC1E237DA224>65 D<EBF8C0EA0185EA070538
+0E0380A2121C123C383807001278A3EAF00EA31410EB1C201270133C38305C40138C380F
+078014157B9419>97 D<137EEA01C138030180EA0703EA0E07121C003CC7FC12381278A3
+5AA45B12701302EA300CEA1830EA0FC011157B9416>99 D<143CEB03F8EB0038A31470A4
+14E0A4EB01C013F9EA0185EA0705380E0380A2121C123C383807001278A3EAF00EA31410
+EB1C201270133C38305C40138C380F078016237BA219>I<13F8EA0384EA0E02121C123C
+1238EA7804EAF018EAFFE0EAF000A25AA41302A2EA6004EA7018EA3060EA0F800F157A94
+16>I<EB1F18EB30B813E03801C070A2EA03801207EB00E05AA3381E01C0A4EB0380120E
+1307EA060BEB1700EA01E7EA0007A2130EA3EA701CEAF0185BEA60E0EA3F80151F7E9416
+>103 D<13F0EA07E01200A3485AA4485AA448C7FCEB01E0EB0210EB0470380E08F01310
+EB2060EB4000EA1D80001EC7FCEA1FC0EA1C70487EA27F142038703840A3EB188012E038
+600F0014237DA216>107 D<EA01E0EA0FC01201A3EA0380A4EA0700A4120EA45AA45AA4
+5AA3127112E2A4126412380B237CA20C>I<391C0F80F8392610C10C3947606606398780
+7807A2EB0070A2000EEBE00EA44848485AA3ED38202638038013401570168015303A7007
+003100D83003131E23157B9428>I<38380F80384C30C0384E4060388E8070EA8F00128E
+A24813E0A4383801C0A3EB03840070138814081307EB031012E0386001E016157B941B>
+I<137EEA01C338038180380701C0120E001C13E0123C12381278A338F003C0A214801307
+00701300130E130CEA3018EA1870EA07C013157B9419>I<13FCEA018338020080EA0401
+EA0C03140090C7FC120F13F0EA07FC6C7EEA003E130F7F1270EAF006A2EAE004EA4008EA
+2030EA1FC011157D9414>115 D<13C01201A4EA0380A4EA0700EAFFF8EA0700A2120EA4
+5AA45AA31310EA7020A213401380EA3100121E0D1F7C9E10>I<001EEB60E00023EBE0F0
+384380E1EB81C000831470D887011330A23907038020120EA3391C070040A31580A2EC01
+00130F380C0B02380613843803E0F81C157B9420>119 D E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fb cmsy8 8 3
+/Fb 3 7 df<B512F0A214027D881B>0 D<1202A3EAC218EAF278EA3AE0EA0F80A2EA3AE0
+EAF278EAC218EA0200A30D0E7E8E12>3 D<13101330AAB512FCA238003000A9B512FCA2
+16187E961B>6 D E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fc cmex10 10 4
+/Fc 4 114 df<EAFFF0A3EAE000B3B3B3B3B3B3AAEAFFF0A30C7C758118>34
+D<EAFFF0A3EA0070B3B3B3B3B3B3AAEAFFF0A30C7C808118>I<ED0380ED0460ED0C70ED
+18F0A2ED3860ED30001570A2156015E0A314015DA31403A25DA21407A44AC7FCA55C141E
+A3143EA4143C147CA45CA6495AA45C1303A45CA313075CA549C8FCA4130EA2131EA2131C
+A3133C1338A313301370A21360EA60E0EAF0C012F1EAE1800063C9FC121E245C7E7F17>
+90 D<16021606A2160CA31618A31630A31660A316C0A3ED0180A3ED0300A31506A35DA3
+5DA35DA35DA21208001C5C123C127C00DC495A128E120E4AC7FC7EA21406EA0380A25CA2
+EA01C05CA2EA00E05CA3EB7060A36D5AA3EB1D80A3011FC8FC7FA2130E1306A2274B7C81
+2A>113 D E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fd cmr8 8 9
+/Fd 9 121 df<1330ABB512FCA238003000AB16187E931B>43 D<EA07C0EA1830EA3018
+EA701CEA600CA2EAE00EA9EA600CA2EA701CEA3018EA1C70EA07C00F157F9412>48
+D<1206120E12FE120EB1EAFFE00B157D9412>I<EA0F80EA30E0EA4070EA8030EAC03812
+E0124012001370A2136013C0EA0180EA03001206EA0C081208EA1018EA3FF0127F12FF0D
+157E9412>I<EA0FE0EA3030EA6018EA701CA21200131813381360EA07E0EA0030131813
+0C130EA212E0A2EAC00CEA4018EA3030EA0FE00F157F9412>I<00FC13FE001E1338001F
+13101217EA1380EA11C0A2EA10E013701338A2131C130E130F1307EB0390EB01D0A2EB00
+F014701430123800FE131017177F961A>78 D<EA3FC0EA70601330EA20381200EA03F8EA
+1E3812301270EAE039A21379EA70FFEA1F1E100E7F8D12>97 D<38F8F83E383B1CC7393C
+0F0380EA380EAA39FE3F8FE01B0E7F8D1E>109 D<EAFE3FEA3C1CEA1C10EA0E20EA0740
+13C0EA0380EA01C0EA02E0EA04F0EA0870EA1838EA383CEAFC7F100E7F8D13>120
+D E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fe cmsy10 12 12
+/Fe 12 113 df<B612FCA21E027C8C27>0 D<EA03F0EA0FFC487E487E481380A2B512C0
+A66C1380A26C13006C5A6C5AEA03F012127D9519>15 D<D807E01301EA0FF8EA3FFCD838
+1E130338700780396003C00639C001E00E903800781C48EB3FFCEC1FF0EC07E0200B7D91
+27>24 D<38E001C0387000E0001C1338000F131E380380073900E001C090387800F0011C
+13380107130E903903C00780903900E001C09138380070021E133C0207130E913901C003
+80913900F001E0A2913901C00380913907000E00021E133C023813709138E001C0903903
+C00780902607000EC7FC011C1338017813F09038E001C026038007C8FC380F001E001C13
+38007013E048485A2B207D9B32>29 D<D807E01301EA0FF8EA3FFCD8381E130338700780
+396003C00639C001E00E903800781C48EB3FFCEC1FF0EC07E0C9FCA9007FB6FCB7FC2016
+7D9627>39 D<D803E0130FD80FFC1338D8181E13E039300F01803920038300004013C6EB
+01E4388000EC1478A21438143CA2146E0040134FECC7803860018339200301E039100E00
+F0D80E38137FD803E0130F20157D9427>47 D<EB03C0EB1E0013385B5BB1485A485A000F
+C7FC12F8120FEA03806C7E6C7EB113707F131EEB03C012317DA419>102
+D<12F8120FEA03806C7E6C7EB113707F131EEB03C0EB1E0013385B5BB1485A485A000FC7
+FC12F812317DA419>I<1320136013C0A3EA0180A3EA0300A21206A35AA35AA25AA35AA3
+5AA21260A37EA37EA27EA37EA37EA2EA0180A3EA00C0A3136013200B327CA413>I<12C0
+A21260A37EA37EA27EA37EA37EA2EA0180A3EA00C0A31360A213C0A3EA0180A3EA0300A2
+1206A35AA35AA25AA35AA35AA20B327DA413>I<12C0B3B3AD02317AA40E>I<1601160316
+06A2160CA21618A21630A21660A216C0A2ED0180A2ED0300A21506A25DA25DA25D120600
+1E5C122F004F5CEA87800007495AEA03C04AC7FCA23801E006A26C6C5AA2EB7818A26D5A
+A26D5AA26D5AA26D5AA26DC8FCA228327D812A>112 D E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Ff cmmi8 8 15
+/Ff 15 123 df<EA0402EA0C06A3485AA4485A1480A2133838785900EA6F8E0060C7FCA2
+5AA35A11147E8D15>22 D<3803FF805A381C3000EA181812301260A3485AA2EA4060EA60
+40EA2180001EC7FC110E7F8D14>27 D<14C0A21301A21303130514E01308131813101320
+A213401380A23801FFF0EB007012025AA25A121838FE03FE17177F961A>65
+D<EA07FFEA00E0A4485AA4485AA448C7FC1408A21410120E143014201460381C01E0B512
+C015177F9618>76 D<381FFFFE38381C0E00201304126012401338128000001300A25BA4
+5BA4485AA41203EA3FFC17177F9615>84 D<EA0710EA18F0EA30701260136012C0A3EA80
+C013C4A212C1EA46C8EA38700E0E7E8D13>97 D<130E13131337133613301360A4EA03FC
+EA00C0A5EA0180A5EA0300A41202126612E65A1278101D7E9611>102
+D<121F1206A45AA4EA18F0EA1B18EA1C081218EA38181230A3EA6030133113611362EAC0
+26133810177E9614>104 D<120313801300C7FCA6121C12241246A25A120C5AA31231A2
+1232A2121C09177F960C>I<38383C1E3844C6633847028138460301388E0703EA0C06A3
+38180C061520140C154039301804C0EC07001B0E7F8D1F>109 D<EA30F0EA4918EA4E38
+EA4C30EA9C001218A35AA45AA20D0E7F8D10>114 D<1203A21206A4EAFFC0EA0C00A35A
+A45A1380A2EA31001232121C0A147F930D>116 D<EA0F1F3811A180EA20C31400EA4180
+1201A348C7FC130212C3EAE704EAC508EA78F0110E7F8D14>120
+D<EA1C02EA26061246A2EA860C120CA3EA1818A31338EA0C70EA07B0EA00301360127013
+C0EA2180EA1E000F147F8D11>I<EA0704EA0FCCEA1878EA1010EA00201340EA0180EA02
+005AEA08081210EA3C30EA43E0EA81C00E0E7F8D10>I E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fg cmmi12 12 32
+/Fg 32 123 df<137EEA0380EA0700120E5A5A12781270EAFFF0EAF000A25AA51270A2EA
+3806EA1C18EA07E00F157D9414>15 D<383C07C038461860384720303887403813801300
+A2000E1370A44813E0A4383801C0A43870038012301200A2EB0700A4130EA4130C15207E
+9418>17 D<130FEB3180EB60C013E03801C0E013801203EA0700A25A120E121EA2EA1C01
+123CA3387FFFC0EA7803A33870078012F014005B130EA2485A12605BEA70305BEA30C0EA
+1180000FC7FC13237EA217>I<000FB5FC5A5A3870418000401300EA8081A21200EA0183
+1303A21203A21206A2120EA2000C1380121CA2EA180118157E941C>25
+D<90387FFF8048B5FC5A390783C000EA0E01486C7E5AA25AA348485AA3495A91C7FCEA60
+07130EEA3018EA1870EA07C019157E941C>27 D<380FFFF84813FC4813F8387020001240
+128013601200A25BA412015BA21203A348C7FC7E16157E9415>I<14105CA45CA45CA449
+C7FCEB0FE0EB711C3801C10638030203000E1480001C1301001814C0EA38041270A339E0
+080380A2EC070012603870100E00305B5C001C13E038062380D801FEC7FCEA0020A25BA4
+5BA41A2D7EA21D>30 D<127012F8A3127005057C840E>58 D<127012F812FCA212741204
+A41208A21210A212201240060F7C840E>I<15181578EC01E0EC0780EC1E001478EB03E0
+EB0F80013CC7FC13F0EA03C0000FC8FC123C12F0A2123C120FEA03C0EA00F0133CEB0F80
+EB03E0EB0078141EEC0780EC01E0EC007815181D1C7C9926>I<14801301A2EB0300A313
+06A35BA35BA35BA35BA35BA3485AA448C7FCA31206A35AA35AA35AA35AA35AA311317DA4
+18>I<12C012F0123C120FEA03C0EA00F0133EEB0F80EB01E0EB0078141EEC0780EC01E0
+EC0078A2EC01E0EC0780EC1E001478EB01E0EB0F80013EC7FC13F0EA03C0000FC8FC123C
+12F012C01D1C7C9926>I<90B6128090380F00071501A2131EA21600A25BA2140192C7FC
+EB7802A21406140EEBFFFCEBF00CA33801E008A21502EC0004485AA25D15184848131015
+305D15E0000F1307B65A21227DA124>69 D<9039FFF801FF010FC71278166016C0011EEB
+010015025D5D4913205D5D0202C7FC495A5C141C147CEBF0BEEBF11E13F2EBF80FEA01F0
+01E07F1407A248486C7EA36E7EEA0780811400A2000F497E39FFF80FFF28227DA129>75
+D<9039FF8007FE010FEB00F016C0D90BC0134001131480A2EB11E0A2903921F001001320
+A2147801401302147C143CA2496C5AA3140FD801005B15881407A20002EB03D0A215F014
+01485C1400A2120C001E1440EAFFC027227DA127>78 D<90B512C090380F0078151C8101
+1E130F811680A249EB0F00A3151E495B5D15E0EC0380D9FFFCC7FCEBF0076E7E8148486C
+7EA44848485AA44848485A1680A29138038100120F39FFF801C6C8127821237DA125>82
+D<001FB512FE391E01E00E001814061230382003C0A200401404A2EB07801280A2000014
+0049C7FCA4131EA45BA45BA45BA41201387FFFC01F227EA11D>84
+D<D8FFF0EB3FE0D81F80EB0F00000F140C150800075C6D5B5D00035CEBE00192C7FC0001
+13026D5A00005B5C6D5AEB7860EB7CC05C013DC8FC133E133CA45BA45BA41201EA1FFF23
+227EA11C>89 D<EA03C0EA3F801203A348C7FCA4120EA45A137CEA1D86EA1E03003C1380
+123814C0A21270A438E00780A3EB0F00130EEA601CA2EA3030EA18E0EA0F8012237EA215
+>98 D<141E14FC141CA31438A41470A414E01378EA01C4EA0302380601C0120E121C123C
+383803801278A338F00700A31408EB0E101270131E38302620EA18C6380F03C017237EA2
+19>100 D<141EEC638014C71301ECC30014801303A449C7FCA4EBFFF8010EC7FCA65BA5
+5BA55BA4136013E0A25BA21271EAF18090C8FC1262123C192D7EA218>102
+D<393C07E01F3A46183061803A47201880C03A87401D00E0EB801E141C1300000E903838
+01C0A4489038700380A2ED070016044801E01308150EA2ED0610267001C01320D83000EB
+03C026157E942B>109 D<383C07C038461860384720303887403813801300A2000E1370
+A44813E0A2EB01C014C1003813C2EB03821484130100701388383000F018157E941D>I<
+3803C0F03804631CEB740EEA0878EB7007A2140FEA00E0A43801C01EA3143C38038038A2
+EBC07014E038072180EB1E0090C7FCA2120EA45AA3B47E181F819418>112
+D<EA3C0F384630C0EA4741EA8783A2EB018090C7FC120EA45AA45AA45A123012157E9416
+>114 D<137E138138030080EA0201EA0603140090C7FC120713F0EA03FC6CB4FCEA003F
+EB07801303127000F01300A2EAE002EA4004EA3018EA0FE011157E9417>I<136013E0A4
+EA01C0A4EA0380EAFFFCEA0380A2EA0700A4120EA45AA31308EA3810A21320EA184013C0
+EA0F000E1F7F9E12>I<001E131800231338EA438014701283A2EA8700000713E0120EA3
+381C01C0A314C2EB0384A21307380C0988EA0E113803E0F017157E941C>I<001E13E0EA
+2301384381F01380008313701430EA870000071320120EA3481340A21480A2EB0100A213
+02EA0C04EA0618EA03E014157E9418>I<3801E0F03806310C38081A1C0010133CEA201C
+14181400C65AA45BA314083860E01012F0142038E1704038423080383C1F0016157E941C
+>120 D<001E131800231338EA438014701283EA8700A2000713E0120EA3381C01C0A4EB
+0380A21307EA0C0B380E1700EA03E7EA0007A2130E1260EAF01C1318485AEA8060EA41C0
+003FC7FC151F7E9418>I<EBE0103803F0203807F86038060FC038080080EB0100EA0002
+5B5B5B5B13C048C7FC1202481340481380EA1001383F8300EA61FEEA40FCEA807814157E
+9417>I E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fh cmr10 10.95 30
+/Fh 30 123 df<EB3FE013E0EA01C1EA0381EA0700A8B5FCEA0700B2383FE7FC1620809F
+19>13 D<EA7038EAF87CEAFC7EA2EA743AEA0402A3EA0804A2EA1008A2EA2010EA40200F
+0E7F9F17>34 D<127012F012F8A212781208A31210A31220A21240050E7C840D>44
+D<EAFFF0A20C02808A0F>I<127012F8A3127005057C840D>I<90380FE0109038381C3090
+38E002703803C00139078000F048C71270121E15305A1510127C127800F81400A9127800
+7C1410123CA26C1420A27E6C6C13406C6C13803900E00300EB380CEB0FF01C217E9F21>
+67 D<B46CEB07FE000715C0A2D805C0130BA2D804E01313A301701323A26D1343A36D13
+83A290380E0103A3EB0702A3EB0384A2EB01C8A3EB00F0A21460121FD8FFE0EB7FFE271F
+7F9E2A>77 D<007FB512E038780F010060EB006000401420A200C0143000801410A40000
+1400B3497E3803FFFC1C1F7E9E21>84 D<EA0804EA1008EA2010A2EA4020A2EA8040A3EA
+B85CEAFC7EA2EA7C3EEA381C0F0E7A9F17>92 D<EA1FE0EA3030EA7818131CEA300E1200
+A313FEEA0F8EEA1E0E1238127800F01310A3131E127838386720380F83C014147E9317>
+97 D<EA01FCEA0706EA1C0F123813060078C7FC127012F0A61270127800381380A2381C
+0100EA0706EA01F811147F9314>99 D<EB01C0130F1301AAEA01F1EA070DEA0C03EA1801
+12381278127012F0A61270A21238EA1803120CEA070D3801F1F815207F9F19>I<EA03F0
+EA0E1C487E487EA238700380A212F0B5FC00F0C7FCA41270A26C1380A2381C0100EA0706
+EA01F811147F9314>I<137CEA01C6EA030F1207EA0E061300A7EAFFF0EA0E00B2EA7FE0
+1020809F0E>I<14E03803E330EA0E3CEA1C1C38380E00EA780FA5EA380E6C5AEA1E38EA
+33E00020C7FCA21230A2EA3FFE381FFF8014C0383001E038600070481330A4006013606C
+13C0381C03803803FC00141F7F9417>I<121C12FC121CAA137C1386EA1D03001E1380A2
+121CAE38FF8FF014207E9F19>I<1238127CA31238C7FCA6121C12FC121CB1EAFF80091F
+7F9E0C>I<121C12FC121CB3ABEAFF8009207F9F0C>108 D<391C3E03E039FCC30C30391D
+019018001EEBE01CA2001C13C0AE3AFF8FF8FF8021147E9326>I<EA1C7CEAFC86EA1D03
+001E1380A2121CAE38FF8FF014147E9319>I<EA01F8EA070E381C0380383801C0A23870
+00E0A200F013F0A6007013E0A2383801C0A2381C038038070E00EA01F814147F9317>I<
+EA1C7CEAFD87381E018014C0381C00E014F014701478A6147014F014E0381E01C0EB0380
+381D8700EA1C7C90C7FCA8B47E151D7E9319>I<EA1CF0EAFD18EA1E3CA21318EA1C00AE
+EAFFC00E147E9312>114 D<EA0FC8EA3038EA6018EAC008A3EAE000127CEA3FE0EA1FF0
+EA07F8EA003CEA800E130612C0A21304EAE00CEAD818EA87E00F147F9312>I<1202A312
+06A2120EA2123EEAFFF8EA0E00AB1304A5EA07081203EA01F00E1C7F9B12>I<381C0380
+EAFC1FEA1C03AE1307120CEA061B3803E3F014147E9319>I<38FF83F8383E00E0001C13
+C06C1380A338070100A21383EA0382A2EA01C4A213E4EA00E8A21370A3132015147F9318
+>I<39FF9FE1FC393C078070391C030060EC8020000E1440A214C0D80704138014E0A239
+038861001471A23801D032143A143E3800E01CA2EB6018EB40081E147F9321>I<38FF83
+F8383E00E0001C13C06C1380A338070100A21383EA0382A2EA01C4A213E4EA00E8A21370
+A31320A25BA3EAF080A200F1C7FC1262123C151D7F9318>121 D<EA7FFFEA700E1260EA
+401C133813781370EA00E0120113C0EA038012071301120E121EEA1C03EA3802EA700613
+0EEAFFFE10147F9314>I E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fi cmbx10 10.95 7
+/Fi 7 117 df<14E0A2497EA3497EA2EB06FCA2EB0EFEEB0C7EA2497EA201307F141F01
+707FEB600FA2496C7E90B5FC4880EB8003000380EB0001A200066D7EA2000E803AFFE00F
+FFE0A2231F7E9E28>65 D<EA07FC381FFF80383F07C0EB03E0EB01F0121F120C1200133F
+EA07FDEA1F81EA3E01127C12F8A3EAFC02EA7E0C383FF87E380FE03E17147F9319>97
+D<B4FCA2121FAAEB1FC0EB7FF0EBE0F8EB807CEB007E143EA2143FA6143EA2147C138038
+1EC1F8381C7FE038181F8018207E9F1D>I<EA01FE3807FF80381F0FC0123EA2007C1380
+EB030000FCC7FCA6127C127E003E1360003F13C0EA1F813807FF00EA01FC13147E9317>
+I<EAFE3EEB7F80381ECFC0138FA2001F1380EB030090C7FCABEAFFF0A212147E9316>
+114 D<EA0FE6EA3FFEEA701EEA600EEAE006A2EAF800EAFFC0EA7FF8EA3FFCEA1FFE1203
+EA001FEAC007A212E0EAF006EAF81EEAFFFCEAC7F010147E9315>I<1203A45AA25AA212
+3FEAFFFCA2EA1F00AA1306A5EA0F8CEA07F8EA03F00F1D7F9C14>I
+E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fj cmr12 12 86
+/Fj 86 128 df<1460A214F0A2497E1478EB027C143CEB043E141EEB081F8001107F1407
+01207F140301407F140101807F140048C77E15780002147C153C48143E151E48141F8148
+158015074815C01503007FB612E0A2B712F024237EA229>1 D<3803FFFC38001F806DC7
+FCA4EB3FC03801EF7838078F1E380E0F07001E1480003CEB03C0007C14E00078130100F8
+14F0A6007814E0007C1303003C14C0001EEB0780000E140038078F1E3801EF7838003FC0
+010FC7FCA4497E3803FFFC1C227DA123>8 D<90381FC1F090387037189038C03E3C3801
+807C000313783907003800A9B612C03907003800B2143C397FE1FFC01E2380A21C>11
+D<EB1FC0EB7020EBC0103801803800031378EA0700143091C7FCA7B512F8380700781438
+B2397FE1FF80192380A21B>I<EB1FD8EB7038EBC078EA0180120338070038A9B512F838
+070038B3397FF3FF80192380A21B>I<90380FC07F90397031C0809039E00B0040260180
+1E13E00003EB3E013807003C91381C00C01600A7B712E03907001C011500B23A7FF1FFCF
+FE272380A229>I<EA7038EAF87CEAFC7EA2EA743AEA0402A4EA0804A2EA1008A2EA2010
+EA40200F0F7EA218>34 D<127012F812FCA212741204A41208A21210A212201240060F7C
+A20E>39 D<132013401380EA01005A12061204120CA25AA25AA312701260A312E0AE1260
+A312701230A37EA27EA2120412067E7EEA0080134013200B327CA413>I<7E12407E7E12
+187E12041206A27EA2EA0180A313C01200A313E0AE13C0A312011380A3EA0300A21206A2
+1204120C5A12105A5A5A0B327DA413>I<497EB0B612FEA23900018000B01F227D9C26>
+43 D<127012F812FCA212741204A41208A21210A212201240060F7C840E>I<EAFFF8A20D
+02808B10>I<127012F8A3127005057C840E>I<14801301A2EB0300A31306A35BA35BA35B
+A35BA35BA3485AA448C7FCA31206A35AA35AA35AA35AA35AA311317DA418>I<EA01F0EA
+071CEA0C06487E00381380A2387001C0A400F013E0AE007013C0A3EA780300381380A238
+1C0700EA0C06EA071CEA01F013227EA018>I<13801203120F12F31203B3A9EA07C0EAFF
+FE0F217CA018>I<EA03F0EA0C1CEA100700201380384003C0A2008013E012F0EAF801A3
+EA2003120014C0A2EB07801400130E5B13185B5B5B485A90C7FC000213205A5A00181360
+481340383FFFC05AB5FC13217EA018>I<EA03F8EA0C1EEA100F38200780004013C01278
+13031307123800001380A214005B130C1338EA03F0EA001C130FEB0780A2EB03C0A214E0
+1220127012F8A200F013C01240EB0780122038100F00EA0C1CEA03F013227EA018>I<13
+03A25BA25B1317A21327136713471387120113071202120612041208A212101220A21240
+12C0B512F838000700A7EB0F80EB7FF015217FA018>I<00101380381E0700EA1FFF5B13
+F8EA17E00010C7FCA6EA11F8EA120CEA1C07381803801210380001C0A214E0A4127012F0
+A200E013C01280EA4003148038200700EA1006EA0C1CEA03F013227EA018>I<137EEA01
+C138030080380601C0EA0C03121C381801800038C7FCA212781270A2EAF0F8EAF30CEAF4
+067F00F81380EB01C012F014E0A51270A3003813C0A238180380001C1300EA0C06EA070C
+EA01F013227EA018>I<12401260387FFFE014C0A23840008038C0010012801302A2485A
+5BA25B5BA21360134013C0A21201A25B1203A41207A76CC7FC13237DA118>I<EA01F8EA
+060EEA0803381001801220386000C0A31270A238780180003E1300EA3F02EA1FC4EA0FF8
+12036C7EEA067EEA083F38100F80383007C0EA6003EB00E05A1460A40060134014C06C13
+8038180300EA0E0EEA03F013227EA018>I<EA01F0EA060C487EEA1807383803801270A2
+38F001C0A314E0A5127013031238EA1805120CEA0619EA03E1380001C0A3EB0380A21230
+387807001306EA700CEA20186C5AEA0FC013227EA018>I<127012F8A312701200AB1270
+12F8A3127005157C940E>I<127012F8A312701200AB127012F8A312781208A41210A312
+201240A2051F7C940E>I<B612FEA2C9FCA8B612FEA21F0C7D9126>61
+D<EB0FE0EB701CEB800239030001800004EB0040481420A2391007C0103920183008EB30
+0839406004049038C007840041130300811482EA8380A7EA81C012410040130701601384
+3820300B9038183188391007C0F06CC8FCA27E0003140EC66C137890387007C090380FFC
+001F237DA226>64 D<497EA3497EA3EB05E0A2EB09F01308A2EB1078A3497EA3497EA2EB
+C01F497EA248B51280EB0007A20002EB03C0A348EB01E0A348EB00F0121C003EEB01F839
+FF800FFF20237EA225>I<B512F8380F800E0007EB0780EC03C015E0140115F0A515E014
+03EC07C0EC0F80EC3E00EBFFFE9038800780EC03C0EC01E015F0140015F8A6EC01F0A2EC
+03E0EC07C0000FEB0F00B512FC1D227EA123>I<903807E0109038381830EBE0063901C0
+017039038000F048C7FC000E1470121E001C1430123CA2007C14101278A200F81400A812
+781510127C123CA2001C1420121E000E14407E6C6C13803901C001003800E002EB381CEB
+07E01C247DA223>I<B512F0380F801E00071307EC0380EC01C0EC00E015F01578A2157C
+153CA3153EA9153CA2157C1578A215F015E01401EC03C0EC0700000F131EB512F01F227E
+A125>I<B612C0380F80070007130114001540A215601520A314201500A3146014E013FF
+138014601420A315081400A21510A31530A2157015E0000F1303B6FC1D227EA121>I<B6
+12C0380F80070007130114001540A215601520A314201500A3146014E013FF1380146014
+20A491C7FCA9487EEAFFFE1B227EA120>I<903807F00890383C0C18EBE0023901C001B8
+39038000F848C71278481438121E15185AA2007C14081278A200F81400A7EC1FFF0078EB
+00F81578127C123CA27EA27E7E6C6C13B86C7E3900E0031890383C0C08903807F0002024
+7DA226>I<39FFFC3FFF390FC003F039078001E0AE90B5FCEB8001AF390FC003F039FFFC
+3FFF20227EA125>I<EAFFFCEA0FC0EA0780B3ACEA0FC0EAFFFC0E227EA112>I<3803FFE0
+38001F007FB3A6127012F8A2130EEAF01EEA401C6C5AEA1870EA07C013237EA119>I<D8
+FFFCEBFF80D80FC0EB7C006C48133015205D5D4AC7FC14025C5C5C5C5C5CEB81C0EB83E0
+1385EB88F01390EBA078EBC03C13808080A26E7E8114036E7EA26E7E81486C7F3AFFFC07
+FF8021227EA126>I<EAFFFCEA1F806CC7FCB3A21401A41403A214021406A2141E48137E
+B512FE18227DA11E>I<D8FFC0EB03FF000F15F0000715E0D805E01305A2D804F01309A3
+01781311A36D1321A36D1341A26D1381A39038078101A3EB03C2A2EB01E4A3EB00F8A314
+70120E001FEC03F03AFFE0203FFF28227EA12D>I<39FF8007FF3907C000F81570D805E0
+1320EA04F0A21378137C133C7F131F7FEB0780A2EB03C0EB01E0A2EB00F014F81478143C
+143E141E140FA2EC07A0EC03E0A21401A21400000E1460121FD8FFE0132020227EA125>
+I<EB0FE0EB783CEBE00E3903C0078039078003C0390F0001E0000E1300001E14F0481478
+A2007C147CA20078143CA200F8143EA90078143C007C147CA2003C1478003E14F8001E14
+F06CEB01E0A239078003C03903C007803900E00E00EB783CEB0FE01F247DA226>I<B512
+F0380F803C0007130FEC078015C0140315E0A615C014071580EC0F00143CEBFFF00180C7
+FCAE487EEAFFFC1B227EA121>I<EB0FE0EB783CEBE00E3903C0078039078003C0390F00
+01E0000E1300001E14F0003E14F8003C1478007C147CA20078143CA200F8143EA9007814
+3C007C147CA2003C1478A2391E0380F0390E0420E0380F080139078813C03903C8178039
+00E80E0090387C3C02EB0FECEB000CA2EC0E06EC0F0EEC07FCA215F81403EC01E01F2D7D
+A226>I<B512E0380F803C0007130E6E7E81140381A55D14075D020EC7FC143CEBFFE0EB
+80708080141E140E140FA481A3168015C014073A0FC003C10039FFFC01E2C8127C21237E
+A124>I<3803F020380C0C60EA1802383001E0EA70000060136012E0A21420A36C1300A2
+1278127FEA3FF0EA1FFE6C7E0003138038003FC0EB07E01301EB00F0A214707EA46C1360
+A26C13C07E38C8018038C60700EA81FC14247DA21B>I<007FB512F83978078078006014
+1800401408A300C0140C00801404A400001400B3A3497E3801FFFE1E227EA123>I<39FF
+FC07FF390FC000F86C4813701520B3A5000314407FA2000114806C7E9038600100EB3006
+EB1C08EB03F020237EA125>I<D8FFF0EB7FC0D81F80EB1F006CC7120C7F00071408A26C
+6C5BA36C6C5BA26D136000001440A201785BA2137CD93C01C7FCA2EB1E02A36D5AA2148C
+EB0788A2EB03D0A214F06D5AA26D5AA322237FA125>I<3BFFF03FFC03FE3B1F8007E000
+F86C486C48137017206E7ED807801540A24A7E2603C0021480A39039E004780100011600
+A2EC083CD800F01402A2EC101E01785CA2EC200F013C5CA20260138890391E400790A216
+D090391F8003F0010F5CA2EC00016D5CA20106130001025C2F237FA132>I<397FF803FF
+390FE001F83907C000E06C6C5B00015CEBF001D800F890C7FCEB7802EB7C04133EEB1E08
+EB1F10EB0FB0EB07A014C06D7E130180497EEB0278EB047CEB0C3EEB081EEB101F496C7E
+140701407F496C7E1401D801007F486D7E5AD81F807F3AFFC003FFC022227FA125>I<D8
+FFF0EB7FC0D81F80EB1F00000F140C000714087F00035C6C6C5B7F00005C6D13C0017C5B
+D93C01C7FC133EEB1E02EB1F06EB0F84EB078814D8EB03D014E01301AC1303EB3FFE2222
+7FA125>I<387FFFFE387E003E0078133C007013781260004013F012C0EB01E0388003C0
+A2EB07801200EB0F005B131E5BA25BA25B1201EBE001EA03C0A2EA07801403EA0F00001E
+1302A2481306140E48131E00F8137EB512FE18227DA11E>I<12FEA212C0B3B3A912FEA2
+07317BA40E>I<EA0804EA1008EA2010A2EA4020A2EA8040A4EAB85CEAFC7EA2EA7C3EEA
+381C0F0F7AA218>I<12FEA21206B3B3A912FEA207317FA40E>I<EA1FE0EA3038EA780C13
+0EEA30071200A313FFEA07C7EA1E07123C1278127000F01308A3130FEA7817383C239038
+0FC1E015157E9418>97 D<120E12FE121E120EAB131FEB61C0EB8060380F0030000E1338
+143C141C141EA7141C143C1438000F1370380C8060EB41C038083F0017237FA21B>I<EA
+01FEEA0703380C0780121C383803000078C7FC127012F0A712700078134012386C138038
+0C0100EA0706EA01F812157E9416>I<14E0130F13011300ABEA01F8EA0704EA0C02EA1C
+01EA38001278127012F0A7127012781238EA1801EA0C0238070CF03801F0FE17237EA21B
+>I<EA01FCEA0707380C0380381C01C01238007813E0EA700012F0B5FC00F0C7FCA51270
+0078132012386C13406C138038070300EA00FC13157F9416>I<133E13E33801C780EA03
+87130748C7FCA9EAFFF80007C7FCB27FEA7FF0112380A20F>I<14703803F198380E1E18
+EA1C0E38380700A200781380A400381300A2EA1C0EEA1E1CEA33F00020C7FCA212301238
+EA3FFE381FFFC06C13E0383000F0481330481318A400601330A2003813E0380E03803803
+FE0015217F9518>I<120E12FE121E120EABEB1F80EB60C0EB80E0380F0070A2120EAF38
+FFE7FF18237FA21B>I<121C123EA3121CC7FCA8120E127E121E120EB1EAFFC00A227FA1
+0E>I<13E0EA01F0A3EA00E01300A81370EA07F012001370B3A51260EAF0E013C0EA6180
+EA3F000C2C83A10F>I<120E12FE121E120EABEB03FCEB01F014C01480EB02005B5B5B13
+3813F8EA0F1CEA0E1E130E7F1480EB03C0130114E0EB00F014F838FFE3FE17237FA21A>
+I<120E12FE121E120EB3ADEAFFE00B237FA20E>I<390E1FC07F3AFE60E183803A1E8072
+01C03A0F003C00E0A2000E1338AF3AFFE3FF8FFE27157F942A>I<380E1F8038FE60C038
+1E80E0380F0070A2120EAF38FFE7FF18157F941B>I<EA01FCEA0707380C0180381800C0
+003813E0481370A200F01378A700701370007813F0003813E0381C01C0380E0380380707
+00EA01FC15157F9418>I<EA0E1F38FE61C0381E8060380F0070000E1338143CA2141EA7
+143CA21438000F1370380E80E0EB41C0EB3F0090C7FCA9EAFFE0171F7F941B>I<3801F8
+2038070460EA0E02EA1C01003813E0EA7800A25AA71278A2EA3801121CEA0C02EA070CEA
+01F0C7FCA9EB0FFE171F7E941A>I<EA0E3CEAFE46EA1E8FEA0F0F13061300120EAD120F
+EAFFF010157F9413>I<EA0F88EA3078EA601812C01308A212E0EAF000127FEA3FE0EA0F
+F0EA01F8EA003CEA801C130CA212C01308EAE018EAD030EA8FC00E157E9413>I<1202A4
+1206A3120E121E123EEAFFFCEA0E00AB1304A6EA07081203EA01F00E1F7F9E13>I<000E
+137038FE07F0EA1E00000E1370AD14F0A238060170380382783800FC7F18157F941B>I<
+38FF80FE381E00781430000E1320A26C1340A2EB80C000031380A23801C100A2EA00E2A3
+1374A21338A3131017157F941A>I<39FF8FF87F393E01E03C001CEBC01814E0000E1410
+EB0260147000071420EB04301438D803841340EB8818141CD801C81380EBD00C140E3900
+F00F00497EA2EB6006EB400220157F9423>I<38FF83FE381F00F0000E13C06C1380EB81
+00EA0383EA01C2EA00E41378A21338133C134E138FEA0187EB0380380201C0000413E0EA
+0C00383E01F038FF03FE17157F941A>I<38FF80FE381E00781430000E1320A26C1340A2
+EB80C000031380A23801C100A2EA00E2A31374A21338A31310A25BA35B12F05B12F10043
+C7FC123C171F7F941A>I<383FFFC038380380EA300700201300EA600EEA401C133C1338
+C65A5B12015B38038040EA07005A000E13C04813805AEA7801EA7007B5FC12157F9416>
+I<B512FE1701808C18>I<EA6030EAF078EAF8F8EAF078EA60300D057BA118>127
+D E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fk cmbx12 17.28 35
+/Fk 35 122 df<91393FFC07F80103B5EA3FFE903A0FF807FF0F903B3FC003FC1F80903B
+7F0007F83FC001FE130F000115F05B0003EE1F80EF060094C7FCA8B812F0A32803FC000F
+F0C7FCB3A8267FFFE1B512C0A332327FB12F>11 D<91383FFCF00103B5FC90380FF00FEB
+3FC0EB7F0013FE12015B1203AAB7FCA33903FC000FB3A8267FFFE1B51280A329327FB12D
+>13 D<001E130F003FEB1F80397F803FC039FFC07FE0A201E013F0A2007F133F393F601F
+B0001EEB0F3000001300A3491360A3484813C0A239030001800006EB0300481306001C13
+0E485B002013101C187DB12A>34 D<B512F8A715077F921B>45 D<EB01C01303130F137F
+EA1FFFB5FC13BFEAE03F1200B3B1007FB512F0A31C2E7AAD28>49
+D<EB3FE03801FFFE0007EBFF80D80F8013C0391E003FE00038EB1FF0007CEB0FF8007EEB
+07FCB4FC018013FEA21403A2EA7F00003E1307C7FC15FCA2EC0FF8A215F0EC1FE015C0EC
+3F80EC7F00147E14F8495A495A495A49C7FC011E130E5B133849131E49131C485A48C712
+3C48B512FC5A5A5A4814F8B6FCA31F2E7CAD28>I<EB1FF890B5FC000314C03907E01FF0
+390F0007F8D81F807FEA3FC06E7EA4EA1F80380F0007C75BA25D4A5A4A5AEC3F8002FFC7
+FCEB3FF8ECFF809038001FE06E7E6E7E6E7E816E7EA21680A3121C123E127FEAFF801600
+A24A5AEA7F00007E495A003C5C391FC01FF06CB512C0000391C7FC38003FF8212E7DAD28
+>I<913A03FF800180023FEBF00349B5EAFC0701079038003F0FD91FF8EB079FD93FC0EB
+01FFD9FF807F4848C8127F4848153F0007161F49150F485A001F1607A2485A1703127FA2
+4992C7FCA212FFA9127FA27FEF0380123FA26C7E1707000F17006C7E6D150E0003161E6C
+6C151C6C6C6C1478D93FC05CD91FF8EB03E0D907FFEB3F800101D9FFFEC7FCD9003F13F8
+0203138031317CB03A>67 D<B812E0A3C6903880007FEE0FF016031601A21600A21770A3
+1738A21507A21700A35D5D5D91B5FCA3EC803F818181A592C8FCACB612C0A32D317EB033
+>70 D<B6D8807FB512C0A3C60180C7387FC000B391B7FCA30280C7127FB3A3B6D8807FB5
+12C0A33A317EB03F>72 D<B61280A3C6EB8000B3B3A7B61280A319317EB01E>I<B67EA3
+000190C9FCB3A9EE0380A416071700A25EA35E5E5E5E4B5A150FB7FCA329317DB030>76
+D<B500C00303B5FCA26E5DC61900D9EFF0150EA3D9E7F85DA2D9E3FC5DA2D9E1FE5DA2D9
+E0FF5DA26E6C495AA26E6C495AA36E6C495AA26E6C130EA26E6C5BA26E6C5BA26E6C5BA2
+6E6C5BA392387F81C0A292383FC380A2DB1FE7C7FCA2ED0FFEA26F5AA36F5A487EB526E0
+01F090B6FCA26F5A48317EB04D>I<B77E16F816FEC690398003FF809238007FE0EE1FF0
+707EA283160783A65F160F5F4C5A4C5A4C5ADB03FFC8FC91B512F816E091388007F8ED01
+FC6F7E167F83707EA283A583A4F0038017F8161F1900706C5AB6398003FE0E933801FFFC
+9338001FF039317EB03C>82 D<007FB8FCA39039C00FF801D87E00EC003F007C82007882
+A200708200F01780A3481603A5C792C7FCB3AA017FB6FCA331307DAF38>84
+D<6D13400003EB01C0390700038000061400481306485B485BA2485BA3485BA300CFEB67
+8039DF806FC039FFC07FE001E013F0A2007F133FA2393FC01FE0391F800FC0390F000780
+1C1876B12A>92 D<EBFFF0000313FF390F803F809038C00FE0486C6C7EA26E7ED80FC07F
+EA0780C7FCA414FF131FEBFFE33803FC03EA0FF0EA1FC0123FEA7F80A2EAFF00A31407A2
+387F800D393FC01DFE3A1FE078FFF03907FFE07FC6EB803F24207E9F27>97
+D<EB0FFF017F13C03901FC01F03803F0033907E007F8120FEA1FC0003FEB03F0EC01E048
+48C7FCA312FFA8127FA36C6C131CA2001F14386C7E000714703903F001E03901FC07C039
+007FFF00EB0FF81E207D9F24>99 D<ED0FC0EC07FFA3EC007F153FADEB07F8EB3FFF9038
+FE07BF3903F801FF3907E0007F120F4848133F123FA2485AA312FFA8127FA36C7EA2121F
+6C6C137F000714FF2603F00313E03A01FC0F3FFE38007FFEEB0FF027327DB12D>I<EB0F
+FC90387FFF803901FC0FC03903F003E03907E001F0000F14F8391FC000FC003F14FEA248
+48137E157FA212FFA290B6FCA20180C7FCA4127FA36C6C1307121F150E6C7E6C6C131C6C
+6C13783900FE03E090383FFFC0903807FE0020207E9F25>I<EB01FE90380FFF8090381F
+C3C090387F07E09038FE0FF0120113FC1203EC07E0EC018091C7FCA8B512FCA3D803FCC7
+FCB3A8387FFFF0A31C327EB119>I<90391FF007C09039FFFE3FE03A01F83F79F03907E0
+0FC3000F14E19039C007E0E0001FECF000A2003F80A5001F5CA2000F5CEBE00F00075C26
+03F83FC7FC3806FFFE380E1FF090C9FC121EA2121F7F90B57E6C14F015FC6C806C801680
+000F15C0003FC7127F007EEC1FE0007C140F00FC1407A4007EEC0FC0003E1580003F141F
+D80FC0EB7E003907F803FC0001B512F0D8001F90C7FC242F7E9F28>I<EA01F812FFA312
+0F1207ADEC07F8EC3FFEEC783F02C013809039F9801FC0EBFB0001FE14E05BA35BB3B500
+C3B5FCA328327DB12D>I<EA03C0487E487E487EA46C5A6C5A6C5AC8FCA9EA01F8127FA3
+1207B3A7B51280A311337DB217>I<EA01F812FFA3120F1207B3B3A6B512C0A312327DB1
+17>108 D<2703F007F8EB1FE000FFD93FFEEBFFF8913A783F01E0FC02C090388300FE28
+0FF1801FC6137F2607F30013CC01F602F8148001FC5CA3495CB3B500C3B5380FFFFCA33E
+207D9F43>I<3903F007F800FFEB3FFEEC783F02C013803A0FF1801FC03807F30001F614
+E013FCA35BB3B500C3B5FCA328207D9F2D>I<EB07FC90387FFFC03901FC07F03903F001
+F848486C7E4848137E001F147F003F158049133F007F15C0A300FF15E0A8007F15C0A36C
+6CEB7F80A2001F15006C6C13FE00075C3903F803F83901FE0FF039007FFFC0D907FCC7FC
+23207E9F28>I<3803F03F00FFEB7FC09038F1C3E01487390FF30FF0EA07F6A29038FC07
+E0EC03C091C7FCA25BB2B512E0A31C207E9F21>114 D<3801FF86000713FEEA1F00003C
+133E48131E140E12F8A36C90C7FCB47E13FC387FFFC06C13F0806C7F00077F00017FEA00
+3F01001380143F0060131F00E0130FA27E15007E6C131E6C131C38FF807838F3FFF038C0
+7F8019207D9F20>I<131CA5133CA3137CA213FC120112031207381FFFFEB5FCA2D803FC
+C7FCB0EC0380A71201EC0700EA00FEEB7F0EEB3FFCEB07F0192E7FAD1F>I<D801F8EB07
+E000FFEB03FFA3000FEB003F0007141FB3153FA20003147FA26C6CEBDFF03A00FE039FFF
+90387FFF1FEB0FFC28207D9F2D>I<B5EB1FFCA3D80FF8EB03C0000715806D1307000315
+007F0001140E7F6C5CA2EC803C017F1338ECC078013F1370ECE0F0011F5B14F1010F5B14
+F9903807FB80A214FF6D90C7FCA26D5AA26D5AA21478A226207E9F2B>I<B53A1FFFE03F
+F8A33C0FF000FE0007806D150300076EEB0700816D5D00039138FF800EA26C6C486D5A15
+DF01FF153C6C9039038FE038A2D97F876D5A150702C714F0D93FCF6D5AECCE03D91FFEEB
+F9C09138FC01FD16FF010F5D4A7EA26D486DC7FCA20103147E4A133EA26D48131C35207E
+9F3A>I<B5EB1FFCA3D80FF8EB03C0000715806D1307000315007F0001140E7F6C5CA2EC
+803C017F1338ECC078013F1370ECE0F0011F5B14F1010F5B14F9903807FB80A214FF6D90
+C7FCA26D5AA26D5AA21478A21470A214F05C1301007C5BEAFE035C49C8FC5BEAFC1EEA78
+7CEA3FF0EA0FC0262E7E9F2B>121 D E
+%EndDVIPSBitmapFont
+%DVIPSBitmapFont: Fl cmbx12 12 28
+/Fl 28 117 df<EAFFFCA40E047F8C13>45 D<14181438A21470A214E0A3EB01C0A2EB03
+80A3EB0700A3130EA25BA35BA25BA35BA2485AA3485AA248C7FCA3120EA35AA25AA35AA2
+5AA25A15317DA41C>47 D<13FE3807FFC0380F83E0381F01F0383E00F8A248137CA312FC
+147EAD007C137CA36C13F8A2381F01F0380F83E03807FFC03800FE0017207E9F1C>I<13
+181378EA01F812FFA21201B3A7387FFFE0A213207C9F1C>I<EA03FCEA0FFF383C1FC038
+7007E0007C13F0EAFE0314F8A21301127CEA3803120014F0A2EB07E014C0EB0F80EB1F00
+133E13385BEBE018EA01C0EA0380EA0700000E1338380FFFF05A5A5AB5FCA215207D9F1C
+>I<13FE3807FFC0380F07E0381E03F0123FEB81F8A3EA1F0314F0120014E0EB07C0EB1F
+803801FE007F380007C0EB01F014F8EB00FCA2003C13FE127EB4FCA314FCEA7E01007813
+F8381E07F0380FFFC03801FE0017207E9F1C>I<14E013011303A21307130F131FA21337
+137713E7EA01C71387EA03071207120E120C12181238127012E0B6FCA2380007E0A790B5
+FCA218207E9F1C>I<00301320383E01E0383FFFC0148014005B13F8EA33C00030C7FCA4
+EA31FCEA37FF383E0FC0383807E0EA3003000013F0A214F8A21238127C12FEA200FC13F0
+A2387007E0003013C0383C1F80380FFF00EA03F815207D9F1C>I<EB1F80EBFFE03803E0
+703807C0F0380F01F8121F123EA2387E00F0007C1300A2EAFC08EB7FC0EBFFE038FD80F0
+38FF00F848137CA248137EA4127CA3003C137C123E001E13F86C13F0380783E03803FFC0
+C6130017207E9F1C>I<12601278387FFFFEA214FC14F8A214F038E0006014C038C00180
+EB0300A2EA00065B131C131813381378A25BA31201A31203A76C5A17227DA11C>I<13FE
+3803FFC0380703E0380E00F05A1478123C123E123F1380EBE0F0381FF9E0EBFFC06C1380
+6C13C06C13E04813F0381E7FF8383C1FFCEA7807EB01FEEAF000143E141EA36C131C0078
+13387E001F13F0380FFFC00001130017207E9F1C>I<EA01FE3807FF80380F83E0381E01
+F0EA3E004813F8147800FC137CA3147EA4007C13FEA2EA3E01381E037EEA0FFEEA07FCEA
+0020EB007CA2121E003F13F8A214F0EB01E0381E03C0381C0F80380FFE00EA03F817207E
+9F1C>I<1470A214F8A3497EA2497EA3EB067FA2010C7F143FA2496C7EA201307F140F01
+707FEB6007A201C07F90B5FC4880EB8001A2D803007F14004880000680A23AFFE007FFF8
+A225227EA12A>65 D<B67E15F03907F001F86E7E157EA2157FA5157E15FE5DEC03F890B5
+5AA29038F001FCEC007E811680151F16C0A6ED3F80A2ED7F00EC01FEB612F815C022227E
+A128>I<D903FE138090381FFF819038FF01E33901F8003FD803E0131F4848130F484813
+07121F48C71203A2481401127EA200FE91C7FCA8127EED0180127F7E15036C6C1400120F
+6C6C1306D803F05B6C6C13386CB413F090381FFFC0D903FEC7FC21227DA128>I<B67E15
+F03907F003FCEC007E81ED1F80ED0FC0ED07E0A216F01503A316F8A916F0A3ED07E0A2ED
+0FC0ED1F80ED3F00157EEC03FCB612F0158025227EA12B>I<B51280A23807F000B3ACB5
+1280A211227EA115>73 D<D8FFF0EC0FFF6D5C000716E0D806FC1437A3017E1467A26D14
+C7A290391F800187A290390FC00307A3903807E006A2903803F00CA2903801F818A39038
+00FC30A2EC7E60A2EC3FC0A2EC1F80A3EC0F00D8FFF091B5FC140630227EA135>77
+D<D8FFF8EB1FFE7F0007EC00C07FEA06FF6D7E6D7E6D7E130F806D7E6D7E6D7E130080EC
+7F80EC3FC0EC1FE0EC0FF0140715F8EC03FCEC01FEEC00FF157FA2153F151F150F150715
+03A2D8FFF01301150027227EA12C>I<B6FC15E03907F007F0EC01FC1400157EA2157FA5
+157EA215FC1401EC07F090B512E0150001F0C7FCADB57EA220227EA126>80
+D<3801FE023807FF86381F01FE383C007E007C131E0078130EA200F81306A27E1400B4FC
+13E06CB4FC14C06C13F06C13F86C13FC000313FEEA003F1303EB007F143FA200C0131FA3
+6C131EA26C133C12FCB413F838C7FFE00080138018227DA11F>83
+D<B538803FFCA23A07F0000180B3A60003EC03007F000114066C6C130E017E5B90383F80
+F890380FFFE0010190C7FC26227EA12B>85 D<13FE3807FF80380F87C0381E01E0003E13
+F0EA7C0014F812FCA2B5FCA200FCC7FCA3127CA2127E003E13186C1330380FC0703803FF
+C0C6130015167E951A>101 D<121C123E127FA3123E121CC7FCA7B4FCA2121FB2EAFFE0
+A20B247EA310>105 D<38FF07E0EB1FF8381F307CEB403CEB803EA21300AE39FFE1FFC0
+A21A167E951F>110 D<38FF0FE0EB3FF8381FE07CEB803E497E1580A2EC0FC0A8EC1F80
+A29038803F00EBC03EEBE0FCEB3FF8EB0FC090C8FCA8EAFFE0A21A207E951F>112
+D<EAFE1FEB3FC0381E67E013C71387A2381F83C090C7FCADEAFFF0A213167E9517>114
+D<487EA41203A21207A2120F123FB5FCA2EA0F80ABEB8180A5EB8300EA07C3EA03FEEA00
+F811207F9F16>116 D E
+%EndDVIPSBitmapFont
+end
+%%EndProlog
+%%BeginSetup
+%%Feature: *Resolution 300dpi
+TeXDict begin
+%%BeginPaperSize: Letter
+letter
+%%EndPaperSize
+
+HPSdict begin
+/TargetAnchors
+0 dict dup begin
+end targetdump-hook def
+TeXDict begin
+%%EndSetup
+%%Page: 0 1
+gsave %matrix defaultmatrix setmatrix
+90 rotate 265 -39 moveto /Times-Roman findfont 20 scalefont setfont
+0.3 setgray (arXiv:hep-ph/0312204 v2   21 Jun 2004) show grestore
+0 0 bop 1184 -33 a Fl(Preprin)n(t)18 b(SINP)h(MSU)g(2004-14/753)0
+761 y Fk(F)-7 b(ast)26 b(sim)n(ulation)f(of)h(\015o)n(w)g(e\013ects)f
+(in)h(cen)n(tral)f(and)g(semi-cen)n(tral)517 836 y(hea)n(vy)h(ion)g
+(collisions)f(at)i(LHC)672 1029 y Fj(I.P)l(.)15 b(Lokh)o(tin)h(and)h
+(A.M.)e(Snigirev)73 1178 y(M.V.Lomonoso)o(v)g(Mosco)o(w)i(State)f(Univ)
+o(ersit)o(y)l(,)d(D.V.Sk)o(ob)q(eltsyn)i(Institute)g(of)i(Nuclear)e(Ph)
+o(ysics)565 1253 y(119992,)k(V)l(orobievy)c(Gory)l(,)h(Mosco)o(w,)g
+(Russia)684 1328 y(E-mail:)30 b(Igor.Lokh)o(tin@cern.c)o(h)904
+1551 y Fi(Abstract)190 1635 y Fh(The)22 b(simple)i(metho)q(d)e(for)f
+(sim)o(ulation)i(of)f(\\thermal")f(hadron)h(sp)q(ectra)g(in)h
+(ultrarelativistic)122 1692 y(hea)o(vy)15 b(ion)h(collisions)i
+(including)g(longitudinal,)g(transv)o(erse)c(and)i(elliptic)i(\015o)o
+(w)d(is)h(dev)o(elop)q(ed.)23 b(The)122 1748 y(mo)q(del)16
+b(is)g(realized)h(as)d(fast)h(Mon)o(te-Carlo)f(ev)o(en)o(t)h
+(generator.)p eop
+%%Page: 1 2
+1 1 bop 0 -33 a Fk(1)81 b(In)n(tro)r(duction)0 91 y Fj(The)16
+b(exp)q(erimen)o(tal)d(in)o(v)o(estigation)h(of)i(ultra-relativistic)e
+(n)o(uclear)h(collisions)g(o\013ers)i(a)f(unique)f(p)q(ossibilit)o(y)0
+166 y(of)f(studying)f(the)h(prop)q(erties)f(of)h(strongly)f(in)o
+(teracting)g(matter)f(at)i(high)f(energy)g(densit)o(y)l(.)19
+b(In)14 b(that)f(regime,)0 241 y(hadronic)i(matter)e(is)h(exp)q(ected)f
+(to)i(b)q(ecome)d(decon\014ned,)j(and)f(a)h(gas)g(of)g(asymptotically)d
+(free)i(quarks)g(and)0 315 y(gluons)22 b(is)f(formed,)f(the)h
+(so-called)g(quark-gluon)g(plasma)g(\(QGP\),)g(in)f(whic)o(h)h(the)g
+(colour)g(in)o(teractions)0 390 y(b)q(et)o(w)o(een)g(partons)i(are)e
+(screened)g(o)o(wing)h(to)g(collectiv)o(e)d(e\013ects)i([1].)37
+b(One)22 b(of)g(the)f(imp)q(ortan)o(t)g(to)q(ols)i(to)0
+465 y(study)16 b(QGP)h(prop)q(erties)f(is)g(transv)o(erse)g(and)h
+(elliptic)d(\015o)o(w)j(observ)m(ables.)73 540 y(In)g(particular,)e
+(the)i(exp)q(erimen)o(tall)o(y)d(observ)o(ed)i(gro)o(wth)h(of)g(the)g
+(mean)e(transv)o(erse)i(momen)o(tum)12 b(with)0 614 y(increasing)h
+(mass)g(in)h(most)f(cen)o(tral)f(n)o(uclear)h(collisions)g(at)h(SPS)g
+([2,)f(3)q(])g(and)h(RHIC)f([4,)g(5])h(energies)f(is)g(natu-)0
+689 y(rally)g(and)h(simply)d(explained)i(with)g(the)h(h)o(ydro)q
+(dynamical)e(mo)q(del)g([6],)h(where)g(the)h(c)o(hange)f(of)h(momen)o
+(tum)0 764 y(\001)p Fg(p)65 771 y Ff(T)93 764 y Fj(\()p
+Fl(r)p Fj(\))j(of)h(a)g(hadron)g(of)g(mass)f Fg(m)g Fj(due)h(to)f
+(transv)o(erse)h(motion)e(of)i(a)g(\015uid)f(elemen)o(t)e(at)i(the)h(p)
+q(oin)o(t)f Fl(r)h Fj(can)0 838 y(b)q(e)e(written)g(as)h(\001)p
+Fg(p)362 845 y Ff(T)390 838 y Fj(\()p Fl(r)p Fj(\))c(=)h
+Fg(m)8 b Fj(sinh)g Fg(Y)690 845 y Ff(T)718 838 y Fj(\()p
+Fl(r)p Fj(\),)16 b(where)g Fg(Y)978 845 y Ff(T)1022 838
+y Fj(is)g(the)g(collectiv)o(e)d(transv)o(erse)j(rapidit)o(y)l(.)73
+913 y(Moreo)o(v)o(er,)d(a)h(strong)h(in)o(terest)d(in)i(azim)o(uthal)d
+(correlation)j(measuremen)o(ts)d(in)i(ultrarelativistic)f(hea)o(vy)0
+988 y(ion)23 b(collisions)f(has)i(recen)o(tly)d(gained)i(imp)q(etus.)40
+b(Recen)o(t)21 b(anisotropic)j(\015o)o(w)f(data)h(from)e(SPS)h([7])f
+(and)0 1063 y(RHIC)14 b([8,)g(9,)g(10)q(])g(can)g(b)q(e)h(describ)q(ed)
+e(w)o(ell)g(b)o(y)h(h)o(ydro)q(dynamical)f(mo)q(dels)g(for)i(semi-cen)o
+(tral)d(collisions)h(and)0 1137 y(transv)o(erse)i(momen)o(tum)n(,)d
+Fg(p)522 1144 y Ff(T)550 1137 y Fj(,)j(up)g(to)h Fe(\030)d
+Fj(2)j(GeV/c)e(\(the)h(co)q(e\016cien)o(t)e(of)j(elliptic)c(\015o)o(w)k
+Fg(v)1622 1144 y Fd(2)1641 1137 y Fj(,)f(whic)o(h)f(is)h(de\014ned)0
+1212 y(as)i(the)e(co)q(e\016cien)o(t)g(of)h(the)g(second)g(harmonic)f
+(of)h(the)g(particle)f(azim)o(uthal)e(distribution)j(with)g(resp)q(ect)
+g(to)0 1287 y(the)h(reaction)h(plane,)f(app)q(ears)i(to)f(b)q(e)g
+(monotonously)f(gro)o(wing)i(with)e(increasing)g Fg(p)1594
+1294 y Ff(T)1640 1287 y Fj([11])h(in)f(this)g(case\).)0
+1361 y(On)g(the)f(other)h(hand,)g(the)f(ma)s(jorit)o(y)f(of)i
+(microscopical)d(Mon)o(te-Carlo)j(mo)q(dels)e(underestimate)g(the)i
+(\015o)o(w)0 1436 y(e\013ects)f(\(see)g(ho)o(w)o(ev)o(er)f([12]\).)21
+b(Measuremen)o(ts)14 b(of)i Fg(v)962 1443 y Fd(2)998
+1436 y Fj(presen)o(t)f(one)i(of)f(the)g(e\013ectiv)o(e)f(to)q(ols)i(to)
+f(test)g(v)m(arious)0 1511 y(mo)q(dels.)24 b(In)18 b(particular,)f(the)
+g(saturation)i(and)f(gradual)h(decrease)e(of)h Fg(v)1359
+1518 y Fd(2)1396 1511 y Fj(for)g Fg(p)1496 1518 y Ff(T)1540
+1511 y Fg(>)e Fj(2)i(GeV/c,)f(predicted)0 1586 y(as)24
+b(a)g(signature)g(of)g(strong)h(partonic)e(energy)g(loss)h(in)g(a)g
+(QGP)l(,)f(is)g(supp)q(orted)i(b)o(y)e(the)g(recen)o(t)g(RHIC)0
+1660 y(data)18 b([8,)f(9])g(extending)f(up)i(to)f Fg(p)616
+1667 y Ff(T)660 1660 y Fe(')e Fj(10)j(GeV/c.)24 b(The)17
+b(in)o(terp)q(olation)g(b)q(et)o(w)o(een)f(the)h(lo)o(w-)p
+Fg(p)1739 1667 y Ff(T)1784 1660 y Fj(relativistic)0 1735
+y(h)o(ydro)q(dynamics)e(region)h(and)h(the)f(high-)p
+Fg(p)796 1742 y Ff(T)841 1735 y Fj(pQCD-computable)f(region)i(w)o(as)f
+(ev)m(aluated)h(in)f([13].)73 1810 y(The)k(initial)e(gluon)i(densities)
+f(in)h(Pb)p Fe(\000)p Fj(Pb)g(reactions)f(at)1171 1778
+y Fe(p)p 1213 1778 78 2 v 32 x Fg(s)1236 1817 y Fd(NN)1310
+1810 y Fj(=)h(5)p Fg(:)p Fj(5)g(T)l(eV)f(at)h(the)g(Large)g(Hadron)0
+1885 y(Collider)15 b(\(LHC\))i(are)g(exp)q(ected)e(to)i(b)q(e)f
+(signi\014can)o(tly)g(higher)g(than)h(at)g(RHIC,)e(implying)f(m)o(uc)o
+(h)g(stronger)0 1959 y(QGP)f(e\013ects.)19 b(The)13 b(probing)g(exp)q
+(erimen)o(tal)c(capabilities)i(of)i(LHC)g(detectors)f(together)g(with)h
+(ph)o(ysics)e(and)0 2034 y(soft)o(w)o(are)17 b(v)m(alidation)g(of)h(v)m
+(arious)g(Mon)o(te-Carlo)f(to)q(ols)h(and)g(cross-comparisons)f(among)g
+(di\013eren)o(t)f(co)q(des)0 2109 y(are)g(imp)q(ortan)o(t)f(tasks)h(in)
+f(the)h(ligh)o(t)f(of)h(coming)f(LHC)h(Hea)o(vy)e(Ion)i(Program)g
+([14].)21 b(A)15 b(n)o(um)o(b)q(er)f(of)i(Mon)o(te-)0
+2183 y(Carlo)22 b(generators)g(is)g(a)o(v)m(ailable)f(at)g(the)h(momen)
+o(t)c(to)k(generate)g(hea)o(vy)f(ion)g(ev)o(en)o(ts)f(at)i(LHC)g
+(energies:)0 2258 y(HIJING)f([15],)h(FRITIOF)f([16],)i(LUCIAE)e([17)q
+(],)h(DPMJET-I)q(I)q(I)g([18],)h(PSM)f([19],)g(NEXUS)f([20)q(],)h(etc.)
+0 2333 y(Ho)o(w)o(ev)o(er,)10 b(\015o)o(w)i(e\013ects)f(in)f(almost)h
+(of)g(suc)o(h)g(mo)q(dels)g(are)g(lac)o(king)f(or)i(implem)o(en)n(ted)c
+(insu\016cien)o(tly)l(.)17 b(Besides,)0 2408 y(running)i(these)g(co)q
+(des)g(at)g(LHC)h(energies)e(consumes)g(m)o(uc)o(h)e(computing)i
+(e\013orts.)30 b(On)19 b(the)g(other)g(hand,)0 2482 y(macroscopic)e(h)o
+(ydro)q(dynamical)f(mo)q(dels)h(basically)g(repro)q(duce)h(the)g(bulk)g
+(of)g(hadron)h(sp)q(ectra)f(observ)o(ed)0 2557 y(at)g(SPS)g(and)g
+(RHIC,)e(and)i(can)g(b)q(e)f(in)g(principle)f(used)i(to)f(estimation)f
+(of)i(particle)e(\015o)o(w)i(e\013ects)f(at)h(LHC,)0
+2632 y(ma)o(y)f(b)q(e)h(extending)f(this)i(approac)o(h)f(to)h(ev)o(en)e
+(some)g(higher)h(p)1187 2639 y Ff(T)1233 2632 y Fj(v)m(alues.)27
+b(Of)18 b(course,)h(for)f(more)f(detailed)0 2706 y(sim)o(ulation,)10
+b(one)i(has)h(to)f(tak)o(e)g(in)o(to)f(accoun)o(t)h(the)g(in)o(terpla)o
+(y)e(b)q(et)o(w)o(een)h(h)o(ydro)h(\015o)o(w)g(and)g(semi-hard)f
+(particle)0 2781 y(\015o)o(w)17 b(due)f(to)g(parton)i(energy)d(loss,)i
+(secondary)f(scatterings,)g(etc.)992 2936 y(1)p eop
+%%Page: 2 3
+2 2 bop 0 -33 a Fk(2)81 b(\\Thermal")26 b(mo)r(del)h(and)g(fast)g(Mon)n
+(te-Carlo)f(generation)0 91 y Fj(W)l(e)16 b(suggest)h(simple)d(h)o
+(ydro)q(dynamical)h(Mon)o(te-Carlo)h(co)q(de)h([21,)f(22)q(])g(giving)g
+(\014nal)g(hadron)h(sp)q(ectrum)e(as)0 166 y(a)i(sup)q(erp)q(osition)g
+(of)g(a)f(thermal)f(distribution)h(and)g(a)h(collectiv)o(e)c(\015o)o(w)
+33 b([23)q(,)15 b(24)q(,)h(25)q(,)g(11],)669 306 y Fg(E)713
+272 y(d)738 254 y Fd(3)758 272 y Fg(N)p 713 294 90 2
+v 723 340 a(d)748 325 y Fd(3)768 340 y Fg(p)821 306 y
+Fj(=)873 247 y Fc(Z)896 341 y Ff(\033)928 306 y Fg(f)5
+b Fj(\()p Fg(x;)j(p)p Fj(\))16 b Fg(p)1109 285 y Ff(\026)1133
+306 y Fg(d\033)1186 313 y Ff(\026)1242 306 y Fg(;)690
+b Fj(\(1\))0 441 y(where)13 b(the)h(in)o(v)m(arian)o(t)f(distribution)g
+(function)g Fg(f)5 b Fj(\()p Fg(x;)j(p)p Fj(\))14 b(is)g(tak)o(en)f(in)
+g(the)g(Bose-Einstein)g(form)g(for)h(particles)0 515
+y(of)24 b(in)o(teger)f(spin)h(and)h(in)e(the)h(F)l(ermi-Dirac)e(form)g
+(for)j(particles)e(of)h(half-in)o(teger)f(spin)h(\()p
+Fg(p)1771 522 y Ff(\026)1819 515 y Fj(is)g(the)f(4-)0
+590 y(momen)o(tum)8 b(of)13 b(hadron,)h(and)f Fg(E)k
+Fj(=)d Fg(p)700 597 y Fd(0)733 590 y Fj(is)e(its)h(energy\).)19
+b(In)o(tegration)13 b(is)f(p)q(erformed)f(o)o(v)o(er)h(the)g(h)o(yp)q
+(ersurface)0 665 y Fg(\033)20 b Fj(at)e(the)g(\\freeze-out")g(temp)q
+(erature)f Fg(T)24 b Fj(=)17 b Fg(T)886 672 y Ff(f)908
+665 y Fj(.)27 b(The)18 b(formation)f(of)i(the)f(cylindrically)d
+(symmetric)f(hot)0 740 y(matter)f(expanding)h(preferably)f(along)i(the)
+f(cylinder)e(axis)i(is)g(exp)q(ected)f(in)h(the)f(case)h(of)h
+(relativistic)d(hea)o(vy)0 814 y(ion)k(collisions;)f(as)h(to)g(the)g
+(transv)o(erse)f(motion,)g(it)g(can)h(b)q(e)g(tak)o(en)f(in)o(to)h
+(accoun)o(t)f(as)i(a)f(correction)f([26)q(].)20 b(In)0
+889 y(this)12 b(case,)h(the)e(v)m(ariables)h Fg(\034)6
+b Fj(,)13 b Fg(r)q Fj(,)g Fg(\021)h Fj(and)e(\010)h(\()p
+Fg(r)i Fj(=)870 851 y Fe(p)p 911 851 153 2 v 911 889
+a Fg(x)939 875 y Fd(2)970 889 y Fj(+)c Fg(y)1045 875
+y Fd(2)1064 889 y Fg(;)32 b(\034)20 b Fj(=)1202 848 y
+Fe(p)p 1244 848 143 2 v 41 x Fg(t)1262 875 y Fd(2)1292
+889 y Fe(\000)11 b Fg(z)1367 875 y Fd(2)1387 889 y Fg(;)32
+b(\021)16 b Fj(=)1529 869 y Fd(1)p 1529 877 18 2 v 1529
+906 a(2)1560 889 y Fj(ln)1614 869 y Ff(t)p Fd(+)p Ff(z)p
+1614 877 59 2 v 1614 906 a(t)p Fb(\000)p Ff(z)1677 889
+y Fg(;)41 b Fj(tan)8 b(\010)14 b(=)g Fg(y)r(=x)p Fj(\))0
+964 y(are)19 b(commonly)c(used)k(instead)g(of)f(the)h(Cartesian)g(co)q
+(ordinates)g Fg(t)p Fj(,)f Fg(x)p Fj(,)h Fg(y)r Fj(,)f
+Fg(z)r Fj(.)28 b(W)l(e)19 b(consider)f(c)o(harged)g(and)0
+1038 y(neutral)f(pions,)g(k)m(aons)h(and)g(n)o(ucleons)f(only)l(,)f
+(and)i(k)m(aons)h(and)e(n)o(ucleons)g(are)g(supp)q(osed)h(to)g(b)q(e)f
+(thermally)0 1113 y(suppressed)c(b)o(y)g(their)f(hea)o(vier)g(mass.)20
+b(In)12 b(addition,)i(the)e(linear)h(transv)o(erse)f(v)o(elo)q(cit)o(y)
+f(pro\014le)i(sp)q(eci\014cation)779 1245 y Fg(u)807
+1225 y Ff(r)840 1245 y Fj(=)h(sinh)8 b Fg(Y)1015 1252
+y Ff(T)1057 1245 y Fj(=)1113 1211 y Fg(dR)p 1113 1234
+63 2 v 1118 1279 a(d\034)1193 1211 y(r)p 1186 1234 38
+2 v 1186 1279 a(R)0 1370 y Fj(\(whic)o(h)15 b(follo)o(ws)h(from)f(a)h
+(solution)g(of)h(the)e(nonrelativistic)g(con)o(tin)o(uit)o(y)f
+(equation)i(with)f(uniform)g(densit)o(y\))0 1444 y(and)e(longitudinal)e
+(v)o(elo)q(cit)o(y)f(sp)q(eci\014cation)i(in)g(accordance)g(with)g
+(one-dimensional)e(scaling)i(solution)h Fg(Y)1930 1451
+y Ff(L)1970 1444 y Fj(=)0 1519 y Fg(\021)23 b Fj(are)f(assumed)e(\()p
+Fg(Y)381 1526 y Ff(T)430 1519 y Fj(and)i Fg(Y)558 1526
+y Ff(L)606 1519 y Fj(are,)g(resp)q(ectiv)o(ely)l(,)e(the)h(transv)o
+(erse)g(and)h(the)f(longitudinal)g(rapidit)o(y)g(of)0
+1594 y(collectiv)o(e)13 b(motion,)i(while)h Fg(R)g Fj(is)g(the)g
+(e\013ectiv)o(e)f(transv)o(erse)h(radius)g(of)h(the)f(system\).)73
+1669 y(The)k(follo)o(wing)f(pro)q(cedure)g(w)o(ere)g(applied)g(to)h
+(sim)o(ulate)d(\\thermal")i(hadron)h(sp)q(ectra)g(in)f(hea)o(vy)g(ion)0
+1743 y(AA)c(collisions)h(at)g(giv)o(en)g(impact)e(parameter)h
+Fg(b)p Fj(.)0 1818 y(1.)21 b(The)16 b(4-momen)o(tum)c
+Fg(p)479 1800 y Fb(\003)479 1830 y Ff(\026)518 1818 y
+Fj(of)j(a)h(hadron)h(of)e(mass)g Fg(m)g Fj(w)o(as)h(generated)g(at)f
+(random)g(in)g(the)h(rest)f(frame)f(of)h(a)0 1893 y(liquid)g(elemen)o
+(t)e(in)j(accordance)g(with)g(the)g(isotropic)g(Boltzmann)f
+(distribution)147 2017 y Fg(f)5 b Fj(\()p Fg(E)234 1997
+y Fb(\003)254 2017 y Fj(\))14 b Fe(/)g Fg(E)379 1997
+y Fb(\003)398 1974 y Fe(p)p 440 1974 200 2 v 43 x Fg(E)479
+2003 y Fb(\003)p Fd(2)527 2017 y Fe(\000)d Fg(m)620 2003
+y Fd(2)648 2017 y Fj(exp)d(\()p Fe(\000)p Fg(E)828 1997
+y Fb(\003)847 2017 y Fg(=T)900 2024 y Ff(f)923 2017 y
+Fj(\))p Fg(;)84 b Fe(\000)10 b Fj(1)15 b Fg(<)e Fj(cos)c
+Fg(\022)1277 1997 y Fb(\003)1311 2017 y Fg(<)k Fj(1)p
+Fg(;)74 b Fj(0)14 b Fg(<)g(\036)1593 1997 y Fb(\003)1626
+2017 y Fg(<)g Fj(2)p Fg(\031)34 b(;)168 b Fj(\(2\))0
+2142 y(where)17 b Fg(E)181 2124 y Fb(\003)215 2142 y
+Fj(=)268 2104 y Fe(p)p 310 2104 185 2 v 38 x Fg(p)334
+2127 y Fb(\003)p Fd(2)383 2142 y Fj(+)11 b Fg(m)475 2127
+y Fd(2)511 2142 y Fj(is)17 b(the)f(energy)h(of)g(the)g(hadron,)g(and)h
+(the)e(p)q(olar)i(angle)f Fg(\022)1581 2124 y Fb(\003)1618
+2142 y Fj(and)g(the)g(azim)o(uthal)0 2217 y(angle)f Fg(\036)156
+2198 y Fb(\003)192 2217 y Fj(sp)q(ecify)g(the)g(direction)f(of)h(its)g
+(motion)g(in)g(the)g(rest)g(frame)f(of)h(the)g(liquid)f(elemen)o(t.)0
+2291 y(2.)21 b(The)14 b(spatial)h(p)q(osition)f(of)h(a)f(liquid)f
+(elemen)o(t)e(and)k(its)f(lo)q(cal)g(4-v)o(elo)q(cit)o(y)f
+Fg(u)1420 2298 y Ff(\026)1457 2291 y Fj(w)o(ere)h(generated)g(at)g
+(random)0 2366 y(in)i(accordance)g(with)g(phase)h(space)f(and)h(the)f
+(c)o(haracter)g(of)g(motion)g(of)g(the)g(\015uid:)323
+2490 y Fg(f)5 b Fj(\()p Fg(r)q Fj(\))14 b(=)g(2)p Fg(r)q(=R)587
+2470 y Fd(2)587 2503 y Ff(f)627 2490 y Fj(\(0)h Fg(<)e(r)i(<)f(R)862
+2497 y Ff(f)885 2490 y Fj(\))p Fg(;)84 b Fe(\000)11 b
+Fg(\021)1076 2497 y Fd(max)1157 2490 y Fg(<)j(\021)i(<)e(\021)1325
+2497 y Fd(max)1392 2490 y Fg(;)73 b Fj(0)15 b Fg(<)e
+Fj(\010)h Fg(<)g Fj(2)p Fg(\031)r(;)323 2578 y(u)351
+2585 y Ff(r)383 2578 y Fj(=)458 2544 y Fg(r)p 440 2566
+60 2 v 440 2612 a(R)477 2619 y Ff(f)513 2578 y Fj(sinh)9
+b Fg(Y)648 2557 y Fd(max)637 2590 y Ff(T)716 2578 y Fg(;)72
+b(u)830 2585 y Ff(t)859 2578 y Fj(=)911 2526 y Fc(q)p
+952 2526 132 2 v 952 2578 a Fj(1)12 b(+)f Fg(u)1065 2563
+y Fd(2)1065 2590 y Ff(r)1092 2578 y Fj(cosh)e Fg(\021)r(;)73
+b(u)1334 2585 y Ff(z)1367 2578 y Fj(=)1419 2526 y Fc(q)p
+1461 2526 V 52 x Fj(1)11 b(+)g Fg(u)1573 2563 y Fd(2)1573
+2590 y Ff(r)1601 2578 y Fj(sinh)d Fg(\021)34 b(;)178
+b Fj(\(3\))0 2714 y(where)15 b Fg(R)177 2721 y Ff(f)214
+2714 y Fj(is)g(the)g(e\013ectiv)o(e)e(\014nal)i(transv)o(erse)f(radius)
+h(of)h(the)e(system,)f(whic)o(h)i(is)f(\014xed)h(here)f(b)o(y)h(sp)q
+(ecifying)0 2789 y(the)24 b(mean)f(c)o(harged)h(m)o(ultiplici)o(t)o(y)d
+(p)q(er)j(unit)g(rapidit)o(y)f(in)o(terv)m(al,)i Fg(<)i(dN)q(=dy)1489
+2771 y Ff(h)1540 2789 y Fg(>)p Fj(,)f(in)e(the)g(\014nal)g(state;)992
+2936 y(2)p eop
+%%Page: 3 4
+3 3 bop 0 -33 a Fg(\021)24 -26 y Fd(max)106 -33 y Fj(=)13
+b Fg(Y)197 -51 y Fd(max)185 -21 y Ff(L)281 -33 y Fj(and)j
+Fg(Y)415 -51 y Fd(max)403 -21 y Ff(T)499 -33 y Fj(are)g(maxim)n(um)c
+(longitudinal)k(and)h(transv)o(erse)f(collectiv)o(e)d(rapidities.)0
+42 y(3.)22 b(F)l(urther,)15 b(b)q(o)q(ost)j(of)f(the)f(hadron)h
+(4-momen)o(tum)c(in)i(the)h(c.m.)k(frame)14 b(of)j(the)f(ev)o(en)o(t)f
+(w)o(as)h(p)q(erformed:)496 164 y Fg(p)520 171 y Ff(x)584
+164 y Fj(=)41 b Fg(p)687 144 y Fb(\003)716 164 y Fj(sin)8
+b Fg(\022)808 144 y Fb(\003)836 164 y Fj(cos)h Fg(\036)939
+144 y Fb(\003)969 164 y Fj(+)i Fg(u)1046 171 y Ff(r)1073
+164 y Fj(cos)e(\010)1190 91 y Fc(")1215 164 y Fg(E)1254
+144 y Fb(\003)1285 164 y Fj(+)1339 131 y(\()p Fg(u)1386
+113 y Ff(i)1399 131 y Fg(p)1423 113 y Fb(\003)p Ff(i)1456
+131 y Fj(\))p 1339 153 136 2 v 1343 199 a Fg(u)1371 206
+y Ff(t)1397 199 y Fj(+)i(1)1479 91 y Fc(#)497 306 y Fg(p)521
+313 y Ff(y)584 306 y Fj(=)41 b Fg(p)687 285 y Fb(\003)716
+306 y Fj(sin)8 b Fg(\022)808 285 y Fb(\003)836 306 y
+Fj(sin)g Fg(\036)933 285 y Fb(\003)964 306 y Fj(+)j Fg(u)1041
+313 y Ff(r)1068 306 y Fj(sin)d(\010)1179 233 y Fc(")1204
+306 y Fg(E)1243 285 y Fb(\003)1274 306 y Fj(+)1328 272
+y(\()p Fg(u)1375 254 y Ff(i)1388 272 y Fg(p)1412 254
+y Fb(\003)p Ff(i)1445 272 y Fj(\))p 1328 294 V 1332 340
+a Fg(u)1360 347 y Ff(t)1386 340 y Fj(+)j(1)1469 233 y
+Fc(#)498 447 y Fg(p)522 454 y Ff(z)584 447 y Fj(=)41
+b Fg(p)687 426 y Fb(\003)716 447 y Fj(cos)8 b Fg(\022)813
+426 y Fb(\003)844 447 y Fj(+)j Fg(u)921 454 y Ff(z)949
+374 y Fc(")973 447 y Fg(E)1012 426 y Fb(\003)1043 447
+y Fj(+)1097 413 y(\()p Fg(u)1144 395 y Ff(i)1158 413
+y Fg(p)1182 395 y Fb(\003)p Ff(i)1214 413 y Fj(\))p 1097
+435 V 1101 481 a Fg(u)1129 488 y Ff(t)1155 481 y Fj(+)g(1)1238
+374 y Fc(#)503 556 y Fg(E)45 b Fj(=)c Fg(E)702 535 y
+Fb(\003)722 556 y Fg(u)750 563 y Ff(t)776 556 y Fj(+)11
+b(\()p Fg(u)872 535 y Ff(i)885 556 y Fg(p)909 535 y Fb(\003)p
+Ff(i)942 556 y Fj(\))p Fg(;)971 b Fj(\(4\))0 664 y(where)484
+773 y(\()p Fg(u)531 753 y Ff(i)545 773 y Fg(p)569 753
+y Fb(\003)p Ff(i)601 773 y Fj(\))41 b(=)h Fg(u)769 780
+y Ff(r)788 773 y Fg(p)812 753 y Fb(\003)840 773 y Fj(sin)8
+b Fg(\022)932 753 y Fb(\003)960 773 y Fj(cos)h(\(\010)i
+Fe(\000)g Fg(\036)1178 753 y Fb(\003)1198 773 y Fj(\))g(+)g
+Fg(u)1305 780 y Ff(z)1324 773 y Fg(p)1348 753 y Fb(\003)1377
+773 y Fj(cos)d Fg(\022)1474 753 y Fb(\003)1510 773 y
+Fg(:)422 b Fj(\(5\))0 882 y(Anisotropic)24 b(\015o)o(w)g(is)g(in)o(tro)
+q(duced)g(here)f(under)h(simple)e(assumption)i(that)h(the)f(spatial)g
+(ellipticit)o(y)d(of)0 957 y(\\freeze-out")16 b(region,)g
+Fg(\017)e Fj(=)g Fe(h)p Fg(y)563 938 y Fd(2)594 957 y
+Fe(\000)c Fg(x)671 938 y Fd(2)691 957 y Fe(i)f Fg(=)f
+Fe(h)q Fg(y)797 938 y Fd(2)827 957 y Fj(+)j Fg(x)904
+938 y Fd(2)923 957 y Fe(i)q Fj(,)16 b(is)g(directly)e(related)i(to)h
+(the)f(ellipticit)o(y)d(of)j(the)g(system)0 1031 y(formed)h(in)h(the)g
+(region)g(of)g(the)g(initial)f(o)o(v)o(erlap)g(of)i(n)o(uclei,)d
+Fg(\017)1149 1038 y Fd(0)1186 1031 y Fj(=)h Fg(b=)p Fj(2)p
+Fg(R)1347 1038 y Ff(A)1394 1031 y Fj(\()p Fg(R)1450 1038
+y Ff(A)1497 1031 y Fj(is)h(n)o(ucleus)f(radius\).)28
+b(This)0 1106 y(\\scaling")17 b(enables)f(one)h(to)g(a)o(v)o(oid)f(in)o
+(tro)q(ducing)g(additional)g(parameters)g(and,)h(at)f(the)h(same)e
+(time,)f(leads)0 1181 y(to)20 b(an)h(azim)o(uthal)c(anisotrop)o(y)k(of)
+f(generated)g(particles)f(due)g(to)h(dep)q(endence)g(of)g(e\013ectiv)o
+(e)e(\014nal)i(radius)0 1255 y Fg(R)37 1262 y Ff(f)60
+1255 y Fj(\()p Fg(b)p Fj(\))c(on)g(the)g(angle)h(\010)f([27)q(]:)153
+1364 y Fg(R)190 1371 y Ff(f)213 1364 y Fj(\()p Fg(b)p
+Fj(\))d(=)h Fg(R)374 1371 y Ff(f)397 1364 y Fj(\()p Fg(b)f
+Fj(=)h(0\))j(min)n Fe(f)668 1309 y Fc(q)p 709 1309 273
+2 v 709 1364 a Fj(1)12 b Fe(\000)f Fg(\017)815 1347 y
+Fd(2)815 1375 y(0)859 1364 y Fj(sin)919 1344 y Fd(2)947
+1364 y Fj(\010)g(+)g Fg(\017)1062 1371 y Fd(0)1106 1364
+y Fj(cos)d(\010)p Fg(;)1269 1309 y Fc(q)p 1311 1309 V
+55 x Fj(1)j Fe(\000)g Fg(\017)1416 1347 y Fd(2)1416 1375
+y(0)1460 1364 y Fj(sin)1520 1344 y Fd(2)1548 1364 y Fj(\010)g
+Fe(\000)g Fg(\017)1664 1371 y Fd(0)1708 1364 y Fj(cos)d(\010)p
+Fe(g)p Fg(:)91 b Fj(\(6\))0 1473 y(Obtained)14 b(in)g(suc)o(h)g(a)h(w)o
+(a)o(y)f(azim)o(uthal)e(distribution)i(of)g(particles)g(is)g(describ)q
+(ed)f(w)o(ell)g(b)o(y)h(the)g(elliptic)e(form)0 1548
+y(for)17 b(the)f(domain)f(of)h(reasonable)h(impact)e(parameter)g(v)m
+(alues.)73 1622 y(W)l(e)i(also)g(set)f(the)h(P)o(oisson)g(m)o
+(ultiplici)o(t)o(y)c(distribution)j(and)i(assume)e(that)h(the)f(mean)g
+(m)o(ultipli)o(cit)n(y)e(of)0 1697 y(particles)19 b(is)g(prop)q
+(ortional)i(to)f(the)g(n)o(uclear)f(o)o(v)o(erlap)g(function)g([27].)32
+b(F)l(or)19 b(estimated)f(\\freeze-out")i(pa-)0 1772
+y(rameters)12 b({)j(temp)q(erature)d Fg(T)541 1779 y
+Ff(f)577 1772 y Fj(=)i(140)h(MeV,)d(collectiv)o(e)f(longitudinal)j
+(rapidit)o(y)e Fg(Y)1545 1754 y Ff(max)1533 1784 y(L)1630
+1772 y Fj(=)i(5)g(and)h(collectiv)o(e)0 1846 y(transv)o(erse)k(rapidit)
+o(y)g Fg(Y)461 1828 y Ff(max)450 1859 y(T)552 1846 y
+Fj(=)g(1)h({)g(w)o(e)f(get)h(a)o(v)o(erage)f(hadron)i(transv)o(erse)e
+(momen)o(tum)c Fg(<)k(p)1778 1828 y Ff(h)1778 1859 y(T)1826
+1846 y Fg(>)p Fj(=)g(0)p Fg(:)p Fj(55)0 1921 y(GeV/c)d(and)h(follo)o
+(wing)f(particle)f(ratios:)123 2030 y Fg(\031)153 2009
+y Fb(\006)195 2030 y Fj(:)f Fg(K)268 2009 y Fb(\006)311
+2030 y Fj(:)g Fg(p)363 2009 y Fb(\006)406 2030 y Fj(=)g(24)h(:)e(6)h(:)
+g(1)p Fg(;)89 b(\031)771 2009 y Fb(\006)814 2030 y Fj(:)14
+b Fg(\031)872 2009 y Fd(0)905 2030 y Fj(=)f(2)i(:)e(1)p
+Fg(;)89 b(K)1194 2009 y Fb(\006)1238 2030 y Fj(:)13 b
+Fg(K)1310 2009 y Fd(0)1344 2030 y Fj(=)h(1)g(:)f(1)p
+Fg(;)90 b(p)14 b Fj(:)g Fg(n)f Fj(=)h(1)g(:)g(1)33 b
+Fg(:)73 2139 y Fj(The)12 b(mo)q(del)e(has)i(b)q(een)f(realized)f(as)i
+(fast)g(Mon)o(te-Carlo)g(ev)o(en)o(t)e(generator,)i(and)g(corresp)q
+(onding)g(F)l(ortran)0 2213 y(routine)20 b(is)h(a)o(v)m(ailable)f(b)o
+(y)g(the)g(w)o(eb)h([28].)34 b(The)21 b(follo)o(wing)f(input)h
+(parameters)e(should)i(b)q(e)g(sp)q(eci\014ed)f(b)o(y)0
+2288 y(user)15 b(to)h(set)g(hadron)g(ev)o(en)o(t)e(con\014guration:)22
+b(b)q(eam)15 b(and)h(target)g(n)o(ucleus)e(atomic)g(n)o(um)o(b)q(er;)g
+(t)o(yp)q(e)h(of)g(ev)o(en)o(t)0 2363 y(cen)o(tralit)o(y)10
+b(generation)i(\(options)h(\\\014xed)f(impact)e(parameter")h(or)i
+(\\impact)d(parameter)h(is)h(generated)g(with)0 2437
+y(standard)21 b(Glaub)q(er)f(geometry)e(b)q(et)o(w)o(een)h(minim)n(um)d
+(and)k(maxim)o(um)15 b(v)m(alues")20 b(are)g(foreseen\);)h(baseline)0
+2512 y(mean)h(c)o(harged)g(particle)g(m)o(ultipli)o(cit)n(y)e(p)q(er)i
+(unit)h(rapidit)o(y)f(at)h(mid-rapidit)o(y)l(,)e Fg(<)k(dN)1663
+2494 y Fb(\006)1693 2512 y Fg(=dy)1768 2494 y Ff(h)1815
+2512 y Fg(>)g Fj(\()p Fg(y)1923 2494 y Ff(h)1970 2512
+y Fj(=)0 2587 y(0\),)f(in)e(cen)o(tral)f(Pb-Pb)i(collisions)f(\(total)g
+(m)o(ultiplici)o(t)o(y)d(for)k(other)f(cen)o(tralities)e(and)j(atomic)e
+(n)o(um)o(b)q(ers)0 2662 y(will)c(b)q(e)i(calculated)e
+(automatically\).)26 b(Since)18 b(the)g(output)h(particle)f
+(information)f(is)h(stored)h(in)f(common)0 2736 y(blo)q(c)o(k)c(LUJETS)
+h(of)f(JETSET)h(routine)f([29)q(],)f(main)g(users)i(program)f(should)h
+(b)q(e)f(compiled)e(with)i(JETSET)0 2811 y(F)l(ortran)j(routine)f(with)
+g(extended)f(size)h(\(up)g(to)h(150000\))h(of)f(LUJETS)g(arra)o(ys.)992
+2936 y(3)p eop
+%%Page: 4 5
+4 4 bop 0 -33 a Fk(3)81 b(Conclusions)0 91 y Fj(The)21
+b(simple)e(mo)q(del)h(to)i(sim)o(ulate)d(\015o)o(w)i(e\013ects)g(in)g
+(hea)o(vy)g(ion)g(collisions)f(at)i(LHC)g(energies)e(has)i(b)q(een)0
+166 y(dev)o(elop)q(ed.)e(This)15 b(mo)q(del)f(is)g(realized)g(as)i
+(fast)f(Mon)o(te-Carlo)g(ev)o(en)o(t)f(generator,)h(and)h(corresp)q
+(onding)f(F)l(or-)0 241 y(tran)i(routine)f(is)g(a)o(v)m(ailable)f(b)o
+(y)h(the)g(w)o(eb.)73 390 y(T)l(o)h(conclude,)e(let)g(us)i(to)g
+(discuss)f(the)g(ph)o(ysics)g(v)m(alidit)o(y)e(of)j(the)f(mo)q(del)f
+(application.)73 498 y Fe(\017)24 b Fj(In)o(ternal)14
+b(parameters)h(of)h(the)f(routine)g(for)h(\015o)o(w)g(w)o(ere)e
+(selected)g(as)i(an)g(estimation)e(for)i(LHC)g(hea)o(vy)122
+572 y(ion)f(b)q(eam)f(energies.)20 b(The)14 b(result)h(for)f(other)h(b)
+q(eam)f(energy)g(ranges,)i(obtained)f(without)g(additional)122
+647 y(in)o(ternal)g(parameters)g(adjusting,)i(is)f(not)h(exp)q(ected)e
+(to)i(b)q(e)f(reasonable.)73 761 y Fe(\017)24 b Fj(Hydro-t)o(yp)q(e)14
+b(description)f(of)h(hea)o(vy)g(ion)g(collisions)f(is)h(exp)q(ected)f
+(to)i(b)q(e)f(applicable)f(for)h(cen)o(tral)f(and)122
+835 y(semi-cen)o(tral)i(collisions.)26 b(The)18 b(result)g(obtained)g
+(for)g(v)o(ery)f(p)q(eripheral)g(collisions)h(\()p Fg(b)e
+Fe(\030)h Fj(2)p Fg(R)1869 842 y Ff(A)1898 835 y Fj(\))h(can)122
+910 y(b)q(e)e(not)h(adequate.)73 1023 y Fe(\017)24 b
+Fj(Hydro)13 b(\015o)o(w)i(mec)o(hanism)10 b(in)j(hea)o(vy)g(ion)h
+(collisions)f(is)h(v)m(alid)f(for)h(restricted)f(kinematic)e(range:)20
+b(mid-)122 1098 y(rapidit)o(y)l(,)15 b(lo)o(w)h(and)g(in)o(termediate)d
+Fg(p)805 1105 y Ff(T)833 1098 y Fj(.)22 b(The)16 b(mo)q(del)f(is)h(not)
+g(applicable)g(for)g(v)o(ery)f(forw)o(ard)i(rapidit)o(y)122
+1173 y(\()p Fe(j)p Fg(y)r Fe(j)208 1164 y Fg(>)208 1188
+y Fe(\030)261 1173 y Fj(3\))f(and)h(v)o(ery)e(high)h
+Fg(p)654 1180 y Ff(T)699 1173 y Fj(\()p Fe(\035)d Fj(2)f
+Fe(\000)f Fj(5)16 b(GeV/c\).)73 1280 y Fa(A)n(cknow)r(le)n(dgments.)0
+1355 y Fj(W)l(e)f(w)o(ould)g(lik)o(e)e(to)i(thank)h(S.V.)d(P)o
+(etrushank)o(o,)i(C.)g(Roland)h(and)f(L.I.)f(Saryc)o(hev)m(a)h(for)g
+(useful)g(discussions.)0 1520 y Fk(References)24 1644
+y Fj([1])24 b(Pro)q(ceedings)c(of)f(16th)h(In)o(ternational)f
+(Conference)g(on)h(Ultrarelativistic)c(Nucleus-Nucleus)h(Colli-)100
+1719 y(sions)e(\\Quark)g(Matter'2002")g(\(Nan)o(tes,)f(F)l(rance,)f
+(July)h(18-24,)i(2002\),)g(Nucl.)c(Ph)o(ys.)i Fl(A)j(715)d
+Fj(\(2003\).)24 1832 y([2])24 b(N.)16 b(Xu)g Fa(et)i(al.)e
+Fj(\(NA44)g(Coll.\),)f(Nucl.)g(Ph)o(ys.)h Fl(A)j(610)d
+Fj(\(1996\))i(175.)24 1945 y([3])24 b(H.)16 b(App)q(elshauser)g
+Fa(et)i(al.)f Fj(\(NA49)f(Coll.\),)f(Eur.)h(Ph)o(ys.)f(J.)h
+Fl(C)j(2)e Fj(\(1998\))h(661.)24 2059 y([4])24 b(O.)16
+b(Barannik)o(o)o(v)m(a)g Fa(et)i(al.)f Fj(\(ST)l(AR)f(Coll.\),)f(Nucl.)
+f(Ph)o(ys.)i Fl(A)j(715)d Fj(\(2003\))i(458.)24 2172
+y([5])24 b(T.)17 b(Ch)o(ujo)f Fa(et)j(al.)e Fj(\(PHENIX)e(Coll.\),)g
+(Nucl.)g(Ph)o(ys.)h Fl(A)j(715)e Fj(\(2003\))h(151;)f(S.)g(Adler)e
+Fa(et)j(al)f Fj(\(PHENIX)100 2247 y(Coll.\),)e([arXiv:n)o
+(ucl-ex/0307022].)24 2360 y([6])24 b(I.L.)16 b(Rozen)o(tal)f(and)i(Y)l
+(u.A.)e(T)l(araso)o(v,)h(Ph)o(ys.)g(Usp.)g Fl(36)g Fj(\(1993\))i(572.)
+24 2474 y([7])24 b(H.)14 b(App)q(elshauser)h Fa(et)i(al.)e
+Fj(\(NA49)g(Coll.\),)f(Ph)o(ys.)h(Rev.)e(Lett)i Fl(80)g
+Fj(\(1998\))i(4136;)f(C.)f(Alt)f Fa(et)j(al.)e Fj(\(ST)l(AR)100
+2548 y(Coll.\),)g(Ph)o(ys.)h(Rev.)f Fl(C)k(68)e Fj(\(2003\))g(034903.)
+24 2662 y([8])24 b(K.H.)d(Ac)o(k)o(ermann)e Fa(et)24
+b(al.)e Fj(\(ST)l(AR)g(Coll.\),)g(Ph)o(ys.)g(Rev.)f(Lett.)h
+Fl(86)g Fj(\(2001\))h(402;)j(C.)c(Adler)f Fa(et)j(al.)100
+2736 y Fj(\(ST)l(AR)e(Coll.\),)g(Ph)o(ys.)f(Rev.)f(Lett.)i
+Fl(87)f Fj(\(2001\))j(182303;)i(Ph)o(ys.)21 b(Rev.)g(Lett.)g
+Fl(90)h Fj(\(2003\))h(032301;)100 2811 y(R.J.M.)15 b(Snellings)g
+Fa(et)j(al.)f Fj(\(ST)l(AR)f(Coll.\))f(Nucl.)g(Ph)o(ys.)h
+Fl(A)j(698)d Fj(\(2002\))i(193.)992 2936 y(4)p eop
+%%Page: 5 6
+5 5 bop 24 -33 a Fj([9])24 b(R.A.)15 b(Lacey)h Fa(et)i(al.)f
+Fj(\(PHENIX)e(Coll.\),)g(Nucl.)g(Ph)o(ys.)g Fl(A)k(698)e
+Fj(\(2002\))g(559.)0 80 y([10])24 b(I.C.)15 b(P)o(ark)h
+Fa(et)i(al.)f Fj(\(PHOBOS)e(Coll.\),)g(Nucl.)g(Ph)o(ys.)g
+Fl(A)k(698)e Fj(\(2002\))g(564;)g(B.B.)d(Bac)o(k)i Fa(et)h(al.)g
+Fj(\(PHO-)100 155 y(BOS)f(Coll.\),)f(Ph)o(ys.)h(Rev.)f(Lett.)h
+Fl(89)g Fj(\(2002\))i(222301;)g(Nucl.)d(Ph)o(ys.)g Fl(A)k(715)e
+Fj(\(2003\))h(611.)0 269 y([11])24 b(P)l(.F.)17 b(Kolb,)i(J.)e
+(Sollfrank,)h(and)h(U.)e(Heinz,)g(Ph)o(ys.)h(Rev.)f Fl(C)k(62)d
+Fj(\(2000\))i(054909;)h(P)l(.F.)c(Kolb)h Fa(et)i(al.)p
+Fj(,)100 343 y(Ph)o(ys.)c(Lett.)g Fl(B)i(500)f Fj(\(2001\))g(232;)g
+(Nucl.)e(Ph)o(ys.)h Fl(A)j(696)d Fj(\(2001\))i(175.)0
+457 y([12])24 b(E.E.)16 b(Zabro)q(din,)h(C.)f(F)l(uc)o(hs,)f(L.V.)g
+(Bra)o(vina,)g(and)i(A.)f(F)l(aessler,)f(Ph)o(ys.)h(Lett.)g
+Fl(B)i(508)e Fj(\(2001\))i(184.)0 570 y([13])24 b(M.)16
+b(Gyulassy)l(,)g(I.)f(Vitev,)f(and)j(X.-N.)e(W)l(ang,)i(Ph)o(ys.)f
+(Rev.)f(Lett.)h Fl(86)g Fj(\(2001\))i(2537.)0 683 y([14])24
+b(CERN)16 b(W)l(orkshop)i(on)e(Mon)o(te)g(Carlo)h(to)q(ols)g(for)g(the)
+f(LHC,)100 758 y(h)o(ttp://mlm.hom)o(e.)o(ce)o(rn.c)n(h/ml)o(m)o(/m)o
+(c)o(wshop03/mcwshop.h)o(tml)29 b(.)0 871 y([15])24 b(M.)19
+b(Gyulassy)g(and)h(X.-N.)d(W)l(ang,)k(Ph)o(ys.)d(Rev.)g
+Fl(D)k(44)e Fj(\(1991\))g(3501;)i(Comput.)c(Ph)o(ys.)h(Comm)o(un.)100
+946 y Fl(83)e Fj(\(1994\))g(307.)0 1059 y([16])24 b(Hong)h(Pi,)h
+(Comput.)e(Ph)o(ys.)f(Comm)o(un.)f Fl(71)j Fj(\(1992\))h(173;)j(B.)24
+b(Andersson,)i(G.)f(Gustafson,)i(and)100 1134 y(Hong)17
+b(Pi,)e(Z.)h(Ph)o(ys.)g Fl(C)j(57)d Fj(\(1993\))i(485.)0
+1247 y([17])24 b(An)16 b(T)l(ai)h(and)f(Ben-Hao)h(Sa,)f(Comput.)f(Ph)o
+(ys.)h(Comm)o(un.)d Fl(116)k Fj(\(199\))g(353.)0 1361
+y([18])24 b(S.)16 b(Ro)q(esler,)g(R.)f(Engel,)h(and)h(J.)f(Ranft,)g
+([arXiv:)k(hep-ph/0012252].)0 1474 y([19])k(N.S.)15 b(Amelin,)e(N.)j
+(Armesto,)e(C.)i(P)o(a)s(jars,)g(and)h(D.)f(Sousa,)h(Eur.)f(Ph)o(ys.)g
+(J.)g Fl(C)j(22)d Fj(\(2001\))i(149.)0 1587 y([20])24
+b(K.)16 b(W)l(erner,)f(H.J.)g(Dresc)o(her,)g(S.)h(Ostap)q(c)o(henk)o
+(o,)g(and)h(T.)f(Pierog,)g([arXiv:)k(hep-ph/0209198].)0
+1700 y([21])k(N.A.)15 b(Kruglo)o(v,)g(I.P)l(.)g(Lokh)o(tin,)h(L.I.)g
+(Saryc)o(hev)m(a,)f(and)i(A.M.)d(Snigirev,)h(Z.)h(Ph)o(ys.)g
+Fl(C)j(76)d Fj(\(1997\))i(99.)0 1814 y([22])24 b(I.P)l(.)12
+b(Lokh)o(tin,)h(L.I.)f(Saryc)o(hev)m(a,)g(and)i(A.M.)d(Snigirev,)h(Ph)o
+(ys.)g(Lett.)g Fl(B)j(537)d Fj(\(2002\))j(261;)f(Nucl.)d(Ph)o(ys.)100
+1888 y Fl(A)19 b(715)e Fj(\(2003\))g(633.)0 2002 y([23])24
+b(E.)16 b(Sc)o(hnedermann,)e(J.)i(Sollfrank,)g(and)h(U.)e(Heinz,)f(Ph)o
+(ys.)i(Rev.)f Fl(C)k(48)e Fj(\(1993\))g(2462.)0 2115
+y([24])24 b(S.)16 b(Muro)o(y)o(a,)g(H.)f(Nak)m(am)o(ura,)g(and)i(M.)e
+(Namiki,)e(Progr.)k(Theor.)f(Ph)o(ys.)g(Suppl.)g Fl(120)g
+Fj(\(1995\))i(209.)0 2228 y([25])24 b(I.P)l(.)15 b(Lokh)o(tin)i(and)f
+(A.M.)f(Snigirev,)g(Ph)o(ys.)h(Lett.)f Fl(B)k(378)d Fj(\(1996\))i(247.)
+0 2342 y([26])24 b(J.D.)16 b(Bjork)o(en,)f(Ph)o(ys.)g(Rev.)h
+Fl(D)i(27)e Fj(\(1983\))i(140.)0 2455 y([27])24 b(I.P)l(.)15
+b(Lokh)o(tin)i(and)f(A.M.)f(Snigirev,)g(Eur.)h(Ph)o(ys.)g(J)g
+Fl(C)j(16)d Fj(\(2000\))i(527.)0 2568 y([28])24 b(HYDR)o(O)15
+b(fast)i(ev)o(en)o(t)e(generator,)100 2643 y(h)o(ttp://cern.c)o(h/lokh)
+o(tin/h)o(ydro)31 b(.)0 2756 y([29])24 b(T.)16 b(Sj\177)-24
+b(ostrand,)17 b(Comput.)e(Ph)o(ys.)h(Comm)o(un.)e Fl(82)i
+Fj(\(1994\))i(74.)992 2936 y(5)p eop
+%%Trailer
+end 
+end
+
+userdict /end-hook known{end-hook}if
+%%EOF
diff --git a/THydjet/hydjet1_1/hydjet.txt b/THydjet/hydjet1_1/hydjet.txt
new file mode 100644 (file)
index 0000000..b772786
--- /dev/null
@@ -0,0 +1,169 @@
+
+      -------------------------------------------------------------
+      HYDJET, fast MC code to simulate flow effects, jet production 
+      and jet quenching in heavy ion AA collisions at the LHC
+      -------------------------------------------------------------
+      This code is merging HYDRO (flow effects), PYTHIA6.4 (hard jet 
+      production) and PYQUEN (jet quenching)
+      --------------------------------------------------------------
+
+      Igor Lokhtin, SINP MSU, Moscow, RU
+      e-mail: Igor.Lokhtin@cern.ch 
+
+      Reference for HYDJET: 
+      I.P. Lokhtin, A.M. Snigirev, 
+      Eur. Phys. J. C 46 (2006) 211.
+
+      References for HYDRO: 
+      N.A.Kruglov, I.P.Lokhtin, L.I.Sarycheva, A.M.Snigirev, 
+      Z. Phys. C 76 (1997) 99;  
+      I.P.Lokhtin, L.I.Sarycheva, A.M.Snigirev, 
+      Phys. Lett. B 537 (2002) 261;   
+      I.P.Lokhtin, A.M.Snigirev, Preprint SINP MSU 2004-14/753, hep-ph/0312204. 
+
+      References for PYQUEN: 
+      I.P.Lokhtin, A.M.Snigirev, Eur.Phys.J. C16 (2000) 527;   
+      I.P.Lokhtin, A.M.Snigirev, Preprint SINP MSU 2004-13/752, hep-ph/0406038.
+
+      References for PYTHIA: 
+      T.Sjostrand et al., Comput.Phys.Commun. 135 (2001) 238; 
+      T.Sjostrand, S. Mrena and P. Skands, hep-ph/0603175.
+      
+      Reference for JETSET event format:  
+      T.Sjostrand, Comput.Phys.Commun. 82 (1994) 74.  
+   
+      -------------------------------------------------------------- 
+      Web-page: 
+      http://cern.ch/lokhtin/hydro
+      --------------------------------------------------------------
+
+      Description of routine
+       
+CALL hydro(A,ifb,bmin,bmax,bfix,nh)  - generates one event
+
+input parameters to fix event configuration : 
+(set in main user routine before hydro call)
+
+  A    - beam and target nucleus atomic weight 
+  ifb  - flag of type of centrality generation 
+         =0 impact parameter is fixed (bfix)  
+        >0 or <0 impact parameter is generated with standard Glauber geometry 
+                 between minimum (bmin) and maximum (bmax) values 
+  bmin - minimum impact parameter in units of nucleus radius RA
+         (i.e. minimum value in [fm] will be bmin*RA), 
+         valid only if ifb not equal to zero   
+  bmax - maximum impact parameter in units of nucleus radius RA
+         (i.e. maximum value in [fm] will be bmax*RA),
+         valid only if ifb not equal to zero 
+  bfix - fixed impact parameter in units of nucleus radius RA 
+         (i.e. fixed value in [fm] will be bfix*RA), 
+         valid only if ifb=0
+  nh   - mean soft hadron multiplicity in central Pb-Pb collisions 
+        (multiplicity for other centralities and atomic numbers 
+        will be calculated automatically).  
+
+      --------------------------------------------------------------
+
+Parameters in COMMON BLOCKS  which can be varied by user: 
+
+COMMON /hyflow/ ytfl,ylfl,fpart 
+ytfl - maximum transverse collective rapidity, controls slope of low-pt spectra 
+(allowed range is 0.01<ytfl<3.0, default value is ytfl=1.).
+ylfl - maximum longitudinal collective rapidity, controls width of eta-spectra
+(allowed range is 0.01<ylfl<7.0, default value is ylfl=5.).
+fpart - fraction of soft multiplicity proportional to the number of nucleon
+participants; then (1.-fpart) will be the fraction of soft multiplicity
+proportional to the number of nucleon-nucleon binary sub-collisions  
+(allowed range is 0.01<fpart<1.0, default value is fpart=1.). 
+
+COMMON /hyjpar/ nhsel,ptmin,njet  
+nhsel - flag to include jet production in hydro event: 
+nhsel=0 - jet production off (pure HYDRO event);
+nhsel=1 - jet production on, jet quenching off (HYDRO+njet*PYTHIA events);
+nhsel=2 - jet production & jet quenching on (HYDRO+njet*PYQUEN events);
+nhsel=3 - jet production on, jet quenching off, HYDRO off (njet*PYTHIA events);
+nhsel=4 - jet production & jet quenching on, HYDRO off (njet*PYQUEN events);
+(default value is nhsel = 0).
+ptmin - minimal pt of parton-parton scattering in PYTHIA event, parameter
+ckin(3) in PYTHIA common block /pysubs/ should be set equal to ptmin 
+(allowed range is 5 GeV < ptmin < 500 GeV, default value ptmin=10 GeV).
+
+      -------------------------------------------------------------- 
+
+Output event parameters in COMMON BLOCKS: 
+
+COMMON /hyjpar/ nhsel,ptmin,njet 
+njet - number of hard parton-parton scatterings with pt>ptmin in event.
+
+common /hyfpar/ bgen,nbcol,npart,npyt,nhyd
+bgen - generated value of impact parameter in units of nucleus radius RA 
+(i.e the value in [fm] will be bgen*RA).
+nbcol - mean number of nucleon-nucleon binary sub-collisions at given 'bgen'. 
+npart - mean number of nucleon participants at given 'bgen'. 
+npyt - multiplicity of hard PYTHIA/PYQUEN-induced particles in event 
+       (including full parton story).  
+nhyd - multiplicity of soft HYDRO-induced hadrons in event. 
+
+      -------------------------------------------------------------- 
+
+Output particle information
+
+COMMON /lujets/ n,k(150000,5),p(150000,5),v(150000,5)
+n - total event multiplicity    
+k(i,1-5) - particle codes       
+p(i,1-5) - particle four-momentum and mass 
+v(i,1-5) - particle vertex, production time and lifetime   
+
+NOTE! First 'npyt' lines in event list correspond to PYTHIA/PYQUEN-induced 
+      particles, last 'nhyd' lines -- HYDRO-induced hadrons.  
+
+COMMON /hyjets/ nl,kl(150000,5),pl(150000,5),vl(150000,5) 
+contains list of parton history of event in the same format as /lujets/ 
+
+      --------------------------------------------------------------  
+    
+NOTE! Main users routine should be compiled with object files obtained by: 
+      - jetset_73.f with extended array size in common block /lujets/; 
+      - pythia6.401.f (or later versions);
+      - pyquen1_1.f;  
+      - hydjet1_1.f. 
+      
+NOTE! Since variables (A-H, O-Z) are described as IMPLICIT DOUBLE PRECISION 
+in 'pythia' and 'pyquen', the corresponding 'pythia' and 'pyquen' variables and
+parameters used in main users routine should be described also as 'double 
+precision'. However variables and parameters from JETSET and HYDRO including
+output event information are supposed to be REAL. 
+      
+NOTE! Since pyquen deals with partonic pythia event, the fragmentation in 
+      subroutine 'hyhard' is switched off before pyquen call using parameter 
+      mstp(111) from pythia common block pypars:     
+      ...
+      mstp(111)=0                           ! fragmentation off  
+c      mstj(41)=0                          ! vacuum showering off 
+      call pyevnt                         ! 'normal' single pythia event 
+      ... 
+      call pyquen(A,ifb,bfix)             ! 'quenched' single pythia event 
+      ... 
+      call pyexec                         ! fragmentation done  
+      ...                            
+      in the case if Pythia final state radiation is switching off (if one set 
+      mstj(41)=0 in 'hyhard'), the Pyquen option "vacuum showering after 
+      in-medium partonic energy loss" is foreseen.
+      
+NOTE! In order to adjust string fragmentation with additional gluons in Pythia, 
+      the parameter paru(14)=1.d0 have to be specified in main users routine. 
+     
+      -------------------------------------------------------------------------    
+        
+      Physics validity of the model 
+      
+1. Internal parameters of the routine were optimized as an estimation 
+for LHC heavy ion beam energies. The result for other beam energy ranges, 
+obtained without additional internal parameters adjusting, is not expected 
+to be reasonable. 
+2. Hydro-type approximation for heavy ion collisions is expected to be 
+applicable for central and semi-central collisions. The result obtained for 
+very peripheral collisions (b~2*RA) can be not adequate. 
+3. We do not expect correct event description for very forward rapidities 
+(|y|>3), where other mechanisms of particle production among hydro-flow and
+jets can be important. 
diff --git a/THydjet/hydjet1_1/hydjet1_1.f b/THydjet/hydjet1_1/hydjet1_1.f
new file mode 100644 (file)
index 0000000..1a36f29
--- /dev/null
@@ -0,0 +1,740 @@
+*----------------------------------------------------------------------
+*
+*  Filename             : HYDJET1_1.F
+*
+*  Author               : Igor Lokhtin  
+*  Version              : HYDJET1_1.f
+*  Last revision        : 27-MAR-2006 
+*
+*======================================================================
+*
+*  Description : Fast event generator for AA collisons at the LHC            
+*
+*  Method I.P. Lokhtin and A.M. Snigirev, Eur. Phys. J C 45 (2006) 211        
+*
+*======================================================================
+
+      SUBROUTINE HYDRO(A,ifb,bmin,bmax,bfix,nh)  
+      real hsin,hgauss,hftaa 
+      real AW 
+      real A,bmin,bmax,bfix 
+      integer numjet,numpar 
+      integer ifb,nh,np 
+      external hsin,hgauss,hftaa,numjet,numpar,hyhard,hipsear 
+      external ludata 
+      common /lujets/ n,k(150000,5),p(150000,5),v(150000,5)
+      common /hyjets/ nl,kl(150000,5),pl(150000,5),vl(150000,5) 
+      common /hyipar/ bminh,bmaxh,AW,RA,sigin,np  
+      common /hyfpar/ bgen,nbcol,npart,npyt,nhyd
+      common /hyflow/ ytfl,ylfl,fpart
+      common /hyjpar/ nhsel,ptmin,njet 
+      save/lujets/,/hyjets/,/hyipar/,/hyfpar/,/hyflow/,/hyjpar/ 
+
+      integer nnhyd, khyd
+      real phyd, vhyd
+      common /hyd/ nnhyd, khyd(150000,5),phyd(150000,5),vhyd(150000,5)
+      save /hyd/
+
+* reset lujets and hyd arrays before event generation 
+      
+      n=0 
+      nnhyd=0 
+      do ncl=1,150000
+       do j=1,5
+        p(ncl,j)=0.
+       phyd(ncl,j)=0.
+       v(ncl,j)=0. 
+       vhyd(ncl,j)=0.  
+        k(ncl,j)=0
+       khyd(ncl,j)=0 
+       enddo
+      end do 
+
+* set initial beam paramters: atomic weigth and radius in fm 
+      AW=A         
+      RA=1.15*AW**0.333333  
+* 
+      pi=3.14159
+      
+* generate impact parameter of A-A collision 
+
+      if(ifb.eq.0) then 
+       if(bfix.lt.0.) then    
+        write(6,*) 'Impact parameter less than zero!'  
+        bfix=0. 
+       end if  
+       if (bfix.gt.2.) then 
+        write(6,*) 'Impact parameter larger than two nuclear radius!'  
+        bfix=2.        
+       end if 
+       b1=bfix*RA
+       bgen=bfix 
+      else        
+       if(bmin.lt.0.) then    
+        write(6,*) 'Impact parameter less than zero!'  
+        bmin=0. 
+       end if 
+       if(bmax.gt.2.) then    
+        write(6,*) 'Impact parameter larger than two nuclear radius!'
+        bmax=2.  
+       end if             
+       bminh=bmin 
+       bmaxh=bmax   
+       call hipsear(fmax1,xmin1) 
+       fmax=fmax1 
+       xmin=xmin1 
+ 3     bb1=xmin*rlu(0)+bminh  
+       ff1=fmax*rlu(0) 
+       fb=hsin(bb1) 
+       if(ff1.gt.fb) goto 3    
+       b1=bb1*RA       
+       bgen=bb1                                                                        
+      end if 
+
+* set flow parameters 
+      Tf=0.14                             ! freeze-out temperature     
+      if (ylfl.lt.0.01.or.ylfl.gt.7.) ylfl=5.
+      etmax=ylfl                          ! longitudinal flow rapidity 
+      if (ytfl.lt.0.01.or.ytfl.gt.3.) ytfl=1.
+      ytmax=ytfl                          ! transverse flow rapidity
+
+* set inelastic NN cross section, mb 
+      sigin=58.  
+            
+* calculate number of nucelons-participants 
+      bb=bgen*RA                              ! impact parameter 
+      npart=numpar(bb)                        ! Npart(b) 
+      npar0=411                               ! Npart(Pb,b=0) 
+
+* calculate number of binary NN sub-collisions 
+      br=max(1.e-10,0.25*bgen*bgen)
+      factor=9.*sigin*AW*AW/(80.*pi*RA*RA)      
+      nbcol=int(factor*hftaa(br))              ! Nsub(b)
+      nbco0=1923                               ! Nsub(Pb,b=0) 
+  
+* generate total multiplicity in event, np,  
+* fpart - fraction of soft multiplicity proportional to # of participants, 
+* fbcol=1-fpart - fraction of multiplicity proprtional to # of NN subcollisions 
+      if(fpart.le.0.or.fpart.gt.1.) fpart=1. 
+      fbcol=1.-fpart 
+      rnp=nh*(fpart*npart+fbcol*nbcol)/(fpart*npar0+fbcol*nbco0)
+      np=int(rnp) 
+      sign=sqrt(rnp)
+ 1    if(nhsel.lt.4.and.np.gt.0) np=max(0,int(hgauss(rnp,sign))) 
+      if(np.gt.150000) then 
+       write(6,*) 'Warning, soft multiplicity too large!'   
+       goto 1 
+      end if 
+      
+* generate hard parton-parton scattering (Q>ptmin) 'njet' times with PYTHIA       
+      if(nhsel.ne.1.and.nhsel.ne.2.and.nhsel.ne.3.and.nhsel.ne.4) 
+     > nhsel=0 
+      njet=0 
+      if(nhsel.ne.0) then 
+       if(ptmin.lt.5.or.ptmin.gt.500.) ptmin=10. 
+       q=ptmin 
+       njet=numjet(q) 
+       call hyhard 
+      end if 
+
+      npyt=n 
+      nhyd=np 
+c      if(nhsel.lt.3) then 
+c       nhyd=max(0,np-npyt)
+c      else 
+c       nhyd=0 
+c       np=n
+c      end if 
+      if(nhyd.eq.0) goto 4 
+
+* generate sort of hadrons (pions, kaons, nucleons) in jetset7* format 
+      do ip=npyt+1,npyt+np                       !cycle on particles 
+       yy=49.*rlu(0)  
+       if(yy.lt.11.83333333) then
+        kf=211
+       elseif(yy.lt.23.66666667) then
+        kf=-211
+       elseif(yy.lt.35.5) then
+        kf=111
+       elseif(yy.lt.38.375) then
+        kf=321
+       elseif(yy.lt.41.25) then
+        kf=-321 
+       elseif(yy.lt.44.125) then
+        kf=310
+       elseif(yy.lt.47.) then
+        kf=130  
+       elseif(yy.lt.47.5) then
+        kf=2212  
+       elseif(yy.lt.48.) then
+        kf=-2212
+       elseif(yy.lt.48.5) then
+        kf=2112 
+       else  
+        kf=-2112
+       end if
+       n=n+1
+       k(n,1)=1
+       k(n,2)=kf
+       do j=3,5
+        k(n,j)=0
+       end do
+
+       do j=1,5
+        v(n,j)=0.
+       enddo
+        kfa=iabs(kf)
+        p(n,5)=ulmass(kfa) 
+
+* generate uniform distribution in system of a fluid element
+ 2     ep0=-1.*Tf*(log(max(1.e-10,rlu(0)))+log(max(1.e-10,rlu(0)))
+     >   +log(max(1.e-10,rlu(0)))) 
+       if(ep0.le.p(n,5)) go to 2 
+       pp0=sqrt(abs(ep0**2-abs(p(n,5)**2))) 
+       probt=pp0/ep0 
+       if(rlu(0).gt.probt) go to 2 
+       ctp0=2.*rlu(0)-1. 
+       stp0=sqrt(abs(1.-ctp0**2)) 
+       php0=2.*pi*rlu(0) 
+
+* generate coordinates of a fluid element
+c       etaf=etmax*(2.*rlu(0)-1.)         ! flat initial eta-spectrum
+       etaf=hgauss(0.,etmax)              ! gaussian initial eta-spectrum
+       phif=2.*pi*rlu(0) 
+       rm1=sqrt(abs(RA*RA-b1*b1/4.*(sin(phif)**2)))+b1*cos(phif)/2. 
+       rm2=sqrt(abs(RA*RA-b1*b1/4.*(sin(phif)**2)))-b1*cos(phif)/2. 
+       RF=min(rm1,rm2) 
+       rrf=RF*RF*rlu(0) 
+
+* generate four-velocity of a fluid element
+       vradf=sinh(ytmax)
+       sb=RA*RA*(pi-2.*asin(b1/RA/2.))-b1*sqrt(abs(RA*RA-b1*b1/4.)) 
+       reff=sqrt(sqrt(sb/pi)*RA) 
+       urf=vradf*sqrt(abs(rrf))/reff          ! linear transverse profile
+c       urf=vradf*rrf/reff**2                  !square transverse profile 
+       utf=cosh(etaf)*sqrt(abs(1.+urf*urf)) 
+       uzf=sinh(etaf)*sqrt(abs(1.+urf*urf)) 
+
+* boost in the laboratory system
+       uipi=pp0*(urf*stp0*cos(phif-php0)+uzf*ctp0) 
+       bfac=uipi/(utf+1.)+ep0 
+       p(n,1)=pp0*stp0*sin(php0)+urf*sin(phif)*bfac 
+       p(n,2)=pp0*stp0*cos(php0)+urf*cos(phif)*bfac                    
+       p(n,3)=pp0*ctp0+uzf*bfac
+       p(n,4)=sqrt(p(n,1)**2+p(n,2)**2+p(n,3)**2+p(n,5)**2) 
+            
+      end do 
+ 4    continue
+
+*      write(*,*) 'NHYD, NPYT, NTOT',nhyd,npyt,nhyd+npyt
+
+* fill array 'hyd' 
+      nnhyd = nhyd+npyt 
+      
+      do ih=1,n
+       do jh=1,5
+        phyd(ih,jh)=p(ih,jh)
+        khyd(ih,jh)=k(ih,jh)                  
+        vhyd(ih,jh)=v(ih,jh) 
+       end do
+      end do
+
+      return
+      end
+
+********************************* HYHARD ***************************
+      SUBROUTINE HYHARD 
+*     generate 'njet' number of hard parton-parton scatterings with PYTHIA 
+      IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+      IMPLICIT INTEGER(I-N)
+      REAL ptmin,pj,vj,pl,vl,bminh,bmaxh,AW,RA,sigin,bgen 
+      INTEGER PYK,PYCHGE,PYCOMP
+      external pydata 
+      external pyp,pyr,pyk,pyquen  
+      common /pyjets/ n,npad,k(4000,5),p(4000,5),v(4000,5)
+      common /lujets/ nj,kj(150000,5),pj(150000,5),vj(150000,5) 
+      common /hyjets/ nl,kl(150000,5),pl(150000,5),vl(150000,5)            
+      COMMON /PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+      COMMON /PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+      COMMON /PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
+      COMMON /PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
+      common /pypars/ mstp(200),parp(200),msti(200),pari(200)
+      common /hyjpar/ nhsel,ptmin,njet      
+      common /hyipar/ bminh,bmaxh,AW,RA,sigin,np 
+      common /hyfpar/ bgen,nbcol,npart,npyt,nhyd 
+      save /pyjets/,/lujets/,/hyjets/,/pydat1/,/pydat2/,/pydat3/,
+     +    /pysubs/,/hyjpar/,/hyipar/,/hyfpar/ 
+      
+* reset array of partons in 'hyjets'
+      nl=0 
+      do i=1,150000
+       do j=1,5
+        pl(i,j)=0.
+       end do
+       do j=1,5
+        vl(i,j)=0.
+       end do
+       do j=1,5
+        kl(i,j)=0
+       end do
+      end do 
+
+* generate 'njet' PYTHIA events and fill arrays for partons and hadrons 
+      if(njet.ge.1) then 
+       mdcy(pycomp(111),1)=0               ! no pi0 decay 
+       mdcy(pycomp(310),1)=0               ! no K_S0 decay 
+       do ihard=1,njet       
+        mstp(111)=0 
+c        mstj(41)=0                         ! vacuum showering off 
+        call pyevnt                        ! generate hard scattering
+
+* generate quenched jets with PYQUEN if nhcel=2 
+        if(nhsel.eq.2.or.nhsel.eq.4) then 
+        ifbp=0 
+        Ap=dble(AW)
+        bfixp=dble(RA*bgen) 
+        call pyquen(Ap,ifbp,bfixp) 
+       end if 
+
+* fill array of partons
+         nl=nl+n  
+        if(nl.gt.150000-np) goto 51 
+         do i=nl-n+1,nl  
+         ip=i+n-nl                             
+         do j=1,5
+           pl(i,j)=p(ip,j) 
+          end do
+         do j=1,5
+           vl(i,j)=v(ip,j) 
+          end do
+          do j=1,5
+           kl(i,j)=k(ip,j)
+          end do
+         do j=3,5
+          kk=kl(i,j) 
+           if(kk.gt.0) kl(i,j)=kk+nl-n 
+          end do
+         end do 
+ 51     continue  
+          
+        call pyexec                         ! hadronization done 
+c         call pyedit(2)                      ! remove partons & leave hadrons 
+
+* fill array of final particles
+         nu=nj+n 
+        if(nu.gt.150000-np) then 
+         write(6,*) 'Warning, multiplicity too large! Cut hard part.'   
+         goto 52
+        end if 
+        nj=nu  
+         do i=nj-n+1,nj
+         ip=i+n-nj                            
+         do j=1,5
+           pj(i,j)=p(ip,j) 
+          end do
+         do j=1,5
+           vj(i,j)=v(ip,j) 
+          end do
+          do j=1,5
+           kj(i,j)=k(ip,j)
+          end do
+         do j=3,5
+          kk=kj(i,j) 
+           if(kk.gt.0) then 
+          kj(i,j)=kk+nj-n 
+          end if
+         end do
+         end do               
+      
+       end do 
+ 52    njet=ihard-1 
+      end if  
+    
+      return 
+      end 
+****************************** END HYHARD **************************      
+      
+********************************* HIPSEAR ***************************
+      SUBROUTINE HIPSEAR (fmax,xmin) 
+* find maximum and 'sufficient minimum' of differential inelasic AA cross 
+* section as a function of impact paramater (xm, fm are outputs) 
+      real hsin  
+      external hsin  
+      common /hyipar/ bminh,bmaxh,AW,RA,sigin,np  
+      save /hyipar/ 
+     
+      xmin=bmaxh-bminh 
+      fmax=0.
+      do j=1,1000
+      x=bminh+xmin*(j-1)/999.
+      f=hsin(x) 
+       if(f.gt.fmax) then
+        fmax=f
+       endif
+      end do   
+      
+      return
+      end
+****************************** END HIPSEAR **************************
+
+************************* HARINV **********************************
+      SUBROUTINE HARINV(X,A,F,N,R)                                      
+* gives interpolation of function F(X) with  arrays A(N) and F(N) 
+      DIMENSION A(N),F(N)                                              
+      IF(X.LT.A(1))GO TO 11                                            
+      IF(X.GT.A(N))GO TO 4                                              
+      K1=1                                                              
+      K2=N                                                              
+ 2    K3=K2-K1                                                          
+      IF(K3.LE.1)GO TO 6                                               
+      K3=K1+K3/2                                                        
+      IF(A(K3)-X) 7,8,9                                                 
+ 7    K1=K3                                                             
+      GOTO2                                                            
+ 9    K2=K3                                                            
+      GOTO2                                                             
+ 8    P=F(K3)                                                          
+      RETURN                                                          
+ 3    B1=A(K1)                                                          
+      B2=A(K1+1)                                                      
+      B3=A(K1+2)                                                        
+      B4=F(K1)                                                        
+      B5=F(K1+1)                                                        
+      B6=F(K1+2)                                                       
+      R=B4*((X-B2)*(X-B3))/((B1-B2)*(B1-B3))+B5*((X-B1)*(X-B3))/       
+     1 ((B2-B1)*(B2-B3))+B6*((X-B1)*(X-B2))/((B3-B1)*(B3-B2))           
+      RETURN                                                          
+ 6    IF(K2.NE.N)GO TO 3                                               
+      K1=N-2                                                            
+      GOTO3                                                            
+ 4    C=ABS(X-A(N))                                                     
+      IF(C.LT.0.1) GO TO 5                                           
+      K1=N-2                                                           
+ 13   CONTINUE                                                          
+C13   PRINT 41,X                                                        
+C41   FORMAT(25H X IS OUT OF THE INTERVAL,3H X=,F15.9)                  
+      GO TO 3                                                           
+ 5    R=F(N)                                                           
+      RETURN                                                            
+ 11   C=ABS(X-A(1))                                                     
+      IF(C.LT.0.1) GO TO 12                                         
+      K1=1                                                             
+      GOTO 13                                                           
+ 12   R=F(1)                                                            
+      RETURN                                                            
+      END                                                              
+C************************** END HARINV *************************************
+
+**************************** HSIMPA **********************************
+      SUBROUTINE HSIMPA (A1,B1,H1,REPS1,AEPS1,FUNCT,X,                   
+     1                     AI,AIH,AIABS)                                
+* calculate intergal of function FUNCT(X) on the interval from A1 to B1 
+      IMPLICIT REAL * 4 ( A-H,O-Z )
+      IMPLICIT INTEGER(I-N)
+      DIMENSION F(7), P(5)                                             
+      H=SIGN ( H1, B1-A1 )                                             
+      S=SIGN (1., H )                                                   
+      A=A1                                                              
+      B=B1                                                              
+      AI=0.0                                                           
+      AIH=0.0                                                           
+      AIABS=0.0                                                        
+      P(2)=4.                                                           
+      P(4)=4.                                                           
+      P(3)=2.                                                           
+      P(5)=1.                                                           
+      IF(B-A)1,2,1                                                      
+ 1    REPS=ABS(REPS1)                                                   
+      AEPS=ABS(AEPS1)                                                  
+      DO 3 K=1,7                                                        
+ 3    F(K)=10.E16                                                       
+      X=A                                                              
+      C=0.                                                              
+      F(1)=FUNCT(X)/3.                                                  
+ 4    X0=X                                                              
+      IF( (X0+4.*H-B)*S)5,5,6                                           
+ 6    H=(B-X0)/4.                                                       
+      IF ( H ) 7,2,7                                                   
+ 7    DO 8 K=2,7                                                      
+ 8    F(K)=10.E16                                                       
+      C=1.                                                           
+ 5    DI2=F (1)                                                       
+      DI3=ABS( F(1) )                                                   
+      DO 9 K=2,5                                                       
+      X=X+H                                                           
+      IF((X-B)*S)23,24,24                                              
+ 24   X=B                                                              
+ 23   IF(F(K)-10.E16)10,11,10                                          
+ 11   F(K)=FUNCT(X)/3.                                               
+ 10   DI2=DI2+P(K)*F(K)                                                 
+ 9    DI3=DI3+P(K)*ABS(F(K))                                            
+      DI1=(F(1)+4.*F(3)+F(5))*2.*H                                      
+      DI2=DI2*H                                                         
+      DI3=DI3*H                                                        
+      IF (REPS) 12,13,12                                               
+ 13   IF (AEPS) 12,14,12                                                
+ 12   EPS=ABS((AIABS+DI3)*REPS)                                         
+      IF(EPS-AEPS)15,16,16                                              
+ 15   EPS=AEPS                                                          
+ 16   DELTA=ABS(DI2-DI1)                                               
+      IF(DELTA-EPS)20,21,21                                             
+ 20   IF(DELTA-EPS/8.)17,14,14                                          
+ 17   H=2.*H                                                            
+      F(1)=F(5)                                                         
+      F(2)=F(6)                                                         
+      F(3)=F(7)                                                         
+      DO 19 K=4,7                                                       
+ 19   F(K)=10.E16                                                      
+      GO TO 18                                                         
+ 14   F(1)=F(5)                                                         
+      F(3)=F(6)                                                         
+      F(5)=F(7)                                                         
+      F(2)=10.E16                                                       
+      F(4)=10.E16                                                      
+      F(6)=10.E16                                                      
+      F(7)=10.E16                                                      
+ 18   DI1=DI2+(DI2-DI1)/15.                                            
+      AI=AI+DI1                                                         
+      AIH=AIH+DI2                                                      
+      AIABS=AIABS+DI3                                                   
+      GO TO 22                                                          
+ 21   H=H/2.                                                            
+      F(7)=F(5)                                                        
+      F(6)=F(4)                                                        
+      F(5)=F(3)                                                        
+      F(3)=F(2)                                                         
+      F(2)=10.E16                                                      
+      F(4)=10.E16                                                      
+      X=X0                                                            
+      C=0.                                                             
+      GO TO 5                                                          
+ 22   IF(C)2,4,2                                                      
+ 2    RETURN                                                        
+      END                                                              
+************************* END HSIMPA *******************************
+
+**************************** HSIMPB **********************************
+      SUBROUTINE HSIMPB (A1,B1,H1,REPS1,AEPS1,FUNCT,X,                   
+     1                     AI,AIH,AIABS)                                
+* calculate intergal of function FUNCT(X) on the interval from A1 to B1 
+      IMPLICIT REAL * 4 ( A-H,O-Z )
+      IMPLICIT INTEGER(I-N)
+      DIMENSION F(7), P(5)                                             
+      H=SIGN ( H1, B1-A1 )                                             
+      S=SIGN (1., H )                                                   
+      A=A1                                                              
+      B=B1                                                              
+      AI=0.0                                                           
+      AIH=0.0                                                           
+      AIABS=0.0                                                        
+      P(2)=4.                                                           
+      P(4)=4.                                                           
+      P(3)=2.                                                           
+      P(5)=1.                                                           
+      IF(B-A)1,2,1                                                      
+ 1    REPS=ABS(REPS1)                                                   
+      AEPS=ABS(AEPS1)                                                  
+      DO 3 K=1,7                                                        
+ 3    F(K)=10.E16                                                       
+      X=A                                                              
+      C=0.                                                              
+      F(1)=FUNCT(X)/3.                                                  
+ 4    X0=X                                                              
+      IF( (X0+4.*H-B)*S)5,5,6                                           
+ 6    H=(B-X0)/4.                                                       
+      IF ( H ) 7,2,7                                                   
+ 7    DO 8 K=2,7                                                      
+ 8    F(K)=10.E16                                                       
+      C=1.                                                           
+ 5    DI2=F (1)                                                       
+      DI3=ABS( F(1) )                                                   
+      DO 9 K=2,5                                                       
+      X=X+H                                                           
+      IF((X-B)*S)23,24,24                                              
+ 24   X=B                                                              
+ 23   IF(F(K)-10.E16)10,11,10                                          
+ 11   F(K)=FUNCT(X)/3.                                               
+ 10   DI2=DI2+P(K)*F(K)                                                 
+ 9    DI3=DI3+P(K)*ABS(F(K))                                            
+      DI1=(F(1)+4.*F(3)+F(5))*2.*H                                      
+      DI2=DI2*H                                                         
+      DI3=DI3*H                                                        
+      IF (REPS) 12,13,12                                               
+ 13   IF (AEPS) 12,14,12                                                
+ 12   EPS=ABS((AIABS+DI3)*REPS)                                         
+      IF(EPS-AEPS)15,16,16                                              
+ 15   EPS=AEPS                                                          
+ 16   DELTA=ABS(DI2-DI1)                                               
+      IF(DELTA-EPS)20,21,21                                             
+ 20   IF(DELTA-EPS/8.)17,14,14                                          
+ 17   H=2.*H                                                            
+      F(1)=F(5)                                                         
+      F(2)=F(6)                                                         
+      F(3)=F(7)                                                         
+      DO 19 K=4,7                                                       
+ 19   F(K)=10.E16                                                      
+      GO TO 18                                                         
+ 14   F(1)=F(5)                                                         
+      F(3)=F(6)                                                         
+      F(5)=F(7)                                                         
+      F(2)=10.E16                                                       
+      F(4)=10.E16                                                      
+      F(6)=10.E16                                                      
+      F(7)=10.E16                                                      
+ 18   DI1=DI2+(DI2-DI1)/15.                                            
+      AI=AI+DI1                                                         
+      AIH=AIH+DI2                                                      
+      AIABS=AIABS+DI3                                                   
+      GO TO 22                                                          
+ 21   H=H/2.                                                            
+      F(7)=F(5)                                                        
+      F(6)=F(4)                                                        
+      F(5)=F(3)                                                        
+      F(3)=F(2)                                                         
+      F(2)=10.E16                                                      
+      F(4)=10.E16                                                      
+      X=X0                                                            
+      C=0.                                                             
+      GO TO 5                                                          
+ 22   IF(C)2,4,2                                                      
+ 2    RETURN                                                        
+      END                                                              
+************************* END HSIMPB *******************************
+
+* function to calculate differential inelastic AA cross section 
+      real function hsin(x) 
+      external hftaa 
+      real hftaa 
+      common /hyipar/ bminh,bmaxh,AW,RA,sigin,np  
+      save /hyipar/ 
+      sigp=sigin 
+      taapb0=33.16 
+      br=max(1.e-10,0.25*x*x) 
+      hsin=x*(1.-exp(-1.*hftaa(br)*sigp*taapb0)) 
+      return 
+      end 
+
+* set of functions to calculate number of nucleons-participants at im.par.b 
+      integer function numpar(c) 
+      IMPLICIT REAL * 4 (A-H,O-Z)   
+      real HFUNC1
+      external HFUNC1 
+      common /hynup1/ bp,x    
+      EPS=0.01  
+      A=0. 
+      B=6.28318 
+      H=0.01*(B-A)    
+      bp=c    
+      CALL HSIMPA(A,B,H,EPS,1.E-8,HFUNC1,X,RES,AIH,AIABS)
+      numpar=int(2.*RES) 
+      return 
+      end   
+*
+      real function HFUNC1(x) 
+      IMPLICIT REAL * 4 (A-H,O-Z) 
+      real HFUNC2 
+      external HFUNC2 
+      common /hyipar/ bminh,bmaxh,AW,RA,sigin,np
+      common /hynup1/ bp,xx
+      save /hyipar/  
+      xx=x 
+      b2=0.5*bp 
+      r1=abs(sqrt(abs(RA*RA-(b2*sin(xx))**2))+b2*cos(xx))
+      r2=abs(sqrt(abs(RA*RA-(b2*sin(xx))**2))-b2*cos(xx))
+      EPS=0.01 
+      A=0. 
+      B=min(r1,r2)
+      H=0.01*(B-A)    
+      CALL HSIMPB(A,B,H,EPS,1.E-8,HFUNC2,Y,RES,AIH,AIABS)
+      HFUNC1=RES 
+      return 
+      end   
+*      
+      real function HFUNC2(y) 
+      IMPLICIT REAL * 4 (A-H,O-Z) 
+      real hythik 
+      external hythik 
+      common /hyipar/ bminh,bmaxh,AW,RA,sigin,np 
+      common /hynup1/ bp,x 
+      save /hyipar/ 
+      r1=sqrt(abs(y*y+bp*bp/4.+y*bp*cos(x))) 
+      r2=sqrt(abs(y*y+bp*bp/4.-y*bp*cos(x)))
+      s=1.-exp(-0.1*sigin*hythik(r2))
+      HFUNC2=y*hythik(r2)*s 
+      return 
+      end   
+* to calculate nuclear thikness function 
+       real function hythik(r)   
+       IMPLICIT REAL * 4 (A-H,O-Z) 
+       common /hyipar/ bminh,bmaxh,AW,RA,sigin,np
+       save /hyipar/ 
+       hythik=0.477465*AW*sqrt(abs(RA*RA-r*r))/(RA**3)
+       return
+       end
+
+* to calculate nuclear overlap function  
+      real function hftaa(br)  
+      common /hyipar/ bminh,bmaxh,AW,RA,sigin,np  
+      save /hyipar/  
+      sbr=sqrt(abs(1.-br)) 
+      taa=1.-br*(1.+(1.-0.25*br)*log(1./br)+2.*(1.-0.25*br)*
+     + (log(1.+sbr)-sbr/(1.+sbr))-0.5*br*(1.-br)/((1.+sbr)**2))    
+      hftaa=taa*((AW/207)**1.33333333) 
+      return 
+      end   
+
+* function to calculate number of hard parton-parton scatterings with 
+* Q>x at sqrt{s}=5.5 TeV   
+      integer function numjet(x)      
+      common /hyipar/ bminh,bmaxh,AW,RA,sigin,np
+      common /hyfpar/ bgen,nbcol,npart,npyt,nhyd 
+      save /hyipar/,/hyfpar/ 
+      dimension ptj(30),sgj(30) 
+      data ptj/5.,6.,7.,8.,9.,10.,12.,14.,16.,18.,20.,23.,26.,
+     + 30.,35.,40.,50.,60.,70.,80.,90.,100.,120.,150.,200.,
+     + 250.,300.,400.,450.,500./  
+      data sgj/31.,16.8,9.5,6.1,4.1,2.7,1.4,0.8,0.46,0.3,0.2,
+     + 0.11,6.8e-2,3.9e-2,2.06e-2,1.16e-2,4.46e-3,2.e-3,1.e-3,
+     + 5.3e-4,3.1e-4,1.9e-4,7.7e-5,2.6e-5,5.9e-6,1.6e-6,5.9e-7,
+     + 1.e-7,4.8e-8,2.3e-8/
+      pt=x 
+      i=0 
+ 31   i=i+1        
+      if(i.le.30) then 
+       dx=abs(ptj(i)-pt)  
+       if(dx.le.0.1) then 
+        sjet=sgj(i) 
+       goto 32 
+       else
+        goto 31 
+       end if 
+      else 
+       call harinv(pt,ptj,sgj,30,sjet) 
+      end if 
+ 32   pjet=sjet/sigin  
+      ijet=0 
+      do i=1,nbcol 
+       if(rlu(0).lt.pjet) ijet=ijet+1 
+      end do 
+      numjet=ijet        
+      return 
+      end   
+
+* function to generate gauss distribution 
+      real function hgauss(x0,sig)
+ 41   u1=rlu(0)
+      u2=rlu(0)
+      v1=2.*u1-1.
+      v2=2.*u2-1.
+      s=v1**2+v2**2
+      if(s.gt.1) go to 41
+      hgauss=v1*sqrt(-2.*log(s)/s)*sig+x0
+      return
+      end
+
+
+**************************************************************************        
diff --git a/THydjet/hydjet1_1/hydjet1_1.update b/THydjet/hydjet1_1/hydjet1_1.update
new file mode 100644 (file)
index 0000000..c794c92
--- /dev/null
@@ -0,0 +1,19 @@
+                  ****************************
+                  *                          *
+                  *       Update notes       *
+                  *                          *
+                  *    HYDJET version 1.1    *
+                  *                          *
+                  ****************************
+                  (Last updated 26 April 2006)
+HYDJET version 1.1 is a direct continuation of version 1.0. 
+
+1. Main difference from previous version is that HYDJET1.1 uses PYQUEN1.1 
+   instead of PYQUEN1.0 (see pyquen1_1.update) and PYTHIA6.401 (or later 
+   PYTHIA versions). 
+
+2. Parameter mstp(111)=0 is used in HYHARD routine to switch off 
+   hadronization before calling pyquen instead of mstj(1)=0   
+-----------------------------------------------------------------------
\ No newline at end of file
diff --git a/THydjet/hydjet1_1/jetset_73.f b/THydjet/hydjet1_1/jetset_73.f
new file mode 100644 (file)
index 0000000..7d228a1
--- /dev/null
@@ -0,0 +1,10432 @@
+C*********************************************************************
+CCPH   This file has enlarged event record, LUJETS size=30000
+C*********************************************************************
+C*********************************************************************
+C*********************************************************************
+C*                                                                  **
+C*                                                     June 1991    **
+C*                                                                  **
+C*   The Lund Monte Carlo for Jet Fragmentation and e+e- Physics    **
+C*                                                                  **
+C*                        JETSET version 7.3                        **
+C*                                                                  **
+C*                        Torbjorn Sjostrand                        **
+C*                                                                  **
+C*                    CERN/TH, CH-1211 Geneva 23                    **
+C*                BITNET/EARN address TORSJO@CERNVM                 **
+C*                       Tel. +22 - 767 28 20                       **
+C*                                                                  **
+C*          LUSHOW is written together with Mats Bengtsson          **
+C*                                                                  **
+C*           A complete manual exists on a separate file            **
+C*         Please report any program errors to the author!          **
+C*                                                                  **
+C*                   Copyright Torbjorn Sjostrand                   **
+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   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(150000,5),P(150000,5),V(150000,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.
+  100 V(IPA,J)=0.
+
+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
+
+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(150000,5),P(150000,5),V(150000,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 100 I=IPA,IPA+1
+      DO 100 J=1,5
+      K(I,J)=0
+      P(I,J)=0.
+  100 V(I,J)=0.
+
+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
+
+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(150000,5),P(150000,5),V(150000,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 100 I=IPA,IPA+2
+      DO 100 J=1,5
+      K(I,J)=0
+      P(I,J)=0.
+  100 V(I,J)=0.
+
+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
+
+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(150000,5),P(150000,5),V(150000,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 100 I=IPA,IPA+3
+      DO 100 J=1,5
+      K(I,J)=0
+      P(I,J)=0.
+  100 V(I,J)=0.
+
+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
+
+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(150000,5),P(150000,5),V(150000,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
+  100 IF(IJN.EQ.1) KQS=KQ
+      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
+  110 IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0
+
+C...Error exit: no action taken.
+      RETURN
+  120 CALL LUERRM(12,
+     &'(LUJOIN:) given entries can not be joined by one string')
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      SUBROUTINE LUGIVE(CHIN)
+
+C...Purpose: to set values of commonblock variables (also in PYTHIA!).
+      COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,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)
+      CHARACTER PROC*28
+      SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/
+      SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,
+     &/PYINT5/,/PYINT6/
+      CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28,
+     &CHNEW2*28,CHNAM*4,CHVAR(42)*4,CHALP(2)*26,CHIND*8,CHINI*10,
+     &CHINR*16
+      DIMENSION MSVAR(42,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'/
+      DATA ((MSVAR(I,J),J=1,8),I=1,42)/ 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/
+      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 150 LCOM=1,LNAM-1
+      DO 150 LALP=1,26
+  150 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)=
+     &CHALP(2)(LALP:LALP)
+      IVAR=0
+      DO 160 IV=1,42
+  160 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV
+      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
+  170   LIND=LIND+1
+        IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 170
+        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
+  180   LIND=LIND+1
+        IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180
+        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
+  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)') 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)
+      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
+      ENDIF
+
+C...Write old and new value. Loop back.
+      CHBIT(LNAM:14)=' '
+      CHBIT(15:60)=' changed from                to               '
+      IF(MSVAR(IVAR,1).EQ.1) THEN
+        WRITE(CHBIT(33:42),'(I10)') IOLD
+        WRITE(CHBIT(51:60),'(I10)') INEW
+        IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
+      ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
+        WRITE(CHBIT(29:42),'(F14.5)') ROLD
+        WRITE(CHBIT(47:60),'(F14.5)') RNEW
+        IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
+      ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
+        CHBIT(35:42)=CHOLD
+        CHBIT(53:60)=CHNEW
+        IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
+      ELSE
+        CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2
+        IF(MSTU(13).GE.1) WRITE(MSTU(11),5100) CHBIT(1:88)
+      ENDIF
+      LLOW=LHIG
+      IF(LLOW.LT.LTOT) GOTO 120
+
+C...Format statement for output on unit MSTU(11) (by default 6).
+ 5000 FORMAT(5X,A60)
+ 5100 FORMAT(5X,A88)
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      SUBROUTINE LUEXEC
+
+C...Purpose: to administrate the fragmentation and decay chain.
+      COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,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 100 I=1,2
+      DO 100 J=1,6
+  100 PS(I,J)=0.
+      DO 120 I=1,N
+      IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120
+      DO 110 J=1,4
+  110 PS(1,J)=PS(1,J)+P(I,J)
+      PS(1,6)=PS(1,6)+LUCHGE(K(I,2))
+  120 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
+  130 MBE=MBE+1
+      IP=0
+  140 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 140
+      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 130
+      ENDIF
+
+C...Check that momentum, energy and charge were conserved.
+      DO 160 I=1,N
+      IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 160
+      DO 150 J=1,4
+  150 PS(2,J)=PS(2,J)+P(I,J)
+      PS(2,6)=PS(2,6)+LUCHGE(K(I,2))
+  160 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
+
+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(150000,5),P(150000,5),V(150000,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)
+  110   V(I1,J)=V(IA,J)
+        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
+  150   DPS(J)=P(I,J)
+        MSTJ(93)=1
+        DPS(5)=ULMASS(K(I,2))
+      ELSEIF(K(I,1).EQ.2) THEN
+        DO 160 J=1,4
+  160   DPS(J)=DPS(J)+P(I,J)
+      ELSEIF(IC.NE.0.AND.KCHG(LUCOMP(K(I,2)),2).NE.0) THEN
+        DO 170 J=1,4
+  170   DPS(J)=DPS(J)+P(I,J)
+        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
+  180     DPC(J)=DPS(J)
+          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)
+  220   P(N+3,J)=-PA*UE(J)
+        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
+  230   IF(K(I,1).EQ.1.OR.K(I,1).EQ.2) NP=NP+1
+        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)
+  240   P(N+3,J)=(1.+HK2)*P(IC2,J)-HK1*P(IC1,J)
+      ENDIF
+      DO 250 J=1,4
+      V(N+1,J)=V(IC1,J)
+      V(N+2,J)=V(IC1,J)
+  250 V(N+3,J)=V(IC2,J)
+      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)
+  290   V(N+2,J)=V(IC1,J)
+        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
+  330 DPS(J)=0.
+      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
+  340 DPS(J)=DPS(J)+P(I,J)
+      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
+  350   DPS(J)=0.
+      ENDIF
+  360 CONTINUE
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      SUBROUTINE LUSTRF(IP)
+C...Purpose: to handle the fragmentation of an arbitrary colour singlet
+C...jet system according to the Lund string fragmentation model.
+      IMPLICIT DOUBLE PRECISION(D)
+      COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,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),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2),
+     &IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(3),PJU(5,5),
+     &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8)
+
+C...Function: four-product of two vectors.
+      FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3)
+      DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)-
+     &DP(I,3)*DP(J,3)
+
+C...Reset counters. Identify parton system.
+      MSTJ(91)=0
+      NSAV=N
+      MSTU90=MSTU(90)
+      NP=0
+      KQSUM=0
+      DO 100 J=1,5
+  100 DPS(J)=0D0
+      MJU(1)=0
+      MJU(2)=0
+      I=IP-1
+  110 I=I+1
+      IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN
+        CALL LUERRM(12,'(LUSTRF:) failed to reconstruct jet system')
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+      IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110
+      KC=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
+      IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN
+        CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS')
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+
+C...Take copy of partons to be considered. Check flavour sum.
+      NP=NP+1
+      DO 120 J=1,5
+      K(N+NP,J)=K(I,J)
+      P(N+NP,J)=P(I,J)
+  120 IF(J.NE.4) DPS(J)=DPS(J)+P(I,J)
+      DPS(4)=DPS(4)+SQRT(DBLE(P(I,1))**2+DBLE(P(I,2))**2+
+     &DBLE(P(I,3))**2+DBLE(P(I,5))**2)
+      K(N+NP,3)=I
+      IF(KQ.NE.2) KQSUM=KQSUM+KQ
+      IF(K(I,1).EQ.41) THEN
+        KQSUM=KQSUM+2*KQ
+        IF(KQSUM.EQ.KQ) MJU(1)=N+NP
+        IF(KQSUM.NE.KQ) MJU(2)=N+NP
+      ENDIF
+      IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110
+      IF(KQSUM.NE.0) THEN
+        CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination')
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+
+C...Boost copied system to CM frame (for better numerical precision).
+      IF(ABS(DPS(3)).LT.0.99D0*DPS(4)) THEN
+        MBST=0
+        MSTU(33)=1
+        CALL LUDBRB(N+1,N+NP,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4),
+     &  -DPS(3)/DPS(4))
+      ELSE
+        MBST=1
+        HHBZ=SQRT(MAX(1D-6,DPS(4)+DPS(3))/MAX(1D-6,DPS(4)-DPS(3)))
+        DO 130 I=N+1,N+NP
+        HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2
+        IF(P(I,3).GT.0.) THEN
+          HHPEZ=(P(I,4)+P(I,3))/HHBZ
+          P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ)
+          P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ)
+        ELSE
+          HHPEZ=(P(I,4)-P(I,3))*HHBZ
+          P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ)
+          P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ)
+        ENDIF
+  130   CONTINUE
+      ENDIF
+
+C...Search for very nearby partons that may be recombined.
+      NTRYR=0
+      PARU12=PARU(12)
+      PARU13=PARU(13)
+      MJU(3)=MJU(1)
+      MJU(4)=MJU(2)
+      NR=NP
+  140 IF(NR.GE.3) THEN
+        PDRMIN=2.*PARU12
+        DO 150 I=N+1,N+NR
+        IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 150
+        I1=I+1
+        IF(I.EQ.N+NR) I1=N+1
+        IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 150
+        IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21)
+     &  GOTO 150
+        IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21) GOTO 150
+        PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+
+     &  P(I1,2)**2+P(I1,3)**2))
+        PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3)
+        PDR=4.*(PAP-PVP)**2/MAX(1E-6,PARU13**2*PAP+2.*(PAP-PVP))
+        IF(PDR.LT.PDRMIN) THEN
+          IR=I
+          PDRMIN=PDR
+        ENDIF
+  150   CONTINUE
+
+C...Recombine very nearby partons to avoid machine precision problems.
+        IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN
+          DO 160 J=1,4
+  160     P(N+1,J)=P(N+1,J)+P(N+NR,J)
+          P(N+1,5)=SQRT(MAX(0.,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2-
+     &    P(N+1,3)**2))
+          NR=NR-1
+          GOTO 140
+        ELSEIF(PDRMIN.LT.PARU12) THEN
+          DO 170 J=1,4
+  170     P(IR,J)=P(IR,J)+P(IR+1,J)
+          P(IR,5)=SQRT(MAX(0.,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2-
+     &    P(IR,3)**2))
+          DO 180 I=IR+1,N+NR-1
+          K(I,2)=K(I+1,2)
+          DO 180 J=1,5
+  180     P(I,J)=P(I+1,J)
+          IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2)
+          NR=NR-1
+          IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1
+          IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1
+          GOTO 140
+        ENDIF
+      ENDIF
+      NTRYR=NTRYR+1
+
+C...Reset particle counter. Skip ahead if no junctions are present;
+C...this is usually the case!
+      NRS=MAX(5*NR+11,NP)
+      NTRY=0
+  190 NTRY=NTRY+1
+      IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
+        PARU12=4.*PARU12
+        PARU13=2.*PARU13
+        GOTO 140
+      ELSEIF(NTRY.GT.100) THEN
+        CALL LUERRM(14,'(LUSTRF:) caught in infinite loop')
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+      I=N+NRS
+      MSTU(90)=MSTU90
+      IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 510
+      DO 500 JT=1,2
+      NJS(JT)=0
+      IF(MJU(JT).EQ.0) GOTO 500
+      JS=3-2*JT
+
+C...Find and sum up momentum on three sides of junction. Check flavours.
+      DO 200 IU=1,3
+      IJU(IU)=0
+      DO 200 J=1,5
+  200 PJU(IU,J)=0.
+      IU=0
+      DO 210 I1=N+1+(JT-1)*(NR-1),N+NR+(JT-1)*(1-NR),JS
+      IF(K(I1,2).NE.21.AND.IU.LE.2) THEN
+        IU=IU+1
+        IJU(IU)=I1
+      ENDIF
+      DO 210 J=1,4
+  210 PJU(IU,J)=PJU(IU,J)+P(I1,J)
+      DO 220 IU=1,3
+  220 PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)
+      IF(K(IJU(3),2)/100.NE.10*K(IJU(1),2)+K(IJU(2),2).AND.
+     &K(IJU(3),2)/100.NE.10*K(IJU(2),2)+K(IJU(1),2)) THEN
+        CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination')
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+
+C...Calculate (approximate) boost to rest frame of junction.
+      T12=(PJU(1,1)*PJU(2,1)+PJU(1,2)*PJU(2,2)+PJU(1,3)*PJU(2,3))/
+     &(PJU(1,5)*PJU(2,5))
+      T13=(PJU(1,1)*PJU(3,1)+PJU(1,2)*PJU(3,2)+PJU(1,3)*PJU(3,3))/
+     &(PJU(1,5)*PJU(3,5))
+      T23=(PJU(2,1)*PJU(3,1)+PJU(2,2)*PJU(3,2)+PJU(2,3)*PJU(3,3))/
+     &(PJU(2,5)*PJU(3,5))
+      T11=SQRT((2./3.)*(1.-T12)*(1.-T13)/(1.-T23))
+      T22=SQRT((2./3.)*(1.-T12)*(1.-T23)/(1.-T13))
+      TSQ=SQRT((2.*T11*T22+T12-1.)*(1.+T12))
+      T1F=(TSQ-T22*(1.+T12))/(1.-T12**2)
+      T2F=(TSQ-T11*(1.+T12))/(1.-T12**2)
+      DO 230 J=1,3
+  230 TJU(J)=-(T1F*PJU(1,J)/PJU(1,5)+T2F*PJU(2,J)/PJU(2,5))
+      TJU(4)=SQRT(1.+TJU(1)**2+TJU(2)**2+TJU(3)**2)
+      DO 240 IU=1,3
+  240 PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)-
+     &TJU(3)*PJU(IU,3)
+
+C...Put junction at rest if motion could give inconsistencies.
+      IF(PJU(1,5)+PJU(2,5).GT.PJU(1,4)+PJU(2,4)) THEN
+        DO 250 J=1,3
+  250   TJU(J)=0.
+        TJU(4)=1.
+        PJU(1,5)=PJU(1,4)
+        PJU(2,5)=PJU(2,4)
+        PJU(3,5)=PJU(3,4)
+      ENDIF
+
+C...Start preparing for fragmentation of two strings from junction.
+      ISTA=I
+      DO 480 IU=1,2
+      NS=IJU(IU+1)-IJU(IU)
+
+C...Junction strings: find longitudinal string directions.
+      DO 270 IS=1,NS
+      IS1=IJU(IU)+IS-1
+      IS2=IJU(IU)+IS
+      DO 260 J=1,5
+      DP(1,J)=0.5*P(IS1,J)
+      IF(IS.EQ.1) DP(1,J)=P(IS1,J)
+      DP(2,J)=0.5*P(IS2,J)
+  260 IF(IS.EQ.NS) DP(2,J)=-PJU(IU,J)
+      IF(IS.EQ.NS) DP(2,4)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)
+      IF(IS.EQ.NS) DP(2,5)=0.
+      DP(3,5)=DFOUR(1,1)
+      DP(4,5)=DFOUR(2,2)
+      DHKC=DFOUR(1,2)
+      IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN
+        DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
+        DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
+        DP(3,5)=0D0
+        DP(4,5)=0D0
+        DHKC=DFOUR(1,2)
+      ENDIF
+      DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5))
+      DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.)
+      DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.)
+      IN1=N+NR+4*IS-3
+      P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5))
+      DO 270 J=1,4
+      P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J)
+  270 P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J)
+
+C...Junction strings: initialize flavour, momentum and starting pos.
+      ISAV=I
+      MSTU91=MSTU(90)
+  280 NTRY=NTRY+1
+      IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
+        PARU12=4.*PARU12
+        PARU13=2.*PARU13
+        GOTO 140
+      ELSEIF(NTRY.GT.100) THEN
+        CALL LUERRM(14,'(LUSTRF:) caught in infinite loop')
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+      I=ISAV
+      MSTU(90)=MSTU91
+      IRANKJ=0
+      IE(1)=K(N+1+(JT/2)*(NP-1),3)
+      IN(4)=N+NR+1
+      IN(5)=IN(4)+1
+      IN(6)=N+NR+4*NS+1
+      DO 290 JQ=1,2
+      DO 290 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4
+      P(IN1,1)=2-JQ
+      P(IN1,2)=JQ-1
+  290 P(IN1,3)=1.
+      KFL(1)=K(IJU(IU),2)
+      PX(1)=0.
+      PY(1)=0.
+      GAM(1)=0.
+      DO 300 J=1,5
+  300 PJU(IU+3,J)=0.
+
+C...Junction strings: find initial transverse directions.
+      DO 310 J=1,4
+      DP(1,J)=P(IN(4),J)
+      DP(2,J)=P(IN(4)+1,J)
+      DP(3,J)=0.
+  310 DP(4,J)=0.
+      DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
+      DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
+      DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
+      DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
+      DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
+      IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
+      IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
+      IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
+      IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
+      DHC12=DFOUR(1,2)
+      DHCX1=DFOUR(3,1)/DHC12
+      DHCX2=DFOUR(3,2)/DHC12
+      DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
+      DHCY1=DFOUR(4,1)/DHC12
+      DHCY2=DFOUR(4,2)/DHC12
+      DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
+      DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
+      DO 320 J=1,4
+      DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
+      P(IN(6),J)=DP(3,J)
+  320 P(IN(6)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
+     &DHCYX*DP(3,J))
+
+C...Junction strings: produce new particle, origin.
+  330 I=I+1
+      IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN
+        CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS')
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+      IRANKJ=IRANKJ+1
+      K(I,1)=1
+      K(I,3)=IE(1)
+      K(I,4)=0
+      K(I,5)=0
+
+C...Junction strings: generate flavour, hadron, pT, z and Gamma.
+  340 CALL LUKFDI(KFL(1),0,KFL(3),K(I,2))
+      IF(K(I,2).EQ.0) GOTO 280
+      IF(MSTJ(12).GE.3.AND.IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND.
+     &IABS(KFL(3)).GT.10) THEN
+        IF(RLU(0).GT.PARJ(19)) GOTO 340
+      ENDIF
+      P(I,5)=ULMASS(K(I,2))
+      CALL LUPTDI(KFL(1),PX(3),PY(3))
+      PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2
+      CALL LUZDIS(KFL(1),KFL(3),PR(1),Z)
+      IF(IABS(KFL(1)).GE.4.AND.IABS(KFL(1)).LE.8.AND.
+     &MSTU(90).LT.8) THEN
+        MSTU(90)=MSTU(90)+1
+        MSTU(90+MSTU(90))=I
+        PARU(90+MSTU(90))=Z
+      ENDIF
+      GAM(3)=(1.-Z)*(GAM(1)+PR(1)/Z)
+      DO 350 J=1,3
+  350 IN(J)=IN(3+J)
+
+C...Junction strings: stepping within or from 'low' string region easy.
+      IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)*
+     &P(IN(1),5)**2.GE.PR(1)) THEN
+        P(IN(1)+2,4)=Z*P(IN(1)+2,3)
+        P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2)
+        DO 360 J=1,4
+  360   P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J)
+        GOTO 430
+      ELSEIF(IN(1)+1.EQ.IN(2)) THEN
+        P(IN(2)+2,4)=P(IN(2)+2,3)
+        P(IN(2)+2,1)=1.
+        IN(2)=IN(2)+4
+        IF(IN(2).GT.N+NR+4*NS) GOTO 280
+        IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
+          P(IN(1)+2,4)=P(IN(1)+2,3)
+          P(IN(1)+2,1)=0.
+          IN(1)=IN(1)+4
+        ENDIF
+      ENDIF
+
+C...Junction strings: find new transverse directions.
+  370 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR.
+     &IN(1).GT.IN(2)) GOTO 280
+      IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN
+        DO 380 J=1,4
+        DP(1,J)=P(IN(1),J)
+        DP(2,J)=P(IN(2),J)
+        DP(3,J)=0.
+  380   DP(4,J)=0.
+        DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
+        DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
+        DHC12=DFOUR(1,2)
+        IF(DHC12.LE.1E-2) THEN
+          P(IN(1)+2,4)=P(IN(1)+2,3)
+          P(IN(1)+2,1)=0.
+          IN(1)=IN(1)+4
+          GOTO 370
+        ENDIF
+        IN(3)=N+NR+4*NS+5
+        DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
+        DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
+        DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
+        IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
+        IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
+        IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
+        IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
+        DHCX1=DFOUR(3,1)/DHC12
+        DHCX2=DFOUR(3,2)/DHC12
+        DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
+        DHCY1=DFOUR(4,1)/DHC12
+        DHCY2=DFOUR(4,2)/DHC12
+        DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
+        DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
+        DO 390 J=1,4
+        DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
+        P(IN(3),J)=DP(3,J)
+  390   P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
+     &  DHCYX*DP(3,J))
+C...Express pT with respect to new axes, if sensible.
+        PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3)))
+        PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1))
+        IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN
+          PX(3)=PXP
+          PY(3)=PYP
+        ENDIF
+      ENDIF
+
+C...Junction strings: sum up known four-momentum, coefficients for m2.
+      DO 410 J=1,4
+      DHG(J)=0.
+      P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+
+     &PY(3)*P(IN(3)+1,J)
+      DO 400 IN1=IN(4),IN(1)-4,4
+  400 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)
+      DO 410 IN2=IN(5),IN(2)-4,4
+  410 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)
+      DHM(1)=FOUR(I,I)
+      DHM(2)=2.*FOUR(I,IN(1))
+      DHM(3)=2.*FOUR(I,IN(2))
+      DHM(4)=2.*FOUR(IN(1),IN(2))
+
+C...Junction strings: find coefficients for Gamma expression.
+      DO 420 IN2=IN(1)+1,IN(2),4
+      DO 420 IN1=IN(1),IN2-1,4
+      DHC=2.*FOUR(IN1,IN2)
+      DHG(1)=DHG(1)+P(IN1+2,1)*P(IN2+2,1)*DHC
+      IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-P(IN2+2,1)*DHC
+      IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+P(IN1+2,1)*DHC
+  420 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC
+
+C...Junction strings: solve (m2, Gamma) equation system for energies.
+      DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3)
+      IF(ABS(DHS1).LT.1E-4) GOTO 280
+      DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(2)*DHG(3)-DHG(4)*
+     &(P(I,5)**2-DHM(1))+DHG(2)*DHM(3)
+      DHS3=DHM(2)*(GAM(3)-DHG(1))-DHG(2)*(P(I,5)**2-DHM(1))
+      P(IN(2)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)-
+     &DHS2/DHS1)
+      IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0.) GOTO 280
+      P(IN(1)+2,4)=(P(I,5)**2-DHM(1)-DHM(3)*P(IN(2)+2,4))/
+     &(DHM(2)+DHM(4)*P(IN(2)+2,4))
+
+C...Junction strings: step to new region if necessary.
+      IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN
+        P(IN(2)+2,4)=P(IN(2)+2,3)
+        P(IN(2)+2,1)=1.
+        IN(2)=IN(2)+4
+        IF(IN(2).GT.N+NR+4*NS) GOTO 280
+        IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
+          P(IN(1)+2,4)=P(IN(1)+2,3)
+          P(IN(1)+2,1)=0.
+          IN(1)=IN(1)+4
+        ENDIF
+        GOTO 370
+      ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN
+        P(IN(1)+2,4)=P(IN(1)+2,3)
+        P(IN(1)+2,1)=0.
+        IN(1)=IN(1)+JS
+        GOTO 720
+      ENDIF
+
+C...Junction strings: particle four-momentum, remainder, loop back.
+  430 DO 440 J=1,4
+      P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J)
+  440 PJU(IU+3,J)=PJU(IU+3,J)+P(I,J)
+      IF(P(I,4).LT.P(I,5)) GOTO 280
+      PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)-
+     &TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3)
+      IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN
+        KFL(1)=-KFL(3)
+        PX(1)=-PX(3)
+        PY(1)=-PY(3)
+        GAM(1)=GAM(3)
+        IF(IN(3).NE.IN(6)) THEN
+          DO 450 J=1,4
+          P(IN(6),J)=P(IN(3),J)
+  450     P(IN(6)+1,J)=P(IN(3)+1,J)
+        ENDIF
+        DO 460 JQ=1,2
+        IN(3+JQ)=IN(JQ)
+        P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4)
+  460   P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4)
+        GOTO 330
+      ENDIF
+
+C...Junction strings: save quantities left after each string.
+      IF(IABS(KFL(1)).GT.10) GOTO 280
+      I=I-1
+      KFJH(IU)=KFL(1)
+      DO 470 J=1,4
+  470 PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J)
+  480 CONTINUE
+
+C...Junction strings: put together to new effective string endpoint.
+      NJS(JT)=I-ISTA
+      KFJS(JT)=K(K(MJU(JT+2),3),2)
+      KFLS=2*INT(RLU(0)+3.*PARJ(4)/(1.+3.*PARJ(4)))+1
+      IF(KFJH(1).EQ.KFJH(2)) KFLS=3
+      IF(ISTA.NE.I) KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)),
+     &IABS(KFJH(2)))+100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+
+     &KFLS,KFJH(1))
+      DO 490 J=1,4
+      PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J)
+  490 PJS(JT+2,J)=PJU(4,J)+PJU(5,J)
+      PJS(JT,5)=SQRT(MAX(0.,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2-
+     &PJS(JT,3)**2))
+  500 CONTINUE
+
+C...Open versus closed strings. Choose breakup region for latter.
+  510 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN
+        NS=MJU(2)-MJU(1)
+        NB=MJU(1)-N
+      ELSEIF(MJU(1).NE.0) THEN
+        NS=N+NR-MJU(1)
+        NB=MJU(1)-N
+      ELSEIF(MJU(2).NE.0) THEN
+        NS=MJU(2)-N
+        NB=1
+      ELSEIF(IABS(K(N+1,2)).NE.21) THEN
+        NS=NR-1
+        NB=1
+      ELSE
+        NS=NR+1
+        W2SUM=0.
+        DO 520 IS=1,NR
+        P(N+NR+IS,1)=0.5*FOUR(N+IS,N+IS+1-NR*(IS/NR))
+  520   W2SUM=W2SUM+P(N+NR+IS,1)
+        W2RAN=RLU(0)*W2SUM
+        NB=0
+  530   NB=NB+1
+        W2SUM=W2SUM-P(N+NR+NB,1)
+        IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 530
+      ENDIF
+
+C...Find longitudinal string directions (i.e. lightlike four-vectors).
+      DO 550 IS=1,NS
+      IS1=N+IS+NB-1-NR*((IS+NB-2)/NR)
+      IS2=N+IS+NB-NR*((IS+NB-1)/NR)
+      DO 540 J=1,5
+      DP(1,J)=P(IS1,J)
+      IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5*DP(1,J)
+      IF(IS1.EQ.MJU(1)) DP(1,J)=PJS(1,J)-PJS(3,J)
+      DP(2,J)=P(IS2,J)
+      IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5*DP(2,J)
+  540 IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J)
+      DP(3,5)=DFOUR(1,1)
+      DP(4,5)=DFOUR(2,2)
+      DHKC=DFOUR(1,2)
+      IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN
+        DP(3,5)=DP(1,5)**2
+        DP(4,5)=DP(2,5)**2
+        DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2+DP(1,5)**2)
+        DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2+DP(2,5)**2)
+        DHKC=DFOUR(1,2)
+      ENDIF
+      DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5))
+      DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.)
+      DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.)
+      IN1=N+NR+4*IS-3
+      P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5))
+      DO 550 J=1,4
+      P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J)
+  550 P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J)
+
+C...Begin initialization: sum up energy, set starting position.
+      ISAV=I
+      MSTU91=MSTU(90)
+  560 NTRY=NTRY+1
+      IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
+        PARU12=4.*PARU12
+        PARU13=2.*PARU13
+        GOTO 140
+      ELSEIF(NTRY.GT.100) THEN
+        CALL LUERRM(14,'(LUSTRF:) caught in infinite loop')
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+      I=ISAV
+      MSTU(90)=MSTU91
+      DO 570 J=1,4
+      P(N+NRS,J)=0.
+      DO 570 IS=1,NR
+  570 P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J)
+      DO 580 JT=1,2
+      IRANK(JT)=0
+      IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT)
+      IF(NS.GT.NR) IRANK(JT)=1
+      IE(JT)=K(N+1+(JT/2)*(NP-1),3)
+      IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1)
+      IN(3*JT+2)=IN(3*JT+1)+1
+      IN(3*JT+3)=N+NR+4*NS+2*JT-1
+      DO 580 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4
+      P(IN1,1)=2-JT
+      P(IN1,2)=JT-1
+  580 P(IN1,3)=1.
+
+C...Initialize flavour and pT variables for open string.
+      IF(NS.LT.NR) THEN
+        PX(1)=0.
+        PY(1)=0.
+        IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL LUPTDI(0,PX(1),PY(1))
+        PX(2)=-PX(1)
+        PY(2)=-PY(1)
+        DO 590 JT=1,2
+        KFL(JT)=K(IE(JT),2)
+        IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT)
+        MSTJ(93)=1
+        PMQ(JT)=ULMASS(KFL(JT))
+  590   GAM(JT)=0.
+
+C...Closed string: random initial breakup flavour, pT and vertex.
+      ELSE
+        KFL(3)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)
+        CALL LUKFDI(KFL(3),0,KFL(1),KDUMP)
+        KFL(2)=-KFL(1)
+        IF(IABS(KFL(1)).GT.10.AND.RLU(0).GT.0.5) THEN
+          KFL(2)=-(KFL(1)+ISIGN(10000,KFL(1)))
+        ELSEIF(IABS(KFL(1)).GT.10) THEN
+          KFL(1)=-(KFL(2)+ISIGN(10000,KFL(2)))
+        ENDIF
+        CALL LUPTDI(KFL(1),PX(1),PY(1))
+        PX(2)=-PX(1)
+        PY(2)=-PY(1)
+        PR3=MIN(25.,0.1*P(N+NR+1,5)**2)
+  600   CALL LUZDIS(KFL(1),KFL(2),PR3,Z)
+        ZR=PR3/(Z*P(N+NR+1,5)**2)
+        IF(ZR.GE.1.) GOTO 600
+        DO 610 JT=1,2
+        MSTJ(93)=1
+        PMQ(JT)=ULMASS(KFL(JT))
+        GAM(JT)=PR3*(1.-Z)/Z
+        IN1=N+NR+3+4*(JT/2)*(NS-1)
+        P(IN1,JT)=1.-Z
+        P(IN1,3-JT)=JT-1
+        P(IN1,3)=(2-JT)*(1.-Z)+(JT-1)*Z
+        P(IN1+1,JT)=ZR
+        P(IN1+1,3-JT)=2-JT
+  610   P(IN1+1,3)=(2-JT)*(1.-ZR)+(JT-1)*ZR
+      ENDIF
+
+C...Find initial transverse directions (i.e. spacelike four-vectors).
+      DO 650 JT=1,2
+      IF(JT.EQ.1.OR.NS.EQ.NR-1) THEN
+        IN1=IN(3*JT+1)
+        IN3=IN(3*JT+3)
+        DO 620 J=1,4
+        DP(1,J)=P(IN1,J)
+        DP(2,J)=P(IN1+1,J)
+        DP(3,J)=0.
+  620   DP(4,J)=0.
+        DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
+        DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
+        DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
+        DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
+        DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
+        IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
+        IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
+        IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
+        IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
+        DHC12=DFOUR(1,2)
+        DHCX1=DFOUR(3,1)/DHC12
+        DHCX2=DFOUR(3,2)/DHC12
+        DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
+        DHCY1=DFOUR(4,1)/DHC12
+        DHCY2=DFOUR(4,2)/DHC12
+        DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
+        DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
+        DO 630 J=1,4
+        DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
+        P(IN3,J)=DP(3,J)
+  630   P(IN3+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
+     &  DHCYX*DP(3,J))
+      ELSE
+        DO 640 J=1,4
+        P(IN3+2,J)=P(IN3,J)
+  640   P(IN3+3,J)=P(IN3+1,J)
+      ENDIF
+  650 CONTINUE
+
+C...Remove energy used up in junction string fragmentation.
+      IF(MJU(1)+MJU(2).GT.0) THEN
+        DO 670 JT=1,2
+        IF(NJS(JT).EQ.0) GOTO 670
+        DO 660 J=1,4
+  660   P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J)
+  670   CONTINUE
+      ENDIF
+
+C...Produce new particle: side, origin.
+  680 I=I+1
+      IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN
+        CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS')
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+      JT=1.5+RLU(0)
+      IF(IABS(KFL(3-JT)).GT.10) JT=3-JT
+      IF(IABS(KFL(3-JT)).GE.4.AND.IABS(KFL(3-JT)).LE.8) JT=3-JT
+      JR=3-JT
+      JS=3-2*JT
+      IRANK(JT)=IRANK(JT)+1
+      K(I,1)=1
+      K(I,3)=IE(JT)
+      K(I,4)=0
+      K(I,5)=0
+
+C...Generate flavour, hadron and pT.
+  690 CALL LUKFDI(KFL(JT),0,KFL(3),K(I,2))
+      IF(K(I,2).EQ.0) GOTO 560
+      IF(MSTJ(12).GE.3.AND.IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND.
+     &IABS(KFL(3)).GT.10) THEN
+        IF(RLU(0).GT.PARJ(19)) GOTO 690
+      ENDIF
+      P(I,5)=ULMASS(K(I,2))
+      CALL LUPTDI(KFL(JT),PX(3),PY(3))
+      PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2
+
+C...Final hadrons for small invariant mass.
+      MSTJ(93)=1
+      PMQ(3)=ULMASS(KFL(3))
+      PARJST=PARJ(33)
+      IF(MSTJ(11).EQ.2) PARJST=PARJ(34)
+      WMIN=PARJST+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3)
+      IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN=
+     &WMIN-0.5*PARJ(36)*PMQ(3)
+      WREM2=FOUR(N+NRS,N+NRS)
+      IF(WREM2.LT.0.10) GOTO 560
+      IF(WREM2.LT.MAX(WMIN*(1.+(2.*RLU(0)-1.)*PARJ(37)),
+     &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 820
+
+C...Choose z, which gives Gamma. Shift z for heavy flavours.
+      CALL LUZDIS(KFL(JT),KFL(3),PR(JT),Z)
+      IF(IABS(KFL(JT)).GE.4.AND.IABS(KFL(JT)).LE.8.AND.
+     &MSTU(90).LT.8) THEN
+        MSTU(90)=MSTU(90)+1
+        MSTU(90+MSTU(90))=I
+        PARU(90+MSTU(90))=Z
+      ENDIF
+      KFL1A=IABS(KFL(1))
+      KFL2A=IABS(KFL(2))
+      IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10),
+     &MOD(KFL2A/1000,10)).GE.4) THEN
+        PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
+        PW12=SQRT(MAX(0.,(WREM2-PR(1)-PR(2))**2-4.*PR(1)*PR(2)))
+        Z=(WREM2+PR(JT)-PR(JR)+PW12*(2.*Z-1.))/(2.*WREM2)
+        PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
+        IF((1.-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 820
+      ENDIF
+      GAM(3)=(1.-Z)*(GAM(JT)+PR(JT)/Z)
+      DO 700 J=1,3
+  700 IN(J)=IN(3*JT+J)
+
+C...Stepping within or from 'low' string region easy.
+      IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)*
+     &P(IN(1),5)**2.GE.PR(JT)) THEN
+        P(IN(JT)+2,4)=Z*P(IN(JT)+2,3)
+        P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2)
+        DO 710 J=1,4
+  710   P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J)
+        GOTO 780
+      ELSEIF(IN(1)+1.EQ.IN(2)) THEN
+        P(IN(JR)+2,4)=P(IN(JR)+2,3)
+        P(IN(JR)+2,JT)=1.
+        IN(JR)=IN(JR)+4*JS
+        IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 560
+        IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
+          P(IN(JT)+2,4)=P(IN(JT)+2,3)
+          P(IN(JT)+2,JT)=0.
+          IN(JT)=IN(JT)+4*JS
+        ENDIF
+      ENDIF
+
+C...Find new transverse directions (i.e. spacelike string vectors).
+  720 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR.
+     &IN(1).GT.IN(2)) GOTO 560
+      IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN
+        DO 730 J=1,4
+        DP(1,J)=P(IN(1),J)
+        DP(2,J)=P(IN(2),J)
+        DP(3,J)=0.
+  730   DP(4,J)=0.
+        DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
+        DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
+        DHC12=DFOUR(1,2)
+        IF(DHC12.LE.1E-2) THEN
+          P(IN(JT)+2,4)=P(IN(JT)+2,3)
+          P(IN(JT)+2,JT)=0.
+          IN(JT)=IN(JT)+4*JS
+          GOTO 720
+        ENDIF
+        IN(3)=N+NR+4*NS+5
+        DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
+        DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
+        DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
+        IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
+        IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
+        IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
+        IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
+        DHCX1=DFOUR(3,1)/DHC12
+        DHCX2=DFOUR(3,2)/DHC12
+        DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
+        DHCY1=DFOUR(4,1)/DHC12
+        DHCY2=DFOUR(4,2)/DHC12
+        DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
+        DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
+        DO 740 J=1,4
+        DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
+        P(IN(3),J)=DP(3,J)
+  740   P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
+     &  DHCYX*DP(3,J))
+C...Express pT with respect to new axes, if sensible.
+        PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)*
+     &  FOUR(IN(3*JT+3)+1,IN(3)))
+        PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)*
+     &  FOUR(IN(3*JT+3)+1,IN(3)+1))
+        IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN
+          PX(3)=PXP
+          PY(3)=PYP
+        ENDIF
+      ENDIF
+
+C...Sum up known four-momentum. Gives coefficients for m2 expression.
+      DO 760 J=1,4
+      DHG(J)=0.
+      P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+
+     &PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J)
+      DO 750 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS
+  750 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)
+      DO 760 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS
+  760 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)
+      DHM(1)=FOUR(I,I)
+      DHM(2)=2.*FOUR(I,IN(1))
+      DHM(3)=2.*FOUR(I,IN(2))
+      DHM(4)=2.*FOUR(IN(1),IN(2))
+
+C...Find coefficients for Gamma expression.
+      DO 770 IN2=IN(1)+1,IN(2),4
+      DO 770 IN1=IN(1),IN2-1,4
+      DHC=2.*FOUR(IN1,IN2)
+      DHG(1)=DHG(1)+P(IN1+2,JT)*P(IN2+2,JT)*DHC
+      IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-JS*P(IN2+2,JT)*DHC
+      IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+JS*P(IN1+2,JT)*DHC
+  770 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC
+
+C...Solve (m2, Gamma) equation system for energies taken.
+      DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1)
+      IF(ABS(DHS1).LT.1E-4) GOTO 560
+      DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)*
+     &(P(I,5)**2-DHM(1))+DHG(JT+1)*DHM(JR+1)
+      DHS3=DHM(JT+1)*(GAM(3)-DHG(1))-DHG(JT+1)*(P(I,5)**2-DHM(1))
+      P(IN(JR)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)-
+     &DHS2/DHS1)
+      IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0.) GOTO 560
+      P(IN(JT)+2,4)=(P(I,5)**2-DHM(1)-DHM(JR+1)*P(IN(JR)+2,4))/
+     &(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4))
+
+C...Step to new region if necessary.
+      IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN
+        P(IN(JR)+2,4)=P(IN(JR)+2,3)
+        P(IN(JR)+2,JT)=1.
+        IN(JR)=IN(JR)+4*JS
+        IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 560
+        IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
+          P(IN(JT)+2,4)=P(IN(JT)+2,3)
+          P(IN(JT)+2,JT)=0.
+          IN(JT)=IN(JT)+4*JS
+        ENDIF
+        GOTO 720
+      ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN
+        P(IN(JT)+2,4)=P(IN(JT)+2,3)
+        P(IN(JT)+2,JT)=0.
+        IN(JT)=IN(JT)+4*JS
+        GOTO 720
+      ENDIF
+
+C...Four-momentum of particle. Remaining quantities. Loop back.
+  780 DO 790 J=1,4
+      P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J)
+  790 P(N+NRS,J)=P(N+NRS,J)-P(I,J)
+      IF(P(I,4).LT.P(I,5)) GOTO 560
+      KFL(JT)=-KFL(3)
+      PMQ(JT)=PMQ(3)
+      PX(JT)=-PX(3)
+      PY(JT)=-PY(3)
+      GAM(JT)=GAM(3)   
+      IF(IN(3).NE.IN(3*JT+3)) THEN
+        DO 800 J=1,4
+        P(IN(3*JT+3),J)=P(IN(3),J)
+  800   P(IN(3*JT+3)+1,J)=P(IN(3)+1,J)
+      ENDIF
+      DO 810 JQ=1,2
+      IN(3*JT+JQ)=IN(JQ)
+      P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4)
+  810 P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4)
+      GOTO 680
+
+C...Final hadron: side, flavour, hadron, mass.
+  820 I=I+1
+      K(I,1)=1
+      K(I,3)=IE(JR)
+      K(I,4)=0
+      K(I,5)=0
+      CALL LUKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2))
+      IF(K(I,2).EQ.0) GOTO 560
+      P(I,5)=ULMASS(K(I,2))
+      PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
+
+C...Final two hadrons: find common setup of four-vectors.
+      JQ=1
+      IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT.P(IN(7),3)*
+     &P(IN(8),3)*FOUR(IN(7),IN(8))) JQ=2
+      DHC12=FOUR(IN(3*JQ+1),IN(3*JQ+2))
+      DHR1=FOUR(N+NRS,IN(3*JQ+2))/DHC12
+      DHR2=FOUR(N+NRS,IN(3*JQ+1))/DHC12
+      IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN
+        PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ)
+        PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ)
+        PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS*
+     &  PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2
+      ENDIF
+
+C...Solve kinematics for final two hadrons, if possible.
+      WREM2=WREM2+(PX(1)+PX(2))**2+(PY(1)+PY(2))**2
+      FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2)
+      IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1.) GOTO 190
+      IF(FD.GE.1.) GOTO 560
+      FA=WREM2+PR(JT)-PR(JR)
+      IF(MSTJ(11).NE.2) PREV=0.5*EXP(MAX(-80.,LOG(FD)*PARJ(38)*
+     &(PR(1)+PR(2))**2))
+      IF(MSTJ(11).EQ.2) PREV=0.5*FD**PARJ(39)
+      FB=SIGN(SQRT(MAX(0.,FA**2-4.*WREM2*PR(JT))),JS*(RLU(0)-PREV))
+      KFL1A=IABS(KFL(1))
+      KFL2A=IABS(KFL(2))
+      IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10),
+     &MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0.,FA**2-
+     &4.*WREM2*PR(JT))),FLOAT(JS))
+      DO 830 J=1,4
+      P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))*
+     &P(IN(3*JQ+3)+1,J)+0.5*(DHR1*(FA+FB)*P(IN(3*JQ+1),J)+
+     &DHR2*(FA-FB)*P(IN(3*JQ+2),J))/WREM2
+  830 P(I,J)=P(N+NRS,J)-P(I-1,J)
+      IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 560
+C...Mark jets as fragmented and give daughter pointers.
+      N=I-NRS+1
+      DO 840 I=NSAV+1,NSAV+NP
+      IM=K(I,3)
+      K(IM,1)=K(IM,1)+10
+      IF(MSTU(16).NE.2) THEN
+        K(IM,4)=NSAV+1
+        K(IM,5)=NSAV+1
+      ELSE
+        K(IM,4)=NSAV+2
+        K(IM,5)=N
+      ENDIF
+  840 CONTINUE
+
+C...Document string system. Move up particles.
+      NSAV=NSAV+1
+      K(NSAV,1)=11
+      K(NSAV,2)=92
+      K(NSAV,3)=IP
+      K(NSAV,4)=NSAV+1
+      K(NSAV,5)=N
+      DO 850 J=1,4
+      P(NSAV,J)=DPS(J)
+  850 V(NSAV,J)=V(IP,J)
+      P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))
+      V(NSAV,5)=0.
+      DO 860 I=NSAV+1,N
+      DO 860 J=1,5
+      K(I,J)=K(I+NRS-1,J)
+      P(I,J)=P(I+NRS-1,J)
+  860 V(I,J)=0.
+      MSTU91=MSTU(90)
+      DO 870 IZ=MSTU90+1,MSTU91
+      MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N
+  870 PARU9T(IZ)=PARU(90+IZ)
+      MSTU(90)=MSTU90
+
+C...Order particles in rank along the chain. Update mother pointer.
+      DO 880 I=NSAV+1,N
+      DO 880 J=1,5
+      K(I-NSAV+N,J)=K(I,J)
+  880 P(I-NSAV+N,J)=P(I,J)
+      I1=NSAV
+      DO 910 I=N+1,2*N-NSAV
+      IF(K(I,3).NE.IE(1)) GOTO 910
+      I1=I1+1
+      DO 890 J=1,5
+      K(I1,J)=K(I,J)
+  890 P(I1,J)=P(I,J)
+      IF(MSTU(16).NE.2) K(I1,3)=NSAV
+      DO 900 IZ=MSTU90+1,MSTU91
+      IF(MSTU9T(IZ).EQ.I) THEN
+        MSTU(90)=MSTU(90)+1
+        MSTU(90+MSTU(90))=I1
+        PARU(90+MSTU(90))=PARU9T(IZ)
+      ENDIF
+  900 CONTINUE
+  910 CONTINUE
+      DO 940 I=2*N-NSAV,N+1,-1
+      IF(K(I,3).EQ.IE(1)) GOTO 940
+      I1=I1+1
+      DO 920 J=1,5
+      K(I1,J)=K(I,J)
+  920 P(I1,J)=P(I,J)
+      IF(MSTU(16).NE.2) K(I1,3)=NSAV
+      DO 930 IZ=MSTU90+1,MSTU91
+      IF(MSTU9T(IZ).EQ.I) THEN
+        MSTU(90)=MSTU(90)+1
+        MSTU(90+MSTU(90))=I1
+        PARU(90+MSTU(90))=PARU9T(IZ)
+      ENDIF
+  930 CONTINUE
+  940 CONTINUE
+
+C...Boost back particle system. Set production vertices.
+      IF(MBST.EQ.0) THEN
+        MSTU(33)=1
+        CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),
+     &  DPS(3)/DPS(4))
+      ELSE
+        DO 950 I=NSAV+1,N
+        HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2
+        IF(P(I,3).GT.0.) THEN
+          HHPEZ=(P(I,4)+P(I,3))*HHBZ
+          P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ)
+          P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ)
+        ELSE
+          HHPEZ=(P(I,4)-P(I,3))/HHBZ
+          P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ)
+          P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ)
+        ENDIF
+  950   CONTINUE
+      ENDIF
+      DO 960 I=NSAV+1,N        
+      DO 960 J=1,4
+  960 V(I,J)=V(IP,J)
+
+      RETURN
+      END
+
+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(150000,5),P(150000,5),V(150000,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
+  100 DPS(J)=0.
+      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)
+  120 DPS(J)=DPS(J)+P(I,J)
+      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
+  130 NFI(J)=0
+      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
+  160 KFLF(J)=0
+
+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/(Z*W))
+      P(I,4)=0.5*(Z*W+PR/(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
+  210 V(I,J)=0.
+
+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
+  220 N=I
+      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 470
+      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
+  260 IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2
+      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
+  270 IF(K(I,1).EQ.8) K(I,1)=1
+
+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))
+  290 IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3))
+      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)
+  300 NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J))
+
+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 330 J=1,3
+        PSI(J)=0.
+        DO 330 I=NSAV+NJET+1,N
+  330   PSI(J)=PSI(J)+P(I,J)
+        PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2
+        PWS=0.
+        DO 340 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))
+  340   IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1.
+        DO 360 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 350 J=1,3
+  350   P(I,J)=P(I,J)-PSI(J)*PW/PWS
+  360   P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
+
+C...Compensate for missing momentum withing each jet separately.
+      ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN
+        DO 370 I=N+1,N+NJET
+        K(I,1)=0
+        DO 370 J=1,5
+  370   P(I,J)=0.
+        DO 390 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 380 J=1,3
+  380   P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J)
+        P(IR2,4)=P(IR2,4)+P(I,4)
+  390   P(IR2,5)=P(IR2,5)+PLS
+        PSS=0.
+        DO 400 I=N+1,N+NJET
+  400   IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8*P(I,5)+0.2))
+        DO 420 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 410 J=1,3
+  410   P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1./(P(IR2,5)*PSS)-1.)*PLS*
+     &  P(IR1,J)
+  420   P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
+      ENDIF
+
+C...Scale momenta for energy conservation.
+      IF(MOD(MSTJ(3),5).NE.0) THEN
+        PMS=0.
+        PES=0.
+        PQS=0.
+        DO 430 I=NSAV+NJET+1,N
+        PMS=PMS+P(I,5)
+        PES=PES+P(I,4)
+  430   PQS=PQS+P(I,5)**2/P(I,4)
+        IF(PMS.GE.PECM) GOTO 150
+        NECO=0
+  440   NECO=NECO+1
+        PFAC=(PECM-PQS)/(PES-PQS)
+        PES=0.
+        PQS=0.
+        DO 460 I=NSAV+NJET+1,N
+        DO 450 J=1,3
+  450   P(I,J)=PFAC*P(I,J)
+        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)
+  460   PQS=PQS+P(I,5)**2/P(I,4)
+        IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2E-6*PECM) GOTO 440
+      ENDIF
+
+C...Origin of produced particles and parton daughter pointers.
+  470 DO 480 I=NSAV+NJET+1,N
+      IF(MSTU(16).NE.2) K(I,3)=NSAV+1
+  480 IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3)
+      DO 490 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
+  490 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 500 J=1,4
+      P(NSAV,J)=DPS(J)
+  500 V(NSAV,J)=V(IP,J)
+      P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))
+      V(NSAV,5)=0.
+      DO 510 I=NSAV+NJET,N
+      DO 510 J=1,5
+      K(I-NJET+1,J)=K(I,J)
+      P(I-NJET+1,J)=P(I,J)
+  510 V(I-NJET+1,J)=V(I,J)
+      N=N-NJET+1
+      DO 520 IZ=MSTU90+1,MSTU(90)
+  520 MSTU(90+IZ)=MSTU(90+IZ)-NJET+1
+
+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 530 I=NSAV+1,N
+      DO 530 J=1,4
+  530 V(I,J)=V(IP,J)
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      SUBROUTINE LUDECY(IP)
+
+C...Purpose: to handle the decay of unstable particles.
+      COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,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)
+      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
+  100 VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5)
+
+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...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.
+  110 NOPE=0
+      BRSU=0.
+      DO 120 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 120
+      IF(MDME(IDL,2).GT.100) GOTO 120
+      NOPE=NOPE+1
+      BRSU=BRSU+BRAT(IDL)
+  120 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.
+  130 RBR=BRSU*RLU(0)
+      IDL=MDCY(KCA,2)-1
+  140 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 140
+      ELSEIF(MDME(IDL,2).GT.100) THEN
+        IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 140
+      ELSE
+        IDC=IDL
+        RBR=RBR-BRAT(IDL)
+        IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0.) GOTO 140
+      ENDIF
+
+C...Start readout of decay channel: matrix element, reset counters.
+      MMAT=MDME(IDC,2)
+  150 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 160 J=1,4
+      PV(1,J)=0.
+  160 IF(MBST.EQ.0) PV(1,J)=P(IP,J)
+      IF(MBST.EQ.1) PV(1,4)=P(IP,5)
+      PV(1,5)=P(IP,5)
+      PS=0.
+      PSQ=0.
+      MREM=0
+
+C...Read out decay products. Convert to standard flavour code.
+      JTMAX=5
+      IF(MDME(IDC+1,2).EQ.101) JTMAX=10
+      DO 170 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 170
+      KPA=IABS(KP)
+      KCP=LUCOMP(KPA)
+      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 150
+        MSTJ(93)=1
+        IF(PV(1,5).LT.PARJ(32)+2.*ULMASS(KFP)) GOTO 150
+      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.GE.42.AND.MMAT.LE.43.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 150
+        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
+  170 CONTINUE
+
+C...Choose decay multiplicity in phase space model.
+  180 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)
+  190   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 190
+          IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 190
+          IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 190
+          IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 190
+        ELSE
+          ND=MMAT-20
+        ENDIF
+
+C...Form hadrons from flavour content.
+        DO 200 JT=1,4
+  200   KFL1(JT)=KFLO(JT)
+        IF(ND.EQ.NP+NQ/2) GOTO 220
+        DO 210 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 190
+  210   KFL1(JT)=-KFL2
+  220   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 190
+        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 190
+
+C...Check that sum of decay product masses not too large.
+        PS=PSP
+        DO 230 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))
+  230   PS=PS+P(I,5)
+        IF(PS+PARJ(64).GT.PV(1,5)) GOTO 190
+
+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 240 J=1,5
+        P(N+NP,J)=PQT*PV(1,J)
+  240   PV(1,J)=(1.-PQT)*PV(1,J)
+        IF(PS+PARJ(64).GT.PV(1,5)) GOTO 150
+        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 130
+        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 130
+        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 150
+        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
+  250   HW=HLQ+RLU(0)*(HUQ-HLQ)
+        IF(HMEPS(HW).LT.RLU(0)) GOTO 250
+        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)
+  260   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 260
+        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.
+  270   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 270
+        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(IM.NE.0) KFAM=IABS(K(IM,2))
+        IF(IM.NE.0.AND.MMAT.EQ.3) THEN
+          DO 280 IL=MAX(IP-2,IM+1),MIN(IP+2,N)
+          IF(K(IL,3).EQ.IM) NM=NM+1
+  280     IF(K(IL,3).EQ.IM.AND.IL.NE.IP) ISIS=IL
+          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 290 J=1,4
+  290   P(N+1,J)=P(IP,J)
+        GOTO 520
+      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 300 IL=ND-1,1,-1
+        PMAX=PMAX+P(N+IL,5)
+        PMIN=PMIN+P(N+IL+1,5)
+  300   WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5))
+      ENDIF
+
+C...Find virtual gamma mass in Dalitz decay.
+  310 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
+  320   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 320
+        PV(2,5)=MAX(2.00001*PMAS(11,1),SQRT(PMST))
+
+C...M-generator gives weight. If rejected, try again.
+      ELSE
+  330   RORD(1)=1.
+        DO 350 IL1=2,ND-1
+        RSAV=RLU(0)
+        DO 340 IL2=IL1-1,1,-1
+        IF(RSAV.LE.RORD(IL2)) GOTO 350
+  340   RORD(IL2+1)=RORD(IL2)
+  350   RORD(IL2+1)=RSAV
+        RORD(ND)=0.
+        WT=1.
+        DO 360 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)
+  360   WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))
+        IF(WT.LT.RLU(0)*WTMAX) GOTO 330
+      ENDIF
+
+C...Perform two-particle decays in respective CM frame.
+  370 DO 390 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 380 J=1,3
+      P(N+IL,J)=PA*UE(J)
+  380 PV(IL+1,J)=-PA*UE(J)
+      P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2)
+  390 PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2)
+
+C...Lorentz transform decay products to lab frame.
+      DO 400 J=1,4
+  400 P(N+ND,J)=PV(ND,J)
+      DO 430 IL=ND-1,1,-1
+      DO 410 J=1,3
+  410 BE(J)=PV(IL,J)/PV(IL,4)
+      GA=PV(IL,4)/PV(IL,5)
+      DO 430 I=N+IL,N+ND
+      BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
+      DO 420 J=1,3
+  420 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
+  430 P(I,4)=GA*(P(I,4)+BEP)
+
+C...Check that no infinite loop in matrix element weight.
+      NTRY=NTRY+1
+      IF(NTRY.GT.800) GOTO 450
+
+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 310
+
+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 370
+
+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 370
+
+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 310
+        IF(K(IP+1,2).EQ.22.AND.(1.-HX1)*P(IP,5)**2.LT.4.*PARJ(32)**2)
+     &  GOTO 310
+
+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
+        IF(8.*HX1*(3.-2.*HX1)/9..LT.RLU(0)) GOTO 310
+
+C...Matrix elements for weak decays (only semileptonic for c and b)
+      ELSEIF(MMAT.GE.42.AND.MMAT.LE.44.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 310
+      ELSEIF(MMAT.GE.42.AND.MMAT.LE.44) THEN
+        DO 440 J=1,4
+        P(N+NP+1,J)=0.
+        DO 440 IS=N+3,N+NP
+  440   P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J)
+        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 310
+
+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 370
+      ENDIF
+
+C...Scale back energy and reattach spectator.
+  450 IF(MREM.EQ.1) THEN
+        DO 460 J=1,5
+  460   PV(1,J)=PV(1,J)/(1.-PQT)
+        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 520
+        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 150
+        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 370
+      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 490
+        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 150
+        P(N+3,5)=ULMASS(K(N+3,2))
+        DO 470 J=1,3
+  470   P(N+3,J)=P(N+3,J)+P(N+4,J)
+        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 480 J=1,3
+        PCOR=HH*(P(N+1,J)-P(N+2,J))
+        P(N+1,J)=P(N+1,J)+PCOR
+  480   P(N+2,J)=P(N+2,J)-PCOR
+        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.
+  490 IF(MMAT.GE.42.AND.MMAT.LE.44.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 500
+        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 150
+        PSM=ULMASS(KF1)+ULMASS(KF2)
+        IF(MMAT.EQ.42.AND.PMR.GT.PARJ(64)+PSM) GOTO 500
+        IF(MMAT.GE.43.AND.PMR.GT.0.2*PARJ(32)+PSM) GOTO 500
+        IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 150
+        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 150
+        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)
+        PV(2,5)=P(N+3,5)
+        MMAT=0
+        ND=2
+        GOTO 370
+      ENDIF
+
+C...Phase space decay of partons from W decay.
+  500 IF(MMAT.EQ.42.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 510 J=1,5
+        PV(1,J)=P(N+1,J)+P(N+2,J)
+  510   P(N+1,J)=P(N+3,J)
+        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 180
+      ENDIF
+
+C...Boost back for rapidly moving particle.
+  520 N=N+ND
+      IF(MBST.EQ.1) THEN
+        DO 530 J=1,3
+  530   BE(J)=P(IP,J)/P(IP,4)
+        GA=P(IP,4)/P(IP,5)
+        DO 550 I=NSAV+1,N
+        BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
+        DO 540 J=1,3
+  540   P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
+  550   P(I,4)=GA*(P(I,4)+BEP)
+      ENDIF
+
+C...Fill in position of decay vertex.
+      DO 570 I=NSAV+1,N
+      DO 560 J=1,4
+  560 V(I,J)=VDCY(J)
+  570 V(I,5)=0.
+
+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
+      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
+
+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 140
+      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.
+      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)
+  110     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 110
+          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...Generate diquark flavour.
+      ELSE
+  120   IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN
+          KFLA=KF1A
+  130     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 130
+          IF(KFLDS.EQ.3.AND.PAR4.LT.RLU(0)) GOTO 130
+          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 120
+
+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.
+  140 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 150 KTS=0,2
+      DO 150 KT3=KT3L,KT3U
+      RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3)
+  150 CONTINUE
+      RFL=RLU(0)*RFL
+      DO 160 KTS=0,2
+      KTABS=KTS
+      DO 160 KT3=KT3L,KT3U
+      KTAB3=KT3
+      RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3)
+  160 IF(RFL.LE.0.) GOTO 170
+  170 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
+
+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(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
+
+C*********************************************************************
+
+      SUBROUTINE LUZDIS(KFL1,KFL2,PR,Z)
+
+C...Purpose: to generate the longitudinal splitting variable z.
+      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...Check if heavy flavour fragmentation.
+      KFLA=IABS(KFL1)
+      KFLB=IABS(KFL2)
+      KFLH=KFLA
+      IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10)
+
+C...Lund symmetric scaling function: determine parameters of shape.
+      IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3).OR.
+     &MSTJ(11).GE.4) THEN
+        FA=PARJ(41)
+        IF(MSTJ(91).EQ.1) FA=PARJ(43)
+        IF(KFLB.GE.10) FA=FA+PARJ(45)
+        FBB=PARJ(42)
+        IF(MSTJ(91).EQ.1) FBB=PARJ(44)
+        FB=FBB*PR
+        FC=1.
+        IF(KFLA.GE.10) FC=FC-PARJ(45)
+        IF(KFLB.GE.10) FC=FC+PARJ(45)
+        IF(MSTJ(11).GE.4.AND.KFLH.GE.4.AND.KFLH.LE.5) THEN
+          FRED=PARJ(46)
+          IF(MSTJ(11).EQ.5.AND.KFLH.EQ.5) FRED=PARJ(47)
+          FC=FC+FRED*FBB*PARF(100+KFLH)**2
+        ELSEIF(MSTJ(11).GE.4.AND.KFLH.GE.6.AND.KFLH.LE.8) THEN
+          FRED=PARJ(46)
+          IF(MSTJ(11).EQ.5) FRED=PARJ(48)
+          FC=FC+FRED*FBB*PMAS(KFLH,1)**2
+        ENDIF
+        MC=1
+        IF(ABS(FC-1.).GT.0.01) MC=2
+
+C...Determine position of maximum. Special cases for a = 0 or a = c.
+        IF(FA.LT.0.02) THEN
+          MA=1
+          ZMAX=1.
+          IF(FC.GT.FB) ZMAX=FB/FC
+        ELSEIF(ABS(FC-FA).LT.0.01) THEN
+          MA=2
+          ZMAX=FB/(FB+FC)
+        ELSE
+          MA=3
+          ZMAX=0.5*(FB+FC-SQRT((FB-FC)**2+4.*FA*FB))/(FC-FA)
+          IF(ZMAX.GT.0.9999.AND.FB.GT.100.) ZMAX=MIN(ZMAX,1.-FA/FB)
+        ENDIF
+
+C...Subdivide z range if distribution very peaked near endpoint.
+        MMAX=2
+        IF(ZMAX.LT.0.1) THEN
+          MMAX=1
+          ZDIV=2.75*ZMAX
+          IF(MC.EQ.1) THEN
+            FINT=1.-LOG(ZDIV)
+          ELSE
+            ZDIVC=ZDIV**(1.-FC)
+            FINT=1.+(1.-1./ZDIVC)/(FC-1.)
+          ENDIF
+        ELSEIF(ZMAX.GT.0.85.AND.FB.GT.1.) THEN
+          MMAX=3
+          FSCB=SQRT(4.+(FC/FB)**2)
+          ZDIV=FSCB-1./ZMAX-(FC/FB)*LOG(ZMAX*0.5*(FSCB+FC/FB))
+          IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1.-ZMAX)
+          ZDIV=MIN(ZMAX,MAX(0.,ZDIV))
+          FINT=1.+FB*(1.-ZDIV)
+        ENDIF
+
+C...Choice of z, preweighted for peaks at low or high z.
+  100   Z=RLU(0)
+        FPRE=1.
+        IF(MMAX.EQ.1) THEN
+          IF(FINT*RLU(0).LE.1.) THEN
+            Z=ZDIV*Z
+          ELSEIF(MC.EQ.1) THEN
+            Z=ZDIV**Z
+            FPRE=ZDIV/Z
+          ELSE
+            Z=1./(ZDIVC+Z*(1.-ZDIVC))**(1./(1.-FC))
+            FPRE=(ZDIV/Z)**FC
+          ENDIF
+        ELSEIF(MMAX.EQ.3) THEN
+          IF(FINT*RLU(0).LE.1.) THEN
+            Z=ZDIV+LOG(Z)/FB
+            FPRE=EXP(FB*(Z-ZDIV))
+          ELSE
+            Z=ZDIV+Z*(1.-ZDIV)
+          ENDIF
+        ENDIF
+
+C...Weighting according to correct formula.
+        IF(Z.LE.0..OR.Z.GE.1.) GOTO 100
+        FEXP=FC*LOG(ZMAX/Z)+FB*(1./ZMAX-1./Z)
+        IF(MA.GE.2) FEXP=FEXP+FA*LOG((1.-Z)/(1.-ZMAX))
+        FVAL=EXP(MAX(-50.,FEXP))
+        IF(FVAL.LT.RLU(0)*FPRE) GOTO 100
+
+C...Generate z according to Field-Feynman, SLAC, (1-z)**c OR z**c.
+      ELSE
+        FC=PARJ(50+MAX(1,KFLH))
+        IF(MSTJ(91).EQ.1) FC=PARJ(59)
+  110   Z=RLU(0)
+        IF(FC.GE.0..AND.FC.LE.1.) THEN
+          IF(FC.GT.RLU(0)) Z=1.-Z**(1./3.)
+        ELSEIF(FC.GT.-1.) THEN
+          IF(-4.*FC*Z*(1.-Z)**2.LT.RLU(0)*((1.-Z)**2-FC*Z)**2) GOTO 110
+        ELSE
+          IF(FC.GT.0.) Z=1.-Z**(1./FC)
+          IF(FC.LT.0.) Z=Z**(-1./FC)
+        ENDIF
+      ENDIF
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      SUBROUTINE LUSHOW(IP1,IP2,QMAX)
+
+C...Purpose: to generate timelike parton showers from given partons.
+      IMPLICIT DOUBLE PRECISION(D)
+      COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,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,40),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)
+
+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)).OR.MSTJ(41).GE.3) RETURN
+      DO 101 IF=0,40
+  101 KSH(IF)=0
+      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).EQ.2) PMQTH1=MIN(PARJ(82),PARJ(83))
+      PMQTH2=PMTH(2,21)
+      IF(MSTJ(41).EQ.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22))
+      DO 100 IF=1,8
+      KSH(IF)=1
+      PMTH(1,IF)=ULMASS(IF)
+      PMTH(2,IF)=SQRT(PMTH(1,IF)**2+0.25*PMQTH1**2)
+      PMTH(3,IF)=PMTH(2,IF)+PMQTH2
+      PMTH(4,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(82)**2)+PMTH(2,21)
+  100 PMTH(5,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(83)**2)+PMTH(2,22)
+      DO 105 IF=11,17,2
+      IF(MSTJ(41).EQ.2) KSH(IF)=1
+      PMTH(1,IF)=ULMASS(IF)
+      PMTH(2,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(83)**2)
+      PMTH(3,IF)=PMTH(2,IF)+PMTH(2,22)
+      PMTH(4,IF)=PMTH(3,IF)
+  105 PMTH(5,IF)=PMTH(3,IF)
+      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.
+      M3JC=0
+      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 110 I=1,NPA
+  110   IPA(I)=IP1+I-1
+      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 120 J=1,5
+  120 PS(J)=0.
+      PM=0.
+      DO 130 I=1,NPA
+      KFLA(I)=IABS(K(IPA(I),2))
+      PMA(I)=P(IPA(I),5)
+      IF(KFLA(I).LE.40) THEN
+        IF(KSH(KFLA(I)).EQ.1) PMA(I)=PMTH(3,KFLA(I))
+      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 130 J=1,4
+  130 PS(J)=PS(J)+P(IPA(I),J)
+      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
+      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).GE.2) M3JC=1
+      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
+  140 IM=IM+1
+      IF(N.GT.NS) THEN
+        IF(IM.GT.N) GOTO 380
+        KFLM=IABS(K(IM,2))
+        IF(KFLM.GT.40) GOTO 140
+        IF(KSH(KFLM).EQ.0) GOTO 140
+        IF(P(IM,5).LT.PMTH(2,KFLM)) GOTO 140
+        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 150 I=1,NEP
+  150   K(N+I,3)=IM
+      ELSE
+        K(N+1,3)=IPA(1)
+      ENDIF
+      IF(IGM.LE.0) THEN
+        DO 160 I=1,NEP
+  160   K(N+I,2)=K(IPA(I),2)
+      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 170 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
+  170 CONTINUE
+      ISLM=0
+
+C...Maximum virtuality of daughters.
+      IF(IGM.LE.0) THEN
+        DO 180 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))
+  180   IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5)
+      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 190 I=1,NEP
+      PMSD(I)=P(N+I,5)
+      IF(ISI(I).EQ.1) THEN
+        IF(P(N+I,5).LE.PMTH(3,KFLD(I))) P(N+I,5)=PMTH(1,KFLD(I))
+      ENDIF
+  190 V(N+I,5)=P(N+I,5)**2
+
+C...Choose one of the daughters for evolution.
+  200 INUM=0
+      IF(NEP.EQ.1) INUM=1
+      DO 210 I=1,NEP
+  210 IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I
+      DO 220 I=1,NEP
+      IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN
+        IF(P(N+I,5).GE.PMTH(2,KFLD(I))) INUM=I
+      ENDIF
+  220 CONTINUE
+      IF(INUM.EQ.0) THEN
+        RMAX=0.
+        DO 230 I=1,NEP
+        IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN
+          RPM=P(N+I,5)/PMSD(I)
+          IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,KFLD(I))) THEN
+            RMAX=RPM
+            INUM=I
+          ENDIF
+        ENDIF
+  230   CONTINUE
+      ENDIF
+
+C...Store information on choice of evolving daughter.
+      INUM=MAX(1,INUM)
+      IEP(1)=N+INUM
+      DO 240 I=2,NEP
+      IEP(I)=IEP(I-1)+1
+  240 IF(IEP(I).GT.N+NEP) IEP(I)=N+1
+      DO 250 I=1,NEP
+  250 KFL(I)=IABS(K(IEP(I),2))
+      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 300
+      IF(KSH(KFL(1)).EQ.0) GOTO 300
+      IF(P(IEP(1),5).LT.PMTH(2,KFL(1))) GOTO 300
+
+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).EQ.2.AND.
+     &MIN(ZC,ZCE).GT.0.49)) THEN
+        P(IEP(1),5)=PMTH(1,KFL(1))
+        V(IEP(1),5)=P(IEP(1),5)**2
+        GOTO 300
+      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).EQ.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18)
+     &FBRE=(KCHG(KFL(1),1)/3.)**2*2.*LOG((1.-ZCE)/ZCE)
+
+C...Inner veto algorithm starts. Find maximum mass for evolution.
+  260 PMS=V(IEP(1),5)
+      IF(IGM.GE.0) THEN
+        PM2=0.
+        DO 270 I=2,NEP
+        PM=P(IEP(I),5)
+        IF(KFL(I).LE.40) THEN
+          IF(KSH(KFL(I)).EQ.1) PM=PMTH(2,KFL(I))
+        ENDIF
+  270   PM2=PM2+PM
+        PMS=MIN(PMS,(P(IM,5)-PM2)**2)
+      ENDIF
+
+C...Select mass for daughter in QCD evolution.
+      B0=27./6.
+      DO 280 IF=4,MSTJ(45)
+  280 IF(PMS.GT.4.*PMTH(2,IF)**2) B0=(33.-2.*IF)/6.
+      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,KFL(1))**2) PMSQCD=
+     &PMTH(2,KFL(1))**2
+      V(IEP(1),5)=PMSQCD
+      MCE=1
+
+C...Select mass for daughter in QED evolution.
+      IF(MSTJ(41).EQ.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN
+        PMSQED=PMS*EXP(MAX(-80.,LOG(RLU(0))*PARU(2)/(PARU(101)*FBRE)))
+        IF(ZCE.GT.0.49.OR.PMSQED.LE.PMTH(5,KFL(1))**2) PMSQED=
+     &  PMTH(2,KFL(1))**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,KFL(1))) THEN
+        P(IEP(1),5)=PMTH(1,KFL(1))
+        V(IEP(1),5)=P(IEP(1),5)**2
+        GOTO 300
+      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 260
+        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 260
+        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 260
+        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 260
+        KFLB=1+INT(MSTJ(45)*RLU(0))
+        PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5)
+        IF(PMQ.GE.1.) GOTO 260
+        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 260
+        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 260
+        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 260
+        IF(ALFM/LOG(V(IEP(1),5)*Z*(1.-Z)/ALAMS).LT.RLU(0)) GOTO 260
+      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
+        PMQTH3=0.5*PARJ(82)
+        IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83)
+        PMQ1=(PMTH(1,KFLGD1)**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 260
+      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...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
+        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 260
+
+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
+  290   IF(K(IAOM,5).EQ.22) THEN
+          IAOM=K(IAOM,3)
+          IF(K(IAOM,3).LE.NS) MAOM=0
+          IF(MAOM.EQ.1) GOTO 290
+        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 260
+        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 260
+        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 260
+        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 260
+        ENDIF
+      ENDIF
+
+C...End of inner veto algorithm. Check if only one leg evolved so far.
+  300 V(IEP(1),1)=Z
+      ISL(1)=0
+      ISL(2)=0
+      IF(NEP.EQ.1) GOTO 330
+      IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 200
+      DO 310 I=1,NEP
+      IF(ITRY(I).EQ.0.AND.KFLD(I).LE.40) THEN
+        IF(KSH(KFLD(I)).EQ.1) THEN
+          IF(P(N+I,5).GE.PMTH(2,KFLD(I))) GOTO 200
+        ENDIF
+      ENDIF
+  310 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 200
+      ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN
+        DO 320 I1=N+1,N+2
+        KFLDA=IABS(K(I1,2))
+        IF(KFLDA.GT.40) GOTO 320
+        IF(KSH(KFLDA).EQ.0) GOTO 320
+        IF(P(I1,5).LT.PMTH(2,KFLDA)) GOTO 320
+        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)
+          PMQ1=(PMTH(1,KFLGD1)**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))
+  320   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 200
+      ENDIF
+      IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE.
+     &PMTH(2,KFLD(1)).OR.P(N+2,5).GE.PMTH(2,KFLD(2)))) 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 200
+      ENDIF
+
+C...Accepted branch. Construct four-momentum for initial partons.
+  330 MAZIP=0
+      MAZIC=0
+      IF(NEP.EQ.1) THEN
+        P(N+1,1)=0.
+        P(N+1,2)=0.
+        P(N+1,3)=SQRT(MAX(0.,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)-
+     &  P(N+1,5))))
+        P(N+1,4)=P(IPA(1),4)
+        V(N+1,2)=P(N+1,4)
+      ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN
+        PED1=0.5*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5)
+        P(N+1,1)=0.
+        P(N+1,2)=0.
+        P(N+1,3)=SQRT(MAX(0.,(PED1+P(N+1,5))*(PED1-P(N+1,5))))
+        P(N+1,4)=PED1
+        P(N+2,1)=0.
+        P(N+2,2)=0.
+        P(N+2,3)=-P(N+1,3)
+        P(N+2,4)=P(IM,5)-PED1
+        V(N+1,2)=P(N+1,4)
+        V(N+2,2)=P(N+2,4)
+      ELSEIF(NEP.EQ.3) THEN
+        P(N+1,1)=0.
+        P(N+1,2)=0.
+        P(N+1,3)=SQRT(MAX(0.,PA1S))
+        P(N+2,1)=SQRT(PTS)
+        P(N+2,2)=0.
+        P(N+2,3)=0.5*(PA3S-PA2S-PA1S)/P(N+1,3)
+        P(N+3,1)=-P(N+2,1)
+        P(N+3,2)=0.
+        P(N+3,3)=-(P(N+1,3)+P(N+2,3))
+        V(N+1,2)=P(N+1,4)
+        V(N+2,2)=P(N+2,4)
+        V(N+3,2)=P(N+3,4)
+
+C...Construct transverse momentum for ordinary branching in shower.
+      ELSE
+        ZM=V(IM,1)
+        PZM=SQRT(MAX(0.,(PEM+P(IM,5))*(PEM-P(IM,5))))
+        PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4.*V(N+1,5)*V(N+2,5)
+        IF(PZM.LE.0.) THEN
+          PTS=0.
+        ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN
+          PTS=(PEM**2*(ZM*(1.-ZM)*V(IM,5)-(1.-ZM)*V(N+1,5)-
+     &    ZM*V(N+2,5))-0.25*PMLS)/PZM**2
+        ELSE
+          PTS=PMLS*(ZM*(1.-ZM)*PEM**2/V(IM,5)-0.25)/PZM**2
+        ENDIF
+        PT=SQRT(MAX(0.,PTS))
+
+C...Find coefficient of azimuthal asymmetry due to gluon polarization.
+        HAZIP=0.
+        IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21.
+     &  AND.IAU.NE.0) THEN
+          IF(K(IGM,3).NE.0) MAZIP=1
+          ZAU=V(IGM,1)
+          IF(IAU.EQ.IM+1) ZAU=1.-V(IGM,1)
+          IF(MAZIP.EQ.0) ZAU=0.
+          IF(K(IGM,2).NE.21) THEN
+            HAZIP=2.*ZAU/(1.+ZAU**2)
+          ELSE
+            HAZIP=(ZAU/(1.-ZAU*(1.-ZAU)))**2
+          ENDIF
+          IF(K(N+1,2).NE.21) THEN
+            HAZIP=HAZIP*(-2.*ZM*(1.-ZM))/(1.-2.*ZM*(1.-ZM))
+          ELSE
+            HAZIP=HAZIP*(ZM*(1.-ZM)/(1.-ZM*(1.-ZM)))**2
+          ENDIF
+        ENDIF
+
+C...Find coefficient of azimuthal asymmetry due to soft gluon
+C...interference.
+        HAZIC=0.
+        IF(MSTJ(49).NE.2.AND.MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR.
+     &  K(N+2,2).EQ.21).AND.IAU.NE.0) THEN
+          IF(K(IGM,3).NE.0) MAZIC=N+1
+          IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2
+          IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND.
+     &    ZM.GT.0.5) MAZIC=N+2
+          IF(K(IAU,2).EQ.22) MAZIC=0
+          ZS=ZM
+          IF(MAZIC.EQ.N+2) ZS=1.-ZM
+          ZGM=V(IGM,1)
+          IF(IAU.EQ.IM-1) ZGM=1.-V(IGM,1)
+          IF(MAZIC.EQ.0) ZGM=1.
+          HAZIC=(P(IM,5)/P(IGM,5))*SQRT((1.-ZS)*(1.-ZGM)/(ZS*ZGM))
+          HAZIC=MIN(0.95,HAZIC)
+        ENDIF
+      ENDIF
+
+C...Construct kinematics for ordinary branching in shower.
+  340 IF(NEP.EQ.2.AND.IGM.GT.0) THEN
+        IF(MOD(MSTJ(43),2).EQ.1) THEN
+          P(N+1,4)=PEM*V(IM,1)
+        ELSE
+          P(N+1,4)=PEM*(0.5*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+
+     &    SQRT(PMLS)*ZM)/V(IM,5)
+        ENDIF
+        PHI=PARU(2)*RLU(0)
+        P(N+1,1)=PT*COS(PHI)
+        P(N+1,2)=PT*SIN(PHI)
+        IF(PZM.GT.0.) THEN
+          P(N+1,3)=0.5*(V(N+2,5)-V(N+1,5)-V(IM,5)+2.*PEM*P(N+1,4))/PZM
+        ELSE
+          P(N+1,3)=0.
+        ENDIF
+        P(N+2,1)=-P(N+1,1)
+        P(N+2,2)=-P(N+1,2)
+        P(N+2,3)=PZM-P(N+1,3)
+        P(N+2,4)=PEM-P(N+1,4)
+        IF(MSTJ(43).LE.2) THEN
+          V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5)
+          V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5)
+        ENDIF
+      ENDIF
+
+C...Rotate and boost daughters.
+      IF(IGM.GT.0) THEN
+        IF(MSTJ(43).LE.2) THEN
+          BEX=P(IGM,1)/P(IGM,4)
+          BEY=P(IGM,2)/P(IGM,4)
+          BEZ=P(IGM,3)/P(IGM,4)
+          GA=P(IGM,4)/P(IGM,5)
+          GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1.+GA)-
+     &    P(IM,4))
+        ELSE
+          BEX=0.
+          BEY=0.
+          BEZ=0.
+          GA=1.
+          GABEP=0.
+        ENDIF
+        THE=ULANGL(P(IM,3)+GABEP*BEZ,SQRT((P(IM,1)+GABEP*BEX)**2+
+     &  (P(IM,2)+GABEP*BEY)**2))
+        PHI=ULANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY)
+        DO 350 I=N+1,N+2
+        DP(1)=COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+
+     &  SIN(THE)*COS(PHI)*P(I,3)
+        DP(2)=COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+
+     &  SIN(THE)*SIN(PHI)*P(I,3)
+        DP(3)=-SIN(THE)*P(I,1)+COS(THE)*P(I,3)
+        DP(4)=P(I,4)
+        DBP=BEX*DP(1)+BEY*DP(2)+BEZ*DP(3)
+        DGABP=GA*(GA*DBP/(1D0+GA)+DP(4))
+        P(I,1)=DP(1)+DGABP*BEX
+        P(I,2)=DP(2)+DGABP*BEY
+        P(I,3)=DP(3)+DGABP*BEZ
+  350   P(I,4)=GA*(DP(4)+DBP)
+      ENDIF
+
+C...Weight with azimuthal distribution, if required.
+      IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN
+        DO 360 J=1,3
+        DPT(1,J)=P(IM,J)
+        DPT(2,J)=P(IAU,J)
+  360   DPT(3,J)=P(N+1,J)
+        DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3)
+        DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3)
+        DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2
+        DO 370 J=1,3
+        DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/DPMM
+  370   DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/DPMM
+        DPT(4,4)=SQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2)
+        DPT(5,4)=SQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2)
+        IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1*PARJ(82)) THEN
+          CAD=(DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+
+     &    DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4))
+          IF(MAZIP.NE.0) THEN
+            IF(1.+HAZIP*(2.*CAD**2-1.).LT.RLU(0)*(1.+ABS(HAZIP)))
+     &      GOTO 340
+          ENDIF
+          IF(MAZIC.NE.0) THEN
+            IF(MAZIC.EQ.N+2) CAD=-CAD
+            IF((1.-HAZIC)*(1.-HAZIC*CAD)/(1.+HAZIC**2-2.*HAZIC*CAD).
+     &      LT.RLU(0)) GOTO 340
+          ENDIF
+        ENDIF
+      ENDIF
+
+C...Continue loop over partons that may branch, until none left.
+      IF(IGM.GE.0) K(IM,1)=14
+      N=N+NEP
+      NEP=2
+      IF(N.GT.MSTU(4)-MSTU(32)-5) THEN
+        CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')
+        IF(MSTU(21).GE.1) N=NS
+        IF(MSTU(21).GE.1) RETURN
+      ENDIF
+      GOTO 140
+
+C...Set information on imagined shower initiator.
+  380 IF(NPA.GE.2) THEN
+        K(NS+1,1)=11
+        K(NS+1,2)=94
+        K(NS+1,3)=IP1
+        IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2
+        K(NS+1,4)=NS+2
+        K(NS+1,5)=NS+1+NPA
+        IIM=1
+      ELSE
+        IIM=0
+      ENDIF
+
+C...Reconstruct string drawing information.
+      DO 390 I=NS+1+IIM,N
+      IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN
+        K(I,1)=1
+      ELSEIF(K(I,1).LE.10.AND.IABS(K(I,2)).GE.11.AND.
+     &IABS(K(I,2)).LE.18) THEN
+        K(I,1)=1
+      ELSEIF(K(I,1).LE.10) THEN
+        K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))
+        K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))
+      ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN
+        ID1=MOD(K(I,4),MSTU(5))
+        IF(K(I,2).GE.1.AND.K(I,2).LE.8) ID1=MOD(K(I,4),MSTU(5))+1
+        ID2=2*MOD(K(I,4),MSTU(5))+1-ID1
+        K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1
+        K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2
+        K(ID1,4)=K(ID1,4)+MSTU(5)*I
+        K(ID1,5)=K(ID1,5)+MSTU(5)*ID2
+        K(ID2,4)=K(ID2,4)+MSTU(5)*ID1
+        K(ID2,5)=K(ID2,5)+MSTU(5)*I
+      ELSE
+        ID1=MOD(K(I,4),MSTU(5))
+        ID2=ID1+1
+        K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1
+        K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1
+        K(ID1,4)=K(ID1,4)+MSTU(5)*I
+        K(ID1,5)=K(ID1,5)+MSTU(5)*I
+        K(ID2,4)=0
+        K(ID2,5)=0
+      ENDIF
+  390 CONTINUE
+
+C...Transformation from CM frame.
+      IF(NPA.GE.2) THEN
+        BEX=PS(1)/PS(4)
+        BEY=PS(2)/PS(4)
+        BEZ=PS(3)/PS(4)
+        GA=PS(4)/PS(5)
+        GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3))
+     &  /(1.+GA)-P(IPA(1),4))
+      ELSE
+        BEX=0.
+        BEY=0.
+        BEZ=0.
+        GABEP=0.
+      ENDIF
+      THE=ULANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1)
+     &+GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2))
+      PHI=ULANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY)
+      IF(NPA.EQ.3) THEN
+        CHI=ULANGL(COS(THE)*COS(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(THE)*
+     &  SIN(PHI)*(P(IPA(2),2)+GABEP*BEY)-SIN(THE)*(P(IPA(2),3)+GABEP*
+     &  BEZ),-SIN(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(PHI)*(P(IPA(2),2)+
+     &  GABEP*BEY))
+        MSTU(33)=1
+        CALL LUDBRB(NS+1,N,0.,CHI,0D0,0D0,0D0)
+      ENDIF
+      DBEX=DBLE(BEX)
+      DBEY=DBLE(BEY)
+      DBEZ=DBLE(BEZ)
+      MSTU(33)=1
+      CALL LUDBRB(NS+1,N,THE,PHI,DBEX,DBEY,DBEZ)
+
+C...Decay vertex of shower.
+      DO 400 I=NS+1,N
+      DO 400 J=1,5
+  400 V(I,J)=V(IP1,J)
+
+C...Delete trivial shower, else connect initiators.
+      IF(N.EQ.NS+NPA+IIM) THEN
+        N=NS
+      ELSE
+        DO 410 IP=1,NPA
+        K(IPA(IP),1)=14
+        K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP
+        K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP
+        K(NS+IIM+IP,3)=IPA(IP)
+        IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1
+        K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4)
+  410   K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5)
+      ENDIF
+
+      RETURN
+      END
+
+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(150000,5),P(150000,5),V(150000,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
+  100 DPS(J)=0.
+      DO 120 I=1,N
+      IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120
+      DO 110 J=1,4
+  110 DPS(J)=DPS(J)+P(I,J)
+  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
+  130 IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4)
+
+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
+  140 P(NBE(IBE),J)=0.
+  150 CONTINUE
+  160 CONTINUE
+
+C...Tabulate integral for subsequent momentum shift.
+      DO 210 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
+  170 IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1)
+
+C...Loop through particle pairs and find old relative momentum.
+  180 DO 200 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.0.5*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
+  190 P(I2M,J)=P(I2M,J)-PD
+  200 CONTINUE
+  210 CONTINUE
+
+C...Shift momenta and recalculate energies.
+      DO 230 IM=NBE(0)+1,NBE(MIN(9,MSTJ(52)))
+      I=K(IM,1)
+      DO 220 J=1,3
+  220 P(I,J)=P(I,J)+P(IM,J)
+  230 P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
+
+C...Rescale all momenta for energy conservation.
+      PES=0.
+      PQS=0.
+      DO 240 I=1,N
+      IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 240
+      PES=PES+P(I,4)
+      PQS=PQS+P(I,5)**2/P(I,4)
+  240 CONTINUE
+      FAC=(PECM-PQS)/(PES-PQS)
+      DO 260 I=1,N
+      IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 260
+      DO 250 J=1,3
+  250 P(I,J)=FAC*P(I,J)
+      P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
+  260 CONTINUE
+
+C...Boost back to correct reference frame.
+      CALL LUDBRB(0,0,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4))
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      FUNCTION ULMASS(KF)
+
+C...Purpose: to give the mass of a particle/parton.
+      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...Reset variables. Compressed code.
+      ULMASS=0.
+      KFA=IABS(KF)
+      KC=LUCOMP(KF)
+      IF(KC.EQ.0) RETURN
+      PARF(106)=PMAS(6,1)
+      PARF(107)=PMAS(7,1)
+      PARF(108)=PMAS(8,1)
+
+C...Guarantee use of constituent masses for internal checks.
+      IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND.KFA.LE.10) THEN
+        ULMASS=PARF(100+KFA)
+        IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(121))
+
+C...Masses that can be read directly off table.
+      ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN
+        ULMASS=PMAS(KC,1)
+
+C...Find constituent partons and their masses.
+      ELSE
+        KFLA=MOD(KFA/1000,10)
+        KFLB=MOD(KFA/100,10)
+        KFLC=MOD(KFA/10,10)
+        KFLS=MOD(KFA,10)
+        KFLR=MOD(KFA/10000,10)
+        PMA=PARF(100+KFLA)
+        PMB=PARF(100+KFLB)
+        PMC=PARF(100+KFLC)
+
+C...Construct masses for various meson, diquark and baryon cases.
+        IF(KFLA.EQ.0.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN
+          IF(KFLS.EQ.1) PMSPL=-3./(PMB*PMC)
+          IF(KFLS.GE.3) PMSPL=1./(PMB*PMC)
+          ULMASS=PARF(111)+PMB+PMC+PARF(113)*PARF(101)**2*PMSPL
+        ELSEIF(KFLA.EQ.0) THEN
+          KMUL=2
+          IF(KFLS.EQ.1) KMUL=3
+          IF(KFLR.EQ.2) KMUL=4
+          IF(KFLS.EQ.5) KMUL=5
+          ULMASS=PARF(113+KMUL)+PMB+PMC
+        ELSEIF(KFLC.EQ.0) THEN
+          IF(KFLS.EQ.1) PMSPL=-3./(PMA*PMB)
+          IF(KFLS.EQ.3) PMSPL=1./(PMA*PMB)
+          ULMASS=2.*PARF(112)/3.+PMA+PMB+PARF(114)*PARF(101)**2*PMSPL
+          IF(MSTJ(93).EQ.1) ULMASS=PMA+PMB
+          IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(122)-
+     &    2.*PARF(112)/3.)
+        ELSE
+          IF(KFLS.EQ.2.AND.KFLA.EQ.KFLB) THEN
+            PMSPL=1./(PMA*PMB)-2./(PMA*PMC)-2./(PMB*PMC)
+          ELSEIF(KFLS.EQ.2.AND.KFLB.GE.KFLC) THEN
+            PMSPL=-2./(PMA*PMB)-2./(PMA*PMC)+1./(PMB*PMC)
+          ELSEIF(KFLS.EQ.2) THEN
+            PMSPL=-3./(PMB*PMC)
+          ELSE
+            PMSPL=1./(PMA*PMB)+1./(PMA*PMC)+1./(PMB*PMC)
+          ENDIF
+          ULMASS=PARF(112)+PMA+PMB+PMC+PARF(114)*PARF(101)**2*PMSPL
+        ENDIF
+      ENDIF
+
+C...Optional mass broadening according to truncated Breit-Wigner
+C...(either in m or in m^2).
+      IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1E-4) THEN
+        IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN
+          ULMASS=ULMASS+0.5*PMAS(KC,2)*TAN((2.*RLU(0)-1.)*
+     &    ATAN(2.*PMAS(KC,3)/PMAS(KC,2)))
+        ELSE
+          PM0=ULMASS
+          PMLOW=ATAN((MAX(0.,PM0-PMAS(KC,3))**2-PM0**2)/
+     &    (PM0*PMAS(KC,2)))
+          PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2)))
+          ULMASS=SQRT(MAX(0.,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+
+     &    (PMUPP-PMLOW)*RLU(0))))
+        ENDIF
+      ENDIF
+      MSTJ(93)=0
+
+      RETURN
+      END
+
+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
+  100   IF(CHAU(LEM:LEM).NE.' ') LEN=LEM
+
+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.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
+
+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
+
+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/
+
+C...Subdivide KF code into constituent pieces.
+      LUCOMP=0
+      KFA=IABS(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...Simple cases: direct translation or special codes.
+      IF(KFA.EQ.0.OR.KFA.GE.100000) THEN
+      ELSEIF(KFA.LE.100) THEN
+        LUCOMP=KFA
+        IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) LUCOMP=0
+      ELSEIF(KFLS.EQ.0) THEN
+        IF(KF.EQ.130) LUCOMP=221
+        IF(KF.EQ.310) LUCOMP=222
+        IF(KFA.EQ.210) LUCOMP=281
+        IF(KFA.EQ.2110) LUCOMP=282
+        IF(KFA.EQ.2210) LUCOMP=283
+
+C...Mesons.
+      ELSEIF(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.AND.KFLC.LE.3) 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
+
+C*********************************************************************
+
+      SUBROUTINE LUERRM(MERR,CHMESS)
+
+C...Purpose: to inform user of errors in program execution.
+      COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,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
+
+C*********************************************************************
+
+      FUNCTION ULALEM(Q2)
+
+C...Purpose: to calculate the running alpha_electromagnetic.
+      COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+      SAVE /LUDAT1/
+
+C...Calculate real part of photon vacuum polarization.
+C...For leptons simplify by using asymptotic (Q^2 >> m^2) expressions.
+C...For hadrons use parametrization of H. Burkhardt et al.
+C...See R. Kleiss et al, CERN 89-08, vol. 3, pp. 129-131.
+      AEMPI=PARU(101)/(3.*PARU(1))
+      IF(MSTU(101).LE.0.OR.Q2.LT.2E-6) THEN
+        RPIGG=0.
+      ELSEIF(Q2.LT.0.09) THEN
+        RPIGG=AEMPI*(13.4916+LOG(Q2))+0.00835*LOG(1.+Q2)
+      ELSEIF(Q2.LT.9.) THEN
+        RPIGG=AEMPI*(16.3200+2.*LOG(Q2))+0.00238*LOG(1.+3.927*Q2)
+      ELSEIF(Q2.LT.1E4) THEN
+        RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00165+0.00299*LOG(1.+Q2)
+      ELSE
+        RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00221+0.00293*LOG(1.+Q2)
+      ENDIF
+
+C...Calculate running alpha_em.
+      ULALEM=PARU(101)/(1.-RPIGG)
+      PARU(108)=ULALEM
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      FUNCTION ULALPS(Q2)
+
+C...Purpose: to give the value of alpha_strong.
+      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...Constant alpha_strong trivial.
+      IF(MSTU(111).LE.0) THEN
+        ULALPS=PARU(111)
+        MSTU(118)=MSTU(112)
+        PARU(117)=0.
+        PARU(118)=PARU(111)
+        RETURN
+      ENDIF
+
+C...Find effective Q2, number of flavours and Lambda.
+      Q2EFF=Q2
+      IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114))
+      NF=MSTU(112)
+      ALAM2=PARU(112)**2
+  100 IF(NF.GT.MAX(2,MSTU(113))) THEN
+        Q2THR=PARU(113)*PMAS(NF,1)**2
+        IF(Q2EFF.LT.Q2THR) THEN
+          NF=NF-1
+          ALAM2=ALAM2*(Q2THR/ALAM2)**(2./(33.-2.*NF))
+          GOTO 100
+        ENDIF
+      ENDIF
+  110 IF(NF.LT.MIN(8,MSTU(114))) THEN
+        Q2THR=PARU(113)*PMAS(NF+1,1)**2
+        IF(Q2EFF.GT.Q2THR) THEN
+          NF=NF+1
+          ALAM2=ALAM2*(ALAM2/Q2THR)**(2./(33.-2.*NF))
+          GOTO 110
+        ENDIF
+      ENDIF
+      IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2
+      PARU(117)=SQRT(ALAM2)
+
+C...Evaluate first or second order alpha_strong.
+      B0=(33.-2.*NF)/6.
+      ALGQ=LOG(MAX(1.0001,Q2EFF/ALAM2))
+      IF(MSTU(111).EQ.1) THEN
+        ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ))
+      ELSE
+        B1=(153.-19.*NF)/6.
+        ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1.-B1*LOG(ALGQ)/
+     &  (B0**2*ALGQ)))
+      ENDIF
+      MSTU(118)=NF
+      PARU(118)=ULALPS
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      FUNCTION ULANGL(X,Y)
+
+C...Purpose: to reconstruct an angle from given x and y coordinates.
+      COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+      SAVE /LUDAT1/
+
+      ULANGL=0.
+      R=SQRT(X**2+Y**2)
+      IF(R.LT.1E-20) RETURN
+      IF(ABS(X)/R.LT.0.8) THEN
+        ULANGL=SIGN(ACOS(X/R),Y)
+      ELSE
+        ULANGL=ASIN(Y/R)
+        IF(X.LT.0..AND.ULANGL.GE.0.) THEN
+          ULANGL=PARU(1)-ULANGL
+        ELSEIF(X.LT.0.) THEN
+          ULANGL=-PARU(1)-ULANGL
+        ENDIF
+      ENDIF
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      FUNCTION RLU(IDUM)
+
+C...Purpose: to generate random numbers uniformly distributed between
+C...0 and 1, excluding the endpoints.
+      COMMON/LUDATR/MRLU(6),RRLU(100)
+      SAVE /LUDATR/
+      EQUIVALENCE (MRLU1,MRLU(1)),(MRLU2,MRLU(2)),(MRLU3,MRLU(3)),
+     &(MRLU4,MRLU(4)),(MRLU5,MRLU(5)),(MRLU6,MRLU(6)),
+     &(RRLU98,RRLU(98)),(RRLU99,RRLU(99)),(RRLU00,RRLU(100))
+
+C...Initialize generation from given seed.
+      IF(MRLU2.EQ.0) THEN
+        IJ=MOD(MRLU1/30082,31329)
+        KL=MOD(MRLU1,30082)
+        I=MOD(IJ/177,177)+2
+        J=MOD(IJ,177)+2
+        K=MOD(KL/169,178)+1
+        L=MOD(KL,169)
+        DO 110 II=1,97
+        S=0.
+        T=0.5
+        DO 100 JJ=1,24
+        M=MOD(MOD(I*J,179)*K,179)
+        I=J
+        J=K
+        K=M
+        L=MOD(53*L+1,169)
+        IF(MOD(L*M,64).GE.32) S=S+T
+  100   T=0.5*T
+  110   RRLU(II)=S
+        TWOM24=1.
+        DO 120 I24=1,24
+  120   TWOM24=0.5*TWOM24
+        RRLU98=362436.*TWOM24
+        RRLU99=7654321.*TWOM24
+        RRLU00=16777213.*TWOM24
+        MRLU2=1
+        MRLU3=0
+        MRLU4=97
+        MRLU5=33
+      ENDIF
+
+C...Generate next random number.
+  130 RUNI=RRLU(MRLU4)-RRLU(MRLU5)
+      IF(RUNI.LT.0.) RUNI=RUNI+1.
+      RRLU(MRLU4)=RUNI
+      MRLU4=MRLU4-1
+      IF(MRLU4.EQ.0) MRLU4=97
+      MRLU5=MRLU5-1
+      IF(MRLU5.EQ.0) MRLU5=97
+      RRLU98=RRLU98-RRLU99
+      IF(RRLU98.LT.0.) RRLU98=RRLU98+RRLU00
+      RUNI=RUNI-RRLU98
+      IF(RUNI.LT.0.) RUNI=RUNI+1.
+      IF(RUNI.LE.0.OR.RUNI.GE.1.) GOTO 130
+
+C...Update counters. Random number to output.
+      MRLU3=MRLU3+1
+      IF(MRLU3.EQ.1000000000) THEN
+        MRLU2=MRLU2+1
+        MRLU3=0
+      ENDIF
+      RLU=RUNI
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      SUBROUTINE RLUGET(LFN,MOVE)
+
+C...Purpose: to dump the state of the random number generator on a file
+C...for subsequent startup from this state onwards.
+      COMMON/LUDATR/MRLU(6),RRLU(100)
+      SAVE /LUDATR/
+      CHARACTER CHERR*8
+
+C...Backspace required number of records (or as many as there are).
+      IF(MOVE.LT.0) THEN
+        NBCK=MIN(MRLU(6),-MOVE)
+        DO 100 IBCK=1,NBCK
+  100   BACKSPACE(LFN,ERR=110,IOSTAT=IERR)
+        MRLU(6)=MRLU(6)-NBCK
+      ENDIF
+
+C...Unformatted write on unit LFN.
+      WRITE(LFN,ERR=110,IOSTAT=IERR) (MRLU(I1),I1=1,5),
+     &(RRLU(I2),I2=1,100)
+      MRLU(6)=MRLU(6)+1
+      RETURN
+
+C...Write error.
+  110 WRITE(CHERR,'(I8)') IERR
+      CALL LUERRM(18,'(RLUGET:) error when accessing file, IOSTAT ='//
+     &CHERR)
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      SUBROUTINE RLUSET(LFN,MOVE)
+
+C...Purpose: to read a state of the random number generator from a file
+C...for subsequent generation from this state onwards.
+      COMMON/LUDATR/MRLU(6),RRLU(100)
+      SAVE /LUDATR/
+      CHARACTER CHERR*8
+
+C...Backspace required number of records (or as many as there are).
+      IF(MOVE.LT.0) THEN
+        NBCK=MIN(MRLU(6),-MOVE)
+        DO 100 IBCK=1,NBCK
+  100   BACKSPACE(LFN,ERR=120,IOSTAT=IERR)
+        MRLU(6)=MRLU(6)-NBCK
+      ENDIF
+
+C...Unformatted read from unit LFN.
+      NFOR=1+MAX(0,MOVE)
+      DO 110 IFOR=1,NFOR
+  110 READ(LFN,ERR=120,IOSTAT=IERR) (MRLU(I1),I1=1,5),
+     &(RRLU(I2),I2=1,100)
+      MRLU(6)=MRLU(6)+NFOR
+      RETURN
+
+C...Write error.
+  120 WRITE(CHERR,'(I8)') IERR
+      CALL LUERRM(18,'(RLUSET:) error when accessing file, IOSTAT ='//
+     &CHERR)
+
+      RETURN
+      END
+
+C*********************************************************************
+
+      SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ)
+
+C...Purpose: to perform rotations and boosts.
+      IMPLICIT DOUBLE PRECISION(D)
+      COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,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 110
+
+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 100 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4))
+        DO 100 J=1,5
+  100   V(I,J)=0.
+        MSTU(33)=0
+      ENDIF
+
+C...Check range of rotation/boost.
+  110 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 140 I=IMIN,IMAX
+        IF(K(I,1).LE.0) GOTO 140
+        DO 120 J=1,3
+        PR(J)=P(I,J)
+  120   VR(J)=V(I,J)
+        DO 130 J=1,3
+        P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3)
+  130   V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3)
+  140   CONTINUE
+      ENDIF
+
+C...Boost, typically from rest to momentum/ene