--- /dev/null
+C*********************************************************************
+C*********************************************************************
+C* **
+C* Jul 2009 **
+C* **
+C* The Lund Monte Carlo **
+C* **
+C* PYTHIA version 6.4 **
+C* **
+C* Torbjorn Sjostrand **
+C* Department of Theoretical Physics **
+C* Lund University **
+C* Solvegatan 14A, S-223 62 Lund, Sweden **
+C* E-mail torbjorn@thep.lu.se **
+C* **
+C* SUSY and Technicolor parts by **
+C* Stephen Mrenna **
+C* Computing Division **
+C* Generators and Detector Simulation Group **
+C* Fermi National Accelerator Laboratory **
+C* MS 234, Batavia, IL 60510, USA **
+C* phone + 1 - 630 - 840 - 2556 **
+C* E-mail mrenna@fnal.gov **
+C* **
+C* New multiple interactions and more SUSY parts by **
+C* Peter Skands **
+C* Theoretical Physics Department **
+C* Fermi National Accelerator Laboratory **
+C* MS 106, Batavia, IL 60510, USA **
+C* and **
+C* CERN/PH, CH-1211 Geneva, Switzerland **
+C* phone +41 - 22 - 767 24 59 **
+C* E-mail skands@fnal.gov **
+C* **
+C* Several parts are written by Hans-Uno Bengtsson **
+C* PYSHOW is written together with Mats Bengtsson **
+C* PYMAEL is written by Emanuel Norrbin **
+C* advanced popcorn baryon production written by Patrik Eden **
+C* code for virtual photons mainly written by Christer Friberg **
+C* code for low-mass strings mainly written by Emanuel Norrbin **
+C* Bose-Einstein code mainly written by Leif Lonnblad **
+C* CTEQ parton distributions are by the CTEQ collaboration **
+C* GRV 94 parton distributions are by Glueck, Reya and Vogt **
+C* SaS photon parton distributions together with Gerhard Schuler **
+C* g + g and q + qbar -> t + tbar + H code by Zoltan Kunszt **
+C* MSSM Higgs mass calculation code by M. Carena, **
+C* J.R. Espinosa, M. Quiros and C.E.M. Wagner **
+C* UED implementation by M. Elkacimi, D. Goujdami, H. Przysiezniak **
+C* PYGAUS adapted from CERN library (K.S. Kolbig) **
+C* NRQCD/colour octet production of onium by S. Wolf **
+C* **
+C* The latest program version and documentation is found on WWW **
+C* http://www.thep.lu.se/~torbjorn/Pythia.html **
+C* **
+C* Copyright Torbjorn Sjostrand, Lund (and CERN) 2008 **
+C* **
+C*********************************************************************
+C*********************************************************************
+C *
+C List of subprograms in order of appearance, with main purpose *
+C (S = subroutine, F = function, B = block data) *
+C *
+C B PYDATA to contain all default values *
+C S PYCKBD to check that BLOCK DATA has been correctly loaded *
+C S PYTEST to test the proper functioning of the package *
+C S PYHEPC to convert between /PYJETS/ and /HEPEVT/ records *
+C *
+C S PYINIT to administer the initialization procedure *
+C S PYEVNT to administer the generation of an event *
+C S PYEVNW ditto, for new multiple interactions scenario *
+C S PYSTAT to print cross-section and other information *
+C S PYUPEV to administer the generation of an LHA hard process *
+C S PYUPIN to provide initialization needed for LHA input *
+C S PYLHEF to produce a Les Houches Event File from run *
+C S PYINRE to initialize treatment of resonances *
+C S PYINBM to read in beam, target and frame choices *
+C S PYINKI to initialize kinematics of incoming particles *
+C S PYINPR to set up the selection of included processes *
+C S PYXTOT to give total, elastic and diffractive cross-sect. *
+C S PYMAXI to find differential cross-section maxima *
+C S PYPILE to select multiplicity of pileup events *
+C S PYSAVE to save alternatives for gamma-p and gamma-gamma *
+C S PYGAGA to handle lepton -> lepton + gamma branchings *
+C S PYRAND to select subprocess and kinematics for event *
+C S PYSCAT to set up kinematics and colour flow of event *
+C S PYEVOL handler for pT-ordered ISR and multiple interactions *
+C S PYSSPA to simulate initial state spacelike showers *
+C S PYPTIS to do pT-ordered initial state spacelike showers *
+C S PYMEMX auxiliary to PYSSPA/PYPTIS for ME correction maximum *
+C S PYMEWT auxiliary to PYSSPA/.. for matrix element correction *
+C S PYPTMI to do pT-ordered multiple interactions *
+C F PYFCMP to give companion quark x*f distribution *
+C F PYPCMP to calculate momentum integral for companion quarks *
+C S PYUPRE to rearranges contents of the HEPEUP commonblock *
+C S PYADSH to administrate sequential final-state showers *
+C S PYVETO to allow the generation of an event to be aborted *
+C S PYRESD to perform resonance decays *
+C S PYMULT to generate multiple interactions - old scheme *
+C S PYREMN to add on target remnants - old scheme *
+C S PYMIGN to generate multiple interactions - new scheme *
+C S PYMIHK to connect colours in mult. int. - new scheme *
+C S PYCTTR to translate PYTHIA colour information to LHA1 tags *
+C S PYMIHG to collapse two pairs of LHA1 colour tags. *
+C S PYMIRM to add on target remnants in mult. int.- new scheme *
+C S PYFSCR to perform final state colour reconnections - -"- *
+C S PYDIFF to set up kinematics for diffractive events *
+C S PYDISG to set up kinematics, remnant and showers for DIS *
+C S PYDOCU to compute cross-sections and handle documentation *
+C S PYFRAM to perform boosts between different frames *
+C S PYWIDT to calculate full and partial widths of resonances *
+C S PYOFSH to calculate partial width into off-shell channels *
+C S PYRECO to handle colour reconnection in W+W- events *
+C S PYKLIM to calculate borders of allowed kinematical region *
+C S PYKMAP to construct value of kinematical variable *
+C S PYSIGH to calculate differential cross-sections *
+C S PYSGQC auxiliary to PYSIGH for QCD processes *
+C S PYSGHF auxiliary to PYSIGH for heavy flavour processes *
+C S PYSGWZ auxiliary to PYSIGH for W and Z processes *
+C S PYSGHG auxiliary to PYSIGH for Higgs processes *
+C S PYSGSU auxiliary to PYSIGH for supersymmetry processes *
+C S PYSGTC auxiliary to PYSIGH for technicolor processes *
+C S PYSGEX auxiliary to PYSIGH for various exotic processes *
+C S PYPDFU to evaluate parton distributions *
+C S PYPDFL to evaluate parton distributions at low x and Q^2 *
+C S PYPDEL to evaluate electron parton distributions *
+C S PYPDGA to evaluate photon parton distributions (generic) *
+C S PYGGAM to evaluate photon parton distributions (SaS sets) *
+C S PYGVMD to evaluate VMD part of photon parton distributions *
+C S PYGANO to evaluate anomalous part of photon PDFs *
+C S PYGBEH to evaluate Bethe-Heitler part of photon PDFs *
+C S PYGDIR to evaluate direct contribution to photon PDFs *
+C S PYPDPI to evaluate pion parton distributions *
+C S PYPDPR to evaluate proton parton distributions *
+C F PYCTEQ to evaluate the CTEQ 3 proton parton distributions *
+C S PYGRVL to evaluate the GRV 94L proton parton distributions *
+C S PYGRVM to evaluate the GRV 94M proton parton distributions *
+C S PYGRVD to evaluate the GRV 94D proton parton distributions *
+C F PYGRVV auxiliary to the PYGRV* routines *
+C F PYGRVW auxiliary to the PYGRV* routines *
+C F PYGRVS auxiliary to the PYGRV* routines *
+C F PYCT5L to evaluate the CTEQ 5L proton parton distributions *
+C F PYCT5M to evaluate the CTEQ 5M1 proton parton distributions *
+C S PYPDPO to evaluate old proton parton distributions *
+C F PYHFTH to evaluate threshold factor for heavy flavour *
+C S PYSPLI to find flavours left in hadron when one removed *
+C F PYGAMM to evaluate ordinary Gamma function Gamma(x) *
+C S PYWAUX to evaluate auxiliary functions W1(s) and W2(s) *
+C S PYI3AU to evaluate auxiliary function I3(s,t,u,v) *
+C F PYSPEN to evaluate Spence (dilogarithm) function Sp(x) *
+C S PYQQBH to evaluate matrix element for g + g -> Q + Qbar + H *
+C S PYSTBH to evaluate matrix element for t + b + H processes *
+C S PYTBHB auxiliary to PYSTBH *
+C S PYTBHG auxiliary to PYSTBH *
+C S PYTBHQ auxiliary to PYSTBH *
+C F PYTBHS auxiliary to PYSTBH *
+C *
+C S PYMSIN to initialize the supersymmetry simulation *
+C S PYSLHA to interface to SUSY spectrum and decay calculators *
+C S PYAPPS to determine MSSM parameters from SUGRA input *
+C S PYSUGI to determine MSSM parameters using ISASUSY *
+C S PYFEYN to determine MSSM Higgs parameters using FEYNHIGGS *
+C F PYRNMQ to determine running squark masses *
+C S PYTHRG to calculate sfermion third-gen. mass eigenstates *
+C S PYINOM to calculate neutralino/chargino mass eigenstates *
+C F PYRNM3 to determine running M3, gluino mass *
+C S PYEIG4 to calculate eigenvalues and -vectors in 4*4 matrix *
+C S PYHGGM to determine Higgs mass spectrum *
+C S PYSUBH to determine Higgs masses in the MSSM *
+C S PYPOLE to determine Higgs masses in the MSSM *
+C S PYRGHM auxiliary to PYPOLE *
+C S PYGFXX auxiliary to PYRGHM *
+C F PYFINT auxiliary to PYPOLE *
+C F PYFISB auxiliary to PYFINT *
+C S PYSFDC to calculate sfermion decay partial widths *
+C S PYGLUI to calculate gluino decay partial widths *
+C S PYTBBN to calculate 3-body decay of gluino to neutralino *
+C S PYTBBC to calculate 3-body decay of gluino to chargino *
+C S PYNJDC to calculate neutralino decay partial widths *
+C S PYCJDC to calculate chargino decay partial widths *
+C F PYXXZ6 auxiliary for ino 3-body decays *
+C F PYXXGA auxiliary for ino -> ino + gamma decay *
+C F PYX2XG auxiliary for ino -> ino + gauge boson decay *
+C F PYX2XH auxiliary for ino -> ino + Higgs decay *
+C S PYHEXT to calculate non-SM Higgs decay partial widths *
+C F PYH2XX auxiliary for H -> ino + ino decay *
+C F PYGAUS to perform Gaussian integration *
+C F PYGAU2 copy of PYGAUS to allow two-dimensional integration *
+C F PYSIMP to perform Simpson integration *
+C F PYLAMF to evaluate the lambda kinematics function *
+C S PYTBDY to perform 3-body decay of gauginos *
+C S PYTECM to calculate techni_rho/omega masses *
+C S PYXDIN to initialize Universal Extra Dimensions *
+C S PYUEDC to compute UED mass radiative corrections *
+C S PYXUED to compute UED cross sections *
+C S PYGRAM to generate UED G* (excited graviton) mass spectrum *
+C F PYGRAW to compute UED partial widths to G* *
+C F PYWDKK to compute UED differential partial widths to G* *
+C S PYEICG to calculate eigenvalues of a 4*4 complex matrix *
+C S PYCMQR auxiliary to PYEICG *
+C S PYCMQ2 auxiliary to PYEICG *
+C S PYCDIV auxiliary to PYCMQR *
+C S PYCSRT auxiliary to PYCMQR *
+C S PYTHAG auxiliary to PYCMQR *
+C S PYCBAL auxiliary to PYEICG *
+C S PYCBA2 auxiliary to PYEICG *
+C S PYCRTH auxiliary to PYEICG *
+C S PYLDCM auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 *
+C S PYBKSB auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 *
+C S PYWIDX to calculate decay widths from within PYWIDT *
+C S PYRVSF to calculate R-violating sfermion decay widths *
+C S PYRVNE to calculate R-violating neutralino decay widths *
+C S PYRVCH to calculate R-violating chargino decay widths *
+C S PYRVGL to calculate R-violating gluino decay widths *
+C F PYRVSB auxiliary to PYRVSF *
+C S PYRVGW to calculate R-Violating 3-body widths *
+C F PYRVI1 auxiliary to PYRVGW, to do PS integration for res. *
+C F PYRVI2 auxiliary to PYRVGW, to do PS integration for LR-int.*
+C F PYRVI3 auxiliary to PYRVGW, to do PS X integral for int. *
+C F PYRVG1 auxiliary to PYRVI1, general matrix element, res. *
+C F PYRVG2 auxiliary to PYRVI2, general matrix element, LR-int. *
+C F PYRVG3 auxiliary to PYRVI3, to do PS Y integral for int. *
+C F PYRVG4 auxiliary to PYRVG3, general matrix element, int. *
+C F PYRVR auxiliary to PYRVG1, Breit-Wigner *
+C F PYRVS auxiliary to PYRVG2 & PYRVG4 *
+C *
+C S PY1ENT to fill one entry (= parton or particle) *
+C S PY2ENT to fill two entries *
+C S PY3ENT to fill three entries *
+C S PY4ENT to fill four entries *
+C S PY2FRM to interface to generic two-fermion generator *
+C S PY4FRM to interface to generic four-fermion generator *
+C S PY6FRM to interface to generic six-fermion generator *
+C S PY4JET to generate a shower from a given 4-parton config *
+C S PY4JTW to evaluate the weight od a shower history for above *
+C S PY4JTS to set up the parton configuration for above *
+C S PYJOIN to connect entries with colour flow information *
+C S PYGIVE to fill (or query) commonblock variables *
+C S PYONOF to allow easy control of particle decay modes *
+C S PYTUNE to select a predefined 'tune' for min-bias and UE *
+C S PYEXEC to administrate fragmentation and decay chain *
+C S PYPREP to rearrange showered partons along strings *
+C S PYSTRF to do string fragmentation of jet system *
+C S PYJURF to find boost to string junction rest frame *
+C S PYINDF to do independent fragmentation of one or many jets *
+C S PYDECY to do the decay of a particle *
+C S PYDCYK to select parton and hadron flavours in decays *
+C S PYKFDI to select parton and hadron flavours in fragm *
+C S PYNMES to select number of popcorn mesons *
+C S PYKFIN to calculate falvour prod. ratios from input params. *
+C S PYPTDI to select transverse momenta in fragm *
+C S PYZDIS to select longitudinal scaling variable in fragm *
+C S PYSHOW to do m-ordered timelike parton shower evolution *
+C S PYPTFS to do pT-ordered timelike parton shower evolution *
+C F PYMAEL auxiliary to PYSHOW & PYPTFS: gluon emission ME's *
+C S PYBOEI to include Bose-Einstein effects (crudely) *
+C S PYBESQ auxiliary to PYBOEI *
+C F PYMASS to give the mass of a particle or parton *
+C F PYMRUN to give the running MSbar mass of a quark *
+C S PYNAME to give the name of a particle or parton *
+C F PYCHGE to give three times the electric charge *
+C F PYCOMP to compress standard KF flavour code to internal KC *
+C S PYERRM to write error messages and abort faulty run *
+C F PYALEM to give the alpha_electromagnetic value *
+C F PYALPS to give the alpha_strong value *
+C F PYANGL to give the angle from known x and y components *
+C F PYR to provide a random number generator *
+C S PYRGET to save the state of the random number generator *
+C S PYRSET to set the state of the random number generator *
+C S PYROBO to rotate and/or boost an event *
+C S PYEDIT to remove unwanted entries from record *
+C S PYLIST to list event record or particle data *
+C S PYLOGO to write a logo *
+C S PYUPDA to update particle data *
+C F PYK to provide integer-valued event information *
+C F PYP to provide real-valued event information *
+C S PYSPHE to perform sphericity analysis *
+C S PYTHRU to perform thrust analysis *
+C S PYCLUS to perform three-dimensional cluster analysis *
+C S PYCELL to perform cluster analysis in (eta, phi, E_T) *
+C S PYJMAS to give high and low jet mass of event *
+C S PYFOWO to give Fox-Wolfram moments *
+C S PYTABU to analyze events, with tabular output *
+C *
+C S PYEEVT to administrate the generation of an e+e- event *
+C S PYXTEE to give the total cross-section at given CM energy *
+C S PYRADK to generate initial state photon radiation *
+C S PYXKFL to select flavour of primary qqbar pair *
+C S PYXJET to select (matrix element) jet multiplicity *
+C S PYX3JT to select kinematics of three-jet event *
+C S PYX4JT to select kinematics of four-jet event *
+C S PYXDIF to select angular orientation of event *
+C S PYONIA to perform generation of onium decay to gluons *
+C *
+C S PYBOOK to book a histogram *
+C S PYFILL to fill an entry in a histogram *
+C S PYFACT to multiply histogram contents by a factor *
+C S PYOPER to perform operations between histograms *
+C S PYHIST to print and reset all histograms *
+C S PYPLOT to print a single histogram *
+C S PYNULL to reset contents of a single histogram *
+C S PYDUMP to dump histogram contents onto a file *
+C *
+C S PYSTOP routine to handle Fortran STOP condition *
+C *
+C S PYKCUT dummy routine for user kinematical cuts *
+C S PYEVWT dummy routine for weighting events *
+C S UPINIT dummy routine to initialize user processes *
+C S UPEVNT dummy routine to generate a user process event *
+C S UPVETO dummy routine to abort event at parton level *
+C S PDFSET dummy routine to be removed when using PDFLIB *
+C S STRUCTM dummy routine to be removed when using PDFLIB *
+C S STRUCTP dummy routine to be removed when using PDFLIB *
+C S SUGRA dummy routine to be removed when linking with ISAJET *
+C F VISAJE dummy functn. to be removed when linking with ISAJET *
+C S SSMSSM dummy routine to be removed when linking with ISAJET *
+C S FHSETFLAGS dummy routine -"- FEYNHIGGS *
+C S FHSETPARA dummy routine -"- FEYNHIGGS *
+C S FHHIGGSCORR dummy routine -"- FEYNHIGGS *
+C S PYTAUD dummy routine for interface to tau decay libraries *
+C S PYTIME dummy routine for giving date and time *
+C *
+C*********************************************************************
+
+C...PYDATA
+C...Default values for switches and parameters,
+C...and particle, decay and process data.
+
+ BLOCK DATA PYDATA
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+C...Commonblocks.
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
+ COMMON/PYDAT4/CHAF(500,2)
+ CHARACTER CHAF*16
+ COMMON/PYDATR/MRPY(6),RRPY(100)
+ COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
+ COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
+ COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
+ COMMON/PYINT4/MWID(500),WIDS(500,5)
+ COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
+ COMMON/PYINT6/PROC(0:500)
+ CHARACTER PROC*28
+ COMMON/PYINT7/SIGT(0:6,0:6,0:5)
+ COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
+ COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
+ &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2)
+ COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3)
+ COMMON/PYTCSM/ITCM(0:99),RTCM(0:99)
+ COMMON/PYPUED/IUED(0:99),RUED(0:99)
+ COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000)
+ COMMON/PYLH3P/MODSEL(200),PARMIN(100),PAREXT(200),RMSOFT(0:100),
+ & AU(3,3),AD(3,3),AE(3,3)
+ COMMON/PYLH3C/CPRO(2),CVER(2)
+ CHARACTER CPRO*12,CVER*12
+ SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/,/PYSUBS/,
+ &/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,
+ &/PYINT6/,/PYINT7/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYTCSM/,/PYPUED/,
+ &/PYBINS/,/PYLH3P/,/PYLH3C/
+
+C...PYDAT1, containing status codes and most parameters.
+ DATA MSTU/
+ & 0, 0, 0, 4000,10000, 500, 8000, 0, 0, 2,
+ 1 6, 0, 1, 0, 0, 1, 0, 0, 0, 0,
+ 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0,
+ 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0,
+ 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0,
+ 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 7 30*0,
+ 1 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 2 1, 5, 3, 5, 0, 0, 0, 0, 0, 0,
+ & 80*0/
+ DATA (PARU(I),I=1,100)/
+ & 3.141592653589793D0, 6.283185307179586D0,
+ & 0.197327D0, 5.06773D0, 0.389380D0, 2.56819D0, 4*0D0,
+ 1 0.001D0, 0.09D0, 0.01D0, 2D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 2 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 3 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 4 2.0D0, 1.0D0, 0.25D0, 2.5D0, 0.05D0,
+ 4 0D0, 0D0, 0.0001D0, 0D0, 0D0,
+ 5 2.5D0,1.5D0,7.0D0,1.0D0,0.5D0,2.0D0,3.2D0, 0D0, 0D0, 0D0,
+ 6 40*0D0/
+ DATA (PARU(I),I=101,200)/
+ & 0.00729735D0, 0.232D0, 0.007764D0, 1.0D0, 1.16639D-5,
+ & 0D0, 0D0, 0D0, 0D0, 0D0,
+ 1 0.20D0, 0.25D0, 1.0D0, 4.0D0, 10D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 2 -0.693D0, -1.0D0, 0.387D0, 1.0D0, -0.08D0,
+ 2 -1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0,
+ 3 1.0D0,-1.0D0, 1.0D0,-1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 4 5.0D0, 1.0D0, 1.0D0, 0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0,
+ 5 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 6 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 7 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0,
+ 8 1.0D0, 1.0D0, 1.0D0, 0.0D0, 0.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0,
+ 9 0D0, 0D0, 0D0, 0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0/
+ DATA MSTJ/
+ & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0,
+ 1 4, 2, 0, 1, 0, 2, 2, 20, 0, 0,
+ 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0,
+ 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 3,
+ 5 0, 3, 0, 2, 0, 0, 1, 0, 0, 0,
+ 6 40*0,
+ & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2,
+ 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0,
+ 2 80*0/
+ DATA PARJ/
+ & 0.10D0, 0.30D0, 0.40D0, 0.05D0, 0.50D0,
+ & 0.50D0, 0.50D0, 0.6D0, 1.2D0, 0.6D0,
+ 1 0.50D0,0.60D0,0.75D0, 0D0, 0D0, 0D0, 0D0, 1.0D0, 1.0D0, 0D0,
+ 2 0.36D0, 1.0D0,0.01D0, 2.0D0,1.0D0,0.4D0, 0D0, 0D0, 0D0, 0D0,
+ 3 0.10D0, 1.0D0, 0.8D0, 1.5D0,0D0,2.0D0,0.2D0, 0D0,0.08D0,1D0,
+ 4 0.3D0, 0.58D0, 0.5D0, 0.9D0,0.5D0,1.0D0,1.0D0,1.5D0,1D0,10D0,
+ 5 0.77D0, 0.77D0, 0.77D0, -0.05D0, -0.005D0,
+ 5 0D0, 0D0, 0D0, 1.0D0, 0D0,
+ 6 4.5D0, 0.7D0, 0D0,0.003D0, 0.5D0, 0.5D0, 0D0, 0D0, 0D0, 0D0,
+ 7 10D0, 1000D0, 100D0, 1000D0, 0D0, 0.7D0,10D0, 0D0,0D0,0.5D0,
+ 8 0.29D0, 1.0D0, 1.0D0, 0D0, 10D0, 10D0, 0D0, 0D0, 0D0,1D-4,
+ 9 0.02D0, 1.0D0, 0.2D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ & 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 1 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 2 1.0D0, 0.25D0,91.187D0,2.489D0, 0.01D0,
+ 2 2.0D0, 1.0D0, 0.25D0,0.002D0, 0D0,
+ 3 0D0, 0D0, 0D0, 0D0, 0.01D0, 0.99D0, 0D0, 0D0, 0.2D0, 0D0,
+ 4 10*0D0,
+ 5 10*0D0,
+ 6 10*0D0,
+ 7 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, -0.693D0,
+ 8 -1.0D0, 0.387D0, 1.0D0, -0.08D0, -1.0D0,
+ 8 1.0D0, 1.0D0, -0.693D0, -1.0D0, 0.387D0,
+ 9 1.0D0, -0.08D0, -1.0D0, 1.0D0, 1.0D0,
+ 9 5*0D0/
+
+C...PYDAT2, with particle data and flavour treatment parameters.
+ DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0,
+ &-3,0,-3,6*0,3,9*0,3,2*0,3,4*0,-1,41*0,2,-1,20*0,3*3,7*0,3*3,3*0,
+ &3*3,3*0,3*3,6*0,3*3,3*0,3*3,4*0,-2,-3,2*1,2*0,4,2*3,6,2*-2,2*-3,
+ &0,2*1,2*0,2*3,-2,2*-3,2*0,-3,2*1,2*0,3,0,2*4,2*3,2*6,3,2*1,2*0,
+ &2*3,2*0,4,2*3,2*6,2*3,6,2*-2,2*-3,0,-3,0,2*1,2*0,2*3,0,3,2*-2,
+ &2*-3,2*0,2*-3,0,2*1,2*0,2*3,2*0,2*3,-2,2*-3,2*0,2*-3,2*0,-3,2*0,
+ &2*3,4*0,2*3,2*0,2*3,2*0,2*3,4*0,2*3,2*0,2*3,3*0,3,2*0,3,0,3,0,3,
+ &2*0,3,0,3,3*0,-1,2,-1,2,-1,2,-3,0,-3,0,-3,4*0,3,2*0,3,0,-1,2,-1,
+ &2,-1,2,-3,0,-3,0,-3,2*0,3,3*0,3,8*0,-1,2,-3,6*0,3,2*6,0,3,4*0,3,
+ &7*0,3,
+C...UED singlet and doublet quarks, leptons, and KK g, gamma, Z, and W
+ &81*0,-1,2,-1,2,-1,2,-1,2,-1,2,-1,2,
+ &3*-3,0,-3,0,-3,0,-3,
+ &3*0,3,
+ &25*0/
+ DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,20*0,1,107*0,-1,0,2*-1,
+ &2*0,-1,3*0,2*-1,3*0,2*-1,4*0,-1,5*0,2*-1,4*0,2*-1,5*0,2*-1,6*0,
+ &-1,7*0,2*-1,5*0,2*-1,6*0,2*-1,7*0,2*-1,8*0,-1,56*0,6*1,6*0,2,7*0,
+ &6*1,9*0,2,3*0,2,0,5*2,2*1,17*0,6*2,
+ &83*0,12*1,9*0,2,3*0,25*0/
+ DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,3*0,
+ &2*1,39*0,1,0,2*1,20*0,3*1,4*0,6*1,3*0,9*1,3*0,12*1,4*0,100*1,2*0,
+ &2*1,2*0,4*1,2*0,6*1,2*0,8*1,3*0,1,0,2*1,0,3*1,0,4*1,3*0,12*1,3*0,
+ &1,2*0,1,0,12*1,0,1,3*0,1,8*0,4*1,5*0,3*1,0,1,3*0,2*1,7*0,1,
+ &81*0,21*1,3*0,1,25*0/
+ DATA (KCHG(I,4),I= 1, 290)/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,
+ &16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,
+ &37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,
+ &58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,
+ &79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,
+ &100,110,111,113,115,130,211,213,215,221,223,225,310,311,313,315,
+ &321,323,325,331,333,335,411,413,415,421,423,425,431,433,435,441,
+ &443,445,511,513,515,521,523,525,531,533,535,541,543,545,551,553,
+ &555,990,1103,1114,2101,2103,2112,2114,2203,2212,2214,2224,3101,
+ &3103,3112,3114,3122,3201,3203,3212,3214,3222,3224,3303,3312,3314,
+ &3322,3324,3334,4101,4103,4112,4114,4122,4132,4201,4203,4212,4214,
+ &4222,4224,4232,4301,4303,4312,4314,4322,4324,4332,4334,4403,4412,
+ &4414,4422,4424,4432,4434,4444,5101,5103,5112,5114,5122,5132,5142,
+ &5201,5203,5212,5214,5222,5224,5232,5242,5301,5303,5312,5314,5322,
+ &5324,5332,5334,5342,5401,5403,5412,5414,5422,5424,5432,5434,5442,
+ &5444,5503,5512,5514,5522,5524,5532,5534,5542,5544,5554,10111,
+ &10113,10211,10213,10221,10223,10311,10313,10321,10323,10331,
+ &10333,10411,10413,10421,10423,10431,10433,10441,10443,10511,
+ &10513,10521,10523,10531,10533,10541,10543,10551,10553,20113,
+ &20213,20223,20313,20323,20333,20413,20423,20433,20443,20513/
+ DATA (KCHG(I,4),I= 291, 500)/20523,20533,20543,20553,100443,
+ &100553,1000001,1000002,1000003,1000004,1000005,1000006,1000011,
+ &1000012,1000013,1000014,1000015,1000016,1000021,1000022,1000023,
+ &1000024,1000025,1000035,1000037,1000039,2000001,2000002,2000003,
+ &2000004,2000005,2000006,2000011,2000012,2000013,2000014,2000015,
+ &2000016,3000111,3000211,3000221,3000331,3000113,3000213,3000223,
+ &3100021,3100111,3200111,3100113,3200113,3300113,3400113,4000001,
+ &4000002,4000011,4000012,5000039,9900012,9900014,9900016,9900023,
+ &9900024,9900041,9900042,9900110,9900210,9900220,9900330,9900440,
+ &9902110,9902210,9900443,9900441,9910441,9900553,9900551,9910551,
+ &3000115,3000215,
+ &81*0,
+C...UED singlet and doublet quarks and leptons, and KK g, gamma, Z, and W.
+ &6100001,6100002,6100003,6100004,6100005,6100006,
+ &5100001,5100002,5100003,5100004,5100005,5100006,
+ &6100011,6100013,6100015,
+ &5100012,5100011,5100014,5100013,5100016,5100015,
+ &5100021,5100022,5100023,5100024,
+ &25*0/
+ DATA (PMAS(I,1),I= 1, 217)/2*0.33D0,0.5D0,1.5D0,4.8D0,175D0,
+ &2*400D0,2*0D0,0.00051D0,0D0,0.10566D0,0D0,1.777D0,0D0,400D0,
+ &5*0D0,91.188D0,80.45D0,115D0,6*0D0,500D0,900D0,500D0,3*300D0,
+ &3*0D0,5000D0,200D0,40*0D0,1D0,2D0,5D0,16*0D0,0.13498D0,0.7685D0,
+ &1.318D0,0.49767D0,0.13957D0,0.7669D0,1.318D0,0.54745D0,0.78194D0,
+ &1.275D0,2*0.49767D0,0.8961D0,1.432D0,0.4936D0,0.8916D0,1.425D0,
+ &0.95777D0,1.0194D0,1.525D0,1.8693D0,2.01D0,2.46D0,1.8645D0,
+ &2.0067D0,2.46D0,1.9685D0,2.1124D0,2.5735D0,2.9798D0,3.09688D0,
+ &3.5562D0,5.2792D0,5.3248D0,5.83D0,5.2789D0,5.3248D0,5.83D0,
+ &5.3693D0,5.4163D0,6.07D0,6.594D0,6.602D0,7.35D0,9.4D0,9.4603D0,
+ &9.9132D0,0D0,0.77133D0,1.234D0,0.57933D0,0.77133D0,0.93957D0,
+ &1.233D0,0.77133D0,0.93827D0,1.232D0,1.231D0,0.80473D0,0.92953D0,
+ &1.19744D0,1.3872D0,1.11568D0,0.80473D0,0.92953D0,1.19255D0,
+ &1.3837D0,1.18937D0,1.3828D0,1.09361D0,1.3213D0,1.535D0,1.3149D0,
+ &1.5318D0,1.67245D0,1.96908D0,2.00808D0,2.4521D0,2.5D0,2.2849D0,
+ &2.4703D0,1.96908D0,2.00808D0,2.4535D0,2.5D0,2.4529D0,2.5D0,
+ &2.4656D0,2.15432D0,2.17967D0,2.55D0,2.63D0,2.55D0,2.63D0,2.704D0,
+ &2.8D0,3.27531D0,3.59798D0,3.65648D0,3.59798D0,3.65648D0,
+ &3.78663D0,3.82466D0,4.91594D0,5.38897D0,5.40145D0,5.8D0,5.81D0,
+ &5.641D0,5.84D0,7.00575D0,5.38897D0,5.40145D0,5.8D0,5.81D0,5.8D0/
+ DATA (PMAS(I,1),I= 218, 500)/5.81D0,5.84D0,7.00575D0,5.56725D0,
+ &5.57536D0,5.96D0,5.97D0,5.96D0,5.97D0,6.12D0,6.13D0,7.19099D0,
+ &6.67143D0,6.67397D0,7.03724D0,7.0485D0,7.03724D0,7.0485D0,
+ &7.21101D0,7.219D0,8.30945D0,8.31325D0,10.07354D0,10.42272D0,
+ &10.44144D0,10.42272D0,10.44144D0,10.60209D0,10.61426D0,
+ &11.70767D0,11.71147D0,15.11061D0,0.9835D0,1.231D0,0.9835D0,
+ &1.231D0,1D0,1.17D0,1.429D0,1.29D0,1.429D0,1.29D0,2*1.4D0,2.272D0,
+ &2.424D0,2.272D0,2.424D0,2.5D0,2.536D0,3.4151D0,3.46D0,5.68D0,
+ &5.73D0,5.68D0,5.73D0,5.92D0,5.97D0,7.25D0,7.3D0,9.8598D0,9.875D0,
+ &2*1.23D0,1.282D0,2*1.402D0,1.427D0,2*2.372D0,2.56D0,3.5106D0,
+ &2*5.78D0,6.02D0,7.3D0,9.8919D0,3.686D0,10.0233D0,32*500D0,
+ &3*110D0,350D0,3*210D0,500D0,125D0,250D0,400D0,2*350D0,300D0,
+ &4*400D0,1000D0,3*500D0,1200D0,750D0,2*200D0,7*0D0,3*3.1D0,
+ &3*9.5D0,2*250D0,
+ &81*0,
+C...UED
+ &586.,588.,586.,588.,586.,586.,6*598.,
+ &3*505.,6*516.,640.,501.,536.,536.,25*0.D0/
+ DATA (PMAS(I,2),I= 1, 500)/5*0D0,1.39816D0,16*0D0,2.47813D0,
+ &2.07115D0,0.00367D0,6*0D0,14.54029D0,0D0,16.66099D0,8.38842D0,
+ &3.3752D0,4.17669D0,3*0D0,417.29147D0,0.39162D0,60*0D0,0.151D0,
+ &0.107D0,2*0D0,0.149D0,0.107D0,0D0,0.00843D0,0.185D0,2*0D0,
+ &0.0505D0,0.109D0,0D0,0.0498D0,0.098D0,0.0002D0,0.00443D0,0.076D0,
+ &2*0D0,0.023D0,2*0D0,0.023D0,2*0D0,0.015D0,0.0013D0,0D0,0.002D0,
+ &2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,5*0D0,0.12D0,
+ &3*0D0,0.12D0,2*0D0,2*0.12D0,3*0D0,0.0394D0,4*0D0,0.036D0,0D0,
+ &0.0358D0,2*0D0,0.0099D0,0D0,0.0091D0,74*0D0,0.06D0,0.142D0,
+ &0.06D0,0.142D0,0D0,0.36D0,0.287D0,0.09D0,0.287D0,0.09D0,0.25D0,
+ &0.08D0,0.05D0,0.02D0,0.05D0,0.02D0,0.05D0,0D0,0.014D0,0.01D0,
+ &8*0.05D0,0D0,0.01D0,2*0.4D0,0.025D0,2*0.174D0,0.053D0,3*0.05D0,
+ &0.0009D0,4*0.05D0,3*0D0,19*1D0,0D0,7*1D0,0D0,1D0,0D0,1D0,0D0,
+ &0.0208D0,0.01195D0,0.03705D0,0.09511D0,1.89978D0,1.60746D0,
+ &0.13396D0,200.47294D0,0.02296D0,0.18886D0,94.66794D0,6.08718D0,
+ &0D0,2.17482D0,2.59359D0,2.59687D0,0.42896D0,0.41912D0,0.14153D0,
+ &2*0.00098D0,0.00097D0,26.7245D0,21.74916D0,0.88159D0,0.88001D0,
+ &7*0D0,6*0.01D0,0.25499D0,0.28446D0,131*0D0/
+ DATA (PMAS(I,3),I= 1, 500)/5*0D0,13.98156D0,16*0D0,24.78129D0,
+ &20.71149D0,0.03669D0,6*0D0,145.40294D0,0D0,166.60993D0,
+ &83.88423D0,33.75195D0,41.76694D0,3*0D0,4172.91467D0,3.91621D0,
+ &60*0D0,0.4D0,0.25D0,2*0D0,0.4D0,0.25D0,0D0,0.1D0,0.17D0,2*0D0,
+ &0.2D0,0.12D0,0D0,0.2D0,0.12D0,0.002D0,0.015D0,0.2D0,2*0D0,0.12D0,
+ &2*0D0,0.12D0,2*0D0,0.05D0,0.005D0,0D0,0.01D0,2*0D0,0.05D0,2*0D0,
+ &0.05D0,2*0D0,0.05D0,2*0D0,0.05D0,5*0D0,0.14D0,3*0D0,0.14D0,2*0D0,
+ &2*0.14D0,3*0D0,0.04D0,4*0D0,0.035D0,0D0,0.035D0,2*0D0,0.05D0,0D0,
+ &0.05D0,74*0D0,0.05D0,0.25D0,0.05D0,0.25D0,0D0,0.2D0,0.4D0,
+ &0.005D0,0.4D0,0.01D0,0.35D0,0.001D0,0.1D0,0.08D0,0.1D0,0.08D0,
+ &0.1D0,0D0,0.05D0,0.02D0,6*0.1D0,0.05D0,0.1D0,0D0,0.02D0,2*0.3D0,
+ &0.05D0,2*0.3D0,0.02D0,2*0.1D0,0.03D0,0.001D0,4*0.1D0,3*0D0,
+ &19*10D0,0.00001D0,7*10D0,0.00001D0,10D0,0.00001D0,10D0,0.00001D0,
+ &0.20797D0,0.11949D0,0.37048D0,0.95114D0,18.99785D0,16.07463D0,
+ &1.33964D0,450D0,0.22959D0,1.88863D0,360D0,60.8718D0,0D0,
+ &21.74824D0,25.93594D0,25.96873D0,4.28961D0,4.19124D0,1.41528D0,
+ &0.00977D0,0.00976D0,0.00973D0,267.24501D0,217.49162D0,8.81592D0,
+ &8.80013D0,13*0D0,2.54987D0,2.84456D0,
+ &81*0,
+C...UED
+ &12*0.2D0,9*0.1D0,0.2,10.,0.07,0.3,25*0.D0/
+ DATA (PMAS(I,4),I= 1, 500)/12*0D0,658654D0,0D0,0.0872D0,68*0D0,
+ &0.1D0,0.387D0,16*0D0,0.00003D0,2*0D0,15500D0,7804.5D0,5*0D0,
+ &26.762D0,3*0D0,3709D0,5*0D0,0.317D0,2*0D0,0.1244D0,2*0D0,0.14D0,
+ &5*0D0,0.468D0,2*0D0,0.462D0,2*0D0,0.483D0,2*0D0,0.15D0,18*0D0,
+ &44.34D0,0D0,78.88D0,4*0D0,23.96D0,2*0D0,49.1D0,0D0,87.1D0,0D0,
+ &24.6D0,4*0D0,0.0618D0,0.029D0,6*0D0,0.106D0,6*0D0,0.019D0,2*0D0,
+ &7*0.1D0,4*0D0,0.342D0,2*0.387D0,6*0D0,2*0.387D0,6*0D0,0.387D0,
+ &0D0,0.387D0,2*0D0,8*0.387D0,0D0,9*0.387D0,120*0D0,131*0D0/
+
+ DATA PARF/
+ & 0.5D0,0.25D0, 0.5D0,0.25D0, 1D0, 0.5D0, 0D0, 0D0, 0D0, 0D0,
+ 1 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0,
+ 2 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0,
+ 3 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0,
+ 4 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0,
+ 5 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0,
+ 6 0.75D0, 0.5D0, 0D0,0.1667D0,0.0833D0,0.1667D0,0D0,0D0,0D0, 0D0,
+ 7 0D0, 0D0, 1D0,0.3333D0,0.6667D0,0.3333D0,0D0,0D0,0D0, 0D0,
+ 8 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 9 0.0099D0, 0.0056D0, 0.199D0, 1.23D0, 4.17D0, 165D0, 4*0D0,
+ & 0.325D0,0.325D0,0.5D0,1.6D0, 5.0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 1 0D0,0.11D0,0.16D0,0.048D0,0.50D0,0.45D0,0.55D0,0.60D0,0D0,0D0,
+ 2 0.2D0, 0.1D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 3 60*0D0,
+ 4 0.2D0, 0.5D0, 8*0D0,
+ 5 1800*0D0/
+ DATA ((VCKM(I,J),J=1,4),I=1,4)/
+ & 0.95113D0, 0.04884D0, 0.00003D0, 0.00000D0,
+ & 0.04884D0, 0.94940D0, 0.00176D0, 0.00000D0,
+ & 0.00003D0, 0.00176D0, 0.99821D0, 0.00000D0,
+ & 0.00000D0, 0.00000D0, 0.00000D0, 1.00000D0/
+
+C...PYDAT3, with particle decay parameters and data.
+ DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0,
+ &4*1,3*0,2*1,40*0,3*1,16*0,3*1,2*0,9*1,0,32*1,2*0,1,3*0,1,2*0,2*1,
+ &2*0,3*1,2*0,4*1,0,5*1,2*0,4*1,2*0,5*1,2*0,6*1,0,7*1,2*0,5*1,2*0,
+ &6*1,2*0,7*1,2*0,8*1,0,75*1,0,7*1,0,1,0,1,0,26*1,7*0,8*1,
+ &81*0,
+C...UED
+ &5*1,0,5*1,0,13*1,25*0/
+ DATA (MDCY(I,2),I= 1, 351)/1,9,17,25,33,41,56,66,2*0,76,80,82,
+ &87,89,143,145,150,2*0,153,162,174,190,210,6*0,289,0,311,334,420,
+ &503,3*0,530,539,40*0,540,541,545,16*0,554,556,561,570,579,581,
+ &583,590,598,604,613,615,617,620,630,636,639,650,656,667,673,736,
+ &739,747,808,810,818,851,853,857,858,861,863,899,900,908,944,945,
+ &953,992,993,997,1028,1029,1033,1034,1043,2*0,1045,3*0,1046,2*0,
+ &1049,1052,2*0,1053,1055,1058,2*0,1062,1063,1066,1069,0,1072,1077,
+ &1079,1082,1084,2*0,1088,1089,1090,1166,2*0,1170,1171,1172,1173,
+ &1174,2*0,1178,1179,1181,1182,1184,1188,0,1189,1193,1197,1201,
+ &1205,1209,1213,2*0,1217,1218,1219,1236,1245,2*0,1254,1255,1256,
+ &1257,1258,1267,2*0,1276,1277,1278,1279,1280,1289,1290,2*0,1299,
+ &1308,1317,1326,1335,1344,1353,1362,0,1371,1380,1389,1398,1407,
+ &1416,1425,1434,1443,1452,1453,1454,1455,1456,1461,1464,1466,1471,
+ &1473,1478,1485,1489,1491,1493,1495,1497,1499,1501,1503,1504,1506,
+ &1508,1510,1512,1514,1516,1518,1520,1522,1523,1525,1527,1541,1543,
+ &1545,1549,1551,1553,1555,1557,1559,1561,1563,1565,1567,1578,1592,
+ &1637,1661,1706,1730,1775,1802,1833,1859,1891,1917,1949,1975,2162,
+ &2331,2595,2826,3106,3402,0,3657,3706,3734,3783,3811,3860,3888,0,
+ &3924,0,3960,0,3996,4004,4012,4020,4217,4243,4270,4023,4029,4036,
+ &4043,4050,4056,4062,4071,4075,4079,4082,4084,4104,4126,4148,4170/
+ DATA (MDCY(I,2),I= 352, 500)/4185,4197,4204,7*0,4211,4212,4213,
+ &4214,4215,4216,4296,4322,
+ &81*0,
+C...UED
+ %5001,5003,5005,5007,5009,5011,5013,5016,5019,5022,5025,5028,
+ &5031,5032,5033,
+ &5034,5035,5036,5037,5038,5039,5040,5064,5065,5083,
+ &25*0/
+ DATA (MDCY(I,3),I= 1, 500)/5*8,15,2*10,2*0,4,2,5,2,54,2,5,3,
+ &2*0,9,12,16,20,79,6*0,22,0,23,86,83,27,3*0,9,1,40*0,1,4,9,16*0,2,
+ &5,2*9,2*2,7,8,6,9,2*2,3,10,6,3,11,6,11,6,63,3,8,61,2,8,33,2,4,1,
+ &3,2,36,1,8,36,1,8,39,1,4,31,1,4,1,9,2,2*0,1,3*0,3,2*0,3,1,2*0,2,
+ &3,4,2*0,1,3*3,0,5,2,3,2,4,2*0,2*1,76,4,2*0,4*1,4,2*0,1,2,1,2,4,1,
+ &0,7*4,2*0,2*1,17,2*9,2*0,4*1,2*9,2*0,4*1,9,1,9,2*0,8*9,0,9*9,4*1,
+ &5,3,2,5,2,5,7,4,7*2,1,9*2,1,2*2,14,2*2,4,9*2,11,14,45,24,45,24,
+ &45,27,31,26,32,26,32,26,187,169,264,231,280,296,255,0,49,28,49,
+ &28,49,28,36,0,36,0,36,0,3*8,3,26,27,26,6,3*7,2*6,9,2*4,3,2,20,
+ &3*22,15,12,2*7,7*0,6*1,26,30,
+ &81*0,
+C...UED
+ &6*2,6*3,9*1,24,1,18,6,25*0/
+ DATA (MDME(I,1),I= 1,8000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1,
+ &7*1,-1,1,7*-1,8*1,2*-1,8*1,2*-1,73*1,-1,2*1,-1,5*1,0,2*-1,6*1,0,
+ &2*-1,3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,-1,6*1,
+ &2*-1,3*1,-1,5*1,62*1,6*1,2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,
+ &3*1,4*-1,6*1,2*-1,3*1,-1,12*1,62*1,6*1,2*-1,3*1,-1,9*1,62*1,
+ &3*1,-1,3*1,-1,1,18*1,4*1,2*-1,2*1,-1,1249*1,2*-1,377*1,2*-1,
+ &1921*1,2*-1,6*1,2*-1,133*1,2*-1,6*1,2*-1,10*1,-1,3*1,-1,3*1,5*-1,
+ &3*1,-1,16*1,2*-1,6*1,2*-1,16*1,2*-1,6*1,2*-1,13*1,-1,3*1,-1,3*1,
+ &5*-1,3*1,-1,
+ &649*0,
+C...UED
+ &10*1,2*0,15*1,3*0,9*1,5*1,0,5*1,0,5*1,0,5*1,0,
+ &1,24*1,2912*0/
+ DATA (MDME(I,2),I= 1,8000)/43*102,4*0,102,0,6*53,3*102,4*0,102,
+ &2*0,3*102,4*0,102,2*0,6*102,42,6*102,2*42,2*0,8*41,2*0,36*41,
+ &8*102,0,102,0,102,2*0,21*102,8*32,8*0,16*32,4*0,8*32,9*0,62*53,
+ &8*32,14*0,16*32,7*0,8*32,16*0,62*53,8*32,13*0,62*53,4*32,5*0,
+ &18*53,6*32,4*0,12,2*42,2*11,9*42,0,2,3,15*0,4*42,5*0,3,12*0,2,
+ &3*0,1,0,3,16*0,2*3,15*0,2*42,2*3,18*0,2*3,3*0,1,11*0,22*42,41*0,
+ &2*3,9*0,16*42,45*0,3,10*0,10*42,20*0,2*13,6*0,12,2*0,12,0,12,
+ &14*42,16*0,48,3*13,2*42,9*0,14*42,16*0,48,3*13,2*42,9*0,14*42,
+ &19*0,48,3*13,2*42,6*0,2*11,28*42,5*0,32,3*0,4*32,2*4,0,32,45*0,
+ &14*42,52*0,10*13,2*42,2*11,4*0,2*42,2*11,6*0,2*42,2*11,0,2*42,
+ &2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,
+ &2*0,3*42,8*0,48,3*13,20*42,4*0,18*42,4*0,9*42,0,162*42,50*0,2*12,
+ &17*0,2*32,33*0,12,9*0,32,2*0,12,11*0,4*32,2*4,5*0,2404*53,4*32,
+ &3*0,6*32,3*0,4*32,3*0,50*32,3*53,12*0,8*32,12*0,66*51,6*32,9*0,
+ &9*32,17*0,6*51,10*0,8*32,15*0,16*32,14*0,8*32,18*0,8*32,18*0,
+ &16*32,
+C...UED
+ &653*0,30*0,9*0,12*0,37*0,2912*0/
+ DATA (BRAT(I) ,I= 1, 348)/43*0D0,0.00003D0,0.001765D0,
+ &0.998205D0,35*0D0,1D0,6*0D0,0.1783D0,0.1735D0,0.1131D0,0.2494D0,
+ &0.003D0,0.09D0,0.0027D0,0.01D0,0.0014D0,0.0012D0,2*0.00025D0,
+ &0.0071D0,0.012D0,0.0004D0,0.00075D0,0.00006D0,2*0.00078D0,
+ &0.0034D0,0.08D0,0.011D0,0.0191D0,0.00006D0,0.005D0,0.0133D0,
+ &0.0067D0,0.0005D0,0.0035D0,0.0006D0,0.0015D0,0.00021D0,0.0002D0,
+ &0.00075D0,0.0001D0,0.0002D0,0.0011D0,3*0.0002D0,0.00022D0,
+ &0.0004D0,0.0001D0,2*0.00205D0,2*0.00069D0,0.00025D0,0.00051D0,
+ &0.00025D0,35*0D0,0.153995D0,0.11942D0,0.153984D0,0.119259D0,
+ &0.152272D0,3*0D0,0.033576D0,0.066806D0,0.033576D0,0.066806D0,
+ &0.0335D0,0.066806D0,2*0D0,0.321369D0,0.016494D0,2*0D0,0.016502D0,
+ &0.320615D0,2*0D0,0.00001D0,0.000591D0,6*0D0,2*0.108166D0,
+ &0.108087D0,0D0,0.000001D0,0D0,0.000353D0,0.04359D0,0.795274D0,
+ &4*0D0,0.000339D0,0.095746D0,0D0,0.060724D0,0.003054D0,0.000919D0,
+ &64*0D0,0.145835D0,0.113276D0,0.145835D0,0.113271D0,0.145781D0,
+ &0.049002D0,2*0D0,0.032025D0,0.063642D0,0.032025D0,0.063642D0,
+ &0.032022D0,0.063642D0,8*0D0,0.251225D0,0.0129D0,0.000006D0,0D0,
+ &0.0129D0,0.250764D0,0.00038D0,0D0,0.000008D0,0.000465D0,
+ &0.215418D0,5*0D0,2*0.085312D0,0.08531D0,7*0D0,0.000029D0,
+ &0.000536D0,5*0D0,0.000074D0,0D0,0.000417D0,0.000015D0,0.000061D0/
+ DATA (BRAT(I) ,I= 349, 655)/0.306789D0,0.689189D0,0D0,0.00289D0,
+ &69*0D0,0.000001D0,0.000072D0,0.001333D0,4*0D0,0.000001D0,
+ &0.000184D0,0D0,0.003108D0,0.000015D0,0.000003D0,2*0D0,0.995284D0,
+ &66*0D0,0.000014D0,0.082234D0,2*0D0,0.000013D0,0.003746D0,0D0,
+ &0.913992D0,18*0D0,3*0.215119D0,0.214724D0,2*0D0,0.06996D0,
+ &0.069959D0,0D0,2*1D0,2*0.08D0,0.76D0,0.08D0,2*0.105D0,0.04D0,
+ &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,0.988D0,0.012D0,
+ &0.998739D0,0.00079D0,0.00038D0,0.000046D0,0.000045D0,2*0.34725D0,
+ &0.144D0,0.104D0,0.0245D0,2*0.01225D0,0.0028D0,0.0057D0,0.2112D0,
+ &0.1256D0,2*0.1939D0,2*0.1359D0,0.002D0,0.001D0,0.0006D0,
+ &0.999877D0,0.000123D0,0.99955D0,0.00045D0,2*0.34725D0,0.144D0,
+ &0.104D0,0.049D0,0.0028D0,0.0057D0,0.3923D0,0.321D0,0.2317D0,
+ &0.0478D0,0.0049D0,0.0013D0,0.0003D0,0.0007D0,0.89D0,0.08693D0,
+ &0.0221D0,0.00083D0,2*0.00007D0,0.564D0,0.282D0,0.072D0,0.028D0,
+ &0.023D0,2*0.0115D0,0.005D0,0.003D0,0.6861D0,0.3139D0,2*0.5D0,
+ &0.665D0,0.333D0,0.002D0,0.333D0,0.166D0,0.168D0,0.084D0,0.087D0,
+ &0.043D0,0.059D0,2*0.029D0,0.002D0,0.6352D0,0.2116D0,0.0559D0,
+ &0.0173D0,0.0482D0,0.0318D0,0.666D0,0.333D0,0.001D0,0.332D0,
+ &0.166D0,0.168D0,0.084D0,0.086D0,0.043D0,0.059D0,2*0.029D0,
+ &2*0.002D0,0.437D0,0.208D0,0.302D0,0.0302D0,0.0212D0,0.0016D0/
+ DATA (BRAT(I) ,I= 656, 831)/0.48947D0,0.34D0,3*0.043D0,0.027D0,
+ &0.0126D0,0.0013D0,0.0003D0,0.00025D0,0.00008D0,0.444D0,2*0.222D0,
+ &0.104D0,2*0.004D0,0.07D0,0.065D0,2*0.005D0,2*0.011D0,5*0.001D0,
+ &0.07D0,0.065D0,2*0.005D0,2*0.011D0,5*0.001D0,0.026D0,0.019D0,
+ &0.066D0,0.041D0,0.045D0,0.076D0,0.0073D0,2*0.0047D0,0.026D0,
+ &0.001D0,0.0006D0,0.0066D0,0.005D0,2*0.003D0,2*0.0006D0,2*0.001D0,
+ &0.006D0,0.005D0,0.012D0,0.0057D0,0.067D0,0.008D0,0.0022D0,
+ &0.027D0,0.004D0,0.019D0,0.012D0,0.002D0,0.009D0,0.0218D0,0.001D0,
+ &0.022D0,0.087D0,0.001D0,0.0019D0,0.0015D0,0.0028D0,0.683D0,
+ &0.306D0,0.011D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,
+ &0.04D0,0.034D0,0.027D0,2*0.002D0,2*0.004D0,2*0.002D0,0.034D0,
+ &0.027D0,2*0.002D0,2*0.004D0,2*0.002D0,0.0365D0,0.045D0,0.073D0,
+ &0.062D0,3*0.021D0,0.0061D0,0.015D0,0.025D0,0.0088D0,0.074D0,
+ &0.0109D0,0.0041D0,0.002D0,0.0035D0,0.0011D0,0.001D0,0.0027D0,
+ &2*0.0016D0,0.0018D0,0.011D0,0.0063D0,0.0052D0,0.018D0,0.016D0,
+ &0.0034D0,0.0036D0,0.0009D0,0.0006D0,0.015D0,0.0923D0,0.018D0,
+ &0.022D0,0.0077D0,0.009D0,0.0075D0,0.024D0,0.0085D0,0.067D0,
+ &0.0511D0,0.017D0,0.0004D0,0.0028D0,0.619D0,0.381D0,0.3D0,0.15D0,
+ &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.01D0,2*0.02D0,0.03D0,
+ &2*0.005D0,2*0.02D0,0.03D0,2*0.005D0,0.015D0,0.037D0,0.028D0/
+ DATA (BRAT(I) ,I= 832, 997)/0.079D0,0.095D0,0.052D0,0.0078D0,
+ &4*0.001D0,0.028D0,0.033D0,0.026D0,0.05D0,0.01D0,4*0.005D0,0.25D0,
+ &0.0952D0,0.94D0,0.06D0,2*0.4D0,2*0.1D0,1D0,0.0602D0,0.0601D0,
+ &0.8797D0,0.135D0,0.865D0,0.02D0,0.055D0,2*0.005D0,0.008D0,
+ &0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,
+ &0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,
+ &0.0185D0,0.0135D0,0.025D0,0.0004D0,0.0007D0,0.0008D0,0.0014D0,
+ &0.0019D0,0.0025D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,
+ &1D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,
+ &0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0,
+ &2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0,
+ &0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0,0.0135D0,
+ &0.025D0,0.0004D0,0.0007D0,0.0008D0,0.0014D0,0.0019D0,0.0025D0,
+ &0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0,
+ &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.02D0,0.055D0,
+ &2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0,
+ &0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0,
+ &0.018D0,0.015D0,0.0185D0,0.0135D0,0.025D0,2*0.0002D0,0.0007D0,
+ &2*0.0004D0,0.0014D0,0.001D0,0.0009D0,0.0025D0,0.4291D0,0.08D0,
+ &0.07D0,0.02D0,0.015D0,0.005D0,1D0,2*0.3D0,2*0.2D0,0.047D0/
+ DATA (BRAT(I) ,I= 998,1188)/0.122D0,0.006D0,0.012D0,0.035D0,
+ &0.012D0,0.035D0,0.003D0,0.007D0,0.15D0,0.037D0,0.008D0,0.002D0,
+ &0.05D0,0.015D0,0.003D0,0.001D0,0.014D0,0.042D0,0.014D0,0.042D0,
+ &0.24D0,0.065D0,0.012D0,0.003D0,0.001D0,0.002D0,0.001D0,0.002D0,
+ &0.014D0,0.003D0,1D0,2*0.3D0,2*0.2D0,1D0,0.0252D0,0.0248D0,
+ &0.0267D0,0.015D0,0.045D0,0.015D0,0.045D0,0.7743D0,0.029D0,0.22D0,
+ &0.78D0,1D0,0.331D0,0.663D0,0.006D0,0.663D0,0.331D0,0.006D0,1D0,
+ &0.999D0,0.001D0,0.88D0,2*0.06D0,0.639D0,0.358D0,0.002D0,0.001D0,
+ &1D0,0.88D0,2*0.06D0,0.516D0,0.483D0,0.001D0,0.88D0,2*0.06D0,
+ &0.9988D0,0.0001D0,0.0006D0,0.0004D0,0.0001D0,0.667D0,0.333D0,
+ &0.9954D0,0.0011D0,0.0035D0,0.333D0,0.667D0,0.676D0,0.234D0,
+ &0.085D0,0.005D0,2*1D0,0.018D0,2*0.005D0,0.003D0,0.002D0,
+ &2*0.006D0,0.018D0,2*0.005D0,0.003D0,0.002D0,2*0.006D0,0.0066D0,
+ &0.025D0,0.016D0,0.0088D0,2*0.005D0,0.0058D0,0.005D0,0.0055D0,
+ &4*0.004D0,2*0.002D0,2*0.004D0,0.003D0,0.002D0,2*0.003D0,
+ &3*0.002D0,2*0.001D0,0.002D0,2*0.001D0,2*0.002D0,0.0013D0,
+ &0.0018D0,5*0.001D0,4*0.003D0,2*0.005D0,2*0.002D0,2*0.001D0,
+ &2*0.002D0,2*0.001D0,0.2432D0,0.057D0,2*0.035D0,0.15D0,2*0.075D0,
+ &0.03D0,2*0.015D0,2*0.08D0,0.76D0,0.08D0,4*1D0,2*0.08D0,0.76D0,
+ &0.08D0,1D0,2*0.5D0,1D0,2*0.5D0,2*0.08D0,0.76D0,0.08D0,1D0/
+ DATA (BRAT(I) ,I=1189,1381)/2*0.08D0,0.76D0,3*0.08D0,0.76D0,
+ &3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,
+ &3*0.08D0,0.76D0,0.08D0,2*1D0,2*0.105D0,0.04D0,0.0077D0,0.02D0,
+ &0.0235D0,0.0285D0,0.0435D0,0.0011D0,0.0022D0,0.0044D0,0.4291D0,
+ &0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,
+ &0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,
+ &0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,4*1D0,2*0.105D0,0.04D0,
+ &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0,
+ &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,4*1D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,1D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,
+ &0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0/
+ DATA (BRAT(I) ,I=1382,1582)/0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
+ &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
+ &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
+ &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
+ &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
+ &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
+ &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
+ &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,
+ &0.015D0,0.005D0,4*1D0,0.52D0,0.26D0,0.11D0,2*0.055D0,0.333D0,
+ &0.334D0,0.333D0,0.667D0,0.333D0,0.28D0,0.14D0,0.313D0,0.157D0,
+ &0.11D0,0.667D0,0.333D0,0.28D0,0.14D0,0.313D0,0.157D0,0.11D0,
+ &0.36D0,0.18D0,0.03D0,2*0.015D0,2*0.2D0,4*0.25D0,0.667D0,0.333D0,
+ &0.667D0,0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,4*0.5D0,0.007D0,
+ &0.993D0,1D0,0.667D0,0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,
+ &0.667D0,0.333D0,8*0.5D0,0.02D0,0.98D0,1D0,4*0.5D0,3*0.146D0,
+ &3*0.05D0,0.15D0,2*0.05D0,4*0.024D0,0.066D0,0.667D0,0.333D0,
+ &0.667D0,0.333D0,4*0.25D0,0.667D0,0.333D0,0.667D0,0.333D0,2*0.5D0,
+ &0.273D0,0.727D0,0.667D0,0.333D0,0.667D0,0.333D0,4*0.5D0,0.35D0,
+ &0.65D0,2*0.0083D0,0.1866D0,0.324D0,0.184D0,0.027D0,0.001D0,
+ &0.093D0,0.087D0,0.078D0,0.0028D0,3*0.014D0,0.008D0,0.024D0/
+ DATA (BRAT(I) ,I=1583,4150)/0.008D0,0.024D0,0.425D0,0.02D0,
+ &0.185D0,0.088D0,0.043D0,0.067D0,0.066D0,2404*0D0,0.024396D0,
+ &0.045285D0,0.83119D0,2*0D0,0.000349D0,0.09878D0,0D0,0.019884D0,
+ &0.02341D0,0.362776D0,0.550787D0,2*0D0,0.000152D0,0.042991D0,
+ &0.013695D0,0.025421D0,0.466595D0,2*0D0,0.000196D0,0.055451D0,
+ &0.438642D0,0.445781D0,0D0,0.554219D0,4*0.00335D0,0.522257D0,
+ &0.464343D0,6*0D0,1D0,6*0D0,1D0,4*0.013853D0,0.562703D0,
+ &0.376702D0,0.00518D0,4*0.006254D0,0.974985D0,7*0D0,4*0.148299D0,
+ &0.015351D0,0D0,0.182109D0,0.167099D0,0.042247D0,0.850973D0,
+ &0.005411D0,0.045025D0,0.098591D0,0.849898D0,0.021617D0,
+ &0.030018D0,0.098466D0,0.294448D0,0.10945D0,0.596102D0,0.389906D0,
+ &0.610094D0,3*0.0633D0,0.063299D0,0.063295D0,0.056281D0,2*0D0,
+ &6*0.020495D0,2*0D0,0.327919D0,0.04099D0,0.045236D0,0.090112D0,
+ &0.19874D0,0.010204D0,0.000003D0,0.010205D0,0.198356D0,0.000151D0,
+ &0.000006D0,0.000367D0,0.081967D0,0.19874D0,0.010204D0,0.000003D0,
+ &0.010205D0,0.198356D0,0.000151D0,0.000006D0,0.000367D0,
+ &0.081967D0,4*0D0,0.198776D0,0.010206D0,0.000003D0,0.010207D0,
+ &0.19839D0,0.000151D0,0.000006D0,0.000367D0,0.081893D0,0.198776D0,
+ &0.010206D0,0.000003D0,0.010207D0,0.19839D0,0.000151D0,0.000006D0,
+ &0.000367D0,0.081893D0,4*0D0,0.199344D0,0.010234D0,0.000003D0/
+ DATA (BRAT(I) ,I=4151,4281)/0.010236D0,0.198928D0,0.000149D0,
+ &0.000006D0,0.000368D0,0.080733D0,0.199344D0,0.010234D0,
+ &0.000003D0,0.010236D0,0.198928D0,0.000149D0,0.000006D0,
+ &0.000368D0,0.080733D0,4*0D0,0.184738D0,0.104588D0,0.184738D0,
+ &0.104587D0,0.184731D0,0.09582D0,0.022902D0,0.008429D0,0.015602D0,
+ &0.022902D0,0.008429D0,0.015602D0,0.022902D0,0.008429D0,
+ &0.015602D0,0.28959D0,0.01487D0,0.000008D0,0.01487D0,0.289061D0,
+ &0.000492D0,0.000009D0,0.000536D0,0.27911D0,2*0.037151D0,
+ &0.03715D0,0.090266D0,2*0.001805D0,0.090266D0,0.001805D0,
+ &0.812263D0,0.00179D0,0.090428D0,0.001809D0,0.001808D0,0.090428D0,
+ &0.001808D0,0.81372D0,0D0,6*1D0,0.095602D0,2*0.338272D0,
+ &0.156896D0,0.019193D0,0.017993D0,0.001168D0,0.001462D0,
+ &0.009608D0,0.003306D0,0.002132D0,0.003127D0,0.002132D0,
+ &0.003127D0,0.00213D0,3*0D0,0.001411D0,0.00045D0,0.001411D0,
+ &0.00045D0,0.001411D0,0.00045D0,2*0D0,0.097996D0,0.399787D0,
+ &0.262464D0,0.185427D0,0.022683D0,0.007648D0,0.004259D0,
+ &0.005925D0,0.000304D0,2*0D0,0.000304D0,0.005914D0,0.000002D0,
+ &2*0D0,0.000011D0,0.001258D0,5*0D0,3*0.002005D0,0D0,0.272178D0,
+ &0.022112D0,0.255165D0,0.015534D0,2*0.108965D0,0.031557D0,
+ &0.005562D0,0.044965D0,0.004674D0,0.007637D0,0.020597D0/
+ DATA (BRAT(I) ,I=4282,8000)/0.007636D0,0.020595D0,0.007616D0,
+ &3*0D0,0.017298D0,0.004782D0,0.017298D0,0.004782D0,0.017297D0,
+ &0.004782D0,2*0D0,0.055332D0,2*0.319757D0,0.121576D0,2*0.001556D0,
+ &4*0D0,0.0277D0,0.021481D0,0.027699D0,0.021477D0,0.027658D0,3*0D0,
+ &0.006071D0,0.01208D0,0.006071D0,0.01208D0,0.006069D0,0.01208D0,
+ &2*0D0,0.035891D0,0.209476D0,0.129084D0,0.286631D0,0.10742D0,
+ &0.109486D0,4*0D0,0.035282D0,0.001812D0,2*0D0,0.001812D0,
+ &0.035215D0,0.000021D0,0D0,0.000001D0,0.000065D0,0.011965D0,5*0D0,
+ &2*0.011947D0,0.011946D0,0D0,
+ &649*0.D0,
+C....UED
+ &0.001D0,0.999D0,0.001D0,0.999D0,0.001D0,0.999D0,
+ &0.001D0,0.999D0,0.001D0,0.999D0,0.001D0,0.999D0,
+ &0.33D0,0.66D0,0.01D0,0.33D0,0.66D0,0.01D0,0.33D0,0.66D0,0.01D0,
+ &0.33D0,0.66D0,0.01D0,0.98D0,0.D0,0.02D0,0.33D0,0.66D0,0.01D0,
+ &9*1.D0,
+ &24*0.0416667,
+ &1.,
+ &3*0.D0,6*0.08333D0,
+ &3*0.D0,6*0.08333D0,
+ &6*0.166667D0,
+ &2912*0.D0/
+ DATA (KFDP(I,1),I= 1, 377)/21,22,23,4*-24,25,21,22,23,4*24,25,
+ &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23,
+ &4*24,25,37,1000022,1000023,1000025,1000035,1000021,1000039,21,22,
+ &23,4*-24,25,2*-37,21,22,23,4*24,25,2*37,22,23,-24,25,23,24,-12,
+ &22,23,-24,25,23,24,-12,-14,48*16,22,23,-24,25,23,24,22,23,-24,25,
+ &-37,23,24,37,1,2,3,4,5,6,7,8,21,1,2,3,4,5,6,7,8,11,13,15,17,1,2,
+ &3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1,4*-3,4*-5,4*-7,-11,-13,
+ &-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,1000022,
+ &2*1000023,3*1000025,4*1000035,2*1000024,2*1000037,1000001,
+ &2000001,1000001,-1000001,1000002,2000002,1000002,-1000002,
+ &1000003,2000003,1000003,-1000003,1000004,2000004,1000004,
+ &-1000004,1000005,2000005,1000005,-1000005,1000006,2000006,
+ &1000006,-1000006,1000011,2000011,1000011,-1000011,1000012,
+ &2000012,1000012,-1000012,1000013,2000013,1000013,-1000013,
+ &1000014,2000014,1000014,-1000014,1000015,2000015,1000015,
+ &-1000015,1000016,2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,12,
+ &13,14,15,16,17,18,24,37,2*23,25,35,4*-1,4*-3,4*-5,4*-7,-11,-13,
+ &-15,-17,3*24,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,23,25,24,
+ &37,23,25,36,1000022,2*1000023,3*1000025,4*1000035,2*1000024,
+ &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002/
+ DATA (KFDP(I,1),I= 378, 580)/1000002,-1000002,1000003,2000003,
+ &1000003,-1000003,1000004,2000004,1000004,-1000004,1000005,
+ &2000005,1000005,-1000005,1000006,2000006,1000006,-1000006,
+ &1000011,2000011,1000011,-1000011,1000012,2000012,1000012,
+ &-1000012,1000013,2000013,1000013,-1000013,1000014,2000014,
+ &1000014,-1000014,1000015,2000015,1000015,-1000015,1000016,
+ &2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,
+ &24,23,25,24,37,1000022,2*1000023,3*1000025,4*1000035,2*1000024,
+ &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002,
+ &1000002,-1000002,1000003,2000003,1000003,-1000003,1000004,
+ &2000004,1000004,-1000004,1000005,2000005,1000005,-1000005,
+ &1000006,2000006,1000006,-1000006,1000011,2000011,1000011,
+ &-1000011,1000012,2000012,1000012,-1000012,1000013,2000013,
+ &1000013,-1000013,1000014,2000014,1000014,-1000014,1000015,
+ &2000015,1000015,-1000015,1000016,2000016,1000016,-1000016,-1,-3,
+ &-5,-7,-11,-13,-15,-17,24,2*1000022,2*1000023,2*1000025,2*1000035,
+ &1000006,2000006,1000006,2000006,-1000001,-1000003,-1000011,
+ &-1000013,-1000015,-2000015,1,2,3,4,5,6,11,13,15,2,82,-11,-13,2*2,
+ &-12,-14,-16,2*-2,2*-4,-2,-4,2*22,211,111,221,13,11,213,-213,221,
+ &223,321,130,310,111,331,111,211,-12,12,-14,14,211,111,22,-13,-11/
+ DATA (KFDP(I,1),I= 581, 992)/2*211,213,113,221,223,321,211,331,
+ &22,111,211,2*22,211,22,111,211,22,211,221,111,11,211,111,2*211,
+ &321,130,310,221,111,211,111,130,310,321,2*311,321,311,323,313,
+ &323,313,321,3*311,-13,3*211,12,14,311,2*321,311,321,313,323,313,
+ &323,311,4*321,211,111,3*22,111,321,130,-213,113,213,211,22,111,
+ &11,13,211,321,130,310,221,211,111,11*-11,11*-13,-311,-313,-311,
+ &-313,-20313,2*-311,-313,-311,-313,2*111,2*221,2*331,2*113,2*223,
+ &2*333,-311,-313,2*-321,211,-311,-321,333,-311,-313,-321,211,
+ &2*-321,2*-311,-321,211,113,421,2*411,421,411,423,413,423,413,421,
+ &411,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311,-313,2*-311,
+ &-321,-10323,-321,-323,-321,-311,2*-313,211,111,333,3*-321,-311,
+ &-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211,-321,3*-311,
+ &211,113,321,2*421,411,421,413,423,413,423,411,421,-15,5*-11,
+ &5*-13,221,331,333,221,331,333,10221,211,213,211,213,321,323,321,
+ &323,2212,221,331,333,221,2*2,2*431,421,411,423,413,82,11,13,82,
+ &443,82,6*12,6*14,2*16,3*-411,3*-413,2*-411,2*-413,2*441,2*443,
+ &2*20443,2*2,2*4,2,4,511,521,511,523,513,523,513,521,511,6*12,
+ &6*14,2*16,3*-421,3*-423,2*-421,2*-423,2*441,2*443,2*20443,2*2,
+ &2*4,2,4,521,511,521,513,523,513,523,511,521,6*12,6*14,2*16,
+ &3*-431,3*-433,2*-431,2*-433,3*441,3*443,3*20443,2*2,2*4,2,4,531/
+ DATA (KFDP(I,1),I= 993,1402)/521,511,523,513,16,2*4,2*12,2*14,
+ &2*16,4*2,4*4,2*-11,2*-13,2*-1,2*-3,2*-11,2*-13,2*-1,541,511,521,
+ &513,523,21,11,13,15,1,2,3,4,21,22,553,21,2112,2212,2*2112,2212,
+ &2112,2*2212,2112,-12,3122,3212,3112,2212,2*2112,-12,2*3122,3222,
+ &3112,2212,2112,2212,3122,3222,3212,3122,3112,-12,-14,-12,3322,
+ &3312,2*3122,3212,3322,3312,3122,3322,3312,-12,2*4122,7*-11,7*-13,
+ &2*2224,2*2212,2*2214,2*3122,2*3212,2*3214,5*3222,4*3224,2*3322,
+ &3324,2*2224,7*2212,5*2214,2*2112,2*2114,2*3122,2*3212,2*3214,
+ &2*3222,2*3224,4*2,3,2*2,1,2*2,-11,-13,2*2,4*4122,-11,-13,2*2,
+ &3*4132,3*4232,-11,-13,2*2,4332,-11,-13,2*2,-11,-13,2*2,-11,-13,
+ &2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,2*5122,-12,
+ &-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,
+ &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,4*5122,-12,-14,-16,2*-2,
+ &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,2*5132,2*5232,-12,-14,-16,
+ &2*-2,2*-4,-2,-4,5332,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,
+ &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,
+ &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,
+ &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,
+ &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,
+ &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2/
+ DATA (KFDP(I,1),I=1403,1713)/2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,
+ &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,
+ &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,221,223,221,
+ &223,211,111,321,130,310,213,113,-213,321,311,321,311,323,313,
+ &2*311,321,311,321,313,323,321,211,111,321,130,310,2*211,313,-313,
+ &323,-323,421,411,423,413,411,421,413,423,411,421,423,413,443,
+ &2*82,521,511,523,513,511,521,513,523,521,511,523,513,511,521,513,
+ &523,553,2*21,213,-213,113,213,10211,10111,-10211,2*221,213,2*113,
+ &-213,2*321,2*311,113,323,2*313,323,313,-313,323,-323,423,2*413,
+ &2*423,413,443,82,523,2*513,2*523,2*513,523,553,21,11,13,82,4*443,
+ &10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553,10551,20553,555,
+ &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035,
+ &1000002,2000002,1000002,2000002,1000021,3*-12,3*-14,3*-16,12,11,
+ &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,
+ &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000001,
+ &2000001,1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3,
+ &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035,
+ &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11,
+ &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,
+ &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000003/
+ DATA (KFDP(I,1),I=1714,1984)/2000003,1000003,2000003,1000021,
+ &3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024,-1000037,1000022,
+ &1000023,1000025,1000035,1000006,2000006,1000006,2000006,1000021,
+ &3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13,14,13,16,15,16,
+ &15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037,1000022,1000023,
+ &1000025,1000035,1000005,2000005,1000005,2000005,1000021,1000022,
+ &1000016,-1000015,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024,
+ &-1000037,1000022,1000023,1000025,1000035,1000012,2000012,1000012,
+ &2*12,2*14,2*16,3*-14,3*-16,3*-2,3*-4,3*-6,1000039,1000024,
+ &1000037,1000022,1000023,1000025,1000035,1000011,2000011,1000011,
+ &2000011,3*-13,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037,
+ &1000022,1000023,1000025,1000035,1000014,2000014,1000014,2000014,
+ &2*12,2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,1000024,
+ &1000037,1000022,1000023,1000025,1000035,1000013,2000013,1000013,
+ &2000013,3*-11,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037,
+ &1000022,1000023,1000025,1000035,1000016,2000016,1000016,2000016,
+ &2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,1000039,1000024,
+ &1000037,1000022,1000023,1000025,1000035,1000015,2000015,1000015,
+ &2000015,3*-11,3*-13,3*-1,3*-3,3*-5,1000039,1000001,-1000001,
+ &2000001,-2000001,1000002,-1000002,2000002,-2000002,1000003/
+ DATA (KFDP(I,1),I=1985,2321)/-1000003,2000003,-2000003,1000004,
+ &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005,
+ &1000006,-1000006,2000006,-2000006,6*1000022,6*1000023,6*1000025,
+ &6*1000035,1000024,-1000024,1000024,-1000024,1000024,-1000024,
+ &1000037,-1000037,1000037,-1000037,1000037,-1000037,-12,12,-11,11,
+ &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,
+ &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13,
+ &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,
+ &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15,
+ &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,
+ &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2,
+ &-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039,4,1,-12,12,-12,12,-12,12,
+ &-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14,14,-14,14,-14,14,
+ &-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12,12,-11,11,-12,12,
+ &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,
+ &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13,-14,14,
+ &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,
+ &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15,-16,16,
+ &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,
+ &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2,-4,4,-4/
+ DATA (KFDP(I,1),I=2322,2573)/4,-4,4,-6,6,-6,6,-6,6,5*1000039,
+ &16*1000022,1000024,-1000024,1000024,-1000024,1000024,-1000024,
+ &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000037,
+ &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037,
+ &1000037,-1000037,1000037,-1000037,1000024,-1000024,1000037,
+ &-1000037,1000001,-1000001,2000001,-2000001,1000002,-1000002,
+ &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004,
+ &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005,
+ &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011,
+ &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013,
+ &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015,
+ &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016,
+ &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14,
+ &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16,
+ &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,
+ &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,
+ &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,
+ &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,
+ &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,
+ &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16/
+ DATA (KFDP(I,1),I=2574,2892)/16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4,
+ &-4,4,-6,6,-6,6,-6,6,2*1000039,6*1000022,6*1000023,6*1000025,
+ &6*1000035,1000022,1000023,1000025,1000035,1000002,2000002,
+ &-1000001,-2000001,1000004,2000004,-1000003,-2000003,1000006,
+ &2000006,-1000005,-2000005,1000012,2000012,-1000011,-2000011,
+ &1000014,2000014,-1000013,-2000013,1000016,2000016,-1000015,
+ &-2000015,2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11,
+ &-12,12,-11,-12,12,-11,-14,-13,-14,-13,-14,-13,-14,14,-13,-14,14,
+ &-13,-14,14,-13,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15,
+ &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,
+ &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-14,2*-13,14,
+ &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,
+ &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16,2*-15,16,-16,2*-15,16,
+ &-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,
+ &-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1,2,-1,3*2,-1,2*4,-3,
+ &3*4,-3,2*6,5*1000039,16*1000022,16*1000023,1000024,-1000024,
+ &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000024,
+ &-1000024,1000024,-1000024,1000037,-1000037,1000037,-1000037,
+ &1000037,-1000037,1000037,-1000037,1000037,-1000037,1000037,
+ &-1000037,1000024,-1000024,1000037,-1000037,1000001,-1000001/
+ DATA (KFDP(I,1),I=2893,3182)/2000001,-2000001,1000002,-1000002,
+ &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004,
+ &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005,
+ &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011,
+ &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013,
+ &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015,
+ &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016,
+ &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14,
+ &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16,
+ &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,
+ &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,
+ &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,
+ &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,
+ &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,
+ &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,
+ &16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039,
+ &16*1000022,16*1000023,16*1000025,1000024,-1000024,1000024,
+ &-1000024,1000024,-1000024,1000024,-1000024,1000024,-1000024,
+ &1000024,-1000024,1000037,-1000037,1000037,-1000037,1000037,
+ &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037/
+ DATA (KFDP(I,1),I=3183,3459)/1000024,-1000024,1000037,-1000037,
+ &1000001,-1000001,2000001,-2000001,1000002,-1000002,2000002,
+ &-2000002,1000003,-1000003,2000003,-2000003,1000004,-1000004,
+ &2000004,-2000004,1000005,-1000005,2000005,-2000005,1000006,
+ &-1000006,2000006,-2000006,1000011,-1000011,2000011,-2000011,
+ &1000012,-1000012,2000012,-2000012,1000013,-1000013,2000013,
+ &-2000013,1000014,-1000014,2000014,-2000014,1000015,-1000015,
+ &2000015,-2000015,1000016,-1000016,2000016,-2000016,5*1000021,-12,
+ &12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14,
+ &14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12,
+ &12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,
+ &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,
+ &14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,
+ &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,
+ &16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,
+ &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,
+ &-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,2*1000039,15*1000024,
+ &6*1000022,6*1000023,6*1000025,6*1000035,1000022,1000023,1000025,
+ &1000035,1000002,2000002,-1000001,-2000001,1000004,2000004,
+ &-1000003,-2000003,1000006,2000006,-1000005,-2000005,1000012/
+ DATA (KFDP(I,1),I=3460,3782)/2000012,-1000011,-2000011,1000014,
+ &2000014,-1000013,-2000013,1000016,2000016,-1000015,-2000015,
+ &2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11,
+ &-12,12,-11,-14,14,-13,-14,14,-13,-14,14,-13,-14,14,-13,-14,14,
+ &-13,-14,14,-13,-16,16,-15,-16,16,-15,-16,16,-15,-16,16,-15,-16,
+ &16,-15,-16,16,-15,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,
+ &2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,
+ &2*-11,12,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,
+ &2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16,
+ &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,
+ &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1,
+ &2,-1,3*2,-1,2*4,-3,3*4,-3,2*6,1000039,-1000024,-1000037,1000022,
+ &1000023,1000025,1000035,4*1000001,1000002,2000002,1000002,
+ &2000002,1000021,3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13,
+ &14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037,
+ &1000022,1000023,1000025,1000035,4*1000002,1000001,2000001,
+ &1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039,
+ &-1000024,-1000037,1000022,1000023,1000025,1000035,4*1000003,
+ &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11,
+ &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6/
+ DATA (KFDP(I,1),I=3783,4156)/1000039,1000024,1000037,1000022,
+ &1000023,1000025,1000035,4*1000004,1000003,2000003,1000003,
+ &2000003,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024,
+ &-1000037,1000022,1000023,1000025,1000035,4*1000005,1000006,
+ &2000006,1000006,2000006,1000021,3*-12,3*-14,3*-16,12,11,12,11,12,
+ &11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039,
+ &1000024,1000037,1000022,1000023,1000025,1000035,4*1000006,
+ &1000005,2000005,1000005,2000005,1000021,3*-11,3*-13,3*-15,2*-1,
+ &-3,1000039,-1000024,-1000037,1000022,1000023,1000025,1000035,
+ &4*1000011,1000012,2000012,1000012,2000012,2*12,2*14,2*16,3*-14,
+ &3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037,1000022,1000023,
+ &1000025,1000035,4*1000013,1000014,2000014,1000014,2000014,2*12,
+ &2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037,
+ &1000022,1000023,1000025,1000035,4*1000015,1000016,2000016,
+ &1000016,2000016,2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,3,4,5,
+ &6,11,13,15,21,2*4,2,4,24,-11,-13,-15,3,4,5,6,11,13,15,21,5,6,21,
+ &1,2,3,4,5,6,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4,
+ &5,6,1,2,3,4,5,6,1,2,3,4,5,6,21,3100111,3200111,21,22,23,-24,21,
+ &22,23,24,22,23,-24,23,24,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,
+ &21,22,23,24,9*11,9*-11,11,-11,11,-11,9*13,9*-13,13,-13,13,-13,
+ &9*15/
+ DATA (KFDP(I,1),I=4157,8000)/9*-15,15,-15,15,-15,1,2,3,4,5,6,11,
+ &12,9900012,13,14,9900014,15,16,9900016,3*-1,3*-3,3*-5,-11,-13,-15,
+ &3*-11,2*-13,-15,24,3*-11,2*-13,-15,9900024,3*443,3*553,2*24,
+ &2*3000211,2*22,2*23,22,23,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,
+ &18,2*24,3*3000211,2*24,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,22,23,
+ &22,23,24,3000211,24,3000211,22,23,1,2,3,4,5,6,7,8,11,12,13,14,15,
+ &16,17,18,2*24,-24,23,2*22,24,-24,2*23,1,2,3,4,5,6,7,8,11,12,13,
+ &14,15,16,17,18,2*22,23,2*24,23,22,2*24,23,4*-1,4*-3,4*-5,4*-7,
+ &-11,-13,-15,-17,
+ &649*0,
+C...UED
+ &5100023,5100022,5100023,5100022,5100023,5100022,
+ &5100023,5100022,5100023,5100022,5100023,5100022,
+ &5100023,-5100024,5100022,5100023,5100024,5100022,
+ &5100023,-5100024,5100022,5100023,5100024,5100022,
+ &5100023,-5100024,5100022,5100023,5100024,5100022,
+ &9*5100022,
+ &6100001,6100002,6100003,6100004,6100005,6100006,
+ &5100001,5100002,5100003,5100004,5100005,5100006,
+ &-6100001,-6100002,-6100003,-6100004,-6100005,-6100006,
+ &-5100001,-5100002,-5100003,-5100004,-5100005,-5100006,
+ &39,
+ &6100011,6100013,6100015,
+ &5100011,5100013,5100015,
+ %5100012,5100014,5100016,
+ &-6100011,-6100013,-6100015,
+ &-5100011,-5100013,-5100015,
+ %-5100012,-5100014,-5100016,
+ &-5100011,-5100013,-5100015,
+ &5100012,5100014,5100016,
+ &2912*0/
+ DATA (KFDP(I,2),I= 1, 339)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4,
+ &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,5,6*1000006,3*7,
+ &2,4,6,8,7,4,6,3*8,1,3,5,7,8,5,7,2*11,12,11,12,2*11,2*13,14,13,14,
+ &13,11,13,-211,-213,-211,-213,-211,-213,-211,-213,2*-211,-321,
+ &-323,-321,2*-323,3*-321,4*-211,-213,-211,-213,-211,-213,-211,
+ &-213,-211,-213,3*-211,-213,4*-211,-323,-321,2*-211,2*-321,3*-211,
+ &2*15,16,15,16,15,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21,
+ &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8,
+ &-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,
+ &12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,
+ &-24,2*1000022,1000023,1000022,1000023,1000025,1000022,1000023,
+ &1000025,1000035,-1000024,-1000037,-1000024,-1000037,-1000001,
+ &2*-2000001,2000001,-1000002,2*-2000002,2000002,-1000003,
+ &2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005,
+ &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011,
+ &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013,
+ &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015,
+ &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6,
+ &-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,-37,22,25,2*36,2,4,6,8,
+ &2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22,25,-1,-2,-3,-4,-5,-6/
+ DATA (KFDP(I,2),I= 340, 533)/-7,-8,-11,-13,-15,-17,21,22,2*23,
+ &-24,2*25,-37,-24,3*36,2*1000022,1000023,1000022,1000023,1000025,
+ &1000022,1000023,1000025,1000035,-1000024,-1000037,-1000024,
+ &-1000037,-1000001,2*-2000001,2000001,-1000002,2*-2000002,2000002,
+ &-1000003,2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005,
+ &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011,
+ &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013,
+ &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015,
+ &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6,
+ &-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25,-37,-24,2*1000022,
+ &1000023,1000022,1000023,1000025,1000022,1000023,1000025,1000035,
+ &-1000024,-1000037,-1000024,-1000037,-1000001,2*-2000001,2000001,
+ &-1000002,2*-2000002,2000002,-1000003,2*-2000003,2000003,-1000004,
+ &2*-2000004,2000004,-1000005,2*-2000005,2000005,-1000006,
+ &2*-2000006,2000006,-1000011,2*-2000011,2000011,-1000012,
+ &2*-2000012,2000012,-1000013,2*-2000013,2000013,-1000014,
+ &2*-2000014,2000014,-1000015,2*-2000015,2000015,-1000016,
+ &2*-2000016,2000016,2,4,6,8,12,14,16,18,25,1000024,1000037,
+ &1000024,1000037,1000024,1000037,1000024,1000037,2*-1000005,
+ &2*-2000005,1000002,1000004,1000012,1000014,2*1000016,-3,-4,-5,-6/
+ DATA (KFDP(I,2),I= 534, 938)/-7,-8,-13,-15,-17,11,-82,12,14,-1,
+ &-3,11,13,15,1,4,3,4,1,3,22,11,-211,2*22,-13,-11,-211,211,111,211,
+ &-321,130,310,22,2*111,-211,11,-11,13,-13,-211,111,22,14,12,111,
+ &22,111,3*211,-311,22,211,22,111,-211,211,11,-211,13,22,-211,111,
+ &-211,22,111,-11,-211,111,2*-211,-321,130,310,221,111,-211,111,
+ &2*0,-211,111,22,-211,111,-211,111,-211,211,-213,113,223,221,14,
+ &111,211,111,-11,-13,211,111,22,211,111,211,111,2*211,213,113,223,
+ &221,22,-211,111,113,223,22,111,-321,310,211,111,2*-211,221,22,
+ &-11,-13,-211,-321,130,310,221,-211,111,11*12,11*14,2*211,2*213,
+ &211,20213,2*321,2*323,211,213,211,213,211,213,211,213,211,213,
+ &211,213,3*211,213,211,2*321,8*211,2*113,3*211,111,22,211,111,211,
+ &111,4*211,8*12,8*14,2*211,2*213,2*111,221,2*113,223,333,20213,
+ &211,2*321,323,2*311,313,-211,111,113,2*211,321,2*211,311,321,310,
+ &211,-211,4*211,321,4*211,113,2*211,-321,111,22,-211,111,-211,111,
+ &-211,211,-211,211,16,5*12,5*14,3*211,3*213,211,2*111,2*113,
+ &2*-311,2*-313,-2112,3*321,323,2*-1,22,111,321,311,321,311,-82,
+ &-11,-13,-82,22,-82,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,
+ &431,433,431,433,311,313,311,313,311,313,-1,-4,-3,-4,-1,-3,22,
+ &-211,111,-211,111,-211,211,-211,211,6*-11,6*-13,2*-15,211,213,
+ &20213,211,213,20213,431,433,431,433,321,323,321,323,321,323,-1/
+ DATA (KFDP(I,2),I= 939,1352)/-4,-3,-4,-1,-3,22,211,111,211,111,
+ &4*211,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,431,433,431,
+ &433,221,331,333,221,331,333,221,331,333,-1,-4,-3,-4,-1,-3,22,
+ &-321,-311,-321,-311,-15,-3,-1,2*-11,2*-13,2*-15,-1,-4,-3,-4,-3,
+ &-4,-1,-4,2*12,2*14,2,3,2,3,2*12,2*14,2,1,22,411,421,411,421,21,
+ &-11,-13,-15,-1,-2,-3,-4,2*21,22,21,2*-211,111,22,111,211,22,211,
+ &-211,11,2*-211,111,-211,111,22,11,22,111,-211,211,111,211,22,211,
+ &111,211,-211,22,11,13,11,-211,2*111,2*22,111,211,-321,-211,111,
+ &11,2*-211,7*12,7*14,-321,-323,-311,-313,-311,-313,211,213,211,
+ &213,211,213,111,221,331,113,223,111,221,113,223,321,323,321,-211,
+ &-213,111,221,331,113,223,333,10221,111,221,331,113,223,211,213,
+ &211,213,321,323,321,323,321,323,311,313,311,313,2*-1,-3,-1,2203,
+ &3201,3203,2203,2101,2103,12,14,-1,-3,2*111,2*211,12,14,-1,-3,22,
+ &111,2*22,111,22,12,14,-1,-3,22,12,14,-1,-3,12,14,-1,-3,12,14,-1,
+ &-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,2*-211,11,13,
+ &15,-211,-213,-20213,-431,-433,3*3122,1,4,3,4,1,3,11,13,15,1,4,3,
+ &4,1,3,11,13,15,1,4,3,4,1,3,2*111,2*211,11,13,15,1,4,3,4,1,3,11,
+ &13,15,1,4,3,4,1,3,4*22,11,13,15,1,4,3,4,1,3,22,11,13,15,1,4,3,4,
+ &1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,
+ &3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3/
+ DATA (KFDP(I,2),I=1353,1815)/11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,
+ &4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,
+ &1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,
+ &3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,
+ &2*111,2*211,-211,111,-321,130,310,-211,111,211,-211,111,-213,113,
+ &-211,111,223,211,111,213,113,211,111,223,-211,111,-321,130,310,
+ &2*-211,-311,311,-321,321,211,111,211,111,-211,111,-211,111,311,
+ &2*321,311,22,2*-82,-211,111,-211,111,211,111,211,111,-321,-311,
+ &-321,-311,411,421,411,421,22,2*21,-211,2*211,111,-211,111,2*211,
+ &111,-211,211,111,211,-321,2*-311,-321,22,-211,111,211,111,-311,
+ &311,-321,321,211,111,-211,111,321,311,22,-82,-211,111,211,111,
+ &-321,-311,411,421,22,21,-11,-13,-82,211,111,221,111,4*22,-11,-13,
+ &-15,-1,-2,-3,-4,2*21,211,111,3*22,1,2*2,4*1,2*-24,2*-37,2*1,3,5,
+ &1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3,
+ &-5,2,2*1,4*2,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3,
+ &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,
+ &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,2*24,2*37,4,1,3,5,1,3,5,1,3,5,-3,
+ &2*-5,5,2*6,4*5,2*-24,2*-37,5,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,
+ &4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6,2*5,4*6,2*24,2*37,6,4,-15,
+ &16,1,3,5,1,3,5,1,3,5,-3,2*-5,11,2*12,4*11,2*-24,-37,13,15,11,15/
+ DATA (KFDP(I,2),I=1816,2317)/11,13,11,13,15,11,13,15,1,3,5,1,3,5,
+ &1,3,5,12,2*11,4*12,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5,
+ &13,2*14,4*13,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3,
+ &5,1,3,5,1,3,5,14,2*13,4*14,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3,
+ &5,1,3,5,15,2*16,4*15,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,
+ &13,15,1,3,5,1,3,5,1,3,5,16,2*15,4*16,2*24,2*37,11,13,15,11,13,15,
+ &1,3,5,1,3,5,1,3,5,21,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5,
+ &5,-5,5,-6,6,-6,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6,
+ &1,-1,3,-3,5,-5,1,-1,3,-3,5,-5,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,
+ &-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,
+ &-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,
+ &-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,
+ &-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,
+ &-3,3,-1,1,-1,1,-3,3,22,23,25,35,36,-1,-3,-13,13,-13,13,-13,13,
+ &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15,
+ &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1,
+ &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,
+ &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,
+ &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,
+ &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3/
+ DATA (KFDP(I,2),I=2318,2770)/3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22,
+ &23,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,-24,24,11,
+ &-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15,-15,1,-1,3,
+ &-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5,5,-5,
+ &5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13,13,-14,14,-14,
+ &14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13,
+ &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15,
+ &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1,
+ &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,
+ &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,
+ &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,
+ &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,
+ &3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,24,37,24,-11,-13,-15,-1,-3,24,
+ &-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,4*37,
+ &2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13,2*14,2*-15,2*16,-1,
+ &-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15,16,2*-15,16,-15,
+ &6*-11,-15,16,2*-15,16,2*-15,16,-15,6*-11,6*-13,-1,-2,-1,2,-1,-2,
+ &-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,
+ &-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,
+ &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1/
+ DATA (KFDP(I,2),I=2771,3221)/2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,
+ &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1,
+ &2*4,-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,22,23,25,35,36,22,23,11,13,
+ &15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,
+ &25,35,36,-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,
+ &-13,15,-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,
+ &-4,4,-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,
+ &-13,13,-14,14,-14,14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13,
+ &13,-13,13,-13,13,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,
+ &15,-15,15,-15,15,-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,
+ &-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,
+ &-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,
+ &-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,
+ &-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,
+ &-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22,23,25,35,36,
+ &22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14,
+ &16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,
+ &-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15,
+ &-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,
+ &-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13/
+ DATA (KFDP(I,2),I=3222,3669)/13,-14,14,-14,14,-15,15,-15,15,-16,
+ &16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13,-15,15,-15,15,-15,15,
+ &-11,11,-11,11,-11,11,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,
+ &-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,
+ &3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,
+ &2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,
+ &5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,
+ &4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1,
+ &1,-1,1,-3,3,24,37,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,24,-11,
+ &-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,
+ &-13,-15,-1,-3,4*37,2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13,
+ &2*14,2*-15,2*16,-1,-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15,
+ &16,2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-15,16,2*-15,16,
+ &2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-13,14,2*-13,14,2*-13,
+ &14,-13,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,
+ &-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,
+ &-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,
+ &6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,
+ &-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1,2*4,
+ &-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,1,2*2,4*1,23,25,35,36,2*-24/
+ DATA (KFDP(I,2),I=3670,4183)/2*-37,2*1,3,5,1,3,5,1,3,5,1,2,3,4,5,
+ &6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3,-5,2,2*1,4*2,23,25,35,
+ &36,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3,23,25,35,36,
+ &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,
+ &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,23,25,35,36,2*24,2*37,4,1,3,5,1,
+ &3,5,1,3,5,-3,2*-5,5,2*6,4*5,23,25,35,36,2*-24,2*-37,5,1,3,5,1,3,
+ &5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6,
+ &2*5,4*6,23,25,35,36,2*24,2*37,6,1,3,5,1,3,5,1,3,5,-3,2*-5,11,
+ &2*12,4*11,23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,
+ &13,15,1,3,5,1,3,5,1,3,5,13,2*14,4*13,23,25,35,36,2*-24,2*-37,13,
+ &15,11,15,11,13,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5,15,2*16,4*15,
+ &23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3,
+ &5,1,3,5,1,3,5,-3,-4,-5,-6,-11,-13,-15,21,-1,-3,2*-5,5,12,14,16,
+ &-3,-4,-5,-6,-11,-13,-15,21,-5,-6,21,-1,-2,-3,-4,-5,-6,-1,-2,-3,
+ &-4,-5,-6,21,-1,-2,-3,-4,-5,-6,21,-1,-2,-3,-4,-5,-6,21,-1,-2,-3,
+ &-4,-5,-6,-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6,3*21,3*1,4*2,1,2*11,
+ &2*12,11,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,
+ &21,22,23,-24,3*-1,3*-3,3*-5,3*1,3*3,3*5,-13,13,-15,15,3*-1,3*-3,
+ &3*-5,3*1,3*3,3*5,-11,11,-15,15,3*-1,3*-3,3*-5,3*1,3*3,3*5,-11,11,
+ &-13,13,-1,-2,-3,-4,-5,-6,-11,-12,9900012,-13,-14,9900014,-15,-16/
+ DATA (KFDP(I,2),I=4184,8000)/9900016,2,4,6,2,4,6,2,4,6,9900012,
+ &9900014,9900016,-11,-13,-15,-13,2*-15,24,-11,-13,-15,-13,2*-15,
+ &9900024,6*21,-24,-3000211,-24,-3000211,3000111,3000221,3000111,
+ &3000221,2*23,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,
+ &-18,23,3000111,23,3000111,22,3000221,22,2,4,6,8,2,4,6,8,2,4,6,8,
+ &2,4,6,8,12,14,16,18,2*3000111,2*3000221,-3000211,2*-24,-3000211,
+ &2*23,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,
+ &-3000211,3000211,3000221,3000113,3000223,-3000213,3000213,
+ &3000113,3000223,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,
+ &-17,-18,24,3000211,24,3000111,3000221,3000211,3000213,3000113,
+ &3000223,3000213,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,
+ &649*0,
+C...UED
+ &1,1,2,2,3,3,4,4,5,5,6,6,
+ &1,2,1,2,1,2,3,4,3,4,3,4,5,6,5,6,5,6,
+ &11,13,15,12,11,14,13,16,15,
+ &-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6,
+ &1,2,3,4,5,6,1,2,3,4,5,6,
+ &22,
+ &-11,-13,-15,-11,-13,-15,-12,-14,-16,
+ &11,13,15,11,13,15,12,14,16,
+ &12,14,16,-11,-13,-15,
+ &2912*0/
+ DATA (KFDP(I,3),I= 1,1021)/81*0,14,6*0,2*16,2*0,6*111,310,130,
+ &2*0,3*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221,
+ &2*113,221,2*113,2*213,-213,113,2*111,310,130,310,130,2*310,130,
+ &402*0,4*3,4*4,1,4,3,2*2,0,-11,8*0,-211,5*0,2*111,211,-211,211,
+ &-211,10*0,111,4*0,2*111,-211,-11,11,-13,22,111,3*0,22,3*0,111,
+ &211,4*0,111,11*0,111,-211,6*0,-211,3*111,7*0,111,-211,5*0,2*221,
+ &3*0,111,5*0,111,11*0,-311,-313,-311,-321,-313,-323,111,221,331,
+ &113,223,-311,-313,-311,-321,-313,-323,111,221,331,113,223,22*0,
+ &111,113,2*211,-211,-311,211,111,3*211,-211,7*211,7*0,111,-211,
+ &111,-211,-321,-323,-311,-321,-313,-323,-211,-213,-321,-323,-311,
+ &-321,-313,-323,-211,-213,22*0,111,113,-311,2*-211,211,-211,310,
+ &-211,2*111,211,2*-211,-321,-211,2*211,-211,111,-211,2*211,6*0,
+ &111,-211,111,-211,0,221,331,333,321,311,221,331,333,321,311,20*0,
+ &3,13*0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413,
+ &-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211,
+ &111,-211,-421,-423,-10423,-10421,-20423,-425,-421,-423,-10423,
+ &-10421,-20423,-425,-421,-423,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211,
+ &111,-211,-431,-433,-10433,-10431,-20433,-435,-431,-433,-10433,
+ &-10431,-20433,-435,-431,-433,19*0,-4,-1,-4,-3,2*-2,8*0,441,443,
+ &441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531,533,531,533,3,2,3,2/
+ DATA (KFDP(I,3),I=1022,2223)/511,513,511,513,1,2,13*0,2*21,11*0,
+ &2112,6*0,2212,12*0,2*3122,3212,10*0,3322,2*0,3122,3212,3214,2112,
+ &2114,2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,6*0,
+ &4*3,4*0,4*3,6*0,4*3,0,28*3,2*0,3*4122,8*0,4,1,4,3,2*2,4*4,1,4,3,
+ &2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3,
+ &2*2,0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,
+ &4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,
+ &3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,
+ &4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,
+ &3,2*2,31*0,211,111,45*0,-211,2*111,-211,3*111,-211,111,211,30*0,
+ &-211,111,13*0,2*21,-211,111,199*0,2*5,210*0,-1,-3,-5,-2,-4,-6,-1,
+ &-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-2,2,-4,4,-6,
+ &6,-2,2,-4,4,-6,6,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,
+ &-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,
+ &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,
+ &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,
+ &-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,-3,3,
+ &-5,5,-5,5,5*0,11,12,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,
+ &-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,
+ &-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/
+ DATA (KFDP(I,3),I=2224,2783)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,
+ &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,
+ &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,
+ &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,
+ &-5,5,-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14,
+ &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12,
+ &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15,
+ &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,
+ &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5,
+ &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,
+ &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,
+ &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,
+ &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,
+ &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,3*0,12,14,16,2,4,0,12,14,16,2,
+ &4,0,12,14,16,2,4,0,12,14,16,2,4,28*0,2,4,12,-11,11,14,-13,13,16,
+ &-15,15,12,-11,11,14,-13,13,16,-15,15,12,11,14,13,16,15,12,-11,11,
+ &14,-13,13,16,-15,15,12,11,14,13,16,15,12,11,14,13,16,15,2*2,1,-1,
+ &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,
+ &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,
+ &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1/
+ DATA (KFDP(I,3),I=2784,3354)/2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,
+ &2*6,5,-5,3,-3,5,-5,1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,7*0,
+ &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14,
+ &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12,
+ &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15,
+ &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,
+ &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5,
+ &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,
+ &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,
+ &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,
+ &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,
+ &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14,-16,
+ &-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,
+ &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,
+ &-2,2,-4,4,2*0,-12,12,-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,
+ &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,
+ &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,
+ &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,
+ &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,
+ &-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/
+ DATA (KFDP(I,3),I=3355,8000)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,
+ &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5,
+ &-5,5,-3,3,-5,5,-5,5,3*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,
+ &4*0,12,14,16,2,4,0,12,14,16,2,4,0,12,14,16,2,4,0,12,14,16,2,4,
+ &28*0,2,4,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,
+ &-15,15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15,
+ &15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15,15,
+ &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,
+ &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,
+ &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,
+ &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,3,-3,5,-5,
+ &1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,351*0,-5,95*0,2,4,6,2,4,
+ &6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900014,2*9900016,2,4,6,2,4,
+ &6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900016,2,4,6,2,4,
+ &6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900014,3831*0/
+ DATA (KFDP(I,4),I= 1,8000)/94*0,4*111,6*0,111,2*0,-211,0,-211,
+ &3*0,111,2*-211,0,111,0,2*111,113,221,2*111,-213,-211,211,113,
+ &6*111,310,2*130,402*0,13*81,41*0,-11,10*0,111,-211,4*0,111,62*0,
+ &111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111,
+ &-211,2*211,2*-211,13*0,-211,111,-211,111,4*0,-211,111,-211,111,
+ &34*0,111,-211,3*111,3*-211,2*111,3*-211,14*0,-321,-311,3*0,-321,
+ &-311,20*0,-3,43*0,6*1,39*0,6*2,42*0,6*3,14*0,8*4,4*0,4*-5,4*0,
+ &2*-5,67*0,-211,111,5*0,-211,111,52*0,2101,2103,2*2101,6*0,4*81,
+ &4*0,4*81,6*0,4*81,0,28*81,13*0,6*2101,18*81,4*0,18*81,4*0,9*81,0,
+ &162*81,31*0,-211,111,6516*0/
+ DATA (KFDP(I,5),I= 1,8000)/96*0,2*111,17*0,111,7*0,2*111,0,
+ &3*111,0,111,597*0,-211,2*111,-211,111,-211,111,65*0,111,-211,
+ &3*111,-211,111,7193*0/
+
+C...PYDAT4, with particle names (character strings).
+ DATA (CHAF(I,1),I= 1, 202)/'d','u','s','c','b','t','b''','t''',
+ &2*' ','e-','nu_e','mu-','nu_mu','tau-','nu_tau','tau''-',
+ &'nu''_tau',2*' ','g','gamma','Z0','W+','h0',6*' ','Z''0','Z"0',
+ &'W''+','H0','A0','H+',' ','Graviton',' ','R0','LQ_ue',38*' ',
+ &'specflav','rndmflav','phasespa','c-hadron','b-hadron',2*' ',
+ &'junction',' ','system','cluster','string','indep.','CMshower',
+ &'SPHEaxis','THRUaxis','CLUSjet','CELLjet','table',' ','reggeon',
+ &'pi0','rho0','a_20','K_L0','pi+','rho+','a_2+','eta','omega',
+ &'f_2','K_S0','K0','K*0','K*_20','K+','K*+','K*_2+','eta''','phi',
+ &'f''_2','D+','D*+','D*_2+','D0','D*0','D*_20','D_s+','D*_s+',
+ &'D*_2s+','eta_c','J/psi','chi_2c','B0','B*0','B*_20','B+','B*+',
+ &'B*_2+','B_s0','B*_s0','B*_2s0','B_c+','B*_c+','B*_2c+','eta_b',
+ &'Upsilon','chi_2b','pomeron','dd_1','Delta-','ud_0','ud_1','n0',
+ &'Delta0','uu_1','p+','Delta+','Delta++','sd_0','sd_1','Sigma-',
+ &'Sigma*-','Lambda0','su_0','su_1','Sigma0','Sigma*0','Sigma+',
+ &'Sigma*+','ss_1','Xi-','Xi*-','Xi0','Xi*0','Omega-','cd_0',
+ &'cd_1','Sigma_c0','Sigma*_c0','Lambda_c+','Xi_c0','cu_0','cu_1',
+ &'Sigma_c+','Sigma*_c+','Sigma_c++','Sigma*_c++','Xi_c+','cs_0',
+ &'cs_1','Xi''_c0','Xi*_c0','Xi''_c+','Xi*_c+','Omega_c0',
+ &'Omega*_c0','cc_1','Xi_cc+','Xi*_cc+','Xi_cc++','Xi*_cc++'/
+ DATA (CHAF(I,1),I= 203, 332)/'Omega_cc+','Omega*_cc+',
+ &'Omega*_ccc++','bd_0','bd_1','Sigma_b-','Sigma*_b-','Lambda_b0',
+ &'Xi_b-','Xi_bc0','bu_0','bu_1','Sigma_b0','Sigma*_b0','Sigma_b+',
+ &'Sigma*_b+','Xi_b0','Xi_bc+','bs_0','bs_1','Xi''_b-','Xi*_b-',
+ &'Xi''_b0','Xi*_b0','Omega_b-','Omega*_b-','Omega_bc0','bc_0',
+ &'bc_1','Xi''_bc0','Xi*_bc0','Xi''_bc+','Xi*_bc+','Omega''_bc0',
+ &'Omega*_bc0','Omega_bcc+','Omega*_bcc+','bb_1','Xi_bb-',
+ &'Xi*_bb-','Xi_bb0','Xi*_bb0','Omega_bb-','Omega*_bb-',
+ &'Omega_bbc0','Omega*_bbc0','Omega*_bbb-','a_00','b_10','a_0+',
+ &'b_1+','f_0','h_1','K*_00','K_10','K*_0+','K_1+','f''_0','h''_1',
+ &'D*_0+','D_1+','D*_00','D_10','D*_0s+','D_1s+','chi_0c','h_1c',
+ &'B*_00','B_10','B*_0+','B_1+','B*_0s0','B_1s0','B*_0c+','B_1c+',
+ &'chi_0b','h_1b','a_10','a_1+','f_1','K*_10','K*_1+','f''_1',
+ &'D*_1+','D*_10','D*_1s+','chi_1c','B*_10','B*_1+','B*_1s0',
+ &'B*_1c+','chi_1b','psi''','Upsilon''','~d_L','~u_L','~s_L',
+ &'~c_L','~b_1','~t_1','~e_L-','~nu_eL','~mu_L-','~nu_muL',
+ &'~tau_1-','~nu_tauL','~g','~chi_10','~chi_20','~chi_1+',
+ &'~chi_30','~chi_40','~chi_2+','~Gravitino','~d_R','~u_R','~s_R',
+ &'~c_R','~b_2','~t_2','~e_R-','~nu_eR','~mu_R-','~nu_muR',
+ &'~tau_2-','~nu_tauR','pi_tc0','pi_tc+','pi''_tc0','eta_tc0'/
+ DATA (CHAF(I,1),I= 333, 500)/'rho_tc0','rho_tc+','omega_tc',
+ &'V8_tc','pi_22_1_tc','pi_22_8_tc','rho_11_tc','rho_12_tc',
+ &'rho_21_tc','rho_22_tc','d*','u*','e*-','nu*_e0','Graviton*',
+ &'nu_Re','nu_Rmu','nu_Rtau','Z_R0','W_R+','H_L++','H_R++',
+ &'rho_diff0','pi_diffr+','omega_di','phi_diff','J/psi_di',
+ &'n_diffr0','p_diffr+','cc~[3S18]','cc~[1S08]','cc~[3P08]',
+ &'bb~[3S18]','bb~[1S08]','bb~[3P08]','a_tc0','a_tc+',
+ &81*' ',
+C...UED
+ &'d*_S','u*_S','s*_S','c*_S','b*_S','t*_S',
+ &'d*_D','u*_D','s*_D','c*_D','b*_D','t*_D',
+ &'e*_S-','mu*_S-','tau*_S-',
+ &'nu*_eD','e*_D-','nu*_muD','mu*_D-','nu*_tauD','tau*_D-',
+ &'g*','gamma*','Z*0','W*+',25*' '/
+ DATA (CHAF(I,2),I= 1, 205)/'dbar','ubar','sbar','cbar','bbar',
+ &'tbar','b''bar','t''bar',2*' ','e+','nu_ebar','mu+','nu_mubar',
+ &'tau+','nu_taubar','tau''+','nu''_taubar',5*' ','W-',9*' ',
+ &'W''-',2*' ','H-',3*' ','Rbar0','LQ_uebar',39*' ','rndmflavbar',
+ &' ','c-hadronbar','b-hadronbar',20*' ','pi-','rho-','a_2-',4*' ',
+ &'Kbar0','K*bar0','K*_2bar0','K-','K*-','K*_2-',3*' ','D-','D*-',
+ &'D*_2-','Dbar0','D*bar0','D*_2bar0','D_s-','D*_s-','D*_2s-',
+ &3*' ','Bbar0','B*bar0','B*_2bar0','B-','B*-','B*_2-','B_sbar0',
+ &'B*_sbar0','B*_2sbar0','B_c-','B*_c-','B*_2c-',4*' ','dd_1bar',
+ &'Deltabar+','ud_0bar','ud_1bar','nbar0','Deltabar0','uu_1bar',
+ &'pbar-','Deltabar-','Deltabar--','sd_0bar','sd_1bar','Sigmabar+',
+ &'Sigma*bar+','Lambdabar0','su_0bar','su_1bar','Sigmabar0',
+ &'Sigma*bar0','Sigmabar-','Sigma*bar-','ss_1bar','Xibar+',
+ &'Xi*bar+','Xibar0','Xi*bar0','Omegabar+','cd_0bar','cd_1bar',
+ &'Sigma_cbar0','Sigma*_cbar0','Lambda_cbar-','Xi_cbar0','cu_0bar',
+ &'cu_1bar','Sigma_cbar-','Sigma*_cbar-','Sigma_cbar--',
+ &'Sigma*_cbar--','Xi_cbar-','cs_0bar','cs_1bar','Xi''_cbar0',
+ &'Xi*_cbar0','Xi''_cbar-','Xi*_cbar-','Omega_cbar0',
+ &'Omega*_cbar0','cc_1bar','Xi_ccbar-','Xi*_ccbar-','Xi_ccbar--',
+ &'Xi*_ccbar--','Omega_ccbar-','Omega*_ccbar-','Omega*_cccbar-'/
+ DATA (CHAF(I,2),I= 206, 325)/'bd_0bar','bd_1bar','Sigma_bbar+',
+ &'Sigma*_bbar+','Lambda_bbar0','Xi_bbar+','Xi_bcbar0','bu_0bar',
+ &'bu_1bar','Sigma_bbar0','Sigma*_bbar0','Sigma_bbar-',
+ &'Sigma*_bbar-','Xi_bbar0','Xi_bcbar-','bs_0bar','bs_1bar',
+ &'Xi''_bbar+','Xi*_bbar+','Xi''_bbar0','Xi*_bbar0','Omega_bbar+',
+ &'Omega*_bbar+','Omega_bcbar0','bc_0bar','bc_1bar','Xi''_bcbar0',
+ &'Xi*_bcbar0','Xi''_bcbar-','Xi*_bcbar-','Omega''_bcba',
+ &'Omega*_bcbar0','Omega_bccbar-','Omega*_bccbar-','bb_1bar',
+ &'Xi_bbbar+','Xi*_bbbar+','Xi_bbbar0','Xi*_bbbar0','Omega_bbbar+',
+ &'Omega*_bbbar+','Omega_bbcbar0','Omega*_bbcbar0',
+ &'Omega*_bbbbar+',2*' ','a_0-','b_1-',2*' ','K*_0bar0','K_1bar0',
+ &'K*_0-','K_1-',2*' ','D*_0-','D_1-','D*_0bar0','D_1bar0',
+ &'D*_0s-','D_1s-',2*' ','B*_0bar0','B_1bar0','B*_0-','B_1-',
+ &'B*_0sbar0','B_1sbar0','B*_0c-','B_1c-',3*' ','a_1-',' ',
+ &'K*_1bar0','K*_1-',' ','D*_1-','D*_1bar0','D*_1s-',' ',
+ &'B*_1bar0','B*_1-','B*_1sbar0','B*_1c-',3*' ','~d_Lbar',
+ &'~u_Lbar','~s_Lbar','~c_Lbar','~b_1bar','~t_1bar','~e_L+',
+ &'~nu_eLbar','~mu_L+','~nu_muLbar','~tau_1+','~nu_tauLbar',3*' ',
+ &'~chi_1-',2*' ','~chi_2-',' ','~d_Rbar','~u_Rbar','~s_Rbar',
+ &'~c_Rbar','~b_2bar','~t_2bar','~e_R+','~nu_eRbar','~mu_R+'/
+ DATA (CHAF(I,2),I= 326, 500)/'~nu_muRbar','~tau_2+',
+ &'~nu_tauRbar',' ','pi_tc-',3*' ','rho_tc-',8*' ','d*bar','u*bar',
+ &'e*bar+','nu*_ebar0',5*' ','W_R-','H_L--','H_R--',' ',
+ &'pi_diffr-',3*' ','n_diffrbar0','p_diffrbar-',7*' ','a_tc-',
+ &81*' ',
+C...UED
+ &'d*_Sbar','u*_Sbar','s*_Sbar','c*_Sbar','b*_Sbar','t*_Sbar',
+ &'d*_Dbar','u*_Dbar','s*_Dbar','c*_Dbar','b*_Dbar','t*_Dbar',
+ &'e*_Sbar+','mu*_Sbar+','tau*_Sbar+',
+ &'nu*_eDbar','e*_Dbar+',
+ &'nu*_muDbar','mu*_Dbar+',
+ &'nu*_tauDbar','tau*_Dbar+',
+ &'g*','gamma*','Z*0','W*-',25*' '/
+
+C...PYDATR, with initial values for the random number generator.
+ DATA MRPY/19780503,0,0,97,33,0/
+
+C...Default values for allowed processes and kinematics constraints.
+ DATA MSEL/1/
+ DATA MSUB/500*0/
+ DATA ((KFIN(I,J),J=-40,40),I=1,2)/16*0,4*1,4*0,6*1,5*0,5*1,0,
+ &5*1,5*0,6*1,4*0,4*1,16*0,16*0,4*1,4*0,6*1,5*0,5*1,0,5*1,5*0,
+ &6*1,4*0,4*1,16*0/
+ DATA CKIN/
+ & 2.0D0, -1.0D0, 0.0D0, -1.0D0, 1.0D0,
+ & 1.0D0, -10D0, 10D0, -40D0, 40D0,
+ 1 -40D0, 40D0, -40D0, 40D0, -40D0,
+ 1 40D0, -1.0D0, 1.0D0, -1.0D0, 1.0D0,
+ 2 0.0D0, 1.0D0, 0.0D0, 1.0D0, -1.0D0,
+ 2 1.0D0, -1.0D0, 1.0D0, 0D0, 0D0,
+ 3 2.0D0, -1.0D0, 0D0, 0D0, 0.0D0,
+ 3 -1.0D0, 0.0D0, -1.0D0, 4.0D0, -1.0D0,
+ 4 12.0D0, -1.0D0, 12.0D0, -1.0D0, 12.0D0,
+ 4 -1.0D0, 12.0D0, -1.0D0, 0D0, 0D0,
+ 5 0.0D0, -1.0D0, 0.0D0, -1.0D0, 0.0D0,
+ 5 -1.0D0, 0D0, 0D0, 0D0, 0D0,
+ 6 0.0001D0, 0.99D0, 0.0001D0, 0.99D0, 0D0,
+ 6 -1D0, 0D0, -1D0, 0D0, -1D0,
+ 7 0D0, -1D0, 0.0001D0, 0.99D0, 0.0001D0,
+ 7 0.99D0, 2D0, -1D0, 0D0, 0D0,
+ 8 120*0D0/
+
+C...Default values for main switches and parameters. Reset information.
+ DATA (MSTP(I),I=1,100)/
+ & 3, 1, 2, 0, 0, 0, 0, 0, 0, 0,
+ 1 1, 0, 1, 30, 0, 1, 4, 3, 4, 3,
+ 2 1, 0, 1, 0, 0, 0, 0, 0, 0, 1,
+ 3 1, 8, 0, 1, 0, 2, 1, 5, 2, 0,
+ 4 2, 1, 3, 7, 3, 1, 1, 0, 1, 0,
+ 5 7, 1, 3, 1, 5, 1, 1, 5, 1, 7,
+ 6 2, 3, 2, 2, 1, 5, 2, 3, 0, 0,
+ 7 1, 1, 0, 0, 0, 0, 0, 0, 0, 0,
+ 8 1, 4, 100, 1, 1, 2, 4, 1, 1, 0,
+ 9 1, 3, 1, 3, 1, 0, 0, 0, 0, 0/
+ DATA (MSTP(I),I=101,200)/
+ & 3, 1, 0, 0, 0, 0, 0, 0, 0, 0,
+ 1 1, 1, 1, 0, 0, 0, 0, 0, 0, 0,
+ 2 0, 1, 2, 1, 1, 100, 0, 0, 10, 0,
+ 3 0, 4, 0, 1, 0, 0, 0, 0, 0, 0,
+ 4 0, 0, 0, 0, 0, 1, 0, 0, 0, 0,
+ 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 7 0, 2, 0, 0, 0, 0, 0, 0, 0, 0,
+ 8 6, 421, 2009, 07, 13, 0, 0, 0, 0, 0,
+ 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
+ DATA (PARP(I),I=1,100)/
+ & 0.25D0, 10D0, 8*0D0,
+ 1 0D0, 0D0, 1.0D0, 0.01D0, 0.5D0, 1.0D0, 1.0D0, 0.4D0, 2*0D0,
+ 2 10*0D0,
+ 3 1.5D0,2.0D0,0.075D0,1.0D0,0.2D0,0D0,1.0D0,0.70D0,0.006D0,0D0,
+ 4 0.02D0,2.0D0,0.10D0,1000D0,2054D0,123D0,246D0,50D0,0D0,0.054D0,
+ 5 10*0D0,
+ 6 0.25D0, 1.0D0,0.25D0, 1.0D0, 2.0D0,1D-3, 4.0D0,1D-3,2*0D0,
+ 7 4.0D0, 0.25D0, 5*0D0, 0.025D0, 2.0D0, 0.1D0,
+ 8 1.90D0, 2.0D0, 0.5D0, 0.4D0, 0.90D0,
+ 8 0.95D0, 0.7D0, 0.5D0, 1800D0, 0.25D0,
+ 9 2.0D0,0.40D0,5.0D0,1.0D0,0.0D0,3.0D0,1.0D0,0.75D0,1.0D0,5.0D0/
+ DATA (PARP(I),I=101,200)/
+ & 0.5D0, 0.28D0, 1.0D0, 0.8D0, 0D0, 0D0, 0D0, 0D0, 0D0, 1D0,
+ 1 2.0D0, 3*0D0, 1.5D0, 0.5D0, 0.6D0, 2.5D0, 2.0D0, 1.0D0,
+ 2 1.0D0, 0.4D0, 8*0D0,
+ 3 0.01D0, 9*0D0,
+ 4 1.16D0, 0.0119D0, 0.01D0, 0.01D0, 0.05D0,
+ 4 9.28D0, 0.15D0, 0.02D0, 0.48D0, 0.09D0,
+ 5 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0,
+ 6 2.20D0, 23.6D0, 18.4D0, 11.5D0, 0.5D0, 0D0, 0D0, 0D0, 2*0D0,
+ 7 0D0, 0D0, 0D0, 1.0D0, 6*0D0,
+ 8 0.1D0, 0.01D0, 0.01D0, 0.01D0, 0.1D0, 0.01D0, 0.01D0, 0.01D0,
+ 8 0.3D0, 0.64D0,
+ 9 0.64D0, 5.0D0, 1.0D4, 1.0D4, 6*0D0/
+ DATA MSTI/200*0/
+ DATA PARI/200*0D0/
+ DATA MINT/400*0/
+ DATA VINT/400*0D0/
+
+C...Constants for the generation of the various processes.
+ DATA (ISET(I),I=1,100)/
+ & 1, 1, 1, -1, 3, -1, -1, 3, -2, 2,
+ 1 2, 2, 2, 2, 2, 2, -1, 2, 2, 2,
+ 2 -1, 2, 2, 2, 2, 2, -1, 2, 2, 2,
+ 3 2, 2, 2, 2, 2, 2, -1, -1, -1, -1,
+ 4 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 5 -1, -1, 2, 2, -1, -1, -1, 2, -1, -1,
+ 6 -1, -1, -1, -1, -1, -1, -1, 2, 2, 2,
+ 7 4, 4, 4, -1, -1, 4, 4, -1, -1, 2,
+ 8 2, 2, 2, 2, 2, 2, 2, 2, 2, -2,
+ 9 0, 0, 0, 0, 0, 9, -2, -2, 8, -2/
+ DATA (ISET(I),I=101,200)/
+ & -1, 1, 1, 1, 1, 2, 2, 2, -2, 2,
+ 1 2, 2, 2, 2, 2, -1, -1, -1, -2, -2,
+ 2 5, 5, 5, 5, -2, -2, -2, -2, -2, -2,
+ 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 4 1, 1, 1, 1, 1, 1, 1, 1, 1, -2,
+ 5 1, 1, 1, -2, -2, 1, 1, 1, -2, -2,
+ 6 2, 2, 2, 2, 2, 2, 2, 2, 2, -2,
+ 7 2, 2, 5, 5, -2, 2, 2, 5, 5, -2,
+ 8 5, 5, 2, 2, 2, 5, 5, 2, 2, 2,
+ 9 1, 1, 1, 2, 2, -2, -2, -2, -2, -2/
+ DATA (ISET(I),I=201,300)/
+ & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 1 2, 2, 2, 2, -2, 2, 2, 2, 2, 2,
+ 2 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 4 2, 2, 2, 2, -1, 2, 2, 2, 2, 2,
+ 5 2, 2, 2, 2, -1, 2, -1, 2, 2, -2,
+ 6 2, 2, 2, 2, 2, -1, -1, -1, -1, -1,
+ 7 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 8 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 9 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/
+ DATA (ISET(I),I=301,500)/
+ & 2, 9*-2, 9*2, 21*-2,
+ 4 1, 1, 2, 2, 2, 2, 2, 2, 2, 2,
+ 5 5, 5, 1, 1, -1, -1, -1, -1, -1, -1,
+ 6 2, 2, 2, 2, 2, 2, 2, 2, -1, 2,
+ 7 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 8 2, 2, 2, 2, 2, 2, 2, 2, -2, -2,
+ 9 1, 1, 2, 2, 2, 5*-2,
+ & 5, 5, 18*-2,
+ 2 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 21*-2,
+ 6 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 7 2, 2, 2, 2, 2, 2, 2, 2, 2, 21*-2/
+ DATA ((KFPR(I,J),J=1,2),I=1,50)/
+ & 23, 0, 24, 0, 25, 0, 24, 0, 25, 0,
+ & 24, 0, 23, 0, 25, 0, 0, 0, 0, 0,
+ 1 0, 0, 0, 0, 21, 21, 21, 22, 21, 23,
+ 1 21, 24, 21, 25, 22, 22, 22, 23, 22, 24,
+ 2 22, 25, 23, 23, 23, 24, 23, 25, 24, 24,
+ 2 24, 25, 25, 25, 0, 21, 0, 22, 0, 23,
+ 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23,
+ 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23,
+ 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23,
+ 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23/
+ DATA ((KFPR(I,J),J=1,2),I=51,100)/
+ 5 0, 24, 0, 25, 0, 0, 0, 0, 0, 0,
+ 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 6 0, 0, 0, 0, 21, 21, 24, 24, 23, 24,
+ 7 23, 23, 24, 24, 23, 24, 23, 25, 22, 22,
+ 7 23, 23, 24, 24, 24, 25, 25, 25, 0, 211,
+ 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 8 443, 21,10441, 21,20443, 21, 445, 21, 0, 0,
+ 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
+ DATA ((KFPR(I,J),J=1,2),I=101,150)/
+ & 23, 0, 25, 0, 25, 0,10441, 0, 445, 0,
+ & 443, 22, 443, 21, 443, 22, 0, 0, 22, 25,
+ 1 21, 25, 0, 25, 21, 25, 22, 22, 21, 22,
+ 1 22, 23, 23, 23, 24, 24, 0, 0, 0, 0,
+ 2 25, 6, 25, 6, 25, 0, 25, 0, 0, 0,
+ 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 3 0, 21, 0, 21, 0, 22, 0, 22, 0, 0,
+ 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 4 32, 0, 34, 0, 37, 0, 41, 0, 42, 0,
+ 4 4000011, 0, 4000001, 0, 4000002, 0, 3000331, 0, 0, 0/
+ DATA ((KFPR(I,J),J=1,2),I=151,200)/
+ 5 35, 0, 35, 0, 35, 0, 0, 0, 0, 0,
+ 5 36, 0, 36, 0, 36, 0, 0, 0, 0, 0,
+ 6 6, 37, 42, 0, 42, 42, 42, 42, 11, 0,
+ 6 11, 0, 0, 4000001, 0, 4000002, 0, 4000011, 0, 0,
+ 7 23, 35, 24, 35, 35, 0, 35, 0, 0, 0,
+ 7 23, 36, 24, 36, 36, 0, 36, 0, 0, 0,
+ 8 35, 6, 35, 6, 21, 35, 0, 35, 21, 35,
+ 8 36, 6, 36, 6, 21, 36, 0, 36, 21, 36,
+ 9 3000113, 0, 3000213, 0, 3000223, 0, 11, 0, 11, 0,
+ 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
+ DATA ((KFPR(I,J),J=1,2),I=201,240)/
+ & 1000011, 1000011, 2000011, 2000011, 1000011,
+ & 2000011, 1000013, 1000013, 2000013, 2000013,
+ & 1000013, 2000013, 1000015, 1000015, 2000015,
+ & 2000015, 1000015, 2000015, 1000011, 1000012,
+ 1 1000015, 1000016, 2000015, 1000016, 1000012,
+ 1 1000012, 1000016, 1000016, 0, 0,
+ 1 1000022, 1000022, 1000023, 1000023, 1000025,
+ 1 1000025, 1000035, 1000035, 1000022, 1000023,
+ 2 1000022, 1000025, 1000022, 1000035, 1000023,
+ 2 1000025, 1000023, 1000035, 1000025, 1000035,
+ 2 1000024, 1000024, 1000037, 1000037, 1000024,
+ 2 1000037, 1000022, 1000024, 1000023, 1000024,
+ 3 1000025, 1000024, 1000035, 1000024, 1000022,
+ 3 1000037, 1000023, 1000037, 1000025, 1000037,
+ 3 1000035, 1000037, 1000021, 1000022, 1000021,
+ 3 1000023, 1000021, 1000025, 1000021, 1000035/
+ DATA ((KFPR(I,J),J=1,2),I=241,280)/
+ 4 1000021, 1000024, 1000021, 1000037, 1000021,
+ 4 1000021, 1000021, 1000021, 0, 0,
+ 4 1000002, 1000022, 2000002, 1000022, 1000002,
+ 4 1000023, 2000002, 1000023, 1000002, 1000025,
+ 5 2000002, 1000025, 1000002, 1000035, 2000002,
+ 5 1000035, 1000001, 1000024, 2000005, 1000024,
+ 5 1000001, 1000037, 2000005, 1000037, 1000002,
+ 5 1000021, 2000002, 1000021, 0, 0,
+ 6 1000006, 1000006, 2000006, 2000006, 1000006,
+ 6 2000006, 1000006, 1000006, 2000006, 2000006,
+ 6 0, 0, 0, 0, 0,
+ 6 0, 0, 0, 0, 0,
+ 7 1000002, 1000002, 2000002, 2000002, 1000002,
+ 7 2000002, 1000002, 1000002, 2000002, 2000002,
+ 7 1000002, 2000002, 1000002, 1000002, 2000002,
+ 7 2000002, 1000002, 1000002, 2000002, 2000002/
+ DATA ((KFPR(I,J),J=1,2),I=281,350)/
+ 8 1000005, 1000002, 2000005, 2000002, 1000005,
+ 8 2000002, 1000005, 1000002, 2000005, 2000002,
+ 8 1000005, 2000002, 1000005, 1000005, 2000005,
+ 8 2000005, 1000005, 1000005, 2000005, 2000005,
+ 9 1000005, 1000005, 2000005, 2000005, 1000005,
+ 9 2000005, 1000005, 1000021, 2000005, 1000021,
+ 9 1000005, 2000005, 37, 25, 37,
+ 9 35, 36, 25, 36, 35,
+ & 37, 37, 18*0,
+C...UED: 311-319
+ & 5100021, 5100021,
+ & 5100002, 5100021,
+ & 5100002, 5100001,
+ & 5100002, -5100002,
+ & 5100002, -5100002,
+ & 5100002, -6100001,
+ & 5100002, -5100001,
+ & 5100002, 6100001,
+ & 5100001, -5100001,
+ & 42*0,
+ 4 9900041, 0, 9900042, 0, 9900041,
+ 4 11, 9900042, 11, 9900041, 13,
+ 4 9900042, 13, 9900041, 15, 9900042,
+ 4 15, 9900041, 9900041, 9900042, 9900042/
+ DATA ((KFPR(I,J),J=1,2),I=351,400)/
+ 5 9900041, 0, 9900042, 0, 9900023,
+ 5 0, 9900024, 0, 0, 0,
+ 5 0, 0, 0, 0, 0,
+ 5 0, 0, 0, 0, 0,
+ 6 24, 24, 24, 3000211, 3000211,
+ 6 3000211, 22, 3000111, 22, 3000221,
+ 6 23, 3000111, 23, 3000221, 24,
+ 6 3000211, 0, 0, 24, 23,
+ 7 24, 3000111, 3000211, 23, 3000211,
+ 7 3000111, 22, 3000211, 23, 3000211,
+ 7 24, 3000111, 24, 3000221, 22,
+ 7 24, 22, 23, 23, 23,
+ 8 0, 0, 0, 0, 21, 21, 0, 21, 0, 0,
+ 8 21, 21, 0, 0, 0, 0, 0, 0, 0, 0,
+ 9 5000039, 0, 5000039, 0, 21,
+ 9 5000039, 0, 5000039, 21, 5000039,
+ 9 10*0/
+ DATA ((KFPR(I,J),J=1,2),I=401,500)/
+ & 37, 6, 37, 6, 36*0,
+ 2 443, 21, 9900443, 21, 9900441,
+ 2 21, 9910441, 21, 0, 9900443,
+ 2 0, 9900441, 0, 9910441, 21,
+ 2 9900443, 21, 9900441, 21, 9910441,
+ 3 10441, 21, 20443, 21, 445, 21, 0, 10441, 0, 20443,
+ 3 0, 445, 21, 10441, 21, 20443, 21, 445, 42*0,
+ 6 553, 21, 9900553, 21, 9900551,
+ 6 21, 9910551, 21, 0, 9900553,
+ 6 0, 9900551, 0, 9910551, 21,
+ 6 9900553, 21, 9900551, 21, 9910551,
+ 7 10551, 21, 20553, 21, 555, 21, 0, 10551, 0, 20553,
+ 7 0, 555, 21, 10551, 21, 20553, 21, 555, 42*0/
+ DATA COEF/10000*0D0/
+ DATA (((ICOL(I,J,K),K=1,2),J=1,4),I=1,40)/
+ &4,0,3,0,2,0,1,0,3,0,4,0,1,0,2,0,2,0,0,1,4,0,0,3,3,0,0,4,1,0,0,2,
+ &3,0,0,4,1,4,3,2,4,0,0,3,4,2,1,3,2,0,4,1,4,0,2,3,4,0,3,4,2,0,1,2,
+ &3,2,1,0,1,4,3,0,4,3,3,0,2,1,1,0,3,2,1,4,1,0,0,2,2,4,3,1,2,0,0,1,
+ &3,2,1,4,1,4,3,2,4,2,1,3,4,2,1,3,3,4,4,3,1,2,2,1,2,0,3,1,2,0,0,0,
+ &4,2,1,0,0,0,1,0,3,0,0,3,1,2,0,0,4,0,0,4,0,0,1,2,2,0,0,1,4,4,3,3,
+ &2,2,1,1,4,4,3,3,3,3,4,4,1,1,2,2,3,2,1,3,1,2,0,0,4,2,1,4,0,0,1,2,
+ &4,0,0,0,4,0,1,3,0,0,3,0,2,4,3,0,3,4,0,0,1,0,0,1,0,0,3,4,2,0,0,2,
+ &3,0,0,0,1,0,0,0,0,0,3,0,2,0,0,0,2,0,3,1,2,0,0,0,3,2,1,0,1,0,0,0,
+ &4,4,3,3,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ &0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/
+
+C...Treatment of resonances.
+ DATA (MWID(I) ,I= 1, 500)/5*0,3*1,8*0,1,5*0,3*1,6*0,1,0,4*1,
+ &3*0,2*1,254*0,19*2,0,7*2,0,2,0,2,0,26*1,7*0,6*2,2*1,
+ &81*0,21*1,4*1,25*0/
+
+C...Character constants: name of processes.
+ DATA PROC(0)/ 'All included subprocesses '/
+ DATA (PROC(I),I=1,20)/
+ &'f + fbar -> gamma*/Z0 ', 'f + fbar'' -> W+/- ',
+ &'f + fbar -> h0 ', 'gamma + W+/- -> W+/- ',
+ &'Z0 + Z0 -> h0 ', 'Z0 + W+/- -> W+/- ',
+ &' ', 'W+ + W- -> h0 ',
+ &' ', 'f + f'' -> f + f'' (QFD) ',
+ 1'f + f'' -> f + f'' (QCD) ','f + fbar -> f'' + fbar'' ',
+ 1'f + fbar -> g + g ', 'f + fbar -> g + gamma ',
+ 1'f + fbar -> g + Z0 ', 'f + fbar'' -> g + W+/- ',
+ 1'f + fbar -> g + h0 ', 'f + fbar -> gamma + gamma ',
+ 1'f + fbar -> gamma + Z0 ', 'f + fbar'' -> gamma + W+/- '/
+ DATA (PROC(I),I=21,40)/
+ 2'f + fbar -> gamma + h0 ', 'f + fbar -> Z0 + Z0 ',
+ 2'f + fbar'' -> Z0 + W+/- ', 'f + fbar -> Z0 + h0 ',
+ 2'f + fbar -> W+ + W- ', 'f + fbar'' -> W+/- + h0 ',
+ 2'f + fbar -> h0 + h0 ', 'f + g -> f + g ',
+ 2'f + g -> f + gamma ', 'f + g -> f + Z0 ',
+ 3'f + g -> f'' + W+/- ', 'f + g -> f + h0 ',
+ 3'f + gamma -> f + g ', 'f + gamma -> f + gamma ',
+ 3'f + gamma -> f + Z0 ', 'f + gamma -> f'' + W+/- ',
+ 3'f + gamma -> f + h0 ', 'f + Z0 -> f + g ',
+ 3'f + Z0 -> f + gamma ', 'f + Z0 -> f + Z0 '/
+ DATA (PROC(I),I=41,60)/
+ 4'f + Z0 -> f'' + W+/- ', 'f + Z0 -> f + h0 ',
+ 4'f + W+/- -> f'' + g ', 'f + W+/- -> f'' + gamma ',
+ 4'f + W+/- -> f'' + Z0 ', 'f + W+/- -> f'' + W+/- ',
+ 4'f + W+/- -> f'' + h0 ', 'f + h0 -> f + g ',
+ 4'f + h0 -> f + gamma ', 'f + h0 -> f + Z0 ',
+ 5'f + h0 -> f'' + W+/- ', 'f + h0 -> f + h0 ',
+ 5'g + g -> f + fbar ', 'g + gamma -> f + fbar ',
+ 5'g + Z0 -> f + fbar ', 'g + W+/- -> f + fbar'' ',
+ 5'g + h0 -> f + fbar ', 'gamma + gamma -> f + fbar ',
+ 5'gamma + Z0 -> f + fbar ', 'gamma + W+/- -> f + fbar'' '/
+ DATA (PROC(I),I=61,80)/
+ 6'gamma + h0 -> f + fbar ', 'Z0 + Z0 -> f + fbar ',
+ 6'Z0 + W+/- -> f + fbar'' ', 'Z0 + h0 -> f + fbar ',
+ 6'W+ + W- -> f + fbar ', 'W+/- + h0 -> f + fbar'' ',
+ 6'h0 + h0 -> f + fbar ', 'g + g -> g + g ',
+ 6'gamma + gamma -> W+ + W- ', 'gamma + W+/- -> Z0 + W+/- ',
+ 7'Z0 + Z0 -> Z0 + Z0 ', 'Z0 + Z0 -> W+ + W- ',
+ 7'Z0 + W+/- -> Z0 + W+/- ', 'Z0 + Z0 -> Z0 + h0 ',
+ 7'W+ + W- -> gamma + gamma ', 'W+ + W- -> Z0 + Z0 ',
+ 7'W+/- + W+/- -> W+/- + W+/- ', 'W+/- + h0 -> W+/- + h0 ',
+ 7'h0 + h0 -> h0 + h0 ', 'q + gamma -> q'' + pi+/- '/
+ DATA (PROC(I),I=81,100)/
+ 8'q + qbar -> Q + Qbar, mass ', 'g + g -> Q + Qbar, massive ',
+ 8'f + q -> f'' + Q, massive ', 'g + gamma -> Q + Qbar, mass ',
+ 8'gamma + gamma -> F + Fbar, m', 'g + g -> J/Psi + g ',
+ 8'g + g -> chi_0c + g ', 'g + g -> chi_1c + g ',
+ 8'g + g -> chi_2c + g ', ' ',
+ 9'Elastic scattering ', 'Single diffractive (XB) ',
+ 9'Single diffractive (AX) ', 'Double diffractive ',
+ 9'Low-pT scattering ', 'Semihard QCD 2 -> 2 ',
+ 9' ', ' ',
+ 9'q + gamma* -> q ', ' '/
+ DATA (PROC(I),I=101,120)/
+ &'g + g -> gamma*/Z0 ', 'g + g -> h0 ',
+ &'gamma + gamma -> h0 ', 'g + g -> chi_0c ',
+ &'g + g -> chi_2c ', 'g + g -> J/Psi + gamma ',
+ &'gamma + g -> J/Psi + g ', 'gamma+gamma -> J/Psi + gamma',
+ &' ', 'f + fbar -> gamma + h0 ',
+ 1'q + qbar -> g + h0 ', 'q + g -> q + h0 ',
+ 1'g + g -> g + h0 ', 'g + g -> gamma + gamma ',
+ 1'g + g -> g + gamma ', 'g + g -> gamma + Z0 ',
+ 1'g + g -> Z0 + Z0 ', 'g + g -> W+ + W- ',
+ 1' ', ' '/
+ DATA (PROC(I),I=121,140)/
+ 2'g + g -> Q + Qbar + h0 ', 'q + qbar -> Q + Qbar + h0 ',
+ 2'f + f'' -> f + f'' + h0 ',
+ 2'f + f'' -> f" + f"'' + h0 ',
+ 2' ', ' ',
+ 2' ', ' ',
+ 2' ', ' ',
+ 3'f + gamma*_T -> f + g ', 'f + gamma*_L -> f + g ',
+ 3'f + gamma*_T -> f + gamma ', 'f + gamma*_L -> f + gamma ',
+ 3'g + gamma*_T -> f + fbar ', 'g + gamma*_L -> f + fbar ',
+ 3'gamma*_T+gamma*_T -> f+fbar ', 'gamma*_T+gamma*_L -> f+fbar ',
+ 3'gamma*_L+gamma*_T -> f+fbar ', 'gamma*_L+gamma*_L -> f+fbar '/
+ DATA (PROC(I),I=141,160)/
+ 4'f + fbar -> gamma*/Z0/Z''0 ', 'f + fbar'' -> W''+/- ',
+ 4'f + fbar'' -> H+/- ', 'f + fbar'' -> R ',
+ 4'q + l -> LQ ', 'e + gamma -> e* ',
+ 4'd + g -> d* ', 'u + g -> u* ',
+ 4'g + g -> eta_tc ', ' ',
+ 5'f + fbar -> H0 ', 'g + g -> H0 ',
+ 5'gamma + gamma -> H0 ', ' ',
+ 5' ', 'f + fbar -> A0 ',
+ 5'g + g -> A0 ', 'gamma + gamma -> A0 ',
+ 5' ', ' '/
+ DATA (PROC(I),I=161,180)/
+ 6'f + g -> f'' + H+/- ', 'q + g -> LQ + lbar ',
+ 6'g + g -> LQ + LQbar ', 'q + qbar -> LQ + LQbar ',
+ 6'f + fbar -> f'' + fbar'' (g/Z)',
+ 6'f +fbar'' -> f" + fbar"'' (W) ',
+ 6'q + q'' -> q" + d* ', 'q + q'' -> q" + u* ',
+ 6'q + qbar -> e + e* ', ' ',
+ 7'f + fbar -> Z0 + H0 ', 'f + fbar'' -> W+/- + H0 ',
+ 7'f + f'' -> f + f'' + H0 ',
+ 7'f + f'' -> f" + f"'' + H0 ',
+ 7' ', 'f + fbar -> Z0 + A0 ',
+ 7'f + fbar'' -> W+/- + A0 ',
+ 7'f + f'' -> f + f'' + A0 ',
+ 7'f + f'' -> f" + f"'' + A0 ',
+ 7' '/
+ DATA (PROC(I),I=181,200)/
+ 8'g + g -> Q + Qbar + H0 ', 'q + qbar -> Q + Qbar + H0 ',
+ 8'q + qbar -> g + H0 ', 'q + g -> q + H0 ',
+ 8'g + g -> g + H0 ', 'g + g -> Q + Qbar + A0 ',
+ 8'q + qbar -> Q + Qbar + A0 ', 'q + qbar -> g + A0 ',
+ 8'q + g -> q + A0 ', 'g + g -> g + A0 ',
+ 9'f + fbar -> rho_tc0 ', 'f + f'' -> rho_tc+/- ',
+ 9'f + fbar -> omega_tc0 ', 'f+fbar -> f''+fbar'' (ETC) ',
+ 9'f+fbar'' -> f"+fbar"'' (ETC)',' ',
+ 9' ', ' ',
+ 9' ', ' '/
+ DATA (PROC(I),I=201,220)/
+ &'f + fbar -> ~e_L + ~e_Lbar ', 'f + fbar -> ~e_R + ~e_Rbar ',
+ &'f + fbar -> ~e_R + ~e_Lbar ', 'f + fbar -> ~mu_L + ~mu_Lbar',
+ &'f + fbar -> ~mu_R + ~mu_Rbar', 'f + fbar -> ~mu_L + ~mu_Rbar',
+ &'f+fbar -> ~tau_1 + ~tau_1bar', 'f+fbar -> ~tau_2 + ~tau_2bar',
+ &'f+fbar -> ~tau_1 + ~tau_2bar', 'q + qbar'' -> ~l_L + ~nulbar ',
+ 1'q+qbar''-> ~tau_1 + ~nutaubar', 'q+qbar''-> ~tau_2 + ~nutaubar',
+ 1'f + fbar -> ~nul + ~nulbar ', 'f+fbar -> ~nutau + ~nutaubar',
+ 1' ', 'f + fbar -> ~chi1 + ~chi1 ',
+ 1'f + fbar -> ~chi2 + ~chi2 ', 'f + fbar -> ~chi3 + ~chi3 ',
+ 1'f + fbar -> ~chi4 + ~chi4 ', 'f + fbar -> ~chi1 + ~chi2 '/
+ DATA (PROC(I),I=221,240)/
+ 2'f + fbar -> ~chi1 + ~chi3 ', 'f + fbar -> ~chi1 + ~chi4 ',
+ 2'f + fbar -> ~chi2 + ~chi3 ', 'f + fbar -> ~chi2 + ~chi4 ',
+ 2'f + fbar -> ~chi3 + ~chi4 ', 'f+fbar -> ~chi+-1 + ~chi-+1 ',
+ 2'f+fbar -> ~chi+-2 + ~chi-+2 ', 'f+fbar -> ~chi+-1 + ~chi-+2 ',
+ 2'q + qbar'' -> ~chi1 + ~chi+-1', 'q + qbar'' -> ~chi2 + ~chi+-1',
+ 3'q + qbar'' -> ~chi3 + ~chi+-1', 'q + qbar'' -> ~chi4 + ~chi+-1',
+ 3'q + qbar'' -> ~chi1 + ~chi+-2', 'q + qbar'' -> ~chi2 + ~chi+-2',
+ 3'q + qbar'' -> ~chi3 + ~chi+-2', 'q + qbar'' -> ~chi4 + ~chi+-2',
+ 3'q + qbar -> ~chi1 + ~g ', 'q + qbar -> ~chi2 + ~g ',
+ 3'q + qbar -> ~chi3 + ~g ', 'q + qbar -> ~chi4 + ~g '/
+ DATA (PROC(I),I=241,260)/
+ 4'q + qbar'' -> ~chi+-1 + ~g ', 'q + qbar'' -> ~chi+-2 + ~g ',
+ 4'q + qbar -> ~g + ~g ', 'g + g -> ~g + ~g ',
+ 4' ', 'qj + g -> ~qj_L + ~chi1 ',
+ 4'qj + g -> ~qj_R + ~chi1 ', 'qj + g -> ~qj_L + ~chi2 ',
+ 4'qj + g -> ~qj_R + ~chi2 ', 'qj + g -> ~qj_L + ~chi3 ',
+ 5'qj + g -> ~qj_R + ~chi3 ', 'qj + g -> ~qj_L + ~chi4 ',
+ 5'qj + g -> ~qj_R + ~chi4 ', 'qj + g -> ~qk_L + ~chi+-1 ',
+ 5'qj + g -> ~qk_R + ~chi+-1 ', 'qj + g -> ~qk_L + ~chi+-2 ',
+ 5'qj + g -> ~qk_R + ~chi+-2 ', 'qj + g -> ~qj_L + ~g ',
+ 5'qj + g -> ~qj_R + ~g ', ' '/
+ DATA (PROC(I),I=261,300)/
+ 6'f + fbar -> ~t_1 + ~t_1bar ', 'f + fbar -> ~t_2 + ~t_2bar ',
+ 6'f + fbar -> ~t_1 + ~t_2bar ', 'g + g -> ~t_1 + ~t_1bar ',
+ 6'g + g -> ~t_2 + ~t_2bar ', ' ',
+ 6' ', ' ',
+ 6' ', ' ',
+ 7'qi + qj -> ~qi_L + ~qj_L ', 'qi + qj -> ~qi_R + ~qj_R ',
+ 7'qi + qj -> ~qi_L + ~qj_R ', 'qi+qjbar -> ~qi_L + ~qj_Lbar',
+ 7'qi+qjbar -> ~qi_R + ~qj_Rbar', 'qi+qjbar -> ~qi_L + ~qj_Rbar',
+ 7'f + fbar -> ~qi_L + ~qi_Lbar', 'f + fbar -> ~qi_R + ~qi_Rbar',
+ 7'g + g -> ~qi_L + ~qi_Lbar ', 'g + g -> ~qi_R + ~qi_Rbar ',
+ 8'b + qj -> ~b_1 + ~qj_L ', 'b + qj -> ~b_2 + ~qj_R ',
+ 8'b + qj -> ~b_1 + ~qj_R ', 'b + qjbar -> ~b_1 + ~qj_Lbar',
+ 8'b + qjbar -> ~b_2 + ~qj_Rbar', 'b + qjbar -> ~b_1 + ~qj_Rbar',
+ 8'f + fbar -> ~b_1 + ~b_1bar ', 'f + fbar -> ~b_2 + ~b_2bar ',
+ 8'g + g -> ~b_1 + ~b_1bar ', 'g + g -> ~b_2 + ~b_2bar ',
+ 9'b + b -> ~b_1 + ~b_1 ', 'b + b -> ~b_2 + ~b_2 ',
+ 9'b + b -> ~b_1 + ~b_2 ', 'b + g -> ~b_1 + ~g ',
+ 9'b + g -> ~b_2 + ~g ', 'b + bbar -> ~b_1 + ~b_2bar ',
+ 9'f + fbar'' -> H+/- + h0 ', 'f + fbar -> H+/- + H0 ',
+ 9'f + fbar -> A0 + h0 ', 'f + fbar -> A0 + H0 '/
+ DATA (PROC(I),I=301,340)/
+ &'f + fbar -> H+ + H- ',
+ &9*' ', 'g + g -> g* + g* ',
+ &'q + g -> q*_D + g* ', 'qi + qj -> q*_Di + q*_Dj ',
+ &'g + g -> q*_D + q*_Dbar ', 'q + qbar -> q*_D + q*_Dbar ',
+ &'qi + qbarj -> q*Di + q*Sbarj', 'qi + qjbar -> q*Di + q*Dbarj',
+ &'qi + qj -> q*_Di + q*_Sj ', 'qi + qibar -> q*Dj + q*Dbarj',
+ &21*' '/
+ DATA (PROC(I),I=341,380)/
+ 4'l + l -> H_L++/-- ', 'l + l -> H_R++/-- ',
+ 4'l + gamma -> H_L++/-- e-/+ ', 'l + gamma -> H_R++/-- e-/+ ',
+ 4'l + gamma -> H_L++/-- mu-/+ ', 'l + gamma -> H_R++/-- mu-/+ ',
+ 4'l + gamma -> H_L++/-- tau-/+', 'l + gamma -> H_R++/-- tau-/+',
+ 4'f + fbar -> H_L++ + H_L-- ', 'f + fbar -> H_R++ + H_R-- ',
+ 5'f + f -> f'' + f'' + H_L++/-- ',
+ 5'f + f -> f'' + f'' + H_R++/-- ','f + fbar -> Z_R0 ',
+ 5'f + fbar'' -> W_R+/- ',5*' ',
+ 6' ', 'f + fbar -> W_L+ W_L- ',
+ 6'f + fbar -> W_L+/- pi_T-/+ ', 'f + fbar -> pi_T+ pi_T- ',
+ 6'f + fbar -> gamma pi_T0 ', 'f + fbar -> gamma pi_T0'' ',
+ 6'f + fbar -> Z0 pi_T0 ', 'f + fbar -> Z0 pi_T0'' ',
+ 6'f + fbar -> W+/- pi_T-/+ ', ' ',
+ 7'f + fbar'' -> W_L+/- Z_L0 ', 'f + fbar'' -> W_L+/- pi_T0 ',
+ 7'f + fbar'' -> pi_T+/- Z_L0 ', 'f + fbar'' -> pi_T+/- pi_T0 ',
+ 7'f + fbar'' -> gamma pi_T+/- ', 'f + fbar'' -> Z0 pi_T+/- ',
+ 7'f + fbar'' -> W+/- pi_T0 ',
+ 7'f + fbar'' -> W+/- pi_T0'' ',
+ 7'f + fbar'' -> gamma W+/-(ETC)','f + fbar -> gamma Z0 (ETC)',
+ 7'f + fbar -> Z0 Z0 (ETC) '/
+ DATA (PROC(I),I=381,420)/
+ 8'f + f'' -> f + f'' (ETC) ','f + fbar -> f'' + fbar'' (ETC)',
+ 8'f + fbar -> g + g (ETC) ', 'f + g -> f + g (ETC) ',
+ 8'g + g -> f + fbar (ETC) ', 'g + g -> g + g (ETC) ',
+ 8'q + qbar -> Q + Qbar (ETC) ', 'g + g -> Q + Qbar (ETC) ',
+ 8' ', ' ',
+ 9'f + fbar -> G* ', 'g + g -> G* ',
+ 9'q + qbar -> g + G* ', 'q + g -> q + G* ',
+ 9'g + g -> g + G* ', ' ',
+ 9 4*' ',
+ &'g + g -> t + b + H+/- ', 'q + qbar -> t + b + H+/- ',
+ & 18*' '/
+ DATA (PROC(I),I=421,460)/
+ 2'g + g -> cc~[3S1(1)] + g ', 'g + g -> cc~[3S1(8)] + g ',
+ 2'g + g -> cc~[1S0(8)] + g ', 'g + g -> cc~[3PJ(8)] + g ',
+ 2'g + q -> q + cc~[3S1(8)] ', 'g + q -> q + cc~[1S0(8)] ',
+ 2'g + q -> q + cc~[3PJ(8)] ', 'q + q~ -> g + cc~[3S1(8)] ',
+ 2'q + q~ -> g + cc~[1S0(8)] ', 'q + q~ -> g + cc~[3PJ(8)] ',
+ 3'g + g -> cc~[3P0(1)] + g ', 'g + g -> cc~[3P1(1)] + g ',
+ 3'g + g -> cc~[3P2(1)] + g ', 'q + g -> q + cc~[3P0(1)] ',
+ 3'q + g -> q + cc~[3P1(1)] ', 'q + g -> q + cc~[3P2(1)] ',
+ 3'q + q~ -> g + cc~[3P0(1)] ', 'q + q~ -> g + cc~[3P1(1)] ',
+ 3'q + q~ -> g + cc~[3P2(1)] ',
+ 3 21 *' '/
+ DATA (PROC(I),I=461,500)/
+ 6'g + g -> bb~[3S1(1)] + g ', 'g + g -> bb~[3S1(8)] + g ',
+ 6'g + g -> bb~[1S0(8)] + g ', 'g + g -> bb~[3PJ(8)] + g ',
+ 6'g + q -> q + bb~[3S1(8)] ', 'g + q -> q + bb~[1S0(8)] ',
+ 6'g + q -> q + bb~[3PJ(8)] ', 'q + q~ -> g + bb~[3S1(8)] ',
+ 6'q + q~ -> g + bb~[1S0(8)] ', 'q + q~ -> g + bb~[3PJ(8)] ',
+ 7'g + g -> bb~[3P0(1)] + g ', 'g + g -> bb~[3P1(1)] + g ',
+ 7'g + g -> bb~[3P2(1)] + g ', 'q + g -> q + bb~[3P0(1)] ',
+ 7'q + g -> q + bb~[3P1(1)] ', 'q + g -> q + bb~[3P2(1)] ',
+ 7'q + q~ -> g + bb~[3P0(1)] ', 'q + q~ -> g + bb~[3P1(1)] ',
+ 7'q + q~ -> g + bb~[3P2(1)] ',
+ 7 21 *' '/
+
+C...Cross sections and slope offsets.
+ DATA SIGT/294*0D0/
+
+C...Supersymmetry switches and parameters.
+ DATA IMSS/0,
+ & 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
+ 1 89*0/
+ DATA RMSS/0D0,
+ & 80D0,160D0,500D0,800D0,2D0,250D0,200D0,800D0,700D0,800D0,
+ 1 700D0,500D0,250D0,200D0,800D0,400D0,0D0,0.1D0,850D0,0.041D0,
+ 2 1D0,800D0,1D4,1D4,1D4,0D0,0D0,0D0,24D17,0D0,
+ 3 10*0D0,
+ 4 0D0,1D0,8*0D0,
+ 5 49*0D0/
+C...Initial values for R-violating SUSY couplings.
+C...Should not be changed here. See PYMSIN.
+ DATA RVLAM/27*0D0/
+ DATA RVLAMP/27*0D0/
+ DATA RVLAMB/27*0D0/
+
+C...Technicolor switches and parameters
+ DATA ITCM/0,
+ & 4, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 1 89*0/
+ DATA RTCM/0D0,
+ & 82D0,1.333D0,.333D0,0.408D0,1D0,1D0,.0182D0,1D0,0D0,1.333D0,
+ 1 .05D0,200D0,200D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,
+ 2 .283D0,.707D0,0D0,0D0,0D0,1.667D0,250D0,250D0,.707D0,0D0,
+ 3 .707D0,0D0,1D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0,
+ 4 1000D0, 1D0, 1D0, 1D0, 1D0, 0D0, 1D0, 3*200D0,
+ 4 200D0, 48*0D0/
+
+C...UED switches and parameters.
+C... IUED(0) empty IUED vector element
+C... IUED(1) UED ON(=1)/OFF(=0) switch
+C... IUED(2) ON(=1)/OFF(=0) switch for gravity mediated decays
+C... IUED(3) NFLAVOURS Number of KK excitation quark flavours
+C... IUED(4) N the number of large extra dimensions
+C... IUED(5) Selects whether the code takes Lambda (=0)
+C... or Lambda*R (=1) as input.
+C... IUED(6) With radiative corrections to the masses (=1)
+C... or without (=0)
+C...
+C... RUED(0) empty RUED vector element
+C... RUED(1) RINV (1/R) the curvature of the extra dimension
+C... RUED(2) XMD the (4+N)-dimensional Planck scale
+C... RUED(3) LAMUED (Lambda cutoff scale)
+C... RUED(4) LAMUED/RINV (feasible values are order of 10-20)
+C...
+ DATA IUED/0,0,0,5,6,0,1,93*0/
+ DATA RUED/0.D0,1000D0,5000D0,20000.,20.,95*0D0/
+
+C...Data for histogramming routines.
+ DATA IHIST/1000,20000,55,1/
+ DATA INDX/1000*0/
+
+C...Data for SUSY Les Houches Accord.
+ DATA CPRO/'PYTHIA ','PYTHIA '/
+ DATA CVER/'6.4 ','6.4 '/
+ DATA MODSEL/200*0/
+ DATA PARMIN/100*0D0/
+ DATA RMSOFT/101*0D0/
+ DATA AU/9*0D0/
+ DATA AD/9*0D0/
+ DATA AE/9*0D0/
+
+ END
+
+C*********************************************************************
+
+C...PYCKBD
+C...Check that BLOCK DATA PYDATA has been loaded.
+C...Should not be required, except that some compilers/linkers
+C...are pretty buggy in this respect.
+
+ SUBROUTINE PYCKBD
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+C...Commonblocks.
+ COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYDAT3/MDCY(500,3),MDME(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)
+ SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/
+
+C...Check a few variables to see they have been sensibly initialized.
+ IF(MSTU(4).LT.10.OR.MSTU(4).GT.900000.OR.PMAS(2,1).LT.0.001D0
+ &.OR.PMAS(2,1).GT.1D0.OR.CKIN(5).LT.0.01D0.OR.MSTP(1).LT.1.OR.
+ &MSTP(1).GT.5) THEN
+C...If not, abort the run right away.
+ WRITE(*,*) 'Fatal error: BLOCK DATA PYDATA has not been loaded!'
+ WRITE(*,*) 'The program execution is stopped now!'
+ CALL PYSTOP(8)
+ ENDIF
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYTEST
+C...A simple program (disguised as subroutine) to run at installation
+C...as a check that the program works as intended.
+
+ SUBROUTINE PYTEST(MTEST)
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+C...Commonblocks.
+ COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYDAT3/MDCY(500,3),MDME(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)
+ SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/
+C...Local arrays.
+ DIMENSION PSUM(5),PINI(6),PFIN(6)
+
+C...Save defaults for values that are changed.
+ MSTJ1=MSTJ(1)
+ MSTJ3=MSTJ(3)
+ MSTJ11=MSTJ(11)
+ MSTJ42=MSTJ(42)
+ MSTJ43=MSTJ(43)
+ MSTJ44=MSTJ(44)
+ PARJ17=PARJ(17)
+ PARJ22=PARJ(22)
+ PARJ43=PARJ(43)
+ PARJ54=PARJ(54)
+ MST101=MSTJ(101)
+ MST104=MSTJ(104)
+ MST105=MSTJ(105)
+ MST107=MSTJ(107)
+ MST116=MSTJ(116)
+
+C...First part: loop over simple events to be generated.
+ IF(MTEST.GE.1) CALL PYTABU(20)
+ NERR=0
+ DO 180 IEV=1,500
+
+C...Reset parameter values. Switch on some nonstandard features.
+ MSTJ(1)=1
+ MSTJ(3)=0
+ MSTJ(11)=1
+ MSTJ(42)=2
+ MSTJ(43)=4
+ MSTJ(44)=2
+ PARJ(17)=0.1D0
+ PARJ(22)=1.5D0
+ PARJ(43)=1D0
+ PARJ(54)=-0.05D0
+ MSTJ(101)=5
+ MSTJ(104)=5
+ MSTJ(105)=0
+ MSTJ(107)=1
+ IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3
+
+C...Ten events each for some single jets configurations.
+ IF(IEV.LE.50) THEN
+ ITY=(IEV+9)/10
+ MSTJ(3)=-1
+ IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2
+ IF(ITY.EQ.1) CALL PY1ENT(1,1,15D0,0D0,0D0)
+ IF(ITY.EQ.2) CALL PY1ENT(1,3101,15D0,0D0,0D0)
+ IF(ITY.EQ.3) CALL PY1ENT(1,-2203,15D0,0D0,0D0)
+ IF(ITY.EQ.4) CALL PY1ENT(1,-4,30D0,0D0,0D0)
+ IF(ITY.EQ.5) CALL PY1ENT(1,21,15D0,0D0,0D0)
+
+C...Ten events each for some simple jet systems; string fragmentation.
+ ELSEIF(IEV.LE.130) THEN
+ ITY=(IEV-41)/10
+ IF(ITY.EQ.1) CALL PY2ENT(1,1,-1,40D0)
+ IF(ITY.EQ.2) CALL PY2ENT(1,4,-4,30D0)
+ IF(ITY.EQ.3) CALL PY2ENT(1,2,2103,100D0)
+ IF(ITY.EQ.4) CALL PY2ENT(1,21,21,40D0)
+ IF(ITY.EQ.5) CALL PY3ENT(1,2101,21,-3203,30D0,0.6D0,0.8D0)
+ IF(ITY.EQ.6) CALL PY3ENT(1,5,21,-5,40D0,0.9D0,0.8D0)
+ IF(ITY.EQ.7) CALL PY3ENT(1,21,21,21,60D0,0.7D0,0.5D0)
+ IF(ITY.EQ.8) CALL PY4ENT(1,2,21,21,-2,40D0,
+ & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0)
+
+C...Seventy events with independent fragmentation and momentum cons.
+ ELSEIF(IEV.LE.200) THEN
+ ITY=1+(IEV-131)/16
+ MSTJ(2)=1+MOD(IEV-131,4)
+ MSTJ(3)=1+MOD((IEV-131)/4,4)
+ IF(ITY.EQ.1) CALL PY2ENT(1,4,-5,40D0)
+ IF(ITY.EQ.2) CALL PY3ENT(1,3,21,-3,40D0,0.9D0,0.4D0)
+ IF(ITY.EQ.3) CALL PY4ENT(1,2,21,21,-2,40D0,
+ & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0)
+ IF(ITY.GE.4) CALL PY4ENT(1,2,-3,3,-2,40D0,
+ & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0)
+
+C...A hundred events with random jets (check invariant mass).
+ ELSEIF(IEV.LE.300) THEN
+ 100 DO 110 J=1,5
+ PSUM(J)=0D0
+ 110 CONTINUE
+ NJET=2D0+6D0*PYR(0)
+ DO 130 I=1,NJET
+ KFL=21
+ IF(I.EQ.1) KFL=INT(1D0+4D0*PYR(0))
+ IF(I.EQ.NJET) KFL=-INT(1D0+4D0*PYR(0))
+ EJET=5D0+20D0*PYR(0)
+ THETA=ACOS(2D0*PYR(0)-1D0)
+ PHI=6.2832D0*PYR(0)
+ IF(I.LT.NJET) CALL PY1ENT(-I,KFL,EJET,THETA,PHI)
+ IF(I.EQ.NJET) CALL PY1ENT(I,KFL,EJET,THETA,PHI)
+ IF(I.EQ.1.OR.I.EQ.NJET) MSTJ(93)=1
+ IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+PYMASS(KFL)
+ DO 120 J=1,4
+ PSUM(J)=PSUM(J)+P(I,J)
+ 120 CONTINUE
+ 130 CONTINUE
+ IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT.
+ & (PSUM(5)+PARJ(32))**2) GOTO 100
+
+C...Fifty e+e- continuum events with matrix elements.
+ ELSEIF(IEV.LE.350) THEN
+ MSTJ(101)=2
+ CALL PYEEVT(0,40D0)
+
+C...Fifty e+e- continuum event with varying shower options.
+ ELSEIF(IEV.LE.400) THEN
+ MSTJ(42)=1+MOD(IEV,2)
+ MSTJ(43)=1+MOD(IEV/2,4)
+ MSTJ(44)=MOD(IEV/8,3)
+ CALL PYEEVT(0,90D0)
+
+C...Fifty e+e- continuum events with coherent shower.
+ ELSEIF(IEV.LE.450) THEN
+ CALL PYEEVT(0,500D0)
+
+C...Fifty Upsilon decays to ggg or gammagg with coherent shower.
+ ELSE
+ CALL PYONIA(5,9.46D0)
+ ENDIF
+
+C...Generate event. Find total momentum, energy and charge.
+ DO 140 J=1,4
+ PINI(J)=PYP(0,J)
+ 140 CONTINUE
+ PINI(6)=PYP(0,6)
+ CALL PYEXEC
+ DO 150 J=1,4
+ PFIN(J)=PYP(0,J)
+ 150 CONTINUE
+ PFIN(6)=PYP(0,6)
+
+C...Check conservation of energy, momentum and charge;
+C...usually exact, but only approximate for single jets.
+ MERR=0
+ IF(IEV.LE.50) THEN
+ IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.10D0)
+ & MERR=MERR+1
+ EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3)
+ IF(EPZREM.LT.0D0.OR.EPZREM.GT.2D0*PARJ(31)) MERR=MERR+1
+ IF(ABS(PFIN(6)-PINI(6)).GT.2.1D0) MERR=MERR+1
+ ELSE
+ DO 160 J=1,4
+ IF(ABS(PFIN(J)-PINI(J)).GT.0.0001D0*PINI(4)) MERR=MERR+1
+ 160 CONTINUE
+ IF(ABS(PFIN(6)-PINI(6)).GT.0.1D0) MERR=MERR+1
+ ENDIF
+ IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6),
+ & (PFIN(J),J=1,4),PFIN(6)
+
+C...Check that all KF codes are known ones, and that partons/particles
+C...satisfy energy-momentum-mass relation. Store particle statistics.
+ DO 170 I=1,N
+ IF(K(I,1).GT.20) GOTO 170
+ IF(PYCOMP(K(I,2)).EQ.0) THEN
+ WRITE(MSTU(11),5100) I
+ MERR=MERR+1
+ ENDIF
+ PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2
+ IF(ABS(PD).GT.MAX(0.1D0,0.001D0*P(I,4)**2).OR.P(I,4).LT.0D0)
+ & THEN
+ WRITE(MSTU(11),5200) I
+ MERR=MERR+1
+ ENDIF
+ 170 CONTINUE
+ IF(MTEST.GE.1) CALL PYTABU(21)
+
+C...List all erroneous events and some normal ones.
+ IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN
+ IF(MERR.GE.1) WRITE(MSTU(11),6400)
+ CALL PYLIST(2)
+ ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN
+ CALL PYLIST(1)
+ ENDIF
+
+C...Stop execution if too many errors.
+ IF(MERR.NE.0) NERR=NERR+1
+ IF(NERR.GE.10) THEN
+ WRITE(MSTU(11),6300)
+ CALL PYLIST(1)
+ CALL PYSTOP(9)
+ ENDIF
+ 180 CONTINUE
+
+C...Summarize result of run.
+ IF(MTEST.GE.1) CALL PYTABU(22)
+
+C...Reset commonblock variables changed during run.
+ MSTJ(1)=MSTJ1
+ MSTJ(3)=MSTJ3
+ MSTJ(11)=MSTJ11
+ MSTJ(42)=MSTJ42
+ MSTJ(43)=MSTJ43
+ MSTJ(44)=MSTJ44
+ PARJ(17)=PARJ17
+ PARJ(22)=PARJ22
+ PARJ(43)=PARJ43
+ PARJ(54)=PARJ54
+ MSTJ(101)=MST101
+ MSTJ(104)=MST104
+ MSTJ(105)=MST105
+ MSTJ(107)=MST107
+ MSTJ(116)=MST116
+
+C...Second part: complete events of various kinds.
+C...Common initial values. Loop over initiating conditions.
+ MSTP(122)=MAX(0,MIN(2,MTEST))
+ MDCY(PYCOMP(111),1)=0
+ DO 230 IPROC=1,8
+
+C...Reset process type, kinematics cuts, and the flags used.
+ MSEL=0
+ DO 190 ISUB=1,500
+ MSUB(ISUB)=0
+ 190 CONTINUE
+ CKIN(1)=2D0
+ CKIN(3)=0D0
+ MSTP(2)=1
+ MSTP(11)=0
+ MSTP(33)=0
+ MSTP(81)=1
+ MSTP(82)=1
+ MSTP(111)=1
+ MSTP(131)=0
+ MSTP(133)=0
+ PARP(131)=0.01D0
+
+C...Prompt photon production at fixed target.
+ IF(IPROC.EQ.1) THEN
+ PZSUM=300D0
+ PESUM=SQRT(PZSUM**2+PYMASS(211)**2)+PYMASS(2212)
+ PQSUM=2D0
+ MSEL=10
+ CKIN(3)=5D0
+ CALL PYINIT('FIXT','pi+','p',PZSUM)
+
+C...QCD processes at ISR energies.
+ ELSEIF(IPROC.EQ.2) THEN
+ PESUM=63D0
+ PZSUM=0D0
+ PQSUM=2D0
+ MSEL=1
+ CKIN(3)=5D0
+ CALL PYINIT('CMS','p','p',PESUM)
+
+C...W production + multiple interactions at CERN Collider.
+ ELSEIF(IPROC.EQ.3) THEN
+ PESUM=630D0
+ PZSUM=0D0
+ PQSUM=0D0
+ MSEL=12
+ CKIN(1)=20D0
+ MSTP(82)=4
+ MSTP(2)=2
+ MSTP(33)=3
+ CALL PYINIT('CMS','p','pbar',PESUM)
+
+C...W/Z gauge boson pairs + pileup events at the Tevatron.
+ ELSEIF(IPROC.EQ.4) THEN
+ PESUM=1800D0
+ PZSUM=0D0
+ PQSUM=0D0
+ MSUB(22)=1
+ MSUB(23)=1
+ MSUB(25)=1
+ CKIN(1)=200D0
+ MSTP(111)=0
+ MSTP(131)=1
+ MSTP(133)=2
+ PARP(131)=0.04D0
+ CALL PYINIT('CMS','p','pbar',PESUM)
+
+C...Higgs production at LHC.
+ ELSEIF(IPROC.EQ.5) THEN
+ PESUM=15400D0
+ PZSUM=0D0
+ PQSUM=2D0
+ MSUB(3)=1
+ MSUB(102)=1
+ MSUB(123)=1
+ MSUB(124)=1
+ PMAS(25,1)=300D0
+ CKIN(1)=200D0
+ MSTP(81)=0
+ MSTP(111)=0
+ CALL PYINIT('CMS','p','p',PESUM)
+
+C...Z' production at SSC.
+ ELSEIF(IPROC.EQ.6) THEN
+ PESUM=40000D0
+ PZSUM=0D0
+ PQSUM=2D0
+ MSEL=21
+ PMAS(32,1)=600D0
+ CKIN(1)=400D0
+ MSTP(81)=0
+ MSTP(111)=0
+ CALL PYINIT('CMS','p','p',PESUM)
+
+C...W pair production at 1 TeV e+e- collider.
+ ELSEIF(IPROC.EQ.7) THEN
+ PESUM=1000D0
+ PZSUM=0D0
+ PQSUM=0D0
+ MSUB(25)=1
+ MSUB(69)=1
+ MSTP(11)=1
+ CALL PYINIT('CMS','e+','e-',PESUM)
+
+C...Deep inelastic scattering at a LEP+LHC ep collider.
+ ELSEIF(IPROC.EQ.8) THEN
+ P(1,1)=0D0
+ P(1,2)=0D0
+ P(1,3)=8000D0
+ P(2,1)=0D0
+ P(2,2)=0D0
+ P(2,3)=-80D0
+ PESUM=8080D0
+ PZSUM=7920D0
+ PQSUM=0D0
+ MSUB(10)=1
+ CKIN(3)=50D0
+ MSTP(111)=0
+ CALL PYINIT('3MOM','p','e-',PESUM)
+ ENDIF
+
+C...Generate 20 events of each required type.
+ DO 220 IEV=1,20
+ CALL PYEVNT
+ PESUMM=PESUM
+ IF(IPROC.EQ.4) PESUMM=MSTI(41)*PESUM
+
+C...Check conservation of energy/momentum/flavour.
+ PINI(1)=0D0
+ PINI(2)=0D0
+ PINI(3)=PZSUM
+ PINI(4)=PESUMM
+ PINI(6)=PQSUM
+ DO 200 J=1,4
+ PFIN(J)=PYP(0,J)
+ 200 CONTINUE
+ PFIN(6)=PYP(0,6)
+ MERR=0
+ DEVE=ABS(PFIN(4)-PINI(4))+ABS(PFIN(3)-PINI(3))
+ DEVT=ABS(PFIN(1)-PINI(1))+ABS(PFIN(2)-PINI(2))
+ DEVQ=ABS(PFIN(6)-PINI(6))
+ IF(DEVE.GT.2D-3*PESUM.OR.DEVT.GT.MAX(0.01D0,1D-4*PESUM).OR.
+ & DEVQ.GT.0.1D0) MERR=1
+ IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6),
+ & (PFIN(J),J=1,4),PFIN(6)
+
+C...Check that all KF codes are known ones, and that partons/particles
+C...satisfy energy-momentum-mass relation.
+ DO 210 I=1,N
+ IF(K(I,1).GT.20) GOTO 210
+ IF(PYCOMP(K(I,2)).EQ.0) THEN
+ WRITE(MSTU(11),5100) I
+ MERR=MERR+1
+ ENDIF
+ PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2*
+ & SIGN(1D0,P(I,5))
+ IF(ABS(PD).GT.MAX(0.1D0,0.002D0*P(I,4)**2,0.002D0*P(I,5)**2)
+ & .OR.(P(I,5).GE.0D0.AND.P(I,4).LT.0D0)) THEN
+ WRITE(MSTU(11),5200) I
+ MERR=MERR+1
+ ENDIF
+ 210 CONTINUE
+
+C...Listing of erroneous events, and first event of each type.
+ IF(MERR.GE.1) NERR=NERR+1
+ IF(NERR.GE.10) THEN
+ WRITE(MSTU(11),6300)
+ CALL PYLIST(1)
+ CALL PYSTOP(9)
+ ENDIF
+ IF(MTEST.GE.1.AND.(MERR.GE.1.OR.IEV.EQ.1)) THEN
+ IF(MERR.GE.1) WRITE(MSTU(11),6400)
+ CALL PYLIST(1)
+ ENDIF
+ 220 CONTINUE
+
+C...List statistics for each process type.
+ IF(MTEST.GE.1) CALL PYSTAT(1)
+ 230 CONTINUE
+
+C...Summarize result of run.
+ IF(NERR.EQ.0) WRITE(MSTU(11),6500)
+ IF(NERR.GT.0) WRITE(MSTU(11),6600) NERR
+
+C...Format statements for output.
+ 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ',
+ &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X,
+ &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X,
+ &4(1X,F12.5),1X,F8.2)
+ 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code')
+ 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ',
+ &'kinematics')
+ 6300 FORMAT(/5X,'This is the tenth error experienced! Something is ',
+ &'wrong.'/5X,'Execution will be stopped after listing of event.')
+ 6400 FORMAT(5X,'Faulty event follows:')
+ 6500 FORMAT(//5X,'End result of PYTEST: no errors detected.')
+ 6600 FORMAT(//5X,'End result of PYTEST:',I2,' errors detected.'/
+ &5X,'This should not have happened!')
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYHEPC
+C...Converts PYTHIA event record contents to or from
+C...the standard event record commonblock.
+
+ SUBROUTINE PYHEPC(MCONV)
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+C...Commonblocks.
+ COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ SAVE /PYJETS/,/PYDAT1/,/PYDAT2/
+C...HEPEVT commonblock.
+ PARAMETER (NMXHEP=4000)
+ COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
+ &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
+ DOUBLE PRECISION PHEP,VHEP
+ SAVE /HEPEVT/
+
+C...Store HEPEVT commonblock size (for interfacing issues).
+ MSTU(8)=NMXHEP
+
+C...Conversion from PYTHIA to standard, the easy part.
+ IF(MCONV.EQ.1) THEN
+ NEVHEP=0
+ IF(N.GT.NMXHEP) CALL PYERRM(8,
+ & '(PYHEPC:) no more space in /HEPEVT/')
+ NHEP=MIN(N,NMXHEP)
+ DO 150 I=1,NHEP
+ ISTHEP(I)=0
+ IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1
+ IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2
+ IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3
+ IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)
+ IDHEP(I)=K(I,2)
+ JMOHEP(1,I)=K(I,3)
+ JMOHEP(2,I)=0
+ IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
+ JDAHEP(1,I)=K(I,4)
+ JDAHEP(2,I)=K(I,5)
+ ELSE
+ JDAHEP(1,I)=0
+ JDAHEP(2,I)=0
+ ENDIF
+ DO 100 J=1,5
+ PHEP(J,I)=P(I,J)
+ 100 CONTINUE
+ DO 110 J=1,4
+ VHEP(J,I)=V(I,J)
+ 110 CONTINUE
+
+C...Check if new event (from pileup).
+ IF(I.EQ.1) THEN
+ INEW=1
+ ELSE
+ IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I
+ ENDIF
+
+C...Fill in missing mother information.
+ IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN
+ IMO1=I-2
+ 120 IF(IMO1.GT.INEW.AND.K(IMO1+1,1).EQ.21.AND.K(IMO1+1,3).EQ.0)
+ & THEN
+ IMO1=IMO1-1
+ GOTO 120
+ ENDIF
+ JMOHEP(1,I)=IMO1
+ JMOHEP(2,I)=IMO1+1
+ ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN
+ I1=K(I,3)-1
+ 130 I1=I1+1
+ IF(I1.GE.I) CALL PYERRM(8,
+ & '(PYHEPC:) translation of inconsistent event history')
+ IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 130
+ KC=PYCOMP(K(I1,2))
+ IF(I1.LT.I.AND.KC.EQ.0) GOTO 130
+ IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 130
+ JMOHEP(2,I)=I1
+ ELSEIF(K(I,2).EQ.94) THEN
+ NJET=2
+ IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3
+ IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4
+ JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5))
+ IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)=
+ & MOD(K(I+1,4)/MSTU(5),MSTU(5))
+ ENDIF
+
+C...Fill in missing daughter information.
+ IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN
+ DO 140 I1=JDAHEP(1,I),JDAHEP(2,I)
+ I2=MOD(K(I1,4)/MSTU(5),MSTU(5))
+ JDAHEP(1,I2)=I
+ 140 CONTINUE
+ ENDIF
+ IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 150
+ I1=JMOHEP(1,I)
+ IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 150
+ IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 150
+ IF(JDAHEP(1,I1).EQ.0) THEN
+ JDAHEP(1,I1)=I
+ ELSE
+ JDAHEP(2,I1)=I
+ ENDIF
+ 150 CONTINUE
+ DO 160 I=1,NHEP
+ IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 160
+ IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I)
+ 160 CONTINUE
+
+C...Conversion from standard to PYTHIA, the easy part.
+ ELSE
+ IF(NHEP.GT.MSTU(4)) CALL PYERRM(8,
+ & '(PYHEPC:) no more space in /PYJETS/')
+ N=MIN(NHEP,MSTU(4))
+ NKQ=0
+ KQSUM=0
+ DO 190 I=1,N
+ K(I,1)=0
+ IF(ISTHEP(I).EQ.1) K(I,1)=1
+ IF(ISTHEP(I).EQ.2) K(I,1)=11
+ IF(ISTHEP(I).EQ.3) K(I,1)=21
+ K(I,2)=IDHEP(I)
+ K(I,3)=JMOHEP(1,I)
+ K(I,4)=JDAHEP(1,I)
+ K(I,5)=JDAHEP(2,I)
+ DO 170 J=1,5
+ P(I,J)=PHEP(J,I)
+ 170 CONTINUE
+ DO 180 J=1,4
+ V(I,J)=VHEP(J,I)
+ 180 CONTINUE
+ V(I,5)=0D0
+ IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN
+ I1=JDAHEP(1,I)
+ IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*
+ & PHEP(5,I)/PHEP(4,I)
+ ENDIF
+
+C...Fill in missing information on colour connection in jet systems.
+ IF(ISTHEP(I).EQ.1) THEN
+ KC=PYCOMP(K(I,2))
+ KQ=0
+ IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
+ IF(KQ.NE.0) NKQ=NKQ+1
+ IF(KQ.NE.2) KQSUM=KQSUM+KQ
+ IF(KQ.NE.0.AND.KQSUM.NE.0) THEN
+ K(I,1)=2
+ ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN
+ IF(K(I+1,2).EQ.21) K(I,1)=2
+ ENDIF
+ ENDIF
+ 190 CONTINUE
+ IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL PYERRM(8,
+ & '(PYHEPC:) input parton configuration not colour singlet')
+ ENDIF
+
+ END
+
+C*********************************************************************
+
+C...PYINIT
+C...Initializes the generation procedure; finds maxima of the
+C...differential cross-sections to be used for weighting.
+
+ SUBROUTINE PYINIT(FRAME,BEAM,TARGET,WIN)
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+C...Commonblocks.
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
+ COMMON/PYDAT4/CHAF(500,2)
+ CHARACTER CHAF*16
+ COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
+ COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
+ COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
+ COMMON/PYPUED/IUED(0:99),RUED(0:99)
+ SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/,
+ &/PYINT1/,/PYINT2/,/PYINT5/,/PYPUED/
+C...Local arrays and character variables.
+ DIMENSION ALAMIN(20),NFIN(20)
+ CHARACTER*(*) FRAME,BEAM,TARGET
+ CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHLH(2)*6
+
+C...Interface to PDFLIB.
+ COMMON/W50511/NPTYPE,NGROUP,NSET,MODE,NFL,LO,TMAS
+ COMMON/W50512/QCDL4,QCDL5
+ SAVE /W50511/,/W50512/
+ DOUBLE PRECISION VALUE(20),TMAS,QCDL4,QCDL5
+ CHARACTER*20 PARM(20)
+ DATA VALUE/20*0D0/,PARM/20*' '/
+
+C...Data:Lambda and n_f values for parton distributions..
+ DATA ALAMIN/0.177D0,0.239D0,0.247D0,0.2322D0,0.248D0,0.248D0,
+ &0.192D0,0.326D0,2*0.2D0,0.2D0,0.2D0,0.29D0,0.2D0,0.4D0,5*0.2D0/,
+ &NFIN/20*4/
+ DATA CHLH/'lepton','hadron'/
+
+C...Check that BLOCK DATA PYDATA has been loaded.
+ CALL PYCKBD
+
+C...Reset MINT and VINT arrays. Write headers.
+ MSTI(53)=0
+ DO 100 J=1,400
+ MINT(J)=0
+ VINT(J)=0D0
+ 100 CONTINUE
+ IF(MSTU(12).NE.12345) CALL PYLIST(0)
+ IF(MSTP(122).GE.1) WRITE(MSTU(11),5100)
+
+C...Reset error counters.
+ MSTU(23)=0
+ MSTU(27)=0
+ MSTU(30)=0
+
+C...Reset processes that should not be on.
+ MSUB(96)=0
+ MSUB(97)=0
+
+C...Select global FSR/ISR/UE parameter set = 'tune'
+C...See routine PYTUNE for details
+ IF (MSTP(5).NE.0) THEN
+ MSTP5=MSTP(5)
+ CALL PYTUNE(MSTP5)
+ ENDIF
+
+C...Call user process initialization routine.
+ IF(FRAME(1:1).EQ.'u'.OR.FRAME(1:1).EQ.'U') THEN
+ MSEL=0
+ CALL UPINIT
+ MSEL=0
+ ENDIF
+
+C...Maximum 4 generations; set maximum number of allowed flavours.
+ MSTP(1)=MIN(4,MSTP(1))
+ MSTU(114)=MIN(MSTU(114),2*MSTP(1))
+ MSTP(58)=MIN(MSTP(58),2*MSTP(1))
+
+C...Sum up Cabibbo-Kobayashi-Maskawa factors for each quark/lepton.
+ DO 120 I=-20,20
+ VINT(180+I)=0D0
+ IA=IABS(I)
+ IF(IA.GE.1.AND.IA.LE.2*MSTP(1)) THEN
+ DO 110 J=1,MSTP(1)
+ IB=2*J-1+MOD(IA,2)
+ IF(IB.GE.6.AND.MSTP(9).EQ.0) GOTO 110
+ IPM=(5-ISIGN(1,I))/2
+ IDC=J+MDCY(IA,2)+2
+ IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) VINT(180+I)=
+ & VINT(180+I)+VCKM((IA+1)/2,(IB+1)/2)
+ 110 CONTINUE
+ ELSEIF(IA.GE.11.AND.IA.LE.10+2*MSTP(1)) THEN
+ VINT(180+I)=1D0
+ ENDIF
+ 120 CONTINUE
+
+C...Initialize parton distributions: PDFLIB.
+ IF(MSTP(52).EQ.2) THEN
+ PARM(1)='NPTYPE'
+ VALUE(1)=1
+ PARM(2)='NGROUP'
+ VALUE(2)=MSTP(51)/1000
+ PARM(3)='NSET'
+ VALUE(3)=MOD(MSTP(51),1000)
+ PARM(4)='TMAS'
+ VALUE(4)=PMAS(6,1)
+ CALL PDFSET_ALICE(PARM,VALUE)
+ MINT(93)=1000000+MSTP(51)
+ ENDIF
+
+C...Choose Lambda value to use in alpha-strong.
+ MSTU(111)=MSTP(2)
+ IF(MSTP(3).GE.2) THEN
+ ALAM=0.2D0
+ NF=4
+ IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.20) THEN
+ ALAM=ALAMIN(MSTP(51))
+ NF=NFIN(MSTP(51))
+ ELSEIF(MSTP(52).EQ.2.AND.NFL.EQ.5) THEN
+ ALAM=QCDL5
+ NF=5
+ ELSEIF(MSTP(52).EQ.2) THEN
+ ALAM=QCDL4
+ NF=4
+ ENDIF
+ PARP(1)=ALAM
+ PARP(61)=ALAM
+ PARP(72)=ALAM
+ PARU(112)=ALAM
+ MSTU(112)=NF
+ IF(MSTP(3).EQ.3) PARJ(81)=ALAM
+ ENDIF
+
+C...Initialize the UED masses and widths
+ IF (IUED(1).EQ.1) CALL PYXDIN
+
+C...Initialize the SUSY generation: couplings, masses,
+C...decay modes, branching ratios, and so on.
+ CALL PYMSIN
+C...Initialize widths and partial widths for resonances.
+ CALL PYINRE
+C...Set Z0 mass and width for e+e- routines.
+ PARJ(123)=PMAS(23,1)
+ PARJ(124)=PMAS(23,2)
+
+C...Identify beam and target particles and frame of process.
+ CHFRAM=FRAME//' '
+ CHBEAM=BEAM//' '
+ CHTARG=TARGET//' '
+ CALL PYINBM(CHFRAM,CHBEAM,CHTARG,WIN)
+ IF(MINT(65).EQ.1) GOTO 170
+
+C...For gamma-p or gamma-gamma allow many (3 or 6) alternatives.
+C...For e-gamma allow 2 alternatives.
+ MINT(121)=1
+ IF(MSTP(14).EQ.10.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN
+ IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND.
+ & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3
+ IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=6
+ IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND.
+ & (IABS(MINT(11)).EQ.11.OR.IABS(MINT(12)).EQ.11)) MINT(121)=2
+ ELSEIF(MSTP(14).EQ.20.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN
+ IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND.
+ & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3
+ IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=9
+ ELSEIF(MSTP(14).EQ.25.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN
+ IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND.
+ & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=2
+ IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=4
+ ELSEIF(MSTP(14).EQ.30.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN
+ IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND.
+ & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=4
+ IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=13
+ ENDIF
+ MINT(123)=MSTP(14)
+ IF((MSTP(14).EQ.10.OR.MSTP(14).EQ.20.OR.MSTP(14).EQ.25.OR.
+ &MSTP(14).EQ.30).AND.MSEL.NE.1.AND.MSEL.NE.2) MINT(123)=0
+ IF(MSTP(14).GE.11.AND.MSTP(14).LE.19) THEN
+ IF(MSTP(14).EQ.11) MINT(123)=0
+ IF(MSTP(14).EQ.12.OR.MSTP(14).EQ.14) MINT(123)=5
+ IF(MSTP(14).EQ.13.OR.MSTP(14).EQ.17) MINT(123)=6
+ IF(MSTP(14).EQ.15) MINT(123)=2
+ IF(MSTP(14).EQ.16.OR.MSTP(14).EQ.18) MINT(123)=7
+ IF(MSTP(14).EQ.19) MINT(123)=3
+ ELSEIF(MSTP(14).GE.21.AND.MSTP(14).LE.24) THEN
+ IF(MSTP(14).EQ.21) MINT(123)=0
+ IF(MSTP(14).EQ.22.OR.MSTP(14).EQ.23) MINT(123)=4
+ IF(MSTP(14).EQ.24) MINT(123)=1
+ ELSEIF(MSTP(14).GE.26.AND.MSTP(14).LE.29) THEN
+ IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28) MINT(123)=8
+ IF(MSTP(14).EQ.27.OR.MSTP(14).EQ.29) MINT(123)=9
+ ENDIF
+
+C...Set up kinematics of process.
+ CALL PYINKI(0)
+
+C...Set up kinematics for photons inside leptons.
+ IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(1,WTGAGA)
+
+C...Precalculate flavour selection weights.
+ CALL PYKFIN
+
+C...Loop over gamma-p or gamma-gamma alternatives.
+ CKIN3=CKIN(3)
+ MSAV48=0
+ DO 160 IGA=1,MINT(121)
+ CKIN(3)=CKIN3
+ MINT(122)=IGA
+
+C...Select partonic subprocesses to be included in the simulation.
+ CALL PYINPR
+ MINT(101)=1
+ MINT(102)=1
+ MINT(103)=MINT(11)
+ MINT(104)=MINT(12)
+
+C...Count number of subprocesses on.
+ MINT(48)=0
+ DO 130 ISUB=1,500
+ IF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND.
+ & MSUB(ISUB).EQ.1.AND.MINT(121).GT.1) THEN
+ MSUB(ISUB)=0
+ ELSEIF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND.
+ & MSUB(ISUB).EQ.1) THEN
+ WRITE(MSTU(11),5200) ISUB,CHLH(MINT(41)),CHLH(MINT(42))
+ CALL PYSTOP(1)
+ ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).EQ.-1) THEN
+ WRITE(MSTU(11),5300) ISUB
+ CALL PYSTOP(1)
+ ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).LE.-2) THEN
+ WRITE(MSTU(11),5400) ISUB
+ CALL PYSTOP(1)
+ ELSEIF(MSUB(ISUB).EQ.1) THEN
+ MINT(48)=MINT(48)+1
+ ENDIF
+ 130 CONTINUE
+
+C...Stop or raise warning flag if no subprocesses on.
+ IF(MINT(121).EQ.1.AND.MINT(48).EQ.0) THEN
+ IF(MSTP(127).NE.1) THEN
+ WRITE(MSTU(11),5500)
+ CALL PYSTOP(1)
+ ELSE
+ WRITE(MSTU(11),5700)
+ MSTI(53)=1
+ ENDIF
+ ENDIF
+ MINT(49)=MINT(48)-MSUB(91)-MSUB(92)-MSUB(93)-MSUB(94)
+ MSAV48=MSAV48+MINT(48)
+
+C...Reset variables for cross-section calculation.
+ DO 150 I=0,500
+ DO 140 J=1,3
+ NGEN(I,J)=0
+ XSEC(I,J)=0D0
+ 140 CONTINUE
+ 150 CONTINUE
+
+C...Find parametrized total cross-sections.
+ CALL PYXTOT
+ VINT(318)=VINT(317)
+
+C...Maxima of differential cross-sections.
+ IF(MSTP(121).LE.1) CALL PYMAXI
+
+C...Initialize possibility of pileup events.
+ IF(MINT(121).GT.1) MSTP(131)=0
+ IF(MSTP(131).NE.0) CALL PYPILE(1)
+
+C...Initialize multiple interactions with variable impact parameter.
+ IF(MINT(50).EQ.1) THEN
+ PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90)
+ IF(MOD(MSTP(81),10).EQ.0.AND.(CKIN(3).GT.PTMN.OR.
+ & ((MSEL.NE.1.AND.MSEL.NE.2)))) MSTP(82)=MIN(1,MSTP(82))
+ IF((MINT(49).NE.0.OR.MSTP(131).NE.0).AND.MSTP(82).GE.2) THEN
+ MINT(35)=1
+ CALL PYMULT(1)
+ MINT(35)=3
+ CALL PYMIGN(1)
+ ENDIF
+ ENDIF
+
+C...Save results for gamma-p and gamma-gamma alternatives.
+ IF(MINT(121).GT.1) CALL PYSAVE(1,IGA)
+ 160 CONTINUE
+
+C...Initialization finished.
+ IF(MSAV48.EQ.0) THEN
+ IF(MSTP(127).NE.1) THEN
+ WRITE(MSTU(11),5500)
+ CALL PYSTOP(1)
+ ELSE
+ WRITE(MSTU(11),5700)
+ MSTI(53)=1
+ ENDIF
+ ENDIF
+ 170 IF(MSTP(122).GE.1) WRITE(MSTU(11),5600)
+
+C...Formats for initialization information.
+ 5100 FORMAT('1',18('*'),1X,'PYINIT: initialization of PYTHIA ',
+ &'routines',1X,17('*'))
+ 5200 FORMAT(1X,'Error: process number ',I3,' not meaningful for ',A6,
+ &'-',A6,' interactions.'/1X,'Execution stopped!')
+ 5300 FORMAT(1X,'Error: requested subprocess',I4,' not implemented.'/
+ &1X,'Execution stopped!')
+ 5400 FORMAT(1X,'Error: requested subprocess',I4,' not existing.'/
+ &1X,'Execution stopped!')
+ 5500 FORMAT(1X,'Error: no subprocess switched on.'/
+ &1X,'Execution stopped.')
+ 5600 FORMAT(/1X,22('*'),1X,'PYINIT: initialization completed',1X,
+ &22('*'))
+ 5700 FORMAT(1X,'Error: no subprocess switched on.'/
+ &1X,'Execution will stop if you try to generate events.')
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYEVNT
+C...Administers the generation of a high-pT event via calls to
+C...a number of subroutines.
+
+ SUBROUTINE PYEVNT
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+ PARAMETER (MAXNUR=1000)
+C...Commonblocks.
+ COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR)
+ COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
+ COMMON/PYCTAG/NCT,MCT(4000,2)
+ 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/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
+ COMMON/PYINT4/MWID(500),WIDS(500,5)
+ COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
+ SAVE /PYJETS/,/PYDAT1/,/PYCTAG/,/PYDAT2/,/PYDAT3/,/PYPARS/,
+ &/PYINT1/,/PYINT2/,/PYINT4/,/PYINT5/
+C...Local array.
+ DIMENSION VTX(4)
+
+C...Optionally let PYEVNW do the whole job.
+ IF(MSTP(81).GE.20) THEN
+ CALL PYEVNW
+ RETURN
+ ENDIF
+
+C...Stop if no subprocesses on.
+ IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN
+ WRITE(MSTU(11),5100)
+ CALL PYSTOP(1)
+ ENDIF
+
+C...Initial values for some counters.
+ MSTU(1)=0
+ MSTU(2)=0
+ N=0
+ MINT(5)=MINT(5)+1
+ MINT(7)=0
+ MINT(8)=0
+ MINT(30)=0
+ MINT(83)=0
+ MINT(84)=MSTP(126)
+ MSTU(24)=0
+ MSTU70=0
+ MSTJ14=MSTJ(14)
+C...Normally, use K(I,4:5) colour info rather than /PYCTAG/.
+ NCT=0
+ MINT(33)=0
+
+C...Let called routines know call is from PYEVNT (not PYEVNW).
+ MINT(35)=1
+ IF (MSTP(81).GE.10) MINT(35)=2
+
+C...If variable energies: redo incoming kinematics and cross-section.
+ MSTI(61)=0
+ IF(MSTP(171).EQ.1) THEN
+ CALL PYINKI(1)
+ IF(MSTI(61).EQ.1) THEN
+ MINT(5)=MINT(5)-1
+ RETURN
+ ENDIF
+ IF(MINT(121).GT.1) CALL PYSAVE(3,1)
+ CALL PYXTOT
+ ENDIF
+
+C...Loop over number of pileup events; check space left.
+ IF(MSTP(131).LE.0) THEN
+ NPILE=1
+ ELSE
+ CALL PYPILE(2)
+ NPILE=MINT(81)
+ ENDIF
+ DO 270 IPILE=1,NPILE
+ IF(MINT(84)+100.GE.MSTU(4)) THEN
+ CALL PYERRM(11,
+ & '(PYEVNT:) no more space in PYJETS for pileup events')
+ IF(MSTU(21).GE.1) GOTO 280
+ ENDIF
+ MINT(82)=IPILE
+
+C...Generate variables of hard scattering.
+ MINT(51)=0
+ MSTI(52)=0
+ 100 CONTINUE
+ IF(MINT(51).NE.0.OR.MSTU(24).NE.0) MSTI(52)=MSTI(52)+1
+ MINT(31)=0
+ MINT(39)=0
+ MINT(51)=0
+ MINT(57)=0
+ CALL PYRAND
+ IF(MSTI(61).EQ.1) THEN
+ MINT(5)=MINT(5)-1
+ RETURN
+ ENDIF
+ IF(MINT(51).EQ.2) RETURN
+ ISUB=MINT(1)
+ IF(MSTP(111).EQ.-1) GOTO 260
+
+C...Loopback point if PYPREP fails, especially for junction topologies.
+ NPREP=0
+ MNT31S=MINT(31)
+ 110 NPREP=NPREP+1
+ MINT(31)=MNT31S
+
+ IF((ISUB.LE.90.OR.ISUB.GE.95).AND.ISUB.NE.99) THEN
+C...Hard scattering (including low-pT):
+C...reconstruct kinematics and colour flow of hard scattering.
+ MINT31=MINT(31)
+ 120 MINT(31)=MINT31
+ MINT(51)=0
+ CALL PYSCAT
+ IF(MINT(51).EQ.1) GOTO 100
+ IPU1=MINT(84)+1
+ IPU2=MINT(84)+2
+ IF(ISUB.EQ.95) GOTO 140
+
+C...Reset statistics on activity in event.
+ DO 130 J=351,359
+ MINT(J)=0
+ VINT(J)=0D0
+ 130 CONTINUE
+
+C...Showering of initial state partons (optional).
+ NFIN=N
+ ALAMSV=PARJ(81)
+ PARJ(81)=PARP(72)
+ IF(MSTP(61).GE.1.AND.MINT(47).GE.2.AND.MINT(111).NE.12)
+ & CALL PYSSPA(IPU1,IPU2)
+ PARJ(81)=ALAMSV
+ IF(MINT(51).EQ.1) GOTO 100
+
+C...pT-ordered FSR off ISR (optional, must have at least 2 partons)
+ IF (NPART.GE.2.AND.(MSTJ(41).EQ.11.OR.MSTJ(41).EQ.12)) THEN
+ PTMAX=0.5*SQRT(PARP(71))*VINT(55)
+ CALL PYPTFS(3,PTMAX,0D0,PTGEN)
+ ENDIF
+
+C...Showering of final state partons (optional).
+ ALAMSV=PARJ(81)
+ PARJ(81)=PARP(72)
+ IF(MSTP(71).GE.1.AND.ISET(ISUB).GE.2.AND.ISET(ISUB).LE.10)
+ & THEN
+ IPU3=MINT(84)+3
+ IPU4=MINT(84)+4
+ IF(ISET(ISUB).EQ.5) IPU4=-3
+ QMAX=VINT(55)
+ IF(ISET(ISUB).EQ.2) QMAX=SQRT(PARP(71))*VINT(55)
+ CALL PYSHOW(IPU3,IPU4,QMAX)
+ ELSEIF(ISET(ISUB).EQ.11) THEN
+ CALL PYADSH(NFIN)
+ ENDIF
+ PARJ(81)=ALAMSV
+
+C...Allow possibility for user to abort event generation.
+ IVETO=0
+ IF(IPILE.EQ.1.AND.MSTP(143).EQ.1) CALL PYVETO(IVETO)
+ IF(IVETO.EQ.1) GOTO 100
+
+C...Decay of final state resonances.
+ MINT(32)=0
+ IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10) CALL PYRESD(0)
+ IF(MINT(51).EQ.1) GOTO 100
+ MINT(52)=N
+
+
+C...Multiple interactions - PYTHIA 6.3 intermediate style.
+ 140 IF(MSTP(81).GE.10.AND.MINT(50).EQ.1) THEN
+ IF(ISUB.EQ.95) MINT(31)=MINT(31)+1
+ CALL PYMIGN(6)
+ IF(MINT(51).EQ.1) GOTO 100
+ MINT(53)=N
+
+C...Beam remnant flavour and colour assignments - new scheme.
+ CALL PYMIHK
+ IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5)
+ & GOTO 120
+ IF(MINT(51).EQ.1) GOTO 100
+
+C...Primordial kT and beam remnant momentum sharing - new scheme.
+ CALL PYMIRM
+ IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5)
+ & GOTO 120
+ IF(MINT(51).EQ.1) GOTO 100
+ IF(ISUB.EQ.95) MINT(31)=MINT(31)-1
+
+C...Multiple interactions - PYTHIA 6.2 style.
+ ELSEIF(MINT(111).NE.12) THEN
+ IF (MSTP(81).GE.1.AND.MINT(50).EQ.1.AND.ISUB.NE.95) THEN
+ CALL PYMULT(6)
+ MINT(53)=N
+ ENDIF
+
+C...Hadron remnants and primordial kT.
+ CALL PYREMN(IPU1,IPU2)
+ IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) GOTO
+ & 110
+ IF(MINT(51).EQ.1) GOTO 100
+ ENDIF
+
+ ELSEIF(ISUB.NE.99) THEN
+C...Diffractive and elastic scattering.
+ CALL PYDIFF
+
+ ELSE
+C...DIS scattering (photon flux external).
+ CALL PYDISG
+ IF(MINT(51).EQ.1) GOTO 100
+ ENDIF
+
+C...Check that no odd resonance left undecayed.
+ MINT(54)=N
+ IF(MSTP(111).GE.1) THEN
+ NFIX=N
+ DO 150 I=MINT(84)+1,NFIX
+ IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND.
+ & K(I,2).NE.22) THEN
+ KCA=PYCOMP(K(I,2))
+ IF(MWID(KCA).NE.0.AND.MDCY(KCA,1).GE.1) THEN
+ CALL PYRESD(I)
+ IF(MINT(51).EQ.1) GOTO 100
+ ENDIF
+ ENDIF
+ 150 CONTINUE
+ ENDIF
+
+C...Boost hadronic subsystem to overall rest frame.
+C..(Only relevant when photon inside lepton beam.)
+ IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(4,WTGAGA)
+
+C...Recalculate energies from momenta and masses (if desired).
+ IF(MSTP(113).GE.1) THEN
+ DO 160 I=MINT(83)+1,N
+ IF(K(I,1).GT.0.AND.K(I,1).LE.10) P(I,4)=SQRT(P(I,1)**2+
+ & P(I,2)**2+P(I,3)**2+P(I,5)**2)
+ 160 CONTINUE
+ NRECAL=N
+ ENDIF
+
+C...Colour reconnection before string formation
+ IF (MSTP(95).GE.2) CALL PYFSCR(MINT(84)+1)
+
+C...Rearrange partons along strings, check invariant mass cuts.
+ MSTU(28)=0
+ IF(MSTP(111).LE.0) MSTJ(14)=-1
+ CALL PYPREP(MINT(84)+1)
+ MSTJ(14)=MSTJ14
+ IF(MINT(51).EQ.1.AND.MSTU(24).EQ.1) THEN
+ MSTU(24)=0
+ GOTO 100
+ ENDIF
+ IF (MINT(51).EQ.1.AND.NPREP.LE.5) GOTO 110
+ IF (MINT(51).EQ.1) GOTO 100
+ IF(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100
+ IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN
+ DO 190 I=MINT(84)+1,N
+ IF(K(I,2).EQ.94) THEN
+ DO 180 I1=I+1,MIN(N,I+10)
+ IF(K(I1,3).EQ.I) THEN
+ K(I1,3)=MOD(K(I1,4)/MSTU(5),MSTU(5))
+ IF(K(I1,3).EQ.0) THEN
+ DO 170 II=MINT(84)+1,I-1
+ IF(K(II,2).EQ.K(I1,2)) THEN
+ IF(MOD(K(II,4),MSTU(5)).EQ.I1.OR.
+ & MOD(K(II,5),MSTU(5)).EQ.I1) K(I1,3)=II
+ ENDIF
+ 170 CONTINUE
+ IF(K(I+1,3).EQ.0) K(I+1,3)=K(I,3)
+ ENDIF
+ ENDIF
+ 180 CONTINUE
+ ENDIF
+ 190 CONTINUE
+ CALL PYEDIT(12)
+ CALL PYEDIT(14)
+ IF(MSTP(125).EQ.0) CALL PYEDIT(15)
+ IF(MSTP(125).EQ.0) MINT(4)=0
+ DO 210 I=MINT(83)+1,N
+ IF(K(I,1).EQ.11.AND.K(I,4).EQ.0.AND.K(I,5).EQ.0) THEN
+ DO 200 I1=I+1,N
+ IF(K(I1,3).EQ.I.AND.K(I,4).EQ.0) K(I,4)=I1
+ IF(K(I1,3).EQ.I) K(I,5)=I1
+ 200 CONTINUE
+ ENDIF
+ 210 CONTINUE
+ ENDIF
+
+C...Introduce separators between sections in PYLIST event listing.
+ IF(IPILE.EQ.1.AND.MSTP(125).LE.0) THEN
+ MSTU70=1
+ MSTU(71)=N
+ ELSEIF(IPILE.EQ.1) THEN
+ MSTU70=3
+ MSTU(71)=2
+ MSTU(72)=MINT(4)
+ MSTU(73)=N
+ ENDIF
+
+C...Go back to lab frame (needed for vertices, also in fragmentation).
+ CALL PYFRAM(1)
+
+C...Set nonvanishing production vertex (optional).
+ IF(MSTP(151).EQ.1) THEN
+ DO 220 J=1,4
+ VTX(J)=PARP(150+J)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0))))*
+ & SIN(PARU(2)*PYR(0))
+ 220 CONTINUE
+ DO 240 I=MINT(83)+1,N
+ DO 230 J=1,4
+ V(I,J)=V(I,J)+VTX(J)
+ 230 CONTINUE
+ 240 CONTINUE
+ ENDIF
+
+C...Perform hadronization (if desired).
+ IF(MSTP(111).GE.1) THEN
+ CALL PYEXEC
+ IF(MSTU(24).NE.0) GOTO 100
+ ENDIF
+ IF(MSTP(113).GE.1) THEN
+ DO 250 I=NRECAL,N
+ IF(P(I,5).GT.0D0) P(I,4)=SQRT(P(I,1)**2+
+ & P(I,2)**2+P(I,3)**2+P(I,5)**2)
+ 250 CONTINUE
+ ENDIF
+ IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) CALL PYEDIT(14)
+
+C...Store event information and calculate Monte Carlo estimates of
+C...subprocess cross-sections.
+ 260 IF(IPILE.EQ.1) CALL PYDOCU
+
+C...Set counters for current pileup event and loop to next one.
+ MSTI(41)=IPILE
+ IF(IPILE.GE.2.AND.IPILE.LE.10) MSTI(40+IPILE)=ISUB
+ IF(MSTU70.LT.10) THEN
+ MSTU70=MSTU70+1
+ MSTU(70+MSTU70)=N
+ ENDIF
+ MINT(83)=N
+ MINT(84)=N+MSTP(126)
+ IF(IPILE.LT.NPILE) CALL PYFRAM(2)
+ 270 CONTINUE
+
+C...Generic information on pileup events. Reconstruct missing history.
+ IF(MSTP(131).EQ.1.AND.MSTP(133).GE.1) THEN
+ PARI(91)=VINT(132)
+ PARI(92)=VINT(133)
+ PARI(93)=VINT(134)
+ IF(MSTP(133).GE.2) PARI(93)=PARI(93)*XSEC(0,3)/VINT(131)
+ ENDIF
+ CALL PYEDIT(16)
+
+C...Transform to the desired coordinate frame.
+ 280 CALL PYFRAM(MSTP(124))
+ MSTU(70)=MSTU70
+ PARU(21)=VINT(1)
+
+C...Error messages
+ 5100 FORMAT(1X,'Error: no subprocess switched on.'/
+ &1X,'Execution stopped.')
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYEVNW
+C...Administers the generation of a high-pT event via calls to
+C...a number of subroutines for the new multiple interactions and
+C...showering framework.
+
+ SUBROUTINE PYEVNW
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+ PARAMETER (MAXNUR=1000)
+C...Commonblocks.
+ COMMON/PYPART/NPART,NPARTD,IPART(MAXNUR),PTPART(MAXNUR)
+C...Commonblocks.
+ COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
+ COMMON/PYCTAG/NCT,MCT(4000,2)
+ 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/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
+ COMMON/PYINT4/MWID(500),WIDS(500,5)
+ COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
+ COMMON/PYINTM/KFIVAL(2,3),NMI(2),IMI(2,800,2),NVC(2,-6:6),
+ & XASSOC(2,-6:6,240),XPSVC(-6:6,-1:240),PVCTOT(2,-1:1),
+ & XMI(2,240),PT2MI(240),IMISEP(0:240)
+ SAVE /PYJETS/,/PYCTAG/,/PYDAT1/,/PYDAT2/,/PYDAT3/,
+ & /PYPARS/,/PYINT1/,/PYINT2/,/PYINT4/,/PYINT5/,/PYINTM/
+C...Local arrays.
+ DIMENSION VTX(4)
+
+C...Stop if no subprocesses on.
+ IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN
+ WRITE(MSTU(11),5100)
+ CALL PYSTOP(1)
+ ENDIF
+
+C...Initial values for some counters.
+ MSTU(1)=0
+ MSTU(2)=0
+ N=0
+ MINT(5)=MINT(5)+1
+ MINT(7)=0
+ MINT(8)=0
+ MINT(30)=0
+ MINT(83)=0
+ MINT(84)=MSTP(126)
+ MSTU(24)=0
+ MSTU70=0
+ MSTJ14=MSTJ(14)
+C...Normally, use K(I,4:5) colour info rather than /PYCT/.
+ NCT=0
+ MINT(33)=0
+C...Zero counters for pT-ordered showers (failsafe)
+ NPART=0
+ NPARTD=0
+
+C...Let called routines know call is from PYEVNW (not PYEVNT).
+ MINT(35)=3
+
+C...If variable energies: redo incoming kinematics and cross-section.
+ MSTI(61)=0
+ IF(MSTP(171).EQ.1) THEN
+ CALL PYINKI(1)
+ IF(MSTI(61).EQ.1) THEN
+ MINT(5)=MINT(5)-1
+ RETURN
+ ENDIF
+ IF(MINT(121).GT.1) CALL PYSAVE(3,1)
+ CALL PYXTOT
+ ENDIF
+
+C...Loop over number of pileup events; check space left.
+ IF(MSTP(131).LE.0) THEN
+ NPILE=1
+ ELSE
+ CALL PYPILE(2)
+ NPILE=MINT(81)
+ ENDIF
+ DO 300 IPILE=1,NPILE
+ IF(MINT(84)+100.GE.MSTU(4)) THEN
+ CALL PYERRM(11,
+ & '(PYEVNW:) no more space in PYJETS for pileup events')
+ IF(MSTU(21).GE.1) GOTO 310
+ ENDIF
+ MINT(82)=IPILE
+
+C...Generate variables of hard scattering.
+ MINT(51)=0
+ MSTI(52)=0
+ LOOPHS =0
+ 100 CONTINUE
+ LOOPHS = LOOPHS + 1
+ IF(MINT(51).NE.0.OR.MSTU(24).NE.0) MSTI(52)=MSTI(52)+1
+ IF(LOOPHS.GE.10) THEN
+ CALL PYERRM(19,'(PYEVNW:) failed to evolve shower or '
+ & //'multiple interactions. Returning.')
+ MINT(51)=1
+ RETURN
+ ENDIF
+ MINT(31)=0
+ MINT(39)=0
+ MINT(36)=0
+ MINT(51)=0
+ MINT(57)=0
+ CALL PYRAND
+ IF(MSTI(61).EQ.1) THEN
+ MINT(5)=MINT(5)-1
+ RETURN
+ ENDIF
+ IF(MINT(51).EQ.2) RETURN
+ ISUB=MINT(1)
+ IF(MSTP(111).EQ.-1) GOTO 290
+
+C...Loopback point if PYPREP fails, especially for junction topologies.
+ NPREP=0
+ MNT31S=MINT(31)
+ 110 NPREP=NPREP+1
+ MINT(31)=MNT31S
+
+ IF((ISUB.LE.90.OR.ISUB.GE.95).AND.ISUB.NE.99) THEN
+C...Hard scattering (including low-pT):
+C...reconstruct kinematics and colour flow of hard scattering.
+ MINT31=MINT(31)
+ 120 MINT(31)=MINT31
+ MINT(51)=0
+ CALL PYSCAT
+ IF(MINT(51).EQ.1) GOTO 100
+ NPARTD=N
+ NFIN=N
+
+C...Intertwined initial state showers and multiple interactions.
+C...Force no IS showers if no pdfs defined: MSTP(61) -> 0 for PYEVOL.
+C...Force no MI if cross section not known: MSTP(81) -> 0 for PYEVOL.
+ MSTP61=MSTP(61)
+ IF (MINT(47).LT.2) MSTP(61)=0
+ MSTP81=MSTP(81)
+ IF (MINT(50).EQ.0) MSTP(81)=0
+ IF ((MSTP(61).GE.1.OR.MOD(MSTP(81),10).GE.0).AND.
+ & MINT(111).NE.12) THEN
+C...Absolute max pT2 scale for evolution: phase space limit.
+ PT2MXS=0.25D0*VINT(2)
+C...Check if more constrained by ISR and MI max scales:
+ PT2MXS=MIN(PT2MXS,MAX(VINT(56),VINT(62)))
+C...Loopback point in case of failure in evolution.
+ LOOP=0
+ 130 LOOP=LOOP+1
+ MINT(51)=0
+ IF(LOOP.GT.100) THEN
+ CALL PYERRM(9,'(PYEVNW:) failed to evolve shower or '
+ & //'multiple interactions. Trying new point.')
+ MINT(51)=1
+ RETURN
+ ENDIF
+
+C...Pre-initialization of interleaved MI/ISR/JI evolution, only done
+C...once per event. (E.g. compute constants and save variables to be
+C...restored later in case of failure.)
+ IF (LOOP.EQ.1) CALL PYEVOL(-1,DUMMY1,DUMMY2)
+
+C...Initialize interleaved MI/ISR/JI evolution.
+C...PT2MAX: absolute upper limit for evolution - Initialization may
+C... return a PT2MAX which is lower than this.
+C...PT2MIN: absolute lower limit for evolution - Initialization may
+C... return a PT2MIN which is larger than this (e.g. Lambda_QCD).
+ PT2MAX=PT2MXS
+ PT2MIN=0D0
+ CALL PYEVOL(0,PT2MAX,PT2MIN)
+C...If failed to initialize evolution, generate a new hard process
+ IF (MINT(51).EQ.1) GOTO 100
+
+C...Perform interleaved MI/ISR/JI evolution from PT2MAX to PT2MIN.
+C...In principle factorized, so can be stopped and restarted.
+C...Example: stop/start at pT=10 GeV. (Commented out for now.)
+C PT2MED=MAX(10D0**2,PT2MIN)
+C CALL PYEVOL(1,PT2MAX,PT2MED)
+C IF (MINT(51).EQ.1) GOTO 160
+C PT2MAX=PT2MED
+ CALL PYEVOL(1,PT2MAX,PT2MIN)
+C...If fatal error (e.g., massive hard-process initiator, but no available
+C...phase space for creation), generate a new hard process
+ IF (MINT(51).EQ.2) GOTO 100
+C...If smaller error, just try running evolution again
+ IF (MINT(51).EQ.1) GOTO 130
+
+C...Finalize interleaved MI/ISR/JI evolution.
+ CALL PYEVOL(2,PT2MAX,PT2MIN)
+ IF (MINT(51).EQ.1) GOTO 130
+
+ ENDIF
+ MSTP(61)=MSTP61
+ MSTP(81)=MSTP81
+ IF(MINT(51).EQ.1) GOTO 100
+C...(MINT(52) is actually obsolete in this routine. Set anyway
+C...to ensure PYDOCU stable.)
+ MINT(52)=N
+ MINT(53)=N
+
+C...Beam remnants - new scheme.
+ 140 IF(MINT(50).EQ.1) THEN
+ IF (ISUB.EQ.95) MINT(31)=1
+
+C...Beam remnant flavour and colour assignments - new scheme.
+ CALL PYMIHK
+ IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5)
+ & GOTO 120
+ IF(MINT(51).EQ.1) GOTO 100
+
+C...Primordial kT and beam remnant momentum sharing - new scheme.
+ CALL PYMIRM
+ IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5)
+ & GOTO 120
+ IF(MINT(51).EQ.1) GOTO 100
+ IF (ISUB.EQ.95) MINT(31)=0
+ ELSEIF(MINT(111).NE.12) THEN
+C...Hadron remnants and primordial kT - old model.
+C...Happens e.g. for direct photon on one side.
+ IPU1=IMI(1,1,1)
+ IPU2=IMI(2,1,1)
+ CALL PYREMN(IPU1,IPU2)
+ IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) GOTO
+ & 110
+ IF(MINT(51).EQ.1) GOTO 100
+C...PYREMN does not set colour tags for BRs, so needs to be done now.
+ DO 160 I=MINT(53)+1,N
+ DO 150 KCS=4,5
+ IDA=MOD(K(I,KCS),MSTU(5))
+ IF (IDA.NE.0) THEN
+ MCT(I,KCS-3)=MCT(IDA,6-KCS)
+ ELSE
+ MCT(I,KCS-3)=0
+ ENDIF
+ 150 CONTINUE
+ 160 CONTINUE
+C...Instruct PYPREP to use colour tags
+ MINT(33)=1
+
+ DO 360 MQGST=1,2
+ DO 350 I=MINT(84)+1,N
+
+C...Look for coloured string endpoint, or (later) leftover gluon.
+ IF (K(I,1).NE.3) GOTO 350
+ KC=PYCOMP(K(I,2))
+ IF(KC.EQ.0) GOTO 350
+ KQ=KCHG(KC,2)
+ IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 350
+
+C... Pick up loose string end with no previous tag.
+ KCS=4
+ IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5
+ IF(MCT(I,KCS-3).NE.0) GOTO 350
+
+ CALL PYCTTR(I,KCS,I)
+ IF(MINT(51).NE.0) RETURN
+
+ 350 CONTINUE
+ 360 CONTINUE
+C...Now delete any colour processing information if set (since partons
+C...otherwise not FS showered!)
+ DO 170 I=MINT(84)+1,N
+ IF (I.LE.N) THEN
+ K(I,4)=MOD(K(I,4),MSTU(5)**2)
+ K(I,5)=MOD(K(I,5),MSTU(5)**2)
+ ENDIF
+ 170 CONTINUE
+ ENDIF
+
+C...Showering of final state partons (optional).
+ ALAMSV=PARJ(81)
+ PARJ(81)=PARP(72)
+ IF(MSTP(71).GE.1.AND.ISET(ISUB).GE.1.AND.ISET(ISUB).LE.10)
+ & THEN
+ QMAX=VINT(55)
+ IF(ISET(ISUB).EQ.2) QMAX=SQRT(PARP(71))*VINT(55)
+ CALL PYPTFS(1,QMAX,0D0,PTGEN)
+C...External processes: handle successive showers.
+ ELSEIF(ISET(ISUB).EQ.11) THEN
+ CALL PYADSH(NFIN)
+ ENDIF
+ PARJ(81)=ALAMSV
+
+C...Allow possibility for user to abort event generation.
+ IVETO=0
+ IF(IPILE.EQ.1.AND.MSTP(143).EQ.1) CALL PYVETO(IVETO) ! sm
+ IF(IVETO.EQ.1) THEN
+C...........No reason to count this as an error
+ LOOPHS = LOOPHS-1
+ GOTO 100
+ ENDIF
+
+
+C...Decay of final state resonances.
+ MINT(32)=0
+ IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10) THEN
+ CALL PYRESD(0)
+ IF(MINT(51).NE.0) GOTO 100
+ ENDIF
+
+ IF(MINT(51).EQ.1) GOTO 100
+
+ ELSEIF(ISUB.NE.99) THEN
+C...Diffractive and elastic scattering.
+ CALL PYDIFF
+
+ ELSE
+C...DIS scattering (photon flux external).
+ CALL PYDISG
+ IF(MINT(51).EQ.1) GOTO 100
+ ENDIF
+
+C...Check that no odd resonance left undecayed.
+ MINT(54)=N
+ IF(MSTP(111).GE.1) THEN
+ NFIX=N
+ DO 180 I=MINT(84)+1,NFIX
+ IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND.
+ & K(I,2).NE.22) THEN
+ KCA=PYCOMP(K(I,2))
+ IF(MWID(KCA).NE.0.AND.MDCY(KCA,1).GE.1) THEN
+ CALL PYRESD(I)
+ IF(MINT(51).EQ.1) GOTO 100
+ ENDIF
+ ENDIF
+ 180 CONTINUE
+ ENDIF
+
+C...Boost hadronic subsystem to overall rest frame.
+C..(Only relevant when photon inside lepton beam.)
+ IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(4,WTGAGA)
+
+C...Recalculate energies from momenta and masses (if desired).
+ IF(MSTP(113).GE.1) THEN
+ DO 190 I=MINT(83)+1,N
+ IF(K(I,1).GT.0.AND.K(I,1).LE.10) P(I,4)=SQRT(P(I,1)**2+
+ & P(I,2)**2+P(I,3)**2+P(I,5)**2)
+ 190 CONTINUE
+ NRECAL=N
+ ENDIF
+
+C...Colour reconnection before string formation
+ CALL PYFSCR(MINT(84)+1)
+
+C...Rearrange partons along strings, check invariant mass cuts.
+ MSTU(28)=0
+ IF(MSTP(111).LE.0) MSTJ(14)=-1
+ CALL PYPREP(MINT(84)+1)
+ MSTJ(14)=MSTJ14
+ IF(MINT(51).EQ.1.AND.MSTU(24).EQ.1) THEN
+ MSTU(24)=0
+ GOTO 100
+ ENDIF
+ IF(MINT(51).EQ.1) GOTO 110
+ IF(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100
+ IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN
+ DO 220 I=MINT(84)+1,N
+ IF(K(I,2).EQ.94) THEN
+ DO 210 I1=I+1,MIN(N,I+10)
+ IF(K(I1,3).EQ.I) THEN
+ K(I1,3)=MOD(K(I1,4)/MSTU(5),MSTU(5))
+ IF(K(I1,3).EQ.0) THEN
+ DO 200 II=MINT(84)+1,I-1
+ IF(K(II,2).EQ.K(I1,2)) THEN
+ IF(MOD(K(II,4),MSTU(5)).EQ.I1.OR.
+ & MOD(K(II,5),MSTU(5)).EQ.I1) K(I1,3)=II
+ ENDIF
+ 200 CONTINUE
+ IF(K(I+1,3).EQ.0) K(I+1,3)=K(I,3)
+ ENDIF
+ ENDIF
+ 210 CONTINUE
+CC...Also collapse particles decaying to themselves (if same KS)
+ ELSEIF (K(I,1).GT.0.AND.K(I,4).EQ.K(I,5).AND.K(I,4).GT.0
+ & .AND.K(I,4).LT.N) THEN
+ IDA=K(I,4)
+ IF (K(IDA,1).EQ.K(I,1).AND.K(IDA,2).EQ.K(I,2)) THEN
+ K(I,1)=0
+ ENDIF
+ ENDIF
+ 220 CONTINUE
+ CALL PYEDIT(12)
+ CALL PYEDIT(14)
+ IF(MSTP(125).EQ.0) CALL PYEDIT(15)
+ IF(MSTP(125).EQ.0) MINT(4)=0
+ DO 240 I=MINT(83)+1,N
+ IF(K(I,1).EQ.11.AND.K(I,4).EQ.0.AND.K(I,5).EQ.0) THEN
+ DO 230 I1=I+1,N
+ IF(K(I1,3).EQ.I.AND.K(I,4).EQ.0) K(I,4)=I1
+ IF(K(I1,3).EQ.I) K(I,5)=I1
+ 230 CONTINUE
+ ENDIF
+ 240 CONTINUE
+ ENDIF
+
+C...Introduce separators between sections in PYLIST event listing.
+ IF(IPILE.EQ.1.AND.MSTP(125).LE.0) THEN
+ MSTU70=1
+ MSTU(71)=N
+ ELSEIF(IPILE.EQ.1) THEN
+ MSTU70=3
+ MSTU(71)=2
+ MSTU(72)=MINT(4)
+ MSTU(73)=N
+ ENDIF
+
+C...Go back to lab frame (needed for vertices, also in fragmentation).
+ CALL PYFRAM(1)
+
+C...Set nonvanishing production vertex (optional).
+ IF(MSTP(151).EQ.1) THEN
+ DO 250 J=1,4
+ VTX(J)=PARP(150+J)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0))))*
+ & SIN(PARU(2)*PYR(0))
+ 250 CONTINUE
+ DO 270 I=MINT(83)+1,N
+ DO 260 J=1,4
+ V(I,J)=V(I,J)+VTX(J)
+ 260 CONTINUE
+ 270 CONTINUE
+ ENDIF
+
+C...Perform hadronization (if desired).
+ IF(MSTP(111).GE.1) THEN
+ CALL PYEXEC
+ IF(MSTU(24).NE.0) GOTO 100
+ ENDIF
+ IF(MSTP(113).GE.1) THEN
+ DO 280 I=NRECAL,N
+ IF(P(I,5).GT.0D0) P(I,4)=SQRT(P(I,1)**2+
+ & P(I,2)**2+P(I,3)**2+P(I,5)**2)
+ 280 CONTINUE
+ ENDIF
+ IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) CALL PYEDIT(14)
+
+C...Store event information and calculate Monte Carlo estimates of
+C...subprocess cross-sections.
+ 290 IF(IPILE.EQ.1) CALL PYDOCU
+
+C...Set counters for current pileup event and loop to next one.
+ MSTI(41)=IPILE
+ IF(IPILE.GE.2.AND.IPILE.LE.10) MSTI(40+IPILE)=ISUB
+ IF(MSTU70.LT.10) THEN
+ MSTU70=MSTU70+1
+ MSTU(70+MSTU70)=N
+ ENDIF
+ MINT(83)=N
+ MINT(84)=N+MSTP(126)
+ IF(IPILE.LT.NPILE) CALL PYFRAM(2)
+ 300 CONTINUE
+
+C...Generic information on pileup events. Reconstruct missing history.
+ IF(MSTP(131).EQ.1.AND.MSTP(133).GE.1) THEN
+ PARI(91)=VINT(132)
+ PARI(92)=VINT(133)
+ PARI(93)=VINT(134)
+ IF(MSTP(133).GE.2) PARI(93)=PARI(93)*XSEC(0,3)/VINT(131)
+ ENDIF
+ CALL PYEDIT(16)
+
+C...Transform to the desired coordinate frame.
+ 310 CALL PYFRAM(MSTP(124))
+ MSTU(70)=MSTU70
+ PARU(21)=VINT(1)
+
+C...Error messages
+ 5100 FORMAT(1X,'Error: no subprocess switched on.'/
+ &1X,'Execution stopped.')
+
+ RETURN
+ END
+
+
+C***********************************************************************
+
+C...PYSTAT
+C...Prints out information about cross-sections, decay widths, branching
+C...ratios, kinematical limits, status codes and parameter values.
+
+ SUBROUTINE PYSTAT(MSTAT)
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+C...Parameter statement to help give large particle numbers.
+ PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
+ &KEXCIT=4000000,KDIMEN=5000000)
+ PARAMETER (EPS=1D-3)
+C...Commonblocks.
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYDAT3/MDCY(500,3),MDME(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/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
+ COMMON/PYINT4/MWID(500),WIDS(500,5)
+ COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
+ COMMON/PYINT6/PROC(0:500)
+ CHARACTER PROC*28, CHTMP*16
+ COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
+ COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3)
+ SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,
+ &/PYINT2/,/PYINT4/,/PYINT5/,/PYINT6/,/PYMSSM/,/PYMSRV/
+C...Local arrays, character variables and data.
+ DIMENSION WDTP(0:400),WDTE(0:400,0:5),NMODES(0:20),PBRAT(10)
+ CHARACTER PROGA(6)*28,CHAU*16,CHKF*16,CHD1*16,CHD2*16,CHD3*16,
+ &CHIN(2)*12,STATE(-1:5)*4,CHKIN(21)*18,DISGA(2)*28,
+ &PROGG9(13)*28,PROGG4(4)*28,PROGG2(2)*28,PROGP4(4)*28
+ CHARACTER*24 CHD0, CHDC(10)
+ CHARACTER*6 DNAME(3)
+ DATA PROGA/
+ &'VMD/hadron * VMD ','VMD/hadron * direct ',
+ &'VMD/hadron * anomalous ','direct * direct ',
+ &'direct * anomalous ','anomalous * anomalous '/
+ DATA DISGA/'e * VMD','e * anomalous'/
+ DATA PROGG9/
+ &'direct * direct ','direct * VMD ',
+ &'direct * anomalous ','VMD * direct ',
+ &'VMD * VMD ','VMD * anomalous ',
+ &'anomalous * direct ','anomalous * VMD ',
+ &'anomalous * anomalous ','DIS * VMD ',
+ &'DIS * anomalous ','VMD * DIS ',
+ &'anomalous * DIS '/
+ DATA PROGG4/
+ &'direct * direct ','direct * resolved ',
+ &'resolved * direct ','resolved * resolved '/
+ DATA PROGG2/
+ &'direct * hadron ','resolved * hadron '/
+ DATA PROGP4/
+ &'VMD * hadron ','direct * hadron ',
+ &'anomalous * hadron ','DIS * hadron '/
+ DATA STATE/'----','off ','on ','on/+','on/-','on/1','on/2'/,
+ &CHKIN/' m_hard (GeV/c^2) ',' p_T_hard (GeV/c) ',
+ &'m_finite (GeV/c^2)',' y*_subsystem ',' y*_large ',
+ &' y*_small ',' eta*_large ',' eta*_small ',
+ &'cos(theta*)_large ','cos(theta*)_small ',' x_1 ',
+ &' x_2 ',' x_F ',' cos(theta_hard) ',
+ &'m''_hard (GeV/c^2) ',' tau ',' y* ',
+ &'cos(theta_hard^-) ','cos(theta_hard^+) ',' x_T^2 ',
+ &' tau'' '/
+ DATA DNAME /'q ','lepton','nu '/
+
+C...Cross-sections.
+ IF(MSTAT.LE.1) THEN
+ IF(MINT(121).GT.1) CALL PYSAVE(5,0)
+ WRITE(MSTU(11),5000)
+ WRITE(MSTU(11),5100)
+ WRITE(MSTU(11),5200) 0,PROC(0),NGEN(0,3),NGEN(0,1),XSEC(0,3)
+ DO 100 I=1,500
+ IF(MSUB(I).NE.1) GOTO 100
+ WRITE(MSTU(11),5200) I,PROC(I),NGEN(I,3),NGEN(I,1),XSEC(I,3)
+ 100 CONTINUE
+ IF(MINT(121).GT.1) THEN
+ WRITE(MSTU(11),5300)
+ DO 110 IGA=1,MINT(121)
+ CALL PYSAVE(3,IGA)
+ IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN
+ WRITE(MSTU(11),5200) IGA,DISGA(IGA),NGEN(0,3),NGEN(0,1),
+ & XSEC(0,3)
+ ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN
+ WRITE(MSTU(11),5200) IGA,PROGG9(IGA),NGEN(0,3),NGEN(0,1),
+ & XSEC(0,3)
+ ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.30) THEN
+ WRITE(MSTU(11),5200) IGA,PROGP4(IGA),NGEN(0,3),NGEN(0,1),
+ & XSEC(0,3)
+ ELSEIF(MINT(121).EQ.4) THEN
+ WRITE(MSTU(11),5200) IGA,PROGG4(IGA),NGEN(0,3),NGEN(0,1),
+ & XSEC(0,3)
+ ELSEIF(MINT(121).EQ.2) THEN
+ WRITE(MSTU(11),5200) IGA,PROGG2(IGA),NGEN(0,3),NGEN(0,1),
+ & XSEC(0,3)
+ ELSE
+ WRITE(MSTU(11),5200) IGA,PROGA(IGA),NGEN(0,3),NGEN(0,1),
+ & XSEC(0,3)
+ ENDIF
+ 110 CONTINUE
+ CALL PYSAVE(5,0)
+ ENDIF
+ WRITE(MSTU(11),5400) MSTU(23),MSTU(30),MSTU(27),
+ & 1D0-DBLE(NGEN(0,3))/MAX(1D0,DBLE(NGEN(0,2)))
+
+C...Decay widths and branching ratios.
+ ELSEIF(MSTAT.EQ.2) THEN
+ WRITE(MSTU(11),5500)
+ WRITE(MSTU(11),5600)
+ DO 140 KC=1,500
+ KF=KCHG(KC,4)
+ CALL PYNAME(KF,CHKF)
+ IOFF=0
+ IF(KC.LE.22) THEN
+ IF(KC.GT.2*MSTP(1).AND.KC.LE.10) GOTO 140
+ IF(KC.GT.10+2*MSTP(1).AND.KC.LE.20) GOTO 140
+ IF(KC.LE.5.OR.(KC.GE.11.AND.KC.LE.16)) IOFF=1
+ IF(KC.EQ.18.AND.PMAS(18,1).LT.1D0) IOFF=1
+ IF(KC.EQ.21.OR.KC.EQ.22) IOFF=1
+ ELSE
+ IF(MWID(KC).LE.0) GOTO 140
+ IF(IMSS(1).LE.0.AND.(KF/KSUSY1.EQ.1.OR.
+ & KF/KSUSY1.EQ.2)) GOTO 140
+ ENDIF
+C...Off-shell branchings.
+ IF(IOFF.EQ.1) THEN
+ NGP=0
+ IF(KC.LE.20) NGP=(MOD(KC,10)+1)/2
+ IF(NGP.LE.MSTP(1)) WRITE(MSTU(11),5700) KF,CHKF(1:10),
+ & PMAS(KC,1),0D0,0D0,STATE(MDCY(KC,1)),0D0
+ DO 120 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ NGP1=0
+ IF(IABS(KFDP(IDC,1)).LE.20) NGP1=
+ & (MOD(IABS(KFDP(IDC,1)),10)+1)/2
+ NGP2=0
+ IF(IABS(KFDP(IDC,2)).LE.20) NGP2=
+ & (MOD(IABS(KFDP(IDC,2)),10)+1)/2
+ CALL PYNAME(KFDP(IDC,1),CHD1)
+ CALL PYNAME(KFDP(IDC,2),CHD2)
+ IF(KFDP(IDC,3).EQ.0) THEN
+ IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND.
+ & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5800) IDC,CHD1(1:10),
+ & CHD2(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0
+ ELSE
+ CALL PYNAME(KFDP(IDC,3),CHD3)
+ IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND.
+ & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5900) IDC,CHD1(1:10),
+ & CHD2(1:10),CHD3(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0
+ ENDIF
+ 120 CONTINUE
+C...On-shell decays.
+ ELSE
+ CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE)
+ BRFIN=1D0
+ IF(WDTE(0,0).LE.0D0) BRFIN=0D0
+ WRITE(MSTU(11),5700) KF,CHKF(1:10),PMAS(KC,1),WDTP(0),1D0,
+ & STATE(MDCY(KC,1)),BRFIN
+ DO 130 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ NGP1=0
+ IF(IABS(KFDP(IDC,1)).LE.20) NGP1=
+ & (MOD(IABS(KFDP(IDC,1)),10)+1)/2
+ NGP2=0
+ IF(IABS(KFDP(IDC,2)).LE.20) NGP2=
+ & (MOD(IABS(KFDP(IDC,2)),10)+1)/2
+ BRPRI=0D0
+ IF(WDTP(0).GT.0D0) BRPRI=WDTP(J)/WDTP(0)
+ BRFIN=0D0
+ IF(WDTE(0,0).GT.0D0) BRFIN=WDTE(J,0)/WDTE(0,0)
+ CALL PYNAME(KFDP(IDC,1),CHD1)
+ CALL PYNAME(KFDP(IDC,2),CHD2)
+ IF(KFDP(IDC,3).EQ.0) THEN
+ IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1))
+ & WRITE(MSTU(11),5800) IDC,CHD1(1:10),
+ & CHD2(1:10),WDTP(J),BRPRI,
+ & STATE(MDME(IDC,1)),BRFIN
+ ELSE
+ CALL PYNAME(KFDP(IDC,3),CHD3)
+ IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1))
+ & WRITE(MSTU(11),5900) IDC,CHD1(1:10),
+ & CHD2(1:10),CHD3(1:10),WDTP(J),BRPRI,
+ & STATE(MDME(IDC,1)),BRFIN
+ ENDIF
+ 130 CONTINUE
+ ENDIF
+ 140 CONTINUE
+ WRITE(MSTU(11),6000)
+
+C...Allowed incoming partons/particles at hard interaction.
+ ELSEIF(MSTAT.EQ.3) THEN
+ WRITE(MSTU(11),6100)
+ CALL PYNAME(MINT(11),CHAU)
+ CHIN(1)=CHAU(1:12)
+ CALL PYNAME(MINT(12),CHAU)
+ CHIN(2)=CHAU(1:12)
+ WRITE(MSTU(11),6200) CHIN(1),CHIN(2)
+ DO 150 I=-20,22
+ IF(I.EQ.0) GOTO 150
+ IA=IABS(I)
+ IF(IA.GT.MSTP(58).AND.IA.LE.10) GOTO 150
+ IF(IA.GT.10+2*MSTP(1).AND.IA.LE.20) GOTO 150
+ CALL PYNAME(I,CHAU)
+ WRITE(MSTU(11),6300) CHAU,STATE(KFIN(1,I)),CHAU,
+ & STATE(KFIN(2,I))
+ 150 CONTINUE
+ WRITE(MSTU(11),6400)
+
+C...User-defined limits on kinematical variables.
+ ELSEIF(MSTAT.EQ.4) THEN
+ WRITE(MSTU(11),6500)
+ WRITE(MSTU(11),6600)
+ SHRMAX=CKIN(2)
+ IF(SHRMAX.LT.0D0) SHRMAX=VINT(1)
+ WRITE(MSTU(11),6700) CKIN(1),CHKIN(1),SHRMAX
+ PTHMIN=MAX(CKIN(3),CKIN(5))
+ PTHMAX=CKIN(4)
+ IF(PTHMAX.LT.0D0) PTHMAX=0.5D0*SHRMAX
+ WRITE(MSTU(11),6800) CKIN(3),PTHMIN,CHKIN(2),PTHMAX
+ WRITE(MSTU(11),6900) CHKIN(3),CKIN(6)
+ DO 160 I=4,14
+ WRITE(MSTU(11),6700) CKIN(2*I-1),CHKIN(I),CKIN(2*I)
+ 160 CONTINUE
+ SPRMAX=CKIN(32)
+ IF(SPRMAX.LT.0D0) SPRMAX=VINT(1)
+ WRITE(MSTU(11),6700) CKIN(31),CHKIN(15),SPRMAX
+ WRITE(MSTU(11),7000)
+
+C...Status codes and parameter values.
+ ELSEIF(MSTAT.EQ.5) THEN
+ WRITE(MSTU(11),7100)
+ WRITE(MSTU(11),7200)
+ DO 170 I=1,100
+ WRITE(MSTU(11),7300) I,MSTP(I),PARP(I),100+I,MSTP(100+I),
+ & PARP(100+I)
+ 170 CONTINUE
+
+C...List of all processes implemented in the program.
+ ELSEIF(MSTAT.EQ.6) THEN
+ WRITE(MSTU(11),7400)
+ WRITE(MSTU(11),7500)
+ DO 180 I=1,500
+ IF(ISET(I).LT.0) GOTO 180
+ WRITE(MSTU(11),7600) I,PROC(I),ISET(I),KFPR(I,1),KFPR(I,2)
+ 180 CONTINUE
+ WRITE(MSTU(11),7700)
+
+ ELSEIF(MSTAT.EQ.7) THEN
+ WRITE (MSTU(11),8000)
+ NMODES(0)=0
+ NMODES(10)=0
+ NMODES(9)=0
+ DO 290 ILR=1,2
+ DO 280 KFSM=1,16
+ KFSUSY=ILR*KSUSY1+KFSM
+ NRVDC=0
+C...SDOWN DECAYS
+ IF (KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5) THEN
+ NRVDC=3
+ DO 190 I=1,NRVDC
+ PBRAT(I)=0D0
+ NMODES(I)=0
+ 190 CONTINUE
+ CALL PYNAME(KFSUSY,CHTMP)
+ CHD0=CHTMP//' '
+ CHDC(1)=DNAME(3) // ' + ' // DNAME(1)
+ CHDC(2)=DNAME(2) // ' + ' // DNAME(1)
+ CHDC(3)=DNAME(1) // ' + ' // DNAME(1)
+ KC=PYCOMP(KFSUSY)
+ DO 200 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ ID1=IABS(KFDP(IDC,1))
+ ID2=IABS(KFDP(IDC,2))
+ IF (KFDP(IDC,3).EQ.0) THEN
+ IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2
+ & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN
+ PBRAT(1)=PBRAT(1)+BRAT(IDC)
+ NMODES(1)=NMODES(1)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND
+ & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6)) THEN
+ PBRAT(2)=PBRAT(2)+BRAT(IDC)
+ NMODES(2)=NMODES(2)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND
+ & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN
+ PBRAT(3)=PBRAT(3)+BRAT(IDC)
+ NMODES(3)=NMODES(3)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ENDIF
+ ENDIF
+ 200 CONTINUE
+ ENDIF
+C...SUP DECAYS
+ IF (KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6) THEN
+ NRVDC=2
+ DO 210 I=1,NRVDC
+ NMODES(I)=0
+ PBRAT(I)=0D0
+ 210 CONTINUE
+ CALL PYNAME(KFSUSY,CHTMP)
+ CHD0=CHTMP//' '
+ CHDC(1)=DNAME(2) // ' + ' // DNAME(1)
+ CHDC(2)=DNAME(1) // ' + ' // DNAME(1)
+ KC=PYCOMP(KFSUSY)
+ DO 220 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ ID1=IABS(KFDP(IDC,1))
+ ID2=IABS(KFDP(IDC,2))
+ IF (KFDP(IDC,3).EQ.0) THEN
+ IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2
+ & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN
+ PBRAT(1)=PBRAT(1)+BRAT(IDC)
+ NMODES(1)=NMODES(1)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2
+ & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN
+ PBRAT(2)=PBRAT(2)+BRAT(IDC)
+ NMODES(2)=NMODES(2)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ENDIF
+ ENDIF
+ 220 CONTINUE
+ ENDIF
+C...SLEPTON DECAYS
+ IF (KFSM.EQ.11.OR.KFSM.EQ.13.OR.KFSM.EQ.15) THEN
+ NRVDC=2
+ DO 230 I=1,NRVDC
+ PBRAT(I)=0D0
+ NMODES(I)=0
+ 230 CONTINUE
+ CALL PYNAME(KFSUSY,CHTMP)
+ CHD0=CHTMP//' '
+ CHDC(1)=DNAME(3) // ' + ' // DNAME(2)
+ CHDC(2)=DNAME(1) // ' + ' // DNAME(1)
+ KC=PYCOMP(KFSUSY)
+ DO 240 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ ID1=IABS(KFDP(IDC,1))
+ ID2=IABS(KFDP(IDC,2))
+ IF (KFDP(IDC,3).EQ.0) THEN
+ IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2
+ & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN
+ PBRAT(1)=PBRAT(1)+BRAT(IDC)
+ NMODES(1)=NMODES(1)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ENDIF
+ IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND.(ID2
+ & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN
+ PBRAT(2)=PBRAT(2)+BRAT(IDC)
+ NMODES(2)=NMODES(2)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ENDIF
+ ENDIF
+ 240 CONTINUE
+ ENDIF
+C...SNEUTRINO DECAYS
+ IF ((KFSM.EQ.12.OR.KFSM.EQ.14.OR.KFSM.EQ.16).AND.ILR.EQ.1)
+ & THEN
+ NRVDC=2
+ DO 250 I=1,NRVDC
+ PBRAT(I)=0D0
+ NMODES(I)=0
+ 250 CONTINUE
+ CALL PYNAME(KFSUSY,CHTMP)
+ CHD0=CHTMP//' '
+ CHDC(1)=DNAME(2) // ' + ' // DNAME(2)
+ CHDC(2)=DNAME(1) // ' + ' // DNAME(1)
+ KC=PYCOMP(KFSUSY)
+ DO 260 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ ID1=IABS(KFDP(IDC,1))
+ ID2=IABS(KFDP(IDC,2))
+ IF (KFDP(IDC,3).EQ.0) THEN
+ IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2
+ & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN
+ PBRAT(1)=PBRAT(1)+BRAT(IDC)
+ NMODES(1)=NMODES(1)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ENDIF
+ IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2
+ & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN
+ NMODES(2)=NMODES(2)+1
+ PBRAT(2)=PBRAT(2)+BRAT(IDC)
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ENDIF
+ ENDIF
+ 260 CONTINUE
+ ENDIF
+ IF (NRVDC.NE.0) THEN
+ DO 270 I=1,NRVDC
+ WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I)
+ NMODES(0)=NMODES(0)+NMODES(I)
+ 270 CONTINUE
+ ENDIF
+ 280 CONTINUE
+ 290 CONTINUE
+ DO 370 KFSM=21,37
+ KFSUSY=KSUSY1+KFSM
+ NRVDC=0
+C...NEUTRALINO DECAYS
+ IF (KFSM.EQ.22.OR.KFSM.EQ.23.OR.KFSM.EQ.25.OR.KFSM.EQ.35) THEN
+ NRVDC=4
+ DO 300 I=1,NRVDC
+ PBRAT(I)=0D0
+ NMODES(I)=0
+ 300 CONTINUE
+ CALL PYNAME(KFSUSY,CHTMP)
+ CHD0=CHTMP//' '
+ CHDC(1)=DNAME(3) // ' + ' // DNAME(2) // ' + ' // DNAME(2)
+ CHDC(2)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1)
+ CHDC(3)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1)
+ CHDC(4)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1)
+ KC=PYCOMP(KFSUSY)
+ DO 310 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ ID1=IABS(KFDP(IDC,1))
+ ID2=IABS(KFDP(IDC,2))
+ ID3=IABS(KFDP(IDC,3))
+ IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2
+ & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.11.OR
+ & .ID3.EQ.13.OR.ID3.EQ.15)) THEN
+ PBRAT(1)=PBRAT(1)+BRAT(IDC)
+ NMODES(1)=NMODES(1)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND
+ & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1
+ & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(2)=PBRAT(2)+BRAT(IDC)
+ NMODES(2)=NMODES(2)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND
+ & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1
+ & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(3)=PBRAT(3)+BRAT(IDC)
+ NMODES(3)=NMODES(3)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND
+ & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1
+ & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(4)=PBRAT(4)+BRAT(IDC)
+ NMODES(4)=NMODES(4)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ENDIF
+ 310 CONTINUE
+ ENDIF
+C...CHARGINO DECAYS
+ IF (KFSM.EQ.24.OR.KFSM.EQ.37) THEN
+ NRVDC=5
+ DO 320 I=1,NRVDC
+ PBRAT(I)=0D0
+ NMODES(I)=0
+ 320 CONTINUE
+ CALL PYNAME(KFSUSY,CHTMP)
+ CHD0=CHTMP//' '
+ CHDC(1)=DNAME(3) // ' + ' // DNAME(3) // ' + ' // DNAME(2)
+ CHDC(2)=DNAME(2) // ' + ' // DNAME(2) // ' + ' // DNAME(2)
+ CHDC(3)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1)
+ CHDC(4)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1)
+ CHDC(5)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1)
+ KC=PYCOMP(KFSUSY)
+ DO 330 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ ID1=IABS(KFDP(IDC,1))
+ ID2=IABS(KFDP(IDC,2))
+ ID3=IABS(KFDP(IDC,3))
+ IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2
+ & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.12.OR
+ & .ID3.EQ.14.OR.ID3.EQ.16)) THEN
+ PBRAT(1)=PBRAT(1)+BRAT(IDC)
+ NMODES(1)=NMODES(1)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND
+ & .(ID2.EQ.12.OR.ID2.EQ.14.OR.ID2.EQ.16).AND.(ID3.EQ
+ & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN
+ PBRAT(1)=PBRAT(1)+BRAT(IDC)
+ NMODES(1)=NMODES(1)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND
+ & .(ID2.EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ
+ & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN
+ PBRAT(2)=PBRAT(2)+BRAT(IDC)
+ NMODES(2)=NMODES(2)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND
+ & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ
+ & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN
+ PBRAT(3)=PBRAT(3)+BRAT(IDC)
+ NMODES(3)=NMODES(3)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND
+ & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ
+ & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(3)=PBRAT(3)+BRAT(IDC)
+ NMODES(3)=NMODES(3)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND
+ & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ
+ & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN
+ PBRAT(4)=PBRAT(4)+BRAT(IDC)
+ NMODES(4)=NMODES(4)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND
+ & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ
+ & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(4)=PBRAT(4)+BRAT(IDC)
+ NMODES(4)=NMODES(4)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND
+ & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ
+ & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(5)=PBRAT(5)+BRAT(IDC)
+ NMODES(5)=NMODES(5)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND
+ & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ
+ & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(5)=PBRAT(5)+BRAT(IDC)
+ NMODES(5)=NMODES(5)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ENDIF
+ 330 CONTINUE
+ ENDIF
+C...GLUINO DECAYS
+ IF (KFSM.EQ.21) THEN
+ NRVDC=3
+ DO 340 I=1,NRVDC
+ PBRAT(I)=0D0
+ NMODES(I)=0
+ 340 CONTINUE
+ CALL PYNAME(KFSUSY,CHTMP)
+ CHD0=CHTMP//' '
+ CHDC(1)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1)
+ CHDC(2)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1)
+ CHDC(3)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1)
+ KC=PYCOMP(KFSUSY)
+ DO 350 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ ID1=IABS(KFDP(IDC,1))
+ ID2=IABS(KFDP(IDC,2))
+ ID3=IABS(KFDP(IDC,3))
+ IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2
+ & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1.OR
+ & .ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(1)=PBRAT(1)+BRAT(IDC)
+ NMODES(1)=NMODES(1)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND
+ & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1
+ & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(2)=PBRAT(2)+BRAT(IDC)
+ NMODES(2)=NMODES(2)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND
+ & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1
+ & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN
+ PBRAT(3)=PBRAT(3)+BRAT(IDC)
+ NMODES(3)=NMODES(3)+1
+ IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1
+ IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1
+ ENDIF
+ 350 CONTINUE
+ ENDIF
+
+ IF (NRVDC.NE.0) THEN
+ DO 360 I=1,NRVDC
+ WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I)
+ NMODES(0)=NMODES(0)+NMODES(I)
+ 360 CONTINUE
+ ENDIF
+ 370 CONTINUE
+ WRITE (MSTU(11),8100) NMODES(0), NMODES(10), NMODES(9)
+
+ IF (IMSS(51).GE.1.OR.IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN
+ WRITE (MSTU(11),8500)
+ DO 400 IRV=1,3
+ DO 390 JRV=1,3
+ DO 380 KRV=1,3
+ WRITE (MSTU(11),8700) IRV,JRV,KRV,RVLAM(IRV,JRV,KRV)
+ & ,RVLAMP(IRV,JRV,KRV),RVLAMB(IRV,JRV,KRV)
+ 380 CONTINUE
+ 390 CONTINUE
+ 400 CONTINUE
+ WRITE (MSTU(11),8600)
+ ENDIF
+ ENDIF
+
+C...Formats for printouts.
+ 5000 FORMAT('1',9('*'),1X,'PYSTAT: Statistics on Number of ',
+ &'Events and Cross-sections',1X,9('*'))
+ 5100 FORMAT(/1X,78('=')/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',12X,
+ &'Subprocess',12X,'I',6X,'Number of points',6X,'I',4X,'Sigma',3X,
+ &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',34('-'),'I',28('-'),
+ &'I',4X,'(mb)',4X,'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',1X,
+ &'N:o',1X,'Type',25X,'I',4X,'Generated',9X,'Tried',1X,'I',12X,
+ &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/1X,'I',34X,'I',28X,
+ &'I',12X,'I')
+ 5200 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I12,1X,I13,1X,'I',1X,1P,
+ &D10.3,1X,'I')
+ 5300 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/
+ &1X,'I',34X,'I',28X,'I',12X,'I')
+ 5400 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')//
+ &1X,'********* Total number of errors, excluding junctions =',
+ &1X,I8,' *************'/
+ &1X,'********* Total number of errors, including junctions =',
+ &1X,I8,' *************'/
+ &1X,'********* Total number of warnings = ',
+ &1X,I8,' *************'/
+ &1X,'********* Fraction of events that fail fragmentation ',
+ &'cuts =',1X,F8.5,' *********'/)
+ 5500 FORMAT('1',27('*'),1X,'PYSTAT: Decay Widths and Branching ',
+ &'Ratios',1X,27('*'))
+ 5600 FORMAT(/1X,98('=')/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/
+ &1X,'I',5X,'Mother --> Branching/Decay Channel',8X,'I',1X,
+ &'Width (GeV)',1X,'I',7X,'B.R.',1X,'I',1X,'Stat',1X,'I',2X,
+ &'Eff. B.R.',1X,'I'/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/
+ &1X,98('='))
+ 5700 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,'I',1X,
+ &I8,2X,A10,3X,'(m =',F10.3,')',2X,'-->',5X,'I',2X,1P,D10.3,0P,1X,
+ &'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,1P,D10.3,0P,1X,'I')
+ 5800 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,15X,'I',2X,
+ &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,
+ &1P,D10.3,0P,1X,'I')
+ 5900 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,1X,'+',1X,A10,2X,'I',2X,
+ &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,
+ &1P,D10.3,0P,1X,'I')
+ 6000 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,98('='))
+ 6100 FORMAT('1',7('*'),1X,'PYSTAT: Allowed Incoming Partons/',
+ &'Particles at Hard Interaction',1X,7('*'))
+ 6200 FORMAT(/1X,78('=')/1X,'I',38X,'I',37X,'I'/1X,'I',1X,
+ &'Beam particle:',1X,A12,10X,'I',1X,'Target particle:',1X,A12,7X,
+ &'I'/1X,'I',38X,'I',37X,'I'/1X,'I',1X,'Content',6X,'State',19X,
+ &'I',1X,'Content',6X,'State',18X,'I'/1X,'I',38X,'I',37X,'I'/1X,
+ &78('=')/1X,'I',38X,'I',37X,'I')
+ 6300 FORMAT(1X,'I',1X,A9,5X,A4,19X,'I',1X,A9,5X,A4,18X,'I')
+ 6400 FORMAT(1X,'I',38X,'I',37X,'I'/1X,78('='))
+ 6500 FORMAT('1',12('*'),1X,'PYSTAT: User-Defined Limits on ',
+ &'Kinematical Variables',1X,12('*'))
+ 6600 FORMAT(/1X,78('=')/1X,'I',76X,'I')
+ 6700 FORMAT(1X,'I',16X,1P,D10.3,0P,1X,'<',1X,A,1X,'<',1X,1P,D10.3,0P,
+ &16X,'I')
+ 6800 FORMAT(1X,'I',3X,1P,D10.3,0P,1X,'(',1P,D10.3,0P,')',1X,'<',1X,A,
+ &1X,'<',1X,1P,D10.3,0P,16X,'I')
+ 6900 FORMAT(1X,'I',29X,A,1X,'=',1X,1P,D10.3,0P,16X,'I')
+ 7000 FORMAT(1X,'I',76X,'I'/1X,78('='))
+ 7100 FORMAT('1',12('*'),1X,'PYSTAT: Summary of Status Codes and ',
+ &'Parameter Values',1X,12('*'))
+ 7200 FORMAT(/3X,'I',4X,'MSTP(I)',9X,'PARP(I)',20X,'I',4X,'MSTP(I)',9X,
+ &'PARP(I)'/)
+ 7300 FORMAT(1X,I3,5X,I6,6X,1P,D10.3,0P,18X,I3,5X,I6,6X,1P,D10.3)
+ 7400 FORMAT('1',13('*'),1X,'PYSTAT: List of implemented processes',
+ &1X,13('*'))
+ 7500 FORMAT(/1X,65('=')/1X,'I',34X,'I',28X,'I'/1X,'I',12X,
+ &'Subprocess',12X,'I',1X,'ISET',2X,'KFPR(I,1)',2X,'KFPR(I,2)',1X,
+ &'I'/1X,'I',34X,'I',28X,'I'/1X,65('=')/1X,'I',34X,'I',28X,'I')
+ 7600 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I4,1X,I10,1X,I10,1X,'I')
+ 7700 FORMAT(1X,'I',34X,'I',28X,'I'/1X,65('='))
+ 8000 FORMAT(1X/ 1X/
+ & 17X,'Sums over R-Violating branching ratios',1X/ 1X
+ & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I'/1X,'I',4X
+ & ,'Mother --> Sum over final state flavours',4X,'I',2X
+ & ,'BR(sum)',2X,'I',2X,'N',2X,'I'/1X,'I',50X,'I',11X,'I',5X,'I'
+ & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I')
+ 8100 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I'/1X,70('=')/1X,'I',1X
+ & ,'Total number of R-Violating modes :',3X,I5,24X,'I'/
+ & 1X,'I',1X,'Total number with non-vanishing BR :',2X,I5,24X
+ & ,'I'/1X,'I',1X,'Total number with BR > 0.001 :',8X,I5,24X,'I'
+ & /1X,70('='))
+ 8200 FORMAT(1X,'I',1X,A9,1X,'-->',1X,A24,11X,
+ & 'I',2X,1P,D8.2,0P,1X,'I',2X,I2,1X,'I')
+ 8300 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I')
+ 8500 FORMAT(1X/ 1X/
+ & 1X,'R-Violating couplings',1X/ 1X /
+ & 1X,55('=')/
+ & 1X,'I',1X,'IJK',1X,'I',2X,'LAMBDA(IJK)',2X,'I',2X
+ & ,'LAMBDA''(IJK)',1X,'I',1X,"LAMBDA''(IJK)",1X,'I'/1X,'I',5X
+ & ,'I',15X,'I',15X,'I',15X,'I')
+ 8600 FORMAT(1X,55('='))
+ 8700 FORMAT(1X,'I',1X,I1,I1,I1,1X,'I',1X,1P,D13.3,0P,1X,'I',1X,1P
+ & ,D13.3,0P,1X,'I',1X,1P,D13.3,0P,1X,'I')
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYUPEV
+C...Administers the hard-process generation required for output to the
+C...Les Houches event record.
+
+ SUBROUTINE PYUPEV
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+
+C...Commonblocks.
+ COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
+ COMMON/PYCTAG/NCT,MCT(4000,2)
+ 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/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
+ COMMON/PYINT4/MWID(500),WIDS(500,5)
+ SAVE /PYJETS/,/PYCTAG/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,
+ &/PYINT1/,/PYINT2/,/PYINT4/
+
+C...HEPEUP for output.
+ INTEGER MAXNUP
+ PARAMETER (MAXNUP=500)
+ INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
+ DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
+ COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
+ &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
+ &VTIMUP(MAXNUP),SPINUP(MAXNUP)
+ SAVE /HEPEUP/
+
+C...Stop if no subprocesses on.
+ IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN
+ WRITE(MSTU(11),5100)
+ STOP
+ ENDIF
+
+C...Special flags for hard-process generation only.
+ MSTP71=MSTP(71)
+ MSTP(71)=0
+ MST128=MSTP(128)
+ MSTP(128)=1
+
+C...Initial values for some counters.
+ N=0
+ MINT(5)=MINT(5)+1
+ MINT(7)=0
+ MINT(8)=0
+ MINT(30)=0
+ MINT(83)=0
+ MINT(84)=MSTP(126)
+ MSTU(24)=0
+ MSTU70=0
+ MSTJ14=MSTJ(14)
+C...Normally, use K(I,4:5) colour info rather than /PYCTAG/.
+ MINT(33)=0
+
+C...If variable energies: redo incoming kinematics and cross-section.
+ MSTI(61)=0
+ IF(MSTP(171).EQ.1) THEN
+ CALL PYINKI(1)
+ IF(MSTI(61).EQ.1) THEN
+ MINT(5)=MINT(5)-1
+ RETURN
+ ENDIF
+ IF(MINT(121).GT.1) CALL PYSAVE(3,1)
+ CALL PYXTOT
+ ENDIF
+
+C...Do not allow pileup events.
+ MINT(82)=1
+
+C...Generate variables of hard scattering.
+ MINT(51)=0
+ MSTI(52)=0
+ 100 CONTINUE
+ IF(MINT(51).NE.0.OR.MSTU(24).NE.0) MSTI(52)=MSTI(52)+1
+ MINT(31)=0
+ MINT(51)=0
+ MINT(57)=0
+ CALL PYRAND
+ IF(MSTI(61).EQ.1) THEN
+ MINT(5)=MINT(5)-1
+ RETURN
+ ENDIF
+ IF(MINT(51).EQ.2) RETURN
+ ISUB=MINT(1)
+
+ IF((ISUB.LE.90.OR.ISUB.GE.95).AND.ISUB.NE.99) THEN
+C...Hard scattering (including low-pT):
+C...reconstruct kinematics and colour flow of hard scattering.
+ MINT31=MINT(31)
+ 110 MINT(31)=MINT31
+ MINT(51)=0
+ CALL PYSCAT
+ IF(MINT(51).EQ.1) GOTO 100
+ IPU1=MINT(84)+1
+ IPU2=MINT(84)+2
+
+C...Decay of final state resonances.
+ MINT(32)=0
+ IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10.AND.ISUB.NE.95)
+ & CALL PYRESD(0)
+ IF(MINT(51).EQ.1) GOTO 100
+ MINT(52)=N
+
+C...Longitudinal boost of hard scattering.
+ BETAZ=(VINT(41)-VINT(42))/(VINT(41)+VINT(42))
+ CALL PYROBO(MINT(84)+1,N,0D0,0D0,0D0,0D0,BETAZ)
+
+ ELSEIF(ISUB.NE.99) THEN
+C...Diffractive and elastic scattering.
+ CALL PYDIFF
+
+ ELSE
+C...DIS scattering (photon flux external).
+ CALL PYDISG
+ IF(MINT(51).EQ.1) GOTO 100
+ ENDIF
+
+C...Check that no odd resonance left undecayed.
+ MINT(54)=N
+ NFIX=N
+ DO 120 I=MINT(84)+1,NFIX
+ IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND.
+ & K(I,2).NE.22) THEN
+ KCA=PYCOMP(K(I,2))
+ IF(MWID(KCA).NE.0.AND.MDCY(KCA,1).GE.1) THEN
+ CALL PYRESD(I)
+ IF(MINT(51).EQ.1) GOTO 100
+ ENDIF
+ ENDIF
+ 120 CONTINUE
+
+C...Boost hadronic subsystem to overall rest frame.
+C..(Only relevant when photon inside lepton beam.)
+ IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(4,WTGAGA)
+
+C...Store event information and calculate Monte Carlo estimates of
+C...subprocess cross-sections.
+ 130 CALL PYDOCU
+
+C...Transform to the desired coordinate frame.
+ 140 CALL PYFRAM(MSTP(124))
+ MSTU(70)=MSTU70
+ PARU(21)=VINT(1)
+
+C...Restore special flags for hard-process generation only.
+ MSTP(71)=MSTP71
+ MSTP(128)=MST128
+
+C...Trace colour tags; convert to LHA style labels.
+ NCT=100
+ DO 150 I=MINT(84)+1,N
+ MCT(I,1)=0
+ MCT(I,2)=0
+ 150 CONTINUE
+ DO 160 I=MINT(84)+1,N
+ KQ=KCHG(PYCOMP(K(I,2)),2)*ISIGN(1,K(I,2))
+ IF(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.K(I,1).EQ.14) THEN
+ IF(K(I,4).NE.0.AND.(KQ.EQ.1.OR.KQ.EQ.2).AND.MCT(I,1).EQ.0)
+ & THEN
+ IMO=MOD(K(I,4)/MSTU(5),MSTU(5))
+ IDA=MOD(K(I,4),MSTU(5))
+ IF(IMO.NE.0.AND.MOD(K(IMO,5)/MSTU(5),MSTU(5)).EQ.I.AND.
+ & MCT(IMO,2).NE.0) THEN
+ MCT(I,1)=MCT(IMO,2)
+ ELSEIF(IMO.NE.0.AND.MOD(K(IMO,4),MSTU(5)).EQ.I.AND.
+ & MCT(IMO,1).NE.0) THEN
+ MCT(I,1)=MCT(IMO,1)
+ ELSEIF(IDA.NE.0.AND.MOD(K(IDA,5),MSTU(5)).EQ.I.AND.
+ & MCT(IDA,2).NE.0) THEN
+ MCT(I,1)=MCT(IDA,2)
+ ELSE
+ NCT=NCT+1
+ MCT(I,1)=NCT
+ ENDIF
+ ENDIF
+ IF(K(I,5).NE.0.AND.(KQ.EQ.-1.OR.KQ.EQ.2).AND.MCT(I,2).EQ.0)
+ & THEN
+ IMO=MOD(K(I,5)/MSTU(5),MSTU(5))
+ IDA=MOD(K(I,5),MSTU(5))
+ IF(IMO.NE.0.AND.MOD(K(IMO,4)/MSTU(5),MSTU(5)).EQ.I.AND.
+ & MCT(IMO,1).NE.0) THEN
+ MCT(I,2)=MCT(IMO,1)
+ ELSEIF(IMO.NE.0.AND.MOD(K(IMO,5),MSTU(5)).EQ.I.AND.
+ & MCT(IMO,2).NE.0) THEN
+ MCT(I,2)=MCT(IMO,2)
+ ELSEIF(IDA.NE.0.AND.MOD(K(IDA,4),MSTU(5)).EQ.I.AND.
+ & MCT(IDA,1).NE.0) THEN
+ MCT(I,2)=MCT(IDA,1)
+ ELSE
+ NCT=NCT+1
+ MCT(I,2)=NCT
+ ENDIF
+ ENDIF
+ ENDIF
+ 160 CONTINUE
+
+C...Put event in HEPEUP commonblock.
+ NUP=N-MINT(84)
+ IDPRUP=MINT(1)
+ XWGTUP=1D0
+ SCALUP=VINT(53)
+ AQEDUP=VINT(57)
+ AQCDUP=VINT(58)
+ DO 180 I=1,NUP
+ IDUP(I)=K(I+MINT(84),2)
+ IF(I.LE.2) THEN
+ ISTUP(I)=-1
+ MOTHUP(1,I)=0
+ MOTHUP(2,I)=0
+ ELSEIF(K(I+4,3).EQ.0) THEN
+ ISTUP(I)=1
+ MOTHUP(1,I)=1
+ MOTHUP(2,I)=2
+ ELSE
+ ISTUP(I)=1
+ MOTHUP(1,I)=K(I+MINT(84),3)-MINT(84)
+ MOTHUP(2,I)=0
+ ENDIF
+ IF(I.GE.3.AND.K(I+MINT(84),3).GT.0)
+ & ISTUP(K(I+MINT(84),3)-MINT(84))=2
+ ICOLUP(1,I)=MCT(I+MINT(84),1)
+ ICOLUP(2,I)=MCT(I+MINT(84),2)
+ DO 170 J=1,5
+ PUP(J,I)=P(I+MINT(84),J)
+ 170 CONTINUE
+ VTIMUP(I)=V(I,5)
+ SPINUP(I)=9D0
+ 180 CONTINUE
+
+C...Optionally write out event to disk. Minimal size for time/spin fields.
+ IF(MSTP(162).GT.0) THEN
+ WRITE(MSTP(162),5200) NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP
+ DO 190 I=1,NUP
+ IF(VTIMUP(I).EQ.0D0) THEN
+ WRITE(MSTP(162),5300) IDUP(I),ISTUP(I),MOTHUP(1,I),
+ & MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),(PUP(J,I),J=1,5),
+ & ' 0. 9.'
+ ELSE
+ WRITE(MSTP(162),5400) IDUP(I),ISTUP(I),MOTHUP(1,I),
+ & MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),(PUP(J,I),J=1,5),
+ & VTIMUP(I),' 9.'
+ ENDIF
+ 190 CONTINUE
+
+C...Optional extra line with parton-density information.
+ IF(MSTP(165).GE.1) WRITE(MSTP(162),5500) MSTI(15),MSTI(16),
+ & PARI(33),PARI(34),PARI(23),PARI(29),PARI(30)
+ ENDIF
+
+C...Error messages and other print formats.
+ 5100 FORMAT(1X,'Error: no subprocess switched on.'/
+ &1X,'Execution stopped.')
+ 5200 FORMAT(1P,2I6,4E14.6)
+ 5300 FORMAT(1P,I8,5I5,5E18.10,A6)
+ 5400 FORMAT(1P,I8,5I5,5E18.10,E12.4,A3)
+ 5500 FORMAT(1P,'#pdf ',2I5,5E18.10)
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYUPIN
+C...Fills the HEPRUP commonblock with info on incoming beams and allowed
+C...processes, and optionally stores that information on file.
+
+ SUBROUTINE PYUPIN
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+
+C...Commonblocks.
+ COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
+ COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
+ COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
+ SAVE /PYJETS/,/PYSUBS/,/PYPARS/,/PYINT5/
+
+C...User process initialization commonblock.
+ INTEGER MAXPUP
+ PARAMETER (MAXPUP=100)
+ INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
+ DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
+ COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
+ &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
+ &LPRUP(MAXPUP)
+ SAVE /HEPRUP/
+
+C...Store info on incoming beams.
+ IDBMUP(1)=K(1,2)
+ IDBMUP(2)=K(2,2)
+ EBMUP(1)=P(1,4)
+ EBMUP(2)=P(2,4)
+ PDFGUP(1)=0
+ PDFGUP(2)=0
+ PDFSUP(1)=MSTP(51)
+ PDFSUP(2)=MSTP(51)
+
+C...Event weighting strategy.
+ IDWTUP=3
+
+C...Info on individual processes.
+ NPRUP=0
+ DO 100 ISUB=1,500
+ IF(MSUB(ISUB).EQ.1) THEN
+ NPRUP=NPRUP+1
+ XSECUP(NPRUP)=1D9*XSEC(ISUB,3)
+ XERRUP(NPRUP)=XSECUP(NPRUP)/SQRT(MAX(1D0,DBLE(NGEN(ISUB,3))))
+ XMAXUP(NPRUP)=1D0
+ LPRUP(NPRUP)=ISUB
+ ENDIF
+ 100 CONTINUE
+
+C...Write info to file.
+ IF(MSTP(161).GT.0) THEN
+ WRITE(MSTP(161),5100) IDBMUP(1),IDBMUP(2),EBMUP(1),EBMUP(2),
+ & PDFGUP(1),PDFGUP(2),PDFSUP(1),PDFSUP(2),IDWTUP,NPRUP
+ DO 110 IPR=1,NPRUP
+ WRITE(MSTP(161),5200) XSECUP(IPR),XERRUP(IPR),XMAXUP(IPR),
+ & LPRUP(IPR)
+ 110 CONTINUE
+ ENDIF
+
+C...Formats for printout.
+ 5100 FORMAT(1P,2I8,2E14.6,6I6)
+ 5200 FORMAT(1P,3E14.6,I6)
+
+ RETURN
+ END
+
+
+C*********************************************************************
+
+C...Combine the two old-style Pythia initialization and event files
+C...into a single Les Houches Event File.
+
+ SUBROUTINE PYLHEF
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+
+C...PYTHIA commonblock: only used to provide read/write units and version.
+ COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ SAVE /PYPARS/
+
+C...User process initialization commonblock.
+ INTEGER MAXPUP
+ PARAMETER (MAXPUP=100)
+ INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
+ DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
+ COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
+ &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
+ &LPRUP(MAXPUP)
+ SAVE /HEPRUP/
+
+C...User process event common block.
+ INTEGER MAXNUP
+ PARAMETER (MAXNUP=500)
+ INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
+ DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
+ COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP),
+ &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP),
+ &VTIMUP(MAXNUP),SPINUP(MAXNUP)
+ SAVE /HEPEUP/
+
+C...Lines to read in assumed never longer than 200 characters.
+ PARAMETER (MAXLEN=200)
+ CHARACTER*(MAXLEN) STRING
+
+C...Format for reading lines.
+ CHARACTER*6 STRFMT
+ STRFMT='(A000)'
+ WRITE(STRFMT(3:5),'(I3)') MAXLEN
+
+C...Rewind initialization and event files.
+ REWIND MSTP(161)
+ REWIND MSTP(162)
+
+C...Write header info.
+ WRITE(MSTP(163),'(A)') '<LesHouchesEvents version="1.0">'
+ WRITE(MSTP(163),'(A)') '<!--'
+ WRITE(MSTP(163),'(A,I1,A1,I3)') 'File generated with PYTHIA ',
+ &MSTP(181),'.',MSTP(182)
+ WRITE(MSTP(163),'(A)') '-->'
+
+C...Read first line of initialization info and get number of processes.
+ READ(MSTP(161),'(A)',END=400,ERR=400) STRING
+ READ(STRING,*,ERR=400) IDBMUP(1),IDBMUP(2),EBMUP(1),
+ &EBMUP(2),PDFGUP(1),PDFGUP(2),PDFSUP(1),PDFSUP(2),IDWTUP,NPRUP
+
+C...Copy initialization lines, omitting trailing blanks.
+C...Embed in <init> ... </init> block.
+ WRITE(MSTP(163),'(A)') '<init>'
+ DO 140 IPR=0,NPRUP
+ IF(IPR.GT.0) READ(MSTP(161),'(A)',END=400,ERR=400) STRING
+ LEN=MAXLEN+1
+ 120 LEN=LEN-1
+ IF(LEN.GT.1.AND.STRING(LEN:LEN).EQ.' ') GOTO 120
+ WRITE(MSTP(163),'(A)',ERR=400) STRING(1:LEN)
+ 140 CONTINUE
+ WRITE(MSTP(163),'(A)') '</init>'
+
+C...Begin event loop. Read first line of event info or already done.
+ READ(MSTP(162),'(A)',END=320,ERR=400) STRING
+ 200 CONTINUE
+
+C...Look at first line to know number of particles in event.
+ READ(STRING,*,ERR=400) NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP
+
+C...Begin an <event> block. Copy event lines, omitting trailing blanks.
+ WRITE(MSTP(163),'(A)') '<event>'
+ DO 240 I=0,NUP
+ IF(I.GT.0) READ(MSTP(162),'(A)',END=400,ERR=400) STRING
+ LEN=MAXLEN+1
+ 220 LEN=LEN-1
+ IF(LEN.GT.1.AND.STRING(LEN:LEN).EQ.' ') GOTO 220
+ WRITE(MSTP(163),'(A)',ERR=400) STRING(1:LEN)
+ 240 CONTINUE
+
+C...Copy trailing comment lines - with a # in the first column - as is.
+ 260 READ(MSTP(162),'(A)',END=300,ERR=400) STRING
+ IF(STRING(1:1).EQ.'#') THEN
+ LEN=MAXLEN+1
+ 280 LEN=LEN-1
+ IF(LEN.GT.1.AND.STRING(LEN:LEN).EQ.' ') GOTO 280
+ WRITE(MSTP(163),'(A)',ERR=400) STRING(1:LEN)
+ GOTO 260
+ ENDIF
+
+C..End the <event> block. Loop back to look for next event.
+ WRITE(MSTP(163),'(A)') '</event>'
+ GOTO 200
+
+C...Successfully reached end of event loop: write closing tag
+C...and remove temporary intermediate files (unless asked not to).
+ 300 WRITE(MSTP(163),'(A)') '</event>'
+ 320 WRITE(MSTP(163),'(A)') '</LesHouchesEvents>'
+ IF(MSTP(164).EQ.1) RETURN
+ CLOSE(MSTP(161),ERR=400,STATUS='DELETE')
+ CLOSE(MSTP(162),ERR=400,STATUS='DELETE')
+ RETURN
+
+C...Error exit.
+ 400 WRITE(*,*) ' PYLHEF file joining failed!'
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYINRE
+C...Calculates full and effective widths of gauge bosons, stores
+C...masses and widths, rescales coefficients to be used for
+C...resonance production generation.
+
+ SUBROUTINE PYINRE
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+C...Parameter statement to help give large particle numbers.
+ PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
+ &KEXCIT=4000000,KDIMEN=5000000)
+C...Commonblocks.
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
+ COMMON/PYDAT4/CHAF(500,2)
+ CHARACTER CHAF*16
+ COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
+ COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
+ COMMON/PYINT4/MWID(500),WIDS(500,5)
+ COMMON/PYINT6/PROC(0:500)
+ CHARACTER PROC*28
+ COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
+ SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/,
+ &/PYINT1/,/PYINT2/,/PYINT4/,/PYINT6/,/PYMSSM/
+C...Local arrays and data.
+ DIMENSION WDTP(0:400),WDTE(0:400,0:5),WDTPM(0:400),
+ &WDTEM(0:400,0:5),KCORD(500),PMORD(500)
+
+C...Born level couplings in MSSM Higgs doublet sector.
+ XW=PARU(102)
+ XWV=XW
+ IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2
+ XW1=1D0-XW
+ IF(MSTP(4).EQ.2) THEN
+ TANBE=PARU(141)
+ RATBE=((1D0-TANBE**2)/(1D0+TANBE**2))**2
+ SQMZ=PMAS(23,1)**2
+ SQMW=PMAS(24,1)**2
+ SQMH=PMAS(25,1)**2
+ SQMA=SQMH*(SQMZ-SQMH)/(SQMZ*RATBE-SQMH)
+ SQMHP=0.5D0*(SQMA+SQMZ+SQRT((SQMA+SQMZ)**2-4D0*SQMA*SQMZ*RATBE))
+ SQMHC=SQMA+SQMW
+ IF(SQMH.GE.SQMZ.OR.MIN(SQMA,SQMHP,SQMHC).LE.0D0) THEN
+ WRITE(MSTU(11),5000)
+ CALL PYSTOP(101)
+ ENDIF
+ PMAS(35,1)=SQRT(SQMHP)
+ PMAS(36,1)=SQRT(SQMA)
+ PMAS(37,1)=SQRT(SQMHC)
+ ALSU=0.5D0*ATAN(2D0*TANBE*(SQMA+SQMZ)/((1D0-TANBE**2)*
+ & (SQMA-SQMZ)))
+ BESU=ATAN(TANBE)
+ PARU(142)=1D0
+ PARU(143)=1D0
+ PARU(161)=-SIN(ALSU)/COS(BESU)
+ PARU(162)=COS(ALSU)/SIN(BESU)
+ PARU(163)=PARU(161)
+ PARU(164)=SIN(BESU-ALSU)
+ PARU(165)=PARU(164)
+ PARU(168)=SIN(BESU-ALSU)+0.5D0*COS(2D0*BESU)*SIN(BESU+ALSU)/XW
+ PARU(171)=COS(ALSU)/COS(BESU)
+ PARU(172)=SIN(ALSU)/SIN(BESU)
+ PARU(173)=PARU(171)
+ PARU(174)=COS(BESU-ALSU)
+ PARU(175)=PARU(174)
+ PARU(176)=COS(2D0*ALSU)*COS(BESU+ALSU)-2D0*SIN(2D0*ALSU)*
+ & SIN(BESU+ALSU)
+ PARU(177)=COS(2D0*BESU)*COS(BESU+ALSU)
+ PARU(178)=COS(BESU-ALSU)-0.5D0*COS(2D0*BESU)*COS(BESU+ALSU)/XW
+ PARU(181)=TANBE
+ PARU(182)=1D0/TANBE
+ PARU(183)=PARU(181)
+ PARU(184)=0D0
+ PARU(185)=PARU(184)
+ PARU(186)=COS(BESU-ALSU)
+ PARU(187)=SIN(BESU-ALSU)
+ PARU(188)=PARU(186)
+ PARU(189)=PARU(187)
+ PARU(190)=0D0
+ PARU(195)=COS(BESU-ALSU)
+ ENDIF
+
+C...Reset effective widths of gauge bosons.
+ DO 110 I=1,500
+ DO 100 J=1,5
+ WIDS(I,J)=1D0
+ 100 CONTINUE
+ 110 CONTINUE
+
+C...Order resonances by increasing mass (except Z0 and W+/-).
+ NRES=0
+ DO 140 KC=1,500
+ KF=KCHG(KC,4)
+ IF(KF.EQ.0) GOTO 140
+ IF(MWID(KC).EQ.0) GOTO 140
+ IF(KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18) THEN
+ IF(MSTP(1).LE.3) GOTO 140
+ ENDIF
+ IF(KF/KSUSY1.EQ.1.OR.KF/KSUSY1.EQ.2) THEN
+ IF(IMSS(1).LE.0) GOTO 140
+ ENDIF
+ NRES=NRES+1
+ PMRES=PMAS(KC,1)
+ IF(KC.EQ.23.OR.KC.EQ.24) PMRES=0D0
+ DO 120 I1=NRES-1,1,-1
+ IF(PMRES.GE.PMORD(I1)) GOTO 130
+ KCORD(I1+1)=KCORD(I1)
+ PMORD(I1+1)=PMORD(I1)
+ 120 CONTINUE
+ 130 KCORD(I1+1)=KC
+ PMORD(I1+1)=PMRES
+ 140 CONTINUE
+
+C...Loop over possible resonances.
+ DO 180 I=1,NRES
+ KC=KCORD(I)
+ KF=KCHG(KC,4)
+
+C...Check that no fourth generation channels on by mistake.
+ IF(MSTP(1).LE.3) THEN
+ DO 150 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ KFA1=IABS(KFDP(IDC,1))
+ KFA2=IABS(KFDP(IDC,2))
+ IF(KFA1.EQ.7.OR.KFA1.EQ.8.OR.KFA1.EQ.17.OR.KFA1.EQ.18.OR.
+ & KFA2.EQ.7.OR.KFA2.EQ.8.OR.KFA2.EQ.17.OR.KFA2.EQ.18)
+ & MDME(IDC,1)=-1
+ 150 CONTINUE
+ ENDIF
+
+C...Check that no supersymmetric channels on by mistake.
+ IF(IMSS(1).LE.0) THEN
+ DO 160 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ KFA1S=IABS(KFDP(IDC,1))/KSUSY1
+ KFA2S=IABS(KFDP(IDC,2))/KSUSY1
+ IF(KFA1S.EQ.1.OR.KFA1S.EQ.2.OR.KFA2S.EQ.1.OR.KFA2S.EQ.2)
+ & MDME(IDC,1)=-1
+ 160 CONTINUE
+ ENDIF
+
+C...Find mass and evaluate width.
+ PMR=PMAS(KC,1)
+ IF(KF.EQ.25.OR.KF.EQ.35.OR.KF.EQ.36) MINT(62)=1
+ IF(MWID(KC).EQ.3) MINT(63)=1
+ CALL PYWIDT(KF,PMR**2,WDTP,WDTE)
+ MINT(51)=0
+
+C...Evaluate suppression factors due to non-simulated channels.
+ IF(KCHG(KC,3).EQ.0) THEN
+ WDTP0I=0D0
+ IF(WDTP(0).GT.0D0) WDTP0I=1D0/WDTP(0)
+ WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))**2+
+ & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+
+ & 2D0*WDTE(0,4)*WDTE(0,5))*WDTP0I**2
+ WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*WDTP0I
+ WIDS(KC,3)=0D0
+ WIDS(KC,4)=0D0
+ WIDS(KC,5)=0D0
+ ELSE
+ IF(MWID(KC).EQ.3) MINT(63)=1
+ CALL PYWIDT(-KF,PMR**2,WDTPM,WDTEM)
+ MINT(51)=0
+ WDTP0I=0D0
+ IF(WDTP(0).GT.0D0) WDTP0I=1D0/WDTP(0)
+ WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))*(WDTEM(0,1)+WDTEM(0,3))+
+ & (WDTE(0,1)+WDTE(0,2))*(WDTEM(0,4)+WDTEM(0,5))+
+ & (WDTE(0,4)+WDTE(0,5))*(WDTEM(0,1)+WDTEM(0,3))+
+ & WDTE(0,4)*WDTEM(0,5)+WDTE(0,5)*WDTEM(0,4))*WDTP0I**2
+ WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*WDTP0I
+ WIDS(KC,3)=(WDTEM(0,1)+WDTEM(0,3)+WDTEM(0,4))*WDTP0I
+ WIDS(KC,4)=((WDTE(0,1)+WDTE(0,2))**2+
+ & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+
+ & 2D0*WDTE(0,4)*WDTE(0,5))*WDTP0I**2
+ WIDS(KC,5)=((WDTEM(0,1)+WDTEM(0,3))**2+
+ & 2D0*(WDTEM(0,1)+WDTEM(0,3))*(WDTEM(0,4)+WDTEM(0,5))+
+ & 2D0*WDTEM(0,4)*WDTEM(0,5))*WDTP0I**2
+ ENDIF
+
+C...Set resonance widths and branching ratios;
+C...also on/off switch for decays.
+ IF(MWID(KC).EQ.1.OR.MWID(KC).EQ.3) THEN
+ PMAS(KC,2)=WDTP(0)
+ PMAS(KC,3)=MIN(0.9D0*PMAS(KC,1),10D0*PMAS(KC,2))
+ IF(MSTP(41).EQ.0.OR.MSTP(41).EQ.1) MDCY(KC,1)=MSTP(41)
+ DO 170 J=1,MDCY(KC,3)
+ IDC=J+MDCY(KC,2)-1
+ BRAT(IDC)=0D0
+ IF(WDTP(0).GT.0D0) BRAT(IDC)=WDTP(J)/WDTP(0)
+ 170 CONTINUE
+ ENDIF
+ 180 CONTINUE
+
+C...Flavours of leptoquark: redefine charge and name.
+ KFLQQ=KFDP(MDCY(42,2),1)
+ KFLQL=KFDP(MDCY(42,2),2)
+ KCHG(42,1)=KCHG(PYCOMP(KFLQQ),1)*ISIGN(1,KFLQQ)+
+ &KCHG(PYCOMP(KFLQL),1)*ISIGN(1,KFLQL)
+ LL=1
+ IF(IABS(KFLQL).EQ.13) LL=2
+ IF(IABS(KFLQL).EQ.15) LL=3
+ CHAF(42,1)='LQ_'//CHAF(IABS(KFLQQ),1)(1:1)//
+ &CHAF(IABS(KFLQL),1)(1:LL)//' '
+ CHAF(42,2)=CHAF(42,2)(1:4+LL)//'bar '
+
+C...Special cases in treatment of gamma*/Z0: redefine process name.
+ IF(MSTP(43).EQ.1) THEN
+ PROC(1)='f + fbar -> gamma*'
+ PROC(15)='f + fbar -> g + gamma*'
+ PROC(19)='f + fbar -> gamma + gamma*'
+ PROC(30)='f + g -> f + gamma*'
+ PROC(35)='f + gamma -> f + gamma*'
+ ELSEIF(MSTP(43).EQ.2) THEN
+ PROC(1)='f + fbar -> Z0'
+ PROC(15)='f + fbar -> g + Z0'
+ PROC(19)='f + fbar -> gamma + Z0'
+ PROC(30)='f + g -> f + Z0'
+ PROC(35)='f + gamma -> f + Z0'
+ ELSEIF(MSTP(43).EQ.3) THEN
+ PROC(1)='f + fbar -> gamma*/Z0'
+ PROC(15)='f + fbar -> g + gamma*/Z0'
+ PROC(19)='f+ fbar -> gamma + gamma*/Z0'
+ PROC(30)='f + g -> f + gamma*/Z0'
+ PROC(35)='f + gamma -> f + gamma*/Z0'
+ ENDIF
+
+C...Special cases in treatment of gamma*/Z0/Z'0: redefine process name.
+ IF(MSTP(44).EQ.1) THEN
+ PROC(141)='f + fbar -> gamma*'
+ ELSEIF(MSTP(44).EQ.2) THEN
+ PROC(141)='f + fbar -> Z0'
+ ELSEIF(MSTP(44).EQ.3) THEN
+ PROC(141)='f + fbar -> Z''0'
+ ELSEIF(MSTP(44).EQ.4) THEN
+ PROC(141)='f + fbar -> gamma*/Z0'
+ ELSEIF(MSTP(44).EQ.5) THEN
+ PROC(141)='f + fbar -> gamma*/Z''0'
+ ELSEIF(MSTP(44).EQ.6) THEN
+ PROC(141)='f + fbar -> Z0/Z''0'
+ ELSEIF(MSTP(44).EQ.7) THEN
+ PROC(141)='f + fbar -> gamma*/Z0/Z''0'
+ ENDIF
+
+C...Special cases in treatment of WW -> WW: redefine process name.
+ IF(MSTP(45).EQ.1) THEN
+ PROC(77)='W+ + W+ -> W+ + W+'
+ ELSEIF(MSTP(45).EQ.2) THEN
+ PROC(77)='W+ + W- -> W+ + W-'
+ ELSEIF(MSTP(45).EQ.3) THEN
+ PROC(77)='W+/- + W+/- -> W+/- + W+/-'
+ ENDIF
+
+C...Format for error information.
+ 5000 FORMAT(1X,'Error: unphysical input tan^2(beta) and m_H ',
+ &'combination'/1X,'Execution stopped!')
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYINBM
+C...Identifies the two incoming particles and the choice of frame.
+
+ SUBROUTINE PYINBM(CHFRAM,CHBEAM,CHTARG,WIN)
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+
+C...User process initialization commonblock.
+ INTEGER MAXPUP
+ PARAMETER (MAXPUP=100)
+ INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
+ DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
+ COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
+ &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
+ &LPRUP(MAXPUP)
+ SAVE /HEPRUP/
+
+C...Commonblocks.
+ COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
+ COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT1/MINT(400),VINT(400)
+ SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/
+
+C...Local arrays, character variables and data.
+ CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHCOM(3)*12,CHALP(2)*26,
+ &CHIDNT(3)*12,CHTEMP*12,CHCDE(39)*12,CHINIT*76,CHNAME*16
+ DIMENSION LEN(3),KCDE(39),PM(2)
+ DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
+ &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
+ DATA CHCDE/ 'e- ','e+ ','nu_e ',
+ &'nu_ebar ','mu- ','mu+ ','nu_mu ',
+ &'nu_mubar ','tau- ','tau+ ','nu_tau ',
+ &'nu_taubar ','pi+ ','pi- ','n0 ',
+ &'nbar0 ','p+ ','pbar- ','gamma ',
+ &'lambda0 ','sigma- ','sigma0 ','sigma+ ',
+ &'xi- ','xi0 ','omega- ','pi0 ',
+ &'reggeon ','pomeron ','gamma/e- ','gamma/e+ ',
+ &'gamma/mu- ','gamma/mu+ ','gamma/tau- ','gamma/tau+ ',
+ &'k+ ','k- ','ks0 ','kl0 '/
+ DATA KCDE/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16,
+ &211,-211,2112,-2112,2212,-2212,22,3122,3112,3212,3222,
+ &3312,3322,3334,111,110,990,6*22,321,-321,310,130/
+
+C...Store initial energy. Default frame.
+ VINT(290)=WIN
+ MINT(111)=0
+
+C...Special user process initialization; convert to normal input.
+ IF(CHFRAM(1:1).EQ.'u'.OR.CHFRAM(1:1).EQ.'U') THEN
+ MINT(111)=11
+ IF(PDFGUP(1).EQ.-9.OR.PDFGUP(2).EQ.-9) MINT(111)=12
+ CALL PYNAME(IDBMUP(1),CHNAME)
+ CHBEAM=CHNAME(1:12)
+ CALL PYNAME(IDBMUP(2),CHNAME)
+ CHTARG=CHNAME(1:12)
+ ENDIF
+
+C...Convert character variables to lowercase and find their length.
+ CHCOM(1)=CHFRAM
+ CHCOM(2)=CHBEAM
+ CHCOM(3)=CHTARG
+ DO 130 I=1,3
+ LEN(I)=12
+ DO 110 LL=12,1,-1
+ IF(LEN(I).EQ.LL.AND.CHCOM(I)(LL:LL).EQ.' ') LEN(I)=LL-1
+ DO 100 LA=1,26
+ IF(CHCOM(I)(LL:LL).EQ.CHALP(2)(LA:LA)) CHCOM(I)(LL:LL)=
+ & CHALP(1)(LA:LA)
+ 100 CONTINUE
+ 110 CONTINUE
+ CHIDNT(I)=CHCOM(I)
+
+C...Fix up bar, underscore and charge in particle name (if needed).
+ DO 120 LL=1,10
+ IF(CHIDNT(I)(LL:LL).EQ.'~') THEN
+ CHTEMP=CHIDNT(I)
+ CHIDNT(I)=CHTEMP(1:LL-1)//'bar'//CHTEMP(LL+1:10)//' '
+ ENDIF
+ 120 CONTINUE
+ IF(CHIDNT(I)(1:2).EQ.'nu'.AND.CHIDNT(I)(3:3).NE.'_') THEN
+ CHTEMP=CHIDNT(I)
+ CHIDNT(I)='nu_'//CHTEMP(3:7)
+ ELSEIF(CHIDNT(I)(1:2).EQ.'n ') THEN
+ CHIDNT(I)(1:3)='n0 '
+ ELSEIF(CHIDNT(I)(1:4).EQ.'nbar') THEN
+ CHIDNT(I)(1:5)='nbar0'
+ ELSEIF(CHIDNT(I)(1:2).EQ.'p ') THEN
+ CHIDNT(I)(1:3)='p+ '
+ ELSEIF(CHIDNT(I)(1:4).EQ.'pbar'.OR.
+ & CHIDNT(I)(1:2).EQ.'p-') THEN
+ CHIDNT(I)(1:5)='pbar-'
+ ELSEIF(CHIDNT(I)(1:6).EQ.'lambda') THEN
+ CHIDNT(I)(7:7)='0'
+ ELSEIF(CHIDNT(I)(1:3).EQ.'reg') THEN
+ CHIDNT(I)(1:7)='reggeon'
+ ELSEIF(CHIDNT(I)(1:3).EQ.'pom') THEN
+ CHIDNT(I)(1:7)='pomeron'
+ ENDIF
+ 130 CONTINUE
+
+C...Identify free initialization.
+ IF(CHCOM(1)(1:2).EQ.'no') THEN
+ MINT(65)=1
+ RETURN
+ ENDIF
+
+C...Identify incoming beam and target particles.
+ DO 160 I=1,2
+ DO 140 J=1,39
+ IF(CHIDNT(I+1).EQ.CHCDE(J)) MINT(10+I)=KCDE(J)
+ 140 CONTINUE
+ PM(I)=PYMASS(MINT(10+I))
+ VINT(2+I)=PM(I)
+ MINT(140+I)=0
+ IF(MINT(10+I).EQ.22.AND.CHIDNT(I+1)(6:6).EQ.'/') THEN
+ CHTEMP=CHIDNT(I+1)(7:12)//' '
+ DO 150 J=1,12
+ IF(CHTEMP.EQ.CHCDE(J)) MINT(140+I)=KCDE(J)
+ 150 CONTINUE
+ PM(I)=PYMASS(MINT(140+I))
+ VINT(302+I)=PM(I)
+ ENDIF
+ 160 CONTINUE
+ IF(MINT(11).EQ.0) WRITE(MSTU(11),5000) CHBEAM(1:LEN(2))
+ IF(MINT(12).EQ.0) WRITE(MSTU(11),5100) CHTARG(1:LEN(3))
+ IF(MINT(11).EQ.0.OR.MINT(12).EQ.0) CALL PYSTOP(7)
+
+C...Identify choice of frame and input energies.
+ CHINIT=' '
+
+C...Events defined in the CM frame.
+ IF(CHCOM(1)(1:2).EQ.'cm') THEN
+ MINT(111)=1
+ S=WIN**2
+ IF(MSTP(122).GE.1) THEN
+ IF(CHCOM(2)(1:1).NE.'e') THEN
+ LOFFS=(31-(LEN(2)+LEN(3)))/2
+ CHINIT(LOFFS+1:76)='PYTHIA will be initialized for a '//
+ & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
+ & ' collider'//' '
+ ELSE
+ LOFFS=(30-(LEN(2)+LEN(3)))/2
+ CHINIT(LOFFS+1:76)='PYTHIA will be initialized for an '//
+ & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
+ & ' collider'//' '
+ ENDIF
+ WRITE(MSTU(11),5200) CHINIT
+ WRITE(MSTU(11),5300) WIN
+ ENDIF
+
+C...Events defined in fixed target frame.
+ ELSEIF(CHCOM(1)(1:3).EQ.'fix') THEN
+ MINT(111)=2
+ S=PM(1)**2+PM(2)**2+2D0*PM(2)*SQRT(PM(1)**2+WIN**2)
+ IF(MSTP(122).GE.1) THEN
+ LOFFS=(29-(LEN(2)+LEN(3)))/2
+ CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
+ & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
+ & ' fixed target'//' '
+ WRITE(MSTU(11),5200) CHINIT
+ WRITE(MSTU(11),5400) WIN
+ WRITE(MSTU(11),5500) SQRT(S)
+ ENDIF
+
+C...Frame defined by user three-vectors.
+ ELSEIF(CHCOM(1)(1:1).EQ.'3') THEN
+ MINT(111)=3
+ P(1,5)=PM(1)
+ P(2,5)=PM(2)
+ P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2)
+ P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2)
+ S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2-
+ & (P(1,3)+P(2,3))**2
+ IF(MSTP(122).GE.1) THEN
+ LOFFS=(22-(LEN(2)+LEN(3)))/2
+ CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
+ & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
+ & ' user configuration'//' '
+ WRITE(MSTU(11),5200) CHINIT
+ WRITE(MSTU(11),5600)
+ WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4)
+ WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4)
+ WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
+ ENDIF
+
+C...Frame defined by user four-vectors.
+ ELSEIF(CHCOM(1)(1:1).EQ.'4') THEN
+ MINT(111)=4
+ PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2
+ P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1)
+ PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2
+ P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2)
+ S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2-
+ & (P(1,3)+P(2,3))**2
+ IF(MSTP(122).GE.1) THEN
+ LOFFS=(22-(LEN(2)+LEN(3)))/2
+ CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
+ & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
+ & ' user configuration'//' '
+ WRITE(MSTU(11),5200) CHINIT
+ WRITE(MSTU(11),5600)
+ WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4)
+ WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4)
+ WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
+ ENDIF
+
+C...Frame defined by user five-vectors.
+ ELSEIF(CHCOM(1)(1:1).EQ.'5') THEN
+ MINT(111)=5
+ S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2-
+ & (P(1,3)+P(2,3))**2
+ IF(MSTP(122).GE.1) THEN
+ LOFFS=(22-(LEN(2)+LEN(3)))/2
+ CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
+ & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
+ & ' user configuration'//' '
+ WRITE(MSTU(11),5200) CHINIT
+ WRITE(MSTU(11),5600)
+ WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4)
+ WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4)
+ WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
+ ENDIF
+
+C...Frame defined by HEPRUP common block.
+ ELSEIF(MINT(111).GE.11) THEN
+ S=(EBMUP(1)+EBMUP(2))**2-(SQRT(MAX(0D0,EBMUP(1)**2-PM(1)**2))-
+ & SQRT(MAX(0D0,EBMUP(2)**2-PM(2)**2)))**2
+ IF(MSTP(122).GE.1) THEN
+ LOFFS=(22-(LEN(2)+LEN(3)))/2
+ CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
+ & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
+ & ' user configuration'//' '
+ WRITE(MSTU(11),5200) CHINIT
+ WRITE(MSTU(11),6000) EBMUP(1),EBMUP(2)
+ WRITE(MSTU(11),5500) SQRT(MAX(0D0,S))
+ ENDIF
+
+C...Unknown frame. Error for too low CM energy.
+ ELSE
+ WRITE(MSTU(11),5800) CHFRAM(1:LEN(1))
+ CALL PYSTOP(7)
+ ENDIF
+ IF(S.LT.PARP(2)**2) THEN
+ WRITE(MSTU(11),5900) SQRT(S)
+ CALL PYSTOP(7)
+ ENDIF
+
+C...Formats for initialization and error information.
+ 5000 FORMAT(1X,'Error: unrecognized beam particle ''',A,'''D0'/
+ &1X,'Execution stopped!')
+ 5100 FORMAT(1X,'Error: unrecognized target particle ''',A,'''D0'/
+ &1X,'Execution stopped!')
+ 5200 FORMAT(/1X,78('=')/1X,'I',76X,'I'/1X,'I',A76,'I')
+ 5300 FORMAT(1X,'I',18X,'at',1X,F10.3,1X,'GeV center-of-mass energy',
+ &19X,'I'/1X,'I',76X,'I'/1X,78('='))
+ 5400 FORMAT(1X,'I',22X,'at',1X,F10.3,1X,'GeV/c lab-momentum',22X,'I')
+ 5500 FORMAT(1X,'I',76X,'I'/1X,'I',11X,'corresponding to',1X,F10.3,1X,
+ &'GeV center-of-mass energy',12X,'I'/1X,'I',76X,'I'/1X,78('='))
+ 5600 FORMAT(1X,'I',76X,'I'/1X,'I',18X,'px (GeV/c)',3X,'py (GeV/c)',3X,
+ &'pz (GeV/c)',6X,'E (GeV)',9X,'I')
+ 5700 FORMAT(1X,'I',8X,A8,4(2X,F10.3,1X),8X,'I')
+ 5800 FORMAT(1X,'Error: unrecognized coordinate frame ''',A,'''D0'/
+ &1X,'Execution stopped!')
+ 5900 FORMAT(1X,'Error: too low CM energy,',F8.3,' GeV for event ',
+ &'generation.'/1X,'Execution stopped!')
+ 6000 FORMAT(1X,'I',12X,'with',1X,F10.3,1X,'GeV on',1X,F10.3,1X,
+ &'GeV beam energies',13X,'I')
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYINKI
+C...Sets up kinematics, including rotations and boosts to/from CM frame.
+
+ SUBROUTINE PYINKI(MODKI)
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+
+C...User process initialization commonblock.
+ INTEGER MAXPUP
+ PARAMETER (MAXPUP=100)
+ INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
+ DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
+ COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
+ &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
+ &LPRUP(MAXPUP)
+ SAVE /HEPRUP/
+
+C...Commonblocks.
+ COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
+ COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT1/MINT(400),VINT(400)
+ SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/
+
+C...Set initial flavour state.
+ N=2
+ DO 100 I=1,2
+ K(I,1)=1
+ K(I,2)=MINT(10+I)
+ IF(MINT(140+I).NE.0) K(I,2)=MINT(140+I)
+ 100 CONTINUE
+
+C...Reset boost. Do kinematics for various cases.
+ DO 110 J=6,10
+ VINT(J)=0D0
+ 110 CONTINUE
+
+C...Set up kinematics for events defined in CM frame.
+ IF(MINT(111).EQ.1) THEN
+ WIN=VINT(290)
+ IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290)
+ S=WIN**2
+ P(1,5)=VINT(3)
+ P(2,5)=VINT(4)
+ IF(MINT(141).NE.0) P(1,5)=VINT(303)
+ IF(MINT(142).NE.0) P(2,5)=VINT(304)
+ P(1,1)=0D0
+ P(1,2)=0D0
+ P(2,1)=0D0
+ P(2,2)=0D0
+ P(1,3)=SQRT(((S-P(1,5)**2-P(2,5)**2)**2-(2D0*P(1,5)*P(2,5))**2)/
+ & (4D0*S))
+ P(2,3)=-P(1,3)
+ P(1,4)=SQRT(P(1,3)**2+P(1,5)**2)
+ P(2,4)=SQRT(P(2,3)**2+P(2,5)**2)
+
+C...Set up kinematics for fixed target events.
+ ELSEIF(MINT(111).EQ.2) THEN
+ WIN=VINT(290)
+ IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290)
+ P(1,5)=VINT(3)
+ P(2,5)=VINT(4)
+ IF(MINT(141).NE.0) P(1,5)=VINT(303)
+ IF(MINT(142).NE.0) P(2,5)=VINT(304)
+ P(1,1)=0D0
+ P(1,2)=0D0
+ P(2,1)=0D0
+ P(2,2)=0D0
+ P(1,3)=WIN
+ P(1,4)=SQRT(P(1,3)**2+P(1,5)**2)
+ P(2,3)=0D0
+ P(2,4)=P(2,5)
+ S=P(1,5)**2+P(2,5)**2+2D0*P(2,4)*P(1,4)
+ VINT(10)=P(1,3)/(P(1,4)+P(2,4))
+ CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10))
+
+C...Set up kinematics for events in user-defined frame.
+ ELSEIF(MINT(111).EQ.3) THEN
+ P(1,5)=VINT(3)
+ P(2,5)=VINT(4)
+ IF(MINT(141).NE.0) P(1,5)=VINT(303)
+ IF(MINT(142).NE.0) P(2,5)=VINT(304)
+ P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2)
+ P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2)
+ DO 120 J=1,3
+ VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4))
+ 120 CONTINUE
+ CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10))
+ VINT(7)=PYANGL(P(1,1),P(1,2))
+ CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0)
+ VINT(6)=PYANGL(P(1,3),P(1,1))
+ CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0)
+ S=P(1,5)**2+P(2,5)**2+2D0*(P(1,4)*P(2,4)-P(1,3)*P(2,3))
+
+C...Set up kinematics for events with user-defined four-vectors.
+ ELSEIF(MINT(111).EQ.4) THEN
+ PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2
+ P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1)
+ PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2
+ P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2)
+ DO 130 J=1,3
+ VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4))
+ 130 CONTINUE
+ CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10))
+ VINT(7)=PYANGL(P(1,1),P(1,2))
+ CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0)
+ VINT(6)=PYANGL(P(1,3),P(1,1))
+ CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0)
+ S=(P(1,4)+P(2,4))**2
+
+C...Set up kinematics for events with user-defined five-vectors.
+ ELSEIF(MINT(111).EQ.5) THEN
+ DO 140 J=1,3
+ VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4))
+ 140 CONTINUE
+ CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10))
+ VINT(7)=PYANGL(P(1,1),P(1,2))
+ CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0)
+ VINT(6)=PYANGL(P(1,3),P(1,1))
+ CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0)
+ S=(P(1,4)+P(2,4))**2
+
+C...Set up kinematics for events with external user processes.
+ ELSEIF(MINT(111).GE.11) THEN
+ P(1,5)=VINT(3)
+ P(2,5)=VINT(4)
+ IF(MINT(141).NE.0) P(1,5)=VINT(303)
+ IF(MINT(142).NE.0) P(2,5)=VINT(304)
+ P(1,1)=0D0
+ P(1,2)=0D0
+ P(2,1)=0D0
+ P(2,2)=0D0
+ P(1,3)=SQRT(MAX(0D0,EBMUP(1)**2-P(1,5)**2))
+ P(2,3)=-SQRT(MAX(0D0,EBMUP(2)**2-P(2,5)**2))
+ P(1,4)=EBMUP(1)
+ P(2,4)=EBMUP(2)
+ VINT(10)=(P(1,3)+P(2,3))/(P(1,4)+P(2,4))
+ CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10))
+ S=(P(1,4)+P(2,4))**2
+ ENDIF
+
+C...Return or error for too low CM energy.
+ IF(MODKI.EQ.1.AND.S.LT.PARP(2)**2) THEN
+ IF(MSTP(172).LE.1) THEN
+ CALL PYERRM(23,
+ & '(PYINKI:) too low invariant mass in this event')
+ ELSE
+ MSTI(61)=1
+ RETURN
+ ENDIF
+ ENDIF
+
+C...Save information on incoming particles.
+ VINT(1)=SQRT(S)
+ VINT(2)=S
+ IF(MINT(111).GE.4) THEN
+ IF(MINT(141).EQ.0) THEN
+ VINT(3)=P(1,5)
+ IF(MINT(11).EQ.22.AND.P(1,5).LT.0) VINT(307)=P(1,5)**2
+ ELSE
+ VINT(303)=P(1,5)
+ ENDIF
+ IF(MINT(142).EQ.0) THEN
+ VINT(4)=P(2,5)
+ IF(MINT(12).EQ.22.AND.P(2,5).LT.0) VINT(308)=P(2,5)**2
+ ELSE
+ VINT(304)=P(2,5)
+ ENDIF
+ ENDIF
+ VINT(5)=P(1,3)
+ IF(MODKI.EQ.0) VINT(289)=S
+ DO 150 J=1,5
+ V(1,J)=0D0
+ V(2,J)=0D0
+ VINT(290+J)=P(1,J)
+ VINT(295+J)=P(2,J)
+ 150 CONTINUE
+
+C...Store pT cut-off and related constants to be used in generation.
+ IF(MODKI.EQ.0) VINT(285)=CKIN(3)
+ IF(MSTP(82).LE.1) THEN
+ PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90)
+ ELSE
+ PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90)
+ ENDIF
+ VINT(149)=4D0*PTMN**2/S
+ VINT(154)=PTMN
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYINPR
+C...Selects partonic subprocesses to be included in the simulation.
+
+ SUBROUTINE PYINPR
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+
+C...User process initialization commonblock.
+ INTEGER MAXPUP
+ PARAMETER (MAXPUP=100)
+ INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
+ DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
+ COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
+ &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
+ &LPRUP(MAXPUP)
+ SAVE /HEPRUP/
+
+C...Commonblocks and character variables.
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ 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/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
+ COMMON/PYINT6/PROC(0:500)
+ CHARACTER PROC*28
+ SAVE /PYDAT1/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,
+ &/PYINT6/
+ CHARACTER CHIPR*10
+
+C...Reset processes to be included.
+ IF(MSEL.NE.0) THEN
+ DO 100 I=1,500
+ MSUB(I)=0
+ 100 CONTINUE
+ ENDIF
+
+C...Set running pTmin scale.
+ IF(MSTP(82).LE.1) THEN
+ PTMRUN=PARP(81)*(VINT(1)/PARP(89))**PARP(90)
+ ELSE
+ PTMRUN=PARP(82)*(VINT(1)/PARP(89))**PARP(90)
+ ENDIF
+
+C...Begin by assuming incoming photon to enter subprocess.
+ IF(MINT(11).EQ.22) MINT(15)=22
+ IF(MINT(12).EQ.22) MINT(16)=22
+
+C...For e-gamma with MSTP(14)=10 allow mixture of VMD and anomalous.
+ IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN
+ MSUB(10)=1
+ MINT(123)=MINT(122)+1
+
+C...For gamma-p or gamma-gamma with MSTP(14) = 10, 20, 25 or 30
+C...allow mixture.
+C...Here also set a few parameters otherwise normally not touched.
+ ELSEIF(MINT(121).GT.1) THEN
+
+C...Parton distributions dampened at small Q2; go to low energies,
+C...alpha_s <1; no minimum pT cut-off a priori.
+ IF(MSTP(18).EQ.2) THEN
+ MSTP(57)=3
+ PARP(2)=2D0
+ PARU(115)=1D0
+ CKIN(5)=0.2D0
+ CKIN(6)=0.2D0
+ ENDIF
+
+C...Define pT cut-off parameters and whether run involves low-pT.
+ PTMVMD=PTMRUN
+ VINT(154)=PTMVMD
+ PTMDIR=PTMVMD
+ IF(MSTP(18).EQ.2) PTMDIR=PARP(15)
+ PTMANO=PTMVMD
+ IF(MSTP(15).EQ.5) PTMANO=0.60D0+
+ & 0.125D0*LOG(1D0+0.10D0*VINT(1))**2
+ IPTL=1
+ IF(VINT(285).GT.MAX(PTMVMD,PTMDIR,PTMANO)) IPTL=0
+ IF(MSEL.EQ.2) IPTL=1
+
+C...Set up for p/gamma * gamma; real or virtual photons.
+ IF(MINT(121).EQ.3.OR.MINT(121).EQ.6.OR.(MINT(121).EQ.4.AND.
+ & MSTP(14).EQ.30)) THEN
+
+C...Set up for p/VMD * VMD.
+ IF(MINT(122).EQ.1) THEN
+ MINT(123)=2
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ IF(IPTL.EQ.1) MSUB(95)=1
+ IF(MSEL.EQ.2) THEN
+ MSUB(91)=1
+ MSUB(92)=1
+ MSUB(93)=1
+ MSUB(94)=1
+ ENDIF
+ IF(IPTL.EQ.1) CKIN(3)=0D0
+
+C...Set up for p/VMD * direct gamma.
+ ELSEIF(MINT(122).EQ.2) THEN
+ MINT(123)=0
+ IF(MINT(121).EQ.6) MINT(123)=5
+ MSUB(131)=1
+ MSUB(132)=1
+ MSUB(135)=1
+ MSUB(136)=1
+ IF(IPTL.EQ.1) CKIN(3)=PTMDIR
+
+C...Set up for p/VMD * anomalous gamma.
+ ELSEIF(MINT(122).EQ.3) THEN
+ MINT(123)=3
+ IF(MINT(121).EQ.6) MINT(123)=7
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ IF(IPTL.EQ.1) MSUB(95)=1
+ IF(MSEL.EQ.2) THEN
+ MSUB(91)=1
+ MSUB(92)=1
+ MSUB(93)=1
+ MSUB(94)=1
+ ENDIF
+ IF(IPTL.EQ.1) CKIN(3)=0D0
+
+C...Set up for DIS * p.
+ ELSEIF(MINT(122).EQ.4.AND.(IABS(MINT(11)).GT.100.OR.
+ & IABS(MINT(12)).GT.100)) THEN
+ MINT(123)=8
+ IF(IPTL.EQ.1) MSUB(99)=1
+
+C...Set up for direct * direct gamma (switch off leptons).
+ ELSEIF(MINT(122).EQ.4) THEN
+ MINT(123)=0
+ MSUB(137)=1
+ MSUB(138)=1
+ MSUB(139)=1
+ MSUB(140)=1
+ DO 110 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1
+ IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1))
+ 110 CONTINUE
+ IF(IPTL.EQ.1) CKIN(3)=PTMDIR
+
+C...Set up for direct * anomalous gamma.
+ ELSEIF(MINT(122).EQ.5) THEN
+ MINT(123)=6
+ MSUB(131)=1
+ MSUB(132)=1
+ MSUB(135)=1
+ MSUB(136)=1
+ IF(IPTL.EQ.1) CKIN(3)=PTMANO
+
+C...Set up for anomalous * anomalous gamma.
+ ELSEIF(MINT(122).EQ.6) THEN
+ MINT(123)=3
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ IF(IPTL.EQ.1) MSUB(95)=1
+ IF(MSEL.EQ.2) THEN
+ MSUB(91)=1
+ MSUB(92)=1
+ MSUB(93)=1
+ MSUB(94)=1
+ ENDIF
+ IF(IPTL.EQ.1) CKIN(3)=0D0
+ ENDIF
+
+C...Set up for gamma* * gamma*; virtual photons = dir, VMD, anom.
+ ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN
+
+C...Set up for direct * direct gamma (switch off leptons).
+ IF(MINT(122).EQ.1) THEN
+ MINT(123)=0
+ MSUB(137)=1
+ MSUB(138)=1
+ MSUB(139)=1
+ MSUB(140)=1
+ DO 120 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1
+ IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1))
+ 120 CONTINUE
+ IF(IPTL.EQ.1) CKIN(3)=PTMDIR
+
+C...Set up for direct * VMD and VMD * direct gamma.
+ ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.4) THEN
+ MINT(123)=5
+ MSUB(131)=1
+ MSUB(132)=1
+ MSUB(135)=1
+ MSUB(136)=1
+ IF(IPTL.EQ.1) CKIN(3)=PTMDIR
+
+C...Set up for direct * anomalous and anomalous * direct gamma.
+ ELSEIF(MINT(122).EQ.3.OR.MINT(122).EQ.7) THEN
+ MINT(123)=6
+ MSUB(131)=1
+ MSUB(132)=1
+ MSUB(135)=1
+ MSUB(136)=1
+ IF(IPTL.EQ.1) CKIN(3)=PTMANO
+
+C...Set up for VMD*VMD.
+ ELSEIF(MINT(122).EQ.5) THEN
+ MINT(123)=2
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ IF(IPTL.EQ.1) MSUB(95)=1
+ IF(MSEL.EQ.2) THEN
+ MSUB(91)=1
+ MSUB(92)=1
+ MSUB(93)=1
+ MSUB(94)=1
+ ENDIF
+ IF(IPTL.EQ.1) CKIN(3)=0D0
+
+C...Set up for VMD * anomalous and anomalous * VMD gamma.
+ ELSEIF(MINT(122).EQ.6.OR.MINT(122).EQ.8) THEN
+ MINT(123)=7
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ IF(IPTL.EQ.1) MSUB(95)=1
+ IF(MSEL.EQ.2) THEN
+ MSUB(91)=1
+ MSUB(92)=1
+ MSUB(93)=1
+ MSUB(94)=1
+ ENDIF
+ IF(IPTL.EQ.1) CKIN(3)=0D0
+
+C...Set up for anomalous * anomalous gamma.
+ ELSEIF(MINT(122).EQ.9) THEN
+ MINT(123)=3
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ IF(IPTL.EQ.1) MSUB(95)=1
+ IF(MSEL.EQ.2) THEN
+ MSUB(91)=1
+ MSUB(92)=1
+ MSUB(93)=1
+ MSUB(94)=1
+ ENDIF
+ IF(IPTL.EQ.1) CKIN(3)=0D0
+
+C...Set up for DIS * VMD and VMD * DIS gamma.
+ ELSEIF(MINT(122).EQ.10.OR.MINT(122).EQ.12) THEN
+ MINT(123)=8
+ IF(IPTL.EQ.1) MSUB(99)=1
+
+C...Set up for DIS * anomalous and anomalous * DIS gamma.
+ ELSEIF(MINT(122).EQ.11.OR.MINT(122).EQ.13) THEN
+ MINT(123)=9
+ IF(IPTL.EQ.1) MSUB(99)=1
+ ENDIF
+
+C...Set up for gamma* * p; virtual photons = dir, res.
+ ELSEIF(MINT(121).EQ.2) THEN
+
+C...Set up for direct * p.
+ IF(MINT(122).EQ.1) THEN
+ MINT(123)=0
+ MSUB(131)=1
+ MSUB(132)=1
+ MSUB(135)=1
+ MSUB(136)=1
+ IF(IPTL.EQ.1) CKIN(3)=PTMDIR
+
+C...Set up for resolved * p.
+ ELSEIF(MINT(122).EQ.2) THEN
+ MINT(123)=1
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ IF(IPTL.EQ.1) MSUB(95)=1
+ IF(MSEL.EQ.2) THEN
+ MSUB(91)=1
+ MSUB(92)=1
+ MSUB(93)=1
+ MSUB(94)=1
+ ENDIF
+ IF(IPTL.EQ.1) CKIN(3)=0D0
+ ENDIF
+
+C...Set up for gamma* * gamma*; virtual photons = dir, res.
+ ELSEIF(MINT(121).EQ.4) THEN
+
+C...Set up for direct * direct gamma (switch off leptons).
+ IF(MINT(122).EQ.1) THEN
+ MINT(123)=0
+ MSUB(137)=1
+ MSUB(138)=1
+ MSUB(139)=1
+ MSUB(140)=1
+ DO 130 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1
+ IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1))
+ 130 CONTINUE
+ IF(IPTL.EQ.1) CKIN(3)=PTMDIR
+
+C...Set up for direct * resolved and resolved * direct gamma.
+ ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.3) THEN
+ MINT(123)=5
+ MSUB(131)=1
+ MSUB(132)=1
+ MSUB(135)=1
+ MSUB(136)=1
+ IF(IPTL.EQ.1) CKIN(3)=PTMDIR
+
+C...Set up for resolved * resolved gamma.
+ ELSEIF(MINT(122).EQ.4) THEN
+ MINT(123)=2
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ IF(IPTL.EQ.1) MSUB(95)=1
+ IF(MSEL.EQ.2) THEN
+ MSUB(91)=1
+ MSUB(92)=1
+ MSUB(93)=1
+ MSUB(94)=1
+ ENDIF
+ IF(IPTL.EQ.1) CKIN(3)=0D0
+ ENDIF
+
+C...End of special set up for gamma-p and gamma-gamma.
+ ENDIF
+ CKIN(1)=2D0*CKIN(3)
+ ENDIF
+
+C...Flavour information for individual beams.
+ DO 140 I=1,2
+ MINT(40+I)=1
+ IF(MINT(123).GE.1.AND.MINT(10+I).EQ.22) MINT(40+I)=2
+ IF(IABS(MINT(10+I)).GT.100) MINT(40+I)=2
+ MINT(44+I)=MINT(40+I)
+ IF(MSTP(11).GE.1.AND.(IABS(MINT(10+I)).EQ.11.OR.
+ & IABS(MINT(10+I)).EQ.13.OR.IABS(MINT(10+I)).EQ.15)) MINT(44+I)=3
+ 140 CONTINUE
+
+C...If two real gammas, whereof one direct, pick the first.
+C...For two virtual photons, keep requested order.
+ IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN
+ IF(MSTP(14).LE.10.AND.MINT(123).GE.4.AND.MINT(123).LE.6) THEN
+ MINT(41)=1
+ MINT(45)=1
+ ELSEIF(MSTP(14).EQ.12.OR.MSTP(14).EQ.13.OR.MSTP(14).EQ.22.OR.
+ & MSTP(14).EQ.26.OR.MSTP(14).EQ.27) THEN
+ MINT(41)=1
+ MINT(45)=1
+ ELSEIF(MSTP(14).EQ.14.OR.MSTP(14).EQ.17.OR.MSTP(14).EQ.23.OR.
+ & MSTP(14).EQ.28.OR.MSTP(14).EQ.29) THEN
+ MINT(42)=1
+ MINT(46)=1
+ ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.2
+ & .OR.MINT(122).EQ.3.OR.MINT(122).EQ.10.OR.MINT(122).EQ.11)) THEN
+ MINT(41)=1
+ MINT(45)=1
+ ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.4
+ & .OR.MINT(122).EQ.7.OR.MINT(122).EQ.12.OR.MINT(122).EQ.13)) THEN
+ MINT(42)=1
+ MINT(46)=1
+ ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.2) THEN
+ MINT(41)=1
+ MINT(45)=1
+ ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.3) THEN
+ MINT(42)=1
+ MINT(46)=1
+ ENDIF
+ ELSEIF(MINT(11).EQ.22.OR.MINT(12).EQ.22) THEN
+ IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28.OR.MINT(122).EQ.4) THEN
+ IF(MINT(11).EQ.22) THEN
+ MINT(41)=1
+ MINT(45)=1
+ ELSE
+ MINT(42)=1
+ MINT(46)=1
+ ENDIF
+ ENDIF
+ IF(MINT(123).GE.4.AND.MINT(123).LE.7) CALL PYERRM(26,
+ & '(PYINPR:) unallowed MSTP(14) code for single photon')
+ ENDIF
+
+C...Flavour information on combination of incoming particles.
+ MINT(43)=2*MINT(41)+MINT(42)-2
+ MINT(44)=MINT(43)
+ IF(MINT(123).LE.0) THEN
+ IF(MINT(11).EQ.22) MINT(43)=MINT(43)+2
+ IF(MINT(12).EQ.22) MINT(43)=MINT(43)+1
+ ELSEIF(MINT(123).LE.3) THEN
+ IF(MINT(11).EQ.22) MINT(44)=MINT(44)-2
+ IF(MINT(12).EQ.22) MINT(44)=MINT(44)-1
+ ELSEIF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN
+ MINT(43)=4
+ MINT(44)=1
+ ENDIF
+ MINT(47)=2*MIN(2,MINT(45))+MIN(2,MINT(46))-2
+ IF(MIN(MINT(45),MINT(46)).EQ.3) MINT(47)=5
+ IF(MINT(45).EQ.1.AND.MINT(46).EQ.3) MINT(47)=6
+ IF(MINT(45).EQ.3.AND.MINT(46).EQ.1) MINT(47)=7
+ MINT(50)=0
+ IF(MINT(41).EQ.2.AND.MINT(42).EQ.2.AND.MINT(111).NE.12) MINT(50)=1
+ MINT(107)=0
+ MINT(108)=0
+ IF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN
+ IF((MINT(122).GE.4.AND.MINT(122).LE.6).OR.MINT(122).EQ.12)
+ & MINT(107)=2
+ IF((MINT(122).GE.7.AND.MINT(122).LE.9).OR.MINT(122).EQ.13)
+ & MINT(107)=3
+ IF(MINT(122).EQ.10.OR.MINT(122).EQ.11) MINT(107)=4
+ IF(MINT(122).EQ.2.OR.MINT(122).EQ.5.OR.MINT(122).EQ.8.OR.
+ & MINT(122).EQ.10) MINT(108)=2
+ IF(MINT(122).EQ.3.OR.MINT(122).EQ.6.OR.MINT(122).EQ.9.OR.
+ & MINT(122).EQ.11) MINT(108)=3
+ IF(MINT(122).EQ.12.OR.MINT(122).EQ.13) MINT(108)=4
+ ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.25) THEN
+ IF(MINT(122).GE.3) MINT(107)=1
+ IF(MINT(122).EQ.2.OR.MINT(122).EQ.4) MINT(108)=1
+ ELSEIF(MINT(121).EQ.2) THEN
+ IF(MINT(122).EQ.2.AND.MINT(11).EQ.22) MINT(107)=1
+ IF(MINT(122).EQ.2.AND.MINT(12).EQ.22) MINT(108)=1
+ ELSE
+ IF(MINT(11).EQ.22) THEN
+ MINT(107)=MINT(123)
+ IF(MINT(123).GE.4) MINT(107)=0
+ IF(MINT(123).EQ.7) MINT(107)=2
+ IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.27) MINT(107)=4
+ IF(MSTP(14).EQ.28) MINT(107)=2
+ IF(MSTP(14).EQ.29) MINT(107)=3
+ IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4)
+ & MINT(107)=4
+ ENDIF
+ IF(MINT(12).EQ.22) THEN
+ MINT(108)=MINT(123)
+ IF(MINT(123).GE.4) MINT(108)=MINT(123)-3
+ IF(MINT(123).EQ.7) MINT(108)=3
+ IF(MSTP(14).EQ.26) MINT(108)=2
+ IF(MSTP(14).EQ.27) MINT(108)=3
+ IF(MSTP(14).EQ.28.OR.MSTP(14).EQ.29) MINT(108)=4
+ IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4)
+ & MINT(108)=4
+ ENDIF
+ IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.(MSTP(14).EQ.14.OR.
+ & MSTP(14).EQ.17.OR.MSTP(14).EQ.18.OR.MSTP(14).EQ.23)) THEN
+ MINTTP=MINT(107)
+ MINT(107)=MINT(108)
+ MINT(108)=MINTTP
+ ENDIF
+ ENDIF
+ IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0
+ IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0
+
+C...Select default processes according to incoming beams
+C...(already done for gamma-p and gamma-gamma with
+C...MSTP(14) = 10, 20, 25 or 30).
+ IF(MINT(121).GT.1) THEN
+ ELSEIF(MSEL.EQ.1.OR.MSEL.EQ.2) THEN
+
+ IF(MINT(43).EQ.1) THEN
+C...Lepton + lepton -> gamma/Z0 or W.
+ IF(MINT(11)+MINT(12).EQ.0) MSUB(1)=1
+ IF(MINT(11)+MINT(12).NE.0) MSUB(2)=1
+
+ ELSEIF(MINT(43).LE.3.AND.MINT(123).EQ.0.AND.
+ & (MINT(11).EQ.22.OR.MINT(12).EQ.22)) THEN
+C...Unresolved photon + lepton: Compton scattering.
+ MSUB(133)=1
+ MSUB(134)=1
+
+ ELSEIF((MINT(123).EQ.8.OR.MINT(123).EQ.9).AND.(MINT(11).EQ.22
+ & .OR.MINT(12).EQ.22)) THEN
+C...DIS as pure gamma* + f -> f process.
+ MSUB(99)=1
+
+ ELSEIF(MINT(43).LE.3) THEN
+C...Lepton + hadron: deep inelastic scattering.
+ MSUB(10)=1
+
+ ELSEIF(MINT(123).EQ.0.AND.MINT(11).EQ.22.AND.
+ & MINT(12).EQ.22) THEN
+C...Two unresolved photons: fermion pair production,
+C...exclude lepton pairs.
+ DO 150 ISUB=137,140
+ MSUB(ISUB)=1
+ 150 CONTINUE
+ DO 160 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1
+ IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1))
+ 160 CONTINUE
+ PTMDIR=PTMRUN
+ IF(MSTP(18).EQ.2) PTMDIR=PARP(15)
+ IF(CKIN(3).LT.PTMRUN.OR.MSEL.EQ.2) CKIN(3)=PTMDIR
+ CKIN(1)=MAX(CKIN(1),2D0*CKIN(3))
+
+ ELSEIF((MINT(123).EQ.0.AND.(MINT(11).EQ.22.OR.MINT(12).EQ.22))
+ & .OR.(MINT(123).GE.4.AND.MINT(123).LE.6.AND.MINT(11).EQ.22.AND.
+ & MINT(12).EQ.22)) THEN
+C...Unresolved photon + hadron: photon-parton scattering.
+ DO 170 ISUB=131,136
+ MSUB(ISUB)=1
+ 170 CONTINUE
+
+ ELSEIF(MSEL.EQ.1) THEN
+C...High-pT QCD processes:
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ PTMN=PTMRUN
+ VINT(154)=PTMN
+ IF(CKIN(3).LT.PTMN) MSUB(95)=1
+ IF(MSUB(95).EQ.1.AND.MINT(50).EQ.0) MSUB(95)=0
+
+ ELSE
+C...All QCD processes:
+ MSUB(11)=1
+ MSUB(12)=1
+ MSUB(13)=1
+ MSUB(28)=1
+ MSUB(53)=1
+ MSUB(68)=1
+ MSUB(91)=1
+ MSUB(92)=1
+ MSUB(93)=1
+ MSUB(94)=1
+ MSUB(95)=1
+ ENDIF
+
+ ELSEIF(MSEL.GE.4.AND.MSEL.LE.8) THEN
+C...Heavy quark production.
+ MSUB(81)=1
+ MSUB(82)=1
+ MSUB(84)=1
+ DO 180 J=1,MIN(8,MDCY(21,3))
+ MDME(MDCY(21,2)+J-1,1)=0
+ 180 CONTINUE
+ MDME(MDCY(21,2)+MSEL-1,1)=1
+ MSUB(85)=1
+ DO 190 J=1,MIN(12,MDCY(22,3))
+ MDME(MDCY(22,2)+J-1,1)=0
+ 190 CONTINUE
+ MDME(MDCY(22,2)+MSEL-1,1)=1
+
+ ELSEIF(MSEL.EQ.10) THEN
+C...Prompt photon production:
+ MSUB(14)=1
+ MSUB(18)=1
+ MSUB(29)=1
+
+ ELSEIF(MSEL.EQ.11) THEN
+C...Z0/gamma* production:
+ MSUB(1)=1
+
+ ELSEIF(MSEL.EQ.12) THEN
+C...W+/- production:
+ MSUB(2)=1
+
+ ELSEIF(MSEL.EQ.13) THEN
+C...Z0 + jet:
+ MSUB(15)=1
+ MSUB(30)=1
+
+ ELSEIF(MSEL.EQ.14) THEN
+C...W+/- + jet:
+ MSUB(16)=1
+ MSUB(31)=1
+
+ ELSEIF(MSEL.EQ.15) THEN
+C...Z0 & W+/- pair production:
+ MSUB(19)=1
+ MSUB(20)=1
+ MSUB(22)=1
+ MSUB(23)=1
+ MSUB(25)=1
+
+ ELSEIF(MSEL.EQ.16) THEN
+C...h0 production:
+ MSUB(3)=1
+ MSUB(102)=1
+ MSUB(103)=1
+ MSUB(123)=1
+ MSUB(124)=1
+
+ ELSEIF(MSEL.EQ.17) THEN
+C...h0 & Z0 or W+/- pair production:
+ MSUB(24)=1
+ MSUB(26)=1
+
+ ELSEIF(MSEL.EQ.18) THEN
+C...h0 production; interesting processes in e+e-.
+ MSUB(24)=1
+ MSUB(103)=1
+ MSUB(123)=1
+ MSUB(124)=1
+
+ ELSEIF(MSEL.EQ.19) THEN
+C...h0, H0 and A0 production; interesting processes in e+e-.
+ MSUB(24)=1
+ MSUB(103)=1
+ MSUB(123)=1
+ MSUB(124)=1
+ MSUB(153)=1
+ MSUB(171)=1
+ MSUB(173)=1
+ MSUB(174)=1
+ MSUB(158)=1
+ MSUB(176)=1
+ MSUB(178)=1
+ MSUB(179)=1
+
+ ELSEIF(MSEL.EQ.21) THEN
+C...Z'0 production:
+ MSUB(141)=1
+
+ ELSEIF(MSEL.EQ.22) THEN
+C...W'+/- production:
+ MSUB(142)=1
+
+ ELSEIF(MSEL.EQ.23) THEN
+C...H+/- production:
+ MSUB(143)=1
+
+ ELSEIF(MSEL.EQ.24) THEN
+C...R production:
+ MSUB(144)=1
+
+ ELSEIF(MSEL.EQ.25) THEN
+C...LQ (leptoquark) production.
+ MSUB(145)=1
+ MSUB(162)=1
+ MSUB(163)=1
+ MSUB(164)=1
+
+ ELSEIF(MSEL.GE.35.AND.MSEL.LE.38) THEN
+C...Production of one heavy quark (W exchange):
+ MSUB(83)=1
+ DO 200 J=1,MIN(8,MDCY(21,3))
+ MDME(MDCY(21,2)+J-1,1)=0
+ 200 CONTINUE
+ MDME(MDCY(21,2)+MSEL-31,1)=1
+
+CMRENNA++Define SUSY alternatives.
+ ELSEIF(MSEL.EQ.39) THEN
+C...Turn on all SUSY processes.
+ IF(MINT(43).EQ.4) THEN
+C...Hadron-hadron processes.
+ DO 210 I=201,301
+ IF(ISET(I).GE.0) MSUB(I)=1
+ 210 CONTINUE
+ ELSEIF(MINT(43).EQ.1) THEN
+C...Lepton-lepton processes: QED production of squarks.
+ DO 220 I=201,214
+ MSUB(I)=1
+ 220 CONTINUE
+ MSUB(210)=0
+ MSUB(211)=0
+ MSUB(212)=0
+ DO 230 I=216,228
+ MSUB(I)=1
+ 230 CONTINUE
+ DO 240 I=261,263
+ MSUB(I)=1
+ 240 CONTINUE
+ MSUB(277)=1
+ MSUB(278)=1
+ ENDIF
+
+ ELSEIF(MSEL.EQ.40) THEN
+C...Gluinos and squarks.
+ IF(MINT(43).EQ.4) THEN
+ MSUB(243)=1
+ MSUB(244)=1
+ MSUB(258)=1
+ MSUB(259)=1
+ MSUB(261)=1
+ MSUB(262)=1
+ MSUB(264)=1
+ MSUB(265)=1
+ DO 250 I=271,296
+ MSUB(I)=1
+ 250 CONTINUE
+ ELSEIF(MINT(43).EQ.1) THEN
+ MSUB(277)=1
+ MSUB(278)=1
+ ENDIF
+
+ ELSEIF(MSEL.EQ.41) THEN
+C...Stop production.
+ MSUB(261)=1
+ MSUB(262)=1
+ MSUB(263)=1
+ IF(MINT(43).EQ.4) THEN
+ MSUB(264)=1
+ MSUB(265)=1
+ ENDIF
+
+ ELSEIF(MSEL.EQ.42) THEN
+C...Slepton production.
+ DO 260 I=201,214
+ MSUB(I)=1
+ 260 CONTINUE
+ IF(MINT(43).NE.4) THEN
+ MSUB(210)=0
+ MSUB(211)=0
+ MSUB(212)=0
+ ENDIF
+
+ ELSEIF(MSEL.EQ.43) THEN
+C...Neutralino/Chargino + Gluino/Squark.
+ IF(MINT(43).EQ.4) THEN
+ DO 270 I=237,242
+ MSUB(I)=1
+ 270 CONTINUE
+ DO 280 I=246,254
+ MSUB(I)=1
+ 280 CONTINUE
+ MSUB(256)=1
+ ENDIF
+
+ ELSEIF(MSEL.EQ.44) THEN
+C...Neutralino/Chargino pair production.
+ IF(MINT(43).EQ.4) THEN
+ DO 290 I=216,236
+ MSUB(I)=1
+ 290 CONTINUE
+ ELSEIF(MINT(43).EQ.1) THEN
+ DO 300 I=216,228
+ MSUB(I)=1
+ 300 CONTINUE
+ ENDIF
+
+ ELSEIF(MSEL.EQ.45) THEN
+C...Sbottom production.
+ MSUB(287)=1
+ MSUB(288)=1
+ IF(MINT(43).EQ.4) THEN
+ DO 310 I=281,296
+ MSUB(I)=1
+ 310 CONTINUE
+ ENDIF
+
+ ELSEIF(MSEL.EQ.50) THEN
+C...Pair production of technipions and gauge bosons.
+ DO 320 I=361,368
+ MSUB(I)=1
+ 320 CONTINUE
+ IF(MINT(43).EQ.4) THEN
+ DO 330 I=370,377
+ MSUB(I)=1
+ 330 CONTINUE
+ ENDIF
+
+ ELSEIF(MSEL.EQ.51) THEN
+C...QCD 2 -> 2 processes with compositeness/technicolor modifications.
+ DO 340 I=381,386
+ MSUB(I)=1
+ 340 CONTINUE
+
+ ELSEIF(MSEL.EQ.61) THEN
+C...Charmonium production in colour octet model, with recoiling parton.
+ DO 342 I=421,439
+ MSUB(I)=1
+ 342 CONTINUE
+
+ ELSEIF(MSEL.EQ.62) THEN
+C...Bottomonium production in colour octet model, with recoiling parton.
+ DO 344 I=461,479
+ MSUB(I)=1
+ 344 CONTINUE
+
+ ELSEIF(MSEL.EQ.63) THEN
+C...Charmonium and bottomonium production in colour octet model.
+ DO 346 I=421,439
+ MSUB(I)=1
+ MSUB(I+40)=1
+ 346 CONTINUE
+ ENDIF
+
+C...Find heaviest new quark flavour allowed in processes 81-84.
+ KFLQM=1
+ DO 350 I=1,MIN(8,MDCY(21,3))
+ IDC=I+MDCY(21,2)-1
+ IF(MDME(IDC,1).LE.0) GOTO 350
+ KFLQM=I
+ 350 CONTINUE
+ IF(MSTP(7).GE.1.AND.MSTP(7).LE.8.AND.(MSEL.LE.3.OR.MSEL.GE.9))
+ &KFLQM=MSTP(7)
+ MINT(55)=KFLQM
+ KFPR(81,1)=KFLQM
+ KFPR(81,2)=KFLQM
+ KFPR(82,1)=KFLQM
+ KFPR(82,2)=KFLQM
+ KFPR(83,1)=KFLQM
+ KFPR(84,1)=KFLQM
+ KFPR(84,2)=KFLQM
+
+C...Find heaviest new fermion flavour allowed in process 85.
+ KFLFM=1
+ DO 360 I=1,MIN(12,MDCY(22,3))
+ IDC=I+MDCY(22,2)-1
+ IF(MDME(IDC,1).LE.0) GOTO 360
+ KFLFM=KFDP(IDC,1)
+ 360 CONTINUE
+ IF(((MSTP(7).GE.1.AND.MSTP(7).LE.8).OR.(MSTP(7).GE.11.AND.
+ &MSTP(7).LE.18)).AND.(MSEL.LE.3.OR.MSEL.GE.9)) KFLFM=MSTP(7)
+ MINT(56)=KFLFM
+ KFPR(85,1)=KFLFM
+ KFPR(85,2)=KFLFM
+
+C...Import relevant information on external user processes.
+ IF(MINT(111).GE.11) THEN
+ IPYPR=0
+ DO 390 IUP=1,NPRUP
+C...Find next empty PYTHIA process number slot and enable it.
+ 370 IPYPR=IPYPR+1
+ IF(IPYPR.GT.500) CALL PYERRM(26,
+ & '(PYINPR.) no more empty slots for user processes')
+ IF(ISET(IPYPR).GE.0.AND.ISET(IPYPR).LE.9) GOTO 370
+ IF(IPYPR.GE.91.AND.IPYPR.LE.100) GOTO 370
+ ISET(IPYPR)=11
+C...Overwrite KFPR with references back to process number and ID.
+ KFPR(IPYPR,1)=IUP
+ KFPR(IPYPR,2)=LPRUP(IUP)
+C...Process title.
+ WRITE(CHIPR,'(I10)') LPRUP(IUP)
+ ICHIN=1
+ DO 380 ICH=1,9
+ IF(CHIPR(ICH:ICH).EQ.' ') ICHIN=ICH+1
+ 380 CONTINUE
+ PROC(IPYPR)='User process '//CHIPR(ICHIN:10)//' '
+C...Switch on process.
+ MSUB(IPYPR)=1
+ 390 CONTINUE
+ ENDIF
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYXTOT
+C...Parametrizes total, elastic and diffractive cross-sections
+C...for different energies and beams. Donnachie-Landshoff for
+C...total and Schuler-Sjostrand for elastic and diffractive.
+C...Process code IPROC:
+C...= 1 : p + p;
+C...= 2 : pbar + p;
+C...= 3 : pi+ + p;
+C...= 4 : pi- + p;
+C...= 5 : pi0 + p;
+C...= 6 : phi + p;
+C...= 7 : J/psi + p;
+C...= 11 : rho + rho;
+C...= 12 : rho + phi;
+C...= 13 : rho + J/psi;
+C...= 14 : phi + phi;
+C...= 15 : phi + J/psi;
+C...= 16 : J/psi + J/psi;
+C...= 21 : gamma + p (DL);
+C...= 22 : gamma + p (VDM).
+C...= 23 : gamma + pi (DL);
+C...= 24 : gamma + pi (VDM);
+C...= 25 : gamma + gamma (DL);
+C...= 26 : gamma + gamma (VDM).
+
+ SUBROUTINE PYXTOT
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+C...Commonblocks.
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
+ COMMON/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
+ COMMON/PYINT7/SIGT(0:6,0:6,0:5)
+ SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT5/,/PYINT7/
+C...Local arrays.
+ DIMENSION NPROC(30),XPAR(30),YPAR(30),IHADA(20),IHADB(20),
+ &PMHAD(4),BHAD(4),BETP(4),IFITSD(20),IFITDD(20),CEFFS(10,8),
+ &CEFFD(10,9),SIGTMP(6,0:5)
+
+C...Common constants.
+ DATA EPS/0.0808D0/, ETA/-0.4525D0/, ALP/0.25D0/, CRES/2D0/,
+ &PMRC/1.062D0/, SMP/0.880D0/, FACEL/0.0511D0/, FACSD/0.0336D0/,
+ &FACDD/0.0084D0/
+
+C...Number of multiple processes to be evaluated (= 0 : undefined).
+ DATA NPROC/7*1,3*0,6*1,4*0,4*3,2*6,4*0/
+C...X and Y parameters of sigmatot = X * s**epsilon + Y * s**(-eta).
+ DATA XPAR/2*21.70D0,3*13.63D0,10.01D0,0.970D0,3*0D0,
+ &8.56D0,6.29D0,0.609D0,4.62D0,0.447D0,0.0434D0,4*0D0,
+ &0.0677D0,0.0534D0,0.0425D0,0.0335D0,2.11D-4,1.31D-4,4*0D0/
+ DATA YPAR/
+ &56.08D0,98.39D0,27.56D0,36.02D0,31.79D0,-1.51D0,-0.146D0,3*0D0,
+ &13.08D0,-0.62D0,-0.060D0,0.030D0,-0.0028D0,0.00028D0,4*0D0,
+ &0.129D0,0.115D0,0.081D0,0.072D0,2.15D-4,1.70D-4,4*0D0/
+
+C...Beam and target hadron class:
+C...= 1 : p/n ; = 2 : pi/rho/omega; = 3 : phi; = 4 : J/psi.
+ DATA IHADA/2*1,3*2,3,4,3*0,3*2,2*3,4,4*0/
+ DATA IHADB/7*1,3*0,2,3,4,3,2*4,4*0/
+C...Characteristic class masses, slope parameters, beta = sqrt(X).
+ DATA PMHAD/0.938D0,0.770D0,1.020D0,3.097D0/
+ DATA BHAD/2.3D0,1.4D0,1.4D0,0.23D0/
+ DATA BETP/4.658D0,2.926D0,2.149D0,0.208D0/
+
+C...Fitting constants used in parametrizations of diffractive results.
+ DATA IFITSD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/
+ DATA IFITDD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/
+ DATA ((CEFFS(J1,J2),J2=1,8),J1=1,10)/
+ &0.213D0, 0.0D0, -0.47D0, 150D0, 0.213D0, 0.0D0, -0.47D0, 150D0,
+ &0.213D0, 0.0D0, -0.47D0, 150D0, 0.267D0, 0.0D0, -0.47D0, 100D0,
+ &0.213D0, 0.0D0, -0.47D0, 150D0, 0.232D0, 0.0D0, -0.47D0, 110D0,
+ &0.213D0, 7.0D0, -0.55D0, 800D0, 0.115D0, 0.0D0, -0.47D0, 110D0,
+ &0.267D0, 0.0D0, -0.46D0, 75D0, 0.267D0, 0.0D0, -0.46D0, 75D0,
+ &0.232D0, 0.0D0, -0.46D0, 85D0, 0.267D0, 0.0D0, -0.48D0, 100D0,
+ &0.115D0, 0.0D0, -0.50D0, 90D0, 0.267D0, 6.0D0, -0.56D0, 420D0,
+ &0.232D0, 0.0D0, -0.48D0, 110D0, 0.232D0, 0.0D0, -0.48D0, 110D0,
+ &0.115D0, 0.0D0, -0.52D0, 120D0, 0.232D0, 6.0D0, -0.56D0, 470D0,
+ &0.115D0, 5.5D0, -0.58D0, 570D0, 0.115D0, 5.5D0, -0.58D0, 570D0/
+ DATA ((CEFFD(J1,J2),J2=1,9),J1=1,10)/
+ &3.11D0, -7.34D0, 9.71D0, 0.068D0, -0.42D0, 1.31D0,
+ &-1.37D0, 35.0D0, 118D0, 3.11D0, -7.10D0, 10.6D0,
+ &0.073D0, -0.41D0, 1.17D0, -1.41D0, 31.6D0, 95D0,
+ &3.12D0, -7.43D0, 9.21D0, 0.067D0, -0.44D0, 1.41D0,
+ &-1.35D0, 36.5D0, 132D0, 3.13D0, -8.18D0, -4.20D0,
+ &0.056D0, -0.71D0, 3.12D0, -1.12D0, 55.2D0, 1298D0,
+ &3.11D0, -6.90D0, 11.4D0, 0.078D0, -0.40D0, 1.05D0,
+ &-1.40D0, 28.4D0, 78D0, 3.11D0, -7.13D0, 10.0D0,
+ &0.071D0, -0.41D0, 1.23D0, -1.34D0, 33.1D0, 105D0,
+ &3.12D0, -7.90D0, -1.49D0, 0.054D0, -0.64D0, 2.72D0,
+ &-1.13D0, 53.1D0, 995D0, 3.11D0, -7.39D0, 8.22D0,
+ &0.065D0, -0.44D0, 1.45D0, -1.36D0, 38.1D0, 148D0,
+ &3.18D0, -8.95D0, -3.37D0, 0.057D0, -0.76D0, 3.32D0,
+ &-1.12D0, 55.6D0, 1472D0, 4.18D0, -29.2D0, 56.2D0,
+ &0.074D0, -1.36D0, 6.67D0, -1.14D0, 116.2D0, 6532D0/
+
+C...Parameters. Combinations of the energy.
+ AEM=PARU(101)
+ PMTH=PARP(102)
+ S=VINT(2)
+ SRT=VINT(1)
+ SEPS=S**EPS
+ SETA=S**ETA
+ SLOG=LOG(S)
+
+C...Ratio of gamma/pi (for rescaling in parton distributions).
+ VINT(281)=(XPAR(22)*SEPS+YPAR(22)*SETA)/
+ &(XPAR(5)*SEPS+YPAR(5)*SETA)
+ VINT(317)=1D0
+ IF(MINT(50).NE.1) RETURN
+
+C...Order flavours of incoming particles: KF1 < KF2.
+ IF(IABS(MINT(11)).LE.IABS(MINT(12))) THEN
+ KF1=IABS(MINT(11))
+ KF2=IABS(MINT(12))
+ IORD=1
+ ELSE
+ KF1=IABS(MINT(12))
+ KF2=IABS(MINT(11))
+ IORD=2
+ ENDIF
+ ISGN12=ISIGN(1,MINT(11)*MINT(12))
+
+C...Find process number (for lookup tables).
+ IF(KF1.GT.1000) THEN
+ IPROC=1
+ IF(ISGN12.LT.0) IPROC=2
+ ELSEIF(KF1.GT.100.AND.KF2.GT.1000) THEN
+ IPROC=3
+ IF(ISGN12.LT.0) IPROC=4
+ IF(KF1.EQ.111) IPROC=5
+ ELSEIF(KF1.GT.100) THEN
+ IPROC=11
+ ELSEIF(KF2.GT.1000) THEN
+ IPROC=21
+ IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=22
+ ELSEIF(KF2.GT.100) THEN
+ IPROC=23
+ IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=24
+ ELSE
+ IPROC=25
+ IF(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7) IPROC=26
+ ENDIF
+
+C... Number of multiple processes to be stored; beam/target side.
+ NPR=NPROC(IPROC)
+ MINT(101)=1
+ MINT(102)=1
+ IF(NPR.EQ.3) THEN
+ MINT(100+IORD)=4
+ ELSEIF(NPR.EQ.6) THEN
+ MINT(101)=4
+ MINT(102)=4
+ ENDIF
+ N1=0
+ IF(MINT(101).EQ.4) N1=4
+ N2=0
+ IF(MINT(102).EQ.4) N2=4
+
+C...Do not do any more for user-set or undefined cross-sections.
+ IF(MSTP(31).LE.0) RETURN
+ IF(NPR.EQ.0) CALL PYERRM(26,
+ &'(PYXTOT:) cross section for this process not yet implemented')
+
+C...Parameters. Combinations of the energy.
+ AEM=PARU(101)
+ PMTH=PARP(102)
+ S=VINT(2)
+ SRT=VINT(1)
+ SEPS=S**EPS
+ SETA=S**ETA
+ SLOG=LOG(S)
+
+C...Loop over multiple processes (for VDM).
+ DO 110 I=1,NPR
+ IF(NPR.EQ.1) THEN
+ IPR=IPROC
+ ELSEIF(NPR.EQ.3) THEN
+ IPR=I+4
+ IF(KF2.LT.1000) IPR=I+10
+ ELSEIF(NPR.EQ.6) THEN
+ IPR=I+10
+ ENDIF
+
+C...Evaluate hadron species, mass, slope contribution and fit number.
+ IHA=IHADA(IPR)
+ IHB=IHADB(IPR)
+ PMA=PMHAD(IHA)
+ PMB=PMHAD(IHB)
+ BHA=BHAD(IHA)
+ BHB=BHAD(IHB)
+ ISD=IFITSD(IPR)
+ IDD=IFITDD(IPR)
+
+C...Skip if energy too low relative to masses.
+ DO 100 J=0,5
+ SIGTMP(I,J)=0D0
+ 100 CONTINUE
+ IF(SRT.LT.PMA+PMB+PARP(104)) GOTO 110
+
+C...Total cross-section. Elastic slope parameter and cross-section.
+ SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA
+ BEL=2D0*BHA+2D0*BHB+4D0*SEPS-4.2D0
+ SIGTMP(I,1)=FACEL*SIGTMP(I,0)**2/BEL
+
+C...Diffractive scattering A + B -> X + B.
+ BSD=2D0*BHB
+ SQML=(PMA+PMTH)**2
+ SQMU=S*CEFFS(ISD,1)+CEFFS(ISD,2)
+ SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/
+ & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP)
+ BXB=CEFFS(ISD,3)+CEFFS(ISD,4)/S
+ SUM2=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)/
+ & (BSD+2D0*ALP*LOG(S/((PMA+PMTH)*(PMA+PMRC)))+BXB)
+ SIGTMP(I,2)=FACSD*XPAR(IPR)*BETP(IHB)*MAX(0D0,SUM1+SUM2)
+
+C...Diffractive scattering A + B -> A + X.
+ BSD=2D0*BHA
+ SQML=(PMB+PMTH)**2
+ SQMU=S*CEFFS(ISD,5)+CEFFS(ISD,6)
+ SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/
+ & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP)
+ BAX=CEFFS(ISD,7)+CEFFS(ISD,8)/S
+ SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/
+ & (BSD+2D0*ALP*LOG(S/((PMB+PMTH)*(PMB+PMRC)))+BAX)
+ SIGTMP(I,3)=FACSD*XPAR(IPR)*BETP(IHA)*MAX(0D0,SUM1+SUM2)
+
+C...Order single diffractive correctly.
+ IF(IORD.EQ.2) THEN
+ SIGSAV=SIGTMP(I,2)
+ SIGTMP(I,2)=SIGTMP(I,3)
+ SIGTMP(I,3)=SIGSAV
+ ENDIF
+
+C...Double diffractive scattering A + B -> X1 + X2.
+ YEFF=LOG(S*SMP/((PMA+PMTH)*(PMB+PMTH))**2)
+ DEFF=CEFFD(IDD,1)+CEFFD(IDD,2)/SLOG+CEFFD(IDD,3)/SLOG**2
+ SUM1=(DEFF+YEFF*(LOG(MAX(1D-10,YEFF/DEFF))-1D0))/(2D0*ALP)
+ IF(YEFF.LE.0) SUM1=0D0
+ SQMU=S*(CEFFD(IDD,4)+CEFFD(IDD,5)/SLOG+CEFFD(IDD,6)/SLOG**2)
+ SLUP=LOG(MAX(1.1D0,S/(ALP*(PMA+PMTH)**2*(PMB+PMTH)*(PMB+PMRC))))
+ SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMB+PMTH)*(PMB+PMRC))))
+ SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)*LOG(SLUP/SLDN)/
+ & (2D0*ALP)
+ SLUP=LOG(MAX(1.1D0,S/(ALP*(PMB+PMTH)**2*(PMA+PMTH)*(PMA+PMRC))))
+ SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMA+PMTH)*(PMA+PMRC))))
+ SUM3=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*LOG(SLUP/SLDN)/
+ & (2D0*ALP)
+ BXX=CEFFD(IDD,7)+CEFFD(IDD,8)/SRT+CEFFD(IDD,9)/S
+ SLRR=LOG(S/(ALP*(PMA+PMTH)*(PMA+PMRC)*(PMB+PMTH)*(PMB+PMRC)))
+ SUM4=CRES**2*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*
+ & LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/MAX(0.1D0,2D0*ALP*SLRR+BXX)
+ SIGTMP(I,4)=FACDD*XPAR(IPR)*MAX(0D0,SUM1+SUM2+SUM3+SUM4)
+
+C...Non-diffractive by unitarity.
+ SIGTMP(I,5)=SIGTMP(I,0)-SIGTMP(I,1)-SIGTMP(I,2)-SIGTMP(I,3)-
+ & SIGTMP(I,4)
+ 110 CONTINUE
+
+C...Put temporary results in output array: only one process.
+ IF(MINT(101).EQ.1.AND.MINT(102).EQ.1) THEN
+ DO 120 J=0,5
+ SIGT(0,0,J)=SIGTMP(1,J)
+ 120 CONTINUE
+
+C...Beam multiple processes.
+ ELSEIF(MINT(101).EQ.4.AND.MINT(102).EQ.1) THEN
+ IF(MINT(107).EQ.2) THEN
+ VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2
+ ELSE
+ VINT(317)=16D0*PARP(15)**2*VINT(154)**2/
+ & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307)))
+ ENDIF
+ IF(MSTP(20).GT.0) THEN
+ VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)))**MSTP(20)
+ ENDIF
+ DO 140 I=1,4
+ IF(MINT(107).EQ.2) THEN
+ CONV=(AEM/PARP(160+I))*VINT(317)
+ ELSEIF(VINT(154).GT.PARP(15)) THEN
+ CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2*
+ & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317)
+ ELSE
+ CONV=0D0
+ ENDIF
+ I1=MAX(1,I-1)
+ DO 130 J=0,5
+ SIGT(I,0,J)=CONV*SIGTMP(I1,J)
+ 130 CONTINUE
+ 140 CONTINUE
+ DO 150 J=0,5
+ SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J)
+ 150 CONTINUE
+
+C...Target multiple processes.
+ ELSEIF(MINT(101).EQ.1.AND.MINT(102).EQ.4) THEN
+ IF(MINT(108).EQ.2) THEN
+ VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2
+ ELSE
+ VINT(317)=16D0*PARP(15)**2*VINT(154)**2/
+ & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308)))
+ ENDIF
+ IF(MSTP(20).GT.0) THEN
+ VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(308)))**MSTP(20)
+ ENDIF
+ DO 170 I=1,4
+ IF(MINT(108).EQ.2) THEN
+ CONV=(AEM/PARP(160+I))*VINT(317)
+ ELSEIF(VINT(154).GT.PARP(15)) THEN
+ CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2*
+ & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317)
+ ELSE
+ CONV=0D0
+ ENDIF
+ IV=MAX(1,I-1)
+ DO 160 J=0,5
+ SIGT(0,I,J)=CONV*SIGTMP(IV,J)
+ 160 CONTINUE
+ 170 CONTINUE
+ DO 180 J=0,5
+ SIGT(0,0,J)=SIGT(0,1,J)+SIGT(0,2,J)+SIGT(0,3,J)+SIGT(0,4,J)
+ 180 CONTINUE
+
+C...Both beam and target multiple processes.
+ ELSE
+ IF(MINT(107).EQ.2) THEN
+ VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2
+ ELSE
+ VINT(317)=16D0*PARP(15)**2*VINT(154)**2/
+ & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307)))
+ ENDIF
+ IF(MINT(108).EQ.2) THEN
+ VINT(317)=VINT(317)*(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2
+ ELSE
+ VINT(317)=VINT(317)*16D0*PARP(15)**2*VINT(154)**2/
+ & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308)))
+ ENDIF
+ IF(MSTP(20).GT.0) THEN
+ VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)+
+ & VINT(308)))**MSTP(20)
+ ENDIF
+ DO 210 I1=1,4
+ DO 200 I2=1,4
+ IF(MINT(107).EQ.2) THEN
+ CONV=(AEM/PARP(160+I1))*VINT(317)
+ ELSEIF(VINT(154).GT.PARP(15)) THEN
+ CONV=(AEM/PARU(1))*(KCHG(I1,1)/3D0)**2*PARP(18)**2*
+ & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317)
+ ELSE
+ CONV=0D0
+ ENDIF
+ IF(MINT(108).EQ.2) THEN
+ CONV=CONV*(AEM/PARP(160+I2))
+ ELSEIF(VINT(154).GT.PARP(15)) THEN
+ CONV=CONV*(AEM/PARU(1))*(KCHG(I2,1)/3D0)**2*PARP(18)**2*
+ & (1D0/PARP(15)**2-1D0/VINT(154)**2)
+ ELSE
+ CONV=0D0
+ ENDIF
+ IF(I1.LE.2) THEN
+ IV=MAX(1,I2-1)
+ ELSEIF(I2.LE.2) THEN
+ IV=MAX(1,I1-1)
+ ELSEIF(I1.EQ.I2) THEN
+ IV=2*I1-2
+ ELSE
+ IV=5
+ ENDIF
+ DO 190 J=0,5
+ JV=J
+ IF(I2.GT.I1.AND.(J.EQ.2.OR.J.EQ.3)) JV=5-J
+ SIGT(I1,I2,J)=CONV*SIGTMP(IV,JV)
+ 190 CONTINUE
+ 200 CONTINUE
+ 210 CONTINUE
+ DO 230 J=0,5
+ DO 220 I=1,4
+ SIGT(I,0,J)=SIGT(I,1,J)+SIGT(I,2,J)+SIGT(I,3,J)+SIGT(I,4,J)
+ SIGT(0,I,J)=SIGT(1,I,J)+SIGT(2,I,J)+SIGT(3,I,J)+SIGT(4,I,J)
+ 220 CONTINUE
+ SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J)
+ 230 CONTINUE
+ ENDIF
+
+C...Scale up uniformly for Donnachie-Landshoff parametrization.
+ IF(IPROC.EQ.21.OR.IPROC.EQ.23.OR.IPROC.EQ.25) THEN
+ RFAC=(XPAR(IPROC)*SEPS+YPAR(IPROC)*SETA)/SIGT(0,0,0)
+ DO 260 I1=0,N1
+ DO 250 I2=0,N2
+ DO 240 J=0,5
+ SIGT(I1,I2,J)=RFAC*SIGT(I1,I2,J)
+ 240 CONTINUE
+ 250 CONTINUE
+ 260 CONTINUE
+ ENDIF
+
+ RETURN
+ END
+
+C*********************************************************************
+
+C...PYMAXI
+C...Finds optimal set of coefficients for kinematical variable selection
+C...and the maximum of the part of the differential cross-section used
+C...in the event weighting.
+
+ SUBROUTINE PYMAXI
+
+C...Double precision and integer declarations.
+ IMPLICIT DOUBLE PRECISION(A-H, O-Z)
+ IMPLICIT INTEGER(I-N)
+ INTEGER PYK,PYCHGE,PYCOMP
+C...Parameter statement to help give large particle numbers.
+ PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
+ &KEXCIT=4000000,KDIMEN=5000000)
+
+C...User process initialization commonblock.
+ INTEGER MAXPUP
+ PARAMETER (MAXPUP=100)
+ INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
+ DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
+ COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
+ &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP),
+ &LPRUP(MAXPUP)
+ SAVE /HEPRUP/
+
+C...Commonblocks.
+ COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
+ COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
+ COMMON/PYDAT3/MDCY(500,3),MDME(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/PYINT1/MINT(400),VINT(400)
+ COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2)
+ COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
+ COMMON/PYINT4/MWID(500),WIDS(500,5)
+ COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3)
+ COMMON/PYINT6/PROC(0:500)
+ CHARACTER PROC*28
+ COMMON/PYINT7/SIGT(0:6,0:6,0:5)
+ COMMON/PYTCSM/ITCM(0:99),RTCM(0:99)
+ COMMON/PYTCCO/COEFX(194:380,2)
+ COMMON/TCPARA/IRES,JRES,XMAS(3),XWID(3),YMAS(2),YWID(2)
+ SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,
+ &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT6/,/PYINT7/,/PYTCCO/,
+ &/PYTCSM/,/TCPARA/
+C...Local arrays, character variables and data.
+ LOGICAL IOK
+ CHARACTER CVAR(4)*4
+ DIMENSION NPTS(4),MVARPT(500,4),VINTPT(500,30),SIGSPT(500),
+ &NAREL(9),WTREL(9),WTMAT(9,9),WTRELN(9),COEFU(9),COEFO(9),
+ &IACCMX(4),SIGSMX(4),SIGSSM(3),PMMN(2),WTRSAV(9),TEMPC(9),
+ &IQ(9),IP(9)
+ DATA CVAR/'tau ','tau''','y* ','cth '/
+ DATA SIGSSM/3*0D0/
+
+C...Initial values and loop over subprocesses.
+ NPOSI=0
+ VINT(143)=1D0
+ VINT(144)=1D0
+ XSEC(0,1)=0D0
+ ITECH=0
+ DO 460 ISUB=1,500
+ MINT(1)=ISUB
+ MINT(51)=0
+
+C...Find maximum weight factors for photon flux.
+ IF(MSUB(ISUB).EQ.1.OR.(ISUB.GE.91.AND.ISUB.LE.100)) THEN
+ IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(2,WTGAGA)
+ ENDIF
+
+C...Select subprocess to study: skip cases not applicable.
+ IF(ISET(ISUB).EQ.11) THEN
+ IF(MSUB(ISUB).NE.1) GOTO 460
+C...User process intialization: cross section model dependent.
+ IF(IABS(IDWTUP).EQ.1) THEN
+ IF(IDWTUP.GT.0.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL
+ & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process')
+ XSEC(ISUB,1)=1.00000001D-9*ABS(XMAXUP(KFPR(ISUB,1)))
+ ELSE
+ IF((IDWTUP.EQ.2.OR.IDWTUP.EQ.3).AND.
+ & XSECUP(KFPR(ISUB,1)).LT.0D0) CALL
+ & PYERRM(26,'(PYMAXI:) Negative XSECUP for user process')
+ IF(IDWTUP.EQ.2.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL
+ & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process')
+ XSEC(ISUB,1)=1.00000001D-9*ABS(XSECUP(KFPR(ISUB,1)))
+ ENDIF
+ IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)=
+ & WTGAGA*XSEC(ISUB,1)
+ NPOSI=NPOSI+1
+ GOTO 450
+ ELSEIF(ISUB.GE.91.AND.ISUB.LE.95) THEN
+ CALL PYSIGH(NCHN,SIGS)
+ XSEC(ISUB,1)=SIGS
+ IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)=
+ & WTGAGA*XSEC(ISUB,1)
+ IF(MSUB(ISUB).NE.1) GOTO 460
+ NPOSI=NPOSI+1
+ GOTO 450
+ ELSEIF(ISUB.EQ.99.AND.MSUB(ISUB).EQ.1) THEN
+ CALL PYSIGH(NCHN,SIGS)
+ XSEC(ISUB,1)=SIGS
+ IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)=
+ & WTGAGA*XSEC(ISUB,1)
+ IF(XSEC(ISUB,1).EQ.0D0) THEN
+ MSUB(ISUB)=0
+ ELSE
+ NPOSI=NPOSI+1
+ ENDIF
+ GOTO 450
+ ELSEIF(ISUB.EQ.96) THEN
+ IF(MINT(50).EQ.0) GOTO 460
+ IF(MSUB(95).NE.1.AND.MOD(MSTP(81),10).LE.0.AND.MSTP(131).LE.0)
+ & GOTO 460
+ IF(MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 460
+ ELSEIF(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.ISUB.EQ.28.OR.
+ & ISUB.EQ.53.OR.ISUB.EQ.68) THEN
+ IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460
+ ELSEIF(ISUB.GE.381.AND.ISUB.LE.386) THEN
+ IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460
+ ELSE
+ IF(MSUB(ISUB).NE.1) GOTO 460
+ ENDIF
+ ISTSB=ISET(ISUB)
+ IF(ISUB.EQ.96) ISTSB=2
+ IF(MSTP(122).GE.2) WRITE(MSTU(11),5000) ISUB
+ MWTXS=0
+ IF(MSTP(142).GE.1.AND.ISUB.NE.96.AND.MSUB(91)+MSUB(92)+MSUB(93)+
+ & MSUB(94)+MSUB(95).EQ.0) MWTXS=1
+
+C...Find resonances (explicit or implicit in cross-section).
+ MINT(72)=0
+ KFR1=0
+ IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN
+ KFR1=KFPR(ISUB,1)
+ ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165
+ & .OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN
+ KFR1=23
+ ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172
+ & .OR.ISUB.EQ.177) THEN
+ KFR1=24
+ ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN
+ KFR1=25
+ IF(MSTP(46).EQ.5) THEN
+ KFR1=89
+ PMAS(89,1)=PARP(45)
+ PMAS(89,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2)
+ ENDIF
+ ENDIF
+ CKMX=CKIN(2)
+ IF(CKMX.LE.0D0) CKMX=VINT(1)
+ KCR1=PYCOMP(KFR1)
+ IF(KFR1.NE.0) THEN
+ IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR.
+ & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0
+ ENDIF
+ IF(KFR1.NE.0) THEN
+ TAUR1=PMAS(KCR1,1)**2/VINT(2)
+ GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2)
+ MINT(72)=1
+ MINT(73)=KFR1
+ VINT(73)=TAUR1
+ VINT(74)=GAMR1
+ ENDIF
+ KFR2=0
+ KFR3=0
+ IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.ISUB.EQ.195.OR.
+ $ (ISUB.GE.361.AND.ISUB.LE.380))
+ $ THEN
+ KFR2=23
+ IF(ISUB.EQ.141) THEN
+ KCR2=PYCOMP(KFR2)
+ IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR.
+ & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) THEN
+ KFR2=0
+ ELSE
+ TAUR2=PMAS(KCR2,1)**2/VINT(2)
+ GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2)
+ MINT(72)=2
+ MINT(74)=KFR2
+ VINT(75)=TAUR2
+ VINT(76)=GAMR2
+ ENDIF
+ ELSEIF(ITECH.EQ.0) THEN
+ ALPRHT=2.16D0*(3D0/DBLE(ITCM(1)))
+ ITECH=1
+ KFR1=KTECHN+113
+ KCR1=PYCOMP(KFR1)
+ KFR2=KTECHN+223
+ KCR2=PYCOMP(KFR2)
+ KFR3=KTECHN+115
+ KCR3=PYCOMP(KFR3)
+ IRES=0
+C...Order the resonances
+ IF(PMAS(KCR3,1).LT.PMAS(KCR2,1)) THEN
+ KCT=KCR3
+ KCR3=KCR2
+ KCR2=KCT
+ ENDIF
+ IF(PMAS(KCR3,1).LT.PMAS(KCR1,1)) THEN
+ KCT=KCR3
+ KCR3=KCR1
+ KCR1=KCT
+ ENDIF
+ IF(PMAS(KCR2,1).LT.PMAS(KCR1,1)) THEN
+ KCT=KCR2
+ KCR2=KCR1
+ KCR1=KCT
+ ENDIF
+ DO 101 I=1,3
+ IF(I.EQ.1) THEN
+ SHN0=PMAS(KCR1,1)**2
+ ELSEIF(I.EQ.2) THEN
+ IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LE.1D-6) GOTO 101
+ SHN0=PMAS(KCR2,1)**2
+ ELSEIF(I.EQ.3) THEN
+ IF(ABS(PMAS(KCR3,1)-PMAS(KCR3,1)).LE.1D-6) GOTO 101
+ SHN0=PMAS(KCR3,1)**2
+ ENDIF
+ AEM=PYALEM(SHN0)
+ FAR=SQRT(AEM/ALPRHT)
+ SHN=SHN0*(1D0-FAR)
+ CALL PYTECM(SHN,S1,WIDO,1)
+ RES=SHN-S1
+ SHN=S1*.99D0
+ SHSTEP=2D0
+ 102 SHN=SHN+SHSTEP
+ CALL PYTECM(SHN,S1,WIDO,1)
+ IF(RES.LT.0D0.AND.SHN-S1.GE.0D0) THEN
+ IOK=.FALSE.
+ IF(IRES.GT.0) THEN
+ IF(ABS(SQRT(S1)-XMAS(IRES)).GT.1D-6) IOK=.TRUE.
+ ELSEIF(IRES.EQ.0) THEN
+ IOK=.TRUE.
+ ENDIF
+ IF(IOK) THEN
+ IRES=IRES+1
+ XMAS(IRES)=SQRT(S1)
+ XWID(IRES)=WIDO
+ ENDIF
+ ENDIF
+ RES=SHN-S1
+ IF(IRES.LT.3.AND.SHN.LT.SHN0*(1D0+FAR)) GOTO 102
+ 101 CONTINUE
+ JRES=0
+ KFR1=KTECHN+213
+ KCR1=PYCOMP(KFR1)
+ KFR2=KTECHN+215
+ KCR2=PYCOMP(KFR2)
+ IF(PMAS(KCR2,1).LT.PMAS(KCR1,1)) THEN
+ KCT=KCR2
+ KCR2=KCR1
+ KCR1=KCT
+ ENDIF
+ DO 103 I=1,2
+ IF(I.EQ.1) THEN
+ SHN0=PMAS(KCR1,1)**2
+ ELSEIF(I.EQ.2) THEN
+ IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LE.1D-6) GOTO 103
+ SHN0=PMAS(KCR2,1)**2
+ ENDIF
+ AEM=PYALEM(SHN0)
+ FAR=SQRT(AEM/ALPRHT)
+ SHN=SHN0*(1D0-FAR)
+ CALL PYTECM(SHN,S1,WIDO,2)
+ RES=SHN-S1
+ SHN=S1*.99D0
+ SHSTEP=2D0
+ 104 SHN=SHN+SHSTEP
+ CALL PYTECM(SHN,S1,WIDO,2)
+ IF(RES.LT.0D0.AND.SHN-S1.GE.0D0) THEN
+ IOK=.FALSE.
+ IF(JRES.GT.0) THEN
+ IF(ABS(SQRT(S1)-XMAS(IRES)).GT.1D-6) IOK=.TRUE.
+ ELSEIF(JRES.EQ.0) THEN
+ IOK=.TRUE.
+ ENDIF
+ IF(IOK) THEN
+ JRES=JRES+1
+ YMAS(JRES)=SQRT(S1)
+ YWID(JRES)=WIDO
+ ENDIF
+ ENDIF
+ RES=SHN-S1
+ IF(JRES.LT.2.AND.SHN.LT.SHN0*(1D0+FAR)) GOTO 104
+ 103 CONTINUE
+ ENDIF
+ IF(ISUB.EQ.194.OR.(ISUB.GE.361.AND.ISUB.LE.368).OR.
+ & ISUB.EQ.379.OR.ISUB.EQ.380) THEN
+ MINT(72)=IRES
+ IF(IRES.GE.1) THEN
+ VINT(73)=XMAS(1)**2/VINT(2)
+ VINT(74)=XMAS(1)*XWID(1)/VINT(2)
+ TAUR1=VINT(73)
+ GAMR1=VINT(74)
+ XM1=XMAS(1)
+ XG1=XWID(1)
+ KFR1=1
+ ENDIF
+ IF(IRES.GE.2) THEN
+ VINT(75)=XMAS(2)**2/VINT(2)
+ VINT(76)=XMAS(2)*XWID(2)/VINT(2)
+ TAUR2=VINT(75)
+ GAMR2=VINT(76)
+ XM2=XMAS(2)
+ XG2=XWID(2)
+ KFR2=2
+ ENDIF
+ IF(IRES.EQ.3) THEN
+ VINT(77)=XMAS(3)**2/VINT(2)
+ VINT(78)=XMAS(3)*XWID(3)/VINT(2)
+ TAUR3=VINT(77)
+ GAMR3=VINT(78)
+ XM3=XMAS(3)
+ XG3=XWID(3)
+ KFR3=3
+ ENDIF
+C...Charged current: rho+- and a+-
+ ELSEIF(ISUB.EQ.195.OR.ISUB.GE.370.AND.ISUB.LE.378) THEN
+ MINT(72)=IRES
+ IF(JRES.GE.1) THEN
+ VINT(73)=YMAS(1)**2/VINT(2)
+ VINT(74)=YMAS(1)*YWID(1)/VINT(2)
+ KFR1=1
+ TAUR1=VINT(73)
+ GAMR1=VINT(74)
+ XM1=YMAS(1)
+ XG1=YWID(1)
+ ENDIF
+ IF(JRES.GE.2) THEN
+ VINT(75)=YMAS(2)**2/VINT(2)
+ VINT(76)=YMAS(2)*YWID(2)/VINT(2)
+ KFR2=2
+ TAUR2=VINT(73)
+ GAMR2=VINT(74)
+ XM2=YMAS(2)
+ XG2=YWID(2)
+ ENDIF
+ KFR3=0
+ ENDIF
+ IF(ISUB.NE.141) THEN
+ IF(KFR1.NE.0.AND.(CKIN(1).GT.(XM1+20D0*XG1)
+ & .OR.CKMX.LT.(XM1-20D0*XG1))) KFR1=0
+ IF(KFR2.NE.0.AND.(CKIN(1).GT.(XM2+20D0*XG2)
+ & .OR.CKMX.LT.(XM2-20D0*XG2))) KFR2=0
+ IF(KFR3.NE.0.AND.(CKIN(1).GT.(XM3+20D0*XG3)
+ & .OR.CKMX.LT.(XM3-20D0*XG3))) KFR3=0
+ IF(KFR3.NE.0.AND.KFR2.NE.0.AND.KFR1.NE.0) THEN
+
+ ELSEIF(KFR1.NE.0.AND.KFR2.NE.0) THEN
+ MINT(72)=2
+ ELSEIF(KFR1.NE.0.AND.KFR3.NE.0) THEN
+ MINT(72)=2
+ MINT(74)=KFR3
+ VINT(75)=TAUR3
+ VINT(76)=GAMR3
+ ELSEIF(KFR2.NE.0.AND.KFR3.NE.0) THEN
+ MINT(72)=2
+ MINT(73)=KFR2
+ VINT(73)=TAUR2
+ VINT(74)=GAMR2
+ MINT(74)=KFR3
+ VINT(75)=TAUR3
+ VINT(76)=GAMR3
+ ELSEIF(KFR1.NE.0) THEN
+ MINT(72)=1
+ ELSEIF(KFR2.NE.0) THEN
+ MINT(72)=1
+ MINT(73)=KFR2
+ VINT(73)=TAUR2
+ VINT(74)=GAMR2
+ ELSEIF(KFR3.NE.0) THEN
+ MINT(72)=1
+ MINT(73)=KFR3
+ VINT(73)=TAUR3
+ VINT(74)=GAMR3
+ ELSE
+ MINT(72)=0
+ ENDIF
+ ELSE
+ IF(KFR2.NE.0.AND.KFR1.NE.0) THEN
+
+ ELSEIF(KFR2.NE.0) THEN
+ KFR1=KFR2
+ TAUR1=TAUR2
+ GAMR1=GAMR2
+ MINT(72)=1
+ MINT(73)=KFR1
+ VINT(73)=TAUR1
+ VINT(74)=GAMR1
+ KFR2=0
+ ELSE
+ MINT(72)=0
+ ENDIF
+ ENDIF
+ ENDIF
+
+C...Find product masses and minimum pT of process.
+ SQM3=0D0
+ SQM4=0D0
+ MINT(71)=0
+ VINT(71)=CKIN(3)
+ VINT(80)=1D0
+ IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
+ NBW=0
+ DO 110 I=1,2
+ PMMN(I)=0D0
+ IF(KFPR(ISUB,I).EQ.0) THEN
+ ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT.
+ & PARP(41)) THEN
+ IF(I.EQ.1) SQM3=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2
+ IF(I.EQ.2) SQM4=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2
+ ELSE
+ NBW=NBW+1
+C...This prevents SUSY/t particles from becoming too light.
+ KFLW=KFPR(ISUB,I)
+ IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN
+ KCW=PYCOMP(KFLW)
+ PMMN(I)=PMAS(KCW,1)
+ DO 100 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1
+ IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN
+ PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+
+ & PMAS(PYCOMP(KFDP(IDC,2)),1)
+ IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+
+ & PMAS(PYCOMP(KFDP(IDC,3)),1)
+ PMMN(I)=MIN(PMMN(I),PMSUM)
+ ENDIF
+ 100 CONTINUE
+ ELSEIF(KFLW.EQ.6) THEN
+ PMMN(I)=PMAS(24,1)+PMAS(5,1)
+ ENDIF
+ ENDIF
+ 110 CONTINUE
+ IF(NBW.GE.1) THEN
+ CKIN41=CKIN(41)
+ CKIN43=CKIN(43)
+ CKIN(41)=MAX(PMMN(1),CKIN(41))
+ CKIN(43)=MAX(PMMN(2),CKIN(43))
+ CALL PYOFSH(3,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4)
+ CKIN(41)=CKIN41
+ CKIN(43)=CKIN43
+ IF(MINT(51).EQ.1) THEN
+ WRITE(MSTU(11),5100) ISUB
+ MSUB(ISUB)=0
+ GOTO 460
+ ENDIF
+ SQM3=PQM3**2
+ SQM4=PQM4**2
+ ENDIF
+ IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) MINT(71)=1
+ IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5))
+ IF(ISUB.EQ.96.AND.MSTP(82).LE.1) THEN
+ VINT(71)=PARP(81)*(VINT(1)/PARP(89))**PARP(90)
+ ELSEIF(ISUB.EQ.96) THEN
+ VINT(71)=0.08D0*PARP(82)*(VINT(1)/PARP(89))**PARP(90)
+ ENDIF
+ ENDIF
+ VINT(63)=SQM3
+ VINT(64)=SQM4
+
+C...Prepare for additional variable choices in 2 -> 3.
+ IF(ISTSB.EQ.5) THEN
+ VINT(201)=0D0
+ IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1)
+ VINT(206)=VINT(201)
+ IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(206)=PMAS(5,1)
+ VINT(204)=PMAS(23,1)
+ IF(ISUB.EQ.124.OR.ISUB.EQ.351) VINT(204)=PMAS(24,1)
+ IF(ISUB.EQ.352) VINT(204)=PMAS(PYCOMP(9900024),1)
+ IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182
+ & .OR.ISUB.EQ.186.OR.ISUB.EQ.187.OR.ISUB.EQ.401.OR.ISUB.EQ.402)
+ & VINT(204)=VINT(201)
+ VINT(209)=VINT(204)
+ IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(209)=VINT(206)
+ ENDIF
+
+C...Number of points for each variable: tau, tau', y*, cos(theta-hat).
+ IPEAK7=0
+ NPTS(1)=2+2*MINT(72)
+ IF(MINT(47).EQ.1) THEN
+ IF(ISTSB.EQ.1.OR.ISTSB.EQ.2) NPTS(1)=1
+ ELSEIF(MINT(47).GE.5) THEN
+ IF(ISTSB.LE.2.OR.ISTSB.GT.5) THEN
+ NPTS(1)=NPTS(1)+1
+ IPEAK7=1
+ ENDIF
+ ENDIF
+ NPTS(2)=1
+ IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN
+ IF(MINT(47).GE.2) NPTS(2)=2
+ IF(MINT(47).GE.5) NPTS(2)=3
+ ENDIF
+ NPTS(3)=1
+ IF(MINT(47).EQ.4.OR.MINT(47).EQ.5) THEN
+ NPTS(3)=3
+ IF(MINT(45).EQ.3) NPTS(3)=NPTS(3)+1
+ IF(MINT(46).EQ.3) NPTS(3)=NPTS(3)+1
+ ENDIF
+ NPTS(4)=1
+ IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) NPTS(4)=5
+ NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4)
+
+C...Reset coefficients of cross-section weighting.
+ DO 120 J=1,20
+ COEF(ISUB,J)=0D0
+ 120 CONTINUE
+ IF(ISUB.EQ.194.OR.ISUB.EQ.195.OR.(ISUB.GE.361
+ & .AND.ISUB.LE.380)) THEN
+ DO 125 J=1,2
+ COEFX(ISUB,J)=0D0
+ 125 CONTINUE
+ ENDIF
+ COEF(ISUB,1)=1D0
+ COEF(ISUB,8)=0.5D0
+ COEF(ISUB,9)=0.5D0
+ COEF(ISUB,13)=1D0
+ COEF(ISUB,18)=1D0
+ MCTH=0
+ MTAUP=0
+ METAUP=0
+ VINT(23)=0D0
+ VINT(26)=0D0
+ SIGSAM=0D0
+
+C...Find limits and select tau, y*, cos(theta-hat) and tau' values,
+C...in grid of phase space points.
+ CALL PYKLIM(1)
+ METAU=MINT(51)
+ NACC=0
+ DO 150 ITRY=1,NTRY
+ MINT(51)=0
+ IF(METAU.EQ.1) GOTO 150
+ IF(MOD(ITRY-1,NPTS(2)*NPTS(3)*NPTS(4)).EQ.0) THEN
+ MTAU=1+(ITRY-1)/(NPTS(2)*NPTS(3)*NPTS(4))
+ IF(MINT(72).LE.2.AND.MTAU.GT.2+2*MINT(72)) THEN
+ MTAU=7
+ ELSEIF(MINT(72).EQ.3.AND.IPEAK7.EQ.0.AND.MTAU.GE.7) THEN
+ MTAU=MTAU+1
+ ENDIF
+ RTAU=0.5D0
+C...Special case when both resonances have same mass,
+C...as is often the case in process 194.
+c IF(MINT(72).GE.2) THEN
+c IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LT.
+c & 0.01D0*(PMAS(KCR2,1)+PMAS(KCR1,1))) THEN
+c IF(MTAU.EQ.3.OR.MTAU.EQ.4) THEN
+c RTAU=0.4D0
+c ELSEIF(MTAU.EQ.5.OR.MTAU.EQ.6) THEN
+c
git://git.uio.no / u / mrichter / AliRoot.git / commitdiff