C********************************************************************* C********************************************************************* C* ** C* December 1993 ** C* ** C* The Lund Monte Carlo for Jet Fragmentation and e+e- Physics ** C* ** C* JETSET version 7.4 ** C* ** C* Torbjorn Sjostrand ** C* Department of theoretical physics 2 ** C* University of Lund ** C* Solvegatan 14A, S-223 62 Lund, Sweden ** C* E-mail torbjorn@thep.lu.se ** C* phone +46 - 46 - 222 48 16 ** C* ** C* LUSHOW is written together with Mats Bengtsson ** C* ** C* The latest program version and documentation is found on WWW ** C* http://thep.lu.se/tf2/staff/torbjorn/Welcome.html ** C* ** C* Copyright Torbjorn Sjostrand and CERN, Geneva 1993 ** C* ** C********************************************************************* C********************************************************************* C * C List of subprograms in order of appearance, with main purpose * C (S = subroutine, F = function, B = block data) * C * C S LU1ENT to fill one entry (= parton or particle) * C S LU2ENT to fill two entries * C S LU3ENT to fill three entries * C S LU4ENT to fill four entries * C S LUJOIN to connect entries with colour flow information * C S LUGIVE to fill (or query) commonblock variables * C S LUEXEC to administrate fragmentation and decay chain * C S LUPREP to rearrange showered partons along strings * C S LUSTRF to do string fragmentation of jet system * C S LUINDF to do independent fragmentation of one or many jets * C S LUDECY to do the decay of a particle * C S LUKFDI to select parton and hadron flavours in fragm * C S LUPTDI to select transverse momenta in fragm * C S LUZDIS to select longitudinal scaling variable in fragm * C S LUSHOW to do timelike parton shower evolution * C S LUBOEI to include Bose-Einstein effects (crudely) * C F ULMASS to give the mass of a particle or parton * C S LUNAME to give the name of a particle or parton * C F LUCHGE to give three times the electric charge * C F LUCOMP to compress standard KF flavour code to internal KC * C S LUERRM to write error messages and abort faulty run * C F ULALEM to give the alpha_electromagnetic value * C F ULALPS to give the alpha_strong value * C F ULANGL to give the angle from known x and y components * C F RLU to provide a random number generator * C S RLUGET to save the state of the random number generator * C S RLUSET to set the state of the random number generator * C S LUROBO to rotate and/or boost an event * C S LUEDIT to remove unwanted entries from record * C S LULIST to list event record or particle data * C S LULOGO to write a logo for JETSET and PYTHIA * C S LUUPDA to update particle data * C F KLU to provide integer-valued event information * C F PLU to provide real-valued event information * C S LUSPHE to perform sphericity analysis * C S LUTHRU to perform thrust analysis * C S LUCLUS to perform three-dimensional cluster analysis * C S LUCELL to perform cluster analysis in (eta, phi, E_T) * C S LUJMAS to give high and low jet mass of event * C S LUFOWO to give Fox-Wolfram moments * C S LUTABU to analyze events, with tabular output * C * C S LUEEVT to administrate the generation of an e+e- event * C S LUXTOT to give the total cross-section at given CM energy * C S LURADK to generate initial state photon radiation * C S LUXKFL to select flavour of primary qqbar pair * C S LUXJET to select (matrix element) jet multiplicity * C S LUX3JT to select kinematics of three-jet event * C S LUX4JT to select kinematics of four-jet event * C S LUXDIF to select angular orientation of event * C S LUONIA to perform generation of onium decay to gluons * C * C S LUHEPC to convert between /LUJETS/ and /HEPEVT/ records * C S LUTEST to test the proper functioning of the package * C B LUDATA to contain default values and particle data * C * C********************************************************************* SUBROUTINE LU1ENT(IP,KF,PE,THE,PHI) C...Purpose: to store one parton/particle in commonblock LUJETS. COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ C...Standard checks. MSTU(28)=0 IF(MSTU(12).GE.1) CALL LULIST(0) IPA=MAX(1,IABS(IP)) IF(IPA.GT.MSTU(4)) CALL LUERRM(21, &'(LU1ENT:) writing outside LUJETS memory') KC=LUCOMP(KF) IF(KC.EQ.0) CALL LUERRM(12,'(LU1ENT:) unknown flavour code') C...Find mass. Reset K, P and V vectors. PM=0. IF(MSTU(10).EQ.1) PM=P(IPA,5) IF(MSTU(10).GE.2) PM=ULMASS(KF) DO 100 J=1,5 K(IPA,J)=0 P(IPA,J)=0. V(IPA,J)=0. 100 CONTINUE C...Store parton/particle in K and P vectors. K(IPA,1)=1 IF(IP.LT.0) K(IPA,1)=2 K(IPA,2)=KF P(IPA,5)=PM P(IPA,4)=MAX(PE,PM) PA=SQRT(P(IPA,4)**2-P(IPA,5)**2) P(IPA,1)=PA*SIN(THE)*COS(PHI) P(IPA,2)=PA*SIN(THE)*SIN(PHI) P(IPA,3)=PA*COS(THE) C...Set N. Optionally fragment/decay. N=IPA IF(IP.EQ.0) CALL LUEXEC RETURN END C********************************************************************* SUBROUTINE LU2ENT(IP,KF1,KF2,PECM) C...Purpose: to store two partons/particles in their CM frame, C...with the first along the +z axis. COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ C...Standard checks. MSTU(28)=0 IF(MSTU(12).GE.1) CALL LULIST(0) IPA=MAX(1,IABS(IP)) IF(IPA.GT.MSTU(4)-1) CALL LUERRM(21, &'(LU2ENT:) writing outside LUJETS memory') KC1=LUCOMP(KF1) KC2=LUCOMP(KF2) IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LUERRM(12, &'(LU2ENT:) unknown flavour code') C...Find masses. Reset K, P and V vectors. PM1=0. IF(MSTU(10).EQ.1) PM1=P(IPA,5) IF(MSTU(10).GE.2) PM1=ULMASS(KF1) PM2=0. IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) IF(MSTU(10).GE.2) PM2=ULMASS(KF2) DO 110 I=IPA,IPA+1 DO 100 J=1,5 K(I,J)=0 P(I,J)=0. V(I,J)=0. 100 CONTINUE 110 CONTINUE C...Check flavours. KQ1=KCHG(KC1,2)*ISIGN(1,KF1) KQ2=KCHG(KC2,2)*ISIGN(1,KF2) IF(MSTU(19).EQ.1) THEN MSTU(19)=0 ELSE IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LUERRM(2, & '(LU2ENT:) unphysical flavour combination') ENDIF K(IPA,2)=KF1 K(IPA+1,2)=KF2 C...Store partons/particles in K vectors for normal case. IF(IP.GE.0) THEN K(IPA,1)=1 IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2 K(IPA+1,1)=1 C...Store partons in K vectors for parton shower evolution. ELSE K(IPA,1)=3 K(IPA+1,1)=3 K(IPA,4)=MSTU(5)*(IPA+1) K(IPA,5)=K(IPA,4) K(IPA+1,4)=MSTU(5)*IPA K(IPA+1,5)=K(IPA+1,4) ENDIF C...Check kinematics and store partons/particles in P vectors. IF(PECM.LE.PM1+PM2) CALL LUERRM(13, &'(LU2ENT:) energy smaller than sum of masses') PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/ &(2.*PECM) P(IPA,3)=PA P(IPA,4)=SQRT(PM1**2+PA**2) P(IPA,5)=PM1 P(IPA+1,3)=-PA P(IPA+1,4)=SQRT(PM2**2+PA**2) P(IPA+1,5)=PM2 C...Set N. Optionally fragment/decay. N=IPA+1 IF(IP.EQ.0) CALL LUEXEC RETURN END C********************************************************************* SUBROUTINE LU3ENT(IP,KF1,KF2,KF3,PECM,X1,X3) C...Purpose: to store three partons or particles in their CM frame, C...with the first along the +z axis and the third in the (x,z) C...plane with x > 0. COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ C...Standard checks. MSTU(28)=0 IF(MSTU(12).GE.1) CALL LULIST(0) IPA=MAX(1,IABS(IP)) IF(IPA.GT.MSTU(4)-2) CALL LUERRM(21, &'(LU3ENT:) writing outside LUJETS memory') KC1=LUCOMP(KF1) KC2=LUCOMP(KF2) KC3=LUCOMP(KF3) IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL LUERRM(12, &'(LU3ENT:) unknown flavour code') C...Find masses. Reset K, P and V vectors. PM1=0. IF(MSTU(10).EQ.1) PM1=P(IPA,5) IF(MSTU(10).GE.2) PM1=ULMASS(KF1) PM2=0. IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) IF(MSTU(10).GE.2) PM2=ULMASS(KF2) PM3=0. IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) IF(MSTU(10).GE.2) PM3=ULMASS(KF3) DO 110 I=IPA,IPA+2 DO 100 J=1,5 K(I,J)=0 P(I,J)=0. V(I,J)=0. 100 CONTINUE 110 CONTINUE C...Check flavours. KQ1=KCHG(KC1,2)*ISIGN(1,KF1) KQ2=KCHG(KC2,2)*ISIGN(1,KF2) KQ3=KCHG(KC3,2)*ISIGN(1,KF3) IF(MSTU(19).EQ.1) THEN MSTU(19)=0 ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0) THEN ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.(KQ1+KQ3.EQ.0.OR. &KQ1+KQ3.EQ.4)) THEN ELSE CALL LUERRM(2,'(LU3ENT:) unphysical flavour combination') ENDIF K(IPA,2)=KF1 K(IPA+1,2)=KF2 K(IPA+2,2)=KF3 C...Store partons/particles in K vectors for normal case. IF(IP.GE.0) THEN K(IPA,1)=1 IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0)) K(IPA,1)=2 K(IPA+1,1)=1 IF(KQ2.NE.0.AND.KQ3.NE.0) K(IPA+1,1)=2 K(IPA+2,1)=1 C...Store partons in K vectors for parton shower evolution. ELSE K(IPA,1)=3 K(IPA+1,1)=3 K(IPA+2,1)=3 KCS=4 IF(KQ1.EQ.-1) KCS=5 K(IPA,KCS)=MSTU(5)*(IPA+1) K(IPA,9-KCS)=MSTU(5)*(IPA+2) K(IPA+1,KCS)=MSTU(5)*(IPA+2) K(IPA+1,9-KCS)=MSTU(5)*IPA K(IPA+2,KCS)=MSTU(5)*IPA K(IPA+2,9-KCS)=MSTU(5)*(IPA+1) ENDIF C...Check kinematics. MKERR=0 IF(0.5*X1*PECM.LE.PM1.OR.0.5*(2.-X1-X3)*PECM.LE.PM2.OR. &0.5*X3*PECM.LE.PM3) MKERR=1 PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2)) PA2=SQRT(MAX(1E-10,(0.5*(2.-X1-X3)*PECM)**2-PM2**2)) PA3=SQRT(MAX(1E-10,(0.5*X3*PECM)**2-PM3**2)) CTHE2=(PA3**2-PA1**2-PA2**2)/(2.*PA1*PA2) CTHE3=(PA2**2-PA1**2-PA3**2)/(2.*PA1*PA3) IF(ABS(CTHE2).GE.1.001.OR.ABS(CTHE3).GE.1.001) MKERR=1 CTHE3=MAX(-1.,MIN(1.,CTHE3)) IF(MKERR.NE.0) CALL LUERRM(13, &'(LU3ENT:) unphysical kinematical variable setup') C...Store partons/particles in P vectors. P(IPA,3)=PA1 P(IPA,4)=SQRT(PA1**2+PM1**2) P(IPA,5)=PM1 P(IPA+2,1)=PA3*SQRT(1.-CTHE3**2) P(IPA+2,3)=PA3*CTHE3 P(IPA+2,4)=SQRT(PA3**2+PM3**2) P(IPA+2,5)=PM3 P(IPA+1,1)=-P(IPA+2,1) P(IPA+1,3)=-P(IPA,3)-P(IPA+2,3) P(IPA+1,4)=SQRT(P(IPA+1,1)**2+P(IPA+1,3)**2+PM2**2) P(IPA+1,5)=PM2 C...Set N. Optionally fragment/decay. N=IPA+2 IF(IP.EQ.0) CALL LUEXEC RETURN END C********************************************************************* SUBROUTINE LU4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14) C...Purpose: to store four partons or particles in their CM frame, with C...the first along the +z axis, the last in the xz plane with x > 0 C...and the second having y < 0 and y > 0 with equal probability. COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ C...Standard checks. MSTU(28)=0 IF(MSTU(12).GE.1) CALL LULIST(0) IPA=MAX(1,IABS(IP)) IF(IPA.GT.MSTU(4)-3) CALL LUERRM(21, &'(LU4ENT:) writing outside LUJETS momory') KC1=LUCOMP(KF1) KC2=LUCOMP(KF2) KC3=LUCOMP(KF3) KC4=LUCOMP(KF4) IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL LUERRM(12, &'(LU4ENT:) unknown flavour code') C...Find masses. Reset K, P and V vectors. PM1=0. IF(MSTU(10).EQ.1) PM1=P(IPA,5) IF(MSTU(10).GE.2) PM1=ULMASS(KF1) PM2=0. IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) IF(MSTU(10).GE.2) PM2=ULMASS(KF2) PM3=0. IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) IF(MSTU(10).GE.2) PM3=ULMASS(KF3) PM4=0. IF(MSTU(10).EQ.1) PM4=P(IPA+3,5) IF(MSTU(10).GE.2) PM4=ULMASS(KF4) DO 110 I=IPA,IPA+3 DO 100 J=1,5 K(I,J)=0 P(I,J)=0. V(I,J)=0. 100 CONTINUE 110 CONTINUE C...Check flavours. KQ1=KCHG(KC1,2)*ISIGN(1,KF1) KQ2=KCHG(KC2,2)*ISIGN(1,KF2) KQ3=KCHG(KC3,2)*ISIGN(1,KF3) KQ4=KCHG(KC4,2)*ISIGN(1,KF4) IF(MSTU(19).EQ.1) THEN MSTU(19)=0 ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0.AND.KQ4.EQ.0) THEN ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.KQ3.EQ.2.AND.(KQ1+KQ4.EQ.0.OR. &KQ1+KQ4.EQ.4)) THEN ELSEIF(KQ1.NE.0.AND.KQ1+KQ2.EQ.0.AND.KQ3.NE.0.AND.KQ3+KQ4.EQ.0.) &THEN ELSE CALL LUERRM(2,'(LU4ENT:) unphysical flavour combination') ENDIF K(IPA,2)=KF1 K(IPA+1,2)=KF2 K(IPA+2,2)=KF3 K(IPA+3,2)=KF4 C...Store partons/particles in K vectors for normal case. IF(IP.GE.0) THEN K(IPA,1)=1 IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0.OR.KQ4.NE.0)) K(IPA,1)=2 K(IPA+1,1)=1 IF(KQ2.NE.0.AND.KQ1+KQ2.NE.0.AND.(KQ3.NE.0.OR.KQ4.NE.0)) & K(IPA+1,1)=2 K(IPA+2,1)=1 IF(KQ3.NE.0.AND.KQ4.NE.0) K(IPA+2,1)=2 K(IPA+3,1)=1 C...Store partons for parton shower evolution from q-g-g-qbar or C...g-g-g-g event. ELSEIF(KQ1+KQ2.NE.0) THEN K(IPA,1)=3 K(IPA+1,1)=3 K(IPA+2,1)=3 K(IPA+3,1)=3 KCS=4 IF(KQ1.EQ.-1) KCS=5 K(IPA,KCS)=MSTU(5)*(IPA+1) K(IPA,9-KCS)=MSTU(5)*(IPA+3) K(IPA+1,KCS)=MSTU(5)*(IPA+2) K(IPA+1,9-KCS)=MSTU(5)*IPA K(IPA+2,KCS)=MSTU(5)*(IPA+3) K(IPA+2,9-KCS)=MSTU(5)*(IPA+1) K(IPA+3,KCS)=MSTU(5)*IPA K(IPA+3,9-KCS)=MSTU(5)*(IPA+2) C...Store partons for parton shower evolution from q-qbar-q-qbar event. ELSE K(IPA,1)=3 K(IPA+1,1)=3 K(IPA+2,1)=3 K(IPA+3,1)=3 K(IPA,4)=MSTU(5)*(IPA+1) K(IPA,5)=K(IPA,4) K(IPA+1,4)=MSTU(5)*IPA K(IPA+1,5)=K(IPA+1,4) K(IPA+2,4)=MSTU(5)*(IPA+3) K(IPA+2,5)=K(IPA+2,4) K(IPA+3,4)=MSTU(5)*(IPA+2) K(IPA+3,5)=K(IPA+3,4) ENDIF C...Check kinematics. MKERR=0 IF(0.5*X1*PECM.LE.PM1.OR.0.5*X2*PECM.LE.PM2.OR.0.5*(2.-X1-X2-X4)* &PECM.LE.PM3.OR.0.5*X4*PECM.LE.PM4) MKERR=1 PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2)) PA2=SQRT(MAX(1E-10,(0.5*X2*PECM)**2-PM2**2)) PA4=SQRT(MAX(1E-10,(0.5*X4*PECM)**2-PM4**2)) X24=X1+X2+X4-1.-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2 CTHE4=(X1*X4-2.*X14)*PECM**2/(4.*PA1*PA4) IF(ABS(CTHE4).GE.1.002) MKERR=1 CTHE4=MAX(-1.,MIN(1.,CTHE4)) STHE4=SQRT(1.-CTHE4**2) CTHE2=(X1*X2-2.*X12)*PECM**2/(4.*PA1*PA2) IF(ABS(CTHE2).GE.1.002) MKERR=1 CTHE2=MAX(-1.,MIN(1.,CTHE2)) STHE2=SQRT(1.-CTHE2**2) CPHI2=((X2*X4-2.*X24)*PECM**2-4.*PA2*CTHE2*PA4*CTHE4)/ &MAX(1E-8*PECM**2,4.*PA2*STHE2*PA4*STHE4) IF(ABS(CPHI2).GE.1.05) MKERR=1 CPHI2=MAX(-1.,MIN(1.,CPHI2)) IF(MKERR.EQ.1) CALL LUERRM(13, &'(LU4ENT:) unphysical kinematical variable setup') C...Store partons/particles in P vectors. P(IPA,3)=PA1 P(IPA,4)=SQRT(PA1**2+PM1**2) P(IPA,5)=PM1 P(IPA+3,1)=PA4*STHE4 P(IPA+3,3)=PA4*CTHE4 P(IPA+3,4)=SQRT(PA4**2+PM4**2) P(IPA+3,5)=PM4 P(IPA+1,1)=PA2*STHE2*CPHI2 P(IPA+1,2)=PA2*STHE2*SQRT(1.-CPHI2**2)*(-1.)**INT(RLU(0)+0.5) P(IPA+1,3)=PA2*CTHE2 P(IPA+1,4)=SQRT(PA2**2+PM2**2) P(IPA+1,5)=PM2 P(IPA+2,1)=-P(IPA+1,1)-P(IPA+3,1) P(IPA+2,2)=-P(IPA+1,2) P(IPA+2,3)=-P(IPA,3)-P(IPA+1,3)-P(IPA+3,3) P(IPA+2,4)=SQRT(P(IPA+2,1)**2+P(IPA+2,2)**2+P(IPA+2,3)**2+PM3**2) P(IPA+2,5)=PM3 C...Set N. Optionally fragment/decay. N=IPA+3 IF(IP.EQ.0) CALL LUEXEC RETURN END C********************************************************************* SUBROUTINE LUJOIN(NJOIN,IJOIN) C...Purpose: to connect a sequence of partons with colour flow indices, C...as required for subsequent shower evolution (or other operations). COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ DIMENSION IJOIN(*) C...Check that partons are of right types to be connected. IF(NJOIN.LT.2) GOTO 120 KQSUM=0 DO 100 IJN=1,NJOIN I=IJOIN(IJN) IF(I.LE.0.OR.I.GT.N) GOTO 120 IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120 KC=LUCOMP(K(I,2)) IF(KC.EQ.0) GOTO 120 KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) IF(KQ.EQ.0) GOTO 120 IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120 IF(KQ.NE.2) KQSUM=KQSUM+KQ IF(IJN.EQ.1) KQS=KQ 100 CONTINUE IF(KQSUM.NE.0) GOTO 120 C...Connect the partons sequentially (closing for gluon loop). KCS=(9-KQS)/2 IF(KQS.EQ.2) KCS=INT(4.5+RLU(0)) DO 110 IJN=1,NJOIN I=IJOIN(IJN) K(I,1)=3 IF(IJN.NE.1) IP=IJOIN(IJN-1) IF(IJN.EQ.1) IP=IJOIN(NJOIN) IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1) IF(IJN.EQ.NJOIN) IN=IJOIN(1) K(I,KCS)=MSTU(5)*IN K(I,9-KCS)=MSTU(5)*IP IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0 IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0 110 CONTINUE C...Error exit: no action taken. RETURN 120 CALL LUERRM(12, &'(LUJOIN:) given entries can not be joined by one string') RETURN END C********************************************************************* SUBROUTINE LUGIVE(CHIN) C...Purpose: to set values of commonblock variables (also in PYTHIA!). COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) COMMON/LUDAT4/CHAF(500) CHARACTER CHAF*8 COMMON/LUDATR/MRLU(6),RRLU(100) COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) COMMON/PYINT1/MINT(400),VINT(400) COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3) COMMON/PYINT6/PROC(0:200) COMMON/PYINT7/SIGT(0:6,0:6,0:5) CHARACTER PROC*28 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/ SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/, &/PYINT5/,/PYINT6/,/PYINT7/ CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28, &CHNEW2*28,CHNAM*4,CHVAR(43)*4,CHALP(2)*26,CHIND*8,CHINI*10, &CHINR*16 DIMENSION MSVAR(43,8) C...For each variable to be translated give: name, C...integer/real/character, no. of indices, lower&upper index bounds. DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG', &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRLU', &'RRLU','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI', &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH', &'WIDP','WIDE','WIDS','NGEN','XSEC','PROC','SIGT'/ DATA ((MSVAR(I,J),J=1,8),I=1,43)/ 1,7*0, 1,2,1,4000,1,5,2*0, & 2,2,1,4000,1,5,2*0, 2,2,1,4000,1,5,2*0, 1,1,1,200,4*0, & 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0, & 1,2,1,500,1,3,2*0, 2,2,1,500,1,4,2*0, 2,1,1,2000,4*0, & 2,2,1,4,1,4,2*0, 1,2,1,500,1,3,2*0, 1,2,1,2000,1,2,2*0, & 2,1,1,2000,4*0, 1,2,1,2000,1,5,2*0, 3,1,1,500,4*0, & 1,1,1,6,4*0, 2,1,1,100,4*0, & 1,7*0, 1,1,1,200,4*0, 1,2,1,2,-40,40,2*0, 2,1,1,200,4*0, & 1,1,1,200,4*0, 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0, & 1,1,1,400,4*0, 2,1,1,400,4*0, 1,1,1,200,4*0, & 1,2,1,200,1,2,2*0, 2,2,1,200,1,20,2*0, 1,3,1,40,1,4,1,2, & 2,2,1,2,-40,40,2*0, 1,2,1,1000,1,3,2*0, 2,1,1,1000,4*0, & 2,2,21,40,0,40,2*0, 2,2,21,40,0,40,2*0, 2,2,21,40,1,3,2*0, & 1,2,0,200,1,3,2*0, 2,2,0,200,1,3,2*0, 4,1,0,200,4*0, & 2,3,0,6,0,6,0,5/ DATA CHALP/'abcdefghijklmnopqrstuvwxyz', &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ C...Length of character variable. Subdivide it into instructions. IF(MSTU(12).GE.1) CALL LULIST(0) CHBIT=CHIN//' ' LBIT=101 100 LBIT=LBIT-1 IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100 LTOT=0 DO 110 LCOM=1,LBIT IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110 LTOT=LTOT+1 CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM) 110 CONTINUE LLOW=0 120 LHIG=LLOW+1 130 LHIG=LHIG+1 IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130 LBIT=LHIG-LLOW-1 CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1) C...Identify commonblock variable. LNAM=1 140 LNAM=LNAM+1 IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND. &LNAM.LE.4) GOTO 140 CHNAM=CHBIT(1:LNAM-1)//' ' DO 160 LCOM=1,LNAM-1 DO 150 LALP=1,26 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)= &CHALP(2)(LALP:LALP) 150 CONTINUE 160 CONTINUE IVAR=0 DO 170 IV=1,43 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV 170 CONTINUE IF(IVAR.EQ.0) THEN CALL LUERRM(18,'(LUGIVE:) do not recognize variable '//CHNAM) LLOW=LHIG IF(LLOW.LT.LTOT) GOTO 120 RETURN ENDIF C...Identify any indices. I1=0 I2=0 I3=0 NINDX=0 IF(CHBIT(LNAM:LNAM).EQ.'(') THEN LIND=LNAM 180 LIND=LIND+1 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180 CHIND=' ' IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c'). & AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1) READ(CHIND,'(I8)') KF I1=LUCOMP(KF) ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ. & 'c') THEN CALL LUERRM(18,'(LUGIVE:) not allowed to use C index for '// & CHNAM) LLOW=LHIG IF(LLOW.LT.LTOT) GOTO 120 RETURN ELSE CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) READ(CHIND,'(I8)') I1 ENDIF LNAM=LIND IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 NINDX=1 ENDIF IF(CHBIT(LNAM:LNAM).EQ.',') THEN LIND=LNAM 190 LIND=LIND+1 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190 CHIND=' ' CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) READ(CHIND,'(I8)') I2 LNAM=LIND IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 NINDX=2 ENDIF IF(CHBIT(LNAM:LNAM).EQ.',') THEN LIND=LNAM 200 LIND=LIND+1 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 200 CHIND=' ' CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) READ(CHIND,'(I8)') I3 LNAM=LIND+1 NINDX=3 ENDIF C...Check that indices allowed. IERR=0 IF(NINDX.NE.MSVAR(IVAR,2)) IERR=1 IF(NINDX.GE.1.AND.(I1.LT.MSVAR(IVAR,3).OR.I1.GT.MSVAR(IVAR,4))) &IERR=2 IF(NINDX.GE.2.AND.(I2.LT.MSVAR(IVAR,5).OR.I2.GT.MSVAR(IVAR,6))) &IERR=3 IF(NINDX.EQ.3.AND.(I3.LT.MSVAR(IVAR,7).OR.I3.GT.MSVAR(IVAR,8))) &IERR=4 IF(CHBIT(LNAM:LNAM).NE.'=') IERR=5 IF(IERR.GE.1) THEN CALL LUERRM(18,'(LUGIVE:) unallowed indices for '// & CHBIT(1:LNAM-1)) LLOW=LHIG IF(LLOW.LT.LTOT) GOTO 120 RETURN ENDIF C...Save old value of variable. IF(IVAR.EQ.1) THEN IOLD=N ELSEIF(IVAR.EQ.2) THEN IOLD=K(I1,I2) ELSEIF(IVAR.EQ.3) THEN ROLD=P(I1,I2) ELSEIF(IVAR.EQ.4) THEN ROLD=V(I1,I2) ELSEIF(IVAR.EQ.5) THEN IOLD=MSTU(I1) ELSEIF(IVAR.EQ.6) THEN ROLD=PARU(I1) ELSEIF(IVAR.EQ.7) THEN IOLD=MSTJ(I1) ELSEIF(IVAR.EQ.8) THEN ROLD=PARJ(I1) ELSEIF(IVAR.EQ.9) THEN IOLD=KCHG(I1,I2) ELSEIF(IVAR.EQ.10) THEN ROLD=PMAS(I1,I2) ELSEIF(IVAR.EQ.11) THEN ROLD=PARF(I1) ELSEIF(IVAR.EQ.12) THEN ROLD=VCKM(I1,I2) ELSEIF(IVAR.EQ.13) THEN IOLD=MDCY(I1,I2) ELSEIF(IVAR.EQ.14) THEN IOLD=MDME(I1,I2) ELSEIF(IVAR.EQ.15) THEN ROLD=BRAT(I1) ELSEIF(IVAR.EQ.16) THEN IOLD=KFDP(I1,I2) ELSEIF(IVAR.EQ.17) THEN CHOLD=CHAF(I1) ELSEIF(IVAR.EQ.18) THEN IOLD=MRLU(I1) ELSEIF(IVAR.EQ.19) THEN ROLD=RRLU(I1) ELSEIF(IVAR.EQ.20) THEN IOLD=MSEL ELSEIF(IVAR.EQ.21) THEN IOLD=MSUB(I1) ELSEIF(IVAR.EQ.22) THEN IOLD=KFIN(I1,I2) ELSEIF(IVAR.EQ.23) THEN ROLD=CKIN(I1) ELSEIF(IVAR.EQ.24) THEN IOLD=MSTP(I1) ELSEIF(IVAR.EQ.25) THEN ROLD=PARP(I1) ELSEIF(IVAR.EQ.26) THEN IOLD=MSTI(I1) ELSEIF(IVAR.EQ.27) THEN ROLD=PARI(I1) ELSEIF(IVAR.EQ.28) THEN IOLD=MINT(I1) ELSEIF(IVAR.EQ.29) THEN ROLD=VINT(I1) ELSEIF(IVAR.EQ.30) THEN IOLD=ISET(I1) ELSEIF(IVAR.EQ.31) THEN IOLD=KFPR(I1,I2) ELSEIF(IVAR.EQ.32) THEN ROLD=COEF(I1,I2) ELSEIF(IVAR.EQ.33) THEN IOLD=ICOL(I1,I2,I3) ELSEIF(IVAR.EQ.34) THEN ROLD=XSFX(I1,I2) ELSEIF(IVAR.EQ.35) THEN IOLD=ISIG(I1,I2) ELSEIF(IVAR.EQ.36) THEN ROLD=SIGH(I1) ELSEIF(IVAR.EQ.37) THEN ROLD=WIDP(I1,I2) ELSEIF(IVAR.EQ.38) THEN ROLD=WIDE(I1,I2) ELSEIF(IVAR.EQ.39) THEN ROLD=WIDS(I1,I2) ELSEIF(IVAR.EQ.40) THEN IOLD=NGEN(I1,I2) ELSEIF(IVAR.EQ.41) THEN ROLD=XSEC(I1,I2) ELSEIF(IVAR.EQ.42) THEN CHOLD2=PROC(I1) ELSEIF(IVAR.EQ.43) THEN ROLD=SIGT(I1,I2,I3) ENDIF C...Print current value of variable. Loop back. IF(LNAM.GE.LBIT) THEN CHBIT(LNAM:14)=' ' CHBIT(15:60)=' has the value ' IF(MSVAR(IVAR,1).EQ.1) THEN WRITE(CHBIT(51:60),'(I10)') IOLD ELSEIF(MSVAR(IVAR,1).EQ.2) THEN WRITE(CHBIT(47:60),'(F14.5)') ROLD ELSEIF(MSVAR(IVAR,1).EQ.3) THEN CHBIT(53:60)=CHOLD ELSE CHBIT(33:60)=CHOLD ENDIF IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) LLOW=LHIG IF(LLOW.LT.LTOT) GOTO 120 RETURN ENDIF C...Read in new variable value. IF(MSVAR(IVAR,1).EQ.1) THEN CHINI=' ' CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT) READ(CHINI,'(I10)') INEW ELSEIF(MSVAR(IVAR,1).EQ.2) THEN CHINR=' ' CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT) READ(CHINR,'(F16.2)') RNEW ELSEIF(MSVAR(IVAR,1).EQ.3) THEN CHNEW=CHBIT(LNAM+1:LBIT)//' ' ELSE CHNEW2=CHBIT(LNAM+1:LBIT)//' ' ENDIF C...Store new variable value. IF(IVAR.EQ.1) THEN N=INEW ELSEIF(IVAR.EQ.2) THEN K(I1,I2)=INEW ELSEIF(IVAR.EQ.3) THEN P(I1,I2)=RNEW ELSEIF(IVAR.EQ.4) THEN V(I1,I2)=RNEW ELSEIF(IVAR.EQ.5) THEN MSTU(I1)=INEW ELSEIF(IVAR.EQ.6) THEN PARU(I1)=RNEW ELSEIF(IVAR.EQ.7) THEN MSTJ(I1)=INEW ELSEIF(IVAR.EQ.8) THEN PARJ(I1)=RNEW ELSEIF(IVAR.EQ.9) THEN KCHG(I1,I2)=INEW ELSEIF(IVAR.EQ.10) THEN PMAS(I1,I2)=RNEW ELSEIF(IVAR.EQ.11) THEN PARF(I1)=RNEW ELSEIF(IVAR.EQ.12) THEN VCKM(I1,I2)=RNEW ELSEIF(IVAR.EQ.13) THEN MDCY(I1,I2)=INEW ELSEIF(IVAR.EQ.14) THEN MDME(I1,I2)=INEW ELSEIF(IVAR.EQ.15) THEN BRAT(I1)=RNEW ELSEIF(IVAR.EQ.16) THEN KFDP(I1,I2)=INEW ELSEIF(IVAR.EQ.17) THEN CHAF(I1)=CHNEW ELSEIF(IVAR.EQ.18) THEN MRLU(I1)=INEW ELSEIF(IVAR.EQ.19) THEN RRLU(I1)=RNEW ELSEIF(IVAR.EQ.20) THEN MSEL=INEW ELSEIF(IVAR.EQ.21) THEN MSUB(I1)=INEW ELSEIF(IVAR.EQ.22) THEN KFIN(I1,I2)=INEW ELSEIF(IVAR.EQ.23) THEN CKIN(I1)=RNEW ELSEIF(IVAR.EQ.24) THEN MSTP(I1)=INEW ELSEIF(IVAR.EQ.25) THEN PARP(I1)=RNEW ELSEIF(IVAR.EQ.26) THEN MSTI(I1)=INEW ELSEIF(IVAR.EQ.27) THEN PARI(I1)=RNEW ELSEIF(IVAR.EQ.28) THEN MINT(I1)=INEW ELSEIF(IVAR.EQ.29) THEN VINT(I1)=RNEW ELSEIF(IVAR.EQ.30) THEN ISET(I1)=INEW ELSEIF(IVAR.EQ.31) THEN KFPR(I1,I2)=INEW ELSEIF(IVAR.EQ.32) THEN COEF(I1,I2)=RNEW ELSEIF(IVAR.EQ.33) THEN ICOL(I1,I2,I3)=INEW ELSEIF(IVAR.EQ.34) THEN XSFX(I1,I2)=RNEW ELSEIF(IVAR.EQ.35) THEN ISIG(I1,I2)=INEW ELSEIF(IVAR.EQ.36) THEN SIGH(I1)=RNEW ELSEIF(IVAR.EQ.37) THEN WIDP(I1,I2)=RNEW ELSEIF(IVAR.EQ.38) THEN WIDE(I1,I2)=RNEW ELSEIF(IVAR.EQ.39) THEN WIDS(I1,I2)=RNEW ELSEIF(IVAR.EQ.40) THEN NGEN(I1,I2)=INEW ELSEIF(IVAR.EQ.41) THEN XSEC(I1,I2)=RNEW ELSEIF(IVAR.EQ.42) THEN PROC(I1)=CHNEW2 ELSEIF(IVAR.EQ.43) THEN SIGT(I1,I2,I3)=RNEW ENDIF C...Write old and new value. Loop back. CHBIT(LNAM:14)=' ' CHBIT(15:60)=' changed from to ' IF(MSVAR(IVAR,1).EQ.1) THEN WRITE(CHBIT(33:42),'(I10)') IOLD WRITE(CHBIT(51:60),'(I10)') INEW IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) ELSEIF(MSVAR(IVAR,1).EQ.2) THEN WRITE(CHBIT(29:42),'(F14.5)') ROLD WRITE(CHBIT(47:60),'(F14.5)') RNEW IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) ELSEIF(MSVAR(IVAR,1).EQ.3) THEN CHBIT(35:42)=CHOLD CHBIT(53:60)=CHNEW IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) ELSE CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2 IF(MSTU(13).GE.1) WRITE(MSTU(11),5100) CHBIT(1:88) ENDIF LLOW=LHIG IF(LLOW.LT.LTOT) GOTO 120 C...Format statement for output on unit MSTU(11) (by default 6). 5000 FORMAT(5X,A60) 5100 FORMAT(5X,A88) RETURN END C********************************************************************* SUBROUTINE LUEXEC C...Purpose: to administrate the fragmentation and decay chain. COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ DIMENSION PS(2,6) C...Initialize and reset. MSTU(24)=0 IF(MSTU(12).GE.1) CALL LULIST(0) MSTU(31)=MSTU(31)+1 MSTU(1)=0 MSTU(2)=0 MSTU(3)=0 IF(MSTU(17).LE.0) MSTU(90)=0 MCONS=1 C...Sum up momentum, energy and charge for starting entries. NSAV=N DO 110 I=1,2 DO 100 J=1,6 PS(I,J)=0. 100 CONTINUE 110 CONTINUE DO 130 I=1,N IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 130 DO 120 J=1,4 PS(1,J)=PS(1,J)+P(I,J) 120 CONTINUE PS(1,6)=PS(1,6)+LUCHGE(K(I,2)) 130 CONTINUE PARU(21)=PS(1,4) C...Prepare system for subsequent fragmentation/decay. CALL LUPREP(0) C...Loop through jet fragmentation and particle decays. MBE=0 140 MBE=MBE+1 IP=0 150 IP=IP+1 KC=0 IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=LUCOMP(K(IP,2)) IF(KC.EQ.0) THEN C...Particle decay if unstable and allowed. Save long-lived particle C...decays until second pass after Bose-Einstein effects. ELSEIF(KCHG(KC,2).EQ.0) THEN IF(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1.AND.(MSTJ(51).LE.0.OR.MBE & .EQ.2.OR.PMAS(KC,2).GE.PARJ(91).OR.IABS(K(IP,2)).EQ.311)) & CALL LUDECY(IP) C...Decay products may develop a shower. IF(MSTJ(92).GT.0) THEN IP1=MSTJ(92) QMAX=SQRT(MAX(0.,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1, & 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2)) CALL LUSHOW(IP1,IP1+1,QMAX) CALL LUPREP(IP1) MSTJ(92)=0 ELSEIF(MSTJ(92).LT.0) THEN IP1=-MSTJ(92) CALL LUSHOW(IP1,-3,P(IP,5)) CALL LUPREP(IP1) MSTJ(92)=0 ENDIF C...Jet fragmentation: string or independent fragmentation. ELSEIF(K(IP,1).EQ.1.OR.K(IP,1).EQ.2) THEN MFRAG=MSTJ(1) IF(MFRAG.GE.1.AND.K(IP,1).EQ.1) MFRAG=2 IF(MSTJ(21).GE.2.AND.K(IP,1).EQ.2.AND.N.GT.IP) THEN IF(K(IP+1,1).EQ.1.AND.K(IP+1,3).EQ.K(IP,3).AND. & K(IP,3).GT.0.AND.K(IP,3).LT.IP) THEN IF(KCHG(LUCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG) ENDIF ENDIF IF(MFRAG.EQ.1) CALL LUSTRF(IP) IF(MFRAG.EQ.2) CALL LUINDF(IP) IF(MFRAG.EQ.2.AND.K(IP,1).EQ.1) MCONS=0 IF(MFRAG.EQ.2.AND.(MSTJ(3).LE.0.OR.MOD(MSTJ(3),5).EQ.0)) MCONS=0 ENDIF C...Loop back if enough space left in LUJETS and no error abort. IF(MSTU(24).NE.0.AND.MSTU(21).GE.2) THEN ELSEIF(IP.LT.N.AND.N.LT.MSTU(4)-20-MSTU(32)) THEN GOTO 150 ELSEIF(IP.LT.N) THEN CALL LUERRM(11,'(LUEXEC:) no more memory left in LUJETS') ENDIF C...Include simple Bose-Einstein effect parametrization if desired. IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN CALL LUBOEI(NSAV) GOTO 140 ENDIF C...Check that momentum, energy and charge were conserved. DO 170 I=1,N IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170 DO 160 J=1,4 PS(2,J)=PS(2,J)+P(I,J) 160 CONTINUE PS(2,6)=PS(2,6)+LUCHGE(K(I,2)) 170 CONTINUE PDEV=(ABS(PS(2,1)-PS(1,1))+ABS(PS(2,2)-PS(1,2))+ABS(PS(2,3)- &PS(1,3))+ABS(PS(2,4)-PS(1,4)))/(1.+ABS(PS(2,4))+ABS(PS(1,4))) IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL LUERRM(15, &'(LUEXEC:) four-momentum was not conserved') IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1) CALL LUERRM(15, &'(LUEXEC:) charge was not conserved') RETURN END C********************************************************************* SUBROUTINE LUPREP(IP) C...Purpose: to rearrange partons along strings, to allow small systems C...to collapse into one or two particles and to check flavours. IMPLICIT DOUBLE PRECISION(D) COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ DIMENSION DPS(5),DPC(5),UE(3) C...Rearrange parton shower product listing along strings: begin loop. I1=N DO 130 MQGST=1,2 DO 120 I=MAX(1,IP),N IF(K(I,1).NE.3) GOTO 120 KC=LUCOMP(K(I,2)) IF(KC.EQ.0) GOTO 120 KQ=KCHG(KC,2) IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 120 C...Pick up loose string end. KCS=4 IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5 IA=I NSTP=0 100 NSTP=NSTP+1 IF(NSTP.GT.4*N) THEN CALL LUERRM(14,'(LUPREP:) caught in infinite loop') RETURN ENDIF C...Copy undecayed parton. IF(K(IA,1).EQ.3) THEN IF(I1.GE.MSTU(4)-MSTU(32)-5) THEN CALL LUERRM(11,'(LUPREP:) no more memory left in LUJETS') RETURN ENDIF I1=I1+1 K(I1,1)=2 IF(NSTP.GE.2.AND.IABS(K(IA,2)).NE.21) K(I1,1)=1 K(I1,2)=K(IA,2) K(I1,3)=IA K(I1,4)=0 K(I1,5)=0 DO 110 J=1,5 P(I1,J)=P(IA,J) V( O O O O O O O O O O O O O O nd invariant masses in parton systems. O O 320 NP=0 I O KFN=0 O KQS=0  O DO 330 J=1,5 L O DPS(J)=0.  O 330 CONTINUE P O DO 360 I=MAX(1,IP),N ./ O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360 F O KC=LUCOMP(K(I,2))  O IF(KC.EQ.0) GOTO 360 F$ O KQ=KCHG(KC,2)*ISIGN(1,K(I,2))  O IF(KQ.EQ.0) GOTO 360 ) O NP=NP+1  O IF(KQ.NE.2) THEN E O KFN=KFN+1  O KQS=KQS+KQ E O MSTJ(93)=1 .% O DPS(5)=DPS(5)+ULMASS(K(I,2)) O ENDIF  O DO 340 J=1,4  O DPS(J)=DPS(J)+P(I,J) L O 340 CONTINUE T O IF(K(I,1).EQ.1) THEN W@ O IF(NP.NE.1.AND.(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0)) CALL = O & LUERRM(2,'(LUPREP:) unphysical flavour combination') C O IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT. I1 O & (0.9*PARJ(32)+DPS(5))**2) CALL LUERRM(3, E2 O & '(LUPREP:) too small mass in jet system') NP=0 . O KFN=0  O KQS=0  O DO 350 J=1,5 I O DPS(J)=0.  O 350 CONTINUE N O ENDIF  O 360 CONTINUE T O RETURN I O END  O G O C********************************************************************* A O Q O SUBROUTINE LUSTRF(IP) H O C...Purpose: to handle the fragmentation of an arbitrary colour singlet A O C...jet system according to the Lund string fragmentation model. (# O IMPLICIT DOUBLE PRECISION(D) c4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) M& O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ E O DIMENSION DPS(5),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2), 9C O &IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(3),PJU(5,5), O A O &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8)  O E+ O C...Function: four-product of two vectors. 5H O FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3) B O DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)-  O &DP(I,3)*DP(J,3)  O t, O C...Reset counters. Identify parton system.  O MSTJ(91)=0 T NSAV=N  O MSTU90=MSTU(90) O NP=0 O O KQSUM=0  O DO 100 J=1,5 s O DPS(J)=0D0  O 100 CONTINUE ( O MJU(1)=0 O  O MJU(2)=0 6 I=IP-1 M O 110 I=I+1 , O IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN E O CALL LUERRM(12,'(LUSTRF:) failed to reconstruct jet system') ! O IF(MSTU(21).GE.1) RETURN s O ENDIF @ O IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110  O KC=LUCOMP(K(I,2))  O IF(KC.EQ.0) GOTO 110 2$ O KQ=KCHG(KC,2)*ISIGN(1,K(I,2))  O IF(KQ.EQ.0) GOTO 110 ,/ O IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN LB O CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS') ! O IF(MSTU(21).GE.1) RETURN / O ENDIF  O O> O C...Take copy of partons to be considered. Check flavour sum.  O NP=NP+1  O DO 120 J=1,5 ) O K(N+NP,J)=K(I,J) 1 O P(N+NP,J)=P(I,J) & O IF(J.NE.4) DPS(J)=DPS(J)+P(I,J)  O 120 CONTINUE : O DPS(4)=DPS(4)+SQRT(DBLE(P(I,1))**2+DBLE(P(I,2))**2+ ' O &DBLE(P(I,3))**2+DBLE(P(I,5))**2)  O K(N+NP,3)=I ! O IF(KQ.NE.2) KQSUM=KQSUM+KQ O  O IF(K(I,1).EQ.41) THEN  O KQSUM=KQSUM+2*KQ $ O IF(KQSUM.EQ.KQ) MJU(1)=N+NP $ O IF(KQSUM.NE.KQ) MJU(2)=N+NP O ENDIF / O IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110 c O IF(KQSUM.NE.0) THEN C O CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination') p! O IF(MSTU(21).GE.1) RETURN t O ENDIF  O F O C...Boost copied system to CM frame (for better numerical precision). , O IF(ABS(DPS(3)).LT.0.99D0*DPS(4)) THEN  O MBST=0 P O MSTU(33)=1 O B O CALL LUDBRB(N+1,N+NP,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4),  O & -DPS(3)/DPS(4)) O ELSE c O MBST=1 dC O HHBZ=SQRT(MAX(1D-6,DPS(4)+DPS(3))/MAX(1D-6,DPS(4)-DPS(3))) t O DO 130 I=N+1,N+NP , O HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2  O IF(P(I,3).GT.0.) THEN % O HHPEZ=(P(I,4)+P(I,3))/HHBZ &) O P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ) () O P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) O ELSE r% O HHPEZ=(P(I,4)-P(I,3))*HHBZ * O P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ) ) O P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) ) O ENDIF  O 130 CONTINUE y O ENDIF  O 2; O C...Search for very nearby partons that may be recombined.  O NTRYR=0  O PARU12=PARU(12)  O PARU13=PARU(13)  O MJU(3)=MJU(1)  O MJU(4)=MJU(2) O NR=NP  O 140 IF(NR.GE.3) THEN 2 O PDRMIN=2.*PARU12 P O DO 150 I=N+1,N+NR 8 O IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 150  O I1=I+1 e O IF(I.EQ.N+NR) I1=N+1 f3 O IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 150 EA O IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21) 1 O & GOTO 150 H O IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21) GOTO 150 > O PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+ O & P(I1,2)**2+P(I1,3)**2)) 9 O PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3) ,A O PDR=4.*(PAP-PVP)**2/MAX(1E-6,PARU13**2*PAP+2.*(PAP-PVP)) C O IF(PDR.LT.PDRMIN) THEN G O IR=I F O PDRMIN=PDR G O ENDIF  O 150 CONTINUE  O G O C...Recombine very nearby partons to avoid machine precision problems. 1 O IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN  O DO 160 J=1,4 .& O P(N+1,J)=P(N+1,J)+P(N+NR,J)  O 160 CONTINUE LD O P(N+1,5)=SQRT(MAX(0.,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2-  O & P(N+1,3)**2))  O NR=NR-1  O GOTO 140 m& O ELSEIF(PDRMIN.LT.PARU12) THEN  O DO 170 J=1,4 e$ O P(IR,J)=P(IR,J)+P(IR+1,J)  O 170 CONTINUE F@ O P(IR,5)=SQRT(MAX(0.,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2-  O & P(IR,3)**2)) N O DO 190 I=IR+1,N+NR-1 , O K(I,2)=K(I+1,2)  O DO 180 J=1,5 1 O P(I,J)=P(I+1,J)  O 180 CONTINUE 1 O 190 CONTINUE 1- O IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2) T O NR=NR-1 + O IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1 O + O IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1 P O GOTO 140 P O ENDIF O ENDIF  O NTRYR=NTRYR+1  O +D O C...Reset particle counter. Skip ahead if no junctions are present;  O C...this is usually the case!  O NRS=MAX(5*NR+11,NP) NTRY=0 E O 200 NTRY=NTRY+1 * O IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN  O PARU12=4.*PARU12 s O PARU13=2.*PARU13  O GOTO 140 * O ELSEIF(NTRY.GT.100) THEN *< O CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') ! O IF(MSTU(21).GE.1) RETURN a O ENDIF  O I=N+NRS  O MSTU(90)=MSTU90 / O IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 580 e O DO 570 JT=1,2  O NJS(JT)=0 O IF(MJU(JT).EQ.0) GOTO 570  O JS=3-2*JT  O ,I O C...Find and sum up momentum on three sides of junction. Check flavours.  O DO 220 IU=1,3  O IJU(IU)=0  O DO 210 J=1,5 ) O PJU(IU,J)=0. T O 210 CONTINUE E O 220 CONTINUE 0 O IU=0 )8 O DO 240 I1=N+1+(JT-1)*(NR-1),N+NR+(JT-1)*(1-NR),JS ) O IF(K(I1,2).NE.21.AND.IU.LE.2) THEN e O IU=IU+1  O IJU(IU)=I1 l O ENDIF  O DO 230 J=1,4 1" O PJU(IU,J)=PJU(IU,J)+P(I1,J)  O 230 CONTINUE I O 240 CONTINUE K O DO 250 IU=1,3 = O PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)  O 250 CONTINUE < O IF(K(IJU(3),2)/100.NE.10*K(IJU(1),2)+K(IJU(2),2).AND. : O &K(IJU(3),2)/100.NE.10*K(IJU(2),2)+K(IJU(1),2)) THEN C O CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination') T! O IF(MSTU(21).GE.1) RETURN O O ENDIF  O R= O C...Calculate (approximate) boost to rest frame of junction. C O T12=(PJU(1,1)*PJU(2,1)+PJU(1,2)*PJU(2,2)+PJU(1,3)*PJU(2,3))/ T O &(PJU(1,5)*PJU(2,5)) C O T13=(PJU(1,1)*PJU(3,1)+PJU(1,2)*PJU(3,2)+PJU(1,3)*PJU(3,3))/ o O &(PJU(1,5)*PJU(3,5)) C O T23=(PJU(2,1)*PJU(3,1)+PJU(2,2)*PJU(3,2)+PJU(2,3)*PJU(3,3))/  O &(PJU(2,5)*PJU(3,5)) 3 O T11=SQRT((2./3.)*(1.-T12)*(1.-T13)/(1.-T23)) O 3 O T22=SQRT((2./3.)*(1.-T12)*(1.-T23)/(1.-T13)) 1- O TSQ=SQRT((2.*T11*T22+T12-1.)*(1.+T12)) =) O T1F=(TSQ-T22*(1.+T12))/(1.-T12**2) ) O T2F=(TSQ-T11*(1.+T12))/(1.-T12**2)  O DO 260 J=1,3 )< O TJU(J)=-(T1F*PJU(1,J)/PJU(1,5)+T2F*PJU(2,J)/PJU(2,5))  O 260 CONTINUE B4 O TJU(4)=SQRT(1.+TJU(1)**2+TJU(2)**2+TJU(3)**2)  O DO 270 IU=1,3 D O PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)-  O &TJU(3)*PJU(IU,3) 2 O 270 CONTINUE 0 O O ? O C...Put junction at rest if motion could give inconsistencies. S6 O IF(PJU(1,5)+PJU(2,5).GT.PJU(1,4)+PJU(2,4)) THEN  O DO 280 J=1,3 ( O TJU(J)=0.  O 280 CONTINUE S O TJU(4)=1.  O PJU(1,5)=PJU(1,4)  O PJU(2,5)=PJU(2,4)  O PJU(3,5)=PJU(3,4) O ENDIF  O oD O C...Start preparing for fragmentation of two strings from junction. ISTA=I T O DO 550 IU=1,2  O NS=IJU(IU+1)-IJU(IU) & O U; O C...Junction strings: find longitudinal string directions.  O DO 310 IS=1,NS ) O IS1=IJU(IU)+IS-1 S O IS2=IJU(IU)+IS ( O DO 290 J=1,5 O  O DP(1,J)=0.5*P(IS1,J) E# O IF(IS.EQ.1) DP(1,J)=P(IS1,J) I O DP(2,J)=0.5*P(IS2,J) K& O IF(IS.EQ.NS) DP(2,J)=-PJU(IU,J)  O 290 CONTINUE IH O IF(IS.EQ.NS) DP(2,4)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)  O IF(IS.EQ.NS) DP(2,5)=0.  O DP(3,5)=DFOUR(1,1) 1 O DP(4,5)=DFOUR(2,2) c O DHKC=DFOUR(1,2) - O IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN Q7 O DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) =7 O DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) O  O DP(3,5)=0D0  O DP(4,5)=0D0  O DHKC=DFOUR(1,2) O ENDIF ) O DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) ( O DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.) ( O DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.)  O IN1=N+NR+4*IS-3 - O P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5))  O DO 300 J=1,4 4. O P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J) 0 O P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J)  O 300 CONTINUE  O 310 CONTINUE J O 4E O C...Junction strings: initialize flavour, momentum and starting pos. ) ISAV=I P O MSTU91=MSTU(90)  O 320 NTRY=NTRY+1 * O IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN  O PARU12=4.*PARU12 F O PARU13=2.*PARU13  O GOTO 140  O ELSEIF(NTRY.GT.100) THEN )< O CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') ! O IF(MSTU(21).GE.1) RETURN 0 O ENDIF I=ISAV N O MSTU(90)=MSTU91  O IRANKJ=0 O # O IE(1)=K(N+1+(JT/2)*(NP-1),3) O  O IN(4)=N+NR+1 s O IN(5)=IN(4)+1  O IN(6)=N+NR+4*NS+1  O DO 340 JQ=1,2 , O DO 330 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4  O P(IN1,1)=2-JQ  O P(IN1,2)=JQ-1  O P(IN1,3)=1.  O 330 CONTINUE  O 340 CONTINUE  O KFL(1)=K(IJU(IU),2)  O PX(1)=0. O  O PY(1)=0. C O GAM(1)=0.  O DO 350 J=1,5 + O PJU(IU+3,J)=0. m O 350 CONTINUE o O l: O C...Junction strings: find initial transverse directions.  O DO 360 J=1,4 1 O DP(1,J)=P(IN(4),J)  O DP(2,J)=P(IN(4)+1,J)  O DP(3,J)=0. N O DP(4,J)=0. O  O 360 CONTINUE I5 O DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) ,5 O DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) (. O DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) . O DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) . O DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) 9 O IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. 9 O IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. 29 O IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. ,9 O IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. O  O DHC12=DFOUR(1,2) O O DHCX1=DFOUR(3,1)/DHC12  O DHCX2=DFOUR(3,2)/DHC12 ,0 O DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)  O DHCY1=DFOUR(4,1)/DHC12 ) O DHCY2=DFOUR(4,2)/DHC12 K2 O DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 9 O DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) G O DO 370 J=1,4 : O DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))  O P(IN(6),J)=DP(3,J) +? O P(IN(6)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- 2 O &DHCYX*DP(3,J)) E O 370 CONTINUE O  O O 4 O C...Junction strings: produce new particle, origin. O 380 I=I+1 . O IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN B O CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS') ! O IF(MSTU(21).GE.1) RETURN 3 O ENDIF  O IRANKJ=IRANKJ+1  O K(I,1)=1  O K(I,3)=IE(1) 2 O K(I,4)=0  O K(I,5)=0 - O 3A O C...Junction strings: generate flavour, hadron, pT, z and Gamma. * O 390 CALL LUKFDI(KFL(1),0,KFL(3),K(I,2))  O IF(K(I,2).EQ.0) GOTO 320 *C O IF(MSTJ(12).GE.3.AND.IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND.  O &IABS(KFL(3)).GT.10) THEN (( O IF(RLU(0).GT.PARJ(19)) GOTO 390 O ENDIF  O P(I,5)=ULMASS(K(I,2)) & O CALL LUPTDI(KFL(1),PX(3),PY(3)) 8 O PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2 ) O CALL LUZDIS(KFL(1),KFL(3),PR(1),Z) )6 O IF(IABS(KFL(1)).GE.4.AND.IABS(KFL(1)).LE.8.AND.  O &MSTU(90).LT.8) THEN  O MSTU(90)=MSTU(90)+1  O MSTU(90+MSTU(90))=I  O PARU(90+MSTU(90))=Z O ENDIF % O GAM(3)=(1.-Z)*(GAM(1)+PR(1)/Z)  O DO 400 J=1,3 D O IN(J)=IN(3+J)  O 400 CONTINUE  O &H O C...Junction strings: stepping within or from 'low' string region easy. ; O IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* # O &P(IN(1),5)**2.GE.PR(1)) THEN /$ O P(IN(1)+2,4)=Z*P(IN(1)+2,3) 8 O P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2)  O DO 410 J=1,4 PC O P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J)  O 410 CONTINUE  O GOTO 500 I$ O ELSEIF(IN(1)+1.EQ.IN(2)) THEN " O P(IN(2)+2,4)=P(IN(2)+2,3)  O P(IN(2)+2,1)=1.  O IN(2)=IN(2)+4 ( O IF(IN(2).GT.N+NR+4*NS) GOTO 320 + O IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN i$ O P(IN(1)+2,4)=P(IN(1)+2,3)  O P(IN(1)+2,1)=0.  O IN(1)=IN(1)+4  O ENDIF O ENDIF  O E6 O C...Junction strings: find new transverse directions. 6 O 420 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR.  O &IN(1).GT.IN(2)) GOTO 320 O 0 O IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN  O DO 430 J=1,4 K O DP(1,J)=P(IN(1),J)  O DP(2,J)=P(IN(2),J) O  O DP(3,J)=0. a O DP(4,J)=0.  O 430 CONTINUE s7 O DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) O7 O DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) 2 O DHC12=DFOUR(1,2) F O IF(DHC12.LE.1E-2) THEN I$ O P(IN(1)+2,4)=P(IN(1)+2,3)  O P(IN(1)+2,1)=0.  O IN(1)=IN(1)+4  O GOTO 420 ) O ENDIF  O IN(3)=N+NR+4*NS+5 0 O DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) 0 O DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) 0 O DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) ; O IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. -; O IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. ,; O IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. ; O IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. O  O DHCX1=DFOUR(3,1)/DHC12  O DHCX2=DFOUR(3,2)/DHC12 r2 O DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)  O DHCY1=DFOUR(4,1)/DHC12 P O DHCY2=DFOUR(4,2)/DHC12 )4 O DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 ; O DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) ) O DO 440 J=1,4 < O DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))  O P(IN(3),J)=DP(3,J) (A O P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- D O & DHCYX*DP(3,J)) V O 440 CONTINUE (6 O C...Express pT with respect to new axes, if sensible. A O PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3))) LE O PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1)) N> O IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN  O PX(3)=PXP  O PY(3)=PYP  O ENDIF O ENDIF  O IG O C...Junction strings: sum up known four-momentum, coefficients for m2. ) O DO 470 J=1,4  O DHG(J)=0. C O P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+ L O &PY(3)*P(IN(3)+1,J) +! O DO 450 IN1=IN(4),IN(1)-4,4 N( O P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)  O 450 CONTINUE -! O DO 460 IN2=IN(5),IN(2)-4,4 c( O P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)  O 460 CONTINUE  O 470 CONTINUE = O DHM(1)=FOUR(I,I) O O DHM(2)=2.*FOUR(I,IN(1))  O DHM(3)=2.*FOUR(I,IN(2)) " O DHM(4)=2.*FOUR(IN(1),IN(2))  O .> O C...Junction strings: find coefficients for Gamma expression. ! O DO 490 IN2=IN(1)+1,IN(2),4 2 O DO 480 IN1=IN(1),IN2-1,4 Q O DHC=2.*FOUR(IN1,IN2) . O DHG(1)=DHG(1)+P(IN1+2,1)*P(IN2+2,1)*DHC 4 O IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-P(IN2+2,1)*DHC 4 O IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+P(IN1+2,1)*DHC : O IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC  O 480 CONTINUE Q O 490 CONTINUE  O FF O C...Junction strings: solve (m2, Gamma) equation system for energies. ' O DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3) n% O IF(ABS(DHS1).LT.1E-4) GOTO 320 D8 O DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(2)*DHG(3)-DHG(4)* ' O &(P(I,5)**2-DHM(1))+DHG(2)*DHM(3) U< O DHS3=DHM(2)*(GAM(3)-DHG(1))-DHG(2)*(P(I,5)**2-DHM(1)) G O P(IN(2)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)- 5 O &DHS2/DHS1) 4 O IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0.) GOTO 320 ; O P(IN(1)+2,4)=(P(I,5)**2-DHM(1)-DHM(3)*P(IN(2)+2,4))/ *# O &(DHM(2)+DHM(4)*P(IN(2)+2,4)) U O E7 O C...Junction strings: step to new region if necessary. , O IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN " O P(IN(2)+2,4)=P(IN(2)+2,3)  O P(IN(2)+2,1)=1.  O IN(2)=IN(2)+4 ( O IF(IN(2).GT.N+NR+4*NS) GOTO 320 + O IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN ,$ O P(IN(1)+2,4)=P(IN(1)+2,3)  O P(IN(1)+2,1)=0.  O IN(1)=IN(1)+4  O ENDIF  O GOTO 420 /0 O ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN " O P(IN(1)+2,4)=P(IN(1)+2,3)  O P(IN(1)+2,1)=0.  O IN(1)=IN(1)+JS ( O GOTO 820 O ENDIF  O ND O C...Junction strings: particle four-momentum, remainder, loop back.  O 500 DO 510 J=1,4 .D O P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) % O PJU(IU+3,J)=PJU(IU+3,J)+P(I,J) ) O 510 CONTINUE D$ O IF(P(I,4).LT.P(I,5)) GOTO 320 9 O PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)- , O &TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3) ( O IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN  O KFL(1)=-KFL(3) P O PX(1)=-PX(3) N O PY(1)=-PY(3) O  O GAM(1)=GAM(3) O IF(IN(3).NE.IN(6)) THEN  O DO 520 J=1,4 ) O P(IN(6),J)=P(IN(3),J) $ O P(IN(6)+1,J)=P(IN(3)+1,J)  O 520 CONTINUE M O ENDIF  O DO 530 JQ=1,2  O IN(3+JQ)=IN(JQ) 2 O P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) ; O P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4) * O 530 CONTINUE  O GOTO 380 O O ENDIF  O N> O C...Junction strings: save quantities left after each string. & O IF(IABS(KFL(1)).GT.10) GOTO 320 O I=I-1  O KFJH(IU)=KFL(1)  O DO 540 J=1,4 .' O PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J) C O 540 CONTINUE  O 550 CONTINUE O  O E O C...Junction strings: put together to new effective string endpoint.  O NJS(JT)=I-ISTA P# O KFJS(JT)=K(K(MJU(JT+2),3),2) 6 O KFLS=2*INT(RLU(0)+3.*PARJ(4)/(1.+3.*PARJ(4)))+1 $ O IF(KFJH(1).EQ.KFJH(2)) KFLS=3 ; O IF(ISTA.NE.I) KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)), ; O &IABS(KFJH(2)))+100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+  O &KFLS,KFJH(1))  O DO 560 J=1,4 S/ O PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J) I$ O PJS(JT+2,J)=PJU(4,J)+PJU(5,J)  O 560 CONTINUE .D O PJS(JT,5)=SQRT(MAX(0.,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2-  O &PJS(JT,3)**2)) T O 570 CONTINUE N O O B O C...Open versus closed strings. Choose breakup region for latter. + O 580 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN . O NS=MJU(2)-MJU(1)  O NB=MJU(1)-N  O ELSEIF(MJU(1).NE.0) THEN + O NS=N+NR-MJU(1) 4 O NB=MJU(1)-N  O ELSEIF(MJU(2).NE.0) THEN E O NS=MJU(2)-N NB=1 R( O ELSEIF(IABS(K(N+1,2)).NE.21) THEN  O NS=NR-1 NB=1 N O ELSE  O NS=NR+1  O W2SUM=0. O  O DO 590 IS=1,NR T6 O P(N+NR+IS,1)=0.5*FOUR(N+IS,N+IS+1-NR*(IS/NR)) ! O W2SUM=W2SUM+P(N+NR+IS,1)  O 590 CONTINUE ( O W2RAN=RLU(0)*W2SUM NB=0  O 600 NB=NB+1 ! O W2SUM=W2SUM-P(N+NR+NB,1) *1 O IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 600 H O ENDIF  O G O C...Find longitudinal string directions (i.e. lightlike four-vectors). r O DO 630 IS=1,NS r& O IS1=N+IS+NB-1-NR*((IS+NB-2)/NR) $ O IS2=N+IS+NB-NR*((IS+NB-1)/NR)  O DO 610 J=1,5 O  O DP(1,J)=P(IS1,J) 3 O IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5*DP(1,J) *2 O IF(IS1.EQ.MJU(1)) DP(1,J)=PJS(1,J)-PJS(3,J)  O DP(2,J)=P(IS2,J) .3 O IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5*DP(2,J) +2 O IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J)  O 610 CONTINUE  O DP(3,5)=DFOUR(1,1) . O DP(4,5)=DFOUR(2,2) . O DHKC=DFOUR(1,2) - O IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN D O DP(3,5)=DP(1,5)**2  O DP(4,5)=DP(2,5)**2 +B O DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2+DP(1,5)**2) B O DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2+DP(2,5)**2)  O DHKC=DFOUR(1,2) O ENDIF ) O DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) M( O DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.) ( O DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.)  O IN1=N+NR+4*IS-3 - O P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5)) p O DO 620 J=1,4 F. O P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J) 0 O P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J)  O 620 CONTINUE  O 630 CONTINUE  O @ O C...Begin initialization: sum up energy, set starting position. ISAV=I * O MSTU91=MSTU(90)  O 640 NTRY=NTRY+1 * O IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN  O PARU12=4.*PARU12  O PARU13=2.*PARU13 R O GOTO 140 O O ELSEIF(NTRY.GT.100) THEN M< O CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') ! O IF(MSTU(21).GE.1) RETURN 1 O ENDIF I=ISAV  O MSTU(90)=MSTU91  O DO 660 J=1,4 P O P(N+NRS,J)=0.  O DO 650 IS=1,NR T& O P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J)  O 650 CONTINUE  O 660 CONTINUE O  O DO 680 JT=1,2  O IRANK(JT)=0 ) O IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT) ) O IF(NS.GT.NR) IRANK(JT)=1 $ O IE(JT)=K(N+1+(JT/2)*(NP-1),3) ( O IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1)  O IN(3*JT+2)=IN(3*JT+1)+1 " O IN(3*JT+3)=N+NR+4*NS+2*JT-1 , O DO 670 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4  O P(IN1,1)=2-JT  O P(IN1,2)=JT-1  O P(IN1,3)=1.  O 670 CONTINUE 4 O 680 CONTINUE  O A9 O C...Initialize flavour and pT variables for open string. 1 O IF(NS.LT.NR) THEN  O PX(1)=0.  O PY(1)=0. lF O IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL LUPTDI(0,PX(1),PY(1))  O PX(2)=-PX(1)  O PY(2)=-PY(1) A O DO 690 JT=1,2  O KFL(JT)=K(IE(JT),2) * O IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT)  O MSTJ(93)=1 O O PMQ(JT)=ULMASS(KFL(JT))  O GAM(JT)=0. t O 690 CONTINUE . O O B O C...Closed string: random initial breakup flavour, pT and vertex. O ELSE TA O KFL(3)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) =+ O CALL LUKFDI(KFL(3),0,KFL(1),KDUMP)  O KFL(2)=-KFL(1) .6 O IF(IABS(KFL(1)).GT.10.AND.RLU(0).GT.0.5) THEN / O KFL(2)=-(KFL(1)+ISIGN(10000,KFL(1))) =( O ELSEIF(IABS(KFL(1)).GT.10) THEN / O KFL(1)=-(KFL(2)+ISIGN(10000,KFL(2))) 5 O ENDIF ( O CALL LUPTDI(KFL(1),PX(1),PY(1))  O PX(2)=-PX(1) U O PY(2)=-PY(1) 1( O PR3=MIN(25.,0.1*P(N+NR+1,5)**2) ) O 700 CALL LUZDIS(KFL(1),KFL(2),PR3,Z) " O ZR=PR3/(Z*P(N+NR+1,5)**2)  O IF(ZR.GE.1.) GOTO 700  O DO 710 JT=1,2  O MSTJ(93)=1 I O PMQ(JT)=ULMASS(KFL(JT))  O GAM(JT)=PR3*(1.-Z)/Z o# O IN1=N+NR+3+4*(JT/2)*(NS-1) U O P(IN1,JT)=1.-Z J O P(IN1,3-JT)=JT-1 *( O P(IN1,3)=(2-JT)*(1.-Z)+(JT-1)*Z  O P(IN1+1,JT)=ZR * O P(IN1+1,3-JT)=2-JT *, O P(IN1+1,3)=(2-JT)*(1.-ZR)+(JT-1)*ZR  O 710 CONTINUE 3 O ENDIF  O F O C...Find initial transverse directions (i.e. spacelike four-vectors).  O DO 750 JT=1,2 % O IF(JT.EQ.1.OR.NS.EQ.NR-1) THEN O  O IN1=IN(3*JT+1) 2 O IN3=IN(3*JT+3)  O DO 720 J=1,4 J O DP(1,J)=P(IN1,J) 6 O DP(2,J)=P(IN1+1,J) = O DP(3,J)=0. , O DP(4,J)=0. * O 720 CONTINUE 7 O DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) (7 O DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) m0 O DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/ (2,4) 0 O DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) 0 O DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) ; O IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. *; O IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. ; O IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. 8; O IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. v O DHC12=DFOUR(1,2) e O DHCX1=DFOUR(3,1)/DHC12 3 O DHCX2=DFOUR(3,2)/DHC12 F2 O DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)  O DHCY1=DFOUR(4,1)/DHC12 ) O DHCY2=DFOUR(4,2)/DHC12 24 O DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 ; O DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) * O DO 730 J=1,4 H< O DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))  O P(IN3,J)=DP(3,J) (? O P(IN3+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- 2 O & DHCYX*DP(3,J)) O  O 730 CONTINUE r O ELSE  O DO 740 J=1,4 . O P(IN3+2,J)=P(IN3,J)  O P(IN3+3,J)=P(IN3+1,J)  O 740 CONTINUE 3 O ENDIF  O 750 CONTINUE  O < O C...Remove energy used up in junction string fragmentation. " O IF(MJU(1)+MJU(2).GT.0) THEN  O DO 770 JT=1,2 " O IF(NJS(JT).EQ.0) GOTO 770  O DO 760 J=1,4 * O P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J)  O 760 CONTINUE F O 770 CONTINUE I O ENDIF  O O ( O C...Produce new particle: side, origin. O 780 I=I+1 . O IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN B O CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS') ! O IF(MSTU(21).GE.1) RETURN 0 O ENDIF  O JT=1.5+RLU(0) ( O IF(IABS(KFL(3-JT)).GT.10) JT=3-JT @ O IF(IABS(KFL(3-JT)).GE.4.AND.IABS(KFL(3-JT)).LE.8) JT=3-JT  O JR=3-JT  O JS=3-2*JT  O IRANK(JT)=IRANK(JT)+1  O K(I,1)=1 U O K(I,3)=IE(JT)  O K(I,4)=0 3 O K(I,5)=0  O % O C...Generate flavour, hadron and pT. + O 790 CALL LUKFDI(KFL(JT),0,KFL(3),K(I,2)) O  O IF(K(I,2).EQ.0) GOTO 640 AG O IF(MSTJ(12).GE.3.AND.IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND. O  O &IABS(KFL(3)).GT.10) THEN O ( O IF(RLU(0).GT.PARJ(19)) GOTO 790 O ENDIF  O P(I,5)=ULMASS(K(I,2)) ' O CALL LUPTDI(KFL(JT),PX(3),PY(3)) ; O PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2 N O ), O C...Final hadrons for small invariant mass.  O MSTJ(93)=1 O  O PMQ(3)=ULMASS(KFL(3))  O PARJST=PARJ(33) ( O IF(MSTJ(11).EQ.2) PARJST=PARJ(34) 0 O WMIN=PARJST+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3) ; O IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN=  O &WMIN-0.5*PARJ(36)*PMQ(3) C O WREM2=FOUR(N+NRS,N+NRS) ! O IF(WREM2.LT.0.10) GOTO 640 9 O IF(WREM2.LT.MAX(WMIN*(1.+(2.*RLU(0)-1.)*PARJ(37)), =+ O &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 940  O = O C...Choose z, which gives Gamma. Shift z for heavy flavours. K+ O CALL LUZDIS(KFL(JT),KFL(3),PR(JT),Z) I8 O IF(IABS(KFL(JT)).GE.4.AND.IABS(KFL(JT)).LE.8.AND.  O &MSTU(90).LT.8) THEN  O MSTU(90)=MSTU(90)+1  O MSTU(90+MSTU(90))=I  O PARU(90+MSTU(90))=Z O ENDIF  O KFL1A=IABS(KFL(1)) = O KFL2A=IABS(KFL(2)) O= O IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), -% O &MOD(KFL2A/1000,10)).GE.4) THEN O G O PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 oA O PW12=SQRT(MAX(0.,(WREM2-PR(1)-PR(2))**2-4.*PR(1)*PR(2))) : O Z=(WREM2+PR(JT)-PR(JR)+PW12*(2.*Z-1.))/(2.*WREM2) G O PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 L7 O IF((1.-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 940 B O ENDIF ' O GAM(3)=(1.-Z)*(GAM(JT)+PR(JT)/Z)  O DO 800 J=1,3 1 O IN(J)=IN(3*JT+J)  O 800 CONTINUE  O U6 O C...Stepping within or from 'low' string region easy. ; O IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* I$ O &P(IN(1),5)**2.GE.PR(JT)) THEN & O P(IN(JT)+2,4)=Z*P(IN(JT)+2,3) ; O P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2) W O DO 810 J=1,4 .E O P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J) n O 810 CONTINUE o O GOTO 900 $ O ELSEIF(IN(1)+1.EQ.IN(2)) THEN $ O P(IN(JR)+2,4)=P(IN(JR)+2,3)  O P(IN(JR)+2,JT)=1.  O IN(JR)=IN(JR)+4*JS =. O IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640 + O IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN 1& O P(IN(JT)+2,4)=P(IN(JT)+2,3)  O P(IN(JT)+2,JT)=0.  O IN(JT)=IN(JT)+4*JS + O ENDIF O ENDIF  O =D O C...Find new transverse directions (i.e. spacelike string vectors). D O 820 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR.  O &IN(1).GT.IN(2)) GOTO 640 : O IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN  O DO 830 J=1,4 + O DP(1,J)=P(IN(1),J) * O DP(2,J)=P(IN(2),J) ( O DP(3,J)=0. ( O DP(4,J)=0. O  O 830 CONTINUE 17 O DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) 57 O DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) 2 O DHC12=DFOUR(1,2) . O IF(DHC12.LE.1E-2) THEN & O P(IN(JT)+2,4)=P(IN(JT)+2,3)  O P(IN(JT)+2,JT)=0.  O IN(JT)=IN(JT)+4*JS * O GOTO 820 + O ENDIF  O IN(3)=N+NR+4*NS+5 0 O DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) 0 O DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) 0 O DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) ; O IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. ; O IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. 1; O IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. 4; O IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. E O DHCX1=DFOUR(3,1)/DHC12  O DHCX2=DFOUR(3,2)/DHC12 O 2 O DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)  O DHCY1=DFOUR(4,1)/DHC12 P O DHCY2=DFOUR(4,2)/DHC12 N4 O DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 ; O DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)  O DO 840 J=1,4 1< O DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))  O P(IN(3),J)=DP(3,J) NA O P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- O O & DHCYX*DP(3,J)) * O 840 CONTINUE (6 O C...Express pT with respect to new axes, if sensible. 2 O PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)* " O & FOUR(IN(3*JT+3)+1,IN(3))) 4 O PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)* $ O & FOUR(IN(3*JT+3)+1,IN(3)+1)) > O IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN  O PX(3)=PXP  O PY(3)=PYP  O ENDIF O ENDIF  O (F O C...Sum up known four-momentum. Gives coefficients for m2 expression.  O DO 870 J=1,4 M O DHG(J)=0. > O P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+ * O &PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J) , O DO 850 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS ( O P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)  O 850 CONTINUE L, O DO 860 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS ( O P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)  O 860 CONTINUE . O 870 CONTINUE  O DHM(1)=FOUR(I,I) 0 O DHM(2)=2.*FOUR(I,IN(1))  O DHM(3)=2.*FOUR(I,IN(2)) " O DHM(4)=2.*FOUR(IN(1),IN(2))  O ), O C...Find coefficients for Gamma expression. ! O DO 890 IN2=IN(1)+1,IN(2),4 ) O DO 880 IN1=IN(1),IN2-1,4  O DHC=2.*FOUR(IN1,IN2) *0 O DHG(1)=DHG(1)+P(IN1+2,JT)*P(IN2+2,JT)*DHC 8 O IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-JS*P(IN2+2,JT)*DHC 8 O IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+JS*P(IN1+2,JT)*DHC : O IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC  O 880 CONTINUE + O 890 CONTINUE - O U: O C...Solve (m2, Gamma) equation system for energies taken. - O DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1) (% O IF(ABS(DHS1).LT.1E-4) GOTO 640 -> O DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)* - O &(P(I,5)**2-DHM(1))+DHG(JT+1)*DHM(JR+1) sB O DHS3=DHM(JT+1)*(GAM(3)-DHG(1))-DHG(JT+1)*(P(I,5)**2-DHM(1)) H O P(IN(JR)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)-  O &DHS2/DHS1) 8 O IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0.) GOTO 640 @ O P(IN(JT)+2,4)=(P(I,5)**2-DHM(1)-DHM(JR+1)*P(IN(JR)+2,4))/ ' O &(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4))  O % O C...Step to new region if necessary. U. O IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN $ O P(IN(JR)+2,4)=P(IN(JR)+2,3)  O P(IN(JR)+2,JT)=1.  O IN(JR)=IN(JR)+4*JS ). O IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640 + O IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN & O P(IN(JT)+2,4)=P(IN(JT)+2,3)  O P(IN(JT)+2,JT)=0.  O IN(JT)=IN(JT)+4*JS 8 O ENDIF  O GOTO 820 O 2 O ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN $ O P(IN(JT)+2,4)=P(IN(JT)+2,3)  O P(IN(JT)+2,JT)=0.  O IN(JT)=IN(JT)+4*JS s O GOTO 820 n O ENDIF  O T@ O C...Four-momentum of particle. Remaining quantities. Loop back.  O 900 DO 910 J=1,4 nD O P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) # O P(N+NRS,J)=P(N+NRS,J)-P(I,J)  O 910 CONTINUE O $ O IF(P(I,4).LT.P(I,5)) GOTO 640  O KFL(JT)=-KFL(3)  O PMQ(JT)=PMQ(3) . O PX(JT)=-PX(3)  O PY(JT)=-PY(3)  O GAM(JT)=GAM(3) E# O IF(IN(3).NE.IN(3*JT+3)) THEN J O DO 920 J=1,4 +# O P(IN(3*JT+3),J)=P(IN(3),J) (' O P(IN(3*JT+3)+1,J)=P(IN(3)+1,J)  O 920 CONTINUE ) O ENDIF  O DO 930 JQ=1,2  O IN(3*JT+JQ)=IN(JQ) .0 O P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) > O P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4)  O 930 CONTINUE  O GOTO 780 O  O / O C...Final hadron: side, flavour, hadron, mass. O 940 I=I+1  O K(I,1)=1 - O K(I,3)=IE(JR)  O K(I,4)=0 ( O K(I,5)=0 .1 O CALL LUKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2))  O IF(K(I,2).EQ.0) GOTO 640 S O P(I,5)=ULMASS(K(I,2)) ; O PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 * O 2: O C...Final two hadrons: find common setup of four-vectors. O JQ=1 O D O IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT.P(IN(7),3)* ) O &P(IN(8),3)*FOUR(IN(7),IN(8))) JQ=2 ( O DHC12=FOUR(IN(3*JQ+1),IN(3*JQ+2)) ( O DHR1=FOUR(N+NRS,IN(3*JQ+2))/DHC12 ( O DHR2=FOUR(N+NRS,IN(3*JQ+1))/DHC12 0 O IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN 0 O PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ) 2 O PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ) A O PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS* O 2 O & PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2 O ENDIF  O +9 O C...Solve kinematics for final two hadrons, if possible. 4 O WREM2=WREM2+(PX(1)+PX(2))**2+(PY(1)+PY(2))**2 / O FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2) -C O IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1.) GOTO 200 ( O IF(FD.GE.1.) GOTO 640  O FA=WREM2+PR(JT)-PR(JR) A@ O IF(MSTJ(11).NE.2) PREV=0.5*EXP(MAX(-50.,LOG(FD)*PARJ(38)*  O &(PR(1)+PR(2))**2)) r. O IF(MSTJ(11).EQ.2) PREV=0.5*FD**PARJ(39) D O FB=SIGN(SQRT(MAX(0.,FA**2-4.*WREM2*PR(JT))),JS*(RLU(0)-PREV))  O KFL1A=IABS(KFL(1))  O KFL2A=IABS(KFL(2)) T= O IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), O ; O &MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0.,FA**2- # O &4.*WREM2*PR(JT))),FLOAT(JS)) 4 O DO 950 J=1,4 1> O P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))* ; O &P(IN(3*JQ+3)+1,J)+0.5*(DHR1*(FA+FB)*P(IN(3*JQ+1),J)+ P* O &DHR2*(FA-FB)*P(IN(3*JQ+2),J))/WREM2 ! O P(I,J)=P(N+NRS,J)-P(I-1,J) F O 950 CONTINUE (< O IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 640  O *8 O C...Mark jets as fragmented and give daughter pointers.  O N=I-NRS+1  O DO 960 I=NSAV+1,NSAV+NP  O IM=K(I,3)  O K(IM,1)=K(IM,1)+10 D O IF(MSTU(16).NE.2) THEN ( O K(IM,4)=NSAV+1 = O K(IM,5)=NSAV+1 O ELSE D O K(IM,4)=NSAV+2 H O K(IM,5)=N O ENDIF  O 960 CONTINUE 2 O C/ O C...Document string system. Move up particles. X O NSAV=NSAV+1  O K(NSAV,1)=11 O  O K(NSAV,2)=92 , O K(NSAV,3)=IP , O K(NSAV,4)=NSAV+1 P O K(NSAV,5)=N  O DO 970 J=1,4 J O P(NSAV,J)=DPS(J) O  O V(NSAV,J)=V(IP,J)  O 970 CONTINUE eG O P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) O  O V(NSAV,5)=0. 1 O DO 990 I=NSAV+1,N  O DO 980 J=1,5  O K(I,J)=K(I+NRS-1,J)  O P(I,J)=P(I+NRS-1,J)  O V(I,J)=0.  O 980 CONTINUE  O 990 CONTINUE 2 O MSTU91=MSTU(90) ! O DO 1000 IZ=MSTU90+1,MSTU91 n* O MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N  O PARU9T(IZ)=PARU(90+IZ) 0 O 1000 CONTINUE O  O MSTU(90)=MSTU90  O 3D O C...Order particles in rank along the chain. Update mother pointer.  O DO 1020 I=NSAV+1,N . O DO 1010 J=1,5  O K(I-NSAV+N,J)=K(I,J)  O P(I-NSAV+N,J)=P(I,J) U O 1010 CONTINUE  O 1020 CONTINUE F O I1=NSAV  O DO 1050 I=N+1,2*N-NSAV )$ O IF(K(I,3).NE.IE(1)) GOTO 1050  O I1=I1+1  O DO 1030 J=1,5  O K(I1,J)=K(I,J) 4 O P(I1,J)=P(I,J) A O 1030 CONTINUE 9% O IF(MSTU(16).NE.2) K(I1,3)=NSAV 0! O DO 1040 IZ=MSTU90+1,MSTU91 O  O IF(MSTU9T(IZ).EQ.I) THEN  O MSTU(90)=MSTU(90)+1  O MSTU(90+MSTU(90))=I1 0% O PARU(90+MSTU(90))=PARU9T(IZ) O O ENDIF  O 1040 CONTINUE n O 1050 CONTINUE i O DO 1080 I=2*N-NSAV,N+1,-1 $ O IF(K(I,3).EQ.IE(1)) GOTO 1080  O I1=I1+1  O DO 1060 J=1,5  O K(I1,J)=K(I,J) N O P(I1,J)=P(I,J) ) O 1060 CONTINUE O % O IF(MSTU(16).NE.2) K(I1,3)=NSAV )! O DO 1070 IZ=MSTU90+1,MSTU91 1 O IF(MSTU9T(IZ).EQ.I) THEN ) O MSTU(90)=MSTU(90)+1  O MSTU(90+MSTU(90))=I1 O % O PARU(90+MSTU(90))=PARU9T(IZ) 1 O ENDIF  O 1070 CONTINUE 2 O 1080 CONTINUE 3 O O 9 O C...Boost back particle system. Set production vertices. F O IF(MBST.EQ.0) THEN 2 O MSTU(33)=1 N@ O CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),  O & DPS(3)/DPS(4)) O ELSE N O DO 1090 I=NSAV+1,N O , O HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2  O IF(P(I,3).GT.0.) THEN % O HHPEZ=(P(I,4)+P(I,3))*HHBZ R) O P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ) O ) O P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) ) ELSE % O HHPEZ=(P(I,4)-P(I,3))/HHBZ ,* O P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ) ) O P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ)  O ENDIF  O 1090 CONTINUE ( O ENDIF  O DO 1110 I=NSAV+1,N  O DO 1100 J=1,4  O V(I,J)=V(IP,J) ) O 1100 CONTINUE = O 1110 CONTINUE  O RETURN 2 O END  O G O C********************************************************************* 1 O N O SUBROUTINE LUINDF(IP)  O F O C...Purpose: to handle the fragmentation of a jet system (or a single 8 O C...jet) according to independent fragmentation models. # O IMPLICIT DOUBLE PRECISION(D) 14 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) P& O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ = O DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3), U" O &KFLO(2),PXO(2),PYO(2),WO(2)  O )I O C...Reset counters. Identify parton system and take copy. Check flavour. = NSAV=N 2 O MSTU90=MSTU(90) NJET=0  O KQSUM=0  O DO 100 J=1,5 D O DPS(J)=0.  O 100 CONTINUE T I=IP-1 D O 110 I=I+1 , O IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN E O CALL LUERRM(12,'(LUINDF:) failed to reconstruct jet system') (! O IF(MSTU(21).GE.1) RETURN ( O ENDIF / O IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110 V O KC=LUCOMP(K(I,2))  O IF(KC.EQ.0) GOTO 110 w$ O KQ=KCHG(KC,2)*ISIGN(1,K(I,2))  O IF(KQ.EQ.0) GOTO 110 O O NJET=NJET+1 ! O IF(KQ.NE.2) KQSUM=KQSUM+KQ ( O DO 120 J=1,5 ) O K(NSAV+NJET,J)=K(I,J)  O P(NSAV+NJET,J)=P(I,J)  O DPS(J)=DPS(J)+P(I,J)  O 120 CONTINUE  O K(NSAV+NJET,3)=I N6 O IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND.  O &K(I+1,1).EQ.2)) GOTO 110 r( O IF(NJET.NE.1.AND.KQSUM.NE.0) THEN C O CALL LUERRM(12,'(LUINDF:) unphysical flavour combination') J! O IF(MSTU(21).GE.1) RETURN O ENDIF  O (F O C...Boost copied system to CM frame. Find CM energy and sum flavours.  O IF(NJET.NE.1) THEN I O MSTU(33)=1 0; O CALL LUDBRB(NSAV+1,NSAV+NJET,0.,0.,-DPS(1)/DPS(4), ,' O & -DPS(2)/DPS(4),-DPS(3)/DPS(4)) J O ENDIF  O PECM=0.  O DO 130 J=1,3 ( O NFI(J)=0 2 O 130 CONTINUE O DO 140 I=NSAV+1,NSAV+NJET  O PECM=PECM+P(I,4)  O KFA=IABS(K(I,2)) 4 O IF(KFA.LE.3) THEN * O NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2))  O ELSEIF(KFA.GT.1000) THEN P O KFLA=MOD(KFA/1000,10)  O KFLB=MOD(KFA/100,10) : O IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2)) : O IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2)) O ENDIF  O 140 CONTINUE ( O )- O C...Loop over attempts made. Reset counters. NTRY=0 ( O 150 NTRY=NTRY+1  O IF(NTRY.GT.200) THEN < O CALL LUERRM(14,'(LUINDF:) caught in infinite loop') ! O IF(MSTU(21).GE.1) RETURN ( O ENDIF  O N=NSAV+NJET  O MSTU(90)=MSTU90  O DO 160 J=1,3 2 O NFL(J)=NFI(J)  O IFET(J)=0  O KFLF(J)=0  O 160 CONTINUE X O )% O C...Loop over jets to be fragmented. 3" O DO 230 IP1=NSAV+1,NSAV+NJET  O MSTJ(91)=0  O NSAV1=N  O MSTU91=MSTU(90)  O C< O C...Initial flavour and momentum values. Jet along +z axis.  O KFLH=IABS(K(IP1,2)) , O IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10)  O KFLO(2)=0 < O WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2)  O I- O C...Initial values for quark or diquark jet. d$ O 170 IF(IABS(K(IP1,2)).NE.21) THEN  O NSTR=1 + O KFLO(1)=K(IP1,2) % O CALL LUPTDI(0,PXO(1),PYO(1)) ) O WO(1)=WF  O 7< O C...Initial values for gluon treated like random quark jet. O ELSEIF(MSTJ(2).LE.2) THEN  O NSTR=1 O $ O IF(MSTJ(2).EQ.2) MSTJ(91)=1 B O KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) % O CALL LUPTDI(0,PXO(1),PYO(1))  O WO(1)=WF T O D O C...Initial values for gluon treated like quark-antiquark jet pair, E O C...sharing energy according to Altarelli-Parisi splitting function. G O ELSE K O NSTR=2 T$ O IF(MSTJ(2).EQ.4) MSTJ(91)=1 B O KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)  O KFLO(2)=-KFLO(1) % O CALL LUPTDI(0,PXO(1),PYO(1))  O PXO(2)=-PXO(1) A O PYO(2)=-PYO(1) )! O WO(1)=WF*RLU(0)**(1./3.) O O WO(2)=WF-WO(1) 2 O ENDIF  O J1 O C...Initial values for rank, flavour, pT and W+. K O DO 220 ISTR=1,NSTR O 180 I=N  O MSTU(90)=MSTU91  O IRANK=0  O KFL1=KFLO(ISTR)  O PX1=PXO(ISTR)  O PY1=PYO(ISTR)  O W=WO(ISTR) 5 O 25 O C...New hadron. Generate flavour and hadron species. a O 190 I=I+1 , O IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN B O CALL LUERRM(11,'(LUINDF:) no more memory left in LUJETS') ! O IF(MSTU(21).GE.1) RETURN R O ENDIF  O IRANK=IRANK+1  O K(I,1)=1 ( O K(I,3)=IP1 ( O K(I,4)=0 I O K(I,5)=0 0& O 200 CALL LUKFDI(KFL1,0,KFL2,K(I,2))  O IF(K(I,2).EQ.0) GOTO 180 .@ O IF(MSTJ(12).GE.3.AND.IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND.  O &IABS(KFL2).GT.10) THEN +( O IF(RLU(0).GT.PARJ(19)) GOTO 200 O ENDIF  O .. O C...Find hadron mass. Generate four-momentum.  O P(I,5)=ULMASS(K(I,2)) O CALL LUPTDI(KFL1,PX2,PY2)  O P(I,1)=PX1+PX2 O  O P(I,2)=PY1+PY2 E' O PR=P(I,5)**2+P(I,1)**2+P(I,2)**2 " O CALL LUZDIS(KFL1,KFL2,PR,Z)  O MZSAV=0 E O IF(IABS(KFL1).GE.4.AND.IABS(KFL1).LE.8.AND.MSTU(90).LT.8) THEN  O MZSAV=1  O MSTU(90)=MSTU(90)+1  O MSTU(90+MSTU(90))=I  O PARU(90+MSTU(90))=Z O ENDIF ( O P(I,3)=0.5*(Z*W-PR/MAX(1E-4,Z*W)) ( O P(I,4)=0.5*(Z*W+PR/MAX(1E-4,Z*W)) 8 O IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND.  O &P(I,3).LE.0.001) THEN . O IF(W.GE.P(I,5)+0.5*PARJ(32)) GOTO 180  O P(I,3)=0.0001  O P(I,4)=SQRT(PR)  O Z=P(I,4)/W L O ENDIF  O 0$ O C...Remaining flavour and momentum.  O KFL1=-KFL2  O PX1=-PX2 1 O PY1=-PY2 = O W=(1.-Z)*W  O DO 210 J=1,5 t O V(I,J)=0.  O 210 CONTINUE r O oE O C...Check if pL acceptable. Go back for new hadron if enough energy. O - O IF(MSTJ(3).GE.0.AND.P(I,3).LT.0.) THEN ( O I=I-1 + O IF(MZSAV.EQ.1) MSTU(90)=MSTU(90)-1 ( O ENDIF ! O IF(W.GT.PARJ(31)) GOTO 190 4 O N=I  O 220 CONTINUE (@ O IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1*PARJ(32) 6 O IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170  O ! O C...Rotate jet to new direction. O 9 O THE=ULAN (P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2)) $ O PHI=ULANGL(P(IP1,1),P(IP1,2))  O MSTU(33)=1 F1 O CALL LUDBRB(NSAV1+1,N,THE,PHI,0D0,0D0,0D0) ) O K(K(IP1,3),4)=NSAV1+1  O K(K(IP1,3),5)=N  O A O C...End of jet generation loop. Skip conservation in some cases. d O 230 CONTINUE i- O IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 490 2< O IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150  O O = O C...Subtract off produced hadron flavours, finished if zero. O O DO 240 I=NSAV+NJET+1,N  O KFA=IABS(K(I,2))  O KFLA=MOD(KFA/1000,10)  O KFLB=MOD(KFA/100,10)  O KFLC=MOD(KFA/10,10)  O IF(KFLA.EQ.0) THEN EE O IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB PE O IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB ) O ELSE F: O IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2)) : O IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2)) : O IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2)) O ENDIF  O 240 CONTINUE 1@ O NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ 5 O &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 P O IF(NREQ.EQ.0) GOTO 320 E O (F O C...Take away flavour of low-momentum particles until enough freedom. NREM=0 3 250 IREM=0  O P2MIN=PECM**2  O DO 260 I=NSAV+NJET+1,N O ' O P2=P(I,1)**2+P(I,2)**2+P(I,3)**2 3- O IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I C/ O IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2 H O 260 CONTINUE 2 O IF(IREM.EQ.0) GOTO 150  O K(IREM,1)=7  O KFA=IABS(K(IREM,2))  O KFLA=MOD(KFA/1000,10)  O KFLB=MOD(KFA/100,10) H O KFLC=MOD(KFA/10,10) - O IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8 " O IF(K(IREM,1).EQ.8) GOTO 250  O IF(KFLA.EQ.0) THEN C+ O ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB / O IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN H/ O IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN O ELSE .= O IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2)) X= O IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2)) 3= O IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2)) ) O ENDIF  O NREM=NREM+1 @ O NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ 5 O &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 O IF(NREQ.GT.NREM) GOTO 250  O DO 270 I=NSAV+NJET+1,N  O IF(K(I,1).EQ.8) K(I,1)=1 O  O 270 CONTINUE 4 O O > O C...Find combination of existing and new flavours for hadron. 280 NFET=2 + O IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3 O  O IF(NREQ.LT.NREM) NFET=1 = O IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0 O O DO 290 J=1,NFET @ O IFET(J)=1+(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*RLU(0)  O KFLF(J)=ISIGN(1,NFL(1)) : O IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2)) G O IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3)) ) O 290 CONTINUE cE O IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0)) O  O &GOTO 280 IE O IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR. +D O &IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3) > O &.LT.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280 7 O IF(NFET.EQ.0) KFLF(1)=1+INT((2.+PARJ(2))*RLU(0)) 4% O IF(NFET.EQ.0) KFLF(2)=-KFLF(1) EG O IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2.+PARJ(2))*RLU(0)),-KFLF(1))  O IF(NFET.LE.2) KFLF(3)=0  O IF(KFLF(3).NE.0) THEN ; O KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+ 18 O & 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1)) ? O IF(KFLF(1).EQ.KFLF(3).OR.(1.+3.*PARJ(4))*RLU(0).GT.1.) )# O & KFLFC=KFLFC+ISIGN(2,KFLFC) * O ELSE , O KFLFC=KFLF(1) O ENDIF + O CALL LUKFDI(KFLFC,KFLF(2),KFLDMP,KF) ( O IF(KF.EQ.0) GOTO 280 O  O DO 300 J=1,MAX(2,NFET) D= O NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J)) J O 300 CONTINUE . O t1 O C...Store hadron at random among free positions. +( O NPOS=MIN(1+INT(RLU(0)*NREM),NREM)  O DO 310 I=NSAV+NJET+1,N " O IF(K(I,1).EQ.7) NPOS=NPOS-1 , O IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310  O K(I,1)=1 O  O K(I,2)=KF  O P(I,5)=ULMASS(K(I,2)) ; O P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) ) O 310 CONTINUE N O NREM=NREM-1 @ O NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ 5 O &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 3 O IF(NREM.GT.0) GOTO 280 O  O B O C...Compensate for missing momentum in global scheme (3 options). ; O 320 IF(MOD(MSTJ(3),5).NE.0.AND.MOD(MSTJ(3),5).NE.4) THEN O  O DO 340 J=1,3  O PSI(J)=0.  O DO 330 I=NSAV+NJET+1,N ) O PSI(J)=PSI(J)+P(I,J) P O 330 CONTINUE O  O 340 CONTINUE - O PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2 T O PWS=0.  O DO 350 I=NSAV+NJET+1,N X/ O IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4) EG O IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ (0 O & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) + O IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1.  O 350 CONTINUE 0 O DO 370 I=NSAV+NJET+1,N )* O IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4) B O IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ 0 O & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) & O IF(MOD(MSTJ(3),5).EQ.3) PW=1.  O DO 360 J=1,3 $ O P(I,J)=P(I,J)-PSI(J)*PW/PWS  O 360 CONTINUE = O P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)  O 370 CONTINUE Q O A O C...Compensate for missing momentum withing each jet separately. X' O ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN . O DO 390 I=N+1,N+NJET  O K(I,1)=0 c O DO 380 J=1,5  O P(I,J)=0.  O 380 CONTINUE N O 390 CONTINUE 7 O DO 410 I=NSAV+NJET+1,N 7 O IR1=K(I,3)  O IR2=N+IR1-NSAV N O K(IR2,1)=K(IR2,1)+1 ? O PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ O . O & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)  O DO 400 J=1,3 R. O P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J)  O 400 CONTINUE +! O P(IR2,4)=P(IR2,4)+P(I,4) T O P(IR2,5)=P(IR2,5)+PLS  O 410 CONTINUE  O PSS=0. Q O DO 420 I=N+1,N+NJET ? O IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8*P(I,5)+0.2)) i O 420 CONTINUE = O DO 440 I=NSAV+NJET+1,N 2 O IR1=K(I,3) T O IR2=N+IR1-NSAV (? O PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ .. O & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)  O DO 430 J=1,3 )D O P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1./(P(IR2,5)*PSS)-1.)*PLS*  O & P(IR1,J) * O 430 CONTINUE T= O P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) A O 440 CONTINUE ) O ENDIF  O )+ O C...Scale momenta for energy conservation. A# O IF(MOD(MSTJ(3),5).NE.0) THEN 1 O PMS=0. , O PES=0. , O PQS=0. 2 O DO 450 I=NSAV+NJET+1,N X O PMS=PMS+P(I,5) E O PES=PES+P(I,4) O ! O PQS=PQS+P(I,5)**2/P(I,4) ) O 450 CONTINUE N! O IF(PMS.GE.PECM) GOTO 150 & O NECO=0 + O 460 NECO=NECO+1 " O PFAC=(PECM-PQS)/(PES-PQS)  O PES=0. R O PQS=0. ) O DO 480 I=NSAV+NJET+1,N T O DO 470 J=1,3 4 O P(I,J)=PFAC*P(I,J) I O 470 CONTINUE O = O P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)  O PES=PES+P(I,4) I! O PQS=PQS+P(I,5)**2/P(I,4) O  O 480 CONTINUE 1? O IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2E-6*PECM) GOTO 460 O O ENDIF  O S? O C...Origin of produced particles and parton daughter pointers.  O 490 DO 500 I=NSAV+NJET+1,N 2& O IF(MSTU(16).NE.2) K(I,3)=NSAV+1 + O IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3) S O 500 CONTINUE O DO 510 I=NSAV+1,NSAV+NJET  O I1=K(I,3)  O K(I1,1)=K(I1,1)+10 = O IF(MSTU(16).NE.2) THEN  O K(I1,4)=NSAV+1  O K(I1,5)=NSAV+1 O ELSE  O K(I1,4)=K(I1,4)-NJET+1 * O K(I1,5)=K(I1,5)-NJET+1 )$ O IF(K(I1,5).LT.K(I1,4)) THEN  O K(I1,4)=0  O K(I1,5)=0  O ENDIF O ENDIF  O 510 CONTINUE O  O D O C...Document independent fragmentation system. Remove copy of jets.  O NSAV=NSAV+1  O K(NSAV,1)=11  O K(NSAV,2)=93 0 O K(NSAV,3)=IP  O K(NSAV,4)=NSAV+1 ) O K(NSAV,5)=N-NJET+1  O DO 520 J=1,4 O  O P(NSAV,J)=DPS(J) n O V(NSAV,J)=V(IP,J)  O 520 CONTINUE O G O P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) , O V(NSAV,5)=0. N O DO 540 I=NSAV+NJET,N  O DO 530 J=1,5  O K(I-NJET+1,J)=K(I,J) = O P(I-NJET+1,J)=P(I,J) 3 O V(I-NJET+1,J)=V(I,J)  O 530 CONTINUE O O 540 CONTINUE  O N=N-NJET+1 O " O DO 550 IZ=MSTU90+1,MSTU(90) % O MSTU(90+IZ)=MSTU(90+IZ)-NJET+1 S O 550 CONTINUE 4 O Z9 O C...Boost back particle system. Set production vertices. > O IF(NJET.NE.1) CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4), # O &DPS(2)/DPS(4),DPS(3)/DPS(4))  O DO 570 I=NSAV+1,N  O DO 560 J=1,4  O V(I,J)=V(IP,J) 1 O 560 CONTINUE I O 570 CONTINUE O O 8 RETURN + O END  O 6G O C********************************************************************* O  O  O SUBROUTINE LUDECY(IP)  O V8 O C...Purpose: to handle the decay of unstable particles. 4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) aE O COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) N/ O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ VG O DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3), " O &WTCOR(10),PTAU(4),PCMTAU(4) ! O DOUBLE PRECISION DBETAU(3) +@ O DATA WTCOR/2.,5.,15.,60.,250.,1500.,1.2E4,1.2E5,150.,16./  O (A O C...Functions: momentum in two-particle decays, four-product and 5 O C...matrix element times phase space in weak decays. ? O PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A) PH O FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3) 4 O HMEPS(HA)=((1.-HRQ-HA)**2+3.*HA*(1.+HRQ-HA))* % O &SQRT((1.-HRQ-HA)**2-4.*HRQ*HA) ) O I O C...Initial values. NTRY=0 N NSAV=N  O KFA=IABS(K(IP,2))  O KFS=ISIGN(1,K(IP,2)) * O KC=LUCOMP(KFA) * O MSTJ(92)=0 O  O O 0 O C...Choose lifetime and determine decay vertex.  O IF(K(IP,1).EQ.5) THEN  O V(IP,5)=0. l O ELSEIF(K(IP,1).NE.4) THEN ( O V(IP,5)=-PMAS(KC,4)*LOG(RLU(0)) O ENDIF  O DO 100 J=1,4 N. O VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5)  O 100 CONTINUE U O 0, O C...Determine whether decay allowed or not. MOUT=0 0 O IF(MSTJ(22).EQ.2) THEN (* O IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1 ! O ELSEIF(MSTJ(22).EQ.3) THEN FC O IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1 )! O ELSEIF(MSTJ(22).EQ.4) THEN o8 O IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1 , O IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1 O ENDIF * O IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN  O K(IP,1)=4  O RETURN O ENDIF  O ID O C...Interface to external tau decay library (for tau polarization). + O IF(KFA.EQ.15.AND.MSTJ(28).GE.1) THEN T O 1. O C...Starting values for pointers and momenta.  O ITAU=IP  O DO 110 J=1,4 C O PTAU(J)=P(ITAU,J)  O PCMTAU(J)=P(ITAU,J)  O 110 CONTINUE ( O )8 O C...Iterate to find position and code of mother of tau.  O IMTAU=ITAU Q O 120 IMTAU=K(IMTAU,3) 5 O O  O IF(IMTAU.EQ.0) THEN ? O C...If no known origin then impossible to do anything further.  O KFORIG=0 S O IORIG=0  O F- O ELSEIF(K(IMTAU,2).EQ.K(ITAU,2)) THEN O : O C...If tau -> tau + gamma then add gamma energy and loop. ) O IF(K(K(IMTAU,4),2).EQ.22) THEN I O DO 130 J=1,4 m0 O PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,4),J)  O 130 CONTINUE o- O ELSEIF(K(K(IMTAU,5),2).EQ.22) THEN n O DO 140 J=1,4 N0 O PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,5),J)  O 140 CONTINUE J O ENDIF  O GOTO 120 S O /- O ELSEIF(IABS(K(IMTAU,2)).GT.100) THEN EH O C...If coming from weak decay of hadron then W is not stored in record, : O C...but can be reconstructed by adding neutrino momentum. & O KFORIG=-ISIGN(24,K(ITAU,2))  O IORIG=0 * O DO 160 II=K(IMTAU,4),K(IMTAU,5) 5 O IF(K(II,2)*ISIGN(1,K(ITAU,2)).EQ.-16) THEN  O DO 150 J=1,4 ( O PCMTAU(J)=PCMTAU(J)+P(II,J)  O 150 CONTINUE  O ENDIF  O 160 CONTINUE ( O ( ELSE NA O C...If coming from resonance decay then find latest copy of this t* O C...resonance (may not completely agree).  O KFORIG=K(IMTAU,2)  O IORIG=IMTAU ! O DO 170 II=IMTAU+1,IP-1 9 O IF(K(II,2).EQ.KFORIG.AND.K(II,3).EQ.IORIG.AND. =? O & ABS(P(II,5)-P(IORIG,5)).LT.1E-5*P(IORIG,5)) IORIG=II F O 170 CONTINUE F O DO 180 J=1,4  O PCMTAU(J)=P(IORIG,J) o O 180 CONTINUE n O ENDIF  O 0@ O C...Boost tau to rest frame of production process (where known) ( O C...and rotate it to sit along +z axis.  O DO 190 J=1,3 t& O DBETAU(J)=PCMTAU(J)/PCMTAU(4)  O 190 CONTINUE .@ O IF(KFORIG.NE.0) CALL LUDBRB(ITAU,ITAU,0.,0.,-DBETAU(1),  O & -DBETAU(2),-DBETAU(3)) I+ O PHITAU=ULANGL(P(ITAU,1),P(ITAU,2)) o6 O CALL LUDBRB(ITAU,ITAU,0.,-PHITAU,0D0,0D0,0D0) + O THETAU=ULANGL(P(ITAU,3),P(ITAU,1)) O 6 O CALL LUDBRB(ITAU,ITAU,-THETAU,0.,0D0,0D0,0D0)  O O @ O C...Call tau decay routine (if meaningful) and fill extra info. . O IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN 0 O CALL LUTAUD(ITAU,IORIG,KFORIG,NDECAY) ' O DO 200 II=NSAV+1,NSAV+NDECAY * O K(II,1)=1  O K(II,3)=IP ) O K(II,4)=0  O K(II,5)=0  O 200 CONTINUE t O N=NSAV+NDECAY  O ENDIF  O h- O C...Boost back decay tau and decay products. t O DO 210 J=1,4  O P(ITAU,J)=PTAU(J)  O 210 CONTINUE .. O IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN : O CALL LUDBRB(NSAV+1,N,THETAU,PHITAU,0D0,0D0,0D0) @ O IF(KFORIG.NE.0) CALL LUDBRB(NSAV+1,N,0.,0.,DBETAU(1),  O & DBETAU(2),DBETAU(3))  O , O C...Skip past ordinary tau decay treatment.  O MMAT=0  O MBST=0 a O ND=0 a O GOTO 660  O ENDIF O ENDIF  O =3 O C...B-B~ mixing: flip sign of meson appropriately. 1 MMIX=0 < O IF((KFA.EQ.511.OR.KFA.EQ.531).AND.MSTJ(26).GE.1) THEN  O XBBMIX=PARJ(76) ' O IF(KFA.EQ.531) XBBMIX=PARJ(77) =C O IF(SIN(0.5*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.RLU(0)) MMIX=1 R O IF(MMIX.EQ.1) KFS=-KFS f O ENDIF  O D O C...Check existence of decay channels. Particle/antiparticle rules. KCA=KC ( O IF(MDCY(KC,2).GT.0) THEN )" O MDMDCY=MDME(MDCY(KC,2),2) 5 O IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY 1 O ENDIF 4 O IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN < O CALL LUERRM(9,'(LUDECY:) no decay channel defined')  O RETURN O ENDIF F O IF(MOD(KFA/1000,10).EQ.0.AND.(KCA.EQ.85.OR.KCA.EQ.87)) KFS=-KFS  O IF(KCHG(KC,3).EQ.0) THEN 2 O KFSP=1 , O KFSN=0 # O IF(RLU(0).GT.0.5) KFS=-KFS 2 O ELSEIF(KFS.GT.0) THEN  O KFSP=1 K O KFSN=0 O ELSE  O KFSP=0 E O KFSN=1 . O ENDIF  O .4 O C...Sum branching ratios of allowed decay channels. 220 NOPE=0  O BRSU=0. 7 O DO 230 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1 (9 O IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. M& O &KFSN*MDME(IDL,1).NE.3) GOTO 230 & O IF(MDME(IDL,2).GT.100) GOTO 230  O NOPE=NOPE+1  O BRSU=BRSU+BRAT(IDL)  O 230 CONTINUE  O IF(NOPE.EQ.0) THEN E O CALL LUERRM(2,'(LUDECY:) all decay channels closed by user') . O RETURN O ENDIF  O - O C...Select decay channel among allowed ones. P O 240 RBR=BRSU*RLU(0)  O IDL=MDCY(KCA,2)-1  O 250 IDL=IDL+1 9 O IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. " O &KFSN*MDME(IDL,1).NE.3) THEN 6 O IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250 & O ELSEIF(MDME(IDL,2).GT.100) THEN 6 O IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250 O ELSE  O IDC=IDL  O RBR=RBR-BRAT(IDL) D O IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0.) GOTO 250 O ENDIF  O TD O C...Start readout of decay channel: matrix element, reset counters.  O MMAT=MDME(IDC,2) 1 O 260 NTRY=NTRY+1  O IF(NTRY.GT.1000) THEN < O CALL LUERRM(14,'(LUDECY:) caught in infinite loop') ! O IF(MSTU(21).GE.1) RETURN + O ENDIF O I=N O NP=0 O NQ=0 t MBST=0 cF O IF(MMAT.GE.11.AND.MMAT.NE.46.AND.P(IP,4).GT.20.*P(IP,5)) MBST=1  O DO 270 J=1,4 2 O PV(1,J)=0. ($ O IF(MBST.EQ.0) PV(1,J)=P(IP,J)  O 270 CONTINUE t$ O IF(MBST.EQ.1) PV(1,4)=P(IP,5)  O PV(1,5)=P(IP,5) O PS=0. PSQ=0. MREM=0 2 O MHADDY=0 M O IF(KFA.GT.80) MHADDY=1 D O A? O C...Read out decay products. Convert to standard flavour code. E O JTMAX=5 ( O IF(MDME(IDC+1,2).EQ.101) JTMAX=10  O DO 280 JT=1,JTMAX " O IF(JT.LE.5) KP=KFDP(IDC,JT) & O IF(JT.GE.6) KP=KFDP(IDC+1,JT-5)  O IF(KP.EQ.0) GOTO 280 A O KPA=IABS(KP) ( O KCP=LUCOMP(KPA)  O IF(KPA.GT.80) MHADDY=1 (< O IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN  O KFP=KP N+ O ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN 1 O KFP=KFS*KP N7 O ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN + O KFP=-KFS*MOD(KFA/10,10) C O ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN ( O KFP=KFS*(100*MOD(KFA/10,100)+3)  O ELSEIF(KPA.EQ.81) THEN *< O KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1)  O ELSEIF(KP.EQ.82) THEN B O CALL LUKFDI(-KFS*INT(1.+(2.+PARJ(2))*RLU(0)),0,KFP,KDUMP)  O IF(KFP.EQ.0) GOTO 260  O MSTJ(93)=1 8 O IF(PV(1,5).LT.PARJ(32)+2.*ULMASS(KFP)) GOTO 260  O ELSEIF(KP.EQ.-82) THEN O  O KFP=-KFP 15 O IF(IABS(KFP).GT.10) KFP=KFP+ISIGN(10000,KFP) 4 O ENDIF 1 O IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=LUCOMP(KFP) O  O @ O C...Add decay product to event record or to quark flavour list.  O KFPA=IABS(KFP) 3 O KQP=KCHG(KCP,2) 6 O IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN  O NQ=NQ+1  O KFLO(NQ)=KFP F O MSTJ(93)=2 ,! O PSQ=PSQ+ULMASS(KFLO(NQ)) G O ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.48).AND.NP.EQ.3.AND. = O &MOD(NQ,2).EQ.1) THEN ) O NQ=NQ-1  O PS=PS-P(I,5)  O K(I,1)=1 I O KFI=K(I,2) 3+ O CALL LUKFDI(KFP,KFI,KFLDMP,K(I,2)) S! O IF(K(I,2).EQ.0) GOTO 260 F O MSTJ(93)=1 5 O P(I,5)=ULMASS(K(I,2))  O PS=PS+P(I,5) 8 O ELSE O  O I=I+1  O NP=NP+1 , O IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1 9 O IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1 F O K(I,1)=1+MOD(NQ,2) )9 O IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2 Q+ O IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1 F O K(I,2)=KFP + O K(I,3)=IP  O K(I,4)=0  O K(I,5)=0 F O P(I,5)=ULMASS(KFP) A6 O IF(MMAT.EQ.45.AND.KFPA.EQ.89) P(I,5)=PARJ(32)  O PS=PS+P(I,5) ( O ENDIF  O 280 CONTINUE O  O 9' O C...Check masses for resonance decays. T O IF(MHADDY.EQ.0) THEN F, O IF(PS+PARJ(64).GT.PV(1,5)) GOTO 240 O ENDIF  O .4 O C...Choose decay multiplicity in phase space model. ) O 290 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN 1 O PSP=PS &> O CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1)) * O IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63)  O 300 NTRY=NTRY+1  O IF(NTRY.GT.1000) THEN > O CALL LUERRM(14,'(LUDECY:) caught in infinite loop') # O IF(MSTU(21).GE.1) RETURN  O ENDIF  O IF(MMAT.LE.20) THEN 7 O GAUSS=SQRT(-2.*CNDE*LOG(MAX(1E-10,RLU(0))))* I O & SIN(PARU(2)*RLU(0)) + O ND=0.5+0.5*NP+0.25*NQ+CNDE+GAUSS (< O IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 300 . O IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 300 . O IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 300 . O IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 300 ELSE N O ND=MMAT-20 K O ENDIF  O F' O C...Form hadrons from flavour content. E O DO 310 JT=1,4  O KFL1(JT)=KFLO(JT)  O 310 CONTINUE M# O IF(ND.EQ.NP+NQ/2) GOTO 330 O" O DO 320 I=N+NP+1,N+ND-NQ/2 O JT=1+INT((NQ-1)*RLU(0)) , O CALL LUKFDI(KFL1(JT),0,KFL2,K(I,2)) ! O IF(K(I,2).EQ.0) GOTO 300 , O KFL1(JT)=-KFL2  O 320 CONTINUE * 330 JT=2 , O JT2=3  O JT3=4 0 O IF(NQ.EQ.4.AND.RLU(0).LT.PARJ(66)) JT=4 < O IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))* 9 O & ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3 O O IF(JT.EQ.3) JT2=2  O IF(JT.EQ.4) JT3=2 > O CALL LUKFDI(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2)) + O IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 300 O F O IF(NQ.EQ.4) CALL LUKFDI(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2)) 0 O IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 300  O O : O C...Check that sum of decay product masses not too large.  O PS=PSP 3 O DO 340 I=N+NP+1,N+ND F O K(I,1)=1 1 O K(I,3)=IP  O K(I,4)=0 ( O K(I,5)=0 + O P(I,5)=ULMASS(K(I,2))  O PS=PS+P(I,5) + O 340 CONTINUE S, O IF(PS+PARJ(64).GT.PV(1,5)) GOTO 300  O .9 O C...Rescale energy to subtract off spectator quark mass. D O ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44.OR.MMAT.EQ.45)  O &.AND.NP.GE.3) THEN 1 O PS=PS-P(N+NP,5) ) O PQT=(P(N+NP,5)+PARJ(65))/PV(1,5)  O DO 350 J=1,5  O P(N+NP,J)=PQT*PV(1,J) ! O PV(1,J)=(1.-PQT)*PV(1,J)  O 350 CONTINUE , O IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260  O ND=NP-1  O MREM=1 E O O , O C...Phase space factors imposed in W decay.  O ELSEIF(MMAT.EQ.46) THEN  O MSTJ(93)=1 . O PSMC=ULMASS(K(N+1,2))  O MSTJ(93)=1 (# O PSMC=PSMC+ULMASS(K(N+2,2)) 6 O IF(MAX(PS,PSMC)+PARJ(32).GT.PV(1,5)) GOTO 240 " O HR1=(P(N+1,5)/PV(1,5))**2 " O HR2=(P(N+2,5)/PV(1,5))**2 F O IF((1.-HR1-HR2)*(2.+HR1+HR2)*SQRT((1.-HR1-HR2)**2-4.*HR1*HR2) O & .LT.2.*RLU(0)) GOTO 240  O ND=NP  O 2@ O C...Fully specified final state: check mass broadening effects. O ELSE (8 O IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 260  O ND=NP O ENDIF  O )= O C...Select W mass in decay Q -> W + q, without W propagator. O, O IF(MMAT.EQ.45.AND.MSTJ(25).LE.0) THEN " O HLQ=(PARJ(32)/PV(1,5))**2 0 O HUQ=(1.-(P(N+2,5)+PARJ(64))/PV(1,5))**2 " O HRQ=(P(N+2,5)/PV(1,5))**2 O 360 HW=HLQ+RLU(0)*(HUQ-HLQ) ) O IF(HMEPS(HW).LT.RLU(0)) GOTO 360 ," O P(N+1,5)=PV(1,5)*SQRT(HW)  O 2I O C...Ditto, including W propagator. Divide mass range into three regions. 2 O ELSEIF(MMAT.EQ.45) THEN $ O HQW=(PV(1,5)/PMAS(24,1))**2 % O HLW=(PARJ(32)/PMAS(24,1))**2 )8 O HUW=((PV(1,5)-P(N+2,5)-PARJ(64))/PMAS(24,1))**2 " O HRQ=(P(N+2,5)/PV(1,5))**2 ! O HG=PMAS(24,2)/PMAS(24,1) ( O HATL=ATAN((HLW-1.)/HG) . O HM=MIN(1.,HUW-0.001) Q. O HMV1=HMEPS(HM/HQW)/((HM-1.)**2+HG**2)  O 370 HM=HM-HG O . O HMV2=HMEPS(HM/HQW)/((HM-1.)**2+HG**2) / O IF(HMV2.GT.HMV1.AND.HM-HG.GT.HLW) THEN G O HMV1=HMV2  O GOTO 370  O ENDIF - O HMV=MIN(2.*HMV1,HMEPS(HM/HQW)/HG**2) =" O HM1=1.-SQRT(1./HMV-HG**2) * O IF(HM1.GT.HLW.AND.HM1.LT.HM) THEN  O HM=HM1 A" O ELSEIF(HMV2.LE.HMV1) THEN ( O HM=MAX(HLW,HM-MIN(0.1,1.-HM))  O ENDIF  O HATM=ATAN((HM-1.)/HG)  O HWT1=(HATM-HATL)/HG " O HWT2=HMV*(MIN(1.,HUW)-HM)  O HWT3=0.  O IF(HUW.GT.1.) THEN 0! O HATU=ATAN((HUW-1.)/HG)  O HMP1=HMEPS(1./HQW) a O HWT3=HMP1*HATU/HG  O ENDIF  O 2E O C...Select mass region and W mass there. Accept according to weight. )% O 380 HREG=RLU(0)*(HWT1+HWT2+HWT3)  O IF(HREG.LE.HWT1) THEN 0 O HW=1.+HG*TAN(HATL+RLU(0)*(HATM-HATL))  O HACC=HMEPS(HW/HQW) ' O ELSEIF(HREG.LE.HWT1+HWT2) THEN ( O HW=HM+RLU(0)*(MIN(1.,HUW)-HM) 4 O HACC=HMEPS(HW/HQW)/((HW-1.)**2+HG**2)/HMV ELSE 4$ O HW=1.+HG*TAN(RLU(0)*HATU) " O HACC=HMEPS(HW/HQW)/HMP1  O ENDIF $ O IF(HACC.LT.RLU(0)) GOTO 380 % O P(N+1,5)=PMAS(24,1)*SQRT(HW) O ENDIF  O VG O C...Determine position of grandmother, number of sisters, Q -> W sign. O NM=0 V KFAS=0 MSGN=0 -' O IF(MMAT.EQ.3.OR.MMAT.EQ.46) THEN S O IM=K(IP,3) % O IF(IM.LT.0.OR.IM.GE.IP) IM=0 . O IF(MMAT.EQ.46.AND.MSTJ(27).EQ.1) THEN  O IM=0 2> O ELSEIF(MMAT.EQ.46.AND.MSTJ(27).GE.2.AND.IM.NE.0) THEN ! O IF(K(IM,2).EQ.94) THEN = O IM=K(K(IM,3),3) ) O IF(IM.LT.0.OR.IM.GE.IP) IM=0 3 O ENDIF  O ENDIF ' O IF(IM.NE.0) KFAM=IABS(K(IM,2)) 1' O IF(IM.NE.0.AND.MMAT.EQ.3) THEN -/ O DO 390 IL=MAX(IP-2,IM+1),MIN(IP+2,N) r$ O IF(K(IL,3).EQ.IM) NM=NM+1 1 O IF(K(IL,3).EQ.IM.AND.IL.NE.IP) ISIS=IL D O 390 CONTINUE &= O IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR. ' O & MOD(KFAM/1000,10).NE.0) NM=0  O IF(NM.EQ.2) THEN E! O KFAS=IABS(K(ISIS,2)) O 5 O IF((KFAS.LE.100.OR.MOD(KFAS,10).NE.1.OR. *9 O & MOD(KFAS/1000,10).NE.0).AND.KFAS.NE.22) NM=0 O  O ENDIF , O ELSEIF(IM.NE.0.AND.MMAT.EQ.46) THEN ( O MSGN=ISIGN(1,K(IM,2)*K(IP,2)) ; O IF(KFAM.GT.100.AND.MOD(KFAM/1000,10).EQ.0) MSGN= 2& O & MSGN*(-1)**MOD(KFAM/100,10)  O ENDIF O ENDIF  O O ' O C...Kinematics of one-particle decays. , O IF(ND.EQ.1) THEN ) O DO 400 J=1,4 , O P(N+1,J)=P(IP,J) V O 400 CONTINUE D O GOTO 660 4 O ENDIF  O 00 O C...Calculate maximum weight ND-particle decay.  O PV(ND,5)=P(N+ND,5) D O IF(ND.GE.3) THEN C O WTMAX=1./WTCOR(ND-2) E" O PMAX=PV(1,5)-PS+P(N+ND,5)  O PMIN=0.  O DO 410 IL=ND-1,1,-1  O PMAX=PMAX+P(N+IL,5)  O PMIN=PMIN+P(N+IL+1,5) . O WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5))  O 410 CONTINUE O O ENDIF  O (- O C...Find virtual gamma mass in Dalitz decay. P O 420 IF(ND.EQ.2) THEN ( O ELSEIF(MMAT.EQ.2) THEN ) O PMES=4.*PMAS(11,1)**2  O PMRHO2=PMAS(131,1)**2  O PGRHO2=PMAS(131,2)**2 , O 430 PMST=PMES*(P(IP,5)**2/PMES)**RLU(0) 9 O WT=(1+0.5*PMES/PMST)*SQRT(MAX(0.,1.-PMES/PMST))* O 4 O & (1.-PMST/P(IP,5)**2)**3*(1.+PGRHO2/PMRHO2)/ , O & ((1.-PMST/PMRHO2)**2+PGRHO2/PMRHO2) " O IF(WT.LT.RLU(0)) GOTO 430 3 O PV(2,5)=MAX(2.00001*PMAS(11,1),SQRT(PMST)) N O 6 O C...M-generator gives weight. If rejected, try again. O ELSE  O 440 RORD(1)=1. 0 O DO 470 IL1=2,ND-1  O RSAV=RLU(0)  O DO 450 IL2=IL1-1,1,-1 ' O IF(RSAV.LE.RORD(IL2)) GOTO 460 R O RORD(IL2+1)=RORD(IL2)  O 450 CONTINUE O  O 460 RORD(IL2+1)=RSAV 2 O 470 CONTINUE P O RORD(ND)=0.  O WT=1.  O DO 480 IL=ND-1,1,-1 I O PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS) P2 O WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))  O 480 CONTINUE E( O IF(WT.LT.RLU(0)*WTMAX) GOTO 440 O ENDIF  O O 8 O C...Perform two-particle decays in respective CM frame.  O 490 DO 510 IL=1,ND-1 E- O PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) g O UE(3)=2.*RLU(0)-1. m O PHI=PARU(2)*RLU(0) ' O UE(1)=SQRT(1.-UE(3)**2)*COS(PHI) T' O UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI) 1 O DO 500 J=1,3 . O P(N+IL,J)=PA*UE(J) a O PV(IL+1,J)=-PA*UE(J)  O 500 CONTINUE Q) O P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2) F+ O PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2) e O 510 CONTINUE o O y3 O C...Lorentz transform decay products to lab frame. I O DO 520 J=1,4 E O P(N+ND,J)=PV(ND,J)  O 520 CONTINUE u O DO 560 IL=ND-1,1,-1  O DO 530 J=1,3 O  O BE(J)=PV(IL,J)/PV(IL,4)  O 530 CONTINUE  O GA=PV(IL,4)/PV(IL,5)  O DO 550 I=N+IL,N+ND (1 O BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) E O DO 540 J=1,3 .5 O P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) T O 540 CONTINUE ( O P(I,4)=GA*(P(I,4)+BEP) 1 O 550 CONTINUE T O 560 CONTINUE L O N: O C...Check that no infinite loop in matrix element weight.  O NTRY=NTRY+1  O IF(NTRY.GT.800) GOTO 590  O . O C...Matrix elements for omega and phi decays.  O IF(MMAT.EQ.1) THEN 0G O WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2 O A O & -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2 06 O & +2.*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3) A O IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001).LT.RLU(0)) GOTO 420 Q O A@ O C...Matrix elements for pi0 or eta Dalitz decay to gamma e+ e-.  O ELSEIF(MMAT.EQ.2) THEN & O FOUR12=FOUR(N+1,N+2) 1 O FOUR13=FOUR(N+1,N+3) F2 O WT=(PMST-0.5*PMES)*(FOUR12**2+FOUR13**2)+ 1 O & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2) ,A O IF(WT.LT.RLU(0)*0.25*PMST*(P(IP,5)**2-PMST)**2) GOTO 490 Q O @ O C...Matrix element for S0 -> S1 + V1 -> S1 + S2 + S3 (S scalar, A O C...V vector), of form cos**2(theta02) in V1 rest frame, and for B O C...S0 -> gamma + V1 -> gamma + S2 + S3, of form sin**2(theta02). ) O ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN ( O FOUR10=FOUR(IP,IM) O  O FOUR12=FOUR(IP,N+1)  O FOUR02=FOUR(IM,N+1)  O PMS1=P(IP,5)**2  O PMS0=P(IM,5)**2  O PMS2=P(N+1,5)**2 ; O IF(KFAS.NE.22) HNUM=(FOUR10*FOUR12-PMS1*FOUR02)**2 .; O IF(KFAS.EQ.22) HNUM=PMS1*(2.*FOUR10*FOUR12*FOUR02- ME O & PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2) . O HNUM=MAX(1E-6*PMS1**2*PMS0*PMS2,HNUM) 9 O HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2) J) O IF(HNUM.LT.RLU(0)*HDEN) GOTO 490  O > O C...Matrix element for "onium" -> g + g + g or gamma + g + g.  O ELSEIF(MMAT.EQ.4) THEN ' O HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 F' O HX2=2.*FOUR(IP,N+2)/P(IP,5)**2 O ' O HX3=2.*FOUR(IP,N+3)/P(IP,5)**2 S< O WT=((1.-HX1)/(HX2*HX3))**2+((1.-HX2)/(HX1*HX3))**2+ O & ((1.-HX3)/(HX1*HX2))**2 % O IF(WT.LT.2.*RLU(0)) GOTO 420 )F O IF(K(IP+1,2).EQ.22.AND.(1.-HX1)*P(IP,5)**2.LT.4.*PARJ(32)**2)  O & GOTO 420 - O )E O C...Effective matrix element for nu spectrum in tau -> nu + hadrons. O  O ELSEIF(MMAT.EQ.41) THEN ' O HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 L) O HXM=MIN(0.75,2.*(1.-PS/P(IP,5))) .? O IF(HX1*(3.-2.*HX1).LT.RLU(0)*HXM*(3.-2.*HXM)) GOTO 420 W O sD O C...Matrix elements for weak decays (only semileptonic for c and b) D O ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48)  O &.AND.ND.EQ.3) THEN V4 O IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3) 8 O IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3) ? O IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 420 iH O ELSEIF(MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) THEN  O DO 580 J=1,4  O P(N+NP+1,J)=0. 4 O DO 570 IS=N+3,N+NP 2( O P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J)  O 570 CONTINUE P O 580 CONTINUE 7 O IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1) S; O IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1) ,? O IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 420 7 O % O C...Angular distribution in W decay. (, O ELSEIF(MMAT.EQ.46.AND.MSGN.NE.0) THEN 5 O IF(MSGN.GT.0) WT=FOUR(IM,N+1)*FOUR(N+2,IP+1) 5 O IF(MSGN.LT.0) WT=FOUR(IM,N+2)*FOUR(N+1,IP+1) P7 O IF(WT.LT.RLU(0)*P(IM,5)**4/WTCOR(10)) GOTO 490 O ENDIF  O L. O C...Scale back energy and reattach spectator.  O 590 IF(MREM.EQ.1) THEN E O DO 600 J=1,5 W! O PV(1,J)=PV(1,J)/(1.-PQT)  O 600 CONTINUE ( O ND=ND+1  O MREM=0 T O ENDIF  O WG O C...Low invariant mass for system with spectator quark gives particle, O 0 O C...not two jets. Readjust momenta accordingly. 6 O IF((MMAT.EQ.31.OR.MMAT.EQ.45).AND.ND.EQ.3) THEN  O MSTJ(93)=1 t O PM2=ULMASS(K(N+2,2)) A O MSTJ(93)=1 i O PM3=ULMASS(K(N+3,2)) T8 O IF(P(N+2,5)**2+P(N+3,5)**2+2.*FOUR(N+2,N+3).GE. ( O & (PARJ(32)+PM2+PM3)**2) GOTO 660  O K(N+2,1)=1 / O KFTEMP=K(N+2,2) 5 O CALL LUKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2)) H# O IF(K(N+2,2).EQ.0) GOTO 260 )" O P(N+2,5)=ULMASS(K(N+2,2))  O PS=P(N+1,5)+P(N+2,5) U O PV(2,5)=P(N+2,5) H O MMAT=0 ND=2  O GOTO 490 T O ELSEIF(MMAT.EQ.44) THEN  O MSTJ(93)=1 H O PM3=ULMASS(K(N+3,2)) e O MSTJ(93)=1 n O PM4=ULMASS(K(N+4,2)) >8 O IF(P(N+3,5)**2+P(N+4,5)**2+2.*FOUR(N+3,N+4).GE. ( O & (PARJ(32)+PM3+PM4)**2) GOTO 630  O K(N+3,1)=1 O  O KFTEMP=K(N+3,2) 5 O CALL LUKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2)) T# O IF(K(N+3,2).EQ.0) GOTO 260 F" O P(N+3,5)=ULMASS(K(N+3,2))  O DO 610 J=1,3 # O P(N+3,J)=P(N+3,J)+P(N+4,J)  O 610 CONTINUE G O P(N+3,4)=SQRT(P(N+3,1)**2+P(N+3,2)**2+P(N+3,3)**2+P(N+3,5)**2) # O HA=P(N+1,4)**2-P(N+2,4)**2 2( O HB=HA-(P(N+1,5)**2-P(N+2,5)**2) : O HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+  O & (P(N+1,3)-P(N+2,3))**2 O ! O HD=(PV(1,4)-P(N+3,4))**2 E7 O HE=HA**2-2.*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2 2 O HF=HD*HC-HB**2 A O HG=HD*HC-HA*HB * O HH=(SQRT(HG**2+HE*HF)-HG)/(2.*HF)  O DO 620 J=1,3 $ O PCOR=HH*(P(N+1,J)-P(N+2,J))  O P(N+1,J)=P(N+1,J)+PCOR , O P(N+2,J)=P(N+2,J)-PCOR F O 620 CONTINUE NG O P(N+1,4)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2+P(N+1,5)**2) QG O P(N+2,4)=SQRT(P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2+P(N+2,5)**2) T O ND=ND-1 O ENDIF  O GI O C...Check invariant mass of W jets. May give one particle or start over. O @ O 630 IF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) & O &.AND.IABS(K(N+1,2)).LT.10) THEN C O PMR=SQRT(MAX(0.,P(N+1,5)**2+P(N+2,5)**2+2.*FOUR(N+1,N+2)))  O MSTJ(93)=1 a O PM1=ULMASS(K(N+1,2))  O MSTJ(93)=1 N O PM2=ULMASS(K(N+2,2)) C- O IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 640 P O KFLDUM=INT(1.5+RLU(0)) NA O CALL LUKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1) A O CALL LUKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2) N* O IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 260 $ O PSM=ULMASS(KF1)+ULMASS(KF2) H O IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.PMR.GT.PARJ(64)+PSM) GOTO 640 < O IF(MMAT.GE.43.AND.PMR.GT.0.2*PARJ(32)+PSM) GOTO 640 O IF(MMAT.EQ.48) GOTO 420 * O IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 260  O K(N+1,1)=1 S O KFTEMP=K(N+1,2) 5 O CALL LUKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2)) P# O IF(K(N+1,2).EQ.0) GOTO 260 2" O P(N+1,5)=ULMASS(K(N+1,2))  O K(N+2,2)=K(N+3,2)  O P(N+2,5)=P(N+3,5)  O PS=P(N+1,5)+P(N+2,5) a, O IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260  O PV(2,5)=P(N+3,5) = O MMAT=0 4 ND=2 O  O GOTO 490 O ENDIF  O I/ O C...Phase space decay of partons from W decay. OC O 640 IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.IABS(K(N+1,2)).LT.10) THEN O O KFLO(1)=K(N+1,2) O O KFLO(2)=K(N+2,2) 0 O K(N+1,1)=K(N+3,1)  O K(N+1,2)=K(N+3,2)  O DO 650 J=1,5 (" O PV(1,J)=P(N+1,J)+P(N+2,J)  O P(N+1,J)=P(N+3,J)  O 650 CONTINUE ) O PV(1,5)=PMR  O N=N+1 NP=0 U NQ=2  O PS=0.  O MSTJ(93)=2 w O PSQ=ULMASS(KFLO(1))  O MSTJ(93)=2 O O PSQ=PSQ+ULMASS(KFLO(2))  O MMAT=11  O GOTO 290 O ENDIF  O ., O C...Boost back for rapidly moving particle. 660 N=N+ND * O IF(MBST.EQ.1) THEN T O DO 670 J=1,3 1 O BE(J)=P(IP,J)/P(IP,4)  O 670 CONTINUE O  O GA=P(IP,4)/P(IP,5) O  O DO 690 I=NSAV+1,N 3 O BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) R O DO 680 J=1,3 e7 O P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) c O 680 CONTINUE O  O P(I,4)=GA*(P(I,4)+BEP) D O 690 CONTINUE 2 O ENDIF  O & O C...Fill in position of decay vertex.  O DO 710 I=NSAV+1,N  O DO 700 J=1,4 T O V(I,J)=VDCY(J) 4 O 700 CONTINUE  O V(I,5)=0.  O 710 CONTINUE E O *2 O C...Set up for parton shower evolution from jets. A O IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN  O K(NSAV+1,1)=3  O K(NSAV+2,1)=3  O K(NSAV+3,1)=3 % O K(NSAV+1,4)=MSTU(5)*(NSAV+2) B% O K(NSAV+1,5)=MSTU(5)*(NSAV+3) m% O K(NSAV+2,4)=MSTU(5)*(NSAV+3) % O K(NSAV+2,5)=MSTU(5)*(NSAV+1) r% O K(NSAV+3,4)=MSTU(5)*(NSAV+1) m% O K(NSAV+3,5)=MSTU(5)*(NSAV+2) ) O MSTJ(92)=-(NSAV+1) / O ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN F O K(NSAV+2,1)=3  O K(NSAV+3,1)=3 % O K(NSAV+2,4)=MSTU(5)*(NSAV+3) T% O K(NSAV+2,5)=MSTU(5)*(NSAV+3) O% O K(NSAV+3,4)=MSTU(5)*(NSAV+2) O% O K(NSAV+3,5)=MSTU(5)*(NSAV+2) m O MSTJ(92)=NSAV+2 H O ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46) E O &.AND.IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN 0 O K(NSAV+1,1)=3  O K(NSAV+2,1)=3 % O K(NSAV+1,4)=MSTU(5)*(NSAV+2) % O K(NSAV+1,5)=MSTU(5)*(NSAV+2) I% O K(NSAV+2,4)=MSTU(5)*(NSAV+1) O % O K(NSAV+2,5)=MSTU(5)*(NSAV+1) T O MSTJ(92)=NSAV+1 H O ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46) E O &.AND.IABS(K(NSAV+1,2)).LE.20.AND.IABS(K(NSAV+2,2)).LE.20) THEN  O MSTJ(92)=NSAV+1 G O ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21) . O &THEN D O K(NSAV+1,1)=3  O K(NSAV+2,1)=3  O K(NSAV+3,1)=3 O KCP=LUCOMP(K(NSAV+1,2)) - O KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2)) U O JCON=4  O IF(KQP.LT.0) JCON=5 ( O K(NSAV+1,JCON)=MSTU(5)*(NSAV+2) * O K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1) ( O K(NSAV+2,JCON)=MSTU(5)*(NSAV+3) * O K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2)  O MSTJ(92)=NSAV+1 0 O ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN  O K(NSAV+1,1)=3  O K(NSAV+3,1)=3 % O K(NSAV+1,4)=MSTU(5)*(NSAV+3) % O K(NSAV+1,5)=MSTU(5)*(NSAV+3) % O K(NSAV+3,4)=MSTU(5)*(NSAV+1) % O K(NSAV+3,5)=MSTU(5)*(NSAV+1) c O MSTJ(92)=NSAV+1  O O 6 O C...Set up for parton shower evolution in t -> W + b. < O ELSEIF(MSTJ(27).GE.1.AND.MMAT.EQ.45.AND.ND.EQ.3) THEN  O K(NSAV+2,1)=3  O K(NSAV+3,1)=3 % O K(NSAV+2,4)=MSTU(5)*(NSAV+3) % O K(NSAV+2,5)=MSTU(5)*(NSAV+3) O % O K(NSAV+3,4)=MSTU(5)*(NSAV+2) .% O K(NSAV+3,5)=MSTU(5)*(NSAV+2) t O MSTJ(92)=NSAV+1 O ENDIF  O O ; O C...Mark decayed particle; special option for B-B~ mixing. " O IF(K(IP,1).EQ.5) K(IP,1)=15 # O IF(K(IP,1).LE.10) K(IP,1)=11 MC O IF(MMIX.EQ.1.AND.MSTJ(26).EQ.2.AND.K(IP,1).EQ.11) K(IP,1)=12 O  O K(IP,4)=NSAV+1  O K(IP,5)=N  O 3 RETURN 7 O END  O FG O C********************************************************************* I O Q+ O SUBROUTINE LUKFDI(KFL1,KFL2,KFL3,KF) x O eF O C...Purpose: to generate a new flavour pair and combine off a hadron. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)  O SAVE /LUDAT1/,/LUDAT2/ . O R6 O C...Default flavour values. Input consistency checks.  O KF1A=IABS(KFL1)  O KF2A=IABS(KFL2) KFL3=0 O O KF=0 K O IF(KF1A.EQ.0) RETURN 8 O IF(KF2A.NE.0) THEN O @ O IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN - O IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN A O IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN L O ENDIF  O P= O C...Check if tabulated flavour probabilities are to be used. i O IF(MSTJ(15).EQ.1) THEN O  O KTAB1=-1 / O IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A , O KFL1A=MOD(KF1A/1000,10)  O KFL1B=MOD(KF1A/100,10) N O KFL1S=MOD(KF1A,10) DD O IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4) 4 O & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2 G O IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1 y/ O IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A  O KTAB2=0  O IF(KF2A.NE.0) THEN a O KTAB2=-1 1 O IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A D" O KFL2A=MOD(KF2A/1000,10) ! O KFL2B=MOD(KF2A/100,10)  O KFL2S=MOD(KF2A,10) F O IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4) 6 O & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2 I O IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1 R O ENDIF / O IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 150 0 O ENDIF  O < O C...Parameters and breaking diquark parameter combinations.  O 100 PAR2=PARJ(2) O  O PAR3=PARJ(3) ) O PAR4=3.*PARJ(4)  O IF(MSTJ(12).GE.2) THEN  O PAR3M=SQRT(PARJ(3)) $ O PAR4M=1./(3.*SQRT(PARJ(4))) . O PARDM=PARJ(7)/(PARJ(7)+PAR3M*PARJ(6)) > O PARS0=PARJ(5)*(2.+(1.+PAR2*PAR3M*PARJ(7))*(1.+PAR4M)) D O PARS1=PARJ(7)*PARS0/(2.*PAR3M)+PARJ(5)*(PARJ(6)*(1.+PAR4M)+ $ O & PAR2*PAR3M*PARJ(6)*PARJ(7)) I O PARS2=PARJ(5)*2.*PARJ(6)*PARJ(7)*(PAR2*PARJ(7)+(1.+PAR4M)/PAR3M) =% O PARSM=MAX(PARS0,PARS1,PARS2) 3 O PAR4=PAR4*(1.+PARSM)/(1.+PARSM/(3.*PAR4M)) 0 O ENDIF  O G3 O C...Choice of whether to generate meson or baryon. n O 110 MBARY=0 KFDA=0 E O IF(KF1A.LE.10) THEN F O IF(KF2A.EQ.0.AND.MSTJ(12).GE.1.AND.(1.+PARJ(1))*RLU(0).GT.1.)  O & MBARY=1  O IF(KF2A.GT.10) MBARY=2 +3 O IF(KF2A.GT.10.AND.KF2A.LE.10000) KFDA=KF2A S O ELSE  O MBARY=2 $ O IF(KF1A.LE.10000) KFDA=KF1A O ENDIF  O .; O C...Possibility of process diquark -> meson + new diquark. + O IF(KFDA.NE.0.AND.MSTJ(12).GE.2) THEN O KFLDA=MOD(KFDA/1000,10)  O KFLDB=MOD(KFDA/100,10) H O KFLDS=MOD(KFDA,10) A O WTDQ=PARS0 F- O IF(MAX(KFLDA,KFLDB).EQ.3) WTDQ=PARS1 )- O IF(MIN(KFLDA,KFLDB).EQ.3) WTDQ=PARS2 3, O IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) , O IF((1.+WTDQ)*RLU(0).GT.1.) MBARY=-1 - O IF(MBARY.EQ.-1.AND.KF2A.NE.0) RETURN L O ENDIF  O 12 O C...Flavour for meson, possibly with new flavour.  O IF(MBARY.LE.0) THEN  O KFS=ISIGN(1,KFL1)  O IF(MBARY.EQ.0) THEN B O IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),-KFL1) ) O KFLA=MAX(KF1A,KF2A+IABS(KFL3)) ,) O KFLB=MIN(KF1A,KF2A+IABS(KFL3)) .$ O IF(KFLA.NE.KF1A) KFS=-KFS  O 6 O C...Splitting of diquark into meson plus new diquark. ELSE B" O KFL1A=MOD(KF1A/1000,10) ! O KFL1B=MOD(KF1A/100,10) D4 O 120 KFL1D=KFL1A+INT(RLU(0)+0.5)*(KFL1B-KFL1A) " O KFL1E=KFL1A+KFL1B-KFL1D B O IF((KFL1D.EQ.3.AND.RLU(0).GT.PARDM).OR.(KFL1E.EQ.3.AND. ! O & RLU(0).LT.PARDM)) THEN $ O KFL1D=KFL1A+KFL1B-KFL1D $ O KFL1E=KFL1A+KFL1B-KFL1E  O ENDIF 6 O KFL3A=1+INT((2.+PAR2*PAR3M*PARJ(7))*RLU(0)) H O IF((KFL1E.NE.KFL3A.AND.RLU(0).GT.(1.+PAR4M)/MAX(2.,1.+PAR4M)) B O & .OR.(KFL1E.EQ.KFL3A.AND.RLU(0).GT.2./MAX(2.,1.+PAR4M)))  O & GOTO 120 N O KFLDS=3 A O IF(KFL1E.NE.KFL3A) KFLDS=2*INT(RLU(0)+1./(1.+PAR4M))+1 AG O KFL3=ISIGN(10000+1000*MAX(KFL1E,KFL3A)+100*MIN(KFL1E,KFL3A)+ 4 O & KFLDS,-KFL1) 1 O KFLA=MAX(KFL1D,KFL3A) O KFLB=MIN(KFL1D,KFL3A) % O IF(KFLA.NE.KFL1D) KFS=-KFS  O ENDIF  O B O C...Form meson, with spin and flavour mixing for diagonal states. 0 O IF(KFLA.LE.2) KMUL=INT(PARJ(11)+RLU(0)) 0 O IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+RLU(0)) 0 O IF(KFLA.GE.4) KMUL=INT(PARJ(13)+RLU(0)) . O IF(KMUL.EQ.0.AND.PARJ(14).GT.0.) THEN ( O IF(RLU(0).LT.PARJ(14)) KMUL=2 D O ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0.) THEN  O RMUL=RLU(0) & O IF(RMUL.LT.PARJ(15)) KMUL=3 = O IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4 NF O (KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5  O ENDIF  O KFLS=3 a* O IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1  O IF(KMUL.EQ.5) KFLS=5 I O IF(KFLA.NE.KFLB) THEN 4 O KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA ELSE  O RMIX=RLU(0)  O IMIX=2*KFLA+10*KMUL : O IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+ % O & INT(RMIX+PARF(IMIX)))+KFLS N) O IF(KFLA.GE.4) KF=110*KFLA+KFLS 1 O ENDIF 9 O IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF) O, O IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF)  O m0 O C...Optional extra suppression of eta and eta'.  O IF(KF.EQ.221) THEN * O IF(RLU(0).GT.PARJ(25)) GOTO 110  O ELSEIF(KF.EQ.331) THEN O * O IF(RLU(0).GT.PARJ(26)) GOTO 110  O ENDIF  O + O C...Generate diquark flavour. O ELSE 2* O 130 IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN  O KFLA=KF1A , O 140 KFLB=1+INT((2.+PAR2*PAR3)*RLU(0)) , O KFLC=1+INT((2.+PAR2*PAR3)*RLU(0))  O KFLDS=1 # O IF(KFLB.GE.KFLC) KFLDS=3 a8 O IF(KFLDS.EQ.1.AND.PAR4*RLU(0).GT.1.) GOTO 140 5 O IF(KFLDS.EQ.3.AND.PAR4.LT.RLU(0)) GOTO 140 H O KFL3=ISIGN(1000*MAX(KFLB,KFLC)+100*MIN(KFLB,KFLC)+KFLDS,KFL1)  O 2% O C...Take diquark flavour from input. 0 O ELSEIF(KF1A.LE.10) THEN  O KFLA=KF1A ! O KFLB=MOD(KF2A/1000,10) 1 O KFLC=MOD(KF2A/100,10)  O KFLDS=MOD(KF2A,10)  O r< O C...Generate (or take from input) quark to go with diquark. ELSE (A O IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),KFL1) R O KFLA=KF2A+IABS(KFL3) F! O KFLB=MOD(KF1A/1000,10) M O KFLC=MOD(KF1A/100,10)  O KFLDS=MOD(KF1A,10)  O ENDIF  O ? O C...SU(6) factors for formation of baryon. Try again if fails.  O KBARY=KFLDS 0 O IF(KFLDS.EQ.3.AND.KFLB.NE.KFLC) KBARY=5 8 O IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC) KBARY=KBARY+1 2 O WT=PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY) . O IF(MBARY.EQ.1.AND.MSTJ(12).GE.2) THEN  O WTDQ=PARS0 U- O IF(MAX(KFLB,KFLC).EQ.3) WTDQ=PARS1 e- O IF(MIN(KFLB,KFLC).EQ.3) WTDQ=PARS2 . O IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) ? O IF(KFLDS.EQ.1) WT=WT*(1.+WTDQ)/(1.+PARSM/(3.*PAR4M)) 24 O IF(KFLDS.EQ.3) WT=WT*(1.+WTDQ)/(1.+PARSM)  O ENDIF 0 O IF(KF2A.EQ.0.AND.WT.LT.RLU(0)) GOTO 130  O 3< O C...Form baryon. Distinguish Lambda- and Sigmalike baryons. ! O KFLD=MAX(KFLA,KFLB,KFLC) *! O KFLF=MIN(KFLA,KFLB,KFLC) & O KFLE=KFLA+KFLB+KFLC-KFLD-KFLF  O KFLS=2 p? O IF((PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY))*RLU(0).GT. O  O & PARF(60+KBARY)) KFLS=4 5 O KFLL=0 X= O IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF) THEN .1 O IF(KFLDS.EQ.1.AND.KFLA.EQ.KFLD) KFLL=1 e@ O IF(KFLDS.EQ.1.AND.KFLA.NE.KFLD) KFLL=INT(0.25+RLU(0)) @ O IF(KFLDS.EQ.3.AND.KFLA.NE.KFLD) KFLL=INT(0.75+RLU(0))  O ENDIF E O IF(KFLL.EQ.0) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1) FE O IF(KFLL.EQ.1) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1) * O ENDIF RETURN  O OB O C...Use tabulated probabilities to select new flavour and hadron. , O 150 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN  O KT3L=1 O  O KT3U=6 =? O ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN T O KT3L=1 O O KT3U=6  O ELSEIF(KTAB2.EQ.0) THEN  O KT3L=1 O  O KT3U=22 O ELSE ) O KT3L=KTAB2 N O KT3U=KTAB2 . O ENDIF RFL=0. W O DO 170 KTS=0,2  O DO 160 KT3=KT3L,KT3U , O RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3)  O 160 CONTINUE  O 170 CONTINUE T O RFL=RLU(0)*RFL I O DO 190 KTS=0,2 . O KTABS=KTS  O DO 180 KT3=KT3L,KT3U  O KTAB3=KT3 , O RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3)  O IF(RFL.LE.0.) GOTO 200 e O 180 CONTINUE  O 190 CONTINUE Q O 200 CONTINUE  O O3 O C...Reconstruct flavour of produced quark/diquark. 0 O IF(KTAB3.LE.6) THEN  O KFL3A=KTAB3  O KFL3B=0 , O KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13)) O ELSE v O KFL3A=1  O IF(KTAB3.GE.8) KFL3A=2 a O IF(KTAB3.GE.11) KFL3A=3 O IF(KTAB3.GE.16) KFL3A=4 * O KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2 $ O KFL3=1000*KFL3A+100*KFL3B+1 G O IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3= 2 O & KFL3+2 &+ O KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1)) ( O ENDIF  O  O C...Reconstruct meson code. ? O IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR. . O &KFL3B.NE.0)) THEN C O RFL=RLU(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ V/ O & 25*KTABS)+PARF(145+80*KTAB1+25*KTABS))  O KF=110+2*KTABS+1 @ O IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1 A O IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ O $ O & 25*KTABS)) KF=330+2*KTABS+1 - O ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN * O KFLA=MAX(KTAB1,KTAB3)  O KFLB=MIN(KTAB1,KTAB3)  O KFS=ISIGN(1,KFL1) " O IF(KFLA.NE.KF1A) KFS=-KFS 7 O KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA ,- O ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN P O KFS=ISIGN(1,KFL1) O IF(KFL1A.EQ.KFL3A) THEN O KFLA=MAX(KFL1B,KFL3B) O KFLB=MIN(KFL1B,KFL3B) % O IF(KFLA.NE.KFL1B) KFS=-KFS N$ O ELSEIF(KFL1A.EQ.KFL3B) THEN  O KFLA=KFL3A N O KFLB=KFL1B  O KFS=-KFS ,$ O ELSEIF(KFL1B.EQ.KFL3A) THEN  O KFLA=KFL1A 2 O KFLB=KFL3B +$ O ELSEIF(KFL1B.EQ.KFL3B) THEN O KFLA=MAX(KFL1A,KFL3A) O KFLB=MIN(KFL1A,KFL3A) % O IF(KFLA.NE.KFL1A) KFS=-KFS ELSE JG O CALL LUERRM(2,'(LUKFDI:) no matching flavours for qq -> qq') - O GOTO 100 N O ENDIF 7 O KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA * O Q O C...Reconstruct baryon code. ) O ELSE * O IF(KTAB1.GE.7) THEN  O KFLA=KFL3A  O KFLB=KFL1A n O KFLC=KFL1B ELSE r O KFLA=KFL1A O  O KFLB=KFL3A . O KFLC=KFL3B 4 O ENDIF ! O KFLD=MAX(KFLA,KFLB,KFLC) T! O KFLF=MIN(KFLA,KFLB,KFLC) ,& O KFLE=KFLA+KFLB+KFLC-KFLD-KFLF C O IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1) )I O IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1) O O ENDIF  O ; O C...Check that constructed flavour code is an allowed one. ( O IF(KFL2.NE.0) KFL3=0  O KC=LUCOMP(KF)  O IF(KC.EQ.0) THEN NH O CALL LUERRM(2,'(LUKFDI:) user-defined flavour probabilities '//  O & 'failed')  O GOTO 100 F O ENDIF  O M RETURN M O END  O SG O C*********************************************************************  O # O SUBROUTINE LUPTDI(KFL,PX,PY)  O FF O C...Purpose: to generate transverse momentum according to a Gaussian. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)  O SAVE /LUDAT1/  O Q9 O C...Generate p_T and azimuthal angle, gives p_x and p_y.  O KFLA=IABS(KFL) 0 O PT=PARJ(21)*SQRT(-LOG(MAX(1E-10,RLU(0)))) , O IF(PARJ(23).GT.RLU(0)) PT=PARJ(24)*PT ' O IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT , O IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0.  O PHI=PARU(2)*RLU(0)  O PX=PT*COS(PHI) f O PY=PT*SIN(PHI) F O M RETURN T O END  O SG O C********************************************************************* + O )( O SUBROUTINE LUZDIS(KFL1,KFL2,PR,Z)  O ,@ O C...Purpose: to generate the longitudinal splitting variable z. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)  O SAVE /LUDAT1/,/LUDAT2/ w O * O C...Check if heavy flavour fragmentation.  O KFLA=IABS(KFL1)  O KFLB=IABS(KFL2)  O KFLH=KFLA , O IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10)  O rD O C...Lund symmetric scaling function: determine parameters of shape. < O IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3).OR.  O &MSTJ(11).GE.4) THEN  O FA=PARJ(41) & O IF(MSTJ(91).EQ.1) FA=PARJ(43) & O IF(KFLB.GE.10) FA=FA+PARJ(45)  O FBB=PARJ(42) ' O IF(MSTJ(91).EQ.1) FBB=PARJ(44) 4 O FB=FBB*PR  O FC=1. & O IF(KFLA.GE.10) FC=FC-PARJ(45) & O IF(KFLB.GE.10) FC=FC+PARJ(45) ; O IF(MSTJ(11).GE.4.AND.KFLH.GE.4.AND.KFLH.LE.5) THEN O O FRED=PARJ(46) 8 O IF(MSTJ(11).EQ.5.AND.KFLH.EQ.5) FRED=PARJ(47) + O FC=FC+FRED*FBB*PARF(100+KFLH)**2 u? O ELSEIF(MSTJ(11).GE.4.AND.KFLH.GE.6.AND.KFLH.LE.8) THEN + O FRED=PARJ(46) * O IF(MSTJ(11).EQ.5) FRED=PARJ(48) ) O FC=FC+FRED*FBB*PMAS(KFLH,1)**2 S O ENDIF MC=1 V$ O IF(ABS(FC-1.).GT.0.01) MC=2  O 2E O C...Determine position of maximum. Special cases for a = 0 or a = c.  O IF(FA.LT.0.02) THEN  O MA=1 3 O ZMAX=1. " O IF(FC.GT.FB) ZMAX=FB/FC ( O ELSEIF(ABS(FC-FA).LT.0.01) THEN  O MA=2 S O ZMAX=FB/(FB+FC) ELSE  O MA=3 5= O ZMAX=0.5*(FB+FC-SQRT((FB-FC)**2+4.*FA*FB))/(FC-FA) (D O IF(ZMAX.GT.0.9999.AND.FB.GT.100.) ZMAX=MIN(ZMAX,1.-FA/FB)  O ENDIF  O AA O C...Subdivide z range if distribution very peaked near endpoint. M O MMAX=2 & O IF(ZMAX.LT.0.1) THEN D O MMAX=1 L O ZDIV=2.75*ZMAX V O IF(MC.EQ.1) THEN = O FINT=1.-LOG(ZDIV)  O ELSE O ZDIVC=ZDIV**(1.-FC) * O FINT=1.+(1.-1./ZDIVC)/(FC-1.)  O ENDIF / O ELSEIF(ZMAX.GT.0.85.AND.FB.GT.1.) THEN  O MMAX=3 1# O FSCB=SQRT(4.+(FC/FB)**2) T? O ZDIV=FSCB-1./ZMAX-(FC/FB)*LOG(ZMAX*0.5*(FSCB+FC/FB)) )5 O IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1.-ZMAX) M& O ZDIV=MIN(ZMAX,MAX(0.,ZDIV))  O FINT=1.+FB*(1.-ZDIV) O  O ENDIF  O =9 O C...Choice of z, preweighted for peaks at low or high z.  O 100 Z=RLU(0) , O FPRE=1.  O IF(MMAX.EQ.1) THEN 2% O IF(FINT*RLU(0).LE.1.) THEN L O Z=ZDIV*Z ( O ELSEIF(MC.EQ.1) THEN  O Z=ZDIV**Z  O FPRE=ZDIV/Z  O ELSE T4 O Z=1./(ZDIVC+Z*(1.-ZDIVC))**(1./(1.-FC))  O FPRE=(ZDIV/Z)**FC  O ENDIF  O ELSEIF(MMAX.EQ.3) THEN % O IF(FINT*RLU(0).LE.1.) THEN 1 O Z=ZDIV+LOG(Z)/FB 5" O FPRE=EXP(FB*(Z-ZDIV))  O ELSE O  O Z=ZDIV+Z*(1.-ZDIV) + O ENDIF  O ENDIF  O A, O C...Weighting according to correct formula. ( O IF(Z.LE.0..OR.Z.GE.1.) GOTO 100 . O FEXP=FC*LOG(ZMAX/Z)+FB*(1./ZMAX-1./Z) 7 O IF(MA.GE.2) FEXP=FEXP+FA*LOG((1.-Z)/(1.-ZMAX)) V* O FVAL=EXP(MAX(-50.,MIN(50.,FEXP))) ) O IF(FVAL.LT.RLU(0)*FPRE) GOTO 100 O  O C O C...Generate z according to Field-Feynman, SLAC, (1-z)**c OR z**c. A O ELSE O FC=PARJ(50+MAX(1,KFLH)) & O IF(MSTJ(91).EQ.1) FC=PARJ(59)  O 110 Z=RLU(0) n' O IF(FC.GE.0..AND.FC.LE.1.) THEN O + O IF(FC.GT.RLU(0)) Z=1.-Z**(1./3.) F+ O ELSEIF(FC.GT.-1.AND.FC.LT.0.) THEN 1H O IF(-4.*FC*Z*(1.-Z)**2.LT.RLU(0)*((1.-Z)**2-FC*Z)**2) GOTO 110 ELSE O ' O IF(FC.GT.0.) Z=1.-Z**(1./FC) *% O IF(FC.LT.0.) Z=Z**(-1./FC) O  O ENDIF O ENDIF  O , RETURN O O END  O G O C********************************************************************* T O S& O SUBROUTINE LUSHOW(IP1,IP2,QMAX)  O E O C...Purpose: to generate timelike parton showers from given partons. A# O IMPLICIT DOUBLE PRECISION(D) l4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) & O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ ? O DIMENSION PMTH(5,50),PS(5),PMA(4),PMSD(4),IEP(4),IPA(4), UC O &KFLA(4),KFLD(4),KFL(4),ITRY(4),ISI(4),ISL(4),DP(4),DPT(5,4), NC O &KSH(0:40),KCII(2),NIIS(2),IIIS(2,2),THEIIS(2,2),PHIIIS(2,2), e O &ISII(2)  O ) O C...Initialization of cutoff masses etc. 1C O IF(MSTJ(41).LE.0.OR.(MSTJ(41).EQ.1.AND.QMAX.LE.PARJ(82)).OR. O- O &QMAX.LE.MIN(PARJ(82),PARJ(83))) RETURN ) O DO 100 IFL=0,40  O KSH(IFL)=0 F O 100 CONTINUE F O KSH(21)=1  O PMTH(1,21)=ULMASS(21) 6 O PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25*PARJ(82)**2)  O PMTH(3,21)=2.*PMTH(2,21) K O PMTH(4,21)=PMTH(3,21)  O PMTH(5,21)=PMTH(3,21)  O PMTH(1,22)=ULMASS(22) 6 O PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25*PARJ(83)**2)  O PMTH(3,22)=2.*PMTH(2,22) K O PMTH(4,22)=PMTH(3,22)  O PMTH(5,22)=PMTH(3,22)  O PMQTH1=PARJ(82) 6 O IF(MSTJ(41).GE.2) PMQTH1=MIN(PARJ(82),PARJ(83))  O PMQTH2=PMTH(2,21) : O IF(MSTJ(41).GE.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22))  O DO 110 IFL=1,8 1 O KSH(IFL)=1 K O PMTH(1,IFL)=ULMASS(IFL) 6 O PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PMQTH1**2) % O PMTH(3,IFL)=PMTH(2,IFL)+PMQTH2 O C O PMTH(4,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(82)**2)+PMTH(2,21) nC O PMTH(5,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(83)**2)+PMTH(2,22) A O 110 CONTINUE M O DO 120 IFL=11,17,2 # O IF(MSTJ(41).GE.2) KSH(IFL)=1 = O PMTH(1,IFL)=ULMASS(IFL) 8 O PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(83)**2) ) O PMTH(3,IFL)=PMTH(2,IFL)+PMTH(2,22)  O PMTH(4,IFL)=PMTH(3,IFL)  O PMTH(5,IFL)=PMTH(3,IFL)  O 120 CONTINUE A/ O PT2MIN=MAX(0.5*PARJ(82),1.1*PARJ(81))**2 * O ALAMS=PARJ(81)**2  O ALFM=LOG(PT2MIN/ALAMS)  O 2 O C...Store positions of shower initiating partons. H O IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN  O NPA=1  O IPA(1)=IP1 B O ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)-  O &MSTU(32))) THEN  O NPA=2  O IPA(1)=IP1  O IPA(2)=IP2 F O ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0  O &.AND.IP2.GE.-3) THEN  O NPA=IABS(IP2)  O DO 130 I=1,NPA  O IPA(I)=IP1+I-1 b O 130 CONTINUE q O ELSE  O CALL LUERRM(12, < O & '(LUSHOW:) failed to reconstruct showering system') ! O IF(MSTU(21).GE.1) RETURN 0 O ENDIF  O F1 O C...Check on phase space available for emission. F IREJ=0 B O DO 140 J=1,5 O  O PS(J)=0. L O 140 CONTINUE T O PM=0.  O DO 160 I=1,NPA D O KFLA(I)=IABS(K(IPA(I),2))  O PMA(I)=P(IPA(I),5) -; O C...Special cutoff masses for t, l, h with variable masses.I O IFLA=KFLA(I), O IF(KFLA(I).GE.6.AND.KFLA(I).LE.8) THEN, O IFLA=37+KFLA(I)+ISIGN(2,K(IPA(I),2)) O PMTH(1,IFLA)=PMA(I)E: O PMTH(2,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PMQTH1**2) ) O PMTH(3,IFLA)=PMTH(2,IFLA)+PMQTH2 BG O PMTH(4,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PARJ(82)**2)+PMTH(2,21) .G O PMTH(5,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PARJ(83)**2)+PMTH(2,22) a O ENDIF  O IF(KFLA(I).LE.40) THEN A1 O IF(KSH(KFLA(I)).EQ.1) PMA(I)=PMTH(3,IFLA)2 O ENDIF  O PM=PM+PMA(I) K O IF(KFLA(I).GT.40) THEN F O IREJ=IREJ+1 O ELSE 1< O IF(KSH(KFLA(I)).EQ.0.OR.PMA(I).GT.QMAX) IREJ=IREJ+1 O ENDIF  O DO 150 J=1,4  O PS(J)=PS(J)+P(IPA(I),J)  O 150 CONTINUE + O 160 CONTINUE  O IF(IREJ.EQ.NPA) RETURN +> O PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))  O IF(NPA.EQ.1) PS(5)=PS(4) .$ O IF(PS(5).LE.PM+PMQTH1) RETURN  O 3/ O C...Check if 3-jet matrix elements to be used. M3JC=0 * O IF(NPA.EQ.2.AND.MSTJ(47).GE.1) THEN ? O IF(KFLA(1).GE.1.AND.KFLA(1).LE.8.AND.KFLA(2).GE.1.AND. 0 O & KFLA(2).LE.8) M3JC=1 K@ O IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR. 6 O & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)) M3JC=1 @ O IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR. 8 O & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)+1) M3JC=1 @ O IF((KFLA(1).EQ.12.OR.KFLA(1).EQ.14.OR.KFLA(1).EQ.16.OR. 8 O & KFLA(1).EQ.18).AND.KFLA(2).EQ.KFLA(1)-1) M3JC=1 2 O IF(MSTJ(47).EQ.2.OR.MSTJ(47).EQ.4) M3JC=1  O M3JCM=0 D O IF(M3JC.EQ.1.AND.MSTJ(47).GE.3.AND.KFLA(1).EQ.KFLA(2)) THEN  O M3JCM=1 , O QME=(2.*PMTH(1,KFLA(1))/PS(5))**2  O ENDIF O ENDIF  O 5 O C...Find if interference with initial state partons. MIIS=0 E O IF(MSTJ(50).GE.1.AND.MSTJ(50).LE.3.AND.NPA.EQ.2) MIIS=MSTJ(50)  O IF(MIIS.NE.0) THEN O  O DO 180 I=1,2 . O KCII(I)=0  O KCA=LUCOMP(KFLA(I)) > O IF(KCA.NE.0) KCII(I)=KCHG(KCA,2)*ISIGN(1,K(IPA(I),2))  O NIIS(I)=0  O IF(KCII(I).NE.0) THEN  O DO 170 J=1,2 X2 O ICSI=MOD(K(IPA(I),3+J)/MSTU(5),MSTU(5)) B O IF(ICSI.GT.0.AND.ICSI.NE.IPA(1).AND.ICSI.NE.IPA(2).AND. 9 O & (KCII(I).EQ.(-1)**(J+1).OR.KCII(I).EQ.2)) THEN  O NIIS(I)=NIIS(I)+1 ! O IIIS(I,NIIS(I))=ICSI F O ENDIF  O 170 CONTINUE O  O ENDIF  O 180 CONTINUE t( O IF(NIIS(1)+NIIS(2).EQ.0) MIIS=0 O ENDIF  O U4 O C...Boost interfering initial partons to rest frame 6 O C...and reconstruct their polar and azimuthal angles.  O IF(MIIS.NE.0) THEN e O DO 200 I=1,2  O DO 190 J=1,5 1 O K(N+I,J)=K(IPA(I),J)  O P(N+I,J)=P(IPA(I),J) F O V(N+I,J)=0.  O 190 CONTINUE  O 200 CONTINUE R O DO 220 I=3,2+NIIS(1) D O DO 210 J=1,5 ." O K(N+I,J)=K(IIIS(1,I-2),J) " O P(N+I,J)=P(IIIS(1,I-2),J)  O V(N+I,J)=0.  O 210 CONTINUE . O 220 CONTINUE O - O DO 240 I=3+NIIS(1),2+NIIS(1)+NIIS(2) N O DO 230 J=1,5 * O K(N+I,J)=K(IIIS(2,I-2-NIIS(1)),J) * O P(N+I,J)=P(IIIS(2,I-2-NIIS(1)),J)  O V(N+I,J)=0.  O 230 CONTINUE 0 O 240 CONTINUE FF O CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),0.,0.,-DBLE(PS(1)/PS(4)), / O & -DBLE(PS(2)/PS(4)),-DBLE(PS(3)/PS(4))) & O PHI=ULANGL(P(N+1,1),P(N+1,2)) A O CALL LUDBRB(N+1,N+2 IS(1)+NIIS(2),0.,-PHI,0D0,0D0,0D0) K& O THE=ULANGL(P(N+1,3),P(N+1,1)) A O CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),-THE,0.,0D0,0D0,0D0)  O DO 250 I=3,2+NIIS(1) E O THEIIS(1,I-2)=ULANGL(P(N+I,3),SQRT(P(N+I,1)**2+P(N+I,2)**2)) F0 O PHIIIS(1,I-2)=ULANGL(P(N+I,1),P(N+I,2))  O 250 CONTINUE L- O DO 260 I=3+NIIS(1),2+NIIS(1)+NIIS(2) 7 O THEIIS(2,I-2-NIIS(1))=PARU(1)-ULANGL(P(N+I,3), F' O & SQRT(P(N+I,1)**2+P(N+I,2)**2)) 8 O PHIIIS(2,I-2-NIIS(1))=ULANGL(P(N+I,1),P(N+I,2))  O 260 CONTINUE O ENDIF  O .B O C...Define imagined single initiator of shower for parton system. O NS=N K' O IF(N.GT.MSTU(4)-MSTU(32)-5) THEN PB O CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS') ! O IF(MSTU(21).GE.1) RETURN D O ENDIF  O IF(NPA.GE.2) THEN  O K(N+1,1)=11  O K(N+1,2)=21  O K(N+1,3)=0 M O K(N+1,4)=0 O  O K(N+1,5)=0 , O P(N+1,1)=0.  O P(N+1,2)=0.  O P(N+1,3)=0.  O P(N+1,4)=PS(5) + O P(N+1,5)=PS(5) B O V(N+1,5)=PS(5)**2  O N=N+1 O ENDIF  O ' O C...Loop over partons that may branch. T O NEP=NPA O IM=NS  O IF(NPA.EQ.1) IM=NS-1 . O 270 IM=IM+1  O IF(N.GT.NS) THEN S O IF(IM.GT.N) GOTO 510 T O KFLM=IABS(K(IM,2)) K O IF(KFLM.GT.40) GOTO 270 $ O IF(KSH(KFLM).EQ.0) GOTO 270  O IFLM=KFLMFB O IF(KFLM.GE.6.AND.KFLM.LE.8) IFLM=37+KFLM+ISIGN(2,K(IM,2)) - O IF(P(IM,5).LT.PMTH(2,IFLM)) GOTO 270 ) O IGM=K(IM,3) O ELSE O O IGM=-1 e O ENDIF + O IF(N+NEP.GT.MSTU(4)-MSTU(32)-5) THEN FB O CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS') ! O IF(MSTU(21).GE.1) RETURN T O ENDIF  O (3 O C...Position of aunt (sister to branching parton). O % O C...Origin and flavour of daughters. O IAU=0  O IF(IGM.GT.0) THEN & O IF(K(IM-1,3).EQ.IGM) IAU=IM-1 4 O IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1 O ENDIF  O IF(IGM.GE.0) THEN  O K(IM,4)=N+1  O DO 280 I=1,NEP  O K(N+I,3)=IM  O 280 CONTINUE L O ELSE  O K(N+1,3)=IPA(1) O ENDIF  O IF(IGM.LE.0) THEN  O DO 290 I=1,NEP  O K(N+I,2)=K(IPA(I),2) K O 290 CONTINUE R O ELSEIF(KFLM.NE.21) THEN  O K(N+1,2)=K(IM,2)  O K(N+2,2)=K(IM,5) o! O ELSEIF(K(IM,5).EQ.21) THEN i O K(N+1,2)=21  O K(N+2,2)=21 O ELSE  O K(N+1,2)=K(IM,5)  O K(N+2,2)=-K(IM,5) O ENDIF  O L, O C...Reset flags on daughers and tries made.  O DO 300 IP=1,NEP  O K(N+IP,1)=3  O K(N+IP,4)=0  O K(N+IP,5)=0  O KFLD(IP)=IABS(K(N+IP,2)) )4 O IF(KCHG(LUCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1  O ITRY(IP)=0 K O ISL(IP)=0  O ISI(IP)=0  O IF(KFLD(IP).LE.40) THEN ) O IF(KSH(KFLD(IP)).EQ.1) ISI(IP)=1 O ENDIF  O 300 CONTINUE e ISLM=0  O F% O C...Maximum virtuality of daughters. ( O IF(IGM.LE.0) THEN  O DO 310 I=1,NPA D O IF(NPA.GE.3) P(N+I,4)=(PS(4)*P(IPA(I),4)-PS(1)*P(IPA(I),1)- 3 O & PS(2)*P(IPA(I),2)-PS(3)*P(IPA(I),3))/PS(5) 1! O P(N+I,5)=MIN(QMAX,PS(5)) A5 O IF(NPA.GE.3) P(N+I,5)=MIN(P(N+I,5),P(N+I,4)) F- O IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5) * O 310 CONTINUE 5 O ELSE 3& O IF(MSTJ(43).LE.2) PEM=V(IM,2) & O IF(MSTJ(43).GE.3) PEM=P(IM,4) * O P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM) / O P(N+2,5)=MIN(P(IM,5),(1.-V(IM,1))*PEM) K/ O IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22) A O ENDIF  O DO 320 I=1,NEP K O PMSD(I)=P(N+I,5)  O IF(ISI(I).EQ.1) THEN F O IFLD=KFLD(I): O IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ O & ISIGN(2,K(N+I,2)) ; O IF(P(N+I,5).LE.PMTH(3,IFLD)) P(N+I,5)=PMTH(1,IFLD) . O ENDIF  O V(N+I,5)=P(N+I,5)**2  O 320 CONTINUE O  O / O C...Choose one of the daughters for evolution. T 330 INUM=0  O IF(NEP.EQ.1) INUM=1  O DO 340 I=1,NEP F+ O IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I L O 340 CONTINUE  O DO 350 I=1,NEP A: O IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN  O IFLD=KFLD(I): O IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ O & ISIGN(2,K(N+I,2)) , O IF(P(N+I,5).GE.PMTH(2,IFLD)) INUM=I O ENDIF  O 350 CONTINUE c O IF(INUM.EQ.0) THEN E O RMAX=0.  O DO 360 I=1,NEP 3 O IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN K O RPM=P(N+I,5)/PMSD(I)  O IFLD=KFLD(I)< O IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ O & ISIGN(2,K(N+I,2)) < O IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,IFLD)) THEN  O RMAX=RPM K O INUM=I 0 O ENDIF  O ENDIF  O 360 CONTINUE G O ENDIF  O 06 O C...Store information on choice of evolving daughter.  O INUM=MAX(1,INUM) t O IEP(1)=N+INUM  O DO 370 I=2,NEP F O IEP(I)=IEP(I-1)+1 % O IF(IEP(I).GT.N+NEP) IEP(I)=N+1 N O 370 CONTINUE L O DO 380 I=1,NEP - O KFL(I)=IABS(K(IEP(I),2))  O 380 CONTINUE ' O ITRY(INUM)=ITRY(INUM)+1 ! O IF(ITRY(INUM).GT.200) THEN < O CALL LUERRM(14,'(LUSHOW:) caught in infinite loop') ! O IF(MSTU(21).GE.1) RETURN I O ENDIF O Z=0.5 O IF(KFL(1).GT.40) GOTO 430 $ O IF(KSH(KFL(1)).EQ.0) GOTO 430  O IFL=KFL(1)4 O IF(KFL(1).GE.6.AND.KFL(1).LE.8) IFL=37+KFL(1)+ O &ISIGN(2,K(IEP(1),2)) p. O IF(P(IEP(1),5).LT.PMTH(2,IFL)) GOTO 430  O = O C...Select side for interference with initial state partons. ), O IF(MIIS.GE.1.AND.IEP(1).LE.NS+3) THEN  O III=IEP(1)-NS-1  O ISII(III)=0 9 O IF(IABS(KCII(III)).EQ.1.AND.NIIS(III).EQ.1) THEN 2 O ISII(III)=1 7 O ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.1) THEN ( O IF(RLU(0).GT.0.5) ISII(III)=1 7 O ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.2) THEN U O ISII(III)=1 ( O IF(RLU(0).GT.0.5) ISII(III)=2  O ENDIF O ENDIF  O z O C...Calculate allowed z range. , O IF(NEP.EQ.1) THEN  O PMED=PS(4) D- O ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN ) O PMED=P(IM,5) , O ELSE ' O IF(INUM.EQ.1) PMED=V(IM,1)*PEM n, O IF(INUM.EQ.2) PMED=(1.-V(IM,1))*PEM O ENDIF $ O IF(MOD(MSTJ(43),2).EQ.1) THEN  O ZC=PMTH(2,21)/PMED d O ZCE=PMTH(2,22)/PMED O ELSE m= O ZC=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,21)/PMED)**2))) K/ O IF(ZC.LT.1E-4) ZC=(PMTH(2,21)/PMED)**2 > O ZCE=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,22)/PMED)**2))) 1 O IF(ZCE.LT.1E-4) ZCE=(PMTH(2,22)/PMED)**2 ) O ENDIF  O ZC=MIN(ZC,0.491) 4 O ZCE=MIN(ZCE,0.491) ? O IF((MSTJ(41).EQ.1.AND.ZC.GT.0.49).OR.(MSTJ(41).GE.2.AND. K! O &MIN(ZC,ZCE).GT.0.49)) THEN O P(IEP(1),5)=PMTH(1,IFL) # O V(IEP(1),5)=P(IEP(1),5)**2 R O GOTO 430 F O ENDIF  O D3 O C...Integral of Altarelli-Parisi z kernel for QCD. P. O IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN 1 O FBR=6.*LOG((1.-ZC)/ZC)+MSTJ(45)*(0.5-ZC) D! O ELSEIF(MSTJ(49).EQ.0) THEN Q$ O FBR=(8./3.)*LOG((1.-ZC)/ZC)  O F< O C...Integral of Altarelli-Parisi z kernel for scalar gluon. 2 O ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN 4 O FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1.-2.*ZC) ! O ELSEIF(MSTJ(49).EQ.1) THEN  O FBR=(1.-2.*ZC)/3. . O IF(IGM.EQ.0.AND.M3JC.EQ.1) FBR=4.*FBR  O ED O C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon. O ELSEIF(KFL(1).EQ.21) THEN ! O FBR=6.*MSTJ(45)*(0.5-ZC) T O ELSE . O FBR=2.*LOG((1.-ZC)/ZC) Z O ENDIF  O .& O C...Reset QCD probability for lepton. / O IF(KFL(1).GE.11.AND.KFL(1).LE.18) FBR=0. b O o= O C...Integral of Altarelli-Parisi kernel for photon emission. A> O IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN 9 O FBRE=(KCHG(KFL(1),1)/3.)**2*2.*LOG((1.-ZCE)/ZCE) V. O IF(MSTJ(41).EQ.10) FBRE=PARJ(84)*FBRE O ENDIF  O B O C...Inner veto algorithm starts. Find maximum mass for evolution.  O 390 PMS=V(IEP(1),5)  O IF(IGM.GE.0) THEN  O PM2=0. B O DO 400 I=2,NEP  O PM=P(IEP(I),5) - O IF(KFL(I).LE.40) THEN  O IFLI=KFL(I)E9 O IF(KFL(I).GE.6.AND.KFL(I).LE.8) IFLI=37+KFL(I)+A O & ISIGN(2,K(IEP(I),2)) 1/ O IF(KSH(KFL(I)).EQ.1) PM=PMTH(2,IFLI) o O ENDIF  O PM2=PM2+PM h O 400 CONTINUE =& O PMS=MIN(PMS,(P(IM,5)-PM2)**2) O ENDIF  O O / O C...Select mass for daughter in QCD evolution.  O B0=27./6.  O DO 410 IFF=4,MSTJ(45) 6 O IF(PMS.GT.4.*PMTH(2,IFF)**2) B0=(33.-2.*IFF)/6.  O 410 CONTINUE  O IF(FBR.LT.1E-3) THEN ) O PMSQCD=0. ! O ELSEIF(MSTJ(44).LE.0) THEN F O PMSQCD=PMS*EXP(MAX(-50.,LOG(RLU(0))*PARU(2)/(PARU(111)*FBR))) ! O ELSEIF(MSTJ(44).EQ.1) THEN G= O PMSQCD=4.*ALAMS*(0.25*PMS/ALAMS)**(RLU(0)**(B0/FBR)) O O ELSE =: O PMSQCD=PMS*EXP(MAX(-50.,ALFM*B0*LOG(RLU(0))/FBR)) O ENDIF G O IF(ZC.GT.0.49.OR.PMSQCD.LE.PMTH(4,IFL)**2) PMSQCD=PMTH(2,IFL)**2  O V(IEP(1),5)=PMSQCD B O MCE=1  O O / O C...Select mass for daughter in QED evolution. M> O IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN G O PMSQED=PMS*EXP(MAX(-50.,LOG(RLU(0))*PARU(2)/(PARU(101)*FBRE))) n< O IF(ZCE.GT.0.49.OR.PMSQED.LE.PMTH(5,IFL)**2) PMSQED=  O & PMTH(2,IFL)**2 " O IF(PMSQED.GT.PMSQCD) THEN  O V(IEP(1),5)=PMSQED E O MCE=2  O ENDIF O ENDIF  O ). O C...Check whether daughter mass below cutoff. $ O P(IEP(1),5)=SQRT(V(IEP(1),5)) * O IF(P(IEP(1),5).LE.PMTH(3,IFL)) THEN O P(IEP(1),5)=PMTH(1,IFL) # O V(IEP(1),5)=P(IEP(1),5)**2  O GOTO 430 Z O ENDIF  O . O C...Select z value of branching: q -> qgamma.  O IF(MCE.EQ.2) THEN - O Z=1.-(1.-ZCE)*(ZCE/(1.-ZCE))**RLU(0) ** O IF(1.+Z**2.LT.2.*RLU(0)) GOTO 390  O K(IEP(1),5)=22 u O s? O C...Select z value of branching: q -> qg, g -> gg, g -> qqbar. 2 O ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN * O Z=1.-(1.-ZC)*(ZC/(1.-ZC))**RLU(0) * O IF(1.+Z**2.LT.2.*RLU(0)) GOTO 390  O K(IEP(1),5)=21 DE O ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*(0.5-ZC).LT.RLU(0)*FBR) THEN ,' O Z=(1.-ZC)*(ZC/(1.-ZC))**RLU(0) 5! O IF(RLU(0).GT.0.5) Z=1.-Z A0 O IF((1.-Z*(1.-Z))**2.LT.RLU(0)) GOTO 390  O K(IEP(1),5)=21 N! O ELSEIF(MSTJ(49).NE.1) THEN I O Z=ZC+(1.-2.*ZC)*RLU(0) e. O IF(Z**2+(1.-Z)**2.LT.RLU(0)) GOTO 390 $ O KFLB=1+INT(MSTJ(45)*RLU(0)) + O PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) . O IF(PMQ.GE.1.) GOTO 390 R* O PMQ0=4.*PMTH(2,21)**2/V(IEP(1),5) B O IF(MOD(MSTJ(43),2).EQ.0.AND.(1.+0.5*PMQ)*SQRT(1.-PMQ).LT. 5 O & RLU(0)*(1.+0.5*PMQ0)*SQRT(1.-PMQ0)) GOTO 390 5 O K(IEP(1),5)=KFLB 3 O )" O C...Ditto for scalar gluon model. O ELSEIF(KFL(1).NE.21) THEN + O Z=1.-SQRT(ZC**2+RLU(0)*(1.-2.*ZC)) M O K(IEP(1),5)=21 *C O ELSEIF(RLU(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN 2 O Z=ZC+(1.-2.*ZC)*RLU(0) P O K(IEP(1),5)=21 P O ELSE  O Z=ZC+(1.-2.*ZC)*RLU(0) R$ O KFLB=1+INT(MSTJ(45)*RLU(0)) + O PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) ( O IF(PMQ.GE.1.) GOTO 390 I O K(IEP(1),5)=KFLB K O ENDIF * O IF(MCE.EQ.1.AND.MSTJ(44).GE.2) THEN 4 O IF(Z*(1.-Z)*V(IEP(1),5).LT.PT2MIN) GOTO 390 D O IF(ALFM/LOG(V(IEP(1),5)*Z*(1.-Z)/ALAMS).LT.RLU(0)) GOTO 390 O ENDIF  O O ) O C...Check if z consistent with chosen m. P O IF(KFL(1).EQ.21) THEN ! O KFLGD1=IABS(K(IEP(1),5)) 7 O KFLGD2=KFLGD1 O ELSE ) O KFLGD1=KFL(1) ! O KFLGD2=IABS(K(IEP(1),5)) T O ENDIF  O IF(NEP.EQ.1) THEN  O PED=PS(4)  O ELSEIF(NEP.GE.3) THEN  O PED=P(IEP(1),4) - O ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN 5 O PED=0.5*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5) L O ELSE ** O IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM / O IF(IEP(1).EQ.N+2) PED=(1.-V(IM,1))*PEM O ENDIF $ O IF(MOD(MSTJ(43),2).EQ.1) THEN  O IFLGD1=KFLGD1 2 O IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFL O PMQTH3=0.5*PARJ(82) - O IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) 7 O PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(IEP(1),5) 7 O PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(IEP(1),5) DC O ZD=SQRT(MAX(0.,(1.-V(IEP(1),5)/PED**2)*((1.-PMQ1-PMQ2)**2-  O & 4.*PMQ1*PMQ2)))  O ZH=1.+PMQ1-PMQ2 O ELSE q/ O ZD=SQRT(MAX(0.,1.-V(IEP(1),5)/PED**2))  O ZH=1. O ENDIF  O ZL=0.5*(ZH-ZD) O  O ZU=0.5*(ZH+ZD) 1& O IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 390 @ O IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*  O &(1.-ZU))) A O IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1.-ZL)/MAX(1E-10,1.-ZU)) D O % O C...Width suppression for q -> q + g.M- O IF(MSTJ(40).NE.0.AND.KFL(1).NE.21) THENo O IF(IGM.EQ.0) THENs: O EGLU=0.5*PS(5)*(1.-Z)*(1.+V(IEP(1),5)/V(NS+1,5)) O ELSE O EGLU=PMED*(1.-Z) ENDIF O - O CHI=PARJ(89)**2/(PARJ(89)**2+EGLU**2)L O IF(MSTJ(40).EQ.1) THEN& O IF(CHI.LT.RLU(0)) GOTO 390 " O ELSEIF(MSTJ(40).EQ.2) THEN' O IF(1.-CHI.LT.RLU(0)) GOTO 390H ENDIF O ENDIF) O R) O C...Three-jet matrix element correction. 2& O IF(IGM.EQ.0.AND.M3JC.EQ.1) THEN ( O X1=Z*(1.+V(IEP(1),5)/V(NS+1,5)) $ O X2=1.-V(IEP(1),5)/V(NS+1,5)  O X3=(1.-X1)+(1.-X2) K O IF(MCE.EQ.2) THEN  O KI1=K(IPA(INUM),2)  O KI2=K(IPA(3-INUM),2) (0 O QF1=KCHG(IABS(KI1),1)*ISIGN(1,KI1)/3. 0 O QF2=KCHG(IABS(KI2),1)*ISIGN(1,KI2)/3. 8 O WSHOW=QF1**2*(1.-X1)/X3*(1.+(X1/(2.-X2))**2)+ 1 O & QF2**2*(1.-X2)/X3*(1.+(X2/(2.-X1))**2) *? O WME=(QF1*(1.-X1)/X3-QF2*(1.-X2)/X3)**2*(X1**2+X2**2) L# O ELSEIF(MSTJ(49).NE.1) THEN f/ O WSHOW=1.+(1.-X1)/X3*(X1/(2.-X2))**2+ 0% O & (1.-X2)/X3*(X2/(2.-X1))**2 ) O WME=X1**2+X2**2 4 O IF(M3JCM.EQ.1) WME=WME-QME*X3-0.5*QME**2- 9 O & (0.5*QME+0.25*QME**2)*((1.-X2)/MAX(1E-7,1.-X1)+)# O & (1.-X1)/MAX(1E-7,1.-X2)) ELSE A> O WSHOW=4.*X3*((1.-X1)/(2.-X2)**2+(1.-X2)/(2.-X1)**2)  O WME=X3**2 C O IF(MSTJ(102).GE.2) WME=X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)* O  O & PARJ(171)  O ENDIF ) O IF(WME.LT.RLU(0)*WSHOW) GOTO 390 . O 1A O C...Impose angular ordering by rejection of nonordered emission. S; O ELSEIF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2) THEN A O MAOM=1 A O ZM=V(IM,1) )( O IF(IEP(1).EQ.N+2) ZM=1.-V(IM,1) 4 O THE2ID=Z*(1.-Z)*(ZM*P(IM,4))**2/V(IEP(1),5)  O IAOM=IM ! O 420 IF(K(IAOM,5).EQ.22) THEN t O IAOM=K(IAOM,3) % O IF(K(IAOM,3).LE.NS) MAOM=0 E! O IF(MAOM.EQ.1) GOTO 420  O ENDIF  O IF(MAOM.EQ.1) THEN 2A O THE2IM=V(IAOM,1)*(1.-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5) A( O IF(THE2ID.LT.THE2IM) GOTO 390  O ENDIF O ENDIF  O : O C...Impose user-defined maximum angle at first branching.  O IF(MSTJ(48).EQ.1) THEN )' O IF(NEP.EQ.1.AND.IM.EQ.NS) THEN S/ O THE2ID=Z*(1.-Z)*PS(4)**2/V(IEP(1),5) K0 O IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390 1 O ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN I7 O THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) 0 O IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390 1 O ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN 7 O THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) s0 O IF(THE2ID.LT.1./PARJ(86)**2) GOTO 390  O ENDIF O ENDIF  O 0C O C...Impose angular constraint in first branching from interference O C...with initial state partons. , O IF(MIIS.GE.2.AND.IEP(1).LE.NS+3) THEN B O THE2D=MAX((1.-Z)/Z,Z/(1.-Z))*V(IEP(1),5)/(0.5*P(IM,4))**2 1 O IF(IEP(1).EQ.NS+2.AND.ISII(1).GE.1) THEN P5 O IF(THE2D.GT.THEIIS(1,ISII(1))**2) GOTO 390 E5 O ELSEIF(IEP(1).EQ.NS+3.AND.ISII(2).GE.1) THEN I5 O IF(THE2D.GT.THEIIS(2,ISII(2))**2) GOTO 390 ) O ENDIF O ENDIF  O G O C...End of inner veto algorithm. Check if only one leg evolved so far. N O 430 V(IEP(1),1)=Z  O ISL(1)=0 L O ISL(2)=0 S O IF(NEP.EQ.1) GOTO 460 C O IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 330 H O DO 440 I=1,NEP ,. O IF(ITRY(I).EQ.0.AND.KFLD(I).LE.40) THEN # O IF(KSH(KFLD(I)).EQ.1) THEN = O IFLD=KFLD(I)< O IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ O & ISIGN(2,K(N+I,2)) 0 O IF(P(N+I,5).GE.PMTH(2,IFLD)) GOTO 330  O ENDIF O ENDIF  O 440 CONTINUE S O I7 O C...Check if chosen multiplet m1,m2,z1,z2 is physical.  O IF(NEP.EQ.3) THEN 5 O PA1S=(P(N+1,4)+P(N+1,5))*(P(N+1,4)-P(N+1,5)) L5 O PA2S=(P(N+2,4)+P(N+2,5))*(P(N+2,4)-P(N+2,5)) )5 O PA3S=(P(N+3,4)+P(N+3,5))*(P(N+3,4)-P(N+3,5)) ,: O PTS=0.25*(2.*PA1S*PA2S+2.*PA1S*PA3S+2.*PA2S*PA3S- & O & PA1S**2-PA2S**2-PA3S**2)/PA1S  O IF(PTS.LE.0.) GOTO 330 FE O ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN m O DO 450 I1=N+1,N+2  O KFLDA=IABS(K(I1,2)) ! O IF(KFLDA.GT.40) GOTO 450 G% O IF(KSH(KFLDA).EQ.0) GOTO 450  O IFLDA=KFLDA 5 O IF(KFLDA.GE.6.AND.KFLDA.LE.8) IFLDA=37+KFLDA+0 O & ISIGN(2,K(I1,2)) . O IF(P(I1,5).LT.PMTH(2,IFLDA)) GOTO 450  O IF(KFLDA.EQ.21) THEN + O KFLGD1=IABS(K(I1,5)) ( O KFLGD2=KFLGD1 ELSE O  O KFLGD1=KFLDA t O KFLGD2=IABS(K(I1,5))  O ENDIF  O I2=2*N+3-I1 + O IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN O 4 O PED=0.5*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5) ELSE # O IF(I1.EQ.N+1) ZM=V(IM,1) K& O IF(I1.EQ.N+2) ZM=1.-V(IM,1) 3 O PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2- M O & 4.*V(N+1,5)*V(N+2,5)) E O PED=PEM*(0.5*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/V(IM,5)  O ENDIF & O IF(MOD(MSTJ(43),2).EQ.1) THEN  O PMQTH3=0.5*PARJ(82) / O IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) T O IFLGD1=KFLGD1.6 O IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFLDA5 O PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(I1,5) o5 O PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(I1,5) O A O ZD=SQRT(MAX(0.,(1.-V(I1,5)/PED**2)*((1.-PMQ1-PMQ2)**2- I O & 4.*PMQ1*PMQ2)))  O ZH=1.+PMQ1-PMQ2 ELSE - O ZD=SQRT(MAX(0.,1.-V(I1,5)/PED**2))  O ZH=1.  O ENDIF  O ZL=0.5*(ZH-ZD) ( O ZU=0.5*(ZH+ZD) ID O IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(1)=1 D O IF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(2)=1 F O IF(KFLDA.EQ.21) V(I1,4)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL* .-ZU))) > O IF(KFLDA.NE.21) V(I1,4)=LOG((1.-ZL)/MAX(1E-10,1.-ZU))  O 450 CONTINUE ; O IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN  O ISL(3-ISLM)=0  O ISLM=3-ISLM 1 O ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN 6 O ZDR1=MAX(0.,V(N+1,3)/MAX(1E-6,V(N+1,4))-1.) 6 O ZDR2=MAX(0.,V(N+2,3)/MAX(1E-6,V(N+2,4))-1.) 2 O IF(ZDR2.GT.RLU(0)*(ZDR1+ZDR2)) ISL(1)=0 # O IF(ISL(1).EQ.1) ISL(2)=0 )! O IF(ISL(1).EQ.0) ISLM=1 .! O IF(ISL(2).EQ.0) ISLM=2  O ENDIF 0 O IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 330 O ENDIF  O IFLD1=KFLD(1) 9 O IF(KFLD(1).GE.6.AND.KFLD(1).LE.8) IFLD1=37+KFLD(1)+P O &ISIGN(2,K(N+1,2))  O IFLD2=KFLD(2)(9 O IF(KFLD(2).GE.6.AND.KFLD(2).LE.8) IFLD2=37+KFLD(2)+Q O &ISIGN(2,K(N+2,2)) = O IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE. Q8 O &PMTH(2,IFLD1).OR.P(N+2,5).GE.PMTH(2,IFLD2))) THEN  O PMQ1=V(N+1,5)/V(IM,5)  O PMQ2=V(N+2,5)/V(IM,5) ? O ZD=SQRT(MAX(0.,(1.-V(IM,5)/PEM**2)*((1.-PMQ1-PMQ2)**2-  O & 4.*PMQ1*PMQ2)))  O ZH=1.+PMQ1-PMQ2  O ZL=0.5*(ZH-ZD) N O ZU=0.5*(ZH+ZD) 4 O IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 330 O ENDIF  O IB O C...Accepted branch. Construct four-momentum for initial partons.  O 460 MAZIP=0  O MAZIC=0  O IF(NEP.EQ.1) THEN  O P(N+1,1)=0.  O P(N+1,2)=0. B O P(N+1,3)=SQRT(MAX(0.,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)-  O & P(N+1,5))))  O P(N+1,4)=P(IPA(1),4) v O V(N+1,2)=P(N+1,4) ) O ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN 15 O PED1=0.5*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5)  O P(N+1,1)=0.  O P(N+1,2)=0. ? O P(N+1,3)=SQRT(MAX(0.,(PED1+P(N+1,5))*(PED1-P(N+1,5)))) F O P(N+1,4)=PED1  O P(N+2,1)=0.  O P(N+2,2)=0.  O P(N+2,3)=-P(N+1,3)  O P(N+2,4)=P(IM,5)-PED1  O V(N+1,2)=P(N+1,4)  O V(N+2,2)=P(N+2,4)  O ELSEIF(NEP.EQ.3) THEN  O P(N+1,1)=0.  O P(N+1,2)=0. $ O P(N+1,3)=SQRT(MAX(0.,PA1S))  O P(N+2,1)=SQRT(PTS) P O P(N+2,2)=0. / O P(N+2,3)=0.5*(PA3S-PA2S-PA1S)/P(N+1,3) . O P(N+3,1)=-P(N+2,1) & O P(N+3,2)=0. & O P(N+3,3)=-(P(N+1,3)+P(N+2,3))  O V(N+1,2)=P(N+1,4)  O V(N+2,2)=P(N+2,4)  O V(N+3,2)=P(N+3,4)  O O D O C...Construct transverse momentum for ordinary branching in shower. O ELSE c O ZM=V(IM,1) r6 O PZM=SQRT(MAX(0.,(PEM+P(IM,5))*(PEM-P(IM,5)))) A O PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4.*V(N+1,5)*V(N+2,5) N O IF(PZM.LE.0.) THEN N O PTS=0. I* O ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN < O PTS=(PEM**2*(ZM*(1.-ZM)*V(IM,5)-(1.-ZM)*V(N+1,5)- ) O & ZM*V(N+2,5))-0.25*PMLS)/PZM**2 ( ELSE a; O PTS=PMLS*(ZM*(1.-ZM)*PEM**2/V(IM,5)-0.25)/PZM**2 O  O ENDIF  O PT=SQRT(MAX(0.,PTS)) 4 O GG O C...Find coefficient of azimuthal asymmetry due to gluon polarization. F O HAZIP=0. LE O IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21. 1 O & AND.IAU.NE.0) THEN $ O IF(K(IGM,3).NE.0) MAZIP=1  O ZAU=V(IGM,1) n* O IF(IAU.EQ.IM+1) ZAU=1.-V(IGM,1) O IF(MAZIP.EQ.0) ZAU=0. " O IF(K(IGM,2).NE.21) THEN % O HAZIP=2.*ZAU/(1.+ZAU**2) H O ELSE S- O HAZIP=(ZAU/(1.-ZAU*(1.-ZAU)))**2 I O ENDIF " O IF(K(N+1,2).NE.21) THEN < O HAZIP=HAZIP*(-2.*ZM*(1.-ZM))/(1.-2.*ZM*(1.-ZM))  O ELSE S8 O HAZIP=HAZIP*(ZM*(1.-ZM)/(1.-ZM*(1.-ZM)))**2  O ENDIF  O ENDIF  O c> O C...Find coefficient of azimuthal asymmetry due to soft gluon  O C...interference.  O HAZIC=0. (C O IF(MSTJ(49).NE.2.AND.MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR. U+ O & K(N+2,2).EQ.21).AND.IAU.NE.0) THEN Q& O IF(K(IGM,3).NE.0) MAZIC=N+1 9 O IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2 1F O IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND.  O & ZM.GT.0.5) MAZIC=N+2 E% O IF(K(IAU,2).EQ.22) MAZIC=0 P O ZS=ZM $ O IF(MAZIC.EQ.N+2) ZS=1.-ZM  O ZGM=V(IGM,1) )* O IF(IAU.EQ.IM-1) ZGM=1.-V(IGM,1) O IF(MAZIC.EQ.0) ZGM=1. 2 O IF(MAZIC.NE.0) HAZIC=(P(IM,5)/P(IGM,5))** O & SQRT((1.-ZS)*(1.-ZGM)/(ZS*ZGM)) O HAZIC=MIN(0.95,HAZIC)  O ENDIF O ENDIF  O ); O C...Construct kinematics for ordinary branching in shower. % O 470 IF(NEP.EQ.2.AND.IGM.GT.0) THEN e& O IF(MOD(MSTJ(43),2).EQ.1) THEN  O P(N+1,4)=PEM*V(IM,1) K ELSE ED O P(N+1,4)=PEM*(0.5*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+ ! O & SQRT(PMLS)*ZM)/V(IM,5) 8 O ENDIF  O PHI=PARU(2)*RLU(0) l O P(N+1,1)=PT*COS(PHI) l O P(N+1,2)=PT*SIN(PHI) 9 O IF(PZM.GT.0.) THEN G O P(N+1,3)=0.5*(V(N+2,5)-V(N+1,5)-V(IM,5)+2.*PEM*P(N+1,4))/PZM ( ELSE  O P(N+1,3)=0.  O ENDIF  O P(N+2,1)=-P(N+1,1) 4 O P(N+2,2)=-P(N+1,2) l O P(N+2,3)=PZM-P(N+1,3)  O P(N+2,4)=PEM-P(N+1,4)  O IF(MSTJ(43).LE.2) THEN =7 O V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5) (7 O V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5)  O ENDIF O ENDIF  O 1 O C...Rotate and boost daughters.  O IF(IGM.GT.0) THEN  O IF(MSTJ(43).LE.2) THEN . O BEX=P(IGM,1)/P(IGM,4) O BEY=P(IGM,2)/P(IGM,4) O BEZ=P(IGM,3)/P(IGM,4)  O GA=P(IGM,4)/P(IGM,5) F O GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1.+GA)-  O & P(IM,4)) n ELSE f O BEX=0. 9 O BEY=0. O  O BEZ=0. T O GA=1.  O GABEP=0. I O ENDIF B O THE=ULANGL(P(IM,3)+GABEP*BEZ,SQRT((P(IM,1)+GABEP*BEX)**2+ ! O & (P(IM,2)+GABEP*BEY)**2)) D8 O PHI=ULANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY)  O DO 480 I=N+1,N+2 L8 O DP(1)=COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+ ! O & SIN(THE)*COS(PHI)*P(I,3) 8 O DP(2)=COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+ ! O & SIN(THE)*SIN(PHI)*P(I,3) t/ O DP(3)=-SIN(THE)*P(I,1)+COS(THE)*P(I,3) ( O DP(4)=P(I,4) .* O DBP=BEX*DP(1)+BEY*DP(2)+BEZ*DP(3) ) O DGABP=GA*(GA*DBP/(1D0+GA)+DP(4))  O P(I,1)=DP(1)+DGABP*BEX T O P(I,2)=DP(2)+DGABP*BEY D O P(I,3)=DP(3)+DGABP*BEZ U O P(I,4)=GA*(DP(4)+DBP)  O 480 CONTINUE O ENDIF  O M5 O C...Weight with azimuthal distribution, if required. ( O IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN  O DO 490 J=1,3 B O DPT(1,J)=P(IM,J) F O DPT(2,J)=P(IAU,J)  O DPT(3,J)=P(N+1,J)  O 490 CONTINUE EC O DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3) EC O DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3) 11 O DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2 ) O DO 500 J=1,3 R- O DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/DPMM H- O DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/DPMM O  O 500 CONTINUE T; O DPT(4,4)=SQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2) =; O DPT(5,4)=SQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2) t8 O IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1*PARJ(82)) THEN 4 O CAD=(DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+ 1 O & DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4)) E O IF(MAZIP.NE.0) THEN B O IF(1.+HAZIP*(2.*CAD**2-1.).LT.RLU(0)*(1.+ABS(HAZIP)))  O & GOTO 470  O ENDIF  O IF(MAZIC.NE.0) THEN & O IF(MAZIC.EQ.N+2) CAD=-CAD D O IF((1.-HAZIC)*(1.-HAZIC*CAD)/(1.+HAZIC**2-2.*HAZIC*CAD) ! O & .LT.RLU(0)) GOTO 470  O ENDIF  O ENDIF O ENDIF  O I O C...Azimuthal anisotropy due to interference with initial state partons. B O IF(MOD(MIIS,2).EQ.1.AND.IGM.EQ.NS+1.AND.(K(N+1,2).EQ.21.OR.  O &K(N+2,2).EQ.21)) THEN  O III=IM-NS-1 O IF(ISII(III).GE.1) THEN  O IAZIID=N+1 Z( O IF(K(N+1,2).NE.21) IAZIID=N+2 4 O IF(K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND. + O & P(N+1,4).GT.P(N+2,4)) IAZIID=N+2 LI O THEIID=ULANGL(P(IAZIID,3),SQRT(P(IAZIID,1)**2+P(IAZIID,2)**2)) M- O IF(III.EQ.2) THEIID=PARU(1)-THEIID 21 O PHIIID=ULANGL(P(IAZIID,1),P(IAZIID,2)) 7 O HAZII=MIN(0.95,THEIID/THEIIS(III,ISII(III))) M0 O CAD=COS(PHIIID-PHIIIS(III,ISII(III))) 3 O PHIREL=ABS(PHIIID-PHIIIS(III,ISII(III))) 06 O IF(PHIREL.GT.PARU(1)) PHIREL=PARU(2)-PHIREL B O IF((1.-HAZII)*(1.-HAZII*CAD)/(1.+HAZII**2-2.*HAZII*CAD)  O & .LT.RLU(0)) GOTO 470  O ENDIF O ENDIF  O RA O C...Continue loop over partons that may branch, until none left. C O IF(IGM.GE.0) K(IM,1)=14  O N=N+NEP O NEP=2 ' O IF(N.GT.MSTU(4)-MSTU(32)-5) THEN B O CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')  O IF(MSTU(21).GE.1) N=NS O! O IF(MSTU(21).GE.1) RETURN O O ENDIF  O GOTO 270 . O .2 O C...Set information on imagined shower initiator.  O 510 IF(NPA.GE.2) THEN  O K(NS+1,1)=11 ( O K(NS+1,2)=94 T O K(NS+1,3)=IP1 2 O IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2  O K(NS+1,4)=NS+2 2 O K(NS+1,5)=NS+1+NPA ( O IIM=1 O ELSE 2 O IIM=0 O ENDIF  O F, O C...Reconstruct string drawing information.  O DO 520 I=NS+1+IIM,N - O IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN F O K(I,1)=1 6 O ELSEIF(K(I,1).LE.10.AND.IABS(K(I,2)).GE.11.AND.  O &IABS(K(I,2)).LE.18) THEN V O K(I,1)=1 P O ELSEIF(K(I,1).LE.10) THEN ( O K(I,4)=MSTU(5)*(K(I,4)/MSTU(5)) ( O K(I,5)=MSTU(5)*(K(I,5)/MSTU(5)) 4 O ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN O ID1=MOD(K(I,4),MSTU(5)) B O IF(K(I,2).GE.1.AND.K(I,2).LE.8) ID1=MOD(K(I,4),MSTU(5))+1 ( O ID2=2*MOD(K(I,4),MSTU(5))+1-ID1 , O K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 , O K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2 $ O K(ID1,4)=K(ID1,4)+MSTU(5)*I & O K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 & O K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 $ O K(ID2,5)=K(ID2,5)+MSTU(5)*I O ELSE L O ID1=MOD(K(I,4),MSTU(5))  O ID2=ID1+1 , O K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 , O K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1 6 O IF(IABS(K(I,2)).LE.10.OR.K(ID1,1).GE.11) THEN & O K(ID1,4)=K(ID1,4)+MSTU(5)*I & O K(ID1,5)=K(ID1,5)+MSTU(5)*I ELSE ( O K(ID1,4)=0 ) O K(ID1,5)=0 e O ENDIF  O K(ID2,4)=0 ( O K(ID2,5)=0 E O ENDIF  O 520 CONTINUE ) O E" O C...Transformation from CM frame.  O IF(NPA.GE.2) THEN  O BEX=PS(1)/PS(4)  O BEY=PS(2)/PS(4)  O BEZ=PS(3)/PS(4)  O GA=PS(4)/PS(5) 2G O GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3))  O & /(1.+GA)-P(IPA(1),4)) O ELSE  O BEX=0. U O BEY=0.  O BEZ=0.  O GABEP=0. h O ENDIF 9 O THE=ULANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1) E2 O &+GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2)) > O PHI=ULANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY)  O IF(NPA.EQ.3) THEN G O CHI=ULANGL(COS(THE)*COS(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(THE)* F O & SIN(PHI)*(P(IPA(2),2)+GABEP*BEY)-SIN(THE)*(P(IPA(2),3)+GABEP* F O & BEZ),-SIN(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(PHI)*(P(IPA(2),2)+  O & GABEP*BEY))  O MSTU(33)=1 2/ O CALL LUDBRB(NS+1,N,0.,CHI,0D0,0D0,0D0) 1 O ENDIF  O DBEX=DBLE(BEX)  O DBEY=DBLE(BEY) H O DBEZ=DBLE(BEZ) . O MSTU(33)=1 -1 O CALL LUDBRB(NS+1,N,THE,PHI,DBEX,DBEY,DBEZ) O  O  O C...Decay vertex of shower.  O DO 540 I=NS+1,N  O DO 530 J=1,5  O V(I,J)=V(IP1,J)  O 530 CONTINUE ) O 540 CONTINUE ) O 4 O C...Delete trivial shower, else connect initiators.  O IF(N.EQ.NS+NPA+IIM) THEN X N=NS 2 O ELSE  O DO 550 IP=1,NPA  O K(IPA(IP),1)=14 , O K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP , O K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP  O K(NS+IIM+IP,3)=IPA(IP) .; O IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1 .% O IF(K(NS+IIM+IP,1).NE.1) THEN A8 O K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4) 8 O K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5)  O ENDIF  O 550 CONTINUE E O ENDIF  O RETURN O END  O EG O C********************************************************************* A O 0 O SUBROUTINE LUBOEI(NSAV)  O 0F O C...Purpose: to modify event so as to approximately take into account A O C...Bose-Einstein effects according to a simple phenom ological T O C...parametrization. # O IMPLICIT DOUBLE PRECISION(D) o4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)  O SAVE /LUJETS/,/LUDAT1/ .1 O DIMENSION DPS(4),KFBE(9),NBE(0:9),BEI(100) 17 O DATA KFBE/211,-211,111,321,-321,130,310,221,331/ ( O E: O C...Boost event to overall CM frame. Calculate CM energy. B O IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN  O DO 100 J=1,4 N O DPS(J)=0.  O 100 CONTINUE  O DO 120 I=1,N P O KFA=IABS(K(I,2))G O IF(K(I,1).LE.10.AND.((KFA.GT.10.AND.KFA.LE.20).OR.KFA.EQ.22).AND.  O &K(I,3).GT.0) THENg O KFMA=IABS(K(K(I,3),2))4 O IF(KFMA.GT.10.AND.KFMA.LE.80) K(I,1)=-K(I,1) O ENDIFM/ O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 = O DO 110 J=1,4 ) O DPS(J)=DPS(J)+P(I,J)  O 110 CONTINUE 1 O 120 CONTINUE I; O CALL LUDBRB(0,0,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4),  O &-DPS(3)/DPS(4))  O PECM=0.  O DO 130 I=1,N H8 O IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4)  O 130 CONTINUE  O ; O C...Reserve copy of particles by species at end of record. y O NBE(0)=N+MSTU(3) N# O DO 160 IBE=1,MIN(9,MSTJ(52)) 0 O NBE(IBE)=NBE(IBE-1)  O DO 150 I=NSAV+1,N ' O IF(K(I,2).NE.KFBE(IBE)) GOTO 150 5/ O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 O . O IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN B O CALL LUERRM(11,'(LUBOEI:) no more memory left in LUJETS')  O RETURN . O ENDIF  O NBE(IBE)=NBE(IBE)+1  O K(NBE(IBE),1)=I  O DO 140 J=1,3 5 O P(NBE(IBE),J)=0. 3 O 140 CONTINUE  O 150 CONTINUE  O 160 CONTINUE I3 O IF(NBE(MIN(9,MSTJ(52)))-NBE(0).LE.1) GOTO 280a O 5 O C...Tabulate integral for subsequent momentum shift. 1# O DO 220 IBE=1,MIN(9,MSTJ(52)) A6 O IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 180 E O IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)) * O &.LE.1) GOTO 180 E O IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5), $ O &NBE(7)-NBE(6)).LE.1) GOTO 180 9 O IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 180 0' O IF(IBE.EQ.1) PMHQ=2.*ULMASS(211) ' O IF(IBE.EQ.4) PMHQ=2.*ULMASS(321) ' O IF(IBE.EQ.8) PMHQ=2.*ULMASS(221) ' O IF(IBE.EQ.9) PMHQ=2.*ULMASS(331) ." O QDEL=0.1*MIN(PMHQ,PARJ(93))  O IF(MSTJ(51).EQ.1) THEN F- O NBIN=MIN(100,NINT(9.*PARJ(93)/QDEL)) F$ O BEEX=EXP(0.5*QDEL/PARJ(93)) ! O BERT=EXP(-QDEL/PARJ(93)) K O ELSE - O NBIN=MIN(100,NINT(3.*PARJ(93)/QDEL)) F O ENDIF  O DO 170 IBIN=1,NBIN  O QBIN=QDEL*(IBIN-0.5) IA O BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12.)/SQRT(QBIN**2+PMHQ**2) ) O IF(MSTJ(51).EQ.1) THEN E O BEEX=BEEX*BERT 1! O BEI(IBIN)=BEI(IBIN)*BEEX N O ELSE M5 O BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2) - O ENDIF 4 O IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1)  O 170 CONTINUE 2 O )@ O C...Loop through particle pairs and find old relative momentum. ) O 180 DO 210 I1M=NBE(IBE-1)+1,NBE(IBE)-1  O I1=K(I1M,1) O DO 200 I2M=I1M+1,NBE(IBE)  O I2=K(I2M,1) G O Q2OLD=MAX(0.,(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+ M= O &P(I2,2))**2-(P(I1,3)+P(I2,3))**2-(P(I1,5)+P(I2,5))**2) L O QOLD=SQRT(Q2OLD) ) O O % O C...Calculate new relative momentum. D! O IF(QOLD.LT.1E-3*QDEL) THEN  O GOTO 200 O O ELSEIF(QOLD.LE.QDEL) THEN  O QMOV=QOLD/3. S+ O ELSEIF(QOLD.LT.(NBIN-0.1)*QDEL) THEN H O RBIN=QOLD/QDEL  O IBIN=RBIN 3 O RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1) (7 O QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))* ." O & SQRT(Q2OLD+PMHQ**2)/Q2OLD O ELSE 21 O QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD ) O ENDIF : O Q2NEW=Q2OLD*(QOLD/(QOLD+3.*PARJ(92)*QMOV))**(2./3.)  O 1? O C...Calculate and save shift to be performed on three-momenta. .- O HC1=(P(I1,4)+P(I2,4))**2-(Q2OLD-Q2NEW) M- O HC2=(Q2OLD-Q2NEW)*(P(I1,4)-P(I2,4))**2 L2 O HA=0.5*(1.-SQRT(HC1*Q2NEW/(HC1*Q2OLD-HC2)))  O DO 190 J=1,3 , O PD=HA*(P(I2,J)-P(I1,J))  O P(I1M,J)=P(I1M,J)+PD , O P(I2M,J)=P(I2M,J)-PD T O 190 CONTINUE 2 O 200 CONTINUE  O 210 CONTINUE Q O 220 CONTINUE  O , O C...Shift momenta and recalculate energies. . O DO 240 IM=NBE(0)+1,NBE(MIN(9,MSTJ(52)))  O I=K(IM,1)  O DO 230 J=1,3  O P(I,J)=P(I,J)+P(IM,J)  O 230 CONTINUE (; O P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) ( O 240 CONTINUE F O =1 O C...Rescale all momenta for energy conservation. F PES=0. Q PQS=0. , O DO 250 I=1,N I/ O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 250 . O PES=PES+P(I,4) . O PQS=PQS+P(I,5)**2/P(I,4) E O 250 CONTINUE V O FAC=(PECM-PQS)/(PES-PQS) N O DO 270 I=1,N / O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270 Q O DO 260 J=1,3 P O P(I,J)=FAC*P(I,J)  O 260 CONTINUE ; O P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) I O 270 CONTINUE M O .+ O C...Boost back to correct reference frame. tG O 280 CALL LUDBRB(0,0,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4)) O  O DO 290 I=1,N$ O IF(K(I,1).LT.0) K(I,1)=-K(I,1) O 290 CONTINUE O , RETURN O END  O AG O C*********************************************************************  O + O FUNCTION ULMASS(KF)  O +4 O C...Purpose: to give the mass of a particle/parton. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) A O SAVE /LUDAT1/,/LUDAT2/ 1 O )& O C...Reset variables. Compressed code.  O ULMASS=0.  O KFA=IABS(KF)  O KC=LUCOMP(KF)  O IF(KC.EQ.0) RETURN P O PARF(106)=PMAS(6,1)  O PARF(107)=PMAS(7,1)  O PARF(108)=PMAS(8,1)  O E= O C...Guarantee use of constituent masses for internal checks. )> O IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND.KFA.LE.10) THEN  O ULMASS=PARF(100+KFA) (: O IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(121))  O 0 O C...Masses that can be read directly off table. 7 O ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN 4 O ULMASS=PMAS(KC,1)  O O / O C...Find constituent partons and their masses. y O ELSE  O KFLA=MOD(KFA/1000,10)  O KFLB=MOD(KFA/100,10) M O KFLC=MOD(KFA/10,10)  O KFLS=MOD(KFA,10) 5 O KFLR=MOD(KFA/10000,10) 5 O PMA=PARF(100+KFLA) L O PMB=PARF(100+KFLB) . O PMC=PARF(100+KFLC) 3 O )B O C...Construct masses for various meson, diquark and baryon cases. 7 O IF(KFLA.EQ.0.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN , O IF(KFLS.EQ.1) PMSPL=-3./(PMB*PMC) + O IF(KFLS.GE.3) PMSPL=1./(PMB*PMC) @ O ULMASS=PARF(111)+PMB+PMC+PARF(113)*PARF(101)**2*PMSPL  O ELSEIF(KFLA.EQ.0) THEN o O KMUL=2 = O IF(KFLS.EQ.1) KMUL=3 D O IF(KFLR.EQ.2) KMUL=4 . O IF(KFLS.EQ.5) KMUL=5 H( O ULMASS=PARF(113+KMUL)+PMB+PMC  O ELSEIF(KFLC.EQ.0) THEN , O IF(KFLS.EQ.1) PMSPL=-3./(PMA*PMB) + O IF(KFLS.EQ.3) PMSPL=1./(PMA*PMB) 2F O ULMASS=2.*PARF(112)/3.+PMA+PMB+PARF(114)*PARF(101)**2*PMSPL + O IF(MSTJ(93).EQ.1) ULMASS=PMA+PMB 2< O IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(122)-  O & 2.*PARF(112)/3.) 1 ELSE M. O IF(KFLS.EQ.2.AND.KFLA.EQ.KFLB) THEN 9 O PMSPL=1./(PMA*PMB)-2./(PMA*PMC)-2./(PMB*PMC) 2 O ELSEIF(KFLS.EQ.2.AND.KFLB.GE.KFLC) THEN : O PMSPL=-2./(PMA*PMB)-2./(PMA*PMC)+1./(PMB*PMC) ! O ELSEIF(KFLS.EQ.2) THEN A O PMSPL=-3./(PMB*PMC)  O ELSE 9 O PMSPL=1./(PMA*PMB)+1./(PMA*PMC)+1./(PMB*PMC) . O ENDIF D O ULMASS=PARF(112)+PMA+PMB+PMC+PARF(114)*PARF(101)**2*PMSPL  O ENDIF O ENDIF  O 2A O C...Optional mass broadening according to truncated Breit-Wigner  O C...(either in m or in m^2). P4 O IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1E-4) THEN A O IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN M; O ULMASS=ULMASS+0.5*PMAS(KC,2)*TAN((2.*RLU(0)-1.)* .* O & ATAN(2.*PMAS(KC,3)/PMAS(KC,2))) ELSE M O PM0=ULMASS 9 O PMLOW=ATAN((MAX(0.,PM0-PMAS(KC,3))**2-PM0**2)/ . O & (PM0*PMAS(KC,2))) D O PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2))) > O ULMASS=SQRT(MAX(0.,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+ " O & (PMUPP-PMLOW)*RLU(0))))  O ENDIF O ENDIF  O MSTJ(93)=0 N O 5 RETURN O END  O VG O C********************************************************************* P O O! O SUBROUTINE LUNAME(KF,CHAU) H O 9E O C...Purpose: to give the particle/parton name as a character string. 5< O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) ( O COMMON/LUDAT4/CHAF(500)  O CHARACTER CHAF*8 & O SAVE /LUDAT1/,/LUDAT2/,/LUDAT4/  O CHARACTER CHAU*16  O , O C...Initial values. Charge. Subdivide code.  O CHAU=' ' , O KFA=IABS(KF) P O KC=LUCOMP(KF)  O IF(KC.EQ.0) RETURN O  O KQ=LUCHGE(KF)  O KFLA=MOD(KFA/1000,10)  O KFLB=MOD(KFA/100,10) 3 O KFLC=MOD(KFA/10,10)  O KFLS=MOD(KFA,10)  O KFLR=MOD(KFA/10000,10)  O 5 O C...Read out root name and spin for simple particle. ,8 O IF(KFA.LE.100.OR.(KFA.GT.100.AND.KC.GT.100)) THEN  O CHAU=CHAF(KC)  O LEN=0  O DO 100 LEM=1,8 ) O IF(CHAU(LEM:LEM).NE.' ') LEN=LEM E O 100 CONTINUE A O 2 O C...Construct root name for diquark. Add on spin.  O ELSEIF(KFLC.EQ.0) THEN P3 O CHAU(1:2)=CHAF(KFLA)(1:1)//CHAF(KFLB)(1:1) 2% O IF(KFLS.EQ.1) CHAU(3:4)='_0' B% O IF(KFLS.EQ.3) CHAU(3:4)='_1' I O LEN=4  O H O C...Construct root name for heavy meson. Add on spin and heavy flavour.  O ELSEIF(KFLA.EQ.0) THEN H$ O IF(KFLB.EQ.5) CHAU(1:1)='B' $ O IF(KFLB.EQ.6) CHAU(1:1)='T' $ O IF(KFLB.EQ.7) CHAU(1:1)='L' $ O IF(KFLB.EQ.8) CHAU(1:1)='H'  O LEN=1 ) O IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN A- O ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN A O CHAU(2:2)='*'  O LEN=2 - O ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN ) O CHAU(2:3)='_1' O O LEN=3 - O ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN n O CHAU(2:4)='*_0'  O LEN=4  O ELSEIF(KFLR.EQ.2) THEN 3 O CHAU(2:4)='*_1'  O LEN=4  O ELSEIF(KFLS.EQ.5) THEN N O CHAU(2:4)='*_2'  O LEN=4  O ENDIF 7 O IF(KFLC.GE.3.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN *1 O CHAU(LEN+1:LEN+2)='_'//CHAF(KFLC)(1:1)  O LEN=LEN+2  O ELSEIF(KFLC.GE.3) THEN , O CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1)  O LEN=LEN+1  O ENDIF  O J3 O C...Construct root name and spin for heavy baryon. P O ELSE P) O IF(KFLB.LE.2.AND.KFLC.LE.2) THEN  O CHAU='Sigma ' ) O IF(KFLC.GT.KFLB) CHAU='Lambda' N& O IF(KFLS.EQ.4) CHAU='Sigma*'  O LEN=5 % O IF(CHAU(6:6).NE.' ') LEN=6 O , O ELSEIF(KFLB.LE.2.OR.KFLC.LE.2) THEN  O CHAU='Xi ' P8 O IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Xi''' # O IF(KFLS.EQ.4) CHAU='Xi*' O O LEN=2 % O IF(CHAU(3:3).NE.' ') LEN=3 ELSE F O CHAU='Omega ' ; O IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Omega''' C& O IF(KFLS.EQ.4) CHAU='Omega*'  O LEN=5 % O IF(CHAU(6:6).NE.' ') LEN=6 . O ENDIF  O o3 O C...Add on heavy flavour content for heavy baryon. O / O CHAU(LEN+1:LEN+2)='_'//CHAF(KFLA)(1:1) N O LEN=LEN+2 , O IF(KFLB.GE.KFLC.AND.KFLC.GE.4) THEN = O CHAU(LEN+1:LEN+2)=CHAF(KFLB)(1:1)//CHAF(KFLC)(1:1)  O LEN=LEN+2 0 O ELSEIF(KFLB.GE.KFLC.AND.KFLB.GE.4) THEN , O CHAU(LEN+1:LEN+1)=CHAF(KFLB)(1:1)  O LEN=LEN+1 0 O ELSEIF(KFLC.GT.KFLB.AND.KFLB.GE.4) THEN = O CHAU(LEN+1:LEN+2)=CHAF(KFLC)(1:1)//CHAF(KFLB)(1:1) - O LEN=LEN+2 0 O ELSEIF(KFLC.GT.KFLB.AND.KFLC.GE.4) THEN , O CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1)  O LEN=LEN+1  O ENDIF O ENDIF  O 8 O C...Add on bar sign for antiparticle (where necessary). # O IF(KF.GT.0.OR.LEN.EQ.0) THEN )E O ELSEIF(KFA.GT.10.AND.KFA.LE.40.AND.KQ.NE.0.AND.MOD(KQ,3).EQ.0) C O &THEN : O ELSEIF(KFA.EQ.89.OR.(KFA.GE.91.AND.KFA.LE.99)) THEN 8 O ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KQ.NE.0) THEN ! O ELSEIF(MSTU(15).LE.1) THEN ) O CHAU(LEN+1:LEN+1)='~'  O LEN=LEN+1 O ELSE ) O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O .*PARU(1)) 3, O IF(MSTU(101).LE.0.OR.Q2.LT.2E-6) THEN  O RPIGG=0. S5 O ELSEIF(MSTU(101).EQ.2.AND.Q2.LT.PARU(104)) THENO O RPIGG=0.! O ELSEIF(MSTU(101).EQ.2) THENe% O RPIGG=1.-PARU(101)/PARU(103) . O ELSEIF(Q2.LT.0.09) THEN 9 O RPIGG=AEMPI*(13.4916+LOG(Q2))+0.00835*LOG(1.+Q2) ( O ELSEIF(Q2.LT.9.) THEN B O RPIGG=AEMPI*(16.3200+2.*LOG(Q2))+0.00238*LOG(1.+3.927*Q2)  O ELSEIF(Q2.LT.1E4) THEN 1D O RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00165+0.00299*LOG(1.+Q2) O ELSE O D O RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00221+0.00293*LOG(1.+Q2) O ENDIF  O O O C...Calculate running alpha_em. " O ULALEM=PARU(101)/(1.-RPIGG)  O PARU(108)=ULALEM D O 4 RETURN , O END  O O G O C********************************************************************* E O , O FUNCTION ULALPS(Q2)  O A0 O C...Purpose: to give the value of alpha_strong. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) L O SAVE /LUDAT1/,/LUDAT2/ 2 O ,# O C...Constant alpha_strong trivial. 5 O IF(MSTU(111).LE.0) THEN  O ULALPS=PARU(111) 1 O MSTU(118)=MSTU(112)  O PARU(117)=0. e O PARU(118)=PARU(111)  O RETURN O ENDIF  O O 6 O C...Find effective Q2, number of flavours and Lambda.  O Q2EFF=Q2 M1 O IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114)) n O NF=MSTU(112) t O ALAM2=PARU(112)**2 .& O 100 IF(NF.GT.MAX(2,MSTU(113))) THEN & O Q2THR=PARU(113)*PMAS(NF,1)**2 O IF(Q2EFF.LT.Q2THR) THEN  O NF=NF-1 6 O ALAM2=ALAM2*(Q2THR/ALAM2)**(2./(33.-2.*NF))  O GOTO 100  O ENDIF O ENDIF & O 110 IF(NF.LT.MIN(8,MSTU(114))) THEN ( O Q2THR=PARU(113)*PMAS(NF+1,1)**2 O IF(Q2EFF.GT.Q2THR) THEN  O NF=NF+1 6 O ALAM2=ALAM2*(ALAM2/Q2THR)**(2./(33.-2.*NF))  O GOTO 110 , O ENDIF O ENDIF + O IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2  O PARU(117)=SQRT(ALAM2)  O =1 O C...Evaluate first or second order alpha_strong. O  O B0=(33.-2.*NF)/6. ( O ALGQ=LOG(MAX(1.0001,Q2EFF/ALAM2))  O IF(MSTU(111).EQ.1) THEN 0 O ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)) O ELSE B O B1=(153.-19.*NF)/6. A O ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1.-B1*LOG(ALGQ)/ ) O & (B0**2*ALGQ))) O ENDIF  O MSTU(118)=NF  O PARU(118)=ULALPS F O L RETURN D O END  O KG O C********************************************************************* R O 1 O FUNCTION ULANGL(X,Y) E O KE O C...Purpose: to reconstruct an angle from given x and y coordinates. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)  O SAVE /LUDAT1/  O ) O ULANGL=0.  O R=SQRT(X**2+Y**2)  O IF(R.LT.1E-20) RETURN  O IF(ABS(X)/R.LT.0.8) THEN 0! O ULANGL=SIGN(ACOS(X/R),Y) P O ELSE 1 O ULANGL=ASIN(Y/R) * O IF(X.LT.0..AND.ULANGL.GE.0.) THEN O ULANGL=PARU(1)-ULANGL  O ELSEIF(X.LT.0.) THEN L! O ULANGL=-PARU(1)-ULANGL E O ENDIF O ENDIF  O B RETURN 1 O END  O G O C*********************************************************************  O  O FUNCTION RLU(IDUMMY) ( O *F O C...Purpose: to generate random numbers uniformly distributed between & O C...0 and 1, excluding the endpoints. & O COMMON/LUDATR/MRLU(6),RRLU(100)  O SAVE /LUDATR/ C O EQUIVALENCE (MRLU1,MRLU(1)),(MRLU2,MRLU(2)),(MRLU3,MRLU(3)), 7 O &(MRLU4,MRLU(4)),(MRLU5,MRLU(5)),(MRLU6,MRLU(6)), )= O &(RRLU98,RRLU(98)),(RRLU99,RRLU(99)),(RRLU00,RRLU(100)) 0 O + O C...Initialize generation from given seed. ) O IF(MRLU2.EQ.0) THEN " O IJ=MOD(MRLU1/30082,31329)  O KL=MOD(MRLU1,30082)  O I=MOD(IJ/177,177)+2  O J=MOD(IJ,177)+2  O K=MOD(KL/169,178)+1  O L=MOD(KL,169)  O DO 110 II=1,97 ( S=0. 2 O T=0.5  O DO 100 JJ=1,24 R" O M=MOD(MOD(I*J,179)*K,179) O I=J O J=K O K=M  O L=MOD(53*L+1,169) $ O IF(MOD(L*M,64).GE.32) S=S+T  O T=0.5*T  O 100 CONTINUE * O RRLU(II)=S * O 110 CONTINUE * O TWOM24=1.  O DO 120 I24=1,24  O TWOM24=0.5*TWOM24  O 120 CONTINUE / O RRLU98=362436.*TWOM24  O RRLU99=7654321.*TWOM24 0 O RRLU00=16777213.*TWOM24  O MRLU2=1  O MRLU3=0  O MRLU4=97 V O MRLU5=33 O O ENDIF  O 5! O C...Generate next random number. # O 130 RUNI=RRLU(MRLU4)-RRLU(MRLU5) " O IF(RUNI.LT.0.) RUNI=RUNI+1.  O RRLU(MRLU4)=RUNI v O MRLU4=MRLU4-1  O IF(MRLU4.EQ.0) MRLU4=97  O MRLU5=MRLU5-1  O IF(MRLU5.EQ.0) MRLU5=97  O RRLU98=RRLU98-RRLU99 D, O IF(RRLU98.LT.0.) RRLU98=RRLU98+RRLU00  O RUNI=RUNI-RRLU98 " O IF(RUNI.LT.0.) RUNI=RUNI+1. + O IF(RUNI.LE.0.OR.RUNI.GE.1.) GOTO 130  O e. O C...Update counters. Random number to output.  O MRLU3=MRLU3+1 # O IF(MRLU3.EQ.1000000000) THEN A O MRLU2=MRLU2+1  O MRLU3=0 O ENDIF  O RLU=RUNI ) O . RETURN O O END  O EG O C********************************************************************* K O ." O SUBROUTINE RLUGET(LFN,MOVE)  O LH O C...Purpose: to dump the state of the random number generator on a file 4 O C...for subsequent startup from this state onwards. & O COMMON/LUDATR/MRLU(6),RRLU(100)  O SAVE /LUDATR/  O CHARACTER CHERR*8  O .D O C...Backspace required number of records (or as many as there are).  O IF(MOVE.LT.0) THEN O NBCK=MIN(MRLU(6),-MOVE)  O DO 100 IBCK=1,NBCK H+ O BACKSPACE(LFN,ERR=110,IOSTAT=IERR) K O 100 CONTINUE  O MRLU(6)=MRLU(6)-NBCK . O ENDIF  O # O C...Unformatted write on unit LFN. 8 O WRITE(LFN,ERR=110,IOSTAT=IERR) (MRLU(I1),I1=1,5),  O &(RRLU(I2),I2=1,100)  O MRLU(6)=MRLU(6)+1 RETURN L O Q O C...Write error.  O 110 WRITE(CHERR,'(I8)') IERR =G O CALL LUERRM(18,'(RLUGET:) error when accessing file, IOSTAT ='// &CHERR)  O L RETURN O END  O G O C********************************************************************* 3 O D" O SUBROUTINE RLUSET(LFN,MOVE)  O H O C...Purpose: to read a state of the random number generator from a file 7 O C...for subsequent generation from this state onwards. H& O COMMON/LUDATR/MRLU(6),RRLU(100)  O SAVE /LUDATR/  O CHARACTER CHERR*8  O fD O C...Backspace required number of records (or as many as there are).  O IF(MOVE.LT.0) THEN m O NBCK=MIN(MRLU(6),-MOVE)  O DO 100 IBCK=1,NBCK K+ O BACKSPACE(LFN,ERR=120,IOSTAT=IERR)  O 100 CONTINUE ) O MRLU(6)=MRLU(6)-NBCK F O ENDIF  O C$ O C...Unformatted read from unit LFN.  O NFOR=1+MAX(0,MOVE) N O DO 110 IFOR=1,NFOR 7 O READ(LFN,ERR=120,IOSTAT=IERR) (MRLU(I1),I1=1,5), O  O &(RRLU(I2),I2=1,100)  O 110 CONTINUE  O MRLU(6)=MRLU(6)+NFOR g RETURN  O K O C...Write error. B O 120 WRITE(CHERR,'(I8)') IERR G O CALL LUERRM(18,'(RLUSET:) error when accessing file, IOSTAT ='// ) &CHERR) . O RETURN o O END  O aG O C********************************************************************* A O F- O SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ) . O K. O C...Purpose: to perform rotations and boosts. # O IMPLICIT DOUBLE PRECISION(D) )4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)  O SAVE /LUJETS/ UDAT1/ 1 O DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4)  O E O C...Find range of rotation/boost. Convert boost to double precision. + IMIN=1 E$ O IF(MSTU(1).GT.0) IMIN=MSTU(1) IMAX=N L$ O IF(MSTU(2).GT.0) IMAX=MSTU(2)  O DBX=BEX  O DBY=BEY  O DBZ=BEZ  O GOTO 120 g O o9 O C...Entry for specific range and double precision boost. .3 O ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ) D O IMIN=IMI K O IF(IMIN.LE.0) IMIN=1  O IMAX=IMA . O IF(IMAX.LE.0) IMAX=N 9 O DBX=DBEX L O DBY=DBEY N O DBZ=DBEZ Q O .3 O C...Optional resetting of V (when not set before.)  O IF(MSTU(33).NE.0) THEN 5 O DO 110 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4)) r O DO 100 J=1,5 O  O V(I,J)=0.  O 100 CONTINUE r O 110 CONTINUE v O MSTU(33)=0 d O ENDIF  O .# O C...Check range of rotation/boost. 2 O 120 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN @ O CALL LUERRM(11,'(LUROBO:) range outside LUJETS memory')  O RETURN . O ENDIF  O 2< O C...Rotate, typically from z axis to direction (theta,phi). & O IF(THE**2+PHI**2.GT.1E-20) THEN # O ROT(1,1)=COS(THE)*COS(PHI) F O ROT(1,2)=-SIN(PHI) .# O ROT(1,3)=SIN(THE)*COS(PHI) T# O ROT(2,1)=COS(THE)*SIN(PHI)  O ROT(2,2)=COS(PHI) # O ROT(2,3)=SIN(THE)*SIN(PHI)  O ROT(3,1)=-SIN(THE) * O ROT(3,2)=0.  O ROT(3,3)=COS(THE)  O DO 150 I=IMIN,IMAX C! O IF(K(I,1).LE.0) GOTO 150 t O DO 130 J=1,3 o O PR(J)=P(I,J) O  O VR(J)=V(I,J) G O 130 CONTINUE , O DO 140 J=1,3 O < O P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3) < O V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3)  O 140 CONTINUE O  O 150 CONTINUE H O ENDIF  O F8 O C...Boost, typically from rest to momentum/energy=beta. - O IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN & O DB=SQRT(DBX**2+DBY**2+DBZ**2) $ O IF(DB.GT.0.99999999D0) THEN 0 O C...Rescale boost vector if too close to unity. < O CALL LUERRM(3,'(LUROBO:) boost vector too large') $ O DBX=DBX*(0.99999999D0/DB) $ O DBY=DBY*(0.99999999D0/DB) $ O DBZ=DBZ*(0.99999999D0/DB)  O DB=0.99999999D0  O ENDIF O DGA=1D0/SQRT(1D0-DB**2)  O DO 170 I=IMIN,IMAX O ! O IF(K(I,1).LE.0) GOTO 170 t O DO 160 J=1,4 L O DP(J)=P(I,J) O  O DV(J)=V(I,J) N O 160 CONTINUE ** O DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3) , O DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4))  O P(I,1)=DP(1)+DGABP*DBX t O P(I,2)=DP(2)+DGABP*DBY a O P(I,3)=DP(3)+DGABP*DBZ t O P(I,4)=DGA*(DP(4)+DBP) a* O DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3) , O DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4))  O V(I,1)=DV(1)+DGABV*DBX  O V(I,2)=DV(2)+DGABV*DBY K O V(I,3)=DV(3)+DGABV*DBZ 2 O V(I,4)=DGA*(DV(4)+DBV) 2 O 170 CONTINUE 1 O ENDIF  O 4 RETURN O O END  O BG O C********************************************************************* , O , O SUBROUTINE LUEDIT(MEDIT) E O .B O C...Purpose: to perform global manipulations on the event record, I O C...in particular to exclude unstable or undetectable partons/particles. .4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) 1& O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ $ O DIMENSION NS(2),PTS(2),PLS(2)  O O ' O C...Remove unwanted partons/particles. Q9 O IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN  O IMAX=N & O IF(MSTU(2).GT.0) IMAX=MSTU(2)  O I1=MAX(1,MSTU(1))-1 % O DO 110 I=MAX(1,MSTU(1)),IMAX A1 O IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110 M O IF(MEDIT.EQ.1) THEN $ O IF(K(I,1).GT.10) GOTO 110 O ELSEIF(MEDIT.EQ.2) THEN $ O IF(K(I,1).GT.10) GOTO 110  O KC=LUCOMP(K(I,2)) F O IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18)  O & GOTO 110 O ELSEIF(MEDIT.EQ.3) THEN $ O IF(K(I,1).GT.10) GOTO 110  O KC=LUCOMP(K(I,2))  O IF(KC.EQ.0) GOTO 110 K? O IF(KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) GOTO 110 K O ELSEIF(MEDIT.EQ.5) THEN 4 O IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110  O KC=LUCOMP(K(I,2))  O IF(KC.EQ.0) GOTO 110 8 O IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110  O ENDIF  O > O C...Pack remaining partons/particles. Origin no longer known.  O I1=I1+1  O DO 100 J=1,5 K O K(I1,J)=K(I,J)  O P(I1,J)=P(I,J) Q O V(I1,J)=V(I,J) U O 100 CONTINUE ( O K(I1,3)=0  O 110 CONTINUE . O IF(I1.LT.N) MSTU(3)=0  O IF(I1.LT.N) MSTU(70)=0 B N=I1  O E O C...Selective removal of class of entries. New position of retained. L/ O ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN 1 I1=0  O DO 120 I=1,N O# O K(I,3)=MOD(K(I,3),MSTU(5)) 1 O IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120 1 O IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120 = O IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR. P1 O & K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120 O = O IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR. . O & K(I,2).EQ.94)) GOTO 120 2 O IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120  O I1=I1+1 ! O K(I,3)=K(I,3)+MSTU(5)*I1 . O 120 CONTINUE . O C8 O C...Find new event history information and replace old.  O DO 140 I=1,N 9H O IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140 ID=I L O 130 IM=MOD(K(ID,3),MSTU(5)) 5 O IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN O D O IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND.  O & K(IM,2).NE.94) THEN  O ID=IM  O GOTO 130  O ENDIF 9 O ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN GC O IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN K O ID=IM  O GOTO 130 K O ENDIF  O ENDIF ( O K(I,3)=MSTU(5)*(K(I,3)/MSTU(5)) 2 O IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5) ? O IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN E8 O IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)=  O & K(K(I,4),3)/MSTU(5) 8 O IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)=  O & K(K(I,5),3)/MSTU(5) ELSE T* O KCM=MOD(K(I,4)/MSTU(5),MSTU(5)) ? O IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) -" O KCD=MOD(K(I,4),MSTU(5)) ? O IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) *@ O K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD * O KCM=MOD(K(I,5)/MSTU(5),MSTU(5)) ? O IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) L" O KCD=MOD(K(I,5),MSTU(5)) ? O IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) O @ O K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD  O ENDIF  O 140 CONTINUE b O i O C...Pack remaining entries. I1=0 S O MSTU90=MSTU(90)  O MSTU(90)=0  O DO 170 I=1,N D) O IF(K(I,3)/MSTU(5).EQ.0) GOTO 170  O I1=I1+1  O DO 150 J=1,5 . O K(I1,J)=K(I,J) h O P(I1,J)=P(I,J) r O V(I1,J)=V(I,J) E O 150 CONTINUE % O K(I1,3)=MOD(K(I1,3),MSTU(5)) M O DO 160 IZ=1,MSTU90 ." O IF(I.EQ.MSTU(90+IZ)) THEN  O MSTU(90)=MSTU(90)+1  O MSTU(90+MSTU(90))=I1 T( O PARU(90+MSTU(90))=PARU(90+IZ)  O ENDIF  O 160 CONTINUE R O 170 CONTINUE S O IF(I1.LT.N) MSTU(3)=0  O IF(I1.LT.N) MSTU(70)=0 L N=I1  O B O C...Fill in some missing daughter pointers (lost in colour flow).  O ELSEIF(MEDIT.EQ.16) THEN  O DO 190 I=1,N M2 O IF(K(I,1).LE.10.OR.K(I,1).GT.20) GOTO 190 0 O IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 190 ' O C...Find daughters who point to mother.' O DO 180 I1=I+1,N  O IF(K(I1,3).NE.I) THEN ! O ELSEIF(K(I,4).EQ.0) THEN , O K(I,4)=I1 ELSE O  O K(I,5)=I1  O ENDIF  O 180 CONTINUE o% O IF(K(I,5).EQ.0) K(I,5)=K(I,4)M O IF(K(I,4).NE.0) GOTO 190F O C...Find daughters who point to documentation version of mother.  O IM=K(I,3)=' O IF(IM.LE.0.OR.IM.GE.I) GOTO 190*5 O IF(K(IM,1).LE.20.OR.K(IM,1).GT.30) GOTO 190 *E O IF(K(IM,2).NE.K(I,2).OR.ABS(P(IM,5)-P(I,5)).GT.1E-2) GOTO 190  O DO 182 I1=I+1,N  O IF(K(I1,3).NE.IM) THEN S! O ELSEIF(K(I,4).EQ.0) THEN 0 O K(I,4)=I1 ELSE c O K(I,5)=I1  O ENDIF  O 182 CONTINUE % O IF(K(I,5).EQ.0) K(I,5)=K(I,4)^ O IF(K(I,4).NE.0) GOTO 190< O C...Find daughters who point to documentation daughters who,1 O C...in their turn, point to documentation mother. O  O ID1=IM O ID2=IM O DO 184 I1=IM+1,I-1B O IF(K(I1,3).EQ.IM.AND.K(I1,1).GT.20.AND.K(I1,1).LE.30) THEN O ID2=I1 O IF(ID1.EQ.IM) ID1=I1 ENDIFT O 184 CONTINUE O  O DO 186 I1=I+1,N 3 O IF(K(I1,3).NE.ID1.AND.K(I1,3).NE.ID2) THEN ! O ELSEIF(K(I,4).EQ.0) THEN 3 O K(I,4)=I1 ELSE ) O K(I,5)=I1  O ENDIF  O 186 CONTINUE L% O IF(K(I,5).EQ.0) K(I,5)=K(I,4)4 O 190 CONTINUE P O =6 O C...Save top entries at bottom of LUJETS commonblock.  O ELSEIF(MEDIT.EQ.21) THEN * O IF(2*N.GE.MSTU(4)) THEN D O CALL LUERRM(11,'(LUEDIT:) no more memory left in LUJETS')  O RETURN ) O ENDIF  O DO 210 I=1,N O  O DO 200 J=1,5  O K(MSTU(4)-I,J)=K(I,J)  O P(MSTU(4)-I,J)=P(I,J)  O V(MSTU(4)-I,J)=V(I,J)  O 200 CONTINUE  O 210 CONTINUE t O MSTU(32)=N l O _9 O C...Restore bottom entries of commonblock LUJETS to top. , O ELSEIF(MEDIT.EQ.22) THEN C O DO 230 I=1,MSTU(32)  O DO 220 J=1,5 A O K(I,J)=K(MSTU(4)-I,J)  O P(I,J)=P(MSTU(4)-I,J)  O V(I,J)=V(MSTU(4)-I,J)  O 220 CONTINUE R O 230 CONTINUE S O N=MSTU(32)  O D O C...Mark primary entries at top of commonblock LUJETS as untreated.  O ELSEIF(MEDIT.EQ.23) THEN Q I1=0 a O DO 240 I=1,N  O KH=K(I,3)  O IF(KH.GE.1) THEN X! O IF(K(KH,1).GT.20) KH=0 ) O ENDIF  O IF(KH.NE.0) GOTO 250 M O I1=I1+1 ; O IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10 F O 240 CONTINUE 250 N=I1  O D O C...Place largest axis along z axis and second largest in xy plane. . O ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN : O CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61),1), $ O & P(MSTU(61),2)),0D0,0D0,0D0) 7 O CALL LUDBRB(1,N+MSTU(3),-ULANGL(P(MSTU(61),3), T' O & P(MSTU(61),1)),0.,0D0,0D0,0D0) 0< O CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61)+1,1), & O & P(MSTU(61)+1,2)),0D0,0D0,0D0)  O IF(MEDIT.EQ.31) RETURN  O o* O C...Rotate to put slim jet along +z axis.  O DO 260 IS=1,2  O NS(IS)=0 M O PTS(IS)=0. 1 O PLS(IS)=0.  O 260 CONTINUE 1 O DO 270 I=1,N O 1 O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270  O IF(MSTU(41).GE.2) THEN A O KC=LUCOMP(K(I,2)) = O IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.  O & KC.EQ.18) GOTO 270 EH O IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)  O & GOTO 270 R O ENDIF  O IS=2.-SIGN(0.5,P(I,3)) s O NS(IS)=NS(IS)+1 2 O PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2)  O 270 CONTINUE 2/ O IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2) )8 O & CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0)  O E: O C...Rotate to put second largest jet into -z,+x quadrant.  O DO 280 I=1,N O " O IF(P(I,3).GE.0.) GOTO 280 1 O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 280  O IF(MSTU(41).GE.2) THEN  O KC=LUCOMP(K(I,2)) = O IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.  O & KC.EQ.18) GOTO 280 H O IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)  O & GOTO 280 I O ENDIF  O IS=2.-SIGN(0.5,P(I,1)) n O PLS(IS)=PLS(IS)-P(I,3)  O 280 CONTINUE A O IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1),  O & 0D0,0D0,0D0) O O ENDIF  O RETURN , O END  O ,G O C********************************************************************* , O O  O SUBROUTINE LULIST(MLIST) R O 9D O C...Purpose: to give program heading, or list an event, or particle ' O C...data, or current parameter values. 4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) IE O COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) / O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ = O CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHDL(7)*4 M O DIMENSION PS(6) 7 O DATA CHDL/'(())',' ','()','!!','<>','==','(==)'/ S O O E O C...Initialization printout: version number and date of last change. + O IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN  O * CALL LULOGO 2 O MSTU(12)=0 5 O IF(MLIST.EQ.0) RETURN O ENDIF  O O 9 O C...List event data, including additional lines after N. ) O IF(MLIST.GE.1.AND.MLIST.LE.3) THEN a, O IF(MLIST.EQ.1) WRITE(MSTU(11),5100) , O IF(MLIST.EQ.2) WRITE(MSTU(11),5200) , O IF(MLIST.EQ.3) WRITE(MSTU(11),5300)  O LMX=12 F O IF(MLIST.GE.2) LMX=16  O ISTR=0  O IMAX=N M& O IF(MSTU(2).GT.0) IMAX=MSTU(2) ; O DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3))) -; O IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120 E O O< O C...Get particle name, pad it and check it is not too long. ! O CALL LUNAME(K(I,2),CHAP)  O LEN=0  O DO 100 LEM=1,16 ) O IF(CHAP(LEM:LEM).NE.' ') LEN=LEM  O 100 CONTINUE = O MDL=(K(I,1)+19)/10  O LDL=0 & O IF(MDL.EQ.2.OR.MDL.GE.8) THEN  O CHAC=CHAP + O IF(LEN.GT.LMX) CHAC(LMX:LMX)='?' E ELSE p O LDL=1 ) O IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2 l O IF(LEN.EQ.0) THEN ) O CHAC=CHDL(MDL)(1:2*LDL)//' ' D O ELSE 1@ O CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))// ( O & CHDL(MDL)(LDL+1:2*LDL)//' ' 3 O IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?'  O ENDIF  O ENDIF  O O* O C...Add information on string connection. G O IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12) O & THEN  O KC=LUCOMP(K(I,2))  O KCC=0 % O IF(KC.NE.0) KCC=KCHG(KC,2) I& O IF(IABS(K(I,2)).EQ.39) THEN 9 O IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X' .. O ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN  O ISTR=1 9 O IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A' LB O ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN 9 O IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I' E O ELSEIF(KCC.NE.0) THEN  O ISTR=0 9 O IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V' t O ENDIF  O ENDIF  O H! O C...Write data for particle/jet. 15 O IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN f> O WRITE(MSTU(11),5400) I,CHAC(1:12),(K(I,J1),J1=1,3),  O & (P(I,J2),J2=1,5) H: O ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN > O WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3),  O & (P(I,J2),J2=1,5) R O ELSEIF(MLIST.EQ.1) THEN > O WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3),  O & (P(I,J2),J2=1,5) E O ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR. , O & K(I,1).EQ.14)) THEN 8 O WRITE(MSTU(11),5700) I,CHAC,(K(I,J1),J1=1,3), F O & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000), F O & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000),  O & (P(I,J2),J2=1,5) * ELSE *H O WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5)  O ENDIF ; O IF(MLIST.EQ.3) WRITE(MSTU(11),5900) (V(I,J),J=1,5) o O s4 O C...Insert extra separator lines specified by user.  O IF(MSTU(70).GE.1) THEN 0 O ISEP=0 N& O DO 110 J=1,MIN(10,MSTU(70)) % O IF(I.EQ.MSTU(70+J)) ISEP=1  O 110 CONTINUE (< O IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),6000) < O IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),6100)  O ENDIF  O 120 CONTINUE  O O C...Sum of charges and momenta.  O DO 130 J=1,6  O PS(J)=PLU(0,J) O  O 130 CONTINUE 4 O IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN 3 O WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5) E9 O ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN 03 O WRITE(MSTU(11),6300) PS(6),(PS(J),J=1,5) X O ELSEIF(MLIST.EQ.1) THEN 3 O WRITE(MSTU(11),6400) PS(6),(PS(J),J=1,5) o ELSE e3 O WRITE(MSTU(11),6500) PS(6),(PS(J),J=1,5)  O ENDIF  O S5 O C...Give simple list of KF codes defined in program.  O ELSEIF(MLIST.EQ.11) THEN r O WRITE(MSTU(11),6600) U O DO 140 KF=1,40 . O CALL LUNAME(KF,CHAP) o O CALL LUNAME(-KF,CHAN) E O IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP s> O IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN  O 140 CONTINUE m O DO 170 KFLS=1,3,2  O DO 160 KFLA=1,8 & O DO 150 KFLB=1,KFLA-(3-KFLS)/2 # O KF=1000*KFLA+100*KFLB+KFLS - O CALL LUNAME(KF,CHAP) N O CALL LUNAME(-KF,CHAN) . O WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN  O 150 CONTINUE ) O 160 CONTINUE  O 170 CONTINUE - O KF=130  O CALL LUNAME(KF,CHAP) )% O WRITE(MSTU(11),6700) KF,CHAP C O KF=310 1 O CALL LUNAME(KF,CHAP) 1% O WRITE(MSTU(11),6700) KF,CHAP  O DO 200 KMUL=0,5  O KFLS=3 * O IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1  O IF(KMUL.EQ.5) KFLS=5 R O KFLR=0 ,* O IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1  O IF(KMUL.EQ.4) KFLR=2  O DO 190 KFLB=1,8  O DO 180 KFLC=1,KFLB-1 , O KF=10000*KFLR+100*KFLB+10*KFLC+KFLS  O CALL LUNAME(KF,CHAP)  O CALL LUNAME(-KF,CHAN) . O WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN  O 180 CONTINUE e$ O KF=10000*KFLR+110*KFLB+KFLS  O CALL LUNAME(KF,CHAP) t% O WRITE(MSTU(11),6700) KF,CHAP * O 190 CONTINUE O  O 200 CONTINUE * O KF=30443 O  O CALL LUNAME(KF,CHAP) /% O WRITE(MSTU(11),6700) KF,CHAP  O KF=30553 G O CALL LUNAME(KF,CHAP) % O WRITE(MSTU(11),6700) KF,CHAP . O DO 240 KFLSP=1,3 O O KFLS=2+2*(KFLSP/3) ( O DO 230 KFLA=1,8  O DO 220 KFLB=1,KFLA  O DO 210 KFLC=1,KFLB BC O IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 210 )1 O IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 210 a: O IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS : O IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS  O CALL LUNAME(KF,CHAP) D O CALL LUNAME(-KF,CHAN) . O WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN  O 210 CONTINUE A O 220 CONTINUE ( O 230 CONTINUE ) O 240 CONTINUE E O O A O C...List parton/particle data table. Check whether to be listed. * O ELSEIF(MLIST.EQ.12) THEN * O WRITE(MSTU(11),6800)  O MSTJ24=MSTJ(24)  O MSTJ(24)=0  O KFMAX=30553 ' IF(MSTU(2).NE.0) KFMAX=MSTU(2) i' O DO 270 KF=MAX(1,MSTU(1)),KFMAX  O KC=LUCOMP(KF)  O IF(KC.EQ.0) GOTO 270 (? O IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 270 2@ O IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10), . O & MOD(KF/100,10)).GT.MSTU(14)) GOTO 270 > O IF(MSTU(14).GT.0.AND.KF.GT.100.AND.KC.EQ.90) GOTO 270  O n4 O C...Find particle name and mass. Print information.  O CALL LUNAME(KF,CHAP) O C O IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 270 M O CALL LUNAME(-KF,CHAN)  O PM=ULMASS(KF) D O WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2), B O & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1)  O TF O C...Particle decay: channel number, branching ration, matrix element,  O C...decay products. - O IF(KF.GT.100.AND.KC.LE.100) GOTO 270 .6 O DO 260 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1  O DO 250 J=1,5 F) O CALL LUNAME(KFDP(IDC,J),CHAD(J)) M O 250 CONTINUE D O WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC),  O & (CHAD(J),J=1,5)  O 260 CONTINUE . O 270 CONTINUE  O MSTJ(24)=MSTJ24  O 1 O C...List parameter value table.  O ELSEIF(MLIST.EQ.13) THEN O O WRITE(MSTU(11),7100) E O DO 280 I=1,200 GG O WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I) n O 280 CONTINUE O O ENDIF  O O B O C...Format statements for output on unit MSTU(11) (by default 6). H O 5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS', ? O &5X,'KF orig p_x p_y p_z E m'/) .F O 5200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet', F O &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', ? O &' P(I,2) P(I,3) P(I,4) P(I,5)'/) I O 5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j', 1H O &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', B O &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X, E O &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/) 33 O 5400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3) 23 O 5500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2) 3 O 5600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1) .A O 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5) d= O 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5) O O 5900 FORMAT(66X,5(1X,F12.3))  O 6000 FORMAT(1X,78('=')) D O 6100 FORMAT(1X,130('=')) ' O 6200 FORMAT(19X,'sum:',F6.2,5X,5F9.3) .' O 6300 FORMAT(19X,'sum:',F6.2,5X,5F9.2) (' O 6400 FORMAT(19X,'sum:',F6.2,5X,5F9.1) QF O 6500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:',  O &5F13.5) 4 O 6600 FORMAT(///20X,'List of KF codes in program'/) ( O 6700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16) F O 6800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X, E O &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X, )I O &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off', 50 O &1X,'ME',3X,'Br.rat.',4X,'decay products') ? O 6900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5), ) O &2X,F12.5,3X,I2) 1 O 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16) IB O 7100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)', ; O &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)') F; O 7200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5)  O C RETURN T O END  O G O C********************************************************************* ) O T O SUBROUTINE LULOGO  O S; O C...Purpose: to write logo for JETSET and PYTHIA programs. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) < O COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)  O SAVE /LUDAT1/  O SAVE /PYPARS/ A O CHARACTER MONTH(12)*3, LOGO(48)*32, REFER(22)*36, LINE*79, % O &VERS*1, SUBV*3, DATE*2, YEAR*4 . O k2 O C...Data on months, logo, titles, and references. H O DATA MONTH/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',  O &'Oct','Nov','Dec'/ O  O DATA (LOGO(J),J=1,10)/ 0* O &'PPP Y Y TTTTT H H III A ', * O &'P P Y Y T H H I A A ', * O &'PPP Y T HHHHH I AAAAA', * O &'P Y T H H I A A', * O &'P Y T H H III A A', * O &'JJJJ EEEE TTTTT SSS EEEE TTTTT', * O &' J E T S E T ', * O &' J EEE T SSS EEE T ', * O &'J J E T S E T ', * O &' JJ EEEE T SSS EEEE T '/  O DATA (LOGO(J),J=11,29)/ * O &' *......* ', * O &' *:::!!:::::::::::* ', * O &' *::::::!!::::::::::::::* ', * O &' *::::::::!!::::::::::::::::* ', * O &' *:::::::::!!:::::::::::::::::* ', * O &' *:::::::::!!:::::::::::::::::* ', * O &' *::::::::!!::::::::::::::::*! ', * O &' *::::::!!::::::::::::::* !! ', * O &' !! *:::!!:::::::::::* !! ', * O &' !! !* -><- * !! ', * O &' !! !! !! ', * O &' !! !! !! ', * O &' !! !! ', * O &' !! ep !! ', * O &' !! !! ', * O &' !! pp !! ', * O &' !! e+e- !! ', * O &' !! !! ', * O &' !! '/  O DATA (LOGO(J),J=30,48)/ * O &'Welcome to the Lund Monte Carlo!', * O &' ', * O &' This is PYTHIA version x.xxx ', * O &'Last date of change: xx xxx 199x', * O &' ', * O &' This is JETSET version x.xxx ', * O &'Last date of change: xx xxx 199x', * O &' ', * O &' Main author: ', * O &' Torbjorn Sjostrand ', * O &' Dept. of theoretical physics 2 ', * O &' University of Lund ', * O &' Solvegatan 14A ', * O &' S-223 62 Lund, Sweden ', * O &' phone: +46 - 46 - 222 48 16 ', * O &' E-mail: torbjorn@thep.lu.se ', * O &' ', * O &' Copyright Torbjorn Sjostrand ', * O &' and CERN, Geneva 1993 '/  O DATA (REFER(J),J=1,6)/ .- O &'The latest program versions and docu', - O &'mentation is found on WWW address ',y- O &'http://thep.lu.se/tf2/staff/torbjorn', - O &'/Welcome.html ',J- O &' ', - O &' '/V O DATA (REFER(J),J=7,22)/ . O &'When you cite these programs, priori', . O &'ty should always be given to the ', . O &'latest published description. Curren', . O &'tly this is ', . O &'T. Sjostrand, Computer Physics Commu', . O &'n. 82 (1994) 74. ', . O &'The most recent long description (un', . O &'published) is ', - O &'T. Sjostrand, LU TP 95-20 and CERN-T',E. O &'H.7112/93 (revised August 1995). ', . O &'Also remember that the programs, to ', . O &'a large extent, represent original ', . O &'physics research. Other publications', . O &' of special relevance to your ', . O &'studies may therefore deserve separa', . O &'te mention. '/  O a O C...Check if PYTHIA linked. # O IF(MSTP(183)/10.NE.199) THEN .4 O LOGO(32)=' Warning: PYTHIA is not loaded! ' 4 O LOGO(33)='Did you remember to link PYDATA?' O ELSE % O WRITE(VERS,'(I1)') MSTP(181) G O LOGO(32)(26:26)=VERS S% O WRITE(SUBV,'(I3)') MSTP(182) A O LOGO(32)(28:30)=SUBV L% O WRITE(DATE,'(I2)') MSTP(185) 1 O LOGO(33)(22:23)=DATE M) O LOGO(33)(25:27)=MONTH(MSTP(184)) % O WRITE(YEAR,'(I4)') MSTP(183) 0 O LOGO(33)(29:32)=YEAR O ENDIF  O 1 O C...Check if JETSET linked. # O IF(MSTU(183)/10.NE.199) THEN O 4 O LOGO(35)=' Error: JETSET is not loaded! ' 4 O LOGO(36)='Did you remember to link LUDATA?' O ELSE % O WRITE(VERS,'(I1)') MSTU(181) O O LOGO(35)(26:26)=VERS E% O WRITE(SU ,'(I3)') MSTU(182) . O LOGO(35)(28:30)=SUBV C% O WRITE(DATE,'(I2)') MSTU(185) R O LOGO(36)(22:23)=DATE -) O LOGO(36)(25:27)=MONTH(MSTU(184)) % O WRITE(YEAR,'(I4)') MSTU(183) 2 O LOGO(36)(29:32)=YEAR 2 O ENDIF  O )B O C...Loop over lines in header. Define page feed and side borders.  O DO 100 ILIN=1,48 E O LINE=' ' u O IF(ILIN.EQ.1) THEN z O LINE(1:1)='1' O ELSE O  O LINE(2:3)='**' ) O LINE(78:79)='**' 1 O ENDIF  O G O C...Separator lines and logos. (B O IF(ILIN.EQ.2.OR.ILIN.EQ.3.OR.ILIN.EQ.47.OR.ILIN.EQ.48) THEN G O LINE(4:77)='***********************************************'// & O & '***************************' , O ELSEIF(ILIN.GE.6.AND.ILIN.LE.10) THEN O LINE(6:37)=LOGO(ILIN-5)  O LINE(44:75)=LOGO(ILIN) - O ELSEIF(ILIN.GE.13.AND.ILIN.LE.31) THEN O O LINE(6:37)=LOGO(ILIN-2) " O LINE(44:75)=LOGO(ILIN+17) - O ELSEIF(ILIN.GE.34.AND.ILIN.LE.44) THEN E$ O LINE(5:40)=REFER(2*ILIN-67) % O LINE(41:76)=REFER(2*ILIN-66) * O ENDIF  O ,% O C...Write lines to appropriate unit. O # O IF(MSTU(183)/10.EQ.199) THEN i% O WRITE(MSTU(11),'(A79)') LINE . O ELSE e O WRITE(*,'(A79)') LINE O ENDIF  O 100 CONTINUE 5 O (0 O C...Check that matching subversions are linked. ; O IF(MSTU(183)/10.EQ.199.AND.MSTP(183)/10.EQ.199) THEN 03 O IF(MSTU(182).LT.MSTP(186)) WRITE(MSTU(11), 5B O & '(/'' Warning: JETSET subversion too old for PYTHIA''/)') 3 O IF(MSTP(182).LT.MSTU(186)) WRITE(MSTU(11), HB O & '(/'' Warning: PYTHIA subversion too old for JETSET''/)') O ENDIF  O ' RETURN > O END  O SG O C********************************************************************* . O O # O SUBROUTINE LUUPDA(MUPDA,LFN)  O ND O C...Purpose: to facilitate the updating of particle and decay data. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) NE O COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) ) O COMMON/LUDAT4/CHAF(500)  O CHARACTER CHAF*8 (/ O SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/ .6 O CHARACTER CHINL*80,CHKC*4,CHVAR(19)*9,CHLIN*72, 7 O &CHBLK(20)*72,CHOLD*12,CHTMP*12,CHNEW*12,CHCOM*12 TC O DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','PMAS(I,1)', .C O &'PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)','MDCY(I,2)', cC O &'MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ','KFDP(I,1)', EC O &'KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)','CHAF(I) '/ L O + O C...Write information on file for editing. /' O IF(MSTU(12).GE.1) CALL LULIST(0) . O IF(MUPDA.EQ.1) THEN  O DO 110 KC=1,MSTU(6) : O WRITE(LFN,5000) KC,CHAF(KC),(KCHG(KC,J1),J1=1,3), ( O & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) 6 O DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 ; O WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), D O & (KFDP(IDC,J),J=1,5)  O 100 CONTINUE  O 110 CONTINUE D O :; O C...Reset variables and read information from edited file. ' O ELSEIF(MUPDA.EQ.2) THEN  O DO 130 I=1,MSTU(7) o O MDME(I,1)=1  O MDME(I,2)=0  O BRAT(I)=0. R O DO 120 J=1,5 . O KFDP(I,J)=0  O 120 CONTINUE C O 130 CONTINUE KC=0  O IDC=0  O NDC=0 % O 140 READ(LFN,5200,END=150) CHINL E& O IF(CHINL(2:5).NE.' ') THEN  O CHKC=CHINL(2:5)  O IF(KC.NE.0) THEN R O MDCY(KC,2)=0 S. O IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC  O MDCY(KC,3)=NDC  O ENDIF  O READ(CHKC,5300) KC )7 O IF(KC.LE.0.OR.KC.GT.MSTU(6)) CALL LUERRM(27, -8 O & '(LUUPDA:) Read KC code illegal, KC ='//CHKC) > O READ(CHINL,5000) KCR,CHAF(KC),(KCHG(KC,J1),J1=1,3), * O & (PMAS(KC,J2),J2=1,4),MDCY(KC,1)  O NDC=0 ELSE O  O IDC=IDC+1  O NDC=NDC+1 - O IF(IDC.GE.MSTU(7)) CALL LUERRM(27, A< O & '(LUUPDA:) Decay data arrays full by KC ='//CHKC) > O READ(CHINL,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),  O & (KFDP(IDC,J),J=1,5)  O ENDIF  O GOTO 140 P O 150 MDCY(KC,2)=0 * O IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC  O MDCY(KC,3)=NDC 2 O K? O C...Perform possible tests that new information is consistent. T O MSTJ24=MSTJ(24)  O MSTJ(24)=0 O O DO 180 KC=1,MSTU(6)  O WRITE(CHKC,5300) KC G O IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3), 0> O & PMAS(KC,4)).LT.0..OR.MDCY(KC,3).LT.0) CALL LUERRM(17, G O & '(LUUPDA:) Mass/width/life/(# channels) wrong for KC ='//CHKC)  O BRSUM=0. 6 O DO 170 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 ' O IF(MDME(IDC,2).GT.80) GOTO 170 T O KQ=KCHG(KC,1) + O PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64) p O MERR=0 i O DO 160 J=1,5  O KP=KFDP(IDC,J) O 7 O IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN % O ELSEIF(LUCOMP(KP).EQ.0) THEN  O MERR=3 E ELSE F O KQ=KQ-LUCHGE(KP) I O PMS=PMS-ULMASS(KP) F O ENDIF  O 160 CONTINUE T% O IF(KQ.NE.0) MERR=MAX(2,MERR) O< O IF(KFDP(IDC,2).NE.0.AND.(KC.LE.20.OR.KC.GT.40).AND. ; O & (KC.LE.80.OR.KC.GT.100).AND.MDME(IDC,2).NE.34.AND. : O & MDME(IDC,2).NE.61.AND.PMS.LT.0.) MERR=MAX(1,MERR) & O IF(MERR.EQ.3) CALL LUERRM(17, B O & '(LUUPDA:) Unknown particle code in decay of KC ='//CHKC) & O IF(MERR.EQ.2) CALL LUERRM(17, A O & '(LUUPDA:) Charge not conserved in decay of KC ='//CHKC) 6% O IF(MERR.EQ.1) CALL LUERRM(7, EA O & '(LUUPDA:) Kinematically unallowed decay of KC ='//CHKC) N O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O psing jet system or not.  O ELSEIF(J.EQ.17) THEN u I1=I ' O 150 KLU=KLU+1  O I3=I1  O I1=K(I1,3) e O I0=MAX(1,I1) i O KC=LUCOMP(K(I0,2)) rE O IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN  O IF(KLU.EQ.1) KLU=-1  O IF(KLU.GT.1) KLU=0 4 O RETURN O  O ENDIF % O IF(KCHG(KC,2).EQ.0) GOTO 150 O IF(K(I1,1).NE.12) KLU=0 ! O IF(K(I1,1).NE.12) RETURN  O I2=I1  O 160 I2=I2+1 / O IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 160  O K3M=K(I3-1,3) * O IF(K3M.GE.I1.AND.K3M.LE.I2) KLU=0  O K3P=K(I3+1,3) 6 O IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) KLU=0  O e+ O C...Number of decay products. Colour flow.  O ELSEIF(J.EQ.18) THEN D O IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) KLU=MAX(0,K(I,5)-K(I,4)+1) - O IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) KLU=0 p O ELSEIF(J.LE.22) THEN A O IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN i4 O IF(J.EQ.19) KLU=MOD(K(I,4)/MSTU(5),MSTU(5)) 4 O IF(J.EQ.20) KLU=MOD(K(I,5)/MSTU(5),MSTU(5)) , O IF(J.EQ.21) KLU=MOD(K(I,4),MSTU(5)) , O IF(J.EQ.22) KLU=MOD(K(I,5),MSTU(5)) O ELSE O ENDIF  O RETURN O END  O &G O C********************************************************************* t O 9 O FUNCTION PLU(I,J)  O b@ O C...Purpose: to provide various real-valued event related data. 4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) & O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/  O DIMENSION PSUM(4)  O 8< O C...Set default value. For I = 0 sum of momenta or charges, ! O C...or invariant mass of system. PLU=0. 0 O IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN % O ELSEIF(I.EQ.0.AND.J.LE.4) THEN : O DO 100 I1=1,N ; O IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+P(I1,J)  O 100 CONTINUE I% O ELSEIF(I.EQ.0.AND.J.EQ.5) THEN 3 O DO 120 J1=1,4  O PSUM(J1)=0.  O DO 110 I1=1,N F O IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PSUM(J1)=PSUM(J1)+P(I1,J1)  O 110 CONTINUE E O 120 CONTINUE F O PLU=SQRT(MAX(0.,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2)) % O ELSEIF(I.EQ.0.AND.J.EQ.6) THEN  O DO 130 I1=1,N F O IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+LUCHGE(K(I1,2))/3.  O 130 CONTINUE  O ELSEIF(I.EQ.0) THEN  O 8 O C...Direct readout of P matrix.  O ELSEIF(J.LE.5) THEN  O PLU=P(I,J)  O OB O C...Charge, total momentum, transverse momentum, transverse mass.  O ELSEIF(J.LE.12) THEN () O IF(J.EQ.6) PLU=LUCHGE(K(I,2))/3. ? O IF(J.EQ.7.OR.J.EQ.8) PLU=P(I,1)**2+P(I,2)**2+P(I,3)**2 6 O IF(J.EQ.9.OR.J.EQ.10) PLU=P(I,1)**2+P(I,2)**2 A O IF(J.EQ.11.OR.J.EQ.12) PLU=P(I,5)**2+P(I,1)**2+P(I,2)**2 O 7 O IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PLU=SQRT(PLU)  O / O C...Theta and phi angle in radians or degrees.  O ELSEIF(J.LE.16) THEN RA O IF(J.LE.14) PLU=ULANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) *. O IF(J.GE.15) PLU=ULANGL(P(I,1),P(I,2)) 4 O IF(J.EQ.14.OR.J.EQ.16) PLU=PLU*180./PARU(1)  O D< O C...True rapidity, rapidity with pion mass, pseudorapidity.  O ELSEIF(J.LE.19) THEN  O PMR=0. 1 O IF(J.EQ.17) PMR=P(I,5) $ O IF(J.EQ.18) PMR=ULMASS(211) 1 O PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2) .D O PLU=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR),  O & 1E20)),P(I,3)) * O A O C...Energy and momentum fractions (only to be used in CM frame). T O ELSEIF(J.LE.25) THEN H O IF(J.EQ.20) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21) + O IF(J.EQ.21) PLU=2.*P(I,3)/PARU(21) .> O IF(J.EQ.22) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21) + O IF(J.EQ.23) PLU=2.*P(I,4)/PARU(21) O 1 O IF(J.EQ.24) PLU=(P(I,4)+P(I,3))/PARU(21) 51 O IF(J.EQ.25) PLU=(P(I,4)-P(I,3))/PARU(21) f O ENDIF  O O RETURN ( O END  O 6G O C********************************************************************* r O T! O SUBROUTINE LUSPHE(SPH,APL)  O UG O C...Purpose: to perform sphericity tensor analysis to give sphericity, *+ O C...aplanarity and the related event axes. U4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) 3& O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ O DIMENSION SM(3,3),SV(3,3)  O 0) O C...Calculate matrix to be diagonalized. N O NP=0 5 O DO 110 J1=1,3  O DO 100 J2=J1,3 U O SM(J1,J2)=0. 3 O 100 CONTINUE  O 110 CONTINUE * O PS=0.  O DO 140 I=1,N / O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140 * O IF(MSTU(41).GE.2) THEN , O KC=LUCOMP(K(I,2)) ; O IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. C O & KC.EQ.18) GOTO 140 &F O IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)  O & GOTO 140 ) O ENDIF  O NP=NP+1 - O PA=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) o PWT=1. E O IF(ABS(PARU(41)-2.).GT.0.001) PWT=MAX(1E-10,PA)**(PARU(41)-2.)  O DO 130 J1=1,3  O DO 120 J2=J1,3 0. O SM(J1,J2)=SM(J1,J2)+PWT*P(I,J1)*P(I,J2)  O 120 CONTINUE , O 130 CONTINUE  O PS=PS+PWT*PA**2  O 140 CONTINUE C O C5 O C...Very low multiplicities (0 or 1) not considered. , O IF(NP.LE.1) THEN DB O CALL LUERRM(8,'(LUSPHE:) too few particles for analysis')  O SPH=-1.  O APL=-1.  O RETURN ' O ENDIF  O DO 160 J1=1,3  O DO 150 J2=J1,3 ) O SM(J1,J2)=SM(J1,J2)/PS  O 150 CONTINUE  O 160 CONTINUE R O 8 O C...Find eigenvalues to matrix (third degree equation). F O SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2- & O &SM(1,3)**2-SM(2,3)**2)/3.-1./9. G O SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)* I O &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27. .8 O SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.) A O P(N+1,4)=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP) 0B O P(N+3,4)=1./3.+SQRT(-SQ)*MIN(2.*SP,-SQRT(3.*(1.-SP**2))-SP) $ O P(N+2,4)=1.-P(N+1,4)-P(N+3,4) O IF(P(N+2,4).LT.1E-5) THEN > O CALL LUERRM(8,'(LUSPHE:) all particles back-to-back')  O SPH=-1.  O APL=-1.  O RETURN O ENDIF  O D@ O C...Find first and last eigenvector by solving equation system.  O DO 240 I=1,3,2 a O DO 180 J1=1,3 # O SV(J1,J1)=SM(J1,J1)-P(N+I,4) D O DO 170 J2=J1+1,3 ) O SV(J1,J2)=SM(J1,J2)  O SV(J2,J1)=SM(J1,J2)  O 170 CONTINUE  O 180 CONTINUE 0 O SMAX=0.  O DO 200 J1=1,3  O DO 190 J2=1,3 * O IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 190 O JA=J1 O JB=J2  O SMAX=ABS(SV(J1,J2))  O 190 CONTINUE  O 200 CONTINUE  O SMAX=0.  O DO 220 J3=JA+1,JA+2  O J1=J3-3*((J3-1)/3) P O RL=SV(J1,JB)/SV(JA,JB) , O DO 210 J2=1,3 ' O SV(J1,J2)=SV(J1,J2)-RL*SV(JA,J2) 3* O IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 210 O JC=J1  O SMAX=ABS(SV(J1,J2))  O 210 CONTINUE  O 220 CONTINUE  O JB1=JB+1-3*(JB/3)  O JB2=JB+2-3*((JB+1)/3)  O P(N+I,JB1)=-SV(JC,JB2) O O P(N+I,JB2)=SV(JC,JB1) @ O P(N+I,JB)=-(SV(JA,JB1)*P(N+I,JB1)+SV(JA,JB2)*P(N+I,JB2))/  O &SV(JA,JB) 3 O PA=SQRT(P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2) .! O SGN=(-1.)**INT(RLU(0)+0.5) O  O DO 230 J=1,3 ( O P(N+I,J)=SGN*P(N+I,J)/PA 3 O 230 CONTINUE F O 240 CONTINUE - O H; O C...Middle axis orthogonal to other two. Fill other codes. 6! O SGN=(-1.)**INT(RLU(0)+0.5) 9 O P(N+2,1)=SGN*(P(N+1,2)*P(N+3,3)-P(N+1,3)*P(N+3,2)) 29 O P(N+2,2)=SGN*(P(N+1,3)*P(N+3,1)-P(N+1,1)*P(N+3,3)) D9 O P(N+2,3)=SGN*(P(N+1,1)*P(N+3,2)-P(N+1,2)*P(N+3,1)) T O DO 260 I=1,3  O K(N+I,1)=31  O K(N+I,2)=95  O K(N+I,3)=I ) O K(N+I,4)=0 o O K(N+I,5)=0 ' O P(N+I,5)=0.  O DO 250 J=1,5 R O V(I,J)=0.  O 250 CONTINUE o O 260 CONTINUE c O o@ O C...Calculate sphericity and aplanarity. Select storing option. " O SPH=1.5*(P(N+2,4)+P(N+ 4))  O APL=1.5*P(N+3,4)  O MSTU(61)=N+1 T O MSTU(62)=NP " O IF(MSTU(43).LE.1) MSTU(3)=3  O IF(MSTU(43).GE.2) N=N+3  O 0 RETURN - O END  O CG O C********************************************************************* 2 O ! O SUBROUTINE LUTHRU(THR,OBL) 8 O C O C...Purpose: to perform thrust analysis to give thrust, oblateness A O C...and the related event axes. 4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) O & O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/  O DIMENSION TDI(3),TPR(3)  O 3I O C...Take copy of particles that are to be considered in thrust analysis. o O NP=0 F O PS=0.  O DO 100 I=1,N / O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 M O IF(MSTU(41).GE.2) THEN H O KC=LUCOMP(K(I,2)) ; O IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.  O & KC.EQ.18) GOTO 100 0F O IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)  O & GOTO 100 Q O ENDIF 6 O IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN B O CALL LUERRM(11,'(LUTHRU:) no more memory left in LUJETS')  O THR=-2.  O OBL=-2.  O RETURN D O ENDIF  O NP=NP+1  O K(N+NP,1)=23 0 O P(N+NP,1)=P(I,1)  O P(N+NP,2)=P(I,2) P O P(N+NP,3)=P(I,3) 4 O P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)  O P(N+NP,5)=1. WG O IF(ABS(PARU(42)-1.).GT.0.001) P(N+NP,5)=P(N+NP,4)**(PARU(42)-1.) D O PS=PS+P(N+NP,4)*P(N+NP,5)  O 100 CONTINUE ) O D5 O C...Very low multiplicities (0 or 1) not considered. D O IF(NP.LE.1) THEN AB O CALL LUERRM(8,'(LUTHRU:) too few particles for analysis')  O THR=-1.  O OBL=-1.  O RETURN C O ENDIF  O O I O C...Loop over thrust and major. T axis along z direction in latter case.  O DO 320 ILD=1,2 H O IF(ILD.EQ.2) THEN  O K(N+NP+1,1)=31 1, O PHI=ULANGL(P(N+NP+1,1),P(N+NP+1,2))  O MSTU(33)=1 H4 O CALL LUDBRB(N+1,N+NP+1,0.,-PHI,0D0,0D0,0D0) , O THE=ULANGL(P(N+NP+1,3),P(N+NP+1,1)) 4 O CALL LUDBRB(N+1,N+NP+1,-THE,0.,0D0,0D0,0D0) O ENDIF  O E< O C...Find and order particles with highest p (pT for major). ( O DO 110 ILF=N+NP+4,N+NP+MSTU(44)+4  O P(ILF,4)=0.  O 110 CONTINUE Q O DO 160 I=N+1,N+NP 4 O IF(ILD.EQ.2) P(I,4)=SQRT(P(I,1)**2+P(I,2)**2) + O DO 130 ILF=N+NP+MSTU(44)+3,N+NP+4,-1 & O IF(P(I,4).LE.P(ILF,4)) GOTO 140  O DO 120 J=1,5 T O P(ILF+1,J)=P(ILF,J)  O 120 CONTINUE  O 130 CONTINUE  O ILF=N+NP+3  O 140 DO 150 J=1,5  O P(ILF+1,J)=P(I,J)  O 150 CONTINUE / O 160 CONTINUE  O W= O C...Find and order initial axes with highest thrust (major). n2 O DO 170 ILG=N+NP+MSTU(44)+5,N+NP+MSTU(44)+15  O P(ILG,4)=0.  O 170 CONTINUE T! O NC=2**(MIN(MSTU(44),NP)-1)  O DO 250 ILC=1,NC  O DO 180 J=1,3  O TDI(J)=0.  O 180 CONTINUE $ O DO 200 ILF=1,MIN(MSTU(44),NP)  O SGN=P(N+NP+ILF+3,5) = O IF(2**ILF*((ILC+2**(ILF-1)-1)/2**ILF).GE.ILC) SGN=-SGN N O DO 190 J=1,4-ILD M( O TDI(J)=TDI(J)+SGN*P(N+NP+ILF+3,J)  O 190 CONTINUE  O 200 CONTINUE 4( O TDS=TDI(1)**2+TDI(2)**2+TDI(3)**2 @ O DO 220 ILG=N+NP+MSTU(44)+MIN(ILC,10)+4,N+NP+MSTU(44)+5,-1 # O IF(TDS.LE.P(ILG,4)) GOTO 230  O DO 210 J=1,4 ) O P(ILG+1,J)=P(ILG,J)  O 210 CONTINUE  O 220 CONTINUE + O ILG=N+NP+MSTU(44)+4  O 230 DO 240 J=1,3  O P(ILG+1,J)=TDI(J)  O 240 CONTINUE  O P(ILG+1,4)=TDS  O 250 CONTINUE f O 4 O C...Iterate direction of axis until stable maximum.  O P(N+NP+ILD,4)=0. 1 O ILG=0  O 260 ILG=ILG+1 THP=0. L O 270 THPS=THP O  O DO 280 J=1,3 E7 O IF(THP.LE.1E-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J) H% O IF(THP.GT.1E-10) TDI(J)=TPR(J)  O TPR(J)=0.  O 280 CONTINUE C O DO 300 I=N+1,N+NP A O SGN=SIGN(P(I,5),TDI(1)*P(I,1)+TDI(2)*P(I,2)+TDI(3)*P(I,3))  O DO 290 J=1,4-ILD = O TPR(J)=TPR(J)+SGN*P(I,J) 0 O 290 CONTINUE  O 300 CONTINUE :1 O THP=SQRT(TPR(1)**2+TPR(2)**2+TPR(3)**2)/PS ( O IF(THP.GE.THPS+PARU(48)) GOTO 270  O H O C...Save good axis. Try new initial axis until a number of tries agree. G O IF(THP.LT.P(N+NP+ILD,4)-PARU(48).AND.ILG.LT.MIN(10,NC)) GOTO 260 :- O IF(THP.GT.P(N+NP+ILD,4)+PARU(48)) THEN N O IAGR=0 # O SGN=(-1.)**INT(RLU(0)+0.5)  O DO 310 J=1,3 * O P(N+NP+ILD,J)=SGN*TPR(J)/(PS*THP)  O 310 CONTINUE s O P(N+NP+ILD,4)=THP  O P(N+NP+ILD,5)=0. N O ENDIF  O IAGR=IAGR+1 : O IF(IAGR.LT.MSTU(45).AND.ILG.LT.MIN(10,NC)) GOTO 260  O 320 CONTINUE O  O 0 O C...Find minor axis and value by orthogonality. ! O SGN=(-1.)**INT(RLU(0)+0.5) # O P(N+NP+3,1)=-SGN*P(N+NP+2,2) t" O P(N+NP+3,2)=SGN*P(N+NP+2,1)  O P(N+NP+3,3)=0. X THP=0. 5 O DO 330 I=N+1,N+NP @ O THP=THP+P(I,5)*ABS(P(N+NP+3,1)*P(I,1)+P(N+NP+3,2)*P(I,2))  O 330 CONTINUE 5 O P(N+NP+3,4)=THP/PS O  O P(N+NP+3,5)=0. N O O F O C...Fill axis information. Rotate back to original coordinate system.  O DO 350 ILD=1,3 N O K(N+ILD,1)=31  O K(N+ILD,2)=96  O K(N+ILD,3)=ILD t O K(N+ILD,4)=0  O K(N+ILD,5)=0 0 O DO 340 J=1,5 0 O P(N+ILD,J)=P(N+NP+ILD,J) 0 O V(N+ILD,J)=0.  O 340 CONTINUE  O 350 CONTINUE G/ O CALL LUDBRB(N+1,N+3,THE,PHI,0D0,0D0,0D0)  O E< O C...Calculate thrust and oblateness. Select storing option.  O THR=P(N+1,4) b O OBL=P(N+2,4)-P(N+3,4)  O MSTU(61)=N+1 . O MSTU(62)=NP " O IF(MSTU(43).LE.1) MSTU(3)=3  O IF(MSTU(43).GE.2) N=N+3  O . RETURN O O END  O O G O C*********************************************************************  O  O SUBROUTINE LUCLUS(NJET)  O D@ O C...Purpose: to subdivide the particle content of an event into  O C...jets/clusters. L4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) )& O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/  O DIMENSION PS(5) * O SAVE NSAV,NP,PS,PSS,RINIT,NPRE,NREM  O t7 O C...Functions: distance measure in pT or (pseudo)mass. C O R2T(I1,I2)=(P(I1,5)*P(I2,5)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)- UF O &P(I1,3)*P(I2,3))*2.*P(I1,5)*P(I2,5)/(0.0001+P(I1,5)+P(I2,5))**2 B O R2M(I1,I2)=2.*P(I1,4)*P(I2,4)*(1.-(P(I1,1)*P(I2,1)+P(I1,2)* 2 O &P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5)))  O I= O C...If first time, reset. If reentering, skip preliminaries. O  O IF(MSTU(48).LE.0) THEN NP=0 2 O DO 100 J=1,5 ) O PS(J)=0. t O 100 CONTINUE d O PSS=0. L O ELSE  O NJET=NSAV # O IF(MSTU(43).GE.2) N=N-NJET 0 O DO 110 I=N+1,N+NJET 3 O P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) 0 O 110 CONTINUE (, O IF(MSTU(46).LE.3) R2ACC=PARU(44)**2 2 O IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2  O NLOOP=0  O GOTO 300 O O ENDIF  O A O C...Find which particles are to be considered in cluster search. ) O DO 140 I=1,N 0/ O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140  O IF(MSTU(41).GE.2) THEN  O KC=LUCOMP(K(I,2)) ; O IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. 1 O & KC.EQ.18) GOTO 140 .F O IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)  O & GOTO 140 O ENDIF , O IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN B O CALL LUERRM(11,'(LUCLUS:) no more memory left in LUJETS')  O NJET=-1  O RETURN O ENDIF  O .E O C...Take copy of these particles, with space left for jets later on. O  O NP=NP+1  O K(N+NP,3)=I  O DO 120 J=1,5 0 O P(N+NP,J)=P(I,J) ) O 120 CONTINUE % O IF(MSTU(42).EQ.0) P(N+NP,5)=0. ? O IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1) (A O P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) )4 O P(N+NP,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)  O DO 130 J=1,4  O PS(J)=PS(J)+P(N+NP,J)  O 130 CONTINUE O  O PSS=PSS+P(N+NP,5)  O 140 CONTINUE 3 O DO 160 I=N+1,N+NP  O K(I+NP,3)=K(I,3) N O DO 150 J=1,5 e O P(I+NP,J)=P(I,J) e O 150 CONTINUE  O 160 CONTINUE E> O PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))  O , O C...Very low multiplicities not considered.  O IF(NP.LT.MSTU(47)) THEN B O CALL LUERRM(8,'(LUCLUS:) too few particles for analysis')  O NJET=-1  O RETURN O ENDIF  O )F O C...Find precluster configuration. If too few jets, make harder cuts.  O NLOOP=0 * O IF(MSTU(46).LE.3) R2ACC=PARU(44)**2 0 O IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2  O RINIT=1.25*PARU(43) $ O IF(NP.LE.MSTU(47)+2) RINIT=0.  O 170 RINIT=0.8*RINIT NPRE=0 D O NREM=NP  O DO 180 I=N+NP+1,N+2*NP  O K(I,4)=0 D O 180 CONTINUE P O .C O C...Sum up small momentum region. Jet if enough absolute momentum. L O IF(MSTU(46).LE.2) THEN F O DO 190 J=1,4 . O P(N+1,J)=0.  O 190 CONTINUE  O DO 210 I=N+NP+1,N+2*NP K( O IF(P(I,5).GT.2.*RINIT) GOTO 210  O NREM=NREM-1  O K(I,4)=1 ( O DO 200 J=1,4 ! O P(N+1,J)=P(N+1,J)+P(I,J) T O 200 CONTINUE  O 210 CONTINUE =; O P(N+1,5)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2) ,( O IF(P(N+1,5).GT.2.*RINIT) NPRE=1 E O IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170  O IF(NREM.EQ.0) GOTO 170 * O ENDIF  O *% O C...Find fastest remaining particle.  O 220 NPRE=NPRE+1  O PMAX=0.  O DO 230 I=N+NP+1,N+2*NP e1 O IF(K(I,4).NE.0.OR.P(I,5).LE.PMAX) GOTO 230 0 IMAX=I ( O PMAX=P(I,5)  O 230 CONTINUE 0 O DO 240 J=1,5 , O P(N+NPRE,J)=P(IMAX,J)  O 240 CONTINUE S O NREM=NREM-1  O K(IMAX,4)=NPRE / O E< O C...Sum up precluster around it according to pT separation.  O IF(MSTU(46).LE.2) THEN  O DO 260 I=N+NP+1,N+2*NP r! O IF(K(I,4).NE.0) GOTO 260 . O R2=R2T(I,IMAX) G$ O IF(R2.GT.RINIT**2) GOTO 260  O NREM=NREM-1  O K(I,4)=NPRE  O DO 250 J=1,4 I' O P(N+NPRE,J)=P(N+NPRE,J)+P(I,J) , O 250 CONTINUE N O 260 CONTINUE IG O P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2)  O > O C...Sum up precluster around it according to mass separation. O ELSE ) O 270 IMIN=0  O R2MIN=RINIT**2 N O DO 280 I=N+NP+1,N+2*NP M! O IF(K(I,4).NE.0) GOTO 280 ) O R2=R2M(I,N+NPRE) .! O IF(R2.GE.R2MIN) GOTO 280 I O IMIN=I F O R2MIN=R2 ( O 280 CONTINUE U O IF(IMIN.NE.0) THEN  O DO 290 J=1,4 I, O P(N+NPRE,J)=P(N+NPRE,J)+P(IMIN,J)  O 290 CONTINUE LI O P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2) e O NREM=NREM-1  O K(IMIN,4)=NPRE  O GOTO 270 E O ENDIF O ENDIF  O B O C...Check if more preclusters to be found. Start over if too few. C O IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170 O O IF(NREM.GT.0) GOTO 220 * O NJET=NPRE  O C O C...Reassign all particles to nearest jet. Sum up new jet momenta.  O 300 TSAV=0.  O PSJT=0.  O 310 IF(MSTU(46).LE.1) THEN R O DO 330 I=N+1,N+NJET  O DO 320 J=1,4 V(I,J)=0. 320 CONTINUE 330 CONTINUE DO 360 I=N+NP+1,N+2*NP R2MIN=PSS**2 DO 340 IJET=N+1,N+NJET IF(P(IJET,5).LT.RINIT) GOTO 340 R2=R2T(I,IJET) IF(R2.GE.R2MIN) GOTO 340 IMIN=IJET R2MIN=R2 340 CONTINUE K(I,4)=IMIN-N DO 350 J=1,4 V(IMIN,J)=V(IMIN,J)+P(I,J) 350 CONTINUE 360 CONTINUE PSJT=0. DO 380 I=N+1,N+NJET DO 370 J=1,4 P(I,J)=V(I,J) 370 CONTINUE P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) PSJT=PSJT+P(I,5) 380 CONTINUE ENDIF C...Find two closest jets. R2MIN=2.*MAX(R2ACC,PS(5)**2) DO 400 ITRY1=N+1,N+NJET-1 DO 390 ITRY2=ITRY1+1,N+NJET IF(MSTU(46).LE.2) R2=R2T(ITRY1,ITRY2) IF(MSTU(46).GE.3) R2=R2M(ITRY1,ITRY2) IF(R2.GE.R2MIN) GOTO 390 IMIN1=ITRY1 IMIN2=ITRY2 R2MIN=R2 390 CONTINUE 400 CONTINUE C...If allowed, join two closest jets and start over. IF(NJET.GT.MSTU(47).AND.R2MIN.LT.R2ACC) THEN IREC=MIN(IMIN1,IMIN2) IDEL=MAX(IMIN1,IMIN2) DO 410 J=1,4 P(IREC,J)=P(IMIN1,J)+P(IMIN2,J) 410 CONTINUE P(IREC,5)=SQRT(P(IREC,1)**2+P(IREC,2)**2+P(IREC,3)**2) DO 430 I=IDEL+1,N+NJET DO 420 J=1,5 P(I-1,J)=P(I,J) 420 CONTINUE 430 CONTINUE IF(MSTU(46).GE.2) THEN DO 440 I=N+NP+1,N+2*NP IORI=N+K(I,4) IF(IORI.EQ.IDEL) K(I,4)=IREC-N IF(IORI.GT.IDEL) K(I,4)=K(I,4)-1 440 CONTINUE ENDIF NJET=NJET-1 GOTO 300 C...Divide up broad jet if empty cluster in list of final ones. ELSEIF(NJET.EQ.MSTU(47).AND.MSTU(46).LE.1.AND.NLOOP.LE.2) THEN DO 450 I=N+1,N+NJET K(I,5)=0 450 CONTINUE DO 460 I=N+NP+1,N+2*NP K(N+K(I,4),5)=K(N+K(I,4),5)+1 460 CONTINUE IEMP=0 DO 470 I=N+1,N+NJET IF(K(I,5).EQ.0) IEMP=I 470 CONTINUE IF(IEMP.NE.0) THEN NLOOP=NLOOP+1 ISPL=0 R2MAX=0. DO 480 I=N+NP+1,N+2*NP IF(K(N+K(I,4),5).LE.1.OR.P(I,5).LT.RINIT) GOTO 480 IJET=N+K(I,4) R2=R2T(I,IJET) IF(R2.LE.R2MAX) GOTO 480 ISPL=I R2MAX=R2 480 CONTINUE IF(ISPL.NE.0) THEN IJET=N+K(ISPL,4) DO 490 J=1,4 P(IEMP,J)=P(ISPL,J) P(IJET,J)=P(IJET,J)-P(ISPL,J) 490 CONTINUE P(IEMP,5)=P(ISPL,5) P(IJET,5)=SQRT(P(IJET,1)**2+P(IJET,2)**2+P(IJET,3)**2) IF(NLOOP.LE.2) GOTO 300 ENDIF ENDIF ENDIF C...If generalized thrust has not yet converged, continue iteration. IF(MSTU(46).LE.1.AND.NLOOP.LE.2.AND.PSJT/PSS.GT.TSAV+PARU(48)) &THEN TSAV=PSJT/PSS GOTO 310 ENDIF C...Reorder jets according to energy. DO 510 I=N+1,N+NJET DO 500 J=1,5 V(I,J)=P(I,J) 500 CONTINUE 510 CONTINUE DO 540 INEW=N+1,N+NJET PEMAX=0. DO 520 ITRY=N+1,N+NJET IF(V(ITRY,4).LE.PEMAX) GOTO 520 IMAX=ITRY PEMAX=V(ITRY,4) 520 CONTINUE K(INEW,1)=31 K(INEW,2)=97 K(INEW,3)=INEW-N K(INEW,4)=0 DO 530 J=1,5 P(INEW,J)=V(IMAX,J) 530 CONTINUE V(IMAX,4)=-1. K(IMAX,5)=INEW 540 CONTINUE C...Clean up particle-jet assignments and jet information. DO 550 I=N+NP+1,N+2*NP IORI=K(N+K(I,4),5) K(I,4)=IORI-N IF(K(K(I,3),1).NE.3) K(K(I,3),4)=IORI-N K(IORI,4)=K(IORI,4)+1 550 CONTINUE IEMP=0 PSJT=0. DO 570 I=N+1,N+NJET K(I,5)=0 PSJT=PSJT+P(I,5) P(I,5)=SQRT(MAX(P(I,4)**2-P(I,5)**2,0.)) DO 560 J=1,5 V(I,J)=0. 560 CONTINUE IF(K(I,4).EQ.0) IEMP=I 570 CONTINUE C...Select storing option. Output variables. Check for failure. MSTU(61)=N+1 MSTU(62)=NP MSTU(63)=NPRE PARU(61)=PS(5) PARU(62)=PSJT/PSS PARU(63)=SQRT(R2MIN) IF(NJET.LE.1) PARU(63)=0. IF(IEMP.NE.0) THEN CALL LUERRM(8,'(LUCLUS:) failed to reconstruct as requested') NJET=-1 ENDIF IF(MSTU(43).LE.1) MSTU(3)=NJET IF(MSTU(43).GE.2) N=N+NJET NSAV=NJET RETURN END C********************************************************************* SUBROUTINE LUCELL(NJET) C...Purpose: to provide a simple way of jet finding in an eta-phi-ET C...coordinate frame, as used for calorimeters at hadron colliders. COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ C...Loop over all particles. Find cell that was hit by given particle. PTLRAT=1./SINH(PARU(51))**2 NP=0 NC=N DO 110 I=1,N IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110 IF(P(I,1)**2+P(I,2)**2.LE.PTLRAT*P(I,3)**2) GOTO 110 IF(MSTU(41).GE.2) THEN KC=LUCOMP(K(I,2)) IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. & KC.EQ.18) GOTO 110 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) & GOTO 110 ENDIF NP=NP+1 PT=SQRT(P(I,1)**2+P(I,2)**2) ETA=SIGN(LOG((SQRT(PT**2+P(I,3)**2)+ABS(P(I,3)))/PT),P(I,3)) IETA=MAX(1,MIN(MSTU(51),1+INT(MSTU(51)*0.5*(ETA/PARU(51)+1.)))) PHI=ULANGL(P(I,1),P(I,2)) IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5*(PHI/PARU(1)+1.)))) IETPH=MSTU(52)*IETA+IPHI C...Add to cell already hit, or book new cell. DO 100 IC=N+1,NC IF(IETPH.EQ.K(IC,3)) THEN K(IC,4)=K(IC,4)+1 P(IC,5)=P(IC,5)+PT GOTO 110 ENDIF 100 CONTINUE IF(NC.GE.MSTU(4)-MSTU(32)-5) THEN CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS') NJET=-2 RETURN ENDIF NC=NC+1 K(NC,3)=IETPH K(NC,4)=1 K(NC,5)=2 P(NC,1)=(PARU(51)/MSTU(51))*(2*IETA-1-MSTU(51)) P(NC,2)=(PARU(1)/MSTU(52))*(2*IPHI-1-MSTU(52)) P(NC,5)=PT 110 CONTINUE C...Smear true bin content by calorimeter resolution. IF(MSTU(53).GE.1) THEN DO 130 IC=N+1,NC PEI=P(IC,5) IF(MSTU(53).EQ.2) PEI=P(IC,5)*COSH(P(IC,1)) 120 PEF=PEI+PARU(55)*SQRT(-2.*LOG(MAX(1E-10,RLU(0)))*PEI)* & COS(PARU(2)*RLU(0)) IF(PEF.LT.0..OR.PEF.GT.PARU(56)*PEI) GOTO 120 P(IC,5)=PEF IF(MSTU(53).EQ.2) P(IC,5)=PEF/COSH(P(IC,1)) 130 CONTINUE ENDIF C...Remove cells below threshold. IF(PARU(58).GT.0.) THEN NCC=NC NC=N DO 140 IC=N+1,NCC IF(P(IC,5).GT.PARU(58)) THEN NC=NC+1 K(NC,3)=K(IC,3) K(NC,4)=K(IC,4) K(NC,5)=K(IC,5) P(NC,1)=P(IC,1) P(NC,2)=P(IC,2) P(NC,5)=P(IC,5) ENDIF 140 CONTINUE ENDIF C...Find initiator cell: the one with highest pT of not yet used ones. NJ=NC 150 ETMAX=0. DO 160 IC=N+1,NC IF(K(IC,5).NE.2) GOTO 160 IF(P(IC,5).LE.ETMAX) GOTO 160 ICMAX=IC ETA=P(IC,1) PHI=P(IC,2) ETMAX=P(IC,5) 160 CONTINUE IF(ETMAX.LT.PARU(52)) GOTO 220 IF(NJ.GE.MSTU(4)-MSTU(32)-5) THEN CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS') NJET=-2 RETURN ENDIF K(ICMAX,5)=1 NJ=NJ+1 K(NJ,4)=0 K(NJ,5)=1 P(NJ,1)=ETA P(NJ,2)=PHI P(NJ,3)=0. P(NJ,4)=0. P(NJ,5)=0. C...Sum up unused cells within required distance of initiator. DO 170 IC=N+1,NC IF(K(IC,5).EQ.0) GOTO 170 IF(ABS(P(IC,1)-ETA).GT.PARU(54)) GOTO 170 DPHIA=ABS(P(IC,2)-PHI) IF(DPHIA.GT.PARU(54).AND.DPHIA.LT.PARU(2)-PARU(54)) GOTO 170 PHIC=P(IC,2) IF(DPHIA.GT.PARU(1)) PHIC=PHIC+SIGN(PARU(2),PHI) IF((P(IC,1)-ETA)**2+(PHIC-PHI)**2.GT.PARU(54)**2) GOTO 170 K(IC,5)=-K(IC,5) K(NJ,4)=K(NJ,4)+K(IC,4) P(NJ,3)=P(NJ,3)+P(IC,5)*P(IC,1) P(NJ,4)=P(NJ,4)+P(IC,5)*PHIC P(NJ,5)=P(NJ,5)+P(IC,5) 170 CONTINUE C...Reject cluster below minimum ET, else accept. IF(P(NJ,5).LT.PARU(53)) THEN NJ=NJ-1 DO 180 IC=N+1,NC IF(K(IC,5).LT.0) K(IC,5)=-K(IC,5) 180 CONTINUE ELSEIF(MSTU(54).LE.2) THEN P(NJ,3)=P(NJ,3)/P(NJ,5) P(NJ,4)=P(NJ,4)/P(NJ,5) IF(ABS(P(NJ,4)).GT.PARU(1)) P(NJ,4)=P(NJ,4)-SIGN(PARU(2), & P(NJ,4)) DO 190 IC=N+1,NC IF(K(IC,5).LT.0) K(IC,5)=0 190 CONTINUE ELSE DO 200 J=1,4 P(NJ,J)=0. 200 CONTINUE DO 210 IC=N+1,NC IF(K(IC,5).GE.0) GOTO 210 P(NJ,1)=P(NJ,1)+P(IC,5)*COS(P(IC,2)) P(NJ,2)=P(NJ,2)+P(IC,5)*SIN(P(IC,2)) P(NJ,3)=P(NJ,3)+P(IC,5)*SINH(P(IC,1)) P(NJ,4)=P(NJ,4)+P(IC,5)*COSH(P(IC,1)) K(IC,5)=0 210 CONTINUE ENDIF GOTO 150 C...Arrange clusters in falling ET sequence. 220 DO 250 I=1,NJ-NC ETMAX=0. DO 230 IJ=NC+1,NJ IF(K(IJ,5).EQ.0) GOTO 230 IF(P(IJ,5).LT.ETMAX) GOTO 230 IJMAX=IJ ETMAX=P(IJ,5) 230 CONTINUE K(IJMAX,5)=0 K(N+I,1)=31 K(N+I,2)=98 K(N+I,3)=I K(N+I,4)=K(IJMAX,4) K(N+I,5)=0 DO 240 J=1,5 P(N+I,J)=P(IJMAX,J) V(N+I,J)=0. 240 CONTINUE 250 CONTINUE NJET=NJ-NC C...Convert to massless or massive four-vectors. IF(MSTU(54).EQ.2) THEN DO 260 I=N+1,N+NJET ETA=P(I,3) P(I,1)=P(I,5)*COS(P(I,4)) P(I,2)=P(I,5)*SIN(P(I,4)) P(I,3)=P(I,5)*SINH(ETA) P(I,4)=P(I,5)*COSH(ETA) P(I,5)=0. 260 CONTINUE ELSEIF(MSTU(54).GE.3) THEN DO 270 I=N+1,N+NJET P(I,5)=SQRT(MAX(0.,P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2)) 270 CONTINUE ENDIF C...Information about storage. MSTU(61)=N+1 MSTU(62)=NP MSTU(63)=NC-N IF(MSTU(43).LE.1) MSTU(3)=NJET IF(MSTU(43).GE.2) N=N+NJET RETURN END C********************************************************************* SUBROUTINE LUJMAS(PMH,PML) C...Purpose: to determine, approximately, the two jet masses that C...minimize the sum m_H^2 + m_L^2, a la Clavelli and Wyler. COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ DIMENSION SM(3,3),SAX(3),PS(3,5) C...Reset. NP=0 DO 120 J1=1,3 DO 100 J2=J1,3 SM(J1,J2)=0. 100 CONTINUE DO 110 J2=1,4 PS(J1,J2)=0. 110 CONTINUE 120 CONTINUE PSS=0. C...Take copy of particles that are to be considered in mass analysis. DO 170 I=1,N IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170 IF(MSTU(41).GE.2) THEN KC=LUCOMP(K(I,2)) IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. & KC.EQ.18) GOTO 170 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) & GOTO 170 ENDIF IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN CALL LUERRM(11,'(LUJMAS:) no more memory left in LUJETS') PMH=-2. PML=-2. RETURN ENDIF NP=NP+1 DO 130 J=1,5 P(N+NP,J)=P(I,J) 130 CONTINUE IF(MSTU(42).EQ.0) P(N+NP,5)=0. IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1) P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) C...Fill information in sphericity tensor and total momentum vector. DO 150 J1=1,3 DO 140 J2=J1,3 SM(J1,J2)=SM(J1,J2)+P(I,J1)*P(I,J2) 140 CONTINUE 150 CONTINUE PSS=PSS+(P(I,1)**2+P(I,2)**2+P(I,3)**2) DO 160 J=1,4 PS(3,J)=PS(3,J)+P(N+NP,J) 160 CONTINUE 170 CONTINUE C...Very low multiplicities (0 or 1) not considered. IF(NP.LE.1) THEN CALL LUERRM(8,'(LUJMAS:) too few particles for analysis') PMH=-1. PML=-1. RETURN ENDIF PARU(61)=SQRT(MAX(0.,PS(3,4)**2-PS(3,1)**2-PS(3,2)**2-PS(3,3)**2)) C...Find largest eigenvalue to matrix (third degree equation). DO 190 J1=1,3 DO 180 J2=J1,3 SM(J1,J2)=SM(J1,J2)/PSS 180 CONTINUE 190 CONTINUE SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2- &SM(1,3)**2-SM(2,3)**2)/3.-1./9. SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)* &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27. SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.) SMA=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP) C...Find largest eigenvector by solving equation system. DO 210 J1=1,3 SM(J1,J1)=SM(J1,J1)-SMA DO 200 J2=J1+1,3 SM(J2,J1)=SM(J1,J2) 200 CONTINUE 210 CONTINUE SMAX=0. DO 230 J1=1,3 DO 220 J2=1,3 IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 220 JA=J1 JB=J2 SMAX=ABS(SM(J1,J2)) 220 CONTINUE 230 CONTINUE SMAX=0. DO 250 J3=JA+1,JA+2 J1=J3-3*((J3-1)/3) RL=SM(J1,JB)/SM(JA,JB) DO 240 J2=1,3 SM(J1,J2)=SM(J1,J2)-RL*SM(JA,J2) IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 240 JC=J1 SMAX=ABS(SM(J1,J2)) 240 CONTINUE 250 CONTINUE JB1=JB+1-3*(JB/3) JB2=JB+2-3*((JB+1)/3) SAX(JB1)=-SM(JC,JB2) SAX(JB2)=SM(JC,JB1) SAX(JB)=-(SM(JA,JB1)*SAX(JB1)+SM(JA,JB2)*SAX(JB2))/SM(JA,JB) C...Divide particles into two initial clusters by hemisphere. DO 270 I=N+1,N+NP PSAX=P(I,1)*SAX(1)+P(I,2)*SAX(2)+P(I,3)*SAX(3) IS=1 IF(PSAX.LT.0.) IS=2 K(I,3)=IS DO 260 J=1,4 PS(IS,J)=PS(IS,J)+P(I,J) 260 CONTINUE 270 CONTINUE PMS=MAX(1E-10,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+ &MAX(1E-10,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2) C...Reassign one particle at a time; find maximum decrease of m^2 sum. 280 PMD=0. IM=0 DO 290 J=1,4 PS(3,J)=PS(1,J)-PS(2,J) 290 CONTINUE DO 300 I=N+1,N+NP PPS=P(I,4)*PS(3,4)-P(I,1)*PS(3,1)-P(I,2)*PS(3,2)-P(I,3)*PS(3,3) IF(K(I,3).EQ.1) PMDI=2.*(P(I,5)**2-PPS) IF(K(I,3).EQ.2) PMDI=2.*(P(I,5)**2+PPS) IF(PMDI.LT.PMD) THEN PMD=PMDI IM=I ENDIF 300 CONTINUE C...Loop back if significant reduction in sum of m^2. IF(PMD.LT.-PARU(48)*PMS) THEN PMS=PMS+PMD IS=K(IM,3) DO 310 J=1,4 PS(IS,J)=PS(IS,J)-P(IM,J) PS(3-IS,J)=PS(3-IS,J)+P(IM,J) 310 CONTINUE K(IM,3)=3-IS GOTO 280 ENDIF C...Final masses and output. MSTU(61)=N+1 MSTU(62)=NP PS(1,5)=SQRT(MAX(0.,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)) PS(2,5)=SQRT(MAX(0.,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2)) PMH=MAX(PS(1,5),PS(2,5)) PML=MIN(PS(1,5),PS(2,5)) RETURN END C********************************************************************* SUBROUTINE LUFOWO(H10,H20,H30,H40) C...Purpose: to calculate the first few Fox-Wolfram moments. COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ C...Copy momenta for particles and calculate H0. NP=0 H0=0. HD=0. DO 110 I=1,N IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110 IF(MSTU(41).GE.2) THEN KC=LUCOMP(K(I,2)) IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. & KC.EQ.18) GOTO 110 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) & GOTO 110 ENDIF IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN CALL LUERRM(11,'(LUFOWO:) no more memory left in LUJETS') H10=-1. H20=-1. H30=-1. H40=-1. RETURN ENDIF NP=NP+1 DO 100 J=1,3 P(N+NP,J)=P(I,J) 100 CONTINUE P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) H0=H0+P(N+NP,4) HD=HD+P(N+NP,4)**2 110 CONTINUE H0=H0**2 C...Very low multiplicities (0 or 1) not considered. IF(NP.LE.1) THEN CALL LUERRM(8,'(LUFOWO:) too few particles for analysis') H10=-1. H20=-1. H30=-1. H40=-1. RETURN ENDIF C...Calculate H1 - H4. H10=0. H20=0. H30=0. H40=0. DO 130 I1=N+1,N+NP DO 120 I2=I1+1,N+NP CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/ &(P(I1,4)*P(I2,4)) H10=H10+P(I1,4)*P(I2,4)*CTHE H20=H20+P(I1,4)*P(I2,4)*(1.5*CTHE**2-0.5) H30=H30+P(I1,4)*P(I2,4)*(2.5*CTHE**3-1.5*CTHE) H40=H40+P(I1,4)*P(I2,4)*(4.375*CTHE**4-3.75*CTHE**2+0.375) 120 CONTINUE 130 CONTINUE C...Calculate H1/H0 - H4/H0. Output. MSTU(61)=N+1 MSTU(62)=NP H10=(HD+2.*H10)/H0 H20=(HD+2.*H20)/H0 H30=(HD+2.*H30)/H0 H40=(HD+2.*H40)/H0 RETURN END C********************************************************************* SUBROUTINE LUTABU(MTABU) C...Purpose: to evaluate various properties of an event, with C...statistics accumulated during the course of the run and C...printed at the end. COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ DIMENSION KFIS(100,2),NPIS(100,0:10),KFFS(400),NPFS(400,4), &FEVFM(10,4),FM1FM(3,10,4),FM2FM(3,10,4),FMOMA(4),FMOMS(4), &FEVEE(50),FE1EC(50),FE2EC(50),FE1EA(25),FE2EA(25), &KFDM(8),KFDC(200,0:8),NPDC(200) SAVE NEVIS,NKFIS,KFIS,NPIS,NEVFS,NPRFS,NFIFS,NCHFS,NKFFS, &KFFS,NPFS,NEVFM,NMUFM,FM1FM,FM2FM,NEVEE,FE1EC,FE2EC,FE1EA, &FE2EA,NEVDC,NKFDC,NREDC,KFDC,NPDC CHARACTER CHAU*16,CHIS(2)*12,CHDC(8)*12 DATA NEVIS/0/,NKFIS/0/,NEVFS/0/,NPRFS/0/,NFIFS/0/,NCHFS/0/, &NKFFS/0/,NEVFM/0/,NMUFM/0/,FM1FM/120*0./,FM2FM/120*0./, &NEVEE/0/,FE1EC/50*0./,FE2EC/50*0./,FE1EA/25*0./,FE2EA/25*0./, &NEVDC/0/,NKFDC/0/,NREDC/0/ C...Reset statistics on initial parton state. IF(MTABU.EQ.10) THEN NEVIS=0 NKFIS=0 C...Identify and order flavour content of initial state. ELSEIF(MTABU.EQ.11) THEN NEVIS=NEVIS+1 KFM1=2*IABS(MSTU(161)) IF(MSTU(161).GT.0) KFM1=KFM1-1 KFM2=2*IABS(MSTU(162)) IF(MSTU(162).GT.0) KFM2=KFM2-1 KFMN=MIN(KFM1,KFM2) KFMX=MAX(KFM1,KFM2) DO 100 I=1,NKFIS IF(KFMN.EQ.KFIS(I,1).AND.KFMX.EQ.KFIS(I,2)) THEN IKFIS=-I GOTO 110 ELSEIF(KFMN.LT.KFIS(I,1).OR.(KFMN.EQ.KFIS(I,1).AND. & KFMX.LT.KFIS(I,2))) THEN IKFIS=I GOTO 110 ENDIF 100 CONTINUE IKFIS=NKFIS+1 110 IF(IKFIS.LT.0) THEN IKFIS=-IKFIS ELSE IF(NKFIS.GE.100) RETURN DO 130 I=NKFIS,IKFIS,-1 KFIS(I+1,1)=KFIS(I,1) KFIS(I+1,2)=KFIS(I,2) DO 120 J=0,10 NPIS(I+1,J)=NPIS(I,J) 120 CONTINUE 130 CONTINUE NKFIS=NKFIS+1 KFIS(IKFIS,1)=KFMN KFIS(IKFIS,2)=KFMX DO 140 J=0,10 NPIS(IKFIS,J)=0 140 CONTINUE ENDIF NPIS(IKFIS,0)=NPIS(IKFIS,0)+1 C...Count number of partons in initial state. NP=0 DO 160 I=1,N IF(K(I,1).LE.0.OR.K(I,1).GT.12) THEN ELSEIF(IABS(K(I,2)).GT.80.AND.IABS(K(I,2)).LE.100) THEN ELSEIF(IABS(K(I,2)).GT.100.AND.MOD(IABS(K(I,2))/10,10).NE.0) & THEN ELSE IM=I 150 IM=K(IM,3) IF(IM.LE.0.OR.IM.GT.N) THEN NP=NP+1 ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN NP=NP+1 O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O ,3)=4**10  O 1 O C...Calculate sum of factorial moments in event. 3 O DO 480 IM=1,3  O DO 430 IB=1,10 S O DO 420 IP=1,4  O FEVFM(IB,IP)=0.  O 420 CONTINUE , O 430 CONTINUE 3 O DO 450 IB=1,10 ($ O IF(IM.LE.2) IBIN=2**(10-IB) $ O IF(IM.EQ.3) IBIN=4**(10-IB)  O IAGR=K(NLOW+1,IM)/IBIN . O NAGR=1 3 O DO 440 I=NLOW+2,NUPP+1 - O ICUT=K(I,IM)/IBIN  O IF(ICUT.EQ.IAGR) THEN  O NAGR=NAGR+1 ELSE O  O IF(NAGR.EQ.1) THEN O ! O ELSEIF(NAGR.EQ.2) THEN J' O FEVFM(IB,1)=FEVFM(IB,1)+2. ! O ELSEIF(NAGR.EQ.3) THEN O' O FEVFM(IB,1)=FEVFM(IB,1)+6. ' O FEVFM(IB,2)=FEVFM(IB,2)+6. ! O ELSEIF(NAGR.EQ.4) THEN A( O FEVFM(IB,1)=FEVFM(IB,1)+12. ( O FEVFM(IB,2)=FEVFM(IB,2)+24. ( O FEVFM(IB,3)=FEVFM(IB,3)+24.  O ELSE S3 O FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1.) J= O FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1.)*(NAGR-2.) G O FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.) NH O FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.)*  O & (NAGR-4.)  O ENDIF  O IAGR=ICUT  O NAGR=1 M O ENDIF  O 440 CONTINUE O  O 450 CONTINUE s O t% O C...Add results to total statistics. O  O DO 470 IB=10,1,-1  O DO 460 IP=1,4 $ O IF(FEVFM(1,IP).LT.0.5) THEN  O FEVFM(IB,IP)=0.  O ELSEIF(IM.LE.2) THEN O@ O FEVFM(IB,IP)=2.**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) ELSE O @ O FEVFM(IB,IP)=4.**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP)  O ENDIF 5 O FM1FM(IM,IB,IP)=FM1FM(IM,IB,IP)+FEVFM(IB,IP) O 8 O FM2FM(IM,IB,IP)=FM2FM(IM,IB,IP)+FEVFM(IB,IP)**2  O 460 CONTINUE 8 O 470 CONTINUE M O 480 CONTINUE J O NMUFM=NMUFM+(NUPP-NLOW)  O MSTU(62)=NUPP-NLOW  O 37 O C...Write accumulated statistics on factorial moments. ( O ELSEIF(MTABU.EQ.32) THEN  O FAC=1./MAX(1,NEVFM) ; O IF(MSTU(42).LE.0) WRITE(MSTU(11),5400) NEVFM,'eta' O ; O IF(MSTU(42).EQ.1) WRITE(MSTU(11),5400) NEVFM,'ypi' I; O IF(MSTU(42).GE.2) WRITE(MSTU(11),5400) NEVFM,'y ' i O DO 510 IM=1,3  O WRITE(MSTU(11),5500) ( O DO 500 IB=1,10 M O BYETA=2.*PARU(57) * O IF(IM.NE.2) BYETA=BYETA/2**(IB-1)  O BPHI=PARU(2) ( O IF(IM.NE.1) BPHI=BPHI/2**(IB-1) 5 O IF(IM.LE.2) BNAVE=FAC*NMUFM/FLOAT(2**(IB-1)) 05 O IF(IM.EQ.3) BNAVE=FAC*NMUFM/FLOAT(4**(IB-1))  O DO 490 IP=1,4 & O FMOMA(IP)=FAC*FM1FM(IM,IB,IP) G O FMOMS(IP)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-FMOMA(IP)**2))) 0 O 490 CONTINUE )D O WRITE(MSTU(11),5600) BYETA,BPHI,BNAVE,(FMOMA(IP),FMOMS(IP),  O & IP=1,4)  O 500 CONTINUE  O 510 CONTINUE  O O8 O C...Copy statistics on factorial moments into /LUJETS/.  O ELSEIF(MTABU.EQ.33) THEN U O FAC=1./MAX(1,NEVFM)  O DO 540 IM=1,3  O DO 530 IB=1,10 - O I=10*(IM-1)+IB  O K(I,1)=32  O K(I,2)=99  O K(I,3)=1 N% O IF(IM.NE.2) K(I,3)=2**(IB-1) A O K(I,4)=1 M% O IF(IM.NE.1) K(I,4)=2**(IB-1) 2 O K(I,5)=0 " O P(I,1)=2.*PARU(57)/K(I,3)  O V(I,1)=PARU(2)/K(I,4)  O DO 520 IP=1,4 & O P(I,IP+1)=FAC*FM1FM(IM,IB,IP) G O V(I,IP+1)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-P(I,IP+1)**2))) I O 520 CONTINUE . O 530 CONTINUE  O 540 CONTINUE N=30 . O DO 550 J=1,5 E O K(N+1,J)=0 0 O P(N+1,J)=0.  O V(N+1,J)=0.  O 550 CONTINUE H O K(N+1,1)=32  O K(N+1,2)=99  O K(N+1,5)=NEVFM I O MSTU(3)=1  O T3 O C...Reset statistics on Energy-Energy Correlation. W O ELSEIF(MTABU.EQ.40) THEN ' O NEVEE=0  O DO 560 J=1,25  O FE1EC(J)=0.  O FE2EC(J)=0.  O FE1EC(51-J)=0.  O FE2EC(51-J)=0. J O FE1EA(J)=0.  O FE2EA(J)=0.  O 560 CONTINUE P O =9 O C...Find particles to include, with proper assumed mass.  O ELSEIF(MTABU.EQ.41) THEN 1 O NEVEE=NEVEE+1  O NLOW=N+MSTU(3) m O NUPP=NLOW  O ECM=0. . O DO 570 I=1,N H1 O IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 570 i O IF(MSTU(41).GE.2) THEN = O KC=LUCOMP(K(I,2)) = O IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. N O & KC.EQ.18) GOTO 570 H O IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)  O & GOTO 570 O O ENDIF  O PMR=0. (; O IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=ULMASS(211) ,% O IF(MSTU(42).GE.2) PMR=P(I,5) 2, O IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN D O CALL LUERRM(11,'(LUTABU:) no more memory left in LUJETS')  O RETURN 1 O ENDIF  O NUPP=NUPP+1  O P(NUPP,1)=P(I,1) . O P(NUPP,2)=P(I,2) . O P(NUPP,3)=P(I,3) t= O P(NUPP,4)=SQRT(PMR**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) +A O P(NUPP,5)=MAX(1E-10,SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2))  O ECM=ECM+P(NUPP,4)  O 570 CONTINUE P O IF(NUPP.EQ.NLOW) RETURN  O *0 O C...Analyze Energy-Energy Correlation in event. $ O FAC=(2./ECM**2)*50./PARU(1)  O DO 580 J=1,50  O FEVEE(J)=0.  O 580 CONTINUE w O DO 600 I1=NLOW+2,NUPP  O DO 590 I2=NLOW+1,I1-1 @ O CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/  O & (P(I1,5)*P(I2,5)) ( O THE=ACOS(MAX(-1.,MIN(1.,CTHE))) 3 O ITHE=MAX(1,MIN(50,1+INT(50.*THE/PARU(1)))) ,4 O FEVEE(ITHE)=FEVEE(ITHE)+FAC*P(I1,4)*P(I2,4)  O 590 CONTINUE ( O 600 CONTINUE E O DO 610 J=1,25 # O FE1EC(J)=FE1EC(J)+FEVEE(J) E& O FE2EC(J)=FE2EC(J)+FEVEE(J)**2 , O FE1EC(51-J)=FE1EC(51-J)+FEVEE(51-J) / O FE2EC(51-J)=FE2EC(51-J)+FEVEE(51-J)**2 E1 O FE1EA(J)=FE1EA(J)+(FEVEE(51-J)-FEVEE(J)) 4 O FE2EA(J)=FE2EA(J)+(FEVEE(51-J)-FEVEE(J))**2  O 610 CONTINUE V O MSTU(62)=NUPP-NLOW O  O 3 O C...Write statistics on Energy-Energy Correlation. , O ELSEIF(MTABU.EQ.42) THEN , O FAC=1./MAX(1,NEVEE) # O WRITE(MSTU(11),5700) NEVEE  O DO 620 J=1,25  O FEEC1=FAC*FE1EC(J) ,8 O FEES1=SQRT(MAX(0.,FAC*(FAC*FE2EC(J)-FEEC1**2)))  O FEEC2=FAC*FE1EC(51-J) ; O FEES2=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-J)-FEEC2**2))) & O FEECA=FAC*FE1EA(J) O 8 O FEESA=SQRT(MAX(0.,FAC*(FAC*FE2EA(J)-FEECA**2))) F O WRITE(MSTU(11),5800) 3.6*(J-1),3.6*J,FEEC1,FEES1,FEEC2,FEES2,  O & FEECA,FEESA  O 620 CONTINUE  O t@ O C...Copy statistics on Energy-Energy Correlation into /LUJETS/.  O ELSEIF(MTABU.EQ.43) THEN  O FAC=1./MAX(1,NEVEE)  O DO 630 I=1,25  O K(I,1)=32  O K(I,2)=99  O K(I,3)=0 O  O K(I,4)=0 K O K(I,5)=0  O P(I,1)=FAC*FE1EC(I) : O V(I,1)=SQRT(MAX(0.,FAC*(FAC*FE2EC(I)-P(I,1)**2)))  O P(I,2)=FAC*FE1EC(51-I) I= O V(I,2)=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-I)-P(I,2)**2))) O O P(I,3)=FAC*FE1EA(I) : O V(I,3)=SQRT(MAX(0.,FAC*(FAC*FE2EA(I)-P(I,3)**2))) ! O P(I,4)=PARU(1)*(I-1)/50. 0 O P(I,5)=PARU(1)*I/50. K O V(I,4)=3.6*(I-1) . O V(I,5)=3.6*I I O 630 CONTINUE N=25  O DO 640 J=1,5 R O K(N+1,J)=0 I O P(N+1,J)=0.  O V(N+1,J)=0.  O 640 CONTINUE F O K(N+1,1)=32  O K(N+1,2)=99  O K(N+1,5)=NEVEE = O MSTU(3)=1  O O( O C...Reset statistics on decay channels.  O ELSEIF(MTABU.EQ.50) THEN S O NEVDC=0  O NKFDC=0  O NREDC=0  O 17 O C...Identify and order flavour content of final state. E O ELSEIF(MTABU.EQ.51) THEN I O NEVDC=NEVDC+1  O NDS=0  O DO 670 I=1,N i0 O IF(K(I,1).LE.0.OR.K(I,1).GE.6) GOTO 670  O NDS=NDS+1  O IF(NDS.GT.8) THEN  O NREDC=NREDC+1  O RETURN S O ENDIF  O KFM=2*IABS(K(I,2)) (" O IF(K(I,2).LT.0) KFM=KFM-1  O DO 650 IDS=NDS-1,1,-1  O IIN=IDS+1 & O IF(KFM.LT.KFDM(IDS)) GOTO 660  O KFDM(IDS+1)=KFDM(IDS)  O 650 CONTINUE N O IIN=1  O 660 KFDM(IIN)=KFM  O 670 CONTINUE M O ) O C...Find whether old or new final state. ( O DO 690 IDC=1,NKFDC )$ O IF(NDS.LT.KFDC(IDC,0)) THEN  O IKFDC=IDC  O GOTO 700 )( O ELSEIF(NDS.EQ.KFDC(IDC,0)) THEN  O DO 680 I=1,NDS O * O IF(KFDM(I).LT.KFDC(IDC,I)) THEN  O IKFDC=IDC  O GOTO 700 N. O ELSEIF(KFDM(I).GT.KFDC(IDC,I)) THEN  O GOTO 690 C O ENDIF  O 680 CONTINUE  O IKFDC=-IDC 0 O GOTO 700 S O ENDIF  O 690 CONTINUE  O IKFDC=NKFDC+1  O 700 IF(IKFDC.LT.0) THEN  O IKFDC=-IKFDC M" O ELSEIF(NKFDC.GE.200) THEN  O NREDC=NREDC+1  O RETURN V ELSE O$ O DO 720 IDC=NKFDC,IKFDC,-1 O NPDC(IDC+1)=NPDC(IDC)  O DO 710 I=0,8 ($ O KFDC(IDC+1,I)=KFDC(IDC,I)  O 710 CONTINUE  O 720 CONTINUE ) O NKFDC=NKFDC+1  O KFDC(IKFDC,0)=NDS  O DO 730 I=1,NDS O KFDC(IKFDC,I)=KFDM(I)  O 730 CONTINUE K O NPDC(IKFDC)=0  O ENDIF " O NPDC(IKFDC)=NPDC(IKFDC)+1  O ( O C...Write statistics on decay channels.  O ELSEIF(MTABU.EQ.52) THEN 1 O FAC=1./MAX(1,NEVDC) # O WRITE(MSTU(11),5900) NEVDC ) O DO 750 IDC=1,NKFDC  O DO 740 I=1,KFDC(IDC,0) = O KFM=KFDC(IDC,I)  O KF=(KFM+1)/2 c O IF(2*KF.NE.KFM) KF=-KF U O CALL LUNAME(KF,CHAU) . O CHDC(I)=CHAU(1:12) X2 O IF(CHAU(13:13).NE.' ') CHDC(I)(12:12)='?'  O 740 CONTINUE E O WRITE(MSTU(11),6000) FAC*NPDC(IDC),(CHDC(I),I=1,KFDC(IDC,0)) 2 O 750 CONTINUE =6 O IF(NREDC.NE.0) WRITE(MSTU(11),6100) FAC*NREDC  O )5 O C...Copy statistics on decay channels into /LUJETS/. Q O ELSEIF(MTABU.EQ.53) THEN ) O FAC=1./MAX(1,NEVDC)  O DO 780 IDC=1,NKFDC , O K(IDC,1)=32  O K(IDC,2)=99  O K(IDC,3)=0  O K(IDC,4)=0 , O K(IDC,5)=KFDC(IDC,0) , O DO 760 J=1,5 E O P(IDC,J)=0.  O V(IDC,J)=0.  O 760 CONTINUE  O DO 770 I=1,KFDC(IDC,0) ( O KFM=KFDC(IDC,I)  O KF=(KFM+1)/2 E O IF(2*KF.NE.KFM) KF=-KF  O IF(I.LE.5) P(IDC,I)=KF V! O IF(I.GE.6) V(IDC,I-5)=KF e O 770 CONTINUE u O V(IDC,5)=FAC*NPDC(IDC)  O 780 CONTINUE 0 O N=NKFDC  O DO 790 J=1,5 = O K(N+1,J)=0 O  O P(N+1,J)=0.  O V(N+1,J)=0.  O 790 CONTINUE r O K(N+1,1)=32  O K(N+1,2)=99  O K(N+1,5)=NEVDC  O V(N+1,5)=FAC*NREDC  O MSTU(3)=1 O ENDIF  O O ? O C...Format statements for output on unit MSTU(11) (default 6). P8 O 5000 FORMAT(///20X,'Event statistics - initial state'/ 4 O &20X,'based on an analysis of ',I6,' events'// A O &3X,'Main flavours after',8X,'Fraction',4X,'Subfractions ', K6 O &'according to fragmenting system multiplicity'/ A O &4X,'hard interaction',24X,'1',7X,'2',7X,'3',7X,'4',7X,'5', I: O &6X,'6-7',5X,'8-10',3X,'11-15',3X,'16-25',4X,'>25'/) , O 5100 FORMAT(3X,A12,1X,A12,F10.5,1X,10F8.4) 6 O 5200 FORMAT(///20X,'Event statistics - final state'/ 4 O &20X,'based on an analysis of ',I7,' events'// . O &5X,'Mean primary multiplicity =',F10.4/ . O &5X,'Mean final multiplicity =',F10.4/ / O &5X,'Mean charged multiplicity =',F10.4// .F O &5X,'Number of particles produced per event (directly and via ',  O &'decays/branchings)'/ I O &5X,'KF Particle/jet MDCY',10X,'Particles',13X,'Antiparticles', B O &8X,'Total'/35X,'prim seco prim seco'/) * O 5300 FORMAT(1X,I6,4X,A16,I2,5(1X,F11.6)) B O 5400 FORMAT(///20X,'Factorial moments analysis of multiplicity'/ 4 O &20X,'based on an analysis of ',I6,' events'// E O &3X,'delta-',A3,' delta-phi /bin',10X,'',18X,'', = O &18X,'',18X,''/35X,4(' value error ')) O O 5500 FORMAT(10X) - O 5600 FORMAT(2X,2F10.4,F12.4,4(F12.4,F10.4)) K? O 5700 FORMAT(///20X,'Energy-Energy Correlation and Asymmetry'/ 4 O &20X,'based on an analysis of ',I6,' events'// ? O &2X,'theta range',8X,'EEC(theta)',8X,'EEC(180-theta)',7X, TA O &'EECA(theta)'/2X,'in degrees ',3(' value error')/) F/ O 5800 FORMAT(2X,F4.1,' - ',F4.1,3(F11.4,F9.4)) I< O 5900 FORMAT(///20X,'Decay channel analysis - final state'/ 4 O &20X,'based on an analysis of ',I6,' events'// 4 O &2X,'Probability',10X,'Complete final state'/) # O 6000 FORMAT(2X,F9.5,5X,8(A12,1X)) O G O 0 FORMAT(2X,F9.5,5X,'into other channels (more than 8 particles ', r O &'or table overflow)')  O RETURN e O END  O G O C********************************************************************* S O 1! O SUBROUTINE LUEEVT(KFL,ECM) F O NI O C...Purpose: to handle the generation of an e+e- annihilation jet event. # O IMPLICIT DOUBLE PRECISION(D) Y4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) & O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/  O m O C...Check input parameters. ' O IF(MSTU(12).GE.1) CALL LULIST(0) O $ O IF(KFL.LT.0.OR.KFL.GT.8) THEN E O CALL LUERRM(16,'(LUEEVT:) called with unknown flavour code') ,! O IF(MSTU(21).GE.1) RETURN O ENDIF > O IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02*PARF(100+MAX(1,KFL)) 5 O IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02*PMAS(KFL,1)  O IF(ECM.LT.ECMMIN) THEN )D O CALL LUERRM(16,'(LUEEVT:) called with too small CM energy') ! O IF(MSTU(21).GE.1) RETURN ( O ENDIF  O + O C...Check consistency of MSTJ options set. 1 O IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN 9 O CALL LUERRM(6, S< O & '(LUEEVT:) MSTJ(109) value requires MSTJ(110) = 1')  O MSTJ(110)=1 O ENDIF 1 O IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN t O CALL LUERRM(6, A< O & '(LUEEVT:) MSTJ(109) value requires MSTJ(111) = 0')  O MSTJ(111)=0 O ENDIF  O 5 O C...Initialize alpha_strong and total cross-section. O  O MSTU(111)=MSTJ(108) @ O IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))  O &MSTU(111)=1  O PARU(112)=PARJ(121) - O IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) .F O IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE. H O &PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL LUXTOT(KFL,ECM, O &XTOT) % O IF(MSTJ(116).GE.3) MSTJ(116)=1  O PARJ(171)=0. O  O ; O C...Add initial e+e- to event record (documentation only). NTRY=0 8 O 100 NTRY=NTRY+1  O IF(NTRY.GT.100) THEN (? O CALL LUERRM(14,'(LUEEVT:) caught in an infinite loop')  O RETURN O ENDIF  O MSTU(24)=0 1 O NC=0 E O IF(MSTJ(115).GE.2) THEN  O NC=NC+2 + O CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.) , O K(NC-1,1)=21 / O CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.) , O K(NC,1)=21 O ENDIF  O )) O C...Radiative photon (in initial state). 4 O MK=0  O ECMC=ECM ,D O IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL LURADK(ECM,MK,PAK,  O &THEK,PHIK,ALPK) . O IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2.*PAK)) * O IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN  O NC=NC+1 ) O CALL LU1ENT(NC,22,PAK,THEK,PHIK) M# O K(NC,3)=MIN(MSTJ(115)/2,1) 3 O ENDIF  O E* O C...Virtual exchange boson (gamma or Z0).  O IF(MSTJ(115).GE.3) THEN  O NC=NC+1  O KF=22 ! O IF(MSTJ(102).EQ.2) KF=23 : O MSTU10=MSTU(10)  O MSTU(10)=1 E O P(NC,5)=ECMC O & O CALL LU1ENT(NC,KF,ECMC,0.,0.)  O K(NC,1)=21  O K(NC,3)=1  O MSTU(10)=MSTU10 O ENDIF  O U- O C...Choice of flavour and jet configuration. I% O CALL LUXKFL(KFL,ECM,ECMC,KFLC) A O IF(KFLC.EQ.0) GOTO 100 ! O CALL LUXJET(ECMC,NJET,CUT) T O KFLN=21 B O IF(NJET.EQ.4) CALL LUX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4,  O &X12,X14) ,: O IF(NJET.EQ.3) CALL LUX3JT(NJET,CUT,KFLC,ECMC,X1,X3) O IF(NJET.EQ.2) MSTJ(120)=1  O ' O C...Fill jet configuration and origin. I O IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL LU2ENT(NC+1,KFLC,-KFLC,ECMC) G O IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL LU2ENT(-(NC+1),KFLC,-KFLC, E O &ECMC) ? O IF(NJET.EQ.3) CALL LU3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3) =D O IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL LU4ENT(NC+1,KFLC,KFLN,KFLN, # O &-KFLC,ECMC,X1,X2,X4,X12,X14) ,E O IF(NJET.EQ.4.AND.KFLN.NE.21) CALL LU4ENT(NC+1,KFLC,-KFLN,KFLN, E# O &-KFLC,ECMC,X1,X2,X4,X12,X14) 0! O IF(MSTU(24).NE.0) GOTO 100 N O DO 110 IP=NC+1,N I> O K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1)  O 110 CONTINUE  O 5 O C...Angular orientation according to matrix element.  O IF(MSTJ(106).EQ.1) THEN 3 O CALL LUXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI) G/ O CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0) J0 O CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0) O ENDIF  O Q. O C...Rotation and boost from radiative photon.  O IF(MK.EQ.1) THEN B O DBEK=-PAK/(ECM-PAK)  O NMIN=NC+1-MSTJ(115)/3 1 O CALL LUDBRB(NMIN,N,0.,-PHIK,0D0,0D0,0D0) EF O CALL LUDBRB(NMIN,N,ALPK,0.,DBEK*SIN(THEK),0D0,DBEK*COS(THEK)) 0 O CALL LUDBRB(NMIN,N,0.,PHIK,0D0,0D0,0D0) O ENDIF  O J? O C...Generate parton shower. Rearrange along strings and check. O  O IF(MSTJ(101).EQ.5) THEN O CALL LUSHOW(N-1,N,ECMC)  O MSTJ14=MSTJ(14) ( O IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 & O IF(MSTJ(105).GE.0) MSTU(28)=0  O CALL LUPREP(0)  O MSTJ(14)=MSTJ14 6 O IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 O ENDIF  O < O C...Fragmentation/decay generation. Information for LUTABU. % O IF(MSTJ(105).EQ.1) CALL LUEXEC 1 O MSTU(161)=KFLC  O MSTU(162)=-KFLC  O RETURN E O END  O G O C********************************************************************* E O O & O SUBROUTINE LUXTOT(KFL,ECM,XTOT)  O MA O C...Purpose: to calculate total cross-section, including initial ( O C...state radiation effects. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) F O SAVE /LUDAT1/,/LUDAT2/ ) O P1 O C...Status, (optimized) Q^2 scale, alpha_strong. a O PARJ(151)=ECM ! O MSTJ(119)=10*MSTJ(102)+KFL  O IF(MSTJ(111).EQ.0) THEN  O Q2R=ECM**2 R" O ELSEIF(MSTU(111).EQ.0) THEN 9 O PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/ O * O & ((33.-2.*MSTU(112))*PARU(111)))))  O Q2R=PARJ(168)*ECM**2 0 O ELSE 6 O PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM, O & (2.*PARU(112)/ECM)**2))  O Q2R=PARJ(168)*ECM**2 1 O ENDIF O ALSPI=ULALPS(Q2R)/PARU(1)  O I! O C...QCD corrections factor in R. 20 O IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN  O RQCD=1. ; O ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN M O RQCD=1.+ALSPI " O ELSEIF(MSTJ(109).EQ.0) THEN 7 O RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2 ED O IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.* ! O & LOG(PARJ(168))*ALSPI**2) N( O ELSEIF(IABS(MSTJ(101)).EQ.1) THEN  O RQCD=1.+(3./4.)*ALSPI O ELSE O @ O RQCD=1.+(3./4.)*ALSPI-(3./32.+0.519*MSTU(118))*ALSPI**2 O ENDIF  O ,8 O C...Calculate Z0 width if default value not acceptable.  O IF(MSTJ(102).GE.3) THEN G O RVA=3.*(3.+(4.*PARU(102)-1.)**2)+6.*RQCD*(2.+(1.-8.*PARU(102)/ ( O & 3.)**2+(4.*PARU(102)/3.-1.)**2)  O DO 100 KFLC=5,6  O VQ=1. F O IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*ULMASS(KFLC)/  O & ECM)**2)) , O IF(KFLC.EQ.5) VF=4.*PARU(102)/3.-1. , O IF(KFLC.EQ.6) VF=1.-8.*PARU(102)/3. 8 O RVA=RVA+3.*RQCD*(0.5*VQ*(3.-VQ**2)*VF**2+VQ**3)  O 100 CONTINUE I O PARJ(124)=PARU(101)*PARJ(123)*RVA/(48.*PARU(102)*(1.-PARU(102))) O O ENDIF  O 0= O C...Calculate propagator and related constants for QFD case. 9" O POLL=1.-PARJ(131)*PARJ(132)  O IF(MSTJ(102).GE.2) THEN . O SFF=1./(16.*PARU(102)*(1.-PARU(102))) G O SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) ( O SFI=SFW*(1.-(PARJ(123)/ECM)**2)  O VE=4.*PARU(102)-1. / O SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131)) EB O SF1W=SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131)))  O HF1I=SFI*SF1I  O HF1W=SFW*SF1W O ENDIF  O 4 O C...Loop over different flavours: charge, velocity.  O RTOT=0. RQQ=0. RQV=0. 1 RVA=0. F' O DO 110 KFLC=1,MAX(MSTJ(104),KFL) O , O IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110  O MSTJ(93)=1  O PMQ=ULMASS(KFLC) E+ O IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 110  O QF=KCHG(KFLC,1)/3. O VQ=1. < O IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1.-(2.*PMQ/ECM)**2)  O O8 O C...Calculate R and sum of charges for QED or QFD case.  O RQQ=RQQ+3.*QF**2*POLL  O IF(MSTJ(102).LE.1) THEN 2 O RTOT=RTOT+3.*0.5*VQ*(3.-VQ**2)*QF**2*POLL O ELSE T' O VF=SIGN(1.,QF)-4.*QF*PARU(102)  O RQV=RQV-6.*QF*VF*SF1I # O RVA=RVA+3.*(VF**2+1.)*SF1W O C O RTOT=RTOT+3.*(0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+ ( O & VF**2*HF1W)+VQ**3*HF1W) O ENDIF  O 110 CONTINUE + O RSUM=RQQ *2 O IF(MSTJ(102).GE.2) RSUM=RQQ+SFI*RQV+SFW*RVA  O *8 O C...Calculate cross-section, including QCD corrections.  O PARJ(141)=RQQ  O PARJ(142)=RTOT T O PARJ(143)=RTOT*RQCD  O PARJ(144)=PARJ(143) & O PARJ(145)=PARJ(141)*86.8/ECM**2 & O PARJ(146)=PARJ(142)*86.8/ECM**2 & O PARJ(147)=PARJ(143)*86.8/ECM**2  O PARJ(148)=PARJ(147)  O PARJ(157)=RSUM*RQCD  O PARJ(158)=0. 2 O PARJ(159)=0. ( O XTOT=PARJ(147) & O IF(MSTJ(107).LE.0) RETURN  O S O C...Virtual cross-section.  O XKL=PARJ(135) 2 O XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2) $ O ALE=2.*LOG(ECM/ULMASS(11))-1. C O SIGV=ALE/3.+2.*LOG(ECM**2/(ULMASS(13)*ULMASS(15)))/3.-4./3.+ ( O &1.526*LOG(ECM**2/0.932)  O E7 O C...Soft and hard radiative cross-section in QED case. J O IF(MSTJ(102).LE.1) THEN / O SIGV=1.5*ALE-0.5+PARU(1)**2/3.+2.*SIGV )/ O SIGS=ALE*(2.*LOG(XKL)-LOG(1.-XKL)-XKL) (D O SIGH=ALE*(2.*LOG(XKU/XKL)-LOG((1.-XKU)/(1.-XKL))-(XKU-XKL))  O 67 O C...Soft and hard radiative cross-section in QFD case. O ELSE ," O SZM=1.-(PARJ(123)/ECM)**2 ' O SZW=PARJ(123)*PARJ(124)/ECM**2 T O PARJ(161)=-RQQ/RSUM & O PARJ(162)=-(RQQ+RQV+RVA)/RSUM @ O PARJ(163)=(RQV*(1.-0.5*SZM-SFI)+RVA*(1.5-SZM-SFW))/RSUM H O PARJ(164)=(RQV*SZW**2*(1.-2.*SFW)+RVA*(2.*SFI+SZW**2-4.+3.*SZM-  O & SZM**2))/(SZW*RSUM) E O SIGV=1.5*ALE-0.5+PARU(1)**2/3.+((2.*RQQ+SFI*RQV)/RSUM)*SIGV+ ** O & (SZW*SFW*RQV/RSUM)*PARU(1)*20./9. C O SIGS=ALE*(2.*LOG(XKL)+PARJ(161)*LOG(1.-XKL)+PARJ(162)*XKL+ T> O & PARJ(163)*LOG(((XKL-SZM)**2+SZW**2)/(SZM**2+SZW**2))+ 8 O & PARJ(164)*(ATAN((XKL-SZM)/SZW)-ATAN(-SZM/SZW))) D O SIGH=ALE*(2.*LOG(XKU/XKL)+PARJ(161)*LOG((1.-XKU)/(1.-XKL))+ A O & PARJ(162)*(XKU-XKL)+PARJ(163)*LOG(((XKU-SZM)**2+SZW**2)/ )? O & ((XKL-SZM)**2+SZW**2))+PARJ(164)*(ATAN((XKU-SZM)/SZW)- C O & ATAN((XKL-SZM)/SZW))) O ENDIF  O F< O C...Total cross-section and fraction of hard photon events. 8 O PARJ(160)=SIGH/(PARU(1)/PARU(101)+SIGV+SIGS+SIGH) D O PARJ(157)=RSUM*(1.+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD  O PARJ(144)=PARJ(157) & O PARJ(148)=PARJ(144)*86.8/ECM**2  O XTOT=PARJ(148) 6 O I RETURN N O END  O =G O C********************************************************************* O  O 3 O SUBROUTINE LURADK(ECM,MK,PAK,THEK,PHIK,ALPK) ) O 9 O C...Purpose: to generate initial state photon radiation. S< O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)  O SAVE /LUDAT1/  O S; O C...Function: cumulative hard photon spectrum in QFD case. .< O FXK(XX)=2.*LOG(XX)+PARJ(161)*LOG(1.-XX)+PARJ(162)*XX+ E O &PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW)  O / O C...Determine whether radiative photon or not. G O MK=0 PAK=0. D% O IF(PARJ(160).LT.RLU(0)) RETURN O MK=1 D O ; O C...Photon energy range. Find photon momentum in QED case. 2 O XKL=PARJ(135) 2 O XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2)  O IF(MSTJ(102).LE.1) THEN A O 100 XK=1./(1.+(1./XKL-1.)*((1./XKU-1.)/(1./XKL-1.))**RLU(0)) 0 O IF(1.+(1.-XK)**2.LT.2.*RLU(0)) GOTO 100  O F O C...Ditto in QFD case, by numerical inversion of integrated spectrum. O ELSE 1" O SZM=1.-(PARJ(123)/ECM)**2 ' O SZW=PARJ(123)*PARJ(124)/ECM**2  O FXKL=FXK(XKL)  O FXKU=FXK(XKU)  O FXKD=1E-4*(FXKU-FXKL) % O FXKR=FXKL+RLU(0)*(FXKU-FXKL) ) O NXK=0  O 110 NXK=NXK+1  O XK=0.5*(XKL+XKU)  O FXKV=FXK(XK) C O IF(FXKV.GT.FX THEN  O XKU=XK N O FXKU=FXKV ELSE  O XKL=XK  O FXKL=FXKV  O ENDIF 5 O IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110 L1 O XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL) F O ENDIF  O PAK=0.5*ECM*XK = O D& O C...Photon polar and azimuthal angle. ! O PME=2.*(ULMASS(11)/ECM)**2 - O 120 CTHM=PME*(2./PME)**RLU(0) > O IF(1.-(XK**2*CTHM*(1.-0.5*CTHM)+2.*(1.-XK)*PME/MAX(PME, ? O &CTHM*(1.-0.5*CTHM)))/(1.+(1.-XK)**2).LT.RLU(0)) GOTO 120 K O CTHE=1.-CTHM C# O IF(RLU(0).GT.0.5) CTHE=-CTHE N. O STHE=SQRT(MAX(0.,(CTHM-PME)*(2.-CTHM)))  O THEK=ULANGL(CTHE,STHE) F O PHIK=PARU(2)*RLU(0)  O ( O C...Rotation angle for hadronic system. SGN=1. e@ O IF(0.5*(2.-XK*(1.-CTHE))**2/((2.-XK)**2+(XK*CTHE)**2).GT.  O &RLU(0)) SGN=-1. ? O ALPK=ASIN(SGN*STHE*(XK-SGN*(2.*SQRT(1.-XK)-2.+XK)*CTHE)/  O &(2.-XK*(1.-SGN*CTHE)))  O F RETURN O O END  O +G O C********************************************************************* O  O + O SUBROUTINE LUXKFL(KFL,ECM,ECMC,KFLC) 1 O N8 O C...Purpose: to select flavour for produced qqbar pair. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) * O SAVE /LUDAT1/,/LUDAT2/  O d1 O C...Calculate maximum weight in QED or QFD case. E O IF(MSTJ(102).LE.1) THEN  O RFMAX=4./9. O ELSE F$ O POLL=1.-PARJ(131)*PARJ(132) . O SFF=1./(16.*PARU(102)*(1.-PARU(102))) I O SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) D) O SFI=SFW*(1.-(PARJ(123)/ECMC)**2) T O VE=4.*PARU(102)-1. D3 O HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) +F O HF1W=SFW*SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131))) > O RFMAX=MAX(4./9.*POLL-4./3.*(1.-8.*PARU(102)/3.)*HF1I+ < O & ((1.-8.*PARU(102)/3.)**2+1.)*HF1W,1./9.*POLL+2./3.* G O & (-1.+4.*PARU(102)/3.)*HF1I+((-1.+4.*PARU(102)/3.)**2+1.)*HF1W) O O ENDIF  O 0/ O C...Choose flavour. Gives charge and velocity. NTRY=0  O 100 NTRY=NTRY+1  O IF(NTRY.GT.100) THEN N? O CALL LUERRM(14,'(LUXKFL:) caught in an infinite loop') t O KFLC=0 n O RETURN u O ENDIF  O KFLC=KFL E0 O IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*RLU(0))  O MSTJ(93)=1 f O PMQ=ULMASS(KFLC) &+ O IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 100 b O QF=KCHG(KFLC,1)/3. r O VQ=1. E O IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*PMQ/ECMC)**2)) ' O ,) O C...Calculate weight in QED or QFD case. 1 O IF(MSTJ(102).LE.1) THEN  O RF=QF**2 3$ O RFV=0.5*VQ*(3.-VQ**2)*QF**2 O ELSE ,' O VF=SIGN(1.,QF)-4.*QF*PARU(102) &4 O RF=QF**2*POLL-2.*QF*VF*HF1I+(VF**2+1.)*HF1W E O RFV=0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+VF**2*HF1W)+ l O & VQ**3*HF1W 7 O IF(RFV.GT.0.) PARJ(171)=MIN(1.,VQ**3*HF1W/RFV) u O ENDIF  O E O C...Weighting or new event (radiative photon). Cross-section update. O 3 O IF(KFL.LE.0.AND.RF.LT.RLU(0)*RFMAX) GOTO 100 3 O PARJ(158)=PARJ(158)+1. '> O IF(ECMC.LT.2.*PMQ+PARJ(127).OR.RFV.LT.RLU(0)*RF) KFLC=0 0 O IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100 + O IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1. l. O PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158) & O PARJ(148)=PARJ(144)*86.8/ECM**2  O a RETURN n O END  O XG O C********************************************************************* O O 5& O SUBROUTINE LUXJET(ECM,NJET,CUT)  O 2B O C...Purpose: to select number of jets in matrix element approach. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)  O SAVE /LUDAT1/  O DIMENSION ZHUT(5)  O 8A O C...Relative three-jet rate in Zhu second order parametrization. 8 O DATA ZHUT/3.0922, 6.2291, 7.4782, 7.8440, 8.2560/  O 1? O C...Trivial result for two-jets only, including parton shower. 0 O IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN  O CUT=0.  O XA O C...QCD and Abelian vector gluon theory: Q^2 for jet rate and R. 54 O ELSEIF(MSTJ(109).EQ.0.OR.MSTJ(109).EQ.2) THEN  O CF=4./3. ! O IF(MSTJ(109).EQ.2) CF=1. r O IF(MSTJ(111).EQ.0) THEN  O Q2=ECM**2  O Q2R=ECM**2 *$ O ELSEIF(MSTU(111).EQ.0) THEN & O PARJ(169)=MIN(1.,PARJ(129))  O Q2=PARJ(169)*ECM**2 ; O PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/ C, O & ((33.-2.*MSTU(112))*PARU(111)))))  O Q2R=PARJ(168)*ECM**2 O ELSE DA O PARJ(169)=MIN(1.,MAX(PARJ(129),(2.*PARU(112)/ECM)**2)) C O Q2=PARJ(169)*ECM**2 8 O PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM, " O & (2.*PARU(112)/ECM)**2))  O Q2R=PARJ(168)*ECM**2 O  O ENDIF  O .% O C...alpha_strong for R and R itself. (- O ALSPI=(3./4.)*CF*ULALPS(Q2R)/PARU(1) )& O IF(IABS(MSTJ(101)).EQ.1) THEN  O RQCD=1.+ALSPI $ O ELSEIF(MSTJ(109).EQ.0) THEN 9 O RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2 (F O IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.* # O & LOG(PARJ(168))*ALSPI**2) ELSE TB O RQCD=1.+ALSPI-(3./32.+0.519*MSTU(118))*(4.*ALSPI/3.)**2  O ENDIF  O 8 O C...alpha_strong for jet rate. Initial value for y cut. , O ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1) 4 O CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2) H O IF(IABS(MSTJ(101)).LE.1.OR.(MSTJ(109).EQ.0.AND.MSTJ(111).EQ.0)) / O & CUT=MAX(CUT,EXP(-SQRT(0.75/ALSPI))/2.) v7 O IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT))  O N< O C...Parametrization of first order three-jet cross-section. / O 100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25) THEN ) O PARJ(152)=0. . ELSE .< O PARJ(152)=(2.*ALSPI/3.)*((3.-6.*CUT+2.*LOG(CUT))* @ O & LOG(CUT/(1.-2.*CUT))+(2.5+1.5*CUT-6.571)*(1.-3.*CUT)+ 5 O & 5.833*(1.-3.*CUT)**2-3.894*(1.-3.*CUT)**3+ J% O & 1.342*(1.-3.*CUT)**4)/RQCD )E O IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2)) ) O & PARJ(152)=0. O  O ENDIF  O a= O C...Parametrization of second order three-jet cross-section. O H O IF(IABS(MSTJ(101)).LE.1.OR.MSTJ(101).EQ.3.OR.MSTJ(109).EQ.2.OR.  O & CUT.GE.0.25) THEN  O PARJ(153)=0. U$ O ELSEIF(MSTJ(110).LE.1) THEN  O CT=LOG(1./CUT-2.) B O PARJ(153)=ALSPI**2*CT**2*(2.419+0.5989*CT+0.6782*CT**2- + O & 0.2661*CT**3+0.01159*CT**4)/RQCD  O LG O C...Interpolation in second/first order ratio for Zhu parametrization. O $ O ELSEIF(MSTJ(110).EQ.2) THEN  O IZA=0  O DO 110 IY=1,5 0 O IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY  O 110 CONTINUE  O IF(IZA.NE.0) THEN  O ZHURAT=ZHUT(IZA) A O ELSE T O IZ=100.*CUT @ O ZHURAT=ZHUT(IZ)+(100.*CUT-IZ)*(ZHUT(IZ+1)-ZHUT(IZ))  O ENDIF + O PARJ(153)=ALSPI*PARJ(152)*ZHURAT i O ENDIF  O nF O C...Shift in second order three-jet cross-section with optimized Q^2. G O IF(MSTJ(111).EQ.1.AND.IABS(MSTJ(101)).GE.2.AND.MSTJ(101).NE.3. O E O & AND.CUT.LT.0.25) PARJ(153)=PARJ(153)+(33.-2.*MSTU(112))/12.* ,' O & LOG(PARJ(169))*ALSPI*PARJ(152)  O (< O C...Parametrization of second order four-jet cross-section. 6 O IF(IABS(MSTJ(101)).LE.1.OR.CUT.GE.0.125) THEN  O PARJ(154)=0. ELSE 0 O CT=LOG(1./CUT-5.) O IF(CUT.LE.0.018) THEN . O XQQGG=6.349-4.330*CT+0.8304*CT**2 A O IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(3.035-2.091*CT+ X O & 0.4059*CT**2) ; O XQQQQ=1.25*(-0.1080+0.01486*CT+0.009364*CT**2) u. O IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ  O ELSE @ O XQQGG=-0.09773+0.2959*CT-0.2764*CT**2+0.08832*CT**3 E O IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(-0.04079+0.1340*CT- 3( O & 0.1326*CT**2+0.04365*CT**3) F O XQQQQ=1.25*(0.003661-0.004888*CT-0.001081*CT**2+0.002093*  O & CT**3) X. O IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ  O ENDIF 6 O PARJ(154)=ALSPI**2*CT**2*(XQQGG+XQQQQ)/RQCD ( O PARJ(155)=XQQQQ/(XQQGG+XQQQQ)  O ENDIF  O CB O C...If negative three-jet rate, change y' optimization parameter. = O IF(MSTJ(111).EQ.1.AND.PARJ(152)+PARJ(153).LT.0..AND. m O & PARJ(169).LT.0.99) THEN * O PARJ(169)=MIN(1.,1.2*PARJ(169))  O Q2=PARJ(169)*ECM**2 . O ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1)  O GOTO 100 N O ENDIF  O 09 O C...If too high cross-section, use harder cuts, or fail. 4 O IF(PARJ(152)+PARJ(153)+PARJ(154).GE.1) THEN F O IF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499.AND.MSTJ(111).EQ.1.AND. " O & PARJ(169).LT.0.99) THEN , O PARJ(169)=MIN(1.,1.2*PARJ(169)) O Q2=PARJ(169)*ECM**2 0 O ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1)  O GOTO 100 r8 O ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499) THEN  O CALL LUERRM(26, H O & '(LUXJET:) no allowed y cut value for Zhu parametrization')  O ENDIF G O CUT=0.26*(4.*CUT)**(PARJ(152)+PARJ(153)+PARJ(154))**(-1./3.) 19 O IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT)) T O GOTO 100 O  O ENDIF  O o% O C...Scalar gluon (first order only). A O ELSE F% O ALSPI=ULALPS(ECM**2)/PARU(1) SC O CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3./ALSPI))  O PARJ(152)=0. *; O IF(CUT.LT.0.25) PARJ(152)=(ALSPI/3.)*((1.-2.*CUT)* 1 O & LOG((1.-2.*CUT)/CUT)+0.5*(9.*CUT**2-1.)) s O PARJ(153)=0. r O PARJ(154)=0. i O ENDIF  O t O C...Select number of jets.  O PARJ(150)=CUT 0 O IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN  O NJET=2 M" O ELSEIF(MSTJ(101).LE.0) THEN O NJET=MIN(4,2-MSTJ(101)) O ELSE o O RNJ=RLU(0) a O NJET=2 8 O IF(PARJ(152)+PARJ(153)+PARJ(154).GT.RNJ) NJET=3 $ O IF(PARJ(154).GT.RNJ) NJET=4 O ENDIF  O RETURN 1 O END  O O G O C********************************************************************* - O M0 O SUBROUTINE LUX3JT(NJET,CUT,KFL,ECM,X1,X2)  O 2F O C...Purpose: to select the kinematical variables of three-jet events. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)  O SAVE /LUDAT1/  O DIMENSION ZHUP(5,12)  O I6 O C...Coefficients of Zhu second order parametrization. / O DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/ O C O & 18.29, 89.56, 4.541, -52.09, -109.8, 24.90, C O & 11.63, 3.683, 17.50, 0.002440, -1.362, -0.3537, LC O & 11.42, 6.299, -22.55, -8.915, 59.25, -5.855, CC O & -32.85, -1.054, -16.90, 0.006489, -0.8156, 0.01095, *C O & 7.847, -3.964, -35.83, 1.178, 29.39, 0.2806, .C O & 47.82, -12.36, -56.72, 0.04054, -0.4365, 0.6062, SC O & 5.441, -56.89, -50.27, 15.13, 114.3, -18.19, lC O & 97.05, -1.890, -139.9, 0.08153, -0.4984, 0.9439, =C O & -17.65, 51.44, -58.32, 70.95, -255.7, -78.99, C O & 476.9, 29.65, -239.3, 0.4745, -1.174, 6.081/ Q O C O C...Dilogarithm of x for x<0.5 (x>0.5 obtained by analytic trick). )E O DILOG(X)=X+X**2/4.+X**3/9.+X**4/16.+X**5/25.+X**6/36.+X**7/49.  O @ O C...Event type. Mass effect factors and other common constants.  O MSTJ(120)=2  O MSTJ(121)=0  O PMQ=ULMASS(KFL)  O QME=(2.*PMQ/ECM)**2  O IF(MSTJ(109).NE.1) THEN  O CUTL=LOG(CUT)  O CUTD=LOG(1./CUT-2.) O IF(MSTJ(109).EQ.0) THEN  O CF=4./3. * O CN=3.  O TR=2. $ O WTMX=MIN(20.,37.-6.*CUTD) 3 O IF(MSTJ(110).EQ.2) WTMX=2.*(7.5+80.*CUT) 3 ELSE 1 O CF=1.  O CN=0.  O TR=12. M O WTMX=0.  O ENDIF  O E O C...Alpha_strong and effects of optimized Q^2 scale. Maximum weight. E! O ALS2PI=PARU(118)/PARU(2) 1 O WTOPT=0. IG O IF(MSTJ(111).EQ.1) WTOPT=(33.-2.*MSTU(112))/6.*LOG(PARJ(169))* r O & ALS2PI r+ O WTMAX=MAX(0.,1.+WTOPT+ALS2PI*WTMX)  O / O C...Choose three-jet events in allowed region. , O 100 NJET=3 ) O 110 Y13L=CUTL+CUTD*RLU(0)  O Y23L=CUTL+CUTD*RLU(0)  O Y13=EXP(Y13L)  O Y23=EXP(Y23L)  O Y12=1.-Y13-Y23 0 O IF(Y12.LE.CUT) GOTO 110 7 O IF(Y13**2+Y23**2+2.*Y12.LE.2.*RLU(0)) GOTO 110 . O Q O C...Second order corrections. 3 O IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN Q O Y12L=LOG(Y12)  O Y13M=LOG(1.-Y13)  O Y23M=LOG(1.-Y23) * O Y12M=LOG(1.-Y12) O ) O IF(Y13.LE.0.5) Y13I=DILOG(Y13) ? O IF(Y13.GE.0.5) Y13I=1.644934-Y13L*Y13M-DILOG(1.-Y13) O ) O IF(Y23.LE.0.5) Y23I=DILOG(Y23) Q? O IF(Y23.GE.0.5) Y23I=1.644934-Y23L*Y23M-DILOG(1.-Y23) ) O IF(Y12.LE.0.5) Y12I=DILOG(Y12) *? O IF(Y12.GE.0.5) Y12I=1.644934-Y12L*Y12M-DILOG(1.-Y12) c/ O WT1=(Y13**2+Y23**2+2.*Y12)/(Y13*Y23) O : O WT2=CF*(-2.*(CUTL-Y12L)**2-3.*CUTL-1.+3.289868+ & O & 2.*(2.*CUTL-Y12L)*CUT/Y12)+ H O & CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2-11.*CUTL/6.+ B O & 67./18.+1.644934-(2.*CUTL-Y12L)*CUT/Y12+(2.*CUTL-Y13L)* + O & CUT/Y13+(2.*CUTL-Y23L)*CUT/Y23)+ J" O & TR*(2.*CUTL/3.-10./9.)+ G O & CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+ rG O & Y13L*(4.*Y12**2+2.*Y12*Y13+4.*Y12*Y23+Y13*Y23)/(Y12+Y23)**2+ (H O & Y23L*(4.*Y12**2+2.*Y12*Y23+4.*Y12*Y13+Y13*Y23)/(Y12+Y13)**2)/  O & WT1+ S: O & CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+ G O & (CN-2.*CF)*((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L* FD O & Y23M+1.644934-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)* > O & (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934-Y12I-Y13I)/ 9 O & (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))- O B O & 2.*Y12L*Y12**2/(Y13+Y23)**2-4.*Y12L*Y12/(Y13+Y23))/WT1- @ O & CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934-Y13I-Y23I) 4 O IF(1.+WTOPT+ALS2PI*WT2.LE.0.) MSTJ(121)=1 ; O IF(1.+WTOPT+ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110 .= O PARJ(156)=(WTOPT+ALS2PI*WT2)/(1.+WTOPT+ALS2PI*WT2) S O *7 O ELSEIF(MSTJ(101).EQ.2.AND.MSTJ(110).EQ.2) THEN *: O C...Second order corrections; Zhu parametrization of ERT.  O ZX=(Y23-Y13)**2  O ZY=1.-Y12  O IZA=0  O DO 120 IY=1,5 0 O IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY  O 120 CONTINUE ( O IF(IZA.NE.0) THEN  O IZ=IZA AG O WT2=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ X@ O & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ E O & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ */ O & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY T O ELSE ) O IZ=100.*CUT G O WTL=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ =@ O & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ E O & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ / O & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY T O IZ=IZ+1 G O WTU=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ *@ O & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ E O & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ / O & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY 2/ O WT2=WTL+(WTU-WTL)*(100.*CUT+1.-IZ) S O ENDIF 7 O IF(1.+WTOPT+2.*ALS2PI*WT2.LE.0.) MSTJ(121)=1 X> O IF(1.+WTOPT+2.*ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110 C O PARJ(156)=(WTOPT+2.*ALS2PI*WT2)/(1.+WTOPT+2.*ALS2PI*WT2) e O ENDIF  O tE O C...Impose mass cuts (gives two jets). For fixed jet number new try. L O X1=1.-Y23  O X2=1.-Y13  O X3=1.-Y12 / O IF(4.*Y23*Y13*Y12/X3**2.LE.QME) NJET=2 =F O IF(MOD(MSTJ(103),4).GE.2.AND.IABS(MSTJ(101)).LE.1.AND.QME*X3+ ; O & 0.5*QME**2+(0.5*QME+0.25*QME**2)*((1.-X2)/(1.-X1)+ U9 O & (1.-X1)/(1.-X2)).GT.(X1**2+X2**2)*RLU(0)) NJET=2 .3 O IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 100 e O a< O C... O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O nts: string configuration, choose new flavour. 0 O ELSE + O IF(ID.EQ.1) THEN *3 O WTR=RLU(0)*(WTD(1)+WTD(2)+WTD(3)+WTD(4)) O / O IF(WTR.LT.WTD(2)+WTD(3)+WTD(4)) ID=2 *( O IF(WTR.LT.WTD(3)+WTD(4)) ID=3 ! O IF(WTR.LT.WTD(4)) ID=4 I O IF(ID.GE.2) GOTO 130  O ENDIF  O MSTJ(120)=5 B O PARJ(156)=CF*TR*(WTD(1)+WTD(2)+WTD(3)+WTD(4))/(16.*WTTOT)  O 140 KFLN=1+INT(5.*RLU(0)) = O IF(KFLN.NE.KFL.AND.0.2*PARJ(156).LE.RLU(0)) GOTO 140 (@ O IF(KFLN.EQ.KFL.AND.1.-0.8*PARJ(156).LE.RLU(0)) GOTO 140 % O IF(KFLN.GT.MSTJ(104)) NJET=2 . O PMQN=ULMASS(KFLN)  O QMEN=(2.*PMQN/ECM)**2  O * O C...Mass cuts. Kinematical variables out. 5 O IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1*QMEN) NJET=2 S O IF(NJET.EQ.2) GOTO 150 J& O Q24=0.5*(1.-SQRT(1.-QME/Y24)) ' O Q13=0.5*(1.-SQRT(1.-QMEN/Y13)) 2% O X1=1.-(1.-Q24)*Y123-Q24*Y134 3% O X4=1.-(1.-Q24)*Y134-Q24*Y123 % O X2=1.-(1.-Q13)*Y234-Q13*Y124 )G O X12=(1.-Q24)*((1.-Q13)*Y14+Q13*Y34)+Q24*((1.-Q13)*Y12+Q13*Y23)  O X14=Y24-0.5*QME G O X34=(1.-Q24)*((1.-Q13)*Y23+Q13*Y12)+Q24*((1.-Q13)*Y34+Q13*Y14) (2 O IF(PMQ**2+PMQN**2+MIN(X12,X34)*ECM**2.LE. ( O & (PARJ(127)+PMQ+PMQN)**2) NJET=2 9 O IF(Y123*Y134/((1.-X1)*(1.-X4)).LE.RLU(0)) NJET=2 o O ENDIF 1 O 150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100 L O = RETURN P O END  O G O C********************************************************************* A O 15 O SUBROUTINE LUXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI) ( O -8 O C...Purpose: to give the angular orientation of events. 4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) J& O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/  O O < O C...Charge. Factors depending on polarization for QED case.  O QF=KCHG(KFL,1)/3. " O POLL=1.-PARJ(131)*PARJ(132)  O POLD=PARJ(132)-PARJ(131) P0 O IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN  O HF1=POLL  O HF2=0. * O HF3=PARJ(133)**2 * O HF4=0. * O *H O C...Factors depending on flavour, energy and polarization for QFD case. O ELSE e. O SFF=1./(16.*PARU(102)*(1.-PARU(102))) G O SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) ( O SFI=SFW*(1.-(PARJ(123)/ECM)**2)  O AE=-1. i O VE=4.*PARU(102)-1. r O AF=SIGN(1.,QF) A O VF=AF-4.*QF*PARU(102) ; O HF1=QF**2*POLL-2.*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+ .D O & (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2.*VE*AE*POLD) E O HF2=-2.*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2.*VF*AF*SFW*SFF**2* ,+ O & (2.*VE*AE*POLL-(VE**2+AE**2)*POLD) 6C O HF3=PARJ(133)**2*(QF**2-2.*QF*VF*SFI*SFF*VE+(VF**2+AF**2)* 5" O & SFW*SFF**2*(VE**2-AE**2)) E O HF4=-PARJ(133)**2*2.*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)* O  O & SFF*AE O ENDIF  O ,A O C...Mass factor. Differential cross-sections for two-jet events. . O SQ2=SQRT(2.) , QME=0. I O IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND. 2 O &MSTJ(109).NE.1) QME=(2.*ULMASS(KFL)/ECM)**2  O IF(NJET.EQ.2) THEN h O SIGU=4.*SQRT(1.-QME) d! O SIGL=2.*QME*SQRT(1.-QME) ( O SIGT=0.  O SIGI=0.  O SIGA=0.  O SIGP=4.  O yC O C...Kinematical variables. Reduce four-jet event to three-jet one. = O ELSE J O IF(NJET.EQ.3) THEN L O X1=2.*P(NC+1,4)/ECM  O X2=2.*P(NC+3,4)/ECM ELSE GB O ECMR=P(NC+1,4)+P(NC+4,4)+SQRT((P(NC+2,1)+P(NC+3,1))**2+ = O & (P(NC+2,2)+P(NC+3,2))**2+(P(NC+2,3)+P(NC+3,3))**2)  O X1=2.*P(NC+1,4)/ECMR  O X2=2.*P(NC+4,4)/ECMR M O ENDIF  O 3E O C...Differential cross-sections for three-jet (or reduced four-jet). M O XQ=(1.-X1)/(1.-X2) F O CT12=(X1*X2-2.*X1-2.*X2+2.+QME)/SQRT((X1**2-QME)*(X2**2-QME))  O ST12=SQRT(1.-CT12**2) O IF(MSTJ(109).NE.1) THEN C O SIGU=2.*X1**2+X2**2*(1.+CT12**2)-QME*(3.+CT12**2-X1-X2)- ); O & QME*X1/XQ+0.5*QME*((X2**2-QME)*ST12**2-2.*X2)*XQ WD O SIGL=(X2*ST12)**2-QME*(3.-CT12**2-2.5*(X1+X2)+X1*X2+QME)+ H O & 0.5*QME*(X1**2-X1-QME)/XQ+0.5*QME*((X2**2-QME)*CT12**2-X2)*XQ > O SIGT=0.5*(X2**2-QME-0.5*QME*(X2**2-QME)/XQ)*ST12**2 E O SIGI=((1.-0.5*QME*XQ)*(X2**2-QME)*ST12*CT12+QME*(1.-X1-X2+ *, O & 0.5*X1*X2+0.5*QME)*ST12/CT12)/SQ2  O SIGA=X2**2*ST12/SQ2 % O SIGP=2.*(X1**2-X2**2*CT12) Q O A O C...Differential cross-sect for scalar gluons (no mass effects). M ELSE O  O X3=2.-X1-X2  O XT=X2*ST12 L+ O CT13=SQRT(MAX(0.,1.-(XT/X3)**2)) .1 O SIGU=(1.-PARJ(171))*(X3**2-0.5*XT**2)+ ? O & PARJ(171)*(X3**2-0.5*XT**2-4.*(1.-X1)*(1.-X2)**2/X1) 3) O SIGL=(1.-PARJ(171))*0.5*XT**2+ ) O & PARJ(171)*0.5*(1.-X1)**2*XT**2 * O SIGT=(1.-PARJ(171))*0.25*XT**2+ * O & PARJ(171)*0.25*XT**2*(1.-2.*X1) 6 O SIGI=-(0.5/SQ2)*((1.-PARJ(171))*XT*X3*CT13+ 8 O & PARJ(171)*XT*((1.-2.*X1)*X3*CT13-X1*(X1-X2))) 0 O SIGA=(0.25/SQ2)*XT*(2.*(1.-X1)-X1*X3) + O SIGP=X3**2-2.*(1.-X1)*(1.-X2)/X1 / O ENDIF O ENDIF  O 11 O C...Upper bounds for differential cross-section. ) O HF1A=ABS(HF1)  O HF2A=ABS(HF2)  O HF3A=ABS(HF3)  O HF4A=ABS(HF4) @ O SIGMAX=(2.*HF1A+HF3A+HF4A)*ABS(SIGU)+2.*(HF1A+HF3A+HF4A)* < O &ABS(SIGL)+2.*(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGT)+2.*SQ2* > O &(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGI)+4.*SQ2*HF2A*ABS(SIGA)+  O &2.*HF2A*ABS(SIGP)  O YG O C...Generate angular orientation according to differential cross-sect. 2 O 100 CHI=PARU(2)*RLU(0) 1 O CTHE=2.*RLU(0)-1.  O PHI=PARU(2)*RLU(0) 2 O CCHI=COS(CHI)  O SCHI=SIN(CHI)  O C2CHI=COS(2.*CHI)  O S2CHI=SIN(2.*CHI)  O THE=ACOS(CTHE) + O STHE=SIN(THE) $ O C2PHI=COS(2.*(PHI-PARJ(134))) $ O S2PHI=SIN(2.*(PHI-PARJ(134))) A O SIG=((1.+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+ O ; O &2.*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+ E O &2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*C2CHI*C2PHI-2.*CTHE*S2CHI* 6F O &S2PHI)*HF3-((1.+CTHE**2)*C2CHI*S2PHI+2.*CTHE*S2CHI*C2PHI)*HF4)* C O &SIGT-2.*SQ2*(2.*STHE*CTHE*CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI- F O &SCHI*S2PHI)*HF3+2.*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+ 1 O &4.*SQ2*STHE*CCHI*HF2*SIGA+2.*CTHE*HF2*SIGP ( O IF(SIG.LT.SIGMAX*RLU(0)) GOTO 100  O O RETURN N O END  O G O C********************************************************************* ( O 2! O SUBROUTINE LUONIA(KFL,ECM) X O @ O C...Purpose: to generate Upsilon and toponium decays into three ' O C...gluons or two gluons and a photon. 34 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) U& O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/  O Z& O C...Printout. Check input parameters. ' O IF(MSTU(12).GE.1) CALL LULIST(0) U$ O IF(KFL.LT.0.OR.KFL.GT.8) THEN E O CALL LUERRM(16,'(LUONIA:) called with unknown flavour code') T! O IF(MSTU(21).GE.1) RETURN 3 O ENDIF / O IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN 6D O CALL LUERRM(16,'(LUONIA:) called with too small CM energy') ! O IF(MSTU(21).GE.1) RETURN O ENDIF  O 1- O C...Initial e+e- and onium state (optional). U O NC=0 U O IF(MSTJ(115).GE.2) THEN  O NC=NC+2 + O CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)  O K(NC-1,1)=21 */ O CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.) 6 O K(NC,1)=21 2 O ENDIF  O KFLC=IABS(KFL) , O IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN  O NC=NC+1  O KF=110*KFLC+3  O MSTU10=MSTU(10)  O MSTU(10)=1 1 O P(NC,5)=ECM % O CALL LU1ENT(NC,KF,ECM,0.,0.)  O K(NC,1)=21 4 O K(NC,3)=1  O MSTU(10)=MSTU10 O ENDIF  O 22 O C...Choose x1 and x2 according to matrix element. NTRY=0 ) O 100 X1=RLU(0)  O X2=RLU(0)  O X3=2.-X1-X2 @ O IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+ 2 O &((1.-X3)/(X1*X2))**2.LE.2.*RLU(0)) GOTO 100  O NTRY=NTRY+1 NJET=3 T> O IF(MSTJ(101).LE.4) CALL LU3ENT(NC+1,21,21,21,ECM,X1,X3) A O IF(MSTJ(101).GE.5) CALL LU3ENT(-(NC+1),21,21,21,ECM,X1,X3) T O XG O C...Photon-gluon-gluon events. Small system modifications. Jet origin.  O MSTU(111)=MSTJ(108) @ O IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))  O &MSTU(111)=1  O PARU(112)=PARJ(121) - O IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) 3 O QF=0. ' O IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3. 0. O RGAM=7.2*QF**2*PARU(101)/ULALPS(ECM**2) O MK=0 E O ECMC=ECM ( O IF(RLU(0).GT.RGAM/(1.+RGAM)) THEN B O IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125)))  O & NJET=2 LE O IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LU2ENT(NC+1,21,21,ECM) lH O IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LU2ENT(-(NC+1),21,21,ECM) O ELSE O MK=1 A O ECMC=SQRT(1.-X1)*ECM B* O IF(ECMC.LT.2.*PARJ(127)) GOTO 100  O K(NC+1,1)=1  O K(NC+1,2)=22 g O K(NC+1,4)=0  O K(NC+1,5)=0 4 O IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3) 4 O IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3) 4 O IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2) 4 O IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2)  O NJET=2 r& O IF(ECMC.LT.4.*PARJ(127)) THEN  O MSTU10=MSTU(10)  O MSTU(10)=1 ) O P(NC+2,5)=ECMC ): O CALL LU1ENT(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.)  O MSTU(10)=MSTU10  O NJET=0 / O ENDIF O ENDIF  O DO 110 IP=NC+1,N O B O K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1)  O 110 CONTINUE y O .@ O C...Differential cross-sections. Upper limit for cross-section.  O IF(MSTJ(106).EQ.1) THEN  O SQ2=SQRT(2.) (# O HF1=1.-PARJ(131)*PARJ(132) U O HF3=PARJ(133)**2 , O CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3)  O ST13=SQRT(1.-CT13**2) 7 O SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2 B O SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL  O SIGT=0.5*SIGL < O SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2 F O SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+ 8 O & 2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI)  O O" O C...Angular orientation of event.  O 120 CHI=PARU(2)*RLU(0) . O CTHE=2.*RLU(0)-1.  O PHI=PARU(2)*RLU(0)  O CCHI=COS(CHI)  O SCHI=SIN(CHI)  O C2CHI=COS(2.*CHI)  O S2CHI=SIN(2.*CHI)  O THE=ACOS(CTHE) 2 O STHE=SIN(THE) & O C2PHI=COS(2.*(PHI-PARJ(134))) & O S2PHI=SIN(2.*(PHI-PARJ(134))) G O SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1- .E O & STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)* 1I O & C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE* 3@ O & CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI * O IF(SIG.LT.SIGMAX*RLU(0)) GOTO 120 / O CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0) 40 O CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0) O ENDIF  O 1? O C...Generate parton shower. Rearrange along strings and check. *, O IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN ( O CALL LUSHOW(NC+MK+1,-NJET,ECMC)  O MSTJ14=MSTJ(14) ( O IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 & O IF(MSTJ(105).GE.0) MSTU(28)=0  O CALL LUPREP(0) A O MSTJ(14)=MSTJ14 6 O IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 O ENDIF  O *4 O C...Generate fragmentation. Information for LUTABU: % O IF(MSTJ(105).EQ.1) CALL LUEXEC 2 O MSTU(161)=110*KFLC+3 O  O MSTU(162)=0  O Y RETURN 1 O END  O 2G O C********************************************************************* Y O 2 O SUBROUTINE LUHEPC(MCONV) Y O Y@ O C...Purpose: to convert JETSET event record contents to or from + O C...the standard event record commonblock. *H O C...Note that HEPEVT is in double precision according to LEP 2 standard. O PARAMETER (NMXHEP=2000) > O COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), F O &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) O DOUBLE PRECISION PHEP,VHEP4 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) Y O SAVE /HEPEVT/ & O SAVE /LUJETS/,/LUDAT1/,/LUDAT2/  O *7 O C...Conversion from JETSET to standard, the easy part. 2 O IF(MCONV.EQ.1) THEN  O NEVHEP=0 &' O IF(N.GT.NMXHEP) CALL LUERRM(8, */ O & '(LUHEPC:) no more space in /HEPEVT/') * O NHEP=MIN(N,NMXHEP) - O DO 140 I=1,NHEP  O ISTHEP(I)=0 5 O IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1 36 O IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2 6 O IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3 < O IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)  O IDHEP(I)=K(I,2)  O JMOHEP(1,I)=K(I,3)  O JMOHEP(2,I)=0 ? O IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN * O JDAHEP(1,I)=K(I,4) Y O JDAHEP(2,I)=K(I,5) ELSE 3 O JDAHEP(1,I)=0  O JDAHEP(2,I)=0  O ENDIF  O DO 100 J=1,5 Y O PHEP(J,I)=P(I,J)  O 100 CONTINUE * O DO 110 J=1,4 1 O VHEP(J,I)=V(I,J) O  O 110 CONTINUE + O Y& O C...Check if new event (from pileup).  O IF(I.EQ.1) THEN  O INEW=1 2 ELSE 15 O IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I 1 O ENDIF  O 4( O C...Fill in missing mother information. > O IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN  O IMO1=I-2 1? O IF(I.GE.INEW+3.AND.K(I-1,1).EQ.21.AND.K(I-1,3).EQ.0) ( O & IMO1=IMO1-1  O JMOHEP(1,I)=IMO1 * O JMOHEP(2,I)=IMO1+1 *3 O ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN ) O I1=K(I,3)-1  O 120 I1=I1+1 % O IF(I1.GE.I) CALL LUERRM(8, 2A O & '(LUHEPC:) translation of inconsistent event history') 1B O IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120  O KC=LUCOMP(K(I1,2)) &+ O IF(I1.LT.I.AND.KC.EQ.0) GOTO 120 13 O IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120 5 O JMOHEP(2,I)=I1 N" O ELSEIF(K(I,2).EQ.94) THEN  O NJET=2 .3 O IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3 O3 O IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4 7 O JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5)) 6 O IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)= ( O & MOD(K(I+1,4)/MSTU(5),MSTU(5))  O ENDIF  O C* O C...Fill in missing daughter information. 0 O IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN , O DO 130 I1=JDAHEP(1,I),JDAHEP(2,I) * O I2=MOD(K(I1,4)/MSTU(5),MSTU(5))  O JDAHEP(1,I2)=I O  O 130 CONTINUE F O ENDIF 3 O IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140  O I1=JMOHEP(1,I) .+ O IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140 5 O IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140 E# O IF(JDAHEP(1,I1).EQ.0) THEN J O JDAHEP(1,I1)=I ) ELSE + O JDAHEP(2,I1)=I ( O ENDIF  O 140 CONTINUE  O DO 150 I=1,NHEP 3 O IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150 5 O IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I) O  O 150 CONTINUE 2 O O7 O C...Conversion from standard to JETSET, the easy part. O ELSE A+ O IF(NHEP.GT.MSTU(4)) CALL LUERRM(8, */ O & '(LUHEPC:) no more space in /LUJETS/') T O N=MIN(NHEP,MSTU(4))  O NKQ=0  O KQSUM=0  O DO 180 I=1,N  O K(I,1)=0 O $ O IF(ISTHEP(I).EQ.1) K(I,1)=1 % O IF(ISTHEP(I).EQ.2) K(I,1)=11 % O IF(ISTHEP(I).EQ.3) K(I,1)=21  O K(I,2)=IDHEP(I)  O K(I,3)=JMOHEP(1,I)  O K(I,4)=JDAHEP(1,I) N O K(I,5)=JDAHEP(2,I)  O DO 160 J=1,5 = O P(I,J)=PHEP(J,I) O  O 160 CONTINUE 1 O DO 170 J=1,4  O V(I,J)=VHEP(J,I) * O 170 CONTINUE 1 O V(I,5)=0. ; O IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN F O I1=JDAHEP(1,I) )D O IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*  O & PHEP(5,I)/PHEP(4,I)  O ENDIF  O .E O C...Fill in missing information on colour connection in jet systems. O IF(ISTHEP(I).EQ.1) THEN  O KC=LUCOMP(K(I,2))  O KQ=0 I4 O IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) O IF(KQ.NE.0) NKQ=NKQ+1 % O IF(KQ.NE.2) KQSUM=KQSUM+KQ 1* O IF(KQ.NE.0.AND.KQSUM.NE.0) THEN  O K(I,1)=2 1* O ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN ( O IF(K(I+1,2).EQ.21) K(I,1)=2  O ENDIF  O ENDIF  O 180 CONTINUE T2 O IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LUERRM(8, C O & '(LUHEPC:) input parton configuration not colour singlet') c O ENDIF  O v O END  O O G O C********************************************************************* Q O  O SUBROUTINE LUTEST(MTEST) Q O 1F O C...Purpose: to provide a simple program (disguised as subroutine) to G O C...run at installation as a check that the program works as intended. 24 O COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)  O SAVE /LUJETS/,/LUDAT1/ 2( O DIMENSION PSUM(5),PINI(6),PFIN(6)  O 1& O C...Loop over events to be generated. % O IF(MTEST.GE.1) CALL LUTABU(20) ) NERR=0 N O DO 180 IEV=1,600 1 O (A O C...Reset parameter values. Switch on some nonstandard features. 0 O MSTJ(1)=1  O MSTJ(3)=0  O MSTJ(11)=1 O  O MSTJ(42)=2 * O MSTJ(43)=4 * O MSTJ(44)=2 * O PARJ(17)=0.1 * O PARJ(22)=1.5 R O PARJ(43)=1.  O PARJ(54)=-0.05 ( O MSTJ(101)=5  O MSTJ(104)=5  O MSTJ(105)=0  O MSTJ(107)=1 = O IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3 2 O ,9 O C...Ten events each for some single jets configurations. 0 O IF(IEV.LE.50) THEN V O ITY=(IEV+9)/10 U O MSTJ(3)=-1 2, O IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2 0 O IF(ITY.EQ.1) CALL LU1ENT(1,1,15.,0.,0.) 3 O IF(ITY.EQ.2) CALL LU1ENT(1,3101,15.,0.,0.) 34 O IF(ITY.EQ.3) CALL LU1ENT(1,-2203,15.,0.,0.) 1 O IF(ITY.EQ.4) CALL LU1ENT(1,-4,30.,0.,0.) 1 O IF(ITY.EQ.5) CALL LU1ENT(1,21,15.,0.,0.) . O tG O C...Ten events each for some simple jet systems; string fragmentation. L O ELSEIF(IEV.LE.130) THEN  O ITY=(IEV-41)/10 - O IF(ITY.EQ.1) CALL LU2ENT(1,1,-1,40.) 1- O IF(ITY.EQ.2) CALL LU2ENT(1,4,-4,30.) (0 O IF(ITY.EQ.3) CALL LU2ENT(1,2,2103,100.) . O IF(ITY.EQ.4) CALL LU2ENT(1,21,21,40.) > O IF(ITY.EQ.5) CALL LU3ENT(1,2101,21,-3203,30.,0.6,0.8) 8 O IF(ITY.EQ.6) CALL LU3ENT(1,5,21,-5,40.,0.9,0.8) 9 O IF(ITY.EQ.7) CALL LU3ENT(1,21,21,21,60.,0.7,0.5) *I O IF(ITY.EQ.8) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2) + O *E O C...Seventy events with independent fragmentation and momentum cons. A O ELSEIF(IEV.LE.200) THEN  O ITY=1+(IEV-131)/16 R! O MSTJ(2)=1+MOD(IEV-131,4) A% O MSTJ(3)=1+MOD((IEV-131)/4,4) - O IF(ITY.EQ.1) CALL LU2ENT(1,4,-5,40.) r8 O IF(ITY.EQ.2) CALL LU3ENT(1,3,21,-3,40.,0.9,0.4) I O IF(ITY.EQ.3) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2) 0H O IF(ITY.GE.4) CALL LU4ENT(1,2,-3,3,-2,40.,0.4,0.64,0.6,0.12,0.2)  O N> O C...A hundred events with random jets (check invariant mass).  O ELSEIF(IEV.LE.300) THEN  O 100 DO 110 J=1,5  O PSUM(J)=0.  O 110 CONTINUE O  O NJET=2.+6.*RLU(0)  O DO 130 I=1,NJET  O KFL=21 ) O IF(I.EQ.1) KFL=INT(1.+4.*RLU(0)) - O IF(I.EQ.NJET) KFL=-INT(1.+4.*RLU(0)) ( O EJET=5.+20.*RLU(0) O ! O THETA=ACOS(2.*RLU(0)-1.) S O PHI=6.2832*RLU(0) 9 O IF(I.LT.NJET) CALL LU1ENT(-I,KFL,EJET,THETA,PHI) )8 O IF(I.EQ.NJET) CALL LU1ENT(I,KFL,EJET,THETA,PHI) + O IF(I.EQ.1.OR.I.EQ.NJET) MSTJ(93)=1 f< O IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+ULMASS(KFL)  O DO 120 J=1,4 . O PSUM(J)=PSUM(J)+P(I,J) - O 120 CONTINUE ( O 130 CONTINUE M; O IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT. .( O & (PSUM(5)+PARJ(32))**2) GOTO 100  O T6 O C...Fifty e+e- continuum events with matrix elements.  O ELSEIF(IEV.LE.350) THEN  O MSTJ(101)=2  O CALL LUEEVT(0,40.) - O *< O C...Fifty e+e- continuum event with varying shower options.  O ELSEIF(IEV.LE.400) THEN  O MSTJ(42)=1+MOD(IEV,2) O MSTJ(43)=1+MOD(IEV/2,4)  O MSTJ(44)=MOD(IEV/8,3)  O CALL LUEEVT(0,90.) - O XE O C...Fifty e+e- continuum events with coherent shower, including top. 2 O ELSEIF(IEV.LE.450) THEN  O MSTJ(104)=6  O CALL LUEEVT(0,500.)  O A O C...Fifty Upsilon decays to ggg or gammagg with coherent shower. - O ELSEIF(IEV.LE.500) THEN  O CALL LUONIA(5,9.46)  O /* O C...One decay each for some heavy mesons.  O ELSEIF(IEV.LE.560) THEN  O ITY=IEV-501  O KFLS=2*(ITY/20)+1  O KFLB=8-MOD(ITY/5,4)  O KFLC=KFLB-MOD(ITY,5) J6 O CALL LU1ENT(1,100*KFLB+10*KFLC+KFLS,0.,0.,0.)  O *+ O C...One decay each for some heavy baryons. ( O ELSEIF(IEV.LE.600) THEN  O ITY=IEV-561  O KFLS=2*(ITY/20)+2  O KFLA=8-MOD(ITY/5,4)  O KFLB=KFLA-MOD(ITY,5) . O KFLC=MAX(1,KFLB-1) @ O CALL LU1ENT(1,1000*KFLA+100*KFLB+10*KFLC+KFLS,0.,0.,0.) O ENDIF  O .< O C...Generate event. Find total momentum, energy and charge.  O DO 140 J=1,4 A O PINI(J)=PLU(0,J) H O 140 CONTINUE A O PINI(6)=PLU(0,6) . O CALL LUEXEC  O DO 150 J=1,4 H O PFIN(J)=PLU(0,J) . O 150 CONTINUE * O PFIN(6)=PLU(0,6) O  O 7 O C...Check conservation of energy, momentum and charge; 9 O C...usually exact, but only approximate for single jets. a MERR=0 t O IF(IEV.LE.50) THEN 2H O IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.4.) MERR=MERR+1 / O EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3) I> O IF(EPZREM.LT.0..OR.EPZREM.GT.2.*PARJ(31)) MERR=MERR+1 4 O IF(ABS(PFIN(6)-PINI(6)).GT.2.1) MERR=MERR+1 O ELSE 1 O DO 160 J=1,4 (? O IF(ABS(PFIN(J)-PINI(J)).GT.0.0001*PINI(4)) MERR=MERR+1 H O 160 CONTINUE +4 O IF(ABS(PFIN(6)-PINI(6)).GT.0.1) MERR=MERR+1 O ENDIF B O IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6),  O &(PFIN(J),J=1,4),PFIN(6)  O CG O C...Check that all KF codes are known ones, and that partons/particles IF O C...satisfy energy-momentum-mass relation. Store particle statistics.  O DO 170 I=1,N H O IF(K(I,1).GT.20) GOTO 170 # O IF(LUCOMP(K(I,2)).EQ.0) THEN F O WRITE(MSTU(11),5100) I O  O MERR=MERR+1 O ENDIF ; O PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 *C O IF(ABS(PD).GT.MAX(0.1,0.001*P(I,4)**2).OR.P(I,4).LT.0.) THEN t O WRITE(MSTU(11),5200) I e O MERR=MERR+1 O ENDIF  O 170 CONTINUE o% O IF(MTEST.GE.1) CALL LUTABU(21) ( O 04 O C...List all erroneous events and some normal ones. ; O IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN 5 O CALL LULIST(2) )6 O ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN  O CALL LULIST(1) e O ENDIF  O T' O C...Stop execution if too many errors. L O IF(MERR.NE.0) NERR=NERR+1  O IF(NERR.GE.10) THEN ! O WRITE(MSTU(11),5300) IEV O STOP ( O ENDIF  O 180 CONTINUE  O  O C...Summarize result of run. R% O IF(MTEST.GE.1) CALL LUTABU(22) ') O IF(NERR.EQ.0) WRITE(MSTU(11),5400) . O IF(NERR.GT.0) WRITE(MSTU(11),5500) NERR  O O 4 O C...Reset commonblock variables changed during run.  O MSTJ(2)=3  O PARJ(17)=0.  O PARJ(22)=1.  O PARJ(43)=0.5 N O PARJ(54)=0.  O MSTJ(105)=1  O MSTJ(107)=0  O L" O C...Format statements for output. E O 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ', MD O &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X, D O &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X,  O &4(1X,F12.5),1X,F8.2) CF O 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code') C O 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ', r O &'kinematics') 8 O 5300 FORMAT(/5X,'Ten errors experienced by event ',I3/ A O &5X,'Something is seriously wrong! Execution stopped now!') 2? O 5400 FORMAT(//5X,'End result of LUTEST: no errors detected.') YB O 5500 FORMAT(//5X,'End result of LUTEST:',I2,' errors detected.'/ + O &5X,'This should not have happened!') ) O L RETURN ) O END  O 1G O C********************************************************************* t O i O BLOCK DATA LUDATA  O 1C O C...Purpose: to give default values to parameters and particle and  O C...decay data. < O COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) A O COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) /E O COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)  O COMMON/LUDAT4/CHAF(500)  O CHARACTER CHAF*8 & O COMMON/LUDATR/MRLU(6),RRLU(100) 8 O SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/  O Q9 O C...LUDAT1, containing status codes and most parameters.  O DATA MSTU/ MC O & 0, 0, 0, 4000,10000, 500, 2000, 0, 0, 2, C O 1 6, 1, 1, 0, 1, 1, 0, 0, 0, 0, 7C O 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0, (C O 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, )C O 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0, C O 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0, TC O 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, E O 7 30*0, C O & 1, 0, 0, 0, 0, 0, 0, 0, 0, C O 1 1, 5, 3, 5, 0, 0, 0, 0, 0, 0, A O 2 60*0, C O 8 7, 409, 1996, 03, 21, 700, 0, 0, 0, 0, IC O 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ L O DATA PARU/ (C O & 3.1415927, 6.2831854, 0.1973, 5.068, 0.3894, 2.568, 4*0., lC O 1 0.001, 0.09, 0.01, 0., 0., 0., 0., 0., 0., 0., =C O 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 3C O 3 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., RC O 4 2.0, 1.0, 0.25, 2.5, 0.05, 0., 0., 0.0001, 0., 0., 2C O 5 2.5, 1.5, 7.0, 1.0, 0.5, 2.0, 3.2, 0., 0., 0.,  O 6 40*0., 5A O & 0.00729735, 0.232, 0.007764, 1.0, 1.16639E-5, 0., 0., 0.,  O & 0., 0., HC O 1 0.20, 0.25, 1.0, 4.0, 10., 0., 0., 0., 0., 0., BC O 2 -0.693, -1.0, 0.387, 1.0, -0.08, -1.0, 1.0, 1.0, 1.0, 0., fC O 3 1.0, -1.0, 1.0, -1.0, 1.0, 0., 0., 0., 0., 0., C O 4 5.0, 1.0, 1.0, 0., 1.0, 1.0, 0., 0., 0., 0., CC O 5 1.0, 0., 0., 0., 1000., 1.0, 1.0, 1.0, 1.0, 0., C O 6 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., 0., 0., AC O 7 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., CC O 8 1.0, 1.0, 1.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0., *C O 9 0., 0., 0., 0., 1.0, 0., 0., 0., 0., 0./ H O DATA MSTJ/ HC O & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, (C O 1 4, 2, 0, 1, 0, 0, 0, 0, 0, 0, 0C O 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0, C O 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, eC O 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 3, TC O 5 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, C O 6 40*0, C O & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2, MC O 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, ) O 2 80*0/  O DATA PARJ/ .C O & 0.10, 0.30, 0.40, 0.05, 0.50, 0.50, 0.50, 0., 0., 0., aC O 1 0.50, 0.60, 0.75, 0., 0., 0., 0., 1.0, 1.0, 0., 2C O 2 0.36, 1.0, 0.01, 2.0, 1.0, 0.4, 0., 0., 0., 0., 1C O 3 0.10, 1.0, 0.8, 1.5, 0., 2.0, 0.2, 2.5, 0.6, 0., *C O 4 0.3, 0.58, 0.5, 0.9, 0.5, 1.0, 1.0, 1.0, 0., 0., uF O 5 0.77,0.77,0.77,-0.05,-0.005,-0.00001,-0.00001,-0.00001,1.0,0., C O 6 4.5, 0.7, 0., 0.003, 0.5, 0.5, 0., 0., 0., 0., rC O 7 10., 1000., 100., 1000., 0., 0.7, 10., 0., 0., 0., O C O 8 0.29, 1.0, 1.0, 0., 10., 10., 0., 0., 0., 0., &C O 9 0.02, 1.0, 0.2, 0., 0., 0., 0., 0., 0., 0., C O & 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 5C O 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 2C O 2 1.0, 0.25,91.187,2.489, 0.01, 2.0, 1.0, 0.25,0.002, 0., )C O 3 0., 0., 0., 0., 0.01, 0.99, 0., 0., 0.2, 0., O  O 4 60*0./ o O EA O C...LUDAT2, with particle data and flavour treatment parameters. F O DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, H O &-3,0,-3,6*0,3,9*0,3,2*0,3,0,-1,44*0,2,-1,2,-1,2,3,11*0,3,0,2*3,0, H O &3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0, G O &3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0, =H O &3,0,3,70*0,3,0,3,28*0,3,2*0,3,8*0,-3,8*0,3,0,-3,0,3,-3,3*0,3,6,0, F O &3,5*0,-3,0,3,-3,0,-3,4*0,-3,0,3,6,-3,0,3,-3,0,-3,0,3,6,0,3,5*0,  O &-3,0,3,-3,0,-3,114*0/ F O DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,16*0,2,1,50*0,-1,410*0/ H O DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,0,2*1, F O &41*0,1,0,7*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1, G O &10*0,10*1,70*0,3*1,22*0,1,5*0,1,0,2*1,6*0,1,0,2*1,6*0,2*1,0,5*1, O , O &0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/ E O DATA (PMAS(I,1),I= 1, 500)/0.0099,0.0056,0.199,1.35,5.,160., tH O &2*250.,2*0.,0.00051,0.,0.1057,0.,1.777,0.,250.,5*0.,91.187,80.25, C O &80.,6*0.,500.,900.,500.,3*300.,350.,200.,5000.,60*0.,0.1396, F O &0.4977,0.4936,1.8693,1.8645,1.9688,5.2787,5.2786,5.47972,6.594, E O &0.135,0.5475,0.9578,2.9788,9.4,320.,2*500.,2*0.,0.7669,0.8961, C O &0.8916,2.0101,2.0071,2.11,2*5.325,5.5068,6.602,0.7683,0.782, H O &1.0194,3.0969,9.4603,320.,2*500.,2*0.,1.232,2*1.29,2*2.424,2.536, H O &2*5.73,5.97,7.3,1.232,1.17,1.4,3.46,9.875,320.,2*500.,2*0.,0.983, H O &2*1.429,2*2.272,2.5,2*5.68,5.92,7.25,0.9827,1.,1.4,3.4151,9.8598, G O &320.,2*500.,2*0.,1.26,2*1.402,2*2.372,2.56,2*5.78,6.02,7.3,1.26, FC O &1.282,1.42,3.5106,9.8919,320.,2*500.,2*0.,1.318,1.432,1.425, LD O &2*2.46,2.61,2*5.83,6.07,7.35,1.318,1.275,1.525,3.5562,9.9132, F O &320.,2*500.,2*0.,2*0.4977,8*0.,3.686,3*0.,10.0233,70*0.,1.1156, C O &5*0.,2.2849,0.,2.473,2.466,6*0.,5.641,0.,2*5.84,6*0.,0.9396, E O &0.9383,0.,1.1974,1.1926,1.1894,1.3213,1.3149,0.,2.4525,2.4529, DH O &2.4527,2*2.55,2.73,4*0.,3*5.8,2*5.96,6.12,4*0.,1.234,1.233,1.232, G O &1.231,1.3872,1.3837,1.3828,1.535,1.5318,1.6724,3*2.5,2*2.63,2.8, & O &4*0.,3*5.81,2*5.97,6.13,114*0./ C O DATA (PMAS(I,2),I= 1, 500)/22*0.,2.489,2.066,88*0.,0.0002, KE O &0.001,6*0.,0.149,0.0505,0.0498,7*0.,0.151,0.00843,0.0044,7*0., DG O &0.155,2*0.09,2*0.02,0.,4*0.05,0.155,0.36,0.08,2*0.01,5*0.,0.057, 1F O &2*0.287,7*0.05,0.057,0.,0.25,0.014,6*0.,0.4,2*0.174,7*0.05,0.4, C O &0.024,0.06,0.0009,6*0.,0.11,0.109,0.098,2*0.019,5*0.02,0.11, .B O &0.185,0.076,0.002,146*0.,4*0.12,0.0394,0.036,0.0358,0.0099,  O &0.0091,131*0./ G O DATA (PMAS(I,3),I= 1, 500)/22*0.,2*20.,88*0.,0.002,0.005,6*0., EC O &0.4,2*0.2,7*0.,0.4,0.1,0.015,7*0.,0.25,0.005,0.01,2*0.08,0., H O &4*0.1,0.25,0.2,0.001,2*0.02,5*0.,0.05,2*0.4,6*0.1,2*0.05,0.,0.35, F O &0.05,6*0.,3*0.3,2*0.1,0.03,4*0.1,0.3,0.05,0.02,0.001,6*0.,0.25, C O &4*0.12,5*0.05,0.25,0.17,0.2,0.01,146*0.,4*0.14,0.04,2*0.035, O  O &2*0.05,131*0./ FF O DATA (PMAS(I,4),I= 1, 500)/12*0.,658650.,0.,0.0914,68*0.,0.1, H O &0.387,15*0.,7804.,0.,3709.,0.32,0.1259,0.135,3*0.387,0.15,110*0., G O &15500.,26.75,83*0.,78.88,5*0.,0.057,0.,0.025,0.09,6*0.,0.387,0., )G O &2*0.387,9*0.,44.3,0.,23.95,49.1,86.9,6*0.,0.13,9*0.,0.387,13*0., E O &24.60001,130*0./  O DATA PARF/ C O & 0.5, 0.25, 0.5, 0.25, 1., 0.5, 0., 0., 0., 0., ,C O 1 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., O C O 2 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., *C O 3 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., NC O 4 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., C O 5 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., C O 6 0.75, 0.5, 0., 0.1667, 0.0833, 0.1667, 0., 0., 0., 0., mC O 7 0., 0., 1., 0.3333, 0.6667, 0.3333, 0., 0., 0., 0., .C O 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., FC O 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., KC O & 0.325, 0.325, 0.5, 1.6, 5.0, 0., 0., 0., 0., 0., DC O 1 0., 0.11, 0.16, 0.048, 0.50, 0.45, 0.55, 0.60, 0., 0., AC O 2 0.2, 0.1, 0., 0., 0., 0., 0., 0., 0., 0.,  O 3 1870*0./ I& O DATA ((VCKM(I,J),J=1,4),I=1,4)/ / O 1 0.95113, 0.04884, 0.00003, 0.00000, E/ O 2 0.04884, 0.94940, 0.00176, 0.00000, t/ O 3 0.00003, 0.00176, 0.99821, 0.00000, */ O 4 0.00000, 0.00000, 0.00000, 1.00000/ * O *5 O C...LUDAT3, with particle decay parameters and data. .H O DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0,1, E O &2*0,4*1,42*0,7*1,12*0,1,0,15*1,2*0,18*1,2*0,18*1,2*0,18*1,2*0, F O &18*1,2*0,18*1,3*0,1,8*0,1,3*0,1,70*0,1,5*0,1,0,2*1,6*0,1,0,2*1, 4 O &9*0,5*1,0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/ G O DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,50,60,2*0,70,74,76, oG O &81,83,124,126,132,2*0,135,144,156,172,192,6*0,209,0,231,254,274, E O &292,301,304,305,42*0,314,315,319,328,331,336,338,11*0,358,359, wG O &361,367,430,491,524,560,596,635,666,668,675,681,682,683,684,685, O G O &2*0,686,688,691,694,697,699,700,701,702,703,704,708,713,721,724, )G O &733,734,735,2*0,736,737,742,747,749,751,753,755,757,759,761,762, G O &765,769,770,771,772,773,2*0,774,775,777,779,781,783,785,787,789, 5G O &791,793,794,799,804,806,808,809,810,2*0,811,813,815,817,819,821, )G O &823,825,827,829,831,833,846,850,852,854,855,856,2*0,857,863,873, nG O &884,892,900,904,912,920,924,928,936,945,951,953,955,956,957,2*0, 3G O &958,966,8*0,968,3*0,979,70*0,993,5*0,997,0,1073,1074,6*0,1075,0, )D O &1092,1093,9*0,1094,1096,1097,1100,1101,0,1103,1104,1105,1106, F O &1107,1108,4*0,1109,1110,1111,1112,1113,1114,4*0,1115,1116,1119, H O &1122,1123,1126,1129,1132,1134,1136,1140,1141,1142,1143,1145,1147, / O &4*0,1148,1149,1150,1151,1152,1153,114*0/ H O DATA (MDCY(I,3),I= 1, 500)/5*8,9,2*10,2*0,4,2,5,2,41,2,6,3,2*0, H O &9,12,16,20,17,6*0,22,0,23,20,18,9,3,1,9,42*0,1,4,9,3,5,2,20,11*0, E O &1,2,6,63,61,33,2*36,39,31,2,7,6,5*1,2*0,2,3*3,2,5*1,4,5,8,3,9, IG O &3*1,2*0,1,2*5,7*2,1,3,4,5*1,2*0,1,9*2,1,2*5,2*2,3*1,2*0,11*2,13, 2H O &4,2*2,3*1,2*0,6,10,11,2*8,4,2*8,2*4,8,9,6,2*2,3*1,2*0,8,2,8*0,11, G O &3*0,14,70*0,4,5*0,76,0,2*1,6*0,17,0,2*1,9*0,2,1,3,1,2,0,6*1,4*0, Y9 O &6*1,4*0,1,2*3,1,3*3,2*2,4,3*1,2*2,1,4*0,6*1,114*0/ YG O DATA (MDME(I,1),I= 1,2000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, eF O &7*1,-1,1,-1,8*1,2*-1,8*1,2*-1,61*1,-1,2*1,-1,6*1,2*-1,7*1,2*-1, G O &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, OE O &3*1,-1,11*1,2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,6*1, EH O &2*-1,3*1,-1,5*1,-1,8*1,2*-1,3*1,-1,9*1,-1,3*1,-1,9*1,2*-1,2*1,-1,  O &16*1,-1,2*1,3*-1,1665*1/ .F O DATA (MDME(I,2),I= 1,2000)/75*102,42,6*102,2*42,2*0,7*41,2*0, E O &24*41,6*102,45,29*102,8*32,8*0,16*32,4*0,8*32,4*0,32,4*0,8*32, uF O &14*0,16*32,7*0,8*32,4*0,32,7*0,8*32,4*0,32,5*0,4*32,5*0,3*32,0, F O &6*32,3*0,12,2*42,2*11,9*42,2*45,31,2*45,2*33,31,2*45,20*46,7*0, F O &24*42,41*0,16*42,46*0,10*42,20*0,2*13,14*42,16*0,48,3*13,16*42, G O &16*0,48,3*13,16*42,19*0,48,3*13,2*42,0,2*11,28*42,0,2,4*0,2,8*0, TF O &12,32,86,87,88,3,0,2*3,0,2*3,0,2*3,0,3,6*0,3,3*0,1,0,3,2*0,2*3, H O &3*0,1,4*0,12,3*0,4*32,2*4,86,87,88,33*0,12,32,86,87,88,31*0,12,0, H O &32,86,87,88,40*0,12,0,32,86,87,88,95*0,12,0,32,86,87,88,2*0,4*42, G O &6*0,12,11*0,4*32,2*4,9*0,14*42,52*0,10*13,2*84,3*42,8*0,48,3*13, & O &2*42,2*85,14*0,84,5*0,85,886*0/ D O DATA (BRAT(I) ,I= 1, 439)/75*0.,1.,6*0.,0.179,0.178,0.116, H O &0.235,0.005,0.056,0.018,0.023,0.011,2*0.004,0.0067,0.014,2*0.002, C O &2*0.001,0.0022,0.054,0.002,0.016,0.005,0.011,0.0101,5*0.006, C O &0.002,2*0.001,5*0.002,6*0.,1.,29*0.,0.15394,0.11936,0.15394, LD O &0.11926,0.15254,3*0.,0.03368,0.06664,0.03368,0.06664,0.03368, B O &0.06664,2*0.,0.3214,0.0165,2*0.,0.0165,0.3207,2*0.,0.00001, B O &0.00059,6*0.,3*0.1081,3*0.,0.0003,0.048,0.8705,4*0.,0.0002, H O &0.0603,0.,0.0199,0.0008,3*0.,0.143,0.111,0.143,0.111,0.143,0.085, F O &2*0.,0.03,0.058,0.03,0.058,0.03,0.058,8*0.,0.25,0.01,2*0.,0.01, F O &0.25,4*0., 24,5*0.,3*0.08,6*0.,0.01,0.08,0.82,5*0.,0.09,11*0., G O &0.01,0.08,0.82,5*0.,0.09,9*0.,1.,6*0.,0.01,0.98,0.01,1.,4*0.215, E O &2*0.,2*0.07,0.,1.,2*0.08,0.76,0.08,2*0.105,0.04,0.5,0.08,0.14, D O &0.01,0.015,0.005,1.,3*0.,1.,4*0.,1.,0.25,0.01,2*0.,0.01,0.25, G O &4*0.,0.24,5*0.,3*0.08,0.,1.,2*0.5,0.635,0.212,0.056,0.017,0.048, (C O &0.032,0.07,0.065,2*0.005,2*0.011,5*0.001,0.07,0.065,2*0.005, )B O &2*0.011,5*0.001,0.026,0.019,0.066,0.041,0.045,0.076,0.0073, A O &2*0.0047,0.026,0.001,0.0006,0.0066,0.005,2*0.003,2*0.0006, TG O &2*0.001,0.006,0.005,0.012,0.0057,0.067,0.008,0.0022,0.027,0.004, DE O &0.019,0.012,0.002,0.009,0.0218,0.001,0.022,0.087,0.001,0.0019, E O &0.0015,0.0028,0.034,0.027,2*0.002,2*0.004,2*0.002,0.034,0.027/ C O DATA (BRAT(I) ,I= 440, 655)/2*0.002,2*0.004,2*0.002,0.0365, rH O &0.045,0.073,0.062,3*0.021,0.0061,0.015,0.025,0.0088,0.074,0.0109, E O &0.0041,0.002,0.0035,0.0011,0.001,0.0027,2*0.0016,0.0018,0.011, C O &0.0063,0.0052,0.018,0.016,0.0034,0.0036,0.0009,0.0006,0.015, .H O &0.0923,0.018,0.022,0.0077,0.009,0.0075,0.024,0.0085,0.067,0.0511, H O &0.017,0.0004,0.0028,0.01,2*0.02,0.03,2*0.005,2*0.02,0.03,2*0.005, F O &0.015,0.037,0.028,0.079,0.095,0.052,0.0078,4*0.001,0.028,0.033, D O &0.026,0.05,0.01,4*0.005,0.25,0.0952,0.02,0.055,2*0.005,0.008, C O &0.012,0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011, AB O &0.0055,0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,0.0004, F O &0.0007,0.0008,0.0014,0.0019,0.0025,0.4291,0.08,0.07,0.02,0.015, E O &0.005,0.02,0.055,2*0.005,0.008,0.012,0.02,0.055,2*0.005,0.008, MD O &0.012,0.01,0.03,0.0035,0.011,0.0055,0.0042,0.009,0.018,0.015, E O &0.0185,0.0135,0.025,0.0004,0.0007,0.0008,0.0014,0.0019,0.0025, aH O &0.4291,0.08,0.07,0.02,0.015,0.005,0.02,0.055,2*0.005,0.008,0.012, D O &0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011,0.0055, D O &0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,2*0.0002,0.0007, G O &2*0.0004,0.0014,0.001,0.0009,0.0025,0.4291,0.08,0.07,0.02,0.015, NH O &0.005,0.047,0.122,0.006,0.012,0.035,0.012,0.035,0.003,0.007,0.15, H O &0.037,0.008,0.002,0.05,0.015,0.003,0.001,0.014,0.042,0.014,0.042/ G O DATA (BRAT(I) ,I= 656, 931)/0.24,0.065,0.012,0.003,0.001,0.002, ED O &0.001,0.002,0.014,0.003,0.988,0.012,0.389,0.319,0.2367,0.049, H O &0.005,0.001,0.0003,0.441,0.206,0.3,0.03,0.022,0.001,5*1.,0.99955, F O &0.00045,0.665,0.333,0.002,0.666,0.333,0.001,0.65,0.3,0.05,0.56, C O &0.44,5*1.,0.99912,0.00079,0.00005,0.00004,0.888,0.085,0.021, O B O &2*0.003,0.49,0.344,3*0.043,0.023,0.013,0.001,0.0627,0.0597, H O &0.8776,3*0.027,0.015,0.045,0.015,0.045,0.77,0.029,4*1.,0.28,0.14, E O &0.313,0.157,0.11,0.28,0.14,0.313,0.157,0.11,0.667,0.333,0.667, uF O &0.333,2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.333,0.334,0.333, C O &4*0.25,6*1.,0.667,0.333,0.667,0.333,0.667,0.333,0.667,0.333, RE O &2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.52,0.26,0.11,2*0.055, JG O &0.62,0.31,0.035,2*0.0175,0.007,0.993,0.02,0.98,3*1.,2*0.5,0.667, C O &0.333,0.667,0.333,0.667,0.333,0.667,0.333,2*0.5,0.667,0.333, tH O &0.667,0.333,6*0.5,3*0.12,0.097,0.043,4*0.095,4*0.03,4*0.25,0.273, G O &0.727,0.35,0.65,3*1.,2*0.35,0.144,0.105,0.048,0.003,0.333,0.166, 'E O &0.168,0.084,0.087,0.043,0.059,2*0.029,0.002,0.332,0.166,0.168, 8G O &0.084,0.086,0.043,0.059,2*0.029,2*0.002,0.3,0.15,0.16,0.08,0.13, oC O &0.06,0.08,0.04,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,2*0.3, G O &2*0.2,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,0.3,0.15,0.16,0.08, F O &0.13,0.06,0.08,0.04,2*0.3,2*0.2,2*0.3,2*0.2,2*0.35,0.144,0.105/ D O DATA (BRAT(I) , O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O O