From 6914519f34df76efc91001c7b0ddb216ade0ab9a Mon Sep 17 00:00:00 2001 From: Gustavo Date: Mon, 21 Feb 2022 17:04:38 +0100 Subject: [PATCH] cleaning area to keep just PrivProd --- README.md | 48 - issues/README.md | 13 - issues/fpmc_lhe.f | 329 - issues/fragment_scv2.py | 25 - issues/fragment_scv4_lep.py | 37 - issues/fragment_scv4_nolep.py | 29 - lpair_2diss/.gitignore | 2 - lpair_2diss/cdf/ConvertLPairToLHE.C | 112 - lpair_2diss/cdf/Makefile | 65 - lpair_2diss/cdf/dl2.vegas.grid | 901 -- lpair_2diss/cdf/eemumu.f | 134 - lpair_2diss/cdf/external | 1 - lpair_2diss/cdf/lpair.cxx | 182 - lpair_2diss/cdf/lpair.dat | 27 - lpair_2diss/cdf/obj/lpair.oxx | Bin 22304 -> 0 bytes lpair_2diss/cdf/src/accept.f | 14 - lpair_2diss/cdf/src/angle.f | 23 - lpair_2diss/cdf/src/dangle.f | 24 - lpair_2diss/cdf/src/f.f | 202 - lpair_2diss/cdf/src/fileini.f | 95 - lpair_2diss/cdf/src/fragmentation.f | 449 - lpair_2diss/cdf/src/gamgam.f | 135 - lpair_2diss/cdf/src/genera.f | 149 - lpair_2diss/cdf/src/generate.f | 62 - lpair_2diss/cdf/src/genzfil.f | 219 - lpair_2diss/cdf/src/integrate.f | 65 - lpair_2diss/cdf/src/lhe.f | 96 - lpair_2diss/cdf/src/lhe.f_bkp | 90 - lpair_2diss/cdf/src/lorenb.f | 35 - lpair_2diss/cdf/src/luset.f | 80 - lpair_2diss/cdf/src/orient.f | 64 - lpair_2diss/cdf/src/paw.f | 228 - lpair_2diss/cdf/src/peripp.f | 61 - lpair_2diss/cdf/src/pickin.f | 154 - lpair_2diss/cdf/src/ranf.f | 155 - lpair_2diss/cdf/src/save.f | 30 - lpair_2diss/cdf/src/save2.f | 29 - lpair_2diss/cdf/src/setgen.f | 119 - lpair_2diss/cdf/src/treat.f | 31 - lpair_2diss/cdf/src/utils.f | 476 - lpair_2diss/cdf/src/vegas.f | 229 - lpair_2diss/cdf/utils.h | 35 - lpair_2diss/cdf/xsect.cpp | 57 - lpair_2diss/desy/ConvertLPairToLHE.C | 112 - lpair_2diss/desy/Makefile | 59 - lpair_2diss/desy/README | 37 - lpair_2diss/desy/README_RUN_MCgem | 11 - lpair_2diss/desy/convert.C | 144 - lpair_2diss/desy/external/jetset7410.f | 11574 ----------------------- lpair_2diss/desy/external/utils.h | 35 - lpair_2diss/desy/ilpair-cms-pp.f | 148 - lpair_2diss/desy/lpair.card | 16 - lpair_2diss/desy/main.cpp | 141 - lpair_2diss/desy/source/arguments.f | 20 - lpair_2diss/desy/source/f.f | 277 - lpair_2diss/desy/source/gamgam.f | 139 - lpair_2diss/desy/source/gmubeg.f | 216 - lpair_2diss/desy/source/gmucha.f | 120 - lpair_2diss/desy/source/gmufil.f | 483 - lpair_2diss/desy/source/gmugna.f | 158 - lpair_2diss/desy/source/gmuini.f | 91 - lpair_2diss/desy/source/gmulhe.f | 70 - lpair_2diss/desy/source/gmupsg.f | 132 - lpair_2diss/desy/source/grv_lo.f | 249 - lpair_2diss/desy/source/lorenb.f | 35 - lpair_2diss/desy/source/lukset.f | 23 - lpair_2diss/desy/source/lunset.f | 25 - lpair_2diss/desy/source/lupset.f | 32 - lpair_2diss/desy/source/maps.f | 95 - lpair_2diss/desy/source/orient.f | 90 - lpair_2diss/desy/source/peripp.f | 84 - lpair_2diss/desy/source/pickin.f | 213 - lpair_2diss/desy/source/prtlhe.f | 91 - lpair_2diss/desy/source/prtpar.f | 51 - lpair_2diss/desy/source/psf.f | 100 - lpair_2diss/desy/source/ran2.f | 33 - lpair_2diss/desy/source/restr1.f | 24 - lpair_2diss/desy/source/restr2.f | 24 - lpair_2diss/desy/source/save1.f | 24 - lpair_2diss/desy/source/save2.f | 24 - lpair_2diss/desy/source/setgen.f | 120 - lpair_2diss/desy/source/treat.f | 48 - lpair_2diss/desy/source/vegas.f | 371 - lpair_2diss/desy/source/vgdat.f | 42 - lpair_2diss/desy/source/w1w2_f2.f | 43 - lpair_2diss/desy/source/zdstdt.f | 29 - lpair_2diss/desy/source/zduevt.f | 34 - lpair_2diss/desy/source/zduini.f | 123 - lpair_2diss/desy/xsect.cpp | 77 - run_fpmc.sh | 17 - run_sim.sh | 66 - setup_fpmc.sh | 20 - setup_sim.sh | 29 - 93 files changed, 21530 deletions(-) delete mode 100644 README.md delete mode 100644 issues/README.md delete mode 100644 issues/fpmc_lhe.f delete mode 100644 issues/fragment_scv2.py delete mode 100644 issues/fragment_scv4_lep.py delete mode 100644 issues/fragment_scv4_nolep.py delete mode 100644 lpair_2diss/.gitignore delete mode 100644 lpair_2diss/cdf/ConvertLPairToLHE.C delete mode 100644 lpair_2diss/cdf/Makefile delete mode 100644 lpair_2diss/cdf/dl2.vegas.grid delete mode 100644 lpair_2diss/cdf/eemumu.f delete mode 120000 lpair_2diss/cdf/external delete mode 100644 lpair_2diss/cdf/lpair.cxx delete mode 100644 lpair_2diss/cdf/lpair.dat delete mode 100644 lpair_2diss/cdf/obj/lpair.oxx delete mode 100644 lpair_2diss/cdf/src/accept.f delete mode 100644 lpair_2diss/cdf/src/angle.f delete mode 100644 lpair_2diss/cdf/src/dangle.f delete mode 100644 lpair_2diss/cdf/src/f.f delete mode 100644 lpair_2diss/cdf/src/fileini.f delete mode 100644 lpair_2diss/cdf/src/fragmentation.f delete mode 100644 lpair_2diss/cdf/src/gamgam.f delete mode 100644 lpair_2diss/cdf/src/genera.f delete mode 100644 lpair_2diss/cdf/src/generate.f delete mode 100644 lpair_2diss/cdf/src/genzfil.f delete mode 100644 lpair_2diss/cdf/src/integrate.f delete mode 100644 lpair_2diss/cdf/src/lhe.f delete mode 100644 lpair_2diss/cdf/src/lhe.f_bkp delete mode 100644 lpair_2diss/cdf/src/lorenb.f delete mode 100644 lpair_2diss/cdf/src/luset.f delete mode 100644 lpair_2diss/cdf/src/orient.f delete mode 100644 lpair_2diss/cdf/src/paw.f delete mode 100644 lpair_2diss/cdf/src/peripp.f delete mode 100644 lpair_2diss/cdf/src/pickin.f delete mode 100644 lpair_2diss/cdf/src/ranf.f delete mode 100644 lpair_2diss/cdf/src/save.f delete mode 100644 lpair_2diss/cdf/src/save2.f delete mode 100644 lpair_2diss/cdf/src/setgen.f delete mode 100644 lpair_2diss/cdf/src/treat.f delete mode 100644 lpair_2diss/cdf/src/utils.f delete mode 100644 lpair_2diss/cdf/src/vegas.f delete mode 100644 lpair_2diss/cdf/utils.h delete mode 100644 lpair_2diss/cdf/xsect.cpp delete mode 100644 lpair_2diss/desy/ConvertLPairToLHE.C delete mode 100644 lpair_2diss/desy/Makefile delete mode 100644 lpair_2diss/desy/README delete mode 100644 lpair_2diss/desy/README_RUN_MCgem delete mode 100644 lpair_2diss/desy/convert.C delete mode 100644 lpair_2diss/desy/external/jetset7410.f delete mode 100644 lpair_2diss/desy/external/utils.h delete mode 100644 lpair_2diss/desy/ilpair-cms-pp.f delete mode 100644 lpair_2diss/desy/lpair.card delete mode 100644 lpair_2diss/desy/main.cpp delete mode 100644 lpair_2diss/desy/source/arguments.f delete mode 100644 lpair_2diss/desy/source/f.f delete mode 100644 lpair_2diss/desy/source/gamgam.f delete mode 100644 lpair_2diss/desy/source/gmubeg.f delete mode 100644 lpair_2diss/desy/source/gmucha.f delete mode 100644 lpair_2diss/desy/source/gmufil.f delete mode 100644 lpair_2diss/desy/source/gmugna.f delete mode 100644 lpair_2diss/desy/source/gmuini.f delete mode 100644 lpair_2diss/desy/source/gmulhe.f delete mode 100644 lpair_2diss/desy/source/gmupsg.f delete mode 100644 lpair_2diss/desy/source/grv_lo.f delete mode 100644 lpair_2diss/desy/source/lorenb.f delete mode 100644 lpair_2diss/desy/source/lukset.f delete mode 100644 lpair_2diss/desy/source/lunset.f delete mode 100644 lpair_2diss/desy/source/lupset.f delete mode 100644 lpair_2diss/desy/source/maps.f delete mode 100644 lpair_2diss/desy/source/orient.f delete mode 100644 lpair_2diss/desy/source/peripp.f delete mode 100644 lpair_2diss/desy/source/pickin.f delete mode 100644 lpair_2diss/desy/source/prtlhe.f delete mode 100644 lpair_2diss/desy/source/prtpar.f delete mode 100644 lpair_2diss/desy/source/psf.f delete mode 100644 lpair_2diss/desy/source/ran2.f delete mode 100644 lpair_2diss/desy/source/restr1.f delete mode 100644 lpair_2diss/desy/source/restr2.f delete mode 100644 lpair_2diss/desy/source/save1.f delete mode 100644 lpair_2diss/desy/source/save2.f delete mode 100644 lpair_2diss/desy/source/setgen.f delete mode 100644 lpair_2diss/desy/source/treat.f delete mode 100644 lpair_2diss/desy/source/vegas.f delete mode 100644 lpair_2diss/desy/source/vgdat.f delete mode 100644 lpair_2diss/desy/source/w1w2_f2.f delete mode 100644 lpair_2diss/desy/source/zdstdt.f delete mode 100644 lpair_2diss/desy/source/zduevt.f delete mode 100644 lpair_2diss/desy/source/zduini.f delete mode 100644 lpair_2diss/desy/xsect.cpp delete mode 100755 run_fpmc.sh delete mode 100755 run_sim.sh delete mode 100755 setup_fpmc.sh delete mode 100755 setup_sim.sh diff --git a/README.md b/README.md deleted file mode 100644 index 068b036..0000000 --- a/README.md +++ /dev/null @@ -1,48 +0,0 @@ -# PPSMC WG repo - -Repository of the Monte Carlo working group of PPS forward detector [twiki](https://twiki.cern.ch/twiki/bin/viewauth/CMS/CTPPSMC). - -**NOTE: to download a single folder, execute the following command:** - -`svn checkout https://github.com/diemort/PPSMC/trunk/` - -The shell scripts are intended to document and to organized the steps needed to setup and run the FPMC event generator and PPS simulation at LXPLUS machines. - -One can simply run all steps from a given directory by choosing the necessary parameters for aparticular case, e.g. CMSSW release, entries in the fpmc input card and the cmsDriver input parameters. - -## setup_fpmc.sh -Build and compile an working area for the FPMC event generator with a wrapper for hepMC output; - -## setup_sim.sh -Build and compile a CMSSW environment including the PPS fast simulation customise, which includes a ED Filter to read the hepMC event sample; - -:x: **WARNING**: outdated version; more info at [twiki](https://twiki.cern.ch/twiki/bin/viewauth/CMS/TaggedProtonsPOGRecommendations). - -:arrow_right: Parameters: CMSSW release and architecture for a SCRAM-based project. - -## run_fpmc.sh -Setup and run a FPMC instance with minimal parameters for HepMC output: - -``` - --cfg Datacards/dataQED_WW \ - --comenergy 13000 \ - --fileout dataWW.hepmc \ - --nevents 10 -``` - -Other parameters can be added folliwng the instructions in the FPMC [manual](https://arxiv.org/pdf/1102.2531.pdf). - -Directives for LHE output given in the bash macro. - -## run_sim.sh -Setup and run the PPS fast simulation taking the produced event sample from fpmc working dir. Usual cmsDriver parameters are set plus a filter to specify the decay channel. - -It propagates the hepMC input file to the ED Filter meant to be simulated for detector effects. - -:arrow_right: Parameters: CMSSW release, HepMC input file, and filename for output configuration. - -## known issues -Generator files placed in the `issues` folder for specific case treatment. - -### Private Production -The folder PrivProd contains the machinery needed to produce simulated private samples for Summer16, Fall17, and Autmn18 scenarios. Instructions listed the README file inside the folder. diff --git a/issues/README.md b/issues/README.md deleted file mode 100644 index d8dd896..0000000 --- a/issues/README.md +++ /dev/null @@ -1,13 +0,0 @@ -# Known issues - -## SuperCHIC event generator -Fragments for CMSSW simulation of SuperCHIC event generator samples due to incompatibility with hadronization in PYTHIA8: - - | 100 Abort from Pythia::next: parton+hadronLevel failed; giving up - | 10000 Error in BeamRemnants::setKinematics: no momentum left for beam remnants - | 1000 Error in Pythia::next: partonLevel failed; try again - -The fragments are meant to v2, and latest v4 with and without photon-initiated lepton pair production. - -## FPMC decay filter -File `fpmc_lhe.f` contains customized filters to collect distinct decay channels. Note that these filters are simply checking the outgoing particles to record the event or not in the output file. Hence, the desired number of produced events will depend on the branching fractions for the given decay channel. For instance, 3 million events may produce around 200 000 events in the leptonic decay channel. diff --git a/issues/fpmc_lhe.f b/issues/fpmc_lhe.f deleted file mode 100644 index a72319d..0000000 --- a/issues/fpmc_lhe.f +++ /dev/null @@ -1,329 +0,0 @@ -C----------------------------------------------------------------------- -CDECK ID>, HWUEMP. -*CMZ :- -20/10/2013 -*-- Author : M.E.POL from HWUEPR: Ian Knowles, Bryan Webber & Kosuke Odagiri -C----------------------------------------------------------------------- - SUBROUTINE HWUEMP -C----------------------------------------------------------------------- -C Prints out event data in LHE format in unit 45 -C Works for QED -C----------------------------------------------------------------------- - INCLUDE 'HERWIG65.INC' - INTEGER I,J,IST,ILEP - INTEGER IGA1,IGA2,IDA1,IDA2,IPR1,IPR2 - INTEGER JMOT,ISIS1,ISIS2,IFLEP1,IFLEP2,IFLEP3,IFLEP4 - INTEGER II1,II2,II3,II4,II5 - INTEGER NUP,IDRPUP - DOUBLE PRECISION AMASSG,VTIM,ASPI,ALFAS,HWUALF,SCALE - EXTERNAL HWUALF - II1=0 - II2=0 - II3=0 - II4=0 - II5=0 - ILEP=0 - JMOT=0 - ISIS1 = 0 - ISIS2 = 0 - IFLEP1 = 0 - IFLEP2 = 0 - IFLEP3 = 0 - IFLEP4 = 0 - NUP = 10 -C NUP = 4 -C IDRPUP = 10042 - IDRPUP = 1 - AMASSG=0.0 - VTIM = 0.0 - ASPI = 9.0 - ALFAS = HWUALF(1,EMSCA) - SCALE = 1.0 -C Filter leptonic decays - DO 300 J=1,NHEP - JMOT = JMOHEP(1,J) - IF(ABS(IDHEP(J)).EQ.11.AND.ABS(IDHEP(JMOT)).EQ.23)ILEP = ILEP+1 - IF(ABS(IDHEP(J)).EQ.12.AND.ABS(IDHEP(JMOT)).EQ.23)ILEP = ILEP+1 - 300 CONTINUE - IF (ILEP.NE.2) GOTO 999 -C See if there is a FSR photons -C DO 350 J=1,NHEP -C JMOT = JMOHEP(1,J) -C IF(IDHEP(J).EQ.22.AND.ABS(IDHEP(JMOT)).EQ.24)THEN -C WRITE(45,192) -C ENDIF -C 350 CONTINUE -C It is a WW -> electrons and/or muons -C Write start of event in the lhe file - WRITE(45,40) - WRITE(45,41)NUP,IDRPUP,EVWGT,SCALE,ALPHEM,ALFAS - DO 410 I=1,NHEP - IF(IDHEP(I).EQ.2212.AND.JMOHEP(1,I).EQ.1)IPR1=I - IF(IDHEP(I).EQ.2212.AND.JMOHEP(1,I).EQ.2)IPR2=I - IF(RNAME(IDHW(I)).EQ.'HARD')THEN - IGA1 = JMOHEP(1,I) - IGA2 = JMOHEP(2,I) - IDA1 = JDAHEP(1,I) - IDA2 = JDAHEP(2,I) - ISIS1 = JDAHEP(1,IDA1) - ISIS2 = JDAHEP(1,IDA2) - IF(ABS(IDHEP(ISIS1)).EQ.24)THEN - IFLEP1 = JDAHEP(1,ISIS1) - IFLEP2 = JDAHEP(2,ISIS1) - ENDIF - IF(ABS(IDHEP(ISIS2)).EQ.24)THEN - IFLEP3 = JDAHEP(1,ISIS2) - IFLEP4 = JDAHEP(2,ISIS2) - ENDIF - ENDIF - 410 CONTINUE -C Print the gammas - DO 411 I=1,NHEP - IF (I.EQ.IGA1.OR.I.EQ.IGA2)THEN - II1 = -1 - WRITE(45,190)IDHEP(I),II1,II2,II3,II4,II5, - & (PHEP(J,I),J=1,5),VTIM,ASPI -C Print the daughters of the gammas(WW) - ELSE IF(I.EQ.IDA1.OR.I.EQ.IDA2)THEN - II1 = 2 - II2 = 1 - II3 = 2 - WRITE(45,190)IDHEP(I),II1,II2,II3,II4,II5, - & (PHEP(J,I),J=1,5),VTIM,ASPI - ELSE IF(I.EQ.IFLEP1.OR.I.EQ.IFLEP2)THEN - II1 = 1 - II2 = 3 - II3 = 3 - WRITE(45,190)IDHEP(I),II1,II2,II3,II4,II5, - & (PHEP(J,I),J=1,5),VTIM,ASPI - ELSE IF(I.EQ.IFLEP3.OR.I.EQ.IFLEP4)THEN - II1 = 1 - II2 = 4 - II3 = 4 - WRITE(45,190)IDHEP(I),II1,II2,II3,II4,II5, - & (PHEP(J,I),J=1,5),VTIM,ASPI - ENDIF - 411 CONTINUE -C Now print the outgoing protons - DO 412 I=1,NHEP - IF (I.EQ.IPR1.OR.I.EQ.IPR2)THEN - II1 = 1 - II2 = 1 - II3 = 2 - WRITE(45,190)IDHEP(I),II1,II2,II3,II4,II5, - & (PHEP(J,I),J=1,5),VTIM,ASPI -C WRITE(45,191) I,RNAME(IDHW(I)),IDHEP(I),IST, -C & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I), -C & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4) - ENDIF - 412 CONTINUE - WRITE(45,50) - 30 FORMAT(///1X,'EVENT ',I7,':',F8.2,' GEV/C ',A8,' ON ',F8.2, - & ' GEV/C ',A8,' PROCESS:',I6/1X,'SEEDS: ',I11,' & ',I11, - & ' STATUS: ',I4,' ERROR:',I4,' WEIGHT: ',1P,E11.4/) - 40 FORMAT('') - 50 FORMAT('') - 41 FORMAT(1X,I2,2X,I5,1X,4(1X,E15.8)) - 190 FORMAT(1X,I8,5I4,5(2X,E15.8),2F3.0) - 191 FORMAT('#',I4,1X,A8,I8,5I4,2F8.2,2F7.1,F8.2,1P,4E10.3) - 192 FORMAT(1X,'There is a final state photon') - 999 CONTINUE - RETURN - END - -C----------------------------------------------------------------------- -C----------------------------------------------------------------------- - SUBROUTINE LHEEVT -C----------------------------------------------------------------------- -C Prints out event data in LHE format in unit 45 -C----------------------------------------------------------------------- - INCLUDE 'HERWIG65.INC' - INTEGER J,IST - INTEGER I - INTEGER IGA1,IGA2,IDA1,IDA2,IPR1,IPR2 - INTEGER ICOL1,ICOL2 - INTEGER NUP,IDRPUP - INTEGER IQURK,IJET,ILEP,JMOT - DOUBLE PRECISION PtCutJet,PtCutMu,PtCutEl,PtCutTau - DOUBLE PRECISION VTIM,ASPI,ALFAS,HWUALF,SCALE - LOGICAL SAVEPART - - EXTERNAL HWUALF - NUP = 0 - IDRPUP = 1 - VTIM = 0.0 - ASPI = 9.0 - ALFAS = HWUALF(1,EMSCA) - SCALE = 1.0 - ICOL1 = 0 - ICOL2 = 0 - -C FILTER: Gustavo Silveira GGS - ILEP = 0 - IQURK = 0 - IJET = 0 - - PtCutJet = 0 ! cut on pT of Jets - PtCutMu = 20 ! cut on pT of Muons - PtCutEl = 20 ! cut on pT of Electrons - PtCutTau = 20 ! cut on pT of Tauons - - DO 300 J=1,NHEP - JMOT = JMOHEP(1,J) - IF(ABS(IDHEP(J)).EQ.13.AND.ABS(IDHEP(JMOT)).EQ.24) THEN - IF((sqrt(PHEP(1,J)**2+PHEP(2,J)**2)).GE.PtCutMu) THEN - ILEP = ILEP+1 - END IF - END IF - IF(ABS(IDHEP(J)).EQ.11.AND.ABS(IDHEP(JMOT)).EQ.24) THEN - IF((sqrt(PHEP(1,J)**2+PHEP(2,J)**2)).GE.PtCutEl) THEN - ILEP = ILEP+1 - END IF - END IF - IF(ABS(IDHEP(J)).EQ.15.AND.ABS(IDHEP(JMOT)).EQ.24) THEN - IF((sqrt(PHEP(1,J)**2+PHEP(2,J)**2)).GE.PtCutTau) THEN - ILEP = ILEP+1 - END IF - END IF - IF(ABS(IDHEP(J)).EQ.1.AND.ABS(IDHEP(JMOT)).EQ.24) THEN - IQURK = IQURK+1 - END IF - IF(ABS(IDHEP(J)).EQ.2.AND.ABS(IDHEP(JMOT)).EQ.24) THEN - IQURK = IQURK+1 - END IF - IF(ABS(IDHEP(J)).EQ.3.AND.ABS(IDHEP(JMOT)).EQ.24) THEN - IQURK = IQURK+1 - END IF - IF(ABS(IDHEP(J)).EQ.4.AND.ABS(IDHEP(JMOT)).EQ.24) THEN - IQURK = IQURK+1 - END IF - IF(ABS(IDHEP(J)).EQ.94) THEN - IF((sqrt(PHEP(1,J)**2+PHEP(2,J)**2)).GE.PtCutJet) THEN - IJET = IJET+1 - END IF - END IF - - 300 CONTINUE -C Channel definition: -C qqelnu = 122, qqmunu = 122, qqqq = 044, leps = 200 - IF (ILEP.EQ.2.AND.IQURK.EQ.0.AND.IJET.EQ.0) THEN - CONTINUE - ELSE - GOTO 542 - ENDIF - -C END FILTER: Gustavo Silveira - -C Write start of event in the lhe file -C - WRITE(45,40) - - DO 510 I=1,NHEP - IF(IDHEP(I).EQ.2212.AND.JMOHEP(1,I).EQ.1) IPR1=I - IF(IDHEP(I).EQ.2212.AND.JMOHEP(1,I).EQ.2) IPR2=I - - SAVEPART = .FALSE. - IF(UHADR.EQ.'N') THEN - IF(ISTHEP(I).EQ.1) THEN - SAVEPART = .TRUE. - ELSEIF (ISTHEP(I).EQ.113.OR.ISTHEP(I).EQ.114) THEN - SAVEPART = .TRUE. - ISTHEP(I) = 1 - ENDIF - ELSE - IF(ISTHEP(I).EQ.1) THEN - SAVEPART = .TRUE. - ENDIF - ENDIF - - IF(SAVEPART) THEN - NUP = NUP + 1 - ENDIF - - 510 CONTINUE - - WRITE(45,41)NUP,IDRPUP,EVWGT,SCALE,ALPHEM,ALFAS - DO 511 I=1,NHEP - IF(IDHEP(I).EQ.2212.AND.JMOHEP(1,I).EQ.1) IPR1=I - IF(IDHEP(I).EQ.2212.AND.JMOHEP(1,I).EQ.2) IPR2=I - - SAVEPART = .FALSE. - IF(UHADR.EQ.'N') THEN - IF(ISTHEP(I).EQ.1) THEN - SAVEPART = .TRUE. - ELSEIF (ISTHEP(I).EQ.113.OR.ISTHEP(I).EQ.114) THEN - SAVEPART = .TRUE. - ISTHEP(I) = 1 - ENDIF - ELSE - IF(ISTHEP(I).EQ.1) THEN - SAVEPART = .TRUE. - ENDIF - ENDIF - - IF(SAVEPART) THEN - WRITE(45,190) IDHEP(I),ISTHEP(I), - & 0,0,ICOL1,ICOL2, - & (PHEP(J,I),J=1,5),VTIM,ASPI - ENDIF - - 511 CONTINUE - - WRITE(45,50) - - 30 FORMAT(///1X,'EVENT ',I7,':',F8.2,' GEV/C ',A8,' ON ',F8.2, - & ' GEV/C ',A8,' PROCESS:',I6/1X,'SEEDS: ',I11,' & ',I11, - & ' STATUS: ',I4,' ERROR:',I4,' WEIGHT: ',1P,E11.4/) - 40 FORMAT('') - 50 FORMAT('') - 41 FORMAT(1X,I5,2X,I5,1X,4(1X,E15.8)) - 190 FORMAT(1X,I8,5I5,5(2X,E15.8),2F3.0) - 191 FORMAT('#',I4,1X,A8,I8,5I4,2F8.2,2F7.1,F8.2,1P,4E10.3) - RETURN - 542 CONTINUE - END -C----------------------------------------------------------------------- - SUBROUTINE LHEINI -C----------------------------------------------------------------------- -C Prints out initialization in LHE format in unit 45 -C----------------------------------------------------------------------- - INCLUDE 'HERWIG65.INC' - INCLUDE 'ffcard.inc' - INTEGER IPR1,IPR2,I3,I4,III5,IPROC2 - DOUBLE PRECISION ERWGT - -C FIXME - IPR1 = 2212 - IPR2 = 2212 -C I3 = 3 - I3 = 4 - I4 = 1 - III5 = -1 - IPROC2 = -1 - - OPEN(UNIT=45,FILE=ULHEFILE,STATUS='UNKNOWN') - - WRITE(45,30) - WRITE(45,40) - WRITE(45,41)IPR1,IPR2,PBEAM1,PBEAM2,III5,III5,III5,III5,I3,I4 - WRITE(45,42)1000.*AVWGT,1000.*ERWGT,AVWGT,IPROC2 -C WRITE(45,41)IPR1,IPR2,PBEAM1,PBEAM2,I2,I2,IPROC2,IPROC2,I3,I4 -C WRITE(45,42)1000.*AVWGT,1000.*ERWGT,AVWGT,I1 - WRITE(45,50) - 30 FORMAT('') - 40 FORMAT('
'/'
'/'') -C 41 FORMAT(2(5X,I4),2(2X,E15.8),2(2X,I2),2(2x,I2),2(2X,I1)) -C 41 FORMAT(2(5X,I4),2(2X,E15.8),2(2X,I1),2(2x,I5),2(2X,I1)) - 41 FORMAT(2(5X,I4),2(2X,E15.8),2(2X,I4),2(2X,I4),2(2X,I4)) - 42 FORMAT(3(2x,E15.8),2X,I5) - 50 FORMAT('') - RETURN - END -C----------------------------------------------------------------------- - SUBROUTINE LHEEND -C----------------------------------------------------------------------- - WRITE(45,151) - 151 FORMAT('') - - CLOSE(45) - - END diff --git a/issues/fragment_scv2.py b/issues/fragment_scv2.py deleted file mode 100644 index df89230..0000000 --- a/issues/fragment_scv2.py +++ /dev/null @@ -1,25 +0,0 @@ -# Fragment for old version of SuperCHIC. -# New directives for v4 and newer are given in the generator manual -# https://superchic.hepforge.org/superchic4.pdf - -import FWCore.ParameterSet.Config as cms - -from Configuration.Generator.Pythia8CommonSettings_cfi import * -from Configuration.Generator.MCTunes2017.PythiaCP5Settings_cfi import * - -generator = cms.EDFilter("Pythia8HadronizerFilter", - maxEventsToPrint = cms.untracked.int32(1), - pythiaPylistVerbosity = cms.untracked.int32(1), - filterEfficiency = cms.untracked.double(1.0), - pythiaHepMCVerbosity = cms.untracked.bool(False), - comEnergy = cms.double(13000.), - PythiaParameters = cms.PSet( - pythia8CommonSettingsBlock, - pythia8CP5SettingsBlock, - parameterSets = cms.vstring('pythia8CommonSettings', - 'pythia8CP5Settings', - 'keepProtonsIntact' - ), - keepProtonsIntact= cms.vstring('ProcessLevel:all = off') - ) -) diff --git a/issues/fragment_scv4_lep.py b/issues/fragment_scv4_lep.py deleted file mode 100644 index 795398e..0000000 --- a/issues/fragment_scv4_lep.py +++ /dev/null @@ -1,37 +0,0 @@ -# Fragment for latest versions of SuperCHIC. - -import FWCore.ParameterSet.Config as cms - -from Configuration.Generator.Pythia8CommonSettings_cfi import * -from Configuration.Generator.MCTunes2017.PythiaCP5Settings_cfi import * - -generator = cms.EDFilter("Pythia8HadronizerFilter", - maxEventsToPrint = cms.untracked.int32(1), - pythiaPylistVerbosity = cms.untracked.int32(1), - filterEfficiency = cms.untracked.double(1.0), - pythiaHepMCVerbosity = cms.untracked.bool(False), - comEnergy = cms.double(13000.), - PythiaParameters = cms.PSet( - pythia8CommonSettingsBlock, - pythia8CP5SettingsBlock, - parameterSets = cms.vstring('pythia8CommonSettings', - 'pythia8CP5Settings', - 'keepProtonsIntact' - ), - keepProtonsIntact= cms.vstring( - 'LesHouches:matchInOut = off', - 'BeamRemnants:primordialKT = off', - 'PartonLevel:MPI = off', - 'PartonLevel:FSR = on', - 'SpaceShower:dipoleRecoil = on', - 'SpaceShower:pTmaxMatch = 2', - 'SpaceShower:QEDshowerByQ = off', - 'SpaceShower:pTdampMatch=1', - 'BeamRemnants:unresolvedHadron = 0' - # 0 for double dissociation (dd) - # 1 for single dissociation (sdb) - # 2 for single dissociation (sda) - # 3 for elastic (el) - ) - ) -) diff --git a/issues/fragment_scv4_nolep.py b/issues/fragment_scv4_nolep.py deleted file mode 100644 index a117d9d..0000000 --- a/issues/fragment_scv4_nolep.py +++ /dev/null @@ -1,29 +0,0 @@ -# Fragment for latest versions of SuperCHIC. - -import FWCore.ParameterSet.Config as cms - -from Configuration.Generator.Pythia8CommonSettings_cfi import * -from Configuration.Generator.MCTunes2017.PythiaCP5Settings_cfi import * - -generator = cms.EDFilter("Pythia8HadronizerFilter", - maxEventsToPrint = cms.untracked.int32(1), - pythiaPylistVerbosity = cms.untracked.int32(1), - filterEfficiency = cms.untracked.double(1.0), - pythiaHepMCVerbosity = cms.untracked.bool(False), - comEnergy = cms.double(13000.), - PythiaParameters = cms.PSet( - pythia8CommonSettingsBlock, - pythia8CP5SettingsBlock, - parameterSets = cms.vstring('pythia8CommonSettings', - 'pythia8CP5Settings', - 'keepProtonsIntact' - ), - keepProtonsIntact= cms.vstring( - 'PartonLevel:ISR = off', - 'PartonLevel:MPI = off', - 'PartonLevel:Remnants = off', - 'Check:event = off', - 'LesHouches:matchInOut = off' - ) - ) -) diff --git a/lpair_2diss/.gitignore b/lpair_2diss/.gitignore deleted file mode 100644 index 9581c8f..0000000 --- a/lpair_2diss/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -*.o -*.opp diff --git a/lpair_2diss/cdf/ConvertLPairToLHE.C b/lpair_2diss/cdf/ConvertLPairToLHE.C deleted file mode 100644 index 7e8235e..0000000 --- a/lpair_2diss/cdf/ConvertLPairToLHE.C +++ /dev/null @@ -1,112 +0,0 @@ -#include "TFile.h" -#include "TTree.h" -#include -#include -using namespace std; - -void ConvertLPairToLHE() -{ - const Double_t energy = 6500; - const Int_t N = 200; // max number of particles in per event - const Int_t max_events = 2E5; - - TFile *f1 = TFile::Open("events.root"); - TTree *t1 = (TTree*) f1->Get("h4444"); - Double_t xsec, errxsec; - Double_t px[N],py[N],pz[N],en[N],m[N]; - Int_t partid[N], parent[N], daughter1[N], daughter2[N], ip, status[N]; - Double_t iz[N]; - - t1->SetBranchAddress("xsect",&xsec); - t1->SetBranchAddress("errxsect",&errxsec); - t1->SetBranchAddress("px",px); - t1->SetBranchAddress("py",py); - t1->SetBranchAddress("pz",pz); - t1->SetBranchAddress("E",en); - t1->SetBranchAddress("icode",partid); - t1->SetBranchAddress("m",m); - t1->SetBranchAddress("status",status); - t1->SetBranchAddress("parent",parent); - t1->SetBranchAddress("daughter1",daughter1); - t1->SetBranchAddress("daughter2",daughter2); -// t1->SetBranchAddress("iz",iz); - t1->SetBranchAddress("ip",&ip); - - ofstream output("events.lhe"); - //ofstream output("gammagammatautau.lpair_inelel_pt15_7tev.lhe"); - //ofstream output("gammagammatautau.lpair_inelel_tautau_pt25_8tev.lhe"); - //ofstream output("gammagammatautau.lpair_elel_tautau_pt40_7tev.lhe"); - - Int_t nevts = t1->GetEntries(); - if(nevts<1) { std::cout << "no event in the file\n"; return;} - - int first_event = 0; - - output << "" << endl; - output << "
" << endl; - output << "This file was created from the output of the LPAIR generator" << endl; - output << "
" << endl; - - t1->GetEntry(0); - cout << "xsect = " << xsec << " +/- " << errxsec << endl; - - output << "" << endl; - output << "2212 2212 " << energy << " " << energy << " 0 0 10042 10042 2 1" << endl; - output << xsec << " " << errxsec << " 0.26731120000E-03 0" << endl; - output << "" << endl; - - for(Int_t i = first_event;i < first_event+max_events;i++) { - t1->GetEntry(i); - if (i%10000==0) - cout << i << ", Npart = " << ip << endl; - - output << "" << endl; - output << ip-3 << " 0 0.2983460E-04 0.9118800E+02 0.7546772E-02 0.1300000E+00" << endl; - // cout << "there are " << ip << " particles in this event\n"; - - for(int j=0; j=11 && status[j]<=13)) status[j] = 3; // quarks content - else if (status[j]==11) status[j] = 2; // intermediate resonance - - //output << partid[j] << " 1 1 2 0 0 " << px[j] << " " << py[j] << " " << pz[j] << " " << en[j] << " " << m[j] << " 0. " << iz[j] << endl; - output << fixed << setw(6) << partid[j] << setw(4) - << status[j] << setw(4) - << parent[j] << " 0 0 0" << setw(14) - << px[j] << setw(14) - << py[j] << setw(14) - << pz[j] << setw(14) - << en[j] << setw(10) - << m[j] << " 0. " << setw(9) - << iz[j] << endl; - // output << "P "<< i*N+j << " " << partid[j] << " " << px[j] << " " << py[j] << " " << pz[j] << " " << en[j] << " 1 0 0 0 0" << endl; - } - - - output << "" << endl; - } - output << "" << endl; - output.close(); - - cout << "Converted " << max_events << " events" << endl; -} diff --git a/lpair_2diss/cdf/Makefile b/lpair_2diss/cdf/Makefile deleted file mode 100644 index 274170c..0000000 --- a/lpair_2diss/cdf/Makefile +++ /dev/null @@ -1,65 +0,0 @@ -FF_FILES = $(wildcard src/*.f) -EX_FILES = $(wildcard external/*.f) -OBJ_DIR = obj -LIBRARY = #-L/usr/lib64/cernlib/2006/lib -lpdflib804 -lmathlib -lpacklib -lkernlib -OBJ_FILES = $(patsubst src/%.f,$(OBJ_DIR)/%.o,$(FF_FILES)) -EXT_FILES = $(patsubst ../desy/external/%.f,$(OBJ_DIR)/%.o,$(EX_FILES)) -LIB_FILES = $(EXT_FILES) $(OBJ_FILES) -VPATH = src/ external/ - -############################################################################### - -FC = @gfortran -FFLAGS = -g -w -static -lc -lm - -CC = @g++ -CFLAGS = -lgfortran -Wall -lrt - -RM = /bin/rm -RMFLAGS = -rf - -# ROOT flags -RFLAGS = $(shell root-config --cflags) -RLIBS = $(shell root-config --libs) -RHEAD = $(shell root-config --incdir) - -.PHONY: all -all: xsect clpair - -# -# Make the executable -# - -clpair: $(OBJ_DIR)/lpair.oxx $(LIB_FILES) $(OBJ_FILES) $(LIB_FILES) - @echo "Linking $@..." - $(CC) $(CFLAGS) -I$(RHEAD) -o $@ $^ $(LIBRARY) $(RLIBS) - -nice: - $(RM) $(RMFLAGS) *.o $(OBJ_DIR) - -xsect: $(OBJ_DIR)/xsect.opp $(LIB_FILES) $(OBJ_FILES) - @echo "Linking $@..." - $(CC) $(CFLAGS) -o $@ $^ $(LIBRARY) - -clean: nice - $(RM) $(RMFLAGS) lpair xsect -# -# Make the objects -# -$(OBJ_DIR)/%.o: %.f - @echo "Building "$< - $(FC) -c $(FFLAGS) $< -o $@ - -$(OBJ_DIR)/%.opp: %.cpp | $(OBJ_DIR) - @echo "Building "$< - $(CC) -c $(CFLAGS) $< -o $@ - -$(OBJ_DIR)/%.oxx: %.cxx - @echo "Building "$< - $(CC) -c $(CFLAGS) $(RFLAGS) $< -o $@ - -$(OBJ_FILES): | $(OBJ_DIR) -$(EXT_FILES): | $(OBJ_DIR) - -$(OBJ_DIR): - @mkdir -p $(OBJ_DIR) diff --git a/lpair_2diss/cdf/dl2.vegas.grid b/lpair_2diss/cdf/dl2.vegas.grid deleted file mode 100644 index 0aaf754..0000000 --- a/lpair_2diss/cdf/dl2.vegas.grid +++ /dev/null @@ -1,901 +0,0 @@ - 250 15 0.6356493173497471D+09 0.5911557046946032D+08 0.3192544242535807D+06 0.1265668664721575D+13 - 0.2666327081968381D-02 0.4804206337346743D-02 0.7113898718042059D-02 0.9964949931177134D-02 0.1278487282859240D-01 - 0.1556597092395950D-01 0.1817820876184287D-01 0.2006663266108145D-01 0.2157894660075871D-01 0.2363554006874663D-01 - 0.2513200874234709D-01 0.2683682403953554D-01 0.2857155182898601D-01 0.3045952747238462D-01 0.3230100201338602D-01 - 0.3419157046352152D-01 0.3616138143084068D-01 0.3795868408800393D-01 0.3960619831704417D-01 0.4136094659097920D-01 - 0.4288205061456776D-01 0.4465461387098967D-01 0.4617877844992577D-01 0.4771420366385404D-01 0.4923620244139242D-01 - 0.5066192576682983D-01 0.5211993806954935D-01 0.5357085084269861D-01 0.5517378059538081D-01 0.5667758394809450D-01 - 0.5818871220649446D-01 0.5959203387262477D-01 0.6079151002547965D-01 0.6197726388689272D-01 0.6329205469215532D-01 - 0.6446975156062013D-01 0.6576083804646214D-01 0.6702350321566222D-01 0.6819278372495904D-01 0.6961845590506606D-01 - 0.7094424152651348D-01 0.7258662524922566D-01 0.7410417673483644D-01 0.7545190793751867D-01 0.7669531088487647D-01 - 0.7769788256248752D-01 0.7884189737675125D-01 0.8018952740920314D-01 0.8164198238483690D-01 0.8301778665248077D-01 - 0.8431899702572571D-01 0.8590057298310499D-01 0.8721053643026638D-01 0.8847607674247050D-01 0.8972949204534213D-01 - 0.9111683926277164D-01 0.9242090509713612D-01 0.9370922177527403D-01 0.9482291769544463D-01 0.9630858468741393D-01 - 0.9743779584681256D-01 0.9867347664923398D-01 0.1000008380605153D+00 0.1014077468908949D+00 0.1027623990268218D+00 - 0.1041273101367023D+00 0.1054840047744216D+00 0.1068352211536980D+00 0.1081415943480212D+00 0.1094386596463974D+00 - 0.1107662017371800D+00 0.1120251316395416D+00 0.1133385049158915D+00 0.1146256947513588D+00 0.1158526260123384D+00 - 0.1170372507171162D+00 0.1182168977166457D+00 0.1194126832767063D+00 0.1205026926205073D+00 0.1215822299024161D+00 - 0.1228838125550938D+00 0.1242081160120805D+00 0.1255540882713119D+00 0.1268493007636119D+00 0.1281119453615998D+00 - 0.1293087578064951D+00 0.1304823087911102D+00 0.1317359947601723D+00 0.1331303274372988D+00 0.1345552881969146D+00 - 0.1357834620460399D+00 0.1369637705352655D+00 0.1382208255153570D+00 0.1395948280456286D+00 0.1409782799501479D+00 - 0.1420775620393327D+00 0.1430469571586312D+00 0.1443267392878675D+00 0.1456396679789336D+00 0.1469281644493710D+00 - 0.1481911898885090D+00 0.1494605409635530D+00 0.1507448019723114D+00 0.1520478552701311D+00 0.1533235139980653D+00 - 0.1545631374403212D+00 0.1558131296286769D+00 0.1570510228246808D+00 0.1583209149347294D+00 0.1595611979227692D+00 - 0.1608347757099832D+00 0.1621385681264320D+00 0.1633659968865161D+00 0.1646541556962013D+00 0.1659861506119188D+00 - 0.1672379674078007D+00 0.1685301326897319D+00 0.1698389087194876D+00 0.1711578699642139D+00 0.1725027710440767D+00 - 0.1738903418992390D+00 0.1752117859530770D+00 0.1764766032210371D+00 0.1777071165845734D+00 0.1790274225783228D+00 - 0.1804467488920851D+00 0.1817819371801199D+00 0.1829841128191789D+00 0.1842222674585441D+00 0.1856020145680905D+00 - 0.1869368179442184D+00 0.1882703488696361D+00 0.1896025921428121D+00 0.1909097615138768D+00 0.1922225450910008D+00 - 0.1935101636921730D+00 0.1948017067349660D+00 0.1961078182807880D+00 0.1974441213273153D+00 0.1988393528436201D+00 - 0.2002578322439909D+00 0.2014838447925335D+00 0.2026820047454334D+00 0.2041188421950338D+00 0.2055004098999898D+00 - 0.2067936100810029D+00 0.2080756431363108D+00 0.2094330341871055D+00 0.2107918724893149D+00 0.2121203750800375D+00 - 0.2135540151612553D+00 0.2150180051261600D+00 0.2163846902769548D+00 0.2177548094191592D+00 0.2192256650897540D+00 - 0.2202513127184112D+00 0.2215272630712871D+00 0.2230288568002675D+00 0.2243748966082054D+00 0.2258645916562480D+00 - 0.2272362935877400D+00 0.2286672887669016D+00 0.2301752135337563D+00 0.2317020438965894D+00 0.2332641949058300D+00 - 0.2348678895745366D+00 0.2364410206486120D+00 0.2379806627686781D+00 0.2393672914834081D+00 0.2408882919999472D+00 - 0.2423772913771254D+00 0.2437873385965355D+00 0.2453193260453810D+00 0.2469053235298058D+00 0.2484017596722128D+00 - 0.2500016961175006D+00 0.2515235292910099D+00 0.2531072000565508D+00 0.2544853632749081D+00 0.2559996518786800D+00 - 0.2574703916199969D+00 0.2588764236656938D+00 0.2604156780218388D+00 0.2619732903439771D+00 0.2635463224058506D+00 - 0.2651434660294263D+00 0.2667616928654121D+00 0.2683688163767194D+00 0.2701216930644977D+00 0.2718294689287539D+00 - 0.2734317941213167D+00 0.2750805686836649D+00 0.2767056603928923D+00 0.2783889720248157D+00 0.2801386238620863D+00 - 0.2819077404925443D+00 0.2836871447337068D+00 0.2854690072005561D+00 0.2873714431085608D+00 0.2892477423359559D+00 - 0.2909831392013235D+00 0.2925276851796164D+00 0.2941243789245573D+00 0.2958455609967771D+00 0.2975959981992105D+00 - 0.2994370380310550D+00 0.3012732056734270D+00 0.3031050133769654D+00 0.3049823607854275D+00 0.3068641342402447D+00 - 0.3087481411814997D+00 0.3106222787126655D+00 0.3125134683309205D+00 0.3145214843678281D+00 0.3164502312815941D+00 - 0.3184546687356191D+00 0.3204400127324416D+00 0.3223446583217692D+00 0.3241003290870384D+00 0.3260001948508733D+00 - 0.3280108129271402D+00 0.3297089503793814D+00 0.3316048792790618D+00 0.3336023354553261D+00 0.3358838505632128D+00 - 0.3382854492990100D+00 0.3406015613707558D+00 0.3428874037194359D+00 0.3450003573073540D+00 0.3473282464170115D+00 - 0.3497813584652769D+00 0.3521895837967286D+00 0.3549030675972188D+00 0.3578134371592233D+00 0.3602475493845322D+00 - 0.3627271658319342D+00 0.3655400900868869D+00 0.3684493237231153D+00 0.3714994400251342D+00 0.3746288588174286D+00 - 0.3778289039206853D+00 0.3816578650621776D+00 0.3858454969900224D+00 0.3900126813142806D+00 0.3949073509571578D+00 - 0.3990339275112973D+00 0.4037268953859440D+00 0.4111006811566736D+00 0.4230916024319633D+00 0.1000000000000000D+01 - 0.9661365659601611D-02 0.1651017767457132D-01 0.2441963107122518D-01 0.3153991056429536D-01 0.3775337970021915D-01 - 0.4263364616466953D-01 0.4722460274402322D-01 0.5186622333022343D-01 0.5573868467284161D-01 0.5859137995286124D-01 - 0.6203744216303295D-01 0.6578329667573102D-01 0.7073864575644406D-01 0.7531645598537587D-01 0.7918872843395178D-01 - 0.8312042436923534D-01 0.8724474274873342D-01 0.9074608909159738D-01 0.9436025333505024D-01 0.9743138878430109D-01 - 0.1012405711234867D+00 0.1043764262071597D+00 0.1075132834424768D+00 0.1105938145455649D+00 0.1132866499703581D+00 - 0.1163467866734332D+00 0.1195323262446935D+00 0.1226098078895904D+00 0.1255922183718108D+00 0.1289062032467189D+00 - 0.1320496004993706D+00 0.1347300303395912D+00 0.1378140415196591D+00 0.1404592409384065D+00 0.1434147752250170D+00 - 0.1459470458922173D+00 0.1485200125695072D+00 0.1513709355775813D+00 0.1541832021146866D+00 0.1564288906154596D+00 - 0.1587583732731819D+00 0.1615168106582931D+00 0.1640972592640533D+00 0.1665947259042093D+00 0.1690184348206290D+00 - 0.1713595668021747D+00 0.1733126924001845D+00 0.1752043526068501D+00 0.1776748404419427D+00 0.1800818519391079D+00 - 0.1822446546671281D+00 0.1843536520250609D+00 0.1866165169972498D+00 0.1890183641664474D+00 0.1910014442236901D+00 - 0.1929640948424544D+00 0.1951665338513419D+00 0.1973205825090087D+00 0.1996350976809957D+00 0.2019165743334786D+00 - 0.2042717203266294D+00 0.2063714205347077D+00 0.2083621488078054D+00 0.2104361710688450D+00 0.2126947072797166D+00 - 0.2147145981676720D+00 0.2166644987777661D+00 0.2184958100075647D+00 0.2206558555218184D+00 0.2228115878349819D+00 - 0.2248357437523910D+00 0.2268706261950040D+00 0.2289082255681382D+00 0.2310825666288734D+00 0.2330814209775024D+00 - 0.2350268590530848D+00 0.2370324269428632D+00 0.2386787956175871D+00 0.2406265991605429D+00 0.2424664346340343D+00 - 0.2440374260254609D+00 0.2454976504447885D+00 0.2473240932830699D+00 0.2491001596726240D+00 0.2507140208486214D+00 - 0.2525299157918527D+00 0.2542613597626697D+00 0.2558903142786303D+00 0.2578004451174247D+00 0.2596227250549996D+00 - 0.2613162218384715D+00 0.2629911664181479D+00 0.2646959184543594D+00 0.2663931212570825D+00 0.2681702908453992D+00 - 0.2698895028267163D+00 0.2714015898333762D+00 0.2724010579272235D+00 0.2739991718187190D+00 0.2757355180422132D+00 - 0.2775581878678580D+00 0.2790664512467803D+00 0.2806213782072248D+00 0.2822014014509518D+00 0.2838105389839204D+00 - 0.2854644002196260D+00 0.2870535007023737D+00 0.2885857715751434D+00 0.2901628462556699D+00 0.2917205511777510D+00 - 0.2932183498636318D+00 0.2947595541531390D+00 0.2963665474277341D+00 0.2979475254701791D+00 0.2993876391250405D+00 - 0.3009044362562250D+00 0.3021095663891704D+00 0.3034578714530551D+00 0.3049920601866806D+00 0.3065092670053121D+00 - 0.3080551939660284D+00 0.3095186169443194D+00 0.3110219482612132D+00 0.3125169652933334D+00 0.3139771643406103D+00 - 0.3154074359320977D+00 0.3168095395696753D+00 0.3182745344546132D+00 0.3197768997488169D+00 0.3212268894279672D+00 - 0.3226185777271915D+00 0.3240216008005009D+00 0.3255102474385778D+00 0.3269037939485703D+00 0.3283047746832142D+00 - 0.3297260078679277D+00 0.3311285620694742D+00 0.3325021839584637D+00 0.3338801673801473D+00 0.3352979059298947D+00 - 0.3367073425094095D+00 0.3380734355479894D+00 0.3393762121419936D+00 0.3407618017640201D+00 0.3421650050245497D+00 - 0.3434284149160706D+00 0.3447479229725569D+00 0.3460159377490197D+00 0.3473123180420901D+00 0.3486295124138104D+00 - 0.3499914003736616D+00 0.3512526689913770D+00 0.3524950795532952D+00 0.3538257582365975D+00 0.3550223764232298D+00 - 0.3562231953232671D+00 0.3575798955972138D+00 0.3590657893530966D+00 0.3604361201291037D+00 0.3617744952519469D+00 - 0.3631309556239173D+00 0.3644847416466521D+00 0.3658259794055172D+00 0.3670847537776261D+00 0.3683408429549054D+00 - 0.3697132693628357D+00 0.3710921392059160D+00 0.3724449321170124D+00 0.3736615422270645D+00 0.3748517332965207D+00 - 0.3761438166857398D+00 0.3773764467950658D+00 0.3786453893388249D+00 0.3796069430713989D+00 0.3807374256258519D+00 - 0.3819479851271029D+00 0.3831883403522504D+00 0.3844641944658605D+00 0.3856942433323737D+00 0.3867706952816740D+00 - 0.3878514020785846D+00 0.3890319051294707D+00 0.3902675353211342D+00 0.3915255162424625D+00 0.3927387708081818D+00 - 0.3940296739630096D+00 0.3952414714702337D+00 0.3964232636907637D+00 0.3976512616854228D+00 0.3986451134549931D+00 - 0.3997226706271059D+00 0.4009175782238142D+00 0.4020744408899174D+00 0.4032659386359213D+00 0.4045475431591882D+00 - 0.4058529431992687D+00 0.4071743792998371D+00 0.4084630287034599D+00 0.4097425843716829D+00 0.4110598687407576D+00 - 0.4123637921241503D+00 0.4135656328363854D+00 0.4148524866331074D+00 0.4162492506823529D+00 0.4176026850501535D+00 - 0.4188700705537183D+00 0.4201032477430331D+00 0.4214486455495162D+00 0.4228538539076195D+00 0.4240602576500907D+00 - 0.4253623815465929D+00 0.4267286567349351D+00 0.4279770829624475D+00 0.4292501810812853D+00 0.4305934342041524D+00 - 0.4319542957445249D+00 0.4334191889770338D+00 0.4348350819228318D+00 0.4362215551280036D+00 0.4377305127786502D+00 - 0.4393017981014403D+00 0.4407970948303605D+00 0.4423288704187335D+00 0.4440083251198518D+00 0.4457406551167996D+00 - 0.4473982073512904D+00 0.4491321572343757D+00 0.4505216344783385D+00 0.4521245538339543D+00 0.4538475044759346D+00 - 0.4556464522891111D+00 0.4575843061359887D+00 0.4594506165428586D+00 0.4613382301999405D+00 0.4636285758411356D+00 - 0.4659389214000031D+00 0.4682738407974083D+00 0.4710456532166621D+00 0.4741369677589042D+00 0.4773765333048988D+00 - 0.4807304273477190D+00 0.4842591049864791D+00 0.4886564990635239D+00 0.4932995730267290D+00 0.4988024484343640D+00 - 0.5066066229294316D+00 0.5156996971766946D+00 0.5279346210726017D+00 0.5610805925001999D+00 0.1000000000000000D+01 - 0.2206681341155554D-01 0.3509825626053691D-01 0.4611653932839769D-01 0.5381463527971222D-01 0.6086286279129124D-01 - 0.6735726828895175D-01 0.7346063932201338D-01 0.7998231846692481D-01 0.8596769267006238D-01 0.9140119793355291D-01 - 0.9615683824568361D-01 0.1007528347079584D+00 0.1053759075710102D+00 0.1092219535398161D+00 0.1129125100547941D+00 - 0.1169379985709094D+00 0.1209679387223530D+00 0.1250168542917280D+00 0.1288923445802923D+00 0.1323415101893058D+00 - 0.1358520047804353D+00 0.1398305944673822D+00 0.1435154138480749D+00 0.1466481956767589D+00 0.1496550306580725D+00 - 0.1528376812366519D+00 0.1562268610086409D+00 0.1593388122571616D+00 0.1625950526832743D+00 0.1656041145792636D+00 - 0.1685628288982199D+00 0.1715374046088869D+00 0.1746789300401534D+00 0.1781075906580520D+00 0.1812592440002206D+00 - 0.1840888701837676D+00 0.1869473496188898D+00 0.1896622471144021D+00 0.1925253958936619D+00 0.1955478635841637D+00 - 0.1984790042677048D+00 0.2015449067922412D+00 0.2043488215956189D+00 0.2071015982356430D+00 0.2098866544787244D+00 - 0.2125761356915360D+00 0.2154531080299966D+00 0.2183151009950718D+00 0.2209698353672985D+00 0.2234546475538268D+00 - 0.2259099075763610D+00 0.2284884279986058D+00 0.2310163446124143D+00 0.2333850240004011D+00 0.2362399712717100D+00 - 0.2388719884877468D+00 0.2415074313787565D+00 0.2442791423575981D+00 0.2470211182902038D+00 0.2498631541554543D+00 - 0.2527344231327400D+00 0.2552538848895194D+00 0.2578468186492066D+00 0.2604416670082212D+00 0.2627911083187316D+00 - 0.2651984927668951D+00 0.2673966516818949D+00 0.2696353551720174D+00 0.2721693112157561D+00 0.2745717369749616D+00 - 0.2770393925069902D+00 0.2794378515089610D+00 0.2817903522861594D+00 0.2842567388822015D+00 0.2868751699003849D+00 - 0.2890921922625349D+00 0.2911510688845084D+00 0.2934995392606656D+00 0.2958452783392477D+00 0.2983285334395314D+00 - 0.3006025701342028D+00 0.3029669223822599D+00 0.3055471405990581D+00 0.3081485109223658D+00 0.3104815324425468D+00 - 0.3126612777762247D+00 0.3150337165084351D+00 0.3174421725874003D+00 0.3198408044820020D+00 0.3222994303207551D+00 - 0.3247963117307585D+00 0.3273280593184920D+00 0.3296270506616052D+00 0.3311258735907833D+00 0.3325442436490855D+00 - 0.3352360003671903D+00 0.3378542443094329D+00 0.3403620356548068D+00 0.3429372571331186D+00 0.3454103601381519D+00 - 0.3478026863821347D+00 0.3502246798258365D+00 0.3526829543461900D+00 0.3550474487218023D+00 0.3573443271870131D+00 - 0.3596613759122740D+00 0.3618831956245369D+00 0.3642455526352438D+00 0.3667702680737957D+00 0.3692382215932601D+00 - 0.3716053247843412D+00 0.3741516883110209D+00 0.3764605704037000D+00 0.3788719620476914D+00 0.3812607345707384D+00 - 0.3834634018769319D+00 0.3857714277537099D+00 0.3883226287525428D+00 0.3906192595535267D+00 0.3928811226628099D+00 - 0.3952734368982488D+00 0.3977463390201175D+00 0.4001725561140183D+00 0.4026615374703164D+00 0.4050242323151763D+00 - 0.4074118987577582D+00 0.4099616700599595D+00 0.4124333882754292D+00 0.4149797626927815D+00 0.4175129968397285D+00 - 0.4200586386100945D+00 0.4224316765029752D+00 0.4248581447740432D+00 0.4274496587650318D+00 0.4301516007945482D+00 - 0.4327091333808960D+00 0.4354348044711976D+00 0.4380189154980426D+00 0.4403856299192824D+00 0.4422472907004016D+00 - 0.4443455206872822D+00 0.4468105533990615D+00 0.4494897121741603D+00 0.4520945645327793D+00 0.4548016414588850D+00 - 0.4575564084403443D+00 0.4600549439441686D+00 0.4625800078924814D+00 0.4652306702121995D+00 0.4680997535631726D+00 - 0.4706757900259955D+00 0.4733060439244375D+00 0.4759380900248510D+00 0.4786191702603543D+00 0.4813246368264884D+00 - 0.4839984421532211D+00 0.4866922028011708D+00 0.4895300745728787D+00 0.4923050995286834D+00 0.4949936445503632D+00 - 0.4976942172824592D+00 0.5005098477209997D+00 0.5034531820634212D+00 0.5064300605165489D+00 0.5092889139962459D+00 - 0.5121868629753165D+00 0.5151368113223070D+00 0.5179372268437508D+00 0.5208026856792626D+00 0.5238201176539468D+00 - 0.5269452920981476D+00 0.5299696172673881D+00 0.5326332384555696D+00 0.5358600765278149D+00 0.5391588541641023D+00 - 0.5421176680889559D+00 0.5452003059800968D+00 0.5484718946571805D+00 0.5516189462534523D+00 0.5543707073901540D+00 - 0.5576629933500501D+00 0.5606879479686818D+00 0.5637977049082259D+00 0.5671227175443370D+00 0.5706350424530897D+00 - 0.5740019862540859D+00 0.5771875115714653D+00 0.5805371078700280D+00 0.5835435111168151D+00 0.5866675520681287D+00 - 0.5894859107427664D+00 0.5930394583220570D+00 0.5965806251238731D+00 0.5999901428347703D+00 0.6032213207310072D+00 - 0.6066098467773705D+00 0.6100247091323516D+00 0.6136374839998499D+00 0.6173237840230673D+00 0.6209227270582002D+00 - 0.6244948741032360D+00 0.6281457128542889D+00 0.6319046505259424D+00 0.6356223293828343D+00 0.6387992359599660D+00 - 0.6419124642820940D+00 0.6453533005755170D+00 0.6490431469760499D+00 0.6529644773428530D+00 0.6568442489429644D+00 - 0.6606706426257803D+00 0.6644166800214055D+00 0.6681047695997069D+00 0.6722400022888064D+00 0.6757822593123887D+00 - 0.6797784872458200D+00 0.6835364054975852D+00 0.6871042519199669D+00 0.6913023435748458D+00 0.6955351322272354D+00 - 0.7000047097657496D+00 0.7047754493610879D+00 0.7090017710389513D+00 0.7132770155794466D+00 0.7181219730175004D+00 - 0.7229776150817093D+00 0.7279459347389782D+00 0.7328210708700250D+00 0.7382083950349381D+00 0.7428643617302896D+00 - 0.7479126849747746D+00 0.7528038768681387D+00 0.7584585653574761D+00 0.7634475344761976D+00 0.7685297292059674D+00 - 0.7740042460340983D+00 0.7800718976769399D+00 0.7863062318369101D+00 0.7925879566635839D+00 0.7986433509624762D+00 - 0.8063698849408536D+00 0.8153200614238557D+00 0.8264916283400112D+00 0.8350023140490429D+00 0.8429557983743939D+00 - 0.8549960876198256D+00 0.8689578059204321D+00 0.8863925146248468D+00 0.9341291354295388D+00 0.1000000000000000D+01 - 0.4487250116772968D-02 0.8874543234295595D-02 0.1314480149763368D-01 0.1725719155669613D-01 0.2171392748706537D-01 - 0.2607548713956570D-01 0.3007834781387423D-01 0.3462195472521183D-01 0.3946545730227392D-01 0.4421700460069365D-01 - 0.4952362183634017D-01 0.5416154138226292D-01 0.5848590262890298D-01 0.6315107987695802D-01 0.6783106002640057D-01 - 0.7186236758647928D-01 0.7571983631805472D-01 0.8045946851414790D-01 0.8488200897515499D-01 0.8910122415728902D-01 - 0.9301468417697020D-01 0.9672480807471072D-01 0.1004518896845210D+00 0.1052468866603920D+00 0.1097129832223078D+00 - 0.1138488060106005D+00 0.1178947708767428D+00 0.1220211545956165D+00 0.1258514909453185D+00 0.1296142178571082D+00 - 0.1337653239778626D+00 0.1384294423149978D+00 0.1423460062056777D+00 0.1469335867869525D+00 0.1509766248405116D+00 - 0.1551802757752744D+00 0.1593423451414756D+00 0.1637072955858624D+00 0.1679182010015790D+00 0.1720681645887902D+00 - 0.1762473766113717D+00 0.1796555613101236D+00 0.1834460300965132D+00 0.1876525146204462D+00 0.1918285991003198D+00 - 0.1959573874107763D+00 0.2003690157874012D+00 0.2045521822474524D+00 0.2088226813967838D+00 0.2130329838881732D+00 - 0.2169409802638451D+00 0.2206424518479110D+00 0.2241113107717001D+00 0.2274038405696148D+00 0.2308683538704955D+00 - 0.2349373902461267D+00 0.2394053022238569D+00 0.2435206129333841D+00 0.2474761099986033D+00 0.2512750282295310D+00 - 0.2550407443448289D+00 0.2590953419714201D+00 0.2628515945068845D+00 0.2670266790881896D+00 0.2705464107293991D+00 - 0.2730835958952718D+00 0.2764466862002757D+00 0.2803157118351352D+00 0.2844183126479442D+00 0.2888061520890579D+00 - 0.2927750941573116D+00 0.2968874585682947D+00 0.3007847328805731D+00 0.3047042446257291D+00 0.3085443072613568D+00 - 0.3128489570660105D+00 0.3172084867400496D+00 0.3211397131234215D+00 0.3249108282861812D+00 0.3293574594934905D+00 - 0.3333942466954969D+00 0.3375110088990091D+00 0.3415399824822070D+00 0.3456021619759571D+00 0.3494381424079843D+00 - 0.3527722379637002D+00 0.3559028117375274D+00 0.3599009813551369D+00 0.3639310007849108D+00 0.3676001915474394D+00 - 0.3710737891770057D+00 0.3745841616914570D+00 0.3785814974172088D+00 0.3815985997366455D+00 0.3840516466512667D+00 - 0.3870165440889683D+00 0.3908310673168485D+00 0.3946504552954849D+00 0.3982378463965535D+00 0.4018691049948089D+00 - 0.4054033269665062D+00 0.4089525117963110D+00 0.4125026461115525D+00 0.4163114061460346D+00 0.4202045174804769D+00 - 0.4242454567136394D+00 0.4278502634332527D+00 0.4316849806645918D+00 0.4354109067508283D+00 0.4387644543209710D+00 - 0.4424155741326598D+00 0.4461538871987026D+00 0.4497685750074160D+00 0.4535168245972663D+00 0.4571271341533894D+00 - 0.4608449522401396D+00 0.4648228318685759D+00 0.4686775631121766D+00 0.4724117003994234D+00 0.4757130856734853D+00 - 0.4791032855186220D+00 0.4827497114213219D+00 0.4864278404753424D+00 0.4902289305422763D+00 0.4941075563751384D+00 - 0.4980287893257853D+00 0.5017058060175922D+00 0.5051629673307102D+00 0.5087838643634063D+00 0.5125401191352361D+00 - 0.5160639029332637D+00 0.5196006974467506D+00 0.5232810701385816D+00 0.5267908978448632D+00 0.5300119026526912D+00 - 0.5332458025753233D+00 0.5369794901003807D+00 0.5405265956577073D+00 0.5443963329380632D+00 0.5481270669548431D+00 - 0.5517394661303381D+00 0.5555443123594052D+00 0.5592439323927210D+00 0.5626973983196366D+00 0.5660124847348735D+00 - 0.5695031382563039D+00 0.5734468830215284D+00 0.5771497254734127D+00 0.5804638058313891D+00 0.5839988714879278D+00 - 0.5876035245096038D+00 0.5911271839950805D+00 0.5947047193479144D+00 0.5986613882900602D+00 0.6024971024303292D+00 - 0.6065138928350152D+00 0.6105034802465076D+00 0.6141829073218633D+00 0.6180508303542523D+00 0.6217928602251019D+00 - 0.6256019132510138D+00 0.6294455038669639D+00 0.6332711591076488D+00 0.6372894572966739D+00 0.6413158640323146D+00 - 0.6452308781611180D+00 0.6491369557360109D+00 0.6531497893893899D+00 0.6573006072864355D+00 0.6613964568296671D+00 - 0.6654835117384573D+00 0.6695392082120277D+00 0.6735243870778367D+00 0.6776481597542687D+00 0.6815851199901902D+00 - 0.6854455778853497D+00 0.6893759530535939D+00 0.6933548645404334D+00 0.6972342285992668D+00 0.7010207963473638D+00 - 0.7049772685349617D+00 0.7084634619755277D+00 0.7117052328326680D+00 0.7156923284039245D+00 0.7200458971755495D+00 - 0.7240429753908135D+00 0.7278373431356099D+00 0.7319198897767433D+00 0.7356467138490681D+00 0.7390938722100669D+00 - 0.7430258632956248D+00 0.7470589770013113D+00 0.7515164754426646D+00 0.7558006533707675D+00 0.7596186348520754D+00 - 0.7638599253658330D+00 0.7687333909517754D+00 0.7728566472090851D+00 0.7768188729865644D+00 0.7808839461594378D+00 - 0.7852311752441608D+00 0.7897591671395245D+00 0.7936274354834212D+00 0.7969329364821782D+00 0.7999529234427133D+00 - 0.8041403030653210D+00 0.8084321883942480D+00 0.8126180397766936D+00 0.8168515989650572D+00 0.8211766497511888D+00 - 0.8258333634147165D+00 0.8301591899156797D+00 0.8341083781402815D+00 0.8379903271059739D+00 0.8421092064603527D+00 - 0.8466056808458245D+00 0.8507252559697770D+00 0.8547966463241952D+00 0.8592513898969532D+00 0.8636613518339553D+00 - 0.8678649181632213D+00 0.8721859173326822D+00 0.8771436633630905D+00 0.8819610148426688D+00 0.8866871618996144D+00 - 0.8912474122076033D+00 0.8956937481180087D+00 0.8998423761575218D+00 0.9041551213323065D+00 0.9088144387028010D+00 - 0.9136642206521028D+00 0.9182884312383909D+00 0.9226220202572512D+00 0.9270272722033984D+00 0.9315100002488769D+00 - 0.9359765824168904D+00 0.9407337494748655D+00 0.9457758499207033D+00 0.9506065932576679D+00 0.9552958709404319D+00 - 0.9596749209233818D+00 0.9635326544795545D+00 0.9679035779877245D+00 0.9728341380345688D+00 0.9775140302740128D+00 - 0.9821567340673314D+00 0.9863733764841732D+00 0.9909037955582801D+00 0.9954662223401185D+00 0.1000000000000000D+01 - 0.1748856218639655D+00 0.2048982556184946D+00 0.2203565293867833D+00 0.2329040963383344D+00 0.2431290250264926D+00 - 0.2501203989654593D+00 0.2563558527180714D+00 0.2623408553383785D+00 0.2676597725067424D+00 0.2725541933274835D+00 - 0.2767614437806185D+00 0.2808076340716809D+00 0.2845138191490516D+00 0.2878419080023318D+00 0.2907566949586395D+00 - 0.2931743109602130D+00 0.2956063188891566D+00 0.2978469976872927D+00 0.3002028420287590D+00 0.3025070939935680D+00 - 0.3047931346718398D+00 0.3072256270451825D+00 0.3093294950826329D+00 0.3112492137756830D+00 0.3129503593428256D+00 - 0.3148745217090650D+00 0.3166385499428390D+00 0.3184530689129385D+00 0.3202413672922340D+00 0.3220050646152154D+00 - 0.3236601036881750D+00 0.3254273379548199D+00 0.3270147168453039D+00 0.3287265929763450D+00 0.3301376285258499D+00 - 0.3315348105492809D+00 0.3328576304403787D+00 0.3340048900837417D+00 0.3353557780065889D+00 0.3367039639372228D+00 - 0.3378993572326359D+00 0.3392659816158793D+00 0.3405825413276762D+00 0.3417700253965585D+00 0.3428210540111115D+00 - 0.3439738525785873D+00 0.3452729989899173D+00 0.3465878420567066D+00 0.3478346387813457D+00 0.3489645140588304D+00 - 0.3500155950626505D+00 0.3511218264799763D+00 0.3521934739254273D+00 0.3533697560084709D+00 0.3544991318699414D+00 - 0.3555742034370423D+00 0.3566745134204537D+00 0.3577690940817906D+00 0.3587677031254637D+00 0.3596336532211669D+00 - 0.3603733877585164D+00 0.3612608608247724D+00 0.3622519493171142D+00 0.3632466535289395D+00 0.3643556805343975D+00 - 0.3654267141850931D+00 0.3664049358466898D+00 0.3674552970774581D+00 0.3684294323342974D+00 0.3692800782730888D+00 - 0.3701909790685059D+00 0.3711853802023416D+00 0.3721939959727859D+00 0.3730477643779624D+00 0.3738002175510097D+00 - 0.3747255789197888D+00 0.3756590163998098D+00 0.3765592914781473D+00 0.3774724212415155D+00 0.3783222132211241D+00 - 0.3791581662010833D+00 0.3800464409923721D+00 0.3809274071078833D+00 0.3817135753531511D+00 0.3825608334748826D+00 - 0.3834113491220181D+00 0.3842561268458176D+00 0.3851187221684841D+00 0.3859853210137387D+00 0.3868066845195295D+00 - 0.3876958284241152D+00 0.3885873163237040D+00 0.3894399140427916D+00 0.3902825312340139D+00 0.3911860478368710D+00 - 0.3921008520335689D+00 0.3929788283923708D+00 0.3938436075166148D+00 0.3946798393023574D+00 0.3954762890171447D+00 - 0.3962911429383635D+00 0.3970553149155273D+00 0.3978104284402110D+00 0.3986265149319307D+00 0.3994090130450313D+00 - 0.4001860226492021D+00 0.4009402045234177D+00 0.4016817966800498D+00 0.4024456528391917D+00 0.4032544213616545D+00 - 0.4040330091271300D+00 0.4048019886036766D+00 0.4056400669965127D+00 0.4064700994798227D+00 0.4072502183612797D+00 - 0.4080053410279439D+00 0.4088080146431067D+00 0.4096377507220182D+00 0.4104291302565737D+00 0.4112331581186034D+00 - 0.4120716830798828D+00 0.4128437946733109D+00 0.4135967563691830D+00 0.4144265383542618D+00 0.4152798507802485D+00 - 0.4160727543455954D+00 0.4168443361905292D+00 0.4176196198077672D+00 0.4183827611972710D+00 0.4191184768538289D+00 - 0.4198587668692242D+00 0.4206087112813905D+00 0.4213231360044953D+00 0.4221028116440456D+00 0.4229058916538999D+00 - 0.4236638306659916D+00 0.4244089362778297D+00 0.4252035110475846D+00 0.4259866514237744D+00 0.4267483307387149D+00 - 0.4275514645494385D+00 0.4282772700648770D+00 0.4289765524308536D+00 0.4297554772863438D+00 0.4305339612773749D+00 - 0.4313040698411803D+00 0.4320729324406116D+00 0.4329094309439377D+00 0.4337274897485148D+00 0.4344773552598177D+00 - 0.4352630485384011D+00 0.4360890425864098D+00 0.4369452655514549D+00 0.4378088281299269D+00 0.4386558762899915D+00 - 0.4394274567025040D+00 0.4402173638821532D+00 0.4411350111460248D+00 0.4417382761530301D+00 0.4425535435447425D+00 - 0.4434067607395547D+00 0.4441684088934558D+00 0.4449541375751532D+00 0.4457813509844927D+00 0.4466744941562319D+00 - 0.4475650847529674D+00 0.4484369212772726D+00 0.4493766667999494D+00 0.4503636826683095D+00 0.4512773117024896D+00 - 0.4521766816699933D+00 0.4531036406653028D+00 0.4540301648966698D+00 0.4549961214964559D+00 0.4559829297118380D+00 - 0.4569474787864105D+00 0.4579167247678587D+00 0.4589312393721260D+00 0.4598758660686987D+00 0.4607818190864602D+00 - 0.4617725997057624D+00 0.4627197598147116D+00 0.4636349596640613D+00 0.4646266150388778D+00 0.4656275914399453D+00 - 0.4666177925958735D+00 0.4676587443222741D+00 0.4687375222754701D+00 0.4697416885123648D+00 0.4706675673746014D+00 - 0.4717749505075855D+00 0.4729630206213525D+00 0.4740409877541912D+00 0.4750529130164043D+00 0.4761627460998637D+00 - 0.4773985108576357D+00 0.4785506731735014D+00 0.4797541793327378D+00 0.4809616515643036D+00 0.4821258084924127D+00 - 0.4832518710338347D+00 0.4843136550958258D+00 0.4854318307540136D+00 0.4865785610648274D+00 0.4874228113540964D+00 - 0.4886191301925280D+00 0.4898695553187771D+00 0.4911226782575756D+00 0.4923496663307474D+00 0.4936717175255192D+00 - 0.4949058806054035D+00 0.4961498591932103D+00 0.4974219244852590D+00 0.4989270796165892D+00 0.5005406795119266D+00 - 0.5022327822527708D+00 0.5038438004615194D+00 0.5055861251514389D+00 0.5072812995521353D+00 0.5091653451295618D+00 - 0.5110784184468948D+00 0.5129451112547958D+00 0.5147873332870051D+00 0.5166659889235693D+00 0.5188597319523366D+00 - 0.5207855786184589D+00 0.5228857981726626D+00 0.5245872747962336D+00 0.5268412109505295D+00 0.5294691780590199D+00 - 0.5314545316577270D+00 0.5338072296525470D+00 0.5364200310608331D+00 0.5388584023001513D+00 0.5420741472990854D+00 - 0.5453294406142675D+00 0.5489988102683218D+00 0.5524594959185068D+00 0.5559764144606353D+00 0.5585824685254285D+00 - 0.5630708128021235D+00 0.5682013088367587D+00 0.5740992853741592D+00 0.5805278394224155D+00 0.5877318763469305D+00 - 0.5974856397552762D+00 0.6086598760692927D+00 0.6274104135789687D+00 0.6971854300685926D+00 0.1000000000000000D+01 - 0.4235907709281081D-02 0.9016345800075341D-02 0.1318228344825811D-01 0.1729240269828394D-01 0.2182382193654247D-01 - 0.2607736959573045D-01 0.3054704413582982D-01 0.3497250406201320D-01 0.3927595247602832D-01 0.4327259691036321D-01 - 0.4645189044836728D-01 0.4982873213857004D-01 0.5459292523788290D-01 0.5867390118505885D-01 0.6257204856697307D-01 - 0.6699786173510096D-01 0.7095243463300606D-01 0.7527245687772148D-01 0.7948979824919616D-01 0.8346764556670760D-01 - 0.8752058346420387D-01 0.9102512915006306D-01 0.9503427137367740D-01 0.9864236964700665D-01 0.1021705940014580D+00 - 0.1057951187678179D+00 0.1091832179803636D+00 0.1124034736928196D+00 0.1162635431496056D+00 0.1205492306773760D+00 - 0.1246463663830530D+00 0.1284059114509634D+00 0.1320244625830475D+00 0.1360851707188556D+00 0.1401328523834871D+00 - 0.1439154253300756D+00 0.1473275765824545D+00 0.1514302662306037D+00 0.1553816493018692D+00 0.1590900023724535D+00 - 0.1628231431063195D+00 0.1669728650256180D+00 0.1702811132473570D+00 0.1730076594594994D+00 0.1756346449159125D+00 - 0.1791454488755706D+00 0.1830108247710020D+00 0.1868082777750852D+00 0.1909479114161122D+00 0.1949952950127057D+00 - 0.1988359170473364D+00 0.2028482691899234D+00 0.2064438241657453D+00 0.2106955513651611D+00 0.2143513069547132D+00 - 0.2178645007368862D+00 0.2219916505692835D+00 0.2258350647055168D+00 0.2297485498366144D+00 0.2339876249824296D+00 - 0.2380137488542541D+00 0.2423331835036287D+00 0.2462427344802279D+00 0.2491160499880685D+00 0.2525594931134775D+00 - 0.2567750520393561D+00 0.2611669234311531D+00 0.2654262135280179D+00 0.2694382869615011D+00 0.2735220613957350D+00 - 0.2768890979098328D+00 0.2803152650829382D+00 0.2841656263346590D+00 0.2880931293249956D+00 0.2920160250610773D+00 - 0.2958579999404533D+00 0.2997509546680263D+00 0.3035005701919487D+00 0.3074844933432547D+00 0.3108468877813114D+00 - 0.3148944193860145D+00 0.3189345271172587D+00 0.3229677783673377D+00 0.3267776666750791D+00 0.3309836203186262D+00 - 0.3353881280351630D+00 0.3395434040418553D+00 0.3435516156597229D+00 0.3475237123913887D+00 0.3509803731790104D+00 - 0.3547147915387369D+00 0.3584838811770673D+00 0.3624497568179550D+00 0.3663972613538022D+00 0.3701898473341641D+00 - 0.3744376712231650D+00 0.3788209560469529D+00 0.3825548789194319D+00 0.3863966278980163D+00 0.3903203003135309D+00 - 0.3943102474467497D+00 0.3984271331596405D+00 0.4025590699659468D+00 0.4067063916066174D+00 0.4109371734205871D+00 - 0.4154750259108851D+00 0.4202552170976041D+00 0.4246668175994520D+00 0.4290283426297089D+00 0.4332582709882489D+00 - 0.4377400650367732D+00 0.4421557910213957D+00 0.4461289990008823D+00 0.4503964117535819D+00 0.4550500280093130D+00 - 0.4596650669766411D+00 0.4634541840982387D+00 0.4672986992773986D+00 0.4718927667646277D+00 0.4763572885689886D+00 - 0.4808895099560491D+00 0.4854578987332236D+00 0.4898426656755198D+00 0.4942626585767694D+00 0.4987366328652014D+00 - 0.5031168752328002D+00 0.5074393358117261D+00 0.5117467117850977D+00 0.5161056223005468D+00 0.5201485179174212D+00 - 0.5244001712846266D+00 0.5283317487337323D+00 0.5320111571524437D+00 0.5360994738899850D+00 0.5405211864476061D+00 - 0.5449270227429602D+00 0.5494148202855902D+00 0.5539362870863163D+00 0.5582625903445537D+00 0.5624310282635551D+00 - 0.5666007402683136D+00 0.5707144948916477D+00 0.5747870915248701D+00 0.5785548798139791D+00 0.5817772655851950D+00 - 0.5854885443385394D+00 0.5896019954030699D+00 0.5935434128788970D+00 0.5971241686827201D+00 0.6012043307757017D+00 - 0.6055436028377490D+00 0.6097885715699457D+00 0.6141878069767216D+00 0.6187866897134979D+00 0.6234190023915391D+00 - 0.6276360746877614D+00 0.6316879444808301D+00 0.6359180193597149D+00 0.6401443592163972D+00 0.6442392264917483D+00 - 0.6480992710593185D+00 0.6520694670460452D+00 0.6561721361473206D+00 0.6597834737910837D+00 0.6636367123613742D+00 - 0.6675628040016263D+00 0.6720627605994098D+00 0.6759255563702116D+00 0.6802972011142955D+00 0.6841484259100313D+00 - 0.6884642287162304D+00 0.6925454329660805D+00 0.6968930725437168D+00 0.7012529707918140D+00 0.7053437907206460D+00 - 0.7092554306768979D+00 0.7133789402792299D+00 0.7172576137361399D+00 0.7210393749715470D+00 0.7249305089887772D+00 - 0.7286690638323010D+00 0.7321004449129358D+00 0.7363094785062793D+00 0.7405092229488761D+00 0.7448237121381639D+00 - 0.7488626660223685D+00 0.7529014448046663D+00 0.7569337171007161D+00 0.7607080130465774D+00 0.7647783055116144D+00 - 0.7687900249939849D+00 0.7731041114574474D+00 0.7771914830343651D+00 0.7813679980114754D+00 0.7854385092415289D+00 - 0.7892768800758903D+00 0.7931790352489735D+00 0.7971720242325592D+00 0.8010668322976509D+00 0.8047048621653128D+00 - 0.8079682541626296D+00 0.8115259512638973D+00 0.8154528296486139D+00 0.8196129900091480D+00 0.8233024858542941D+00 - 0.8277185330724421D+00 0.8315910004263055D+00 0.8354412942451842D+00 0.8396699105929367D+00 0.8435118489902232D+00 - 0.8474971730335568D+00 0.8520724310369839D+00 0.8563463416097422D+00 0.8602299068221597D+00 0.8641408075387064D+00 - 0.8678901117200062D+00 0.8714871505510144D+00 0.8739438245380772D+00 0.8774653087050595D+00 0.8815015972319962D+00 - 0.8857097473875468D+00 0.8895113956827797D+00 0.8934134329763622D+00 0.8977116660034727D+00 0.9019462298613937D+00 - 0.9059687649900224D+00 0.9093172798768443D+00 0.9126287766024019D+00 0.9157213746147260D+00 0.9189163140746259D+00 - 0.9222941292865450D+00 0.9264135484839786D+00 0.9306181581342562D+00 0.9346972038929506D+00 0.9386393922178169D+00 - 0.9428546377643983D+00 0.9470565119166057D+00 0.9512637567296361D+00 0.9547544876362154D+00 0.9583143276993404D+00 - 0.9625159515343749D+00 0.9667765167731320D+00 0.9705290128904140D+00 0.9745061264137413D+00 0.9785015787062253D+00 - 0.9832186137326855D+00 0.9880102348075407D+00 0.9924393048695874D+00 0.9967649747098446D+00 0.1000000000000000D+01 - 0.4184806800123115D-02 0.8093175602958289D-02 0.1235899765693345D-01 0.1673829996542430D-01 0.2120061055197298D-01 - 0.2512029179266618D-01 0.2912626037849941D-01 0.3307775964447663D-01 0.3687702008577837D-01 0.4100486015112748D-01 - 0.4554045948350358D-01 0.4971686215356085D-01 0.5373820644322064D-01 0.5782476149269025D-01 0.6176999728640467D-01 - 0.6583084266244207D-01 0.6988541103003357D-01 0.7383590796430535D-01 0.7749683956313895D-01 0.8156619484384807D-01 - 0.8543294031194018D-01 0.8975275295632437D-01 0.9402112760921609D-01 0.9797747398152003D-01 0.1018355114068996D+00 - 0.1060098068216996D+00 0.1100412714721705D+00 0.1136657129682665D+00 0.1174192780613658D+00 0.1212004538355221D+00 - 0.1245975249188357D+00 0.1287198258345345D+00 0.1318248643862864D+00 0.1358001793819930D+00 0.1394059976366022D+00 - 0.1430564393368881D+00 0.1469627322573576D+00 0.1508840520385843D+00 0.1545189092464699D+00 0.1584351933146977D+00 - 0.1624017408385714D+00 0.1664917314540044D+00 0.1702830433219628D+00 0.1748023869332422D+00 0.1789810689118874D+00 - 0.1823776865821963D+00 0.1864226727208947D+00 0.1905696060531560D+00 0.1944474216755940D+00 0.1987164731248992D+00 - 0.2019381444500117D+00 0.2053536017278014D+00 0.2090760814570430D+00 0.2128773028207504D+00 0.2170426577693954D+00 - 0.2214801575255243D+00 0.2256105956398628D+00 0.2299103899301394D+00 0.2345533412286273D+00 0.2391385386345456D+00 - 0.2438094842550932D+00 0.2480625532228660D+00 0.2517761235345884D+00 0.2558277083042562D+00 0.2602526390423964D+00 - 0.2643704489395528D+00 0.2679390650647137D+00 0.2722294201823511D+00 0.2761219549179550D+00 0.2805430700482080D+00 - 0.2848807347429568D+00 0.2889124657984622D+00 0.2931214733368523D+00 0.2971253761256864D+00 0.3014808499033530D+00 - 0.3057206054703738D+00 0.3096606512601737D+00 0.3140999295096620D+00 0.3183516200792957D+00 0.3226534879476030D+00 - 0.3267767053025691D+00 0.3308741058373194D+00 0.3352286058146513D+00 0.3389835135982953D+00 0.3427450080366363D+00 - 0.3466334448389930D+00 0.3508215480646713D+00 0.3550965882073863D+00 0.3591634395741318D+00 0.3629196381701170D+00 - 0.3668164003773035D+00 0.3709002258023101D+00 0.3747771382400873D+00 0.3788057339023101D+00 0.3826116474542965D+00 - 0.3863143337650549D+00 0.3900080102755522D+00 0.3935530624142387D+00 0.3976592093671950D+00 0.4016808734428158D+00 - 0.4055408055727925D+00 0.4095388506350103D+00 0.4138360294554724D+00 0.4177408891885747D+00 0.4215264707146258D+00 - 0.4254765468812008D+00 0.4296987889746363D+00 0.4340050270133795D+00 0.4374127522542285D+00 0.4411214124426743D+00 - 0.4454362452800729D+00 0.4492469962319036D+00 0.4528781697071717D+00 0.4567400757636192D+00 0.4608397979141173D+00 - 0.4648858683846886D+00 0.4688196933058726D+00 0.4726312396764361D+00 0.4766389363745125D+00 0.4807962860336006D+00 - 0.4846646122089625D+00 0.4885887901919752D+00 0.4927036803860808D+00 0.4970390442650820D+00 0.5016787965559096D+00 - 0.5062519346233255D+00 0.5104073563992307D+00 0.5142422932361366D+00 0.5184164807664137D+00 0.5225454965519558D+00 - 0.5269877907130648D+00 0.5316435226608388D+00 0.5362521573367034D+00 0.5409780524502605D+00 0.5452061510777358D+00 - 0.5496170920090701D+00 0.5540101721277720D+00 0.5577306046139850D+00 0.5609257916463969D+00 0.5645317480870173D+00 - 0.5683988533321430D+00 0.5723763031289929D+00 0.5763731964613529D+00 0.5802989500337071D+00 0.5844787583810057D+00 - 0.5888347281853651D+00 0.5930287066081666D+00 0.5971171699523842D+00 0.6010988336405384D+00 0.6049405461691542D+00 - 0.6087479420918169D+00 0.6124085712877850D+00 0.6158623041056988D+00 0.6198189721340605D+00 0.6236704962544480D+00 - 0.6277952070103462D+00 0.6315059329148256D+00 0.6353459337043795D+00 0.6394596556647144D+00 0.6434768474515148D+00 - 0.6474452753253095D+00 0.6515139546352168D+00 0.6557504878353607D+00 0.6601196217948345D+00 0.6641195138333150D+00 - 0.6684863619332745D+00 0.6729933073500287D+00 0.6773240006870314D+00 0.6813406249462880D+00 0.6851985849308461D+00 - 0.6891436550597436D+00 0.6933163166625554D+00 0.6969213120104845D+00 0.7004303827064954D+00 0.7044211441383509D+00 - 0.7090551479134598D+00 0.7133053018700461D+00 0.7170222415548725D+00 0.7210767895414022D+00 0.7255873229234420D+00 - 0.7303753098464445D+00 0.7350711236063519D+00 0.7393069585146613D+00 0.7433520383222022D+00 0.7474422006135417D+00 - 0.7517172560892437D+00 0.7559414140470475D+00 0.7596924791865521D+00 0.7634144948389316D+00 0.7674525769524009D+00 - 0.7713562027614828D+00 0.7757420387658939D+00 0.7799984605471471D+00 0.7833157205252194D+00 0.7873988566352160D+00 - 0.7911311298153757D+00 0.7953668884031310D+00 0.8000351192406457D+00 0.8047167895064357D+00 0.8077649349338706D+00 - 0.8108689833719910D+00 0.8147407519827548D+00 0.8178695964019139D+00 0.8219464564378761D+00 0.8260553497655184D+00 - 0.8299344331633018D+00 0.8338946084363589D+00 0.8381019725222485D+00 0.8420757009378480D+00 0.8460460496342137D+00 - 0.8502202061579864D+00 0.8539717592907372D+00 0.8575562918267187D+00 0.8613862150287556D+00 0.8650309078525591D+00 - 0.8690609556816115D+00 0.8730458920783356D+00 0.8768987865473390D+00 0.8806189505955925D+00 0.8841181787206894D+00 - 0.8881391470037241D+00 0.8922426396326381D+00 0.8964006228494896D+00 0.9003520598168371D+00 0.9044047675061826D+00 - 0.9084418821899264D+00 0.9124923841416396D+00 0.9164470882753541D+00 0.9204284538095789D+00 0.9245082291146129D+00 - 0.9281850277974589D+00 0.9314555788194153D+00 0.9338867104322366D+00 0.9366266600982778D+00 0.9405933913084950D+00 - 0.9445483409066048D+00 0.9486200935557315D+00 0.9524655726133940D+00 0.9565716517567189D+00 0.9609581951149819D+00 - 0.9648172424262229D+00 0.9689537302596872D+00 0.9729554979169138D+00 0.9765134677868930D+00 0.9801858013653769D+00 - 0.9839656283672670D+00 0.9879896836273796D+00 0.9923709025435258D+00 0.9957277430847883D+00 0.1000000000000000D+01 - 0.2478662803965230D-03 0.4960597437753054D-03 0.6898708704573454D-03 0.9321683206496095D-03 0.1169910303207043D-02 - 0.1404202336382798D-02 0.1658764073249326D-02 0.1919277579977454D-02 0.2167229923659416D-02 0.2419883093572966D-02 - 0.2673606684210090D-02 0.2939684808792027D-02 0.3249669789273893D-02 0.3512464576400434D-02 0.3754914285744669D-02 - 0.4011888286512494D-02 0.4284551780106448D-02 0.4540473102918168D-02 0.4867249268552971D-02 0.5160656113456195D-02 - 0.5458479116199774D-02 0.5769244070274462D-02 0.6075309656604892D-02 0.6372463077186627D-02 0.6683371780262634D-02 - 0.7037214837595204D-02 0.7400011393521580D-02 0.7768742102429356D-02 0.8157309962828201D-02 0.8509130688880208D-02 - 0.8840027995263060D-02 0.9220316133109223D-02 0.9539122092657937D-02 0.9870523018982190D-02 0.1017062565318160D-01 - 0.1050189728352644D-01 0.1084946121805024D-01 0.1124976069020992D-01 0.1169709382790037D-01 0.1213350905376551D-01 - 0.1257518311449574D-01 0.1300969237680400D-01 0.1345772540806279D-01 0.1383274573916373D-01 0.1424328003750502D-01 - 0.1471880585532967D-01 0.1519492650976088D-01 0.1564016211962143D-01 0.1608449748791207D-01 0.1655256050551801D-01 - 0.1700023859708458D-01 0.1746998655676929D-01 0.1796697623145098D-01 0.1849653720942868D-01 0.1901119960475333D-01 - 0.1951767034132225D-01 0.2003176512554604D-01 0.2055665157987728D-01 0.2112725206987176D-01 0.2173100580551044D-01 - 0.2228322865118657D-01 0.2284337289023890D-01 0.2338572624824068D-01 0.2391544132687295D-01 0.2451488939891396D-01 - 0.2515543269419434D-01 0.2580357401373379D-01 0.2641589546864197D-01 0.2707194399166571D-01 0.2767134094526241D-01 - 0.2818955624236441D-01 0.2872730197782444D-01 0.2935194133299601D-01 0.3004295454065525D-01 0.3073116262060433D-01 - 0.3141008753510720D-01 0.3213361627718171D-01 0.3285106429265291D-01 0.3354309226783110D-01 0.3420457017999570D-01 - 0.3486603369195366D-01 0.3555637009044407D-01 0.3625311676581236D-01 0.3698559726003025D-01 0.3779470548544414D-01 - 0.3863228453754435D-01 0.3945050851365285D-01 0.4031330923152966D-01 0.4109880394418827D-01 0.4172115027019401D-01 - 0.4241379461536945D-01 0.4324536135701745D-01 0.4415801371740597D-01 0.4497063217648224D-01 0.4580285696726784D-01 - 0.4672403616587172D-01 0.4754483262567241D-01 0.4845841653352424D-01 0.4935596347170478D-01 0.5030727775853963D-01 - 0.5130142086481606D-01 0.5233680089586460D-01 0.5330983144367071D-01 0.5425859672147162D-01 0.5534496543202296D-01 - 0.5640787542151284D-01 0.5741530487922535D-01 0.5851318477789047D-01 0.5956804736055384D-01 0.6063743658860016D-01 - 0.6169979993977674D-01 0.6293922195391692D-01 0.6414054427295798D-01 0.6528163336068349D-01 0.6635314139618587D-01 - 0.6740956485667912D-01 0.6864401848110191D-01 0.6979940351539904D-01 0.7096581061584400D-01 0.7213444797111228D-01 - 0.7303892581672454D-01 0.7415550835284103D-01 0.7546817075874034D-01 0.7676710267849282D-01 0.7799258297646426D-01 - 0.7928329842463525D-01 0.8058799865100062D-01 0.8190251447476433D-01 0.8326071596283567D-01 0.8465287659299257D-01 - 0.8600162583967232D-01 0.8735543592513975D-01 0.8878492374463809D-01 0.9022228822804435D-01 0.9175096566211706D-01 - 0.9334159099920938D-01 0.9491918833792536D-01 0.9653489112409219D-01 0.9805325186523686D-01 0.9940621530486182D-01 - 0.1008631742780906D+00 0.1024022790380101D+00 0.1038224005337382D+00 0.1052380625559143D+00 0.1067889961534161D+00 - 0.1084617622748398D+00 0.1101620602884086D+00 0.1119092316329496D+00 0.1136594185157453D+00 0.1154549780471971D+00 - 0.1172471711484352D+00 0.1189527518695256D+00 0.1207051274673068D+00 0.1224558426855003D+00 0.1241161993525722D+00 - 0.1258252607894236D+00 0.1276392378903331D+00 0.1292321078384869D+00 0.1306336483959069D+00 0.1319411292541229D+00 - 0.1336027792924980D+00 0.1355244323784908D+00 0.1374862050500389D+00 0.1396217098331977D+00 0.1417359852382286D+00 - 0.1437912728380437D+00 0.1458564936870320D+00 0.1478964485909064D+00 0.1499627531951251D+00 0.1519999412108963D+00 - 0.1539299241644871D+00 0.1558489766951658D+00 0.1579644498790710D+00 0.1601217960164596D+00 0.1623934504257786D+00 - 0.1647025856587268D+00 0.1668471183045077D+00 0.1690820501539503D+00 0.1714573279093907D+00 0.1737345856172913D+00 - 0.1759995847580241D+00 0.1784187343371215D+00 0.1809946131022085D+00 0.1835566295911622D+00 0.1858266775024962D+00 - 0.1880852827086448D+00 0.1906148490077030D+00 0.1930711185290391D+00 0.1956661021637789D+00 0.1983208222415751D+00 - 0.2010868766549549D+00 0.2036666364870147D+00 0.2063023413954337D+00 0.2089872765038899D+00 0.2115769339033240D+00 - 0.2143170806864032D+00 0.2170721987893599D+00 0.2198565713894026D+00 0.2229992538289869D+00 0.2260759472476340D+00 - 0.2288842407142868D+00 0.2317611234487846D+00 0.2347416431746868D+00 0.2377701718537569D+00 0.2409683934554335D+00 - 0.2441289566446296D+00 0.2474098350585475D+00 0.2509186832706864D+00 0.2543072303857564D+00 0.2577197417699417D+00 - 0.2610562243711369D+00 0.2642183831959472D+00 0.2675436102127878D+00 0.2710461266256312D+00 0.2746874479834469D+00 - 0.2784016569101926D+00 0.2821762940258869D+00 0.2861334965300994D+00 0.2900621105206254D+00 0.2941611321330300D+00 - 0.2978437793044671D+00 0.3015125684445300D+00 0.3051955585687680D+00 0.3092609463569091D+00 0.3128517203210632D+00 - 0.3170661848877616D+00 0.3215979580264361D+00 0.3267095979472054D+00 0.3315678245288201D+00 0.3363642363760511D+00 - 0.3412587018716124D+00 0.3461849682858832D+00 0.3513958929628729D+00 0.3567857464077558D+00 0.3622386616285577D+00 - 0.3687244474899918D+00 0.3759365576335467D+00 0.3828775206153951D+00 0.3900346935595422D+00 0.3975013537690213D+00 - 0.4053720874004182D+00 0.4148358095217482D+00 0.4239889239797549D+00 0.4347849794286403D+00 0.4488964111744437D+00 - 0.4625441963546598D+00 0.4812619513087145D+00 0.5055770311014205D+00 0.6752776323932790D+00 0.1000000000000000D+01 - 0.2617179393681630D-03 0.5105108824441934D-03 0.7675631056774188D-03 0.1015456341101029D-02 0.1263723859816776D-02 - 0.1488688022112482D-02 0.1756282673690566D-02 0.2032165385530968D-02 0.2319891175488443D-02 0.2615968203843129D-02 - 0.2857368042128844D-02 0.3124265816953388D-02 0.3427646758562523D-02 0.3685072529171027D-02 0.3928432141036011D-02 - 0.4185125105138992D-02 0.4463952503365671D-02 0.4751999314631856D-02 0.5039779599642390D-02 0.5350706836766358D-02 - 0.5688697692077195D-02 0.6016752277672538D-02 0.6357147373932354D-02 0.6697910481828153D-02 0.7041339466164098D-02 - 0.7400871400034361D-02 0.7770039825730041D-02 0.8145616583448465D-02 0.8520618762306816D-02 0.8825955746584846D-02 - 0.9105009209639421D-02 0.9410704818100553D-02 0.9789836124622295D-02 0.1018201288383995D-01 0.1055665496891020D-01 - 0.1096314827433794D-01 0.1136921682209890D-01 0.1173982280290213D-01 0.1213481958828905D-01 0.1262548206188321D-01 - 0.1305121232234664D-01 0.1345963274718563D-01 0.1389883880933744D-01 0.1426015726548356D-01 0.1468851719588704D-01 - 0.1512816497412383D-01 0.1553211205785539D-01 0.1596568438703603D-01 0.1641429068944607D-01 0.1685810331611487D-01 - 0.1733272919679983D-01 0.1784640856624492D-01 0.1840080998644450D-01 0.1890522801915097D-01 0.1940140877019977D-01 - 0.1998456373457531D-01 0.2052723846603834D-01 0.2104535116648026D-01 0.2151603209799991D-01 0.2203933921301142D-01 - 0.2260066191756231D-01 0.2309251697233540D-01 0.2367940547089087D-01 0.2429364609801999D-01 0.2492541540413350D-01 - 0.2552178816759635D-01 0.2615669325830770D-01 0.2683366427974728D-01 0.2744691204408504D-01 0.2813742819414415D-01 - 0.2877772653311626D-01 0.2943447642485297D-01 0.3011292087049592D-01 0.3075066928646276D-01 0.3142493846938013D-01 - 0.3216308040979924D-01 0.3289834792200598D-01 0.3361987956899343D-01 0.3425773338713035D-01 0.3501258579838697D-01 - 0.3570712514072589D-01 0.3644365807694615D-01 0.3724704447492456D-01 0.3808659716920993D-01 0.3890323226116776D-01 - 0.3972987297331550D-01 0.4051676824632997D-01 0.4132273563975961D-01 0.4222714790499104D-01 0.4307870410158050D-01 - 0.4396783694806457D-01 0.4476862006312305D-01 0.4555214259204260D-01 0.4646017013624276D-01 0.4741576603153758D-01 - 0.4828971270732902D-01 0.4927756045306071D-01 0.5022972068336744D-01 0.5128965917031665D-01 0.5226719451411314D-01 - 0.5325993050189588D-01 0.5432249417440763D-01 0.5535779051028968D-01 0.5638955530668733D-01 0.5742498421250267D-01 - 0.5836500222917726D-01 0.5954914592135653D-01 0.6074878614173247D-01 0.6184269836196018D-01 0.6292199199363480D-01 - 0.6402187744265661D-01 0.6517766340982986D-01 0.6632304748333424D-01 0.6757218722630330D-01 0.6880613444912109D-01 - 0.7008272247356416D-01 0.7141134442565897D-01 0.7273615186609302D-01 0.7402520582600208D-01 0.7542743710581933D-01 - 0.7689678837317185D-01 0.7832143666680719D-01 0.7962075248940939D-01 0.8097668420326794D-01 0.8230022190053744D-01 - 0.8368727462871629D-01 0.8503646961792422D-01 0.8643604505414859D-01 0.8783419110810188D-01 0.8924221673406442D-01 - 0.9074914771869205D-01 0.9232176124898031D-01 0.9379667193233260D-01 0.9525060055192666D-01 0.9677377789906089D-01 - 0.9827936856410595D-01 0.9976827372805222D-01 0.1012252445609410D+00 0.1029565504534593D+00 0.1044952585736160D+00 - 0.1060333878038748D+00 0.1076809125576206D+00 0.1094363324743496D+00 0.1113073931278638D+00 0.1131310017866415D+00 - 0.1148787323265833D+00 0.1167548000789204D+00 0.1185574610305276D+00 0.1204956495495252D+00 0.1224906606596631D+00 - 0.1243361958266386D+00 0.1261433873712477D+00 0.1279204042024157D+00 0.1296718766708938D+00 0.1314882067320164D+00 - 0.1334163805659455D+00 0.1354985667765093D+00 0.1373609508864916D+00 0.1393726788380466D+00 0.1415439394788962D+00 - 0.1435539146680909D+00 0.1456862083932162D+00 0.1477540052470225D+00 0.1499080633522044D+00 0.1520188989541187D+00 - 0.1541274433130030D+00 0.1562892043464824D+00 0.1584940637127435D+00 0.1605331783405279D+00 0.1626423505892621D+00 - 0.1647448334589047D+00 0.1668119287982270D+00 0.1688711888227405D+00 0.1711340502207749D+00 0.1733795594030198D+00 - 0.1755492390701928D+00 0.1777295846999908D+00 0.1798541243067857D+00 0.1818277105745161D+00 0.1838641696601343D+00 - 0.1861843329752698D+00 0.1886450184271586D+00 0.1910953158473134D+00 0.1936446810020999D+00 0.1961535383759362D+00 - 0.1985325540134046D+00 0.2009922356346375D+00 0.2035957012398456D+00 0.2062757783016775D+00 0.2089112974123292D+00 - 0.2114405971481492D+00 0.2141310257945268D+00 0.2170417782361111D+00 0.2198641727845656D+00 0.2226401197447620D+00 - 0.2253781446666266D+00 0.2281606237758921D+00 0.2308457523530024D+00 0.2337850445530229D+00 0.2368084095510109D+00 - 0.2400075716529844D+00 0.2431986714758152D+00 0.2462391391127607D+00 0.2494204193622607D+00 0.2526045203455821D+00 - 0.2557736377351049D+00 0.2589621771694714D+00 0.2622603267852878D+00 0.2657720472893783D+00 0.2690884926899592D+00 - 0.2722869692946756D+00 0.2754657339813029D+00 0.2787912357796142D+00 0.2824664205487599D+00 0.2862784120327120D+00 - 0.2898851309567306D+00 0.2932888260982714D+00 0.2963837136895661D+00 0.2998430013648803D+00 0.3036355437422465D+00 - 0.3073212135935200D+00 0.3112921945427334D+00 0.3152852689729475D+00 0.3191568557333642D+00 0.3234940989277719D+00 - 0.3273639131897406D+00 0.3317892275776938D+00 0.3362159930179097D+00 0.3406484253521175D+00 0.3444709696562446D+00 - 0.3475902104433078D+00 0.3518302916938842D+00 0.3564776204405102D+00 0.3612046283237316D+00 0.3660225765288292D+00 - 0.3718328846633646D+00 0.3781416738723297D+00 0.3843198303004377D+00 0.3900463764097046D+00 0.3959674267794694D+00 - 0.4027871248670467D+00 0.4099344793401641D+00 0.4178029098116909D+00 0.4264131451579094D+00 0.4350028082319549D+00 - 0.4444463996220371D+00 0.4587117495612665D+00 0.4847398669489272D+00 0.5231984748015380D+00 0.1000000000000000D+01 - 0.4964805466039611D+01 0.8282616908754239D+01 0.4622311494159756D+01 0.5380327024325166D+01 0.3981407762277931D+01 - 0.6213628061986032D+01 0.4692383881428178D+01 0.8575883876159951D+01 0.5799405796330084D+01 0.5422381968539579D+01 - 0.4477714151936341D+01 0.5697970308849823D+01 0.3926444109972273D+01 0.4976460073141570D+01 0.6225933350576786D+01 - 0.5841141514281402D+01 0.5314230137119381D+01 0.8385035243398491D+01 0.6116153426801699D+01 0.6569922038388133D+01 - 0.5189108755962528D+01 0.5102465393168153D+01 0.5479426471577808D+01 0.5318407255706053D+01 0.7438065430084635D+01 - 0.5866357876157051D+01 0.7481677016508344D+01 0.5328918864251389D+01 0.5195516661477325D+01 0.6960915962695529D+01 - 0.6762890588779984D+01 0.8675356329746672D+01 0.6438364520439518D+01 0.7287374379103358D+01 0.7236475439729237D+01 - 0.7310078590458628D+01 0.5633214881133505D+01 0.8175377326890899D+01 0.6895700829827039D+01 0.6862536478448999D+01 - 0.5735135976187487D+01 0.7184782380733838D+01 0.7891175782260444D+01 0.7554653080162063D+01 0.6171725862332456D+01 - 0.5782116911774147D+01 0.7002214557183017D+01 0.7386893806863930D+01 0.7964966856900619D+01 0.6915748239515249D+01 - 0.6513365675677161D+01 0.6015346883480547D+01 0.6646892570075969D+01 0.7070333798542367D+01 0.7608354066843495D+01 - 0.9022297643394458D+01 0.6968792374507638D+01 0.7726749355540226D+01 0.5568855500324554D+01 0.1117142482010857D+02 - 0.6973646005893634D+01 0.7315643675275758D+01 0.7304422391729791D+01 0.7148473929717209D+01 0.7132343753730538D+01 - 0.5791561156142834D+01 0.7435470861198792D+01 0.7642178183280605D+01 0.6949729783673626D+01 0.5669759642094360D+01 - 0.6916074968243996D+01 0.7566853088308578D+01 0.7737467184832227D+01 0.7641271339064346D+01 0.7720636254585702D+01 - 0.8378632921427512D+01 0.6261492865033101D+01 0.7889581690047695D+01 0.8773979764988987D+01 0.7878716931652551D+01 - 0.7448320723478416D+01 0.9267313857465133D+01 0.8722871203185017D+01 0.8209259321409419D+01 0.6943817816773946D+01 - 0.9680182080858584D+01 0.9998854784136888D+01 0.7434843095196258D+01 0.6357994915743170D+01 0.8595991320902613D+01 - 0.1078402985339821D+02 0.1086365875398790D+02 0.7218133898439470D+01 0.8235799129526862D+01 0.7385135270883400D+01 - 0.3482224557998705D+01 0.3829325215071595D+01 0.7289912348391206D+01 0.7148388648992405D+01 0.8233260509690679D+01 - 0.1054869748373875D+02 0.1073612495950903D+02 0.9500377747455056D+01 0.8520714853999333D+01 0.9184457012137903D+01 - 0.8121623306177296D+01 0.7950124112417050D+01 0.1078522872740708D+02 0.9870793747003857D+01 0.7693749339372715D+01 - 0.9115340525833551D+01 0.7548844295318768D+01 0.9467452934257715D+01 0.8913024287866625D+01 0.9230162737713339D+01 - 0.9447810289604206D+01 0.8231783561049818D+01 0.8882857882487775D+01 0.7595480308296836D+01 0.8272703473327944D+01 - 0.8119584363373880D+01 0.9314041676694947D+01 0.8682162532461216D+01 0.9091549584747446D+01 0.1011170984106806D+02 - 0.9844803431720974D+01 0.9466609563764790D+01 0.8667366662731709D+01 0.9036742533227228D+01 0.8850059146589139D+01 - 0.8586462007938218D+01 0.8944544117134463D+01 0.8831605106774308D+01 0.9351638804803375D+01 0.9455502154335766D+01 - 0.8949915356636176D+01 0.8337798514924454D+01 0.8965612835150081D+01 0.8481767816823361D+01 0.9557585754116623D+01 - 0.9131971813059231D+01 0.9352569597337162D+01 0.1073222973967354D+02 0.8538247502343728D+01 0.9467935097949159D+01 - 0.9905989319919598D+01 0.1093593287238321D+02 0.7565983038487762D+01 0.9977165957719176D+01 0.1140408465495678D+02 - 0.8851881732303541D+01 0.9206152126021818D+01 0.9343356504648199D+01 0.1018853355783327D+02 0.7297468239154574D+01 - 0.1031311029748375D+02 0.1153071416483158D+02 0.8799667899233940D+01 0.1136271522946581D+02 0.1027935767849731D+02 - 0.1015103171108293D+02 0.8923027111209029D+01 0.9288719989937082D+01 0.1026205249476965D+02 0.8559184375403822D+01 - 0.8435816875403312D+01 0.9356694752368755D+01 0.1028201837585897D+02 0.1054955318766913D+02 0.9026035488127164D+01 - 0.1042931784191702D+02 0.9135807072868117D+01 0.9522328155233717D+01 0.9064053196202201D+01 0.9274539163604150D+01 - 0.7581619850097300D+01 0.9613251195033312D+01 0.9868943203125022D+01 0.1199067679068943D+02 0.8154621189966482D+01 - 0.9062438479063115D+01 0.1030646895242013D+02 0.1174316094111798D+02 0.9652824674390686D+01 0.8545117654243732D+01 - 0.1046014713236404D+02 0.9123873115303736D+01 0.1009133009196460D+02 0.7960258789699328D+01 0.9736285772969930D+01 - 0.9378267612370781D+01 0.1047684951318372D+02 0.1065160548770752D+02 0.8609407567018367D+01 0.9801024373913879D+01 - 0.8877784384842329D+01 0.9919654003166876D+01 0.8724126453051994D+01 0.7256706367552056D+01 0.7890464092918320D+01 - 0.1058823069961462D+02 0.1089984644320908D+02 0.9642010403643390D+01 0.8993452939277903D+01 0.8911580754142982D+01 - 0.9659626242552598D+01 0.7248287748342661D+01 0.8291145251275665D+01 0.1025352319315444D+02 0.9444073013675949D+01 - 0.8405194244674998D+01 0.1035046214687425D+02 0.6988644399721523D+01 0.1049858505528034D+02 0.9107369485102517D+01 - 0.7234287916702955D+01 0.6594318614088203D+01 0.6131572176130770D+01 0.7171162423451937D+01 0.7185728261777951D+01 - 0.5046113175131333D+01 0.4785470296452777D+01 0.7049592739795424D+01 0.6468424985963810D+01 0.6467935540798465D+01 - 0.7169130744326250D+01 0.7564584360222979D+01 0.7939465087928077D+01 0.1010077595877274D+02 0.8157300149241696D+01 - 0.5035314073537205D+01 0.6938289449776182D+01 0.6861448241258022D+01 0.6826001495002777D+01 0.7459760912180273D+01 - 0.8771401756648546D+01 0.5706961973151416D+01 0.3899329978427601D+01 0.6037828585540979D+01 0.5292202119006059D+01 - 0.4582527287919298D+01 0.4887615667270341D+01 0.4757711790313851D+01 0.4227326436038011D+01 0.4053156576865331D+01 - 0.4789348947861652D+01 0.3956355619046690D+01 0.5478897059881318D+01 0.5294135624676649D+01 0.2011237861538032D+00 - 0.5724591166405236D+01 0.5015053477338194D+01 0.7010829524377995D+01 0.6013011539367628D+01 0.5480973475241772D+01 - 0.6375770864021124D+01 0.5434733277690290D+01 0.6126366910922681D+01 0.2769337705271691D+01 0.2070409126845567D+01 - 0.3875688449912612D+01 0.6841652792617518D+01 0.5361343191924767D+01 0.6886173506830125D+01 0.7073044811849937D+01 - 0.7194531088762709D+01 0.4739184012165219D+01 0.6145112317589751D+01 0.7571735090942275D+01 0.8144702064001935D+01 - 0.6495104417430613D+01 0.7287347236621843D+01 0.5878677331656033D+01 0.7630416604603700D+01 0.6065802784449383D+01 - 0.5386179100860361D+01 0.6653969127413766D+01 0.5414968501726245D+01 0.6186387461111397D+01 0.6063976271950522D+01 - 0.5288495620179946D+01 0.8073380983455230D+01 0.7507910604877567D+01 0.8384490594711007D+01 0.6258962115771970D+01 - 0.8580510160205083D+01 0.8393404397735825D+01 0.7546357853847304D+01 0.7602055784982005D+01 0.8905709922738790D+01 - 0.6041324093890990D+01 0.6437606311761667D+01 0.6033502926125778D+01 0.5693536081297773D+01 0.6494349723054196D+01 - 0.7804353321828928D+01 0.9586859278935759D+01 0.7470136186352488D+01 0.6776476983570205D+01 0.6481110195654680D+01 - 0.5922381606843214D+01 0.8397524359233655D+01 0.6306513638095128D+01 0.6927241032419633D+01 0.8850666562486673D+01 - 0.8226111480175762D+01 0.8679498965214560D+01 0.7969430133045584D+01 0.7099675406170925D+01 0.6895485569203473D+01 - 0.6077174771587664D+01 0.7478362492030017D+01 0.7989122409164971D+01 0.7000461470978608D+01 0.6322706950581135D+01 - 0.8198022739971369D+01 0.1034492149035788D+02 0.8611821679542023D+01 0.7144342929783909D+01 0.8213385917961768D+01 - 0.9167699053969274D+01 0.8974062289897253D+01 0.7524403560203221D+01 0.7071378913479784D+01 0.8925547825324264D+01 - 0.8509863062016166D+01 0.9777715449373932D+01 0.9519624574711061D+01 0.7138726499006697D+01 0.7936223009214520D+01 - 0.8667034655899590D+01 0.6177376950900226D+01 0.7151487588834887D+01 0.7633781603473102D+01 0.8618605162443984D+01 - 0.9152958999157885D+01 0.9130110493716824D+01 0.8875460226669471D+01 0.7939714053691609D+01 0.8010359390587295D+01 - 0.7479383337654730D+01 0.8835627845969560D+01 0.9277992245184596D+01 0.1069065809900947D+02 0.7713091201624190D+01 - 0.1099562829608450D+02 0.7246030429959019D+01 0.1180076221306124D+02 0.7879664612640009D+01 0.1009652362685254D+02 - 0.9995464015024057D+01 0.9305130363106034D+01 0.8955523929436991D+01 0.9859936334744043D+01 0.9027400480307280D+01 - 0.8784451080377041D+01 0.1021075847712383D+02 0.1017804184480946D+02 0.8217213074306512D+01 0.1023359147149554D+02 - 0.9355039181106447D+01 0.9360098274616103D+01 0.9754725288467441D+01 0.9865952730625482D+01 0.8488107694199112D+01 - 0.6937146927674015D+01 0.7714502574263306D+01 0.8971196003965810D+01 0.8652595543514677D+01 0.8718440328076618D+01 - 0.9089013761493886D+01 0.9762069927112284D+01 0.8590684071029999D+01 0.9055929317053527D+01 0.8937540670428474D+01 - 0.8427490973126950D+01 0.9053389145123269D+01 0.1006908954160963D+02 0.8385086380285516D+01 0.9275932604571638D+01 - 0.9767940138248456D+01 0.1029782466844539D+02 0.8999159844729276D+01 0.1065986656139351D+02 0.9137839493943895D+01 - 0.9234896522983158D+01 0.9206098855818867D+01 0.9941847693248514D+01 0.9538855506474993D+01 0.1091326142425216D+02 - 0.9113626379645535D+01 0.7980388491469061D+01 0.8436217771106858D+01 0.8757210175252538D+01 0.8357159185663471D+01 - 0.9351585919679112D+01 0.8657728508980403D+01 0.1088189487050590D+02 0.9989694697107588D+01 0.9893069878934606D+01 - 0.9011266288795563D+01 0.9433732427479427D+01 0.8605043172428084D+01 0.8119848934925152D+01 0.9086239288316410D+01 - 0.9515893179376267D+01 0.7868084205983989D+01 0.7512387641358521D+01 0.1061091490130289D+02 0.9078298269346735D+01 - 0.9385678318910198D+01 0.9343645673587801D+01 0.8358364350182432D+01 0.9150687811870378D+01 0.8744483306207840D+01 - 0.7344544968808218D+01 0.8061095761493281D+01 0.9226806191319749D+01 0.9572057646156697D+01 0.1043197989517268D+02 - 0.8172832799298627D+01 0.1004208746491275D+02 0.8581846644469950D+01 0.8900115619136374D+01 0.9277523212491651D+01 - 0.8269730420564672D+01 0.6903998045781529D+01 0.8043488190484375D+01 0.8780458774278300D+01 0.7802206916568956D+01 - 0.7851655101196075D+01 0.8315380403987175D+01 0.9009427570395051D+01 0.7914290583344632D+01 0.7727077140158709D+01 - 0.7234543708524431D+01 0.8557968843709904D+01 0.9635111818816078D+01 0.7730045013497437D+01 0.9576383196744416D+01 - 0.8557543064774640D+01 0.9487296103095797D+01 0.9186070426908094D+01 0.7455051195203356D+01 0.8058745207877649D+01 - 0.8379028538938481D+01 0.8235656034854820D+01 0.8688325920347289D+01 0.7214815453060434D+01 0.5877450670721390D+01 - 0.8683479127539400D+01 0.9878053683839601D+01 0.8513488221585600D+01 0.8361148831282367D+01 0.6441633634481465D+01 - 0.7275966517333750D+01 0.6817917459087321D+01 0.7321318760280800D+01 0.6589624582371126D+01 0.5975992312526499D+01 - 0.7090002487612383D+01 0.8159287069817482D+01 0.7718900191780620D+01 0.7978155871063460D+01 0.7668162398236519D+01 - 0.6390505268364733D+01 0.6946181055750863D+01 0.6850165320918148D+01 0.7032901237744717D+01 0.7224418131119769D+01 - 0.7152619262128646D+01 0.6600272927770851D+01 0.5572247409394128D+01 0.7225596312452145D+01 0.5709348445632318D+01 - 0.6222976598648950D+01 0.9496345735505502D+01 0.7022130907350854D+01 0.7130174410424338D+01 0.8250537722801720D+01 - 0.7810088220652422D+01 0.8476478920261854D+01 0.8993663693762290D+01 0.4748397553052314D+01 0.7334610986779662D+01 - 0.7627745708304527D+01 0.7164171392889264D+01 0.5895326211001935D+01 0.6574832460553193D+01 0.7535100483853158D+01 - 0.7658198258275659D+01 0.5672960359912044D+01 0.5727383622565153D+01 0.7554695574859911D+01 0.8119037188290454D+01 - 0.6443846877963480D+01 0.7149485024444618D+01 0.4942473975603630D+01 0.4710266383807070D+01 0.2914822563395461D+00 - 0.1127366180123084D+01 0.2868048685970136D+01 0.3252836557770334D+01 0.3317073702599536D+01 0.5127911926706524D+01 - 0.3912367514235515D+01 0.4122273768699018D+01 0.4006279068729608D+01 0.5297814356630386D+01 0.5075033128316779D+01 - 0.6577013334364901D+01 0.5171611162587472D+01 0.4905096352787770D+01 0.5413574684432288D+01 0.6042531386968927D+01 - 0.5724486063586436D+01 0.5318418254500177D+01 0.7000750602849921D+01 0.5509932496656309D+01 0.6472738167583714D+01 - 0.7676282381093685D+01 0.5223156989414685D+01 0.5700840415678416D+01 0.6445601785633006D+01 0.8659680276769461D+01 - 0.8056654918207906D+01 0.6100173528211735D+01 0.6265843599862611D+01 0.5582606539971473D+01 0.6442100141607580D+01 - 0.6330142985002326D+01 0.7489980776066134D+01 0.7215070691786366D+01 0.6941939970308804D+01 0.6514207014674104D+01 - 0.7045216293063023D+01 0.5904290663939746D+01 0.7504183752968705D+01 0.8663523680815606D+01 0.6757542148473452D+01 - 0.1025579187427501D+02 0.8085756846793437D+01 0.6984815001598513D+01 0.7822731644044151D+01 0.8060401223847432D+01 - 0.1034747949263422D+02 0.8393114741490377D+01 0.8208327450120921D+01 0.8907709412695173D+01 0.8056621516869049D+01 - 0.7910464929021505D+01 0.8409815999916493D+01 0.9706257601465310D+01 0.1125765230944483D+02 0.8244438920097590D+01 - 0.8366408644068070D+01 0.8295983627554474D+01 0.6357842337482392D+01 0.9248480029030935D+01 0.8806213347058273D+01 - 0.8755851403479451D+01 0.1056401939001281D+02 0.7449558453017911D+01 0.9298112503208904D+01 0.1055246409951808D+02 - 0.8648520240278620D+01 0.9840151557525157D+01 0.9074193969254791D+01 0.8262424899707325D+01 0.9034823932111381D+01 - 0.7916732564215259D+01 0.9568062751614059D+01 0.9192872645228915D+01 0.7958705084917381D+01 0.7725596727353261D+01 - 0.8961007618845981D+01 0.7869167797063575D+01 0.8469222849671400D+01 0.7666585329776569D+01 0.7138149211488407D+01 - 0.1062558626111024D+02 0.9304037836142186D+01 0.9135805694242670D+01 0.9144341534341720D+01 0.1065274788360589D+02 - 0.8572396357467797D+01 0.9401141486740734D+01 0.9760817244229568D+01 0.9071163184607400D+01 0.8895993221274223D+01 - 0.9111093931599290D+01 0.6909333659144221D+01 0.7451210292660940D+01 0.8058591268948646D+01 0.6921480839048352D+01 - 0.9327944237867376D+01 0.9105140557554618D+01 0.9517019077559414D+01 0.9703361947835708D+01 0.9656037129153249D+01 - 0.9450485668426552D+01 0.9280905483697586D+01 0.9735072868179547D+01 0.9982708749417501D+01 0.9825294781584457D+01 - 0.9610699888863573D+01 0.9991095167054768D+01 0.9676003910085999D+01 0.9143618556099689D+01 0.1079525638891828D+02 - 0.1055863333363734D+02 0.1132933273745338D+02 0.8864553523039707D+01 0.9768027016836223D+01 0.9885489997377736D+01 - 0.9430130455447147D+01 0.9868353764719476D+01 0.1046143198866776D+02 0.1109590278705634D+02 0.1064486033295811D+02 - 0.9628484990699638D+01 0.8055597239097008D+01 0.7344967594285980D+01 0.8819322475000735D+01 0.7464307656839990D+01 - 0.1005276024229836D+02 0.8301611019711119D+01 0.9362455235531055D+01 0.9653271702066888D+01 0.8805716372196535D+01 - 0.9274203756231250D+01 0.1057450858252252D+02 0.8646473577473092D+01 0.9681259459946842D+01 0.9815914249178212D+01 - 0.8875812083867993D+01 0.1075952944454054D+02 0.1029679735016677D+02 0.5621299518736638D+01 0.4122540804747781D+01 - 0.7047198782881051D+01 0.9790723303200071D+01 0.7806726333390659D+01 0.9628456764160811D+01 0.9211551752161558D+01 - 0.8939350787129007D+01 0.1052711635337343D+02 0.9850501170240046D+01 0.9841976782908326D+01 0.8649575247905615D+01 - 0.1047307596215327D+02 0.9034262398946829D+01 0.9170557178560093D+01 0.9653071965819326D+01 0.1076414440142676D+02 - 0.1045418894665216D+02 0.9967107177421788D+01 0.7943608130097982D+01 0.9048981873508112D+01 0.9464036135526786D+01 - 0.8029587805237004D+01 0.8672716809753993D+01 0.9070730229235298D+01 0.9630765247685122D+01 0.8005843459559744D+01 - 0.1004558209190926D+02 0.8382035773445333D+01 0.9237447541705022D+01 0.1002230380486610D+02 0.8045081856958044D+01 - 0.8110410830535397D+01 0.9897826062408445D+01 0.1099055165416776D+02 0.8030996677957175D+01 0.7608407354965133D+01 - 0.8022194162458247D+01 0.8664928835176575D+01 0.1050965085896852D+02 0.9063346722026139D+01 0.9194306986922756D+01 - 0.7859048898644124D+01 0.9725696165281200D+01 0.8779067162334819D+01 0.9205559813403715D+01 0.7774530652106610D+01 - 0.8819333097767363D+01 0.8710451610347437D+01 0.8128956268117227D+01 0.1040479683797396D+02 0.9800138599097782D+01 - 0.7780993373496404D+01 0.8146553646374898D+01 0.8142953070571616D+01 0.1019700444569243D+02 0.8819414907810906D+01 - 0.7369568752167531D+01 0.8745661969286148D+01 0.6882518128456388D+01 0.8151881261257511D+01 0.7943561747017706D+01 - 0.7659116975250131D+01 0.8521088774641797D+01 0.7287698482394326D+01 0.7798134225992484D+01 0.6163972383220291D+01 - 0.8086464927323007D+01 0.8278408551116161D+01 0.7857795786105555D+01 0.7150362663606950D+01 0.8089339444596995D+01 - 0.8105580971383983D+01 0.7532345578509253D+01 0.8623605742819166D+01 0.8629395041696544D+01 0.8117518850105386D+01 - 0.7145919207889550D+01 0.8591768908604635D+01 0.7901950665211870D+01 0.6265635932370030D+01 0.5925406837614377D+01 - 0.6446747027999027D+01 0.7018120834673396D+01 0.6775264395786751D+01 0.6903470420353142D+01 0.6646406630399937D+01 - 0.5887741096090896D+01 0.4694489767215282D+01 0.4858372390434949D+01 0.4684906820099763D+01 0.7769181703692037D+01 - 0.4830577778647487D+01 0.6700262518770339D+01 0.5530307114411173D+01 0.5319521142431658D+01 0.7334298623198957D+01 - 0.5299312606722589D+01 0.4964756979092450D+01 0.5891761130423369D+01 0.4967253701021921D+01 0.5041897500404610D+01 - 0.3743618174437842D+01 0.3501447459808416D+01 0.3746777523859508D+01 0.3491066099798518D+01 0.5324910254380714D+01 - 0.2315594863918973D+01 0.2405400936807019D+01 0.1349799051122999D+01 0.1631656216750422D+01 0.4844957549424423D+01 - 0.7547907560634195D+01 0.8789671380807956D+01 0.8314686789307411D+01 0.5747203583441787D+01 0.5713806497159797D+01 - 0.7518562930497852D+01 0.9372828358887682D+01 0.8243651547398544D+01 0.8164665078900237D+01 0.8021068566366235D+01 - 0.6245852150810197D+01 0.6552305843668970D+01 0.7348905643038973D+01 0.7447138352056570D+01 0.7500193988370768D+01 - 0.8761559907840818D+01 0.7002252040375096D+01 0.7161024574675224D+01 0.7500246031297716D+01 0.7174855610976928D+01 - 0.6962333300971320D+01 0.7349044006493599D+01 0.5725122926414233D+01 0.5639687325140752D+01 0.7625452502136128D+01 - 0.7515561767393276D+01 0.6670455748278152D+01 0.8120236585410305D+01 0.9218967633818064D+01 0.8948763298941618D+01 - 0.1039830739174662D+02 0.7384828750616359D+01 0.8246218803145592D+01 0.7164327392819820D+01 0.7826265877150733D+01 - 0.8315533962822048D+01 0.8577925665721930D+01 0.7852910371397608D+01 0.6485232447359619D+01 0.6908054418515632D+01 - 0.8137052207151068D+01 0.9318136883330721D+01 0.9243525935967380D+01 0.7713891140573725D+01 0.8225583337610210D+01 - 0.8127846940924389D+01 0.6585976740095295D+01 0.6624897401834639D+01 0.7807014823956297D+01 0.7204568441839745D+01 - 0.7576379589194586D+01 0.8968764904907534D+01 0.1061567805877227D+02 0.9039155247719261D+01 0.9408442498498561D+01 - 0.7936796115874647D+01 0.6834878128012063D+01 0.9412826524148263D+01 0.8643861810196652D+01 0.8700690937743982D+01 - 0.7302803708762758D+01 0.7943109091503499D+01 0.6602477714526113D+01 0.7952692392893419D+01 0.9354488289500443D+01 - 0.7284122228938324D+01 0.5828718687559362D+01 0.6747769843939009D+01 0.7265615251602197D+01 0.7712099744625848D+01 - 0.8696365090060670D+01 0.1029036702594641D+02 0.7234706053332135D+01 0.7161005650237473D+01 0.8158123637806769D+01 - 0.7182735499304712D+01 0.8393291822194533D+01 0.7679672947894333D+01 0.6331248002166181D+01 0.7903508749556281D+01 - 0.6555422608577180D+01 0.8102918015421020D+01 0.6655770786270052D+01 0.7176312134181937D+01 0.8108267823810687D+01 - 0.8821501591235542D+01 0.6326974972010192D+01 0.5239022857756064D+01 0.7830857249165488D+01 0.8459945168462617D+01 - 0.9976048848377236D+01 0.8121716767908641D+01 0.8673320663866566D+01 0.3916399773220815D+01 0.4609111573223903D+01 - 0.8239411529099794D+01 0.6269877506361923D+01 0.8886472281349475D+01 0.9433312316431881D+01 0.8283378452418816D+01 - 0.7741763036187976D+01 0.9186127336752953D+01 0.8508978367526259D+01 0.8672259856470351D+01 0.9546030171061176D+01 - 0.6165401731776554D+01 0.7805852851415533D+01 0.7477512058833086D+01 0.8633242631086681D+01 0.9382109539865860D+01 - 0.7117948691309304D+01 0.9748789213175126D+01 0.9504657113236979D+01 0.7348784303427650D+01 0.8245561308024579D+01 - 0.7004531653230610D+01 0.6819414997789749D+01 0.8300086109374524D+01 0.5260041598785408D+01 0.7819116864585206D+01 - 0.8790184810307988D+01 0.9986532185348095D+01 0.9180155104468589D+01 0.7217912725926541D+01 0.7799350647443892D+01 - 0.6298648591904582D+01 0.8335226175330881D+01 0.9041604707466682D+01 0.7578205424692274D+01 0.9912633384389229D+01 - 0.8436812352502868D+01 0.8265241042086231D+01 0.8323259032224135D+01 0.9041378972155206D+01 0.1002649332880689D+02 - 0.7091288359247584D+01 0.8218161444287972D+01 0.7086885108596516D+01 0.8728323404950251D+01 0.1037405566917677D+02 - 0.6376316301104016D+01 0.6668736232707577D+01 0.9145362392160918D+01 0.6969124114580537D+01 0.7130730682572903D+01 - 0.6200916799375902D+01 0.8361774275965853D+01 0.7515049195251632D+01 0.6657692240632171D+01 0.7035988351177854D+01 - 0.8514718142112478D+01 0.7986294585837394D+01 0.8601767483931525D+01 0.7359732730497875D+01 0.7664865145888061D+01 - 0.9116712327649159D+01 0.7421205442849742D+01 0.1143256484542472D+02 0.8758414435067419D+01 0.8986668722152789D+01 - 0.9062271866880666D+01 0.9176991805523421D+01 0.7665559987953557D+01 0.8986759461278497D+01 0.8482693631138043D+01 - 0.7989303100968312D+01 0.9289669422952993D+01 0.8443934843106616D+01 0.8033484370144237D+01 0.9297977412580423D+01 - 0.9242788393234255D+01 0.8304419879678933D+01 0.8118519925774587D+01 0.9269480249485101D+01 0.8930704388569751D+01 - 0.6872829908060153D+01 0.6936891268206551D+01 0.6460663781041159D+01 0.7680837541874559D+01 0.8941067853619057D+01 - 0.9690632196513963D+01 0.9775412623853134D+01 0.7229690150105589D+01 0.6447013217305258D+01 0.7200749587278341D+01 - 0.1109198422205628D+02 0.6936680398619588D+01 0.6230177507031373D+01 0.5001428074001625D+01 0.5932145815985987D+01 - 0.8913855511254477D+01 0.8510466202556003D+01 0.8693508481841993D+01 0.8223979660647379D+01 0.9236669411875251D+01 - 0.7517983114866338D+01 0.6020575140631045D+01 0.8670344939794274D+01 0.8338511777744676D+01 0.8393313885345222D+01 - 0.6423662749355258D+01 0.8701657570509621D+01 0.9193736158567186D+01 0.7702495841923974D+01 0.6408235986478143D+01 - 0.8363960824236647D+01 0.6958651404930409D+01 0.7424112881185319D+01 0.9386308538980698D+01 0.8493439480539804D+01 - 0.7156784567251001D+01 0.7298870131034256D+01 0.7596484822127519D+01 0.7964848478280222D+01 0.6613454689158863D+01 - 0.6926474577880930D+01 0.9022962419733656D+01 0.8226809822957829D+01 0.9631957242603296D+01 0.9068760325242950D+01 - 0.7726989763179843D+01 0.6617214226902533D+01 0.9717184035550977D+01 0.8760128808080742D+01 0.6025477548314282D+01 - 0.7996720459044763D+01 0.7298269256259060D+01 0.7421521993606961D+01 0.6764695879887591D+01 0.7851610749938981D+01 - 0.8845346929344689D+01 0.9628921919479883D+01 0.9320148714360817D+01 0.7134035087780759D+01 0.8209679550310586D+01 - 0.7660200352318969D+01 0.6074033553777194D+01 0.6982098740868813D+01 0.8396930502245803D+01 0.7357557168994640D+01 - 0.7501071800276399D+01 0.9927721640284428D+01 0.7581408092012174D+01 0.6247820659893074D+01 0.7423152269447743D+01 - 0.7776702632983040D+01 0.7335020089051333D+01 0.5945871310265235D+01 0.8062552023384153D+01 0.7633194943451988D+01 - 0.2750804680774778D+01 0.5826527771400547D+01 0.4734126303012391D+01 0.5888338919511125D+01 0.5766972984564338D+01 - 0.6954632254157548D+01 0.9530753443063553D+01 0.8460579491992938D+01 0.1017086262029020D+02 0.5232381179438828D+01 - 0.6256928891505871D+01 0.8020943443500846D+01 0.7272476289256402D+01 0.7265237183428450D+01 0.8185322178794715D+01 - 0.7501037498050029D+01 0.4936696382305287D+01 0.8952501958568243D+01 0.8292167527637433D+01 0.6928830877119385D+01 - 0.8379794059797996D+01 0.6787109628801188D+01 0.7219609006857948D+01 0.8508322510788066D+01 0.9311758293145093D+01 - 0.8293228865079977D+01 0.8973932698778095D+01 0.7538808620186104D+01 0.6928345335358125D+01 0.7094791144939975D+01 - 0.7988998014113098D+01 0.7457840343192100D+01 0.7791231042055575D+01 0.6423293353818133D+01 0.7920953273705189D+01 - 0.6350180451782789D+01 0.8126783695924312D+01 0.8321816420486272D+01 0.6909079311881070D+01 0.6075987706278767D+01 - 0.8387820333138404D+01 0.7785855552458845D+01 0.7485896477326041D+01 0.7881274283367477D+01 0.7307505744979593D+01 - 0.6478480161653756D+01 0.6509253070118196D+01 0.7012305776784700D+01 0.7510971930302917D+01 0.9711661190282326D+01 - 0.6460340234564798D+01 0.7009366403413820D+01 0.9063302769642219D+01 0.8096548206832100D+01 0.7410711839637167D+01 - 0.8830061858870881D+01 0.8260470120627787D+01 0.6065771838224202D+01 0.7657039327188954D+01 0.1034219850632477D+02 - 0.1008879551708349D+02 0.7010399836626035D+01 0.7225366794589810D+01 0.8776438941082462D+01 0.6922873771972872D+01 - 0.8860658175654034D+01 0.8753699512951664D+01 0.6996066121564742D+01 0.9080552621075615D+01 0.1024858852123494D+02 - 0.9097019229419027D+01 0.8052977579360636D+01 0.7166874017286239D+01 0.9982928232896711D+01 0.6768399535407813D+01 - 0.8272675105937706D+01 0.8449101055706768D+01 0.7799957844354979D+01 0.1042424654460824D+02 0.9795657015516310D+01 - 0.9117767665884115D+01 0.8220397193775472D+01 0.1038429715859059D+02 0.1019707668847198D+02 0.8808924039487447D+01 - 0.6950137146344577D+01 0.7056967515130918D+01 0.7715507102402704D+01 0.5644375294648925D+01 0.7439501115621423D+01 - 0.9295161153155103D+01 0.6580795952169355D+01 0.8045169890576267D+01 0.7247660806218683D+01 0.8551771523474615D+01 - 0.8692150683715777D+01 0.7963169931107428D+01 0.7069818987273547D+01 0.8501216342511960D+01 0.8438644000893115D+01 - 0.7784639634632664D+01 0.9582966582425785D+01 0.8613814270308550D+01 0.8081383405169323D+01 0.8069574806161784D+01 - 0.7499177590096716D+01 0.8299601646782930D+01 0.7229955603658579D+01 0.7738475910946452D+01 0.6676584132408688D+01 - 0.9448847621279437D+01 0.8341333963986671D+01 0.7555982695957910D+01 0.8029427237595568D+01 0.8335441513406932D+01 - 0.7497640685431192D+01 0.8907587511285294D+01 0.8117550060118907D+01 0.1002981687898044D+02 0.8531663571750686D+01 - 0.6780570479420535D+01 0.8233138929422676D+01 0.9089295080692857D+01 0.7768226341513902D+01 0.8207668541704086D+01 - 0.8869969834950389D+01 0.7901677636084218D+01 0.8770438420480566D+01 0.9478979067927247D+01 0.8493299442968512D+01 - 0.8101493972945249D+01 0.8586718963573816D+01 0.8197427538807275D+01 0.6634766566857788D+01 0.8950442290624787D+01 - 0.6724510075233550D+01 0.8321185924274893D+01 0.8538597667495351D+01 0.8486266238330478D+01 0.9129275377699230D+01 - 0.7561609859871818D+01 0.8296345338379629D+01 0.8931899351556199D+01 0.9170892595246249D+01 0.6862908114046004D+01 - 0.5978791423980679D+01 0.7268957396220225D+01 0.8654812279707565D+01 0.8524705609144673D+01 0.8511511346442830D+01 - 0.8066481425145396D+01 0.7383379614830303D+01 0.7546764503726027D+01 0.7903349135335946D+01 0.8098394663204505D+01 - 0.7688515768426615D+01 0.6080030990800152D+01 0.6316297394041772D+01 0.7506547911759109D+01 0.8147868434984069D+01 - 0.1099242517492780D+02 0.8127180109474942D+01 0.8561574474120231D+01 0.8057696027275245D+01 0.8754641277020516D+01 - 0.9110461444389223D+01 0.7898703549112964D+01 0.7969937974543095D+01 0.7832180061376818D+01 0.1047826751242742D+02 - 0.8208239663228191D+01 0.7539538543894960D+01 0.7796576313013817D+01 0.8169717536653737D+01 0.8714992163056127D+01 - 0.1037518746075093D+02 0.9024925617770203D+01 0.8238501095751017D+01 0.8951111157532001D+01 0.8309314322953409D+01 - 0.7819515000834757D+01 0.1227124120221796D+02 0.8693946224231716D+01 0.8443960531122867D+01 0.9119451431536909D+01 - 0.8358559099863507D+01 0.7689145742845085D+01 0.8761267261426193D+01 0.9861934721857743D+01 0.8637820227478443D+01 - 0.8051064893721659D+01 0.7759057872274532D+01 0.8325114573391870D+01 0.8892015100318046D+01 0.5891643714074273D+01 - 0.7314007978345752D+01 0.7756727520678840D+01 0.9034914667269453D+01 0.9258547392226092D+01 0.6926851987778488D+01 - 0.8825036780613775D+01 0.9029328959103704D+01 0.8129058872947622D+01 0.8360065171670076D+01 0.8117146554260957D+01 - 0.8642620579577201D+01 0.7231262736319326D+01 0.7630268379730098D+01 0.8800270166917137D+01 0.6531540522388710D+01 - 0.7288413318106886D+01 0.6762053936501432D+01 0.7162699466601223D+01 0.8446280995870143D+01 0.8708624409858505D+01 - 0.8969587990930005D+01 0.7907076585733777D+01 0.8995334891355037D+01 0.7799501834327476D+01 0.8079268031229333D+01 - 0.8726789082992518D+01 0.8527681968345025D+01 0.8498337054528738D+01 0.6899501294168700D+01 0.7397993773131950D+01 - 0.7688515093595456D+01 0.9317423801464997D+01 0.7153635921769669D+01 0.7175363695120181D+01 0.1058370738937369D+02 - 0.5692784011632265D+01 0.6877386277993325D+01 0.8268207488592054D+01 0.8035555979540641D+01 0.8491820761439346D+01 - 0.6311209155219167D+01 0.8086102770844118D+01 0.6642967067757957D+01 0.2515188302086990D+01 0.2678446735355470D+01 - 0.5498180039904411D+01 0.6911131730725073D+01 0.6646801078648547D+01 0.8237401752674760D+01 0.6350051310329577D+01 - 0.7022671824036604D+01 0.6513038760997440D+01 0.7432638059862547D+01 0.6271584007297999D+01 0.2583065897135054D+01 - 0.5892670154811449D+01 0.6057802289118195D+01 0.8646831047408259D+01 0.8148117088828004D+01 0.7119271835531786D+01 - 0.7745805814277229D+01 0.7435983907472034D+01 0.8358184341661060D+01 0.8469430053870964D+01 0.8889985439476851D+01 - 0.8985416354442286D+01 0.7254502894217379D+01 0.4546646046358674D+01 0.8124284679103008D+01 0.8784032088886921D+01 - 0.6959273644491557D+01 0.9309536561347112D+01 0.8617473372481747D+01 0.7116788852495131D+01 0.6582745948237322D+01 - 0.6721277531981961D+01 0.9805740590254974D+01 0.8265075016984923D+01 0.9299058179125335D+01 0.8163870934049250D+01 - 0.8379845257331501D+01 0.8142567609164050D+01 0.8602843351729639D+01 0.7890457419121121D+01 0.7483360181785211D+01 - 0.7029803152128618D+01 0.6561127085293861D+01 0.7995170536641404D+01 0.6528988575059018D+01 0.7582946649973664D+01 - 0.7489741272630586D+01 0.8285464150171869D+01 0.7090077630441089D+01 0.8417675616428918D+01 0.8242928065387412D+01 - 0.8298574485068789D+01 0.8235711889412425D+01 0.1100499809542007D+02 0.9001246216674138D+01 0.9057102330102321D+01 - 0.6936139251875098D+01 0.8002029383171132D+01 0.7083969953516181D+01 0.8533964513881697D+01 0.1038474780211311D+02 - 0.7930851993213096D+01 0.9999989327797723D+01 0.6072009561035568D+01 0.8490087123012765D+01 0.7850792038410982D+01 - 0.7486425745046086D+01 0.8755269217192780D+01 0.8708035267117273D+01 0.7323206732046332D+01 0.1031974115050956D+02 - 0.8685418207117323D+01 0.8660888898596298D+01 0.7492161032177972D+01 0.9102892666842340D+01 0.8379767735986327D+01 - 0.7276602097681152D+01 0.7238449094261104D+01 0.8546636513466611D+01 0.6633557760525136D+01 0.1058300458550262D+02 - 0.7880991762556231D+01 0.8317423967229873D+01 0.7769253386214118D+01 0.7674868430927054D+01 0.6635171504578463D+01 - 0.6500753759317510D+01 0.8739701070783211D+01 0.6903035876180423D+01 0.9272188211534566D+01 0.7026958848884088D+01 - 0.6926612629614731D+01 0.9925258356189097D+01 0.1018016292570827D+02 0.8321110928272081D+01 0.7676109400883838D+01 - 0.9359662690698469D+01 0.8287978773426950D+01 0.7943101610455226D+01 0.8977317808464678D+01 0.9016235418337006D+01 - 0.1020636368596946D+02 0.7923216290338640D+01 0.7460781154521053D+01 0.5735370493295613D+01 0.7527643014676563D+01 - 0.8830942674295359D+01 0.1054061039854623D+02 0.7829953779254679D+01 0.8598524701772337D+01 0.8599851030151717D+01 - 0.6819483252203423D+01 0.6523545791480512D+01 0.8246003367902386D+01 0.8980302839627626D+01 0.8189372858252328D+01 - 0.8593220953607664D+01 0.7356825705942501D+01 0.6891053840461541D+01 0.7862782663134900D+01 0.9427683709570564D+01 - 0.8920183161968158D+01 0.9645202640236569D+01 0.6999222792167027D+01 0.7504588358550158D+01 0.6732493992684360D+01 - 0.9102185437213357D+01 0.7166391011745807D+01 0.7210279600729589D+01 0.8384870174960732D+01 0.7828306882988718D+01 - 0.9419779871550691D+01 0.8771734788467727D+01 0.9366623430557381D+01 0.9187853571160682D+01 0.8797886845409201D+01 - 0.7839925205176545D+01 0.6611662444494181D+01 0.6228388480262966D+01 0.7989489345967103D+01 0.7267482707638051D+01 - 0.7713493664113072D+01 0.8389806076353830D+01 0.8273771739389973D+01 0.7106259172744130D+01 0.7539605871710043D+01 - 0.8047809419927500D+01 0.7830387466344683D+01 0.8582380860048117D+01 0.7479589353803958D+01 0.7589505313515026D+01 - 0.7599905251486916D+01 0.7571479120377643D+01 0.1085378421793090D+02 0.6955737167561756D+01 0.8115237636524421D+01 - 0.7505664568475585D+01 0.8862216907515233D+01 0.8600279955120188D+01 0.8925027526492698D+01 0.7227546063541492D+01 - 0.5321080838982225D+01 0.7125758049359492D+01 0.6365985907716963D+01 0.8811150812665966D+01 0.6834818818279166D+01 - 0.6250784926523998D+01 0.9594710015297920D+01 0.8673761987668698D+01 0.8936782638613005D+01 0.7158199410199868D+01 - 0.7709445223107767D+01 0.6432201035044515D+01 0.5748977897784238D+01 0.5765471226705764D+01 0.8076778854420457D+01 - 0.6477836302526471D+01 0.8764233926572436D+01 0.6661754233407946D+01 0.6481435063209751D+01 0.6835159752699974D+01 - 0.8188369842919254D+01 0.6758836522846887D+01 0.6769396127648766D+01 0.8462896441976261D+01 0.7213193531921255D+01 - 0.7487566531439005D+01 0.8007971708067046D+01 0.7333478886903598D+01 0.9092953034426452D+01 0.7201012618177744D+01 - 0.9519723916949978D+01 0.8704033696359559D+01 0.9234254405225863D+01 0.7189001889921872D+01 0.8179860085403474D+01 - 0.7622502967647248D+01 0.7837317302225060D+01 0.1014779380200772D+02 0.7744857191444305D+01 0.8464536122810804D+01 - 0.7027244122981633D+01 0.6438422678820823D+01 0.7650067293271549D+01 0.8051761496047462D+01 0.8611846641150633D+01 - 0.6730694998602840D+01 0.8144461676035716D+01 0.8332118130103447D+01 0.8678586878472560D+01 0.8193525738857691D+01 - 0.8258085792122925D+01 0.8401459037632367D+01 0.7866349370045049D+01 0.9609707457683438D+01 0.6906656251669069D+01 - 0.7862654424002071D+01 0.6597676667635469D+01 0.8057983908338253D+01 0.7683605043495027D+01 0.8212000260378542D+01 - 0.7679719974889765D+01 0.8541131455132115D+01 0.7756760078272328D+01 0.9163072970404070D+01 0.8788480304032372D+01 - 0.6485837664145413D+01 0.3530908013769537D+01 0.4209532910304188D+01 0.8408544232810540D+01 0.6249911280572807D+01 - 0.7482585124188353D+01 0.9919804900703612D+01 0.7004645234268247D+01 0.7170104675596343D+01 0.6660920807742420D+01 - 0.9832339388569263D+01 0.9074899737805110D+01 0.6412034410724268D+01 0.4250664279830256D+01 0.8426857649583079D+01 - 0.8669240273693845D+01 0.7178753534855812D+01 0.7546231620032149D+01 0.8642507483714867D+01 0.9279595212327738D+01 - 0.8625110081633093D+01 0.9493513143758372D+01 0.6772598749196352D+01 0.7322475026550037D+01 0.9263484196810428D+01 - 0.5719918001272692D+01 0.7470014400037678D+01 0.7999063378985419D+01 0.6013735026465438D+01 0.8659956794526984D+01 - 0.9110685726893191D+01 0.7171701406296580D+01 0.7617180224804798D+01 0.5899084372996755D+01 0.6531730496686710D+01 - 0.6407505691731340D+01 0.7105872585725956D+01 0.6998843931000478D+01 0.7840624598904887D+01 0.6019902668422017D+01 - 0.9665039018369766D+01 0.7807695842928831D+01 0.7268342561878876D+01 0.6576623785764920D+01 0.7330423023833647D+01 - 0.7587524056890381D+01 0.8660324116751331D+01 0.8394305109245410D+01 0.7906675937935061D+01 0.6298652571185778D+01 - 0.6165777171506853D+01 0.7970020586812138D+01 0.8439311146681241D+01 0.9485183105825907D+01 0.7641817373427701D+01 - 0.8269248231159603D+01 0.7312344496032491D+01 0.7693136008208223D+01 0.7571160408844928D+01 0.9418553186505672D+01 - 0.8326476551777123D+01 0.8146602647282966D+01 0.7952790248169398D+01 0.7317377548759224D+01 0.7196336822337898D+01 - 0.8797345902995241D+01 0.8287758302847601D+01 0.9071809895697895D+01 0.7073564748609384D+01 0.8577237966591536D+01 - 0.8624451114786559D+01 0.5610577866126789D+01 0.8253348353738062D+01 0.7868400096138186D+01 0.7736536271700477D+01 - 0.8364598339042738D+01 0.6913041525947383D+01 0.6730670514748507D+01 0.7339690137961185D+01 0.7839316411885986D+01 - 0.9677363501175657D+01 0.8440279760918360D+01 0.8809491348031827D+01 0.6919804658892224D+01 0.9562270155013776D+01 - 0.9341932347309392D+01 0.8795816560163525D+01 0.8556575425895957D+01 0.7805869297223770D+01 0.7464393145459886D+01 - 0.8454731387442473D+01 0.7863404129877366D+01 0.8124976999033954D+01 0.8286427181555370D+01 0.8195230107598404D+01 - 0.8734581170195854D+01 0.9730216512600602D+01 0.6919958000930842D+01 0.7859409004652152D+01 0.9855965147599221D+01 - 0.9203489273705671D+01 0.7525841462003080D+01 0.8847075196642013D+01 0.6805784342094410D+01 0.8115236061271894D+01 - 0.9411462667915682D+01 0.7208538085666836D+01 0.7280046281740723D+01 0.7687647573759731D+01 0.6993283410752884D+01 - 0.7646880298290330D+01 0.7663877237864893D+01 0.8516543472386033D+01 0.7978909940505438D+01 0.6709365907336093D+01 - 0.9124233888469240D+01 0.6701908406848053D+01 0.8039256230253390D+01 0.9270197743528549D+01 0.8141925259602358D+01 - 0.7326649893362042D+01 0.7553776262310922D+01 0.6448075596864121D+01 0.8701147973993923D+01 0.8168916675912945D+01 - 0.7292296977777596D+01 0.8330330322311919D+01 0.7642959013714790D+01 0.7501614492215650D+01 0.6907079093859423D+01 - 0.7425734338269391D+01 0.5657439680783644D+01 0.7605398478210529D+01 0.7648576349227247D+01 0.8534500617156894D+01 - 0.1001714251915672D+02 0.5783493779255942D+01 0.6725481513631449D+01 0.8743624839795308D+01 0.8448579232521297D+01 - 0.6856676263855839D+01 0.7790450173827868D+01 0.6248659523230081D+01 0.8991406354505878D+01 0.6690848613521950D+01 - 0.7021332102051604D+01 0.9866969839674079D+01 0.6628611528512780D+01 0.6620013048624739D+01 0.6883707416919274D+01 - 0.7149814174293326D+01 0.7694937045472925D+01 0.1073689851016026D+02 0.8252805082543205D+01 0.7755958504627827D+01 - 0.8526283256789156D+01 0.9138602847376944D+01 0.8682153675105999D+01 0.5819414037254635D+01 0.6728088416676310D+01 - 0.8302375402286556D+01 0.8686801161679298D+01 0.8952005747086602D+01 0.6768089872492109D+01 0.8197237196772422D+01 - 0.6860339184101130D+01 0.7006610908627834D+01 0.7261994156438541D+01 0.7136263846607646D+01 0.9313152239367019D+01 - 0.7643590646925092D+01 0.6703561721765576D+01 0.9396365159319878D+01 0.7239167258829986D+01 0.8899342547795071D+01 - 0.1057671451557277D+02 0.6948980770426611D+01 0.7691150948653995D+01 0.8044483848722004D+01 0.7905508600180103D+01 - 0.8568356457075270D+01 0.9140950250876237D+01 0.7702262089729141D+01 0.7244242193383728D+01 0.6939017787164213D+01 - 0.5699477791063983D+01 0.8029494766691451D+01 0.9637696237226749D+01 0.6824307254869759D+01 0.7911717043904638D+01 - 0.6486875149831254D+01 0.8832983744748439D+01 0.8622152930711165D+01 0.7676687360525889D+01 0.9706420557277063D+01 - 0.9021346080743301D+01 0.7183148463572848D+01 0.7870224715569962D+01 0.7854049821651771D+01 0.9412149334972531D+01 - 0.6797131997624223D+01 0.7290611837721657D+01 0.8760798454199856D+01 0.8664614579697934D+01 0.1020711293508741D+02 - 0.9005445337902842D+01 0.7513471862555904D+01 0.6249192563260165D+01 0.4919768094665908D+01 0.5296872638046536D+01 - 0.7661712535729878D+01 0.7316210063010301D+01 0.9700152261723058D+01 0.7475654155568106D+01 0.7591689575827743D+01 - 0.9379439076076720D+01 0.6588041000101005D+01 0.8473421058027760D+01 0.8893266617415874D+01 0.7432671521827443D+01 - 0.7789115686385863D+01 0.7872154227573019D+01 0.9333339600073309D+01 0.9893782702084739D+01 0.8034271638225036D+01 - 0.9591557806346120D+01 0.9976778478726445D+01 0.8640026387264216D+01 0.9618147937157794D+01 0.8685368916425292D+01 - 0.8712437927447402D+01 0.6732911909545432D+01 0.7667447077275400D+01 0.8359785097247483D+01 0.1012812185620477D+02 - 0.8291019954826494D+01 0.7041063149067697D+01 0.6435156277357692D+01 0.7902441381746413D+01 0.8870953548682492D+01 - 0.9838689205036019D+01 0.7032332152477001D+01 0.8837661762483050D+01 0.8351032256450155D+01 0.7086708772238336D+01 - 0.7352150095020379D+01 0.8495147447326909D+01 0.8028516303915728D+01 0.9340191589915905D+01 0.6379362008561531D+01 - 0.8642263241814261D+01 0.7898623510011938D+01 0.9735119359840517D+01 0.1068788118559323D+02 0.9095234061325666D+01 - 0.8895057568511261D+01 0.8528199190916528D+01 0.9843797697714937D+01 0.8578843953428983D+01 0.7523921111857784D+01 - 0.7745278230149704D+01 0.7866677400502981D+01 0.7997322432916735D+01 0.7028360402513941D+01 0.8317889816473457D+01 - 0.7798320189140886D+01 0.4426137888123683D+01 0.3976573587621816D+01 0.7551703677785112D+01 0.6259037578189838D+01 - 0.6313340546759952D+01 0.7415483198651569D+01 0.8745719512581612D+01 0.6889270079181499D+01 0.8177671274518904D+01 - 0.7736611193566124D+01 0.6141480882541602D+01 0.6990652848744964D+01 0.7299675281719595D+01 0.7901147182972186D+01 - 0.5236254630745121D+01 0.7672414072182328D+01 0.6223317042989968D+01 0.6978111970840087D+01 0.8625541193372145D+01 - 0.6695244735026621D+01 0.6665162031458772D+01 0.6902004056840634D+01 0.5737954464186875D+01 0.5362262399300175D+01 - 0.6074930110725473D+01 0.8358501759296701D+01 0.7390215429178130D+01 0.5401577983279811D+01 0.6172554736612676D+01 - 0.5016686565096432D+01 0.6206873483668760D+01 0.6486850501650109D+01 0.6821184883679186D+01 0.9771912779105177D+01 - 0.7368980711262110D+01 0.7201179654396517D+01 0.1033506714454651D+02 0.6170602845904932D+01 0.6819120678372738D+01 - 0.6681038990398037D+01 0.5549072028752712D+01 0.5621453347627746D+01 0.7666625041548615D+01 0.8218789832410156D+01 - 0.7494981859389052D+01 0.6726613200284822D+01 0.7422526791658806D+01 0.8139157398218245D+01 0.7358879948890492D+01 - 0.6730811982195055D+01 0.5782082996118509D+01 0.6559609297917308D+01 0.7656148320728639D+01 0.5132564354409139D+01 - 0.4349349577075513D+01 0.6429169985743998D+01 0.7045927446386589D+01 0.8070878855058059D+01 0.6692053742814866D+01 - 0.8515615055351970D+01 0.8714661230115405D+01 0.6897588017598534D+01 0.7957221660234419D+01 0.1116119933498361D+02 - 0.6460049953362800D+01 0.6877039004528580D+01 0.9192184760087521D+01 0.8067449678503142D+01 0.5690929485421188D+01 - 0.6854895839989768D+01 0.6652569098597573D+01 0.8745726400049243D+01 0.7947133528511611D+01 0.6618745855124148D+01 - 0.8629638802149955D+01 0.9893457893528279D+01 0.6625992054984962D+01 0.6724407142949171D+01 0.7736997293702236D+01 - 0.6882780963441168D+01 0.9574533789445056D+01 0.7511978881344325D+01 0.7710030382951985D+01 0.8929798144894155D+01 - 0.7314473794002434D+01 0.7736513019046512D+01 0.7410468434075119D+01 0.5757217930413846D+01 0.8960644906453648D+01 - 0.9685597233451160D+01 0.1002341414299367D+02 0.8354917265921909D+01 0.8694632267844481D+01 0.6966159396129013D+01 - 0.7594250573894542D+01 0.6989213434486532D+01 0.7815255985792821D+01 0.8329180394762348D+01 0.8638837041713231D+01 - 0.8479742328405845D+01 0.7814348138441614D+01 0.7983034567064415D+01 0.9901918020012298D+01 0.8180317375923876D+01 - 0.9181387553717972D+01 0.8256116819222662D+01 0.7808248760372228D+01 0.8339492586933357D+01 0.8444928664758141D+01 - 0.9518618215472136D+01 0.8344568283093750D+01 0.9233943046600849D+01 0.1020543261927882D+02 0.6951576797797588D+01 - 0.5467591365020067D+01 0.1040913776534595D+02 0.7128731893196329D+01 0.9209505158226287D+01 0.7407206473325270D+01 - 0.7618717997089240D+01 0.7393567457684384D+01 0.7289531960868850D+01 0.7780126728743262D+01 0.8031232495788489D+01 - 0.1042972587912115D+02 0.8908034684006672D+01 0.7206496949137476D+01 0.9886254416802247D+01 0.8111084770074388D+01 - 0.8692593417148494D+01 0.5403854658174907D+01 0.8835379473339049D+01 0.8550004948221339D+01 0.6580368474616894D+01 - 0.6505416946842703D+01 0.7642305070578792D+01 0.8659090714136219D+01 0.7680836670263969D+01 0.6936927600571177D+01 - 0.1004207216501734D+02 0.9800573671088220D+01 0.1037323415202452D+02 0.6973253725995909D+01 0.9782219556266352D+01 - 0.8796383829512196D+01 0.9511218153733905D+01 0.8408985148761822D+01 0.1076782301437765D+02 0.7394571060611528D+01 - 0.8933471965566923D+01 0.9102463539382605D+01 0.7986180737232965D+01 0.7119706857603517D+01 0.7176806804684988D+01 - 0.9298641065096541D+01 0.9329355669122339D+01 0.6829005871356378D+01 0.9082348401395008D+01 0.9707224550972622D+01 - 0.7252131070827112D+01 0.8455733966336160D+01 0.7316158420811908D+01 0.8957675299413705D+01 0.7855119074387135D+01 - 0.7086578502480831D+01 0.7856480604896451D+01 0.8337848141662308D+01 0.1000868236137377D+02 0.1009105560688422D+02 - 0.9511536828562688D+01 0.8541085030999433D+01 0.9491553863801951D+01 0.8944927352794204D+01 0.9207302901238677D+01 - 0.7437979534267870D+01 0.7972408137801185D+01 0.9376577969854136D+01 0.4504774861451315D+01 0.3658359964931889D+01 - 0.6733039287448762D+01 0.7963723661521382D+01 0.9572798445298149D+01 0.8432821653512036D+01 0.8142533949390343D+01 - 0.8512202001308424D+01 0.6405619590423796D+01 0.8217336640269544D+01 0.8284091519996680D+01 0.7815872090403425D+01 - 0.7693204344153641D+01 0.8561747015723768D+01 0.8972876934731762D+01 0.9513441726795017D+01 0.1013860528366522D+02 - 0.7774135304517659D+01 0.9539067995518728D+01 0.9542062375236728D+01 0.8547792275442779D+01 0.8628944402556536D+01 - 0.1049075349284824D+02 0.9753551066169267D+01 0.9263893829672247D+01 0.8781989884852379D+01 0.9571193698795602D+01 - 0.1060704837861593D+02 0.8234567494156927D+01 0.9211360150409082D+01 0.9402075610887479D+01 0.7760196618163785D+01 - 0.8572274295884725D+01 0.6482621718266132D+01 0.1054830236398818D+02 0.8708366904931992D+01 0.9469405816307644D+01 - 0.9242850914394545D+01 0.8965288983778567D+01 0.9542488778944071D+01 0.8878037942463525D+01 0.7613284111335072D+01 - 0.8514529739651852D+01 0.9708958207628122D+01 0.9192545800960838D+01 0.8447022094330647D+01 0.8009362736900126D+01 - 0.9362400078332330D+01 0.9950256368389404D+01 0.9241375624921451D+01 0.7650616435851100D+01 0.9434282323904997D+01 - 0.8271888711394093D+01 0.7884228544677625D+01 0.9522667232471088D+01 0.8096402684000351D+01 0.9454990911660973D+01 - 0.8842544258187464D+01 0.8720002212452018D+01 0.7279903972344230D+01 0.8755060112539004D+01 0.8245187540197442D+01 - 0.8514919261372491D+01 0.8554602511479887D+01 0.7859697868802912D+01 0.7599036026890074D+01 0.8216645899836822D+01 - 0.9229567876792455D+01 0.6214338073378108D+01 0.8426465672516890D+01 0.6718652086112283D+01 0.8315114404912283D+01 - 0.6049270268950375D+01 0.9618815141919528D+01 0.7562222047462292D+01 0.7242218783337915D+01 0.6000037372750922D+01 - 0.5725409323816322D+01 0.6016889572667905D+01 0.5813826789071505D+01 0.7979058743591444D+01 0.7501564585142168D+01 - 0.5854181009002560D+01 0.5537338359822516D+01 0.5590025774131229D+01 0.6048442542343359D+01 0.4902131106292429D+01 - 0.3979474672895144D+01 0.6099850644049551D+01 0.3059976832342686D+01 0.3777743059132028D+01 0.2354545552043726D+01 - 0.7091507596293653D+01 0.5667049049872339D+01 0.6143332120873557D+01 0.6358313823690069D+01 0.6904937974589417D+01 - 0.4692592390174013D+01 0.4426081447672456D+01 0.6991142940362530D+01 0.7157226955338963D+01 0.6824722371590092D+01 - 0.6217086291105748D+01 0.7663875496881763D+01 0.7214598143014995D+01 0.6779339448699639D+01 0.8642505023953563D+01 - 0.7888467740428608D+01 0.7895114495227863D+01 0.6879218763813030D+01 0.7438477410310814D+01 0.7790824184933062D+01 - 0.6340760836829891D+01 0.6810181408870286D+01 0.8106284648687538D+01 0.7531807087698294D+01 0.7992388417519027D+01 - 0.7362992871220426D+01 0.8228516899550872D+01 0.7464785881675283D+01 0.8170802909179750D+01 0.7376315270567515D+01 - 0.7396073852712347D+01 0.6788126544537377D+01 0.6781665545343260D+01 0.6916353279646357D+01 0.7808384843994848D+01 - 0.8815352163485112D+01 0.7061620797413744D+01 0.7279265976212183D+01 0.6219731276222864D+01 0.6781416467815207D+01 - 0.5675470886838536D+01 0.8061336500392885D+01 0.8408981016340601D+01 0.8886022050375095D+01 0.8915286898624519D+01 - 0.5821269642681184D+01 0.9056076055612275D+01 0.1067530968647354D+02 0.9077043651582416D+01 0.5903797325033973D+01 - 0.6976965301082907D+01 0.8256114284359519D+01 0.7674299257633884D+01 0.8342180282143746D+01 0.9471000210399412D+01 - 0.7885033290818859D+01 0.1001974580551317D+02 0.8449002712328891D+01 0.1052591373806645D+02 0.5758251621885410D+01 - 0.8029239251840183D+01 0.7380110812755336D+01 0.7618749398537120D+01 0.8222285040411885D+01 0.8100501332697730D+01 - 0.8437501487678537D+01 0.7546308110968742D+01 0.6238957261436128D+01 0.9060626230847770D+01 0.8284446862416988D+01 - 0.8636580263191076D+01 0.6331592270814381D+01 0.7206283743668676D+01 0.1043950155576286D+02 0.8202852474834325D+01 - 0.7409753188134980D+01 0.7923630256859584D+01 0.8644836229172679D+01 0.1152087947202336D+02 0.7286938657135969D+01 - 0.7615646999380226D+01 0.7998887950905018D+01 0.7786320104989490D+01 0.8206575959365406D+01 0.9730578848312232D+01 - 0.7514953010852264D+01 0.7430369351576366D+01 0.7681160623972533D+01 0.8602360512952647D+01 0.9000956930046927D+01 - 0.7617343139838642D+01 0.8472440945285904D+01 0.9102922656891415D+01 0.8048244688027612D+01 0.8918703789016542D+01 - 0.8286833854290855D+01 0.9304470446142854D+01 0.8491137076084367D+01 0.9899259132663977D+01 0.8222047895157404D+01 - 0.8791106828343487D+01 0.8900985901973398D+01 0.8559327773781041D+01 0.8111799401992576D+01 0.8171740158479329D+01 - 0.7142207059502051D+01 0.8494631711729941D+01 0.8668493705671331D+01 0.6997299852613051D+01 0.5470291660643610D+01 - 0.7793643644510114D+01 0.8843213088154510D+01 0.8587730348580498D+01 0.6880118595623103D+01 0.1009013146966629D+02 - 0.7247795815460755D+01 0.7164791011220473D+01 0.7454861443837655D+01 0.8244096445736876D+01 0.7994471599739794D+01 - 0.7642900271323263D+01 0.8499998935395562D+01 0.1017245650254275D+02 0.7310503696172326D+01 0.6915791538907479D+01 - 0.7788113975351391D+01 0.9119938828741752D+01 0.7176143286715726D+01 0.8233893525442404D+01 0.1045927758632101D+02 - 0.1045089433562944D+02 0.7920197925709754D+01 0.8153140870380952D+01 0.1144572588658632D+02 0.8517996443377351D+01 - 0.7900729835535437D+01 0.8881068853658560D+01 0.9936609916881666D+01 0.7167073386418750D+01 0.1129165216806643D+02 - 0.9496832288477696D+01 0.8686360850518961D+01 0.9458881618636005D+01 0.8614782547961857D+01 0.8767245484854177D+01 - 0.8629268501397050D+01 0.9199876400150693D+01 0.8375347162666291D+01 0.8110537672583872D+01 0.8983338570902216D+01 - 0.8074451494835179D+01 0.8411993162985000D+01 0.9806660252404535D+01 0.8798151345504246D+01 0.8885899239297380D+01 - 0.9870037672055407D+01 0.9471322422069424D+01 0.9038170703332884D+01 0.9727185800964365D+01 0.9473032071686555D+01 - 0.7714775975300573D+01 0.8765359870461836D+01 0.9438788597413481D+01 0.8330775167103470D+01 0.8764059045677502D+01 - 0.8975936432987297D+01 0.1049340756256759D+02 0.8477886683509620D+01 0.7634662599058490D+01 0.8770518500575919D+01 - 0.8713979931250876D+01 0.7562345357911101D+01 0.7997037146165914D+01 0.7948615508164741D+01 0.9722717103503625D+01 - 0.1097129439766004D+02 0.1075004594778502D+02 0.6374955762047499D+01 0.6080222469069136D+01 0.8503255444045124D+01 - 0.8991096320006175D+01 0.1015503514031962D+02 0.9358932145977443D+01 0.7566862022735184D+01 0.8586129347629536D+01 - 0.9106680255105372D+01 0.8550292693074736D+01 0.8130545300813296D+01 0.9274593133652013D+01 0.9843575439743560D+01 - 0.1026604844314958D+02 0.8943389177164789D+01 0.8171939412280317D+01 0.8442383415798442D+01 0.8360484448088775D+01 - 0.1004086230775783D+02 0.1069311099795165D+02 0.9110683031582214D+01 0.7738320006148458D+01 0.8394943110074522D+01 - 0.8228678973680596D+01 0.7742998189586096D+01 0.8726080488502053D+01 0.8610897980387305D+01 0.9063552736401267D+01 - 0.8675051680360435D+01 0.7274201366973939D+01 0.7616925415966817D+01 0.5946507732722806D+01 0.7202951841275095D+01 - 0.6527271561976129D+01 0.9002298918270803D+01 0.9148305186709722D+01 0.7683560347378670D+01 0.7926311463082933D+01 - 0.6445511540763514D+01 0.6354356591380531D+01 0.9009685404127362D+01 0.9164175034359101D+01 0.6238081511112413D+01 - 0.7055105160896211D+01 0.6835334470145892D+01 0.7451651770317369D+01 0.6873352174322527D+01 0.7894994564777368D+01 - 0.6450662797980220D+01 0.6864000484294695D+01 0.7264755452198957D+01 0.8138173046432751D+01 0.6890183639506086D+01 - 0.9235303048801262D+01 0.8014894173943691D+01 0.7129523483134232D+01 0.8160838375715644D+01 0.6726654719248047D+01 - 0.3949131158758167D+01 0.5708167918708158D+01 0.5319528389925776D+01 0.5194483378335287D+01 0.4303409494924533D+01 - 0.5362147297325497D+01 0.4247194275287401D+01 0.3412864311644357D+01 0.4997414251631559D+01 0.4456150423776625D+01 - 0.4129968452539682D+01 0.4734572159530140D+01 0.3665050947254903D+01 0.3351333175926808D+01 0.7052336402865660D-01 diff --git a/lpair_2diss/cdf/eemumu.f b/lpair_2diss/cdf/eemumu.f deleted file mode 100644 index 8e55c99..0000000 --- a/lpair_2diss/cdf/eemumu.f +++ /dev/null @@ -1,134 +0,0 @@ - PROGRAM eemumu - IMPLICIT DOUBLE PRECISION (a-h,o-z) - DOUBLE PRECISION me,mu,f - COMMON/inpu/me,mu,ebeam,const,sq - COMMON/tell/nn - COMMON/ini/xxx,yyy - COMMON/outp/nout - COMMON/cuts/angcut,encut,etacut -* - INTEGER ndim,npoin,nprin,ntreat,nevent -* -* --- LPAIR data COMMON block -* - INTEGER IPAR(20) - REAL*8 LPAR(20) - COMMON/DATAPAR/IPAR,LPAR -* -* --- HEPEVT COMMON block - PARAMETER (NMXHEP=100) - COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), - & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), - & VHEP(4,NMXHEP) - REAL PHEP,VHEP -* - EXTERNAL f -* - CALL fileini(IPAR,LPAR) ! initialize variables - CALL pawini ! initialize histograms -c CALL genzini ! initialize genz structures -* - pi = dacos(-1.d+00) - nout=6 - - IF(ipar(4).EQ.1) THEN - OPEN (12,file='ineemm.data',status='old') - REWIND 12 - ENDIF - - IF(ipar(17).EQ.1) THEN -c OPEN(20,file='events.ascii',status='new') - OPEN(20,file='events.ascii',status='unknown') - ENDIF - - nn=0 -* -* ---- particle masses (GeV) - me = lpar(1) ! incoming particle - mu = lpar(2) ! outgoing particle -* -* ---- beam energy (GeV) - ebeam = lpar(3) - sq=2.*ebeam -* -* ---- angle cuts - angcut = dcos(pi*lpar(4)) -* -* ---- rapidity cuts - etacut = lpar(5) -* -* ---- energy cuts - encut = lpar(6) -* -* ---- constant (convert GeV**2 to picobarns) - const = (19.732d+03)**2 -* -* ---- VEGAS integration -* - xx = ranf(1211) -c OPEN (15,file='dl2.vegas.grid',status='new') - OPEN (15,file='dl2.vegas.grid',status='unknown') - CALL vegas(f,0.1d-03,ipar(5),ipar(6),ipar(7),+1,ipar(4)) - CALL save(7,15) - PRINT*,'Wrote VEGAS grid to dl2.vegas.grid' - CLOSE (15) -* -* ---- cross-section calculation only: exit PROGRAM -* - IF(ipar(1).EQ.1) THEN - PRINT*,'IPAR(1) = 1: cross-section calculation complete' - STOP - ENDIF -* -* ---- SETGEN: find local min/max -* - ndim = ipar(5) - npoin = ipar(14) - nbin = ipar(15) - nprin = 1 - ntreat = ipar(13) -* - OPEN (15,file='dl2.vegas.grid',status='old') - CALL restr(7,15) - PRINT*,'Read dl2.vegas.grid' - CLOSE (15) -c OPEN (16,file='dl2.lattice.1',status='new') - OPEN (16,file='dl2.lattice.1',status='unknown') - CALL setgen(f,ndim,npoin,nbin,nprin,ntreat) - PRINT*,'setgen complete' - CALL save2(7,16) - PRINT*,'Wrote SETGEN maxima to dl2.lattice.1' - CLOSE (16) -* -* ---- GENERA: generate some events -* - ndim = ipar(5) - nevent = ipar(12) - nstrat = 0 - ntreat = ipar(13) -* - OPEN (15,file='dl2.vegas.grid',status='old') - CALL restr(7,15) - PRINT*,'Read dl2.vegas.grid' - CLOSE (15) - OPEN (16,file='dl2.lattice.1',status='old') - CALL restr2(7,16) - CLOSE (16) - PRINT*,'Read maxima from dl2.lattice.1' -c OPEN (17,file='dl2.lattice.2',status='new') - OPEN (17,file='dl2.lattice.2',status='unknown') - xxxx = ranf(1236785) - CALL genera(f,ndim,nevent,nstrat,ntreat) - CALL save2(7,17) - PRINT*,'Wrote new maxima to dl2.lattice.2' - CLOSE (17) -* - CLOSE(20) ! CLOSE events.ascii -* - CALL pawend ! CLOSE histograms -c CALL genzend ! CLOSE genz -* - PRINT*,'GENZ events generated: NEVHEP = ',NEVHEP -* - stop - END diff --git a/lpair_2diss/cdf/external b/lpair_2diss/cdf/external deleted file mode 120000 index a2d2623..0000000 --- a/lpair_2diss/cdf/external +++ /dev/null @@ -1 +0,0 @@ -../desy/external/ \ No newline at end of file diff --git a/lpair_2diss/cdf/lpair.cxx b/lpair_2diss/cdf/lpair.cxx deleted file mode 100644 index 78d4dd0..0000000 --- a/lpair_2diss/cdf/lpair.cxx +++ /dev/null @@ -1,182 +0,0 @@ -#include -#include - -#include "utils.h" - -#include "TFile.h" -#include "TTree.h" -#include "TLorentzVector.h" - -using namespace std; - -extern "C" { - //void zduini_(); - //void zduevt_(int* iwant); - void fileini_(); - void integrate_(); - void generate_(int& nevents); - void fragmentation_(); - int luchge_(int&); - - extern struct { - int ipar[20]; - double lpar[20]; - } datapar_; - - extern struct { - double s1,s2,s3,s4; - } result_; - - extern struct { - bool accepted; - int ndim; - double x[10]; - } event_; - - extern struct { - int n, k[5][4000]; - float p[5][4000],v[5][4000]; - } lujets_; - extern struct { - double mx1, mx2; - double wx1, wx2; - double w1, w6, w3, w8; - } remnts_; -} - -int main() { - // Number of events to generate - const int nevent = 5e2; - //const int nevent = 1e4; - int ev = 1; - int i; - - Timer tmr; - - fileini_(); - - // Beam parameters - /*datapar_.ipar[4] = 9; - datapar_.lpar[2] = 3500.; - - // Outgoing leptons kinematics - datapar_.lpar[4] = 2.5; // eta cut - //datapar_.lpar[4] = 3.1313; // eta cut - datapar_.lpar[5] = 0.; // energy cut - datapar_.lpar[6] = 5.; // pt cut*/ - - integrate_(); - - std::cout << "Pt > " << datapar_.lpar[6] << " GeV :" << std::endl - << " xsec = " << result_.s1 << std::endl - << " error = " << result_.s2 << std::endl; - - const int maxpart = 1000; - - double xsect, errxsect; - int npart, ndim; - int role[maxpart]; - double eta[maxpart], phi[maxpart], rapidity[maxpart]; - double px[maxpart], py[maxpart], pz[maxpart], pt[maxpart]; - double E[maxpart], M[maxpart], charge[maxpart]; - int PID[maxpart], isstable[maxpart], status[maxpart], parentid[maxpart]; - double mx[2]; - TLorentzVector *mom; - TTree *t; - float time_gen, time_tot; - - t = new TTree("h4444", "A TTree containing information from the events produced from LPAIR (CDF)"); - mom = new TLorentzVector(); - - t->Branch("ip", &npart, "npart/I"); - t->Branch("xsect", &xsect, "xsect/D"); - t->Branch("errxsect", &errxsect, "errxsect/D"); - t->Branch("Eta", eta, "eta[npart]/D"); - t->Branch("phi", phi, "phi[npart]/D"); - t->Branch("rapidity", rapidity, "rapidity[npart]/D"); - t->Branch("px", px, "px[npart]/D"); - t->Branch("py", py, "py[npart]/D"); - t->Branch("pz", pz, "pz[npart]/D"); - t->Branch("pt", pt, "pt[npart]/D"); - t->Branch("charge", charge, "charge[npart]/D"); - t->Branch("icode", PID, "PID[npart]/I"); - t->Branch("parent", parentid, "parent[npart]/I"); - t->Branch("stable", isstable, "stable[npart]/I"); - t->Branch("status", status, "status[npart]/I"); - t->Branch("role", role, "role[npart]/I"); - t->Branch("E", E, "E[npart]/D"); - t->Branch("m", M, "M[npart]/D"); - t->Branch("MX", mx, "MX[2]/D"); - t->Branch("ndim", &ndim, "ndim/I"); - t->Branch("generation_time", &time_gen, "generation_time/F"); - t->Branch("total_time", &time_tot, "total_time/F"); - - xsect = result_.s1; - errxsect = result_.s2; - ndim = event_.ndim; - - i = 0; - do { - tmr.reset(); - generate_(ev); - if (event_.accepted) i++; - if (i%5000==0) std::cout << "Event " << i << " generated!" << std::endl; - time_gen = tmr.elapsed(); - fragmentation_(); - time_tot = tmr.elapsed(); - npart = 0; - mx[0] = remnts_.mx1; - mx[1] = remnts_.mx2; - for (int p=0; pSetXYZM(px[npart], py[npart], pz[npart], M[npart]); - pt[npart] = mom->Pt(); - if (pt[npart]!=0.) { - eta[npart] = mom->PseudoRapidity(); - } - else eta[npart] = (pz[npart]/fabs(pz[npart]))*9999.; - rapidity[npart] = mom->Rapidity(); - phi[npart] = mom->Phi(); - - npart++; - } - t->Fill(); - } while (iSaveAs("events.root"); - - delete t; - delete mom; - - return 0; -} diff --git a/lpair_2diss/cdf/lpair.dat b/lpair_2diss/cdf/lpair.dat deleted file mode 100644 index 8c5d215..0000000 --- a/lpair_2diss/cdf/lpair.dat +++ /dev/null @@ -1,27 +0,0 @@ - 0 IPAR(1) ! event generation (0) or cross-section calc (1) - 0 IPAR(2) ! PAW histograms/ntuple yes(1)/no(0) - 1 IPAR(3) ! GNZ event output yes(1)/no(0) - 0 IPAR(4) ! read 'ineemm.data' for graph yes(1)/no(0) - 9 IPAR(5) ! VEGAS dimension in-in(9),in-el(8),el-el(7) - 120000 IPAR(6) ! VEGAS points per iteration - 15 IPAR(7) ! VEGAS iterations - 2212 IPAR(8) ! incoming particle type (p 2212 e 11) - 1 IPAR(9) ! CUTS: vermaseren (0) / caron (1) - 0 IPAR(10) ! VERMASEREN FORM FACTOR:paper(0)/experimental(1) - 200000 IPAR(11) ! Maximum # of events to GNZ output - 10 IPAR(12) ! GENERA: # of events to generate - 1 IPAR(13) ! TREAT: non-smooth (0) / smooth (1) function F - 500 IPAR(14) ! SETGEN: # of points per bin - 3 IPAR(15) ! SETGEN nbin - 1 IPAR(16) ! vector rotation: yes (1) / no (0) - 1 IPAR(17) ! hepevt to ascii: yes (1) / no (0) - 0.9385 LPAR(1) ! incoming particle mass (GeV) - 0.000511 LPAR(2) ! outgoing particle mass (GeV) - 6500.0 LPAR(3) ! beam energy (GeV) - 1. LPAR(4) ! maximum theta angle (fraction of PI) - 999.9 LPAR(5) ! maximum rapidity - 0.0 LPAR(6) ! energy cut (GeV) - 0.0 LPAR(7) ! minimum P_t (GeV) - 0.0 LPAR(8) ! minimum invariant mass (GeV) - 2000.0 LPAR(9) ! maximum invariant mass (GeV) - 1000.0 LPAR(10) ! maximum diffractive mass (GeV) diff --git a/lpair_2diss/cdf/obj/lpair.oxx b/lpair_2diss/cdf/obj/lpair.oxx deleted file mode 100644 index 7e24ba8b2891fbe352d35585f18d1a33a8d22bbb..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 22304 zcmb`O4Rlo1oxpE0L8(#`1Z%2TN7NQ9gnSVKBFzT_FOon`J`hkk87D8vm}F);Gr@pT zg8|DJsJg{n>e@uH9o>+T-d3q={$SZnmFUmpx5;wk;O-EQ{`%)6!=D|9k)c znLBshTaw+qhnIWr@BTmT*Sqh&`-Vq+jhpiG@&t!Gu|Z^VOoiz1Wzsb=StB-!O;Yv- z$fM2@ia$cJm*QI}zLnzJDgGG6%P78s;*V3jlHwAIODQg=xRT;3imNGJ2l0Bi+O6cT zYujtvTCD@`RDUKhOjt1#x9IOpN&jd))l&!>!)Jl&L> z`c4q){#|SURq_|IAy#tt`0F)5DR>sZ^DfSET zowTu;2?xoSXD#`{Y$cx-W6;;LtiaPXznO#Z(7c)1TTb0J2Vt>s4#G9TIS3CuItSsJ zsW}J_9iBtib$ojc!rtR^5KjHo9E7LvKAi2`NPTGzy&*!RItX9$ocO@rZP^qNv#F+1_EY4mLt)sqIc`Ymamee|!N)!zH&gP9Yo&D}hBmdl! z9Do0Jqrbm8IX*gl^YT;4iBRhBA|aNKCdUt@2C9rTbEN%j@@H(&eWf(k<*vfTsjk9Z zsdoz(`i`hYD!ZDxz~M39^RgxBM#6A#dykL#Cb97C-@`IF;(LCiebNg4$U1PU=4Qw* zep)IXPaZpj6Iw4nQJ7thcgIN6^CP}V>-b2)A=De5&MQ2YD*V=j6&wW%ILp%#i=~7r zz!^QVTd7*}(6BW+m2ask4yOvZdoC8Vbo zGI4&VP5_AWn{|S%IKNsaS0K4nCs!g_sFN88PXb5}hj*(G?-mvn$N_=Thrzdw%huz% zt4pSKyGi1rt4ntDyGi1Tt4rdO&BZ&c8M@?&BW{woV1T4`+!}f1jFvfahP+|Pu`^Uj z%p5#J&y@6gFnSbhpZu}9z27&uEKlX>?$l7-FFqI5+9$HDSRfM-!jq;lNwqK_Ow<)?wD*d zB;*|LDr`Fi^Lf0haM>s@n%_HNeglU2jmBo>6`$9$62x5q)C}&JB>eSF=Bf4IPTyqV z6Yu{47k1j?RKpaYj1U7WGuzfol{4(M`5(GM+u6P;ZM}w?uj3MO z4rcw#?$cO73e5@c2CwjLwzqrN39olBZU?>IyMTD@SS%95q!6{GvjjY_Gk?4kzN?Xe`n>5VSj0L1S}mLyLD={l-npMNcIJ z5sn68iB%0E6cy+%v1+4=1-N9uNns}f_ezD`Am&R1M6@TA0gw@~Ks3}DO6<*0CL%hR zfzd$`)nuZ3MRcE5x=%zCS~ekqJ%L!aok1!unj1DUgBAoMowk7HK)W+kujB?jUdX_XhTh%Spc;bS3axM<2``bE=@d&{vuns$hAXQ&_g5+l)VhwYdg6MrJq zZ?D>95|M}`0)1SV$p{~g9E>_yusd%NLXBogED}lZZ25nVaZ2LL<`6`Wz|8y;%+r}i zATtCR6|!>~211&Y!RKQs1jKphpa3!mi;%)&vnXGdVGdujCg4GK@@gUQ5srJF==D+x zi-rAzAJoc(m|vsZ$QmjHe}_JEx`uC9E4hCfmW*jD`MuXsKrZ2Lo|f;fctfYlamCPO zq|!(;EHa=BE6VayR&wH^Rd@%yu_0+LR&mYzOc8D=u0t=d1jBl}1D4>0z6&6C0d|HL zpwM?g-Tqmgb+24As`ZGt>+=v`>yuf6WQ~&pXck(f9zw8hybj%r2wd^=lBY0}EIPkP z!P}vi{>0F!2Fi*<$r!c<7G&S_Sj_@RRdJX3MFhrg78 zgsG~^33kjh{ArTCG7S$#--Xx}XyJST{Kft{hy8Uf({8CE-Ev>bv2^NUHM-D;vJl;X zv4!nZ@a)0K0M_eZTxI$kq+ujw8lDJsURa8A=Z@+h>709{eOf+L*c4}^EzWqUN4X}N z|7s^cat&1knZ9evDr%+^I$v`hF*l<_I>ShDr}`dt}3~J+fhNI)hX7?Pumv2izkyVIA<# zeWTbCqaNHR2L9hxkMHlCmFKdfUX)&`=tlY^ti<=N#iX3KuSMhy7UkWz;L7<=g3~3y@xpL3{;9pD=&}6z4_>hg1R#rL z>ybm)hkv*{e?SUg`F+SCxamKvibXNTtlyfk|16c?t(WKf()M4a@*DK>_Kf~nD!29W z{EoE#B`RN~mp_ovUjqGrp#uMK{lb~@^;CYBUOt#9zmLir_4549Y5xyX`Hgz{_Kg0s zRF3D(Y5%>M@>i)mrkCgUr|qAm@>Yzw{+_LQD6j<3rOVh~f^X>%R^T7j@6PyNPvvg) zL$$np&5d$qU5Rh*!o&0HHpt+Gp%bnGOt25%uqU79*)qVg{~$hpl_A%7)N`a@c%J92 ztI}v1DBVd!}5IpKm z$SQ%Y9qa<-9U?gmnfR#W89U5T$Rp$(A?5Wyp7b59Q2>T29LlmO1Z%!s&gR_k67oz*Sm1Ja%Gj_TAmN{ z8Sga=eDA#oX&jd!8UP*_Jo!U@z~J~2f&3tGd4B`@0rA5Ie~b7Lga4NJlLmjE_%Vae zgNmWw;|5l!c$oNngFi%kfx#amUS#m6 zh%YwybHs}c{vz=u2LDIkct5Ve2LS~6+)_zs(gsRpM;=j|4bt*;Ib4l544M(%1;0XE zX;4^WWc{czTB&L$96&e(kEn5=xL)P@ML`d=*eQ5;5RF2Q+C3N)?UxD z9NLRgp7dRqt>Y0N$Oe@22wFUiQjf^(Hx%)R1%{-`dgLiZZjnb^lM8`(1RMf61dlpA z$|>=Pg*gm?N5JcaL-2^)@m&G)VX3y?kb8a5T?bqqSs8XL7y0dyE~>Gy56&ZUTOzl4tfa@|^_u0T=s^N%=ddl|t~7{)>`l_Bs4~{~H%Of9E3q zL&-DyBKZyj-rklxvoGSEPyyVEPW@I4e5tlylJ7ELXRYL!{gQl#0lrJ}%zlaO?{Tq@ zUs;xF`=}MvBVUm`vyWms-*>U|j+9?V+UlJJGX=1eIJN7;F1*BrZ*bvFz?W+Kx=yMA zKG(0+-aB}|X1mx4yYRg({D2F8+=U-=;oo=RKXc&=;gRFipG#f%CKulA!ox0n(1kzh z!k=>CpLgM3a^ZjN!rye^Z@KV`$Q>S=GcNMi!v@l+pKo*FqAwZ<#Y%#MgTlY7HPKkM zHX5>n_Jg6g?T2q`@kDGOm{3L4et#$epV~0HwX$W~wzleqaKes-1AUEU72VtISR6jR z)%V!JULP5&2=w(uf`LRN=7%p=3RZ=>!;zQ`naVQ1A3rsPf_^j`3iO5csZT|LaHqf1 zR?fkuzcdsA`Nq|~Z7uC+yRoWwQ*C3bOs?&13JkW_!>2JUsK%U@2|72CE4y{AMHK>h>nEqoCnio42(}-SXZB=<`jH*n@#srz91U)CGdQX;j(U3azY-2W|KW zr|MU>TC$CH7Od#q7}*+0G{+)AJ03@K)x8bz`o2h5`Yo&It&0W1!JcjRKLB4vrMpr> zwc)*#Zwf>+JK?7eXl5y4LUS4iETYvNo2(-08Ht0t0;sKTNS+e>Bn;3hsp&vAJR+u-YCtbVm`59ZdisS0zxx@|i&FA}R@P*&O22$M9N*ry7ZlbLcb z6O?Yd?F4?;)LfJ)7fN!C-4}?)?M|Joj@i&bid46?g4;m1UAA^psISlNtlO(Kxd?derjM^buKsUt4{TI z4-WdHuzp8iEr*{i`1h1Tf3N_2 zz$)$!#Nmk%fv1BV=x+$N`F*Xc{mol~Si9CpUtA70*n+jMuOT=)D{cO^Qm|7cXRtKV zys4!%((0G9zO1xuV<;w9h`nW1^#d_n8PY`c{A&4o6lgBgq_xZ+YSxw14;TFW+XrYq z*EJ-%;P&qad+Nyt{n8IVSn-R#fd_0A2Yb4eLe3nh&K`Uon$A97vs~s{6V;(e+z%aQ zS2n;CR^221&UnP%1CLnvJqK395ZWm3TUcZRei*1h^|&vqfE6UKSkWD+4(bIY^Oxyy8X2pe@v6_Fzi1_ z_HBbdLi}-qKT7-wgFjCE6@z0RVfc>0|59P`OM^d89M5ktaR2Z;z;jxie^X_}B7>hI zey72C9@H3olH_{~{!8Nh2LCtWPaFIK@n;NviTEjl&k!Fo_|??@e>eCw#QEHr`{xGY zd_K$kCgQiy0>XSH@dkre65nd@TH<>QzM1$#2ET_mo_Aqjzn>)jg2BVYCk#G7{HF## zMEs8iKSDg87GC!I4DmY*{v7dD27i(GJqG_8@%s$^ZQ^*|rMH*oJ)U>ze3azBYVbFR zzijZoC;n4|PY{30;J+e1WAKZ_@w`i~5B!)yw2b`7zXBKRxH){=ah*2 zd#A>`fUup-8b7A-tr|x=EPsGFkK(7NzjoV<0{r*_vf3ERgXj+(i9p8~h{0Pil7Xnap-hYy6PLf2eU?{+~3i%YOg| z5CRtS+{FAf#IYLB!o_|UY4Tq{K?=nh*X`V-@h`G4#7i~%&q1E;uh8Vt4lR44Op`yM z$@6?fIjrk5H21Yj*U0z;{!&ugec< z{5nWuK>K>Xc@aXuejA31`>hlq1eD(c7u(;85CZapa53MB5CU?2oskg!@cifBBY3F* zm`8AZrXo}Lv3n?ulZCtL^xc=V9 z_W~BzX!1Np$U8L7V}X1~;~zpm;e^JoX9#gh<2=?_Jf(5I$E6xJ2m(eo$dvly)i~d4 zSW=_$C7OIMaqRm?H9n-t^IC+(NliZU6<&xJGo>obp zWa|g%*_vsQY-i@#Egzj{E9aa-(usMtlxZvb@O)OXbdH`ao8z5N&o3jU4$?0p=h-!NI#wii;{38VVA(~{a3;# z(qJ!1+C6?aFNUM`lI~b!03Tfc$AG`vS?FM+h8VB?8zFx;T)c;F_D2qYwzYyeEk7GA|9$H<0%N+Cv(K!TNA8oQ< zj@|qZp)v$rANND7$FZCKVX2+1kNY^*{Hg` z*iHWh2YuXsvL457`Y$`^KQssZlMed04`sg`yZKK!=;Ql4>v8O+KklIa$Q<-1NT2tH z8zJB1pzj5STPu2vgp>+rDQ?s^oxo@tMx{dF-U{1NlO`%LwMxasQ~~sl`$fJVid8ZF ze~rv{Ccdq@`J(wpVFx>Q_MtGE=UU{NwoOp-9g_x(qI-_D|ob z1TT<0wjbMUw!a=2`oF@cz#whX^}Qm9<s;hJ(&6_D0Hg7~H|Lf!*_bhra+mGi3PW}hUe+Mb!_}vbd>HniH{uj}vjFus? zlH2||7yUZYuSjdE1h!QVce&Jm(xLyBfudReoi6_Okbg3hc4_wC!!G)-kbYxYQzcCO z2VLrafgG2TKKB2|;WF$0IT!!@Q+a$o=)v@l->KkV&ic264kOq<+c5R{eR)&zmfdo*_<9s|M(w~o%~mmf383J$F%AHYB1>3{@2Jq|Gt~+VEV`B zhLisu@;^w5=)c^-{~8zn*V5q**Wb;5xr_fPhyJg0@c&5{|8?XapYM7A@vMOVkIAY1 z(+>XeS#S3Lu#5ljEZhHS7ym_{P}S7uU$uk(Z@T#ZBKhykYHjZG|792d%gDbz{_7n4 z|Cs#eL#&5al|A*6Ax>fw*9uR};*OZs;h+|oMOz`bPJQLDJ{{KgaT1 zf6lLUY5z%TKY!1``@aq@*5~$PeN5kI`!ER<(>~A#?0&dReLTa4D&&L{A5-W~Rv-zp T{rH%2(l5fwLfB>$n)?3@7C7ON diff --git a/lpair_2diss/cdf/src/accept.f b/lpair_2diss/cdf/src/accept.f deleted file mode 100644 index b8268ca..0000000 --- a/lpair_2diss/cdf/src/accept.f +++ /dev/null @@ -1,14 +0,0 @@ - SUBROUTINE ACCEPT(n) -C -C Save events -C - implicit double precision (a-h,o-z) -* - integer n -* - CALL pawfil1 ! fill PAW ntuple/histograms - CALL genzfil ! fill GENZ output -* - RETURN - - END diff --git a/lpair_2diss/cdf/src/angle.f b/lpair_2diss/cdf/src/angle.f deleted file mode 100644 index 62f02c2..0000000 --- a/lpair_2diss/cdf/src/angle.f +++ /dev/null @@ -1,23 +0,0 @@ - - FUNCTION MYULANGL(X,Y) -C...Purpose: to reconstruct an angle from given x and y coordinates. - - REAL ULANGL,R,PI - PI = ACOS(-1.) - - ULANGL=0. - R=SQRT(X**2+Y**2) - IF(R.LT.1E-20) RETURN - IF(ABS(X)/R.LT.0.8) THEN - ULANGL=SIGN(ACOS(X/R),Y) - ELSE - ULANGL=ASIN(Y/R) - IF(X.LT.0..AND.ULANGL.GE.0.) THEN - ULANGL=PI-ULANGL - ELSEIF(X.LT.0.) THEN - ULANGL=-PI-ULANGL - ENDIF - ENDIF - - RETURN - END diff --git a/lpair_2diss/cdf/src/dangle.f b/lpair_2diss/cdf/src/dangle.f deleted file mode 100644 index fe7978b..0000000 --- a/lpair_2diss/cdf/src/dangle.f +++ /dev/null @@ -1,24 +0,0 @@ -C...PYANGL -C...Reconstructs an angle from given x and y coordinates. - - FUNCTION PYANGL(X,Y) -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - - PI = ACOS(-1.0D0) - PYANGL=0D0 - R=SQRT(X**2+Y**2) - IF(R.LT.1D-20) RETURN - IF(ABS(X)/R.LT.0.8D0) THEN - PYANGL=SIGN(ACOS(X/R),Y) - ELSE - PYANGL=ASIN(Y/R) - IF(X.LT.0D0.AND.PYANGL.GE.0D0) THEN - PYANGL=PI-PYANGL - ELSEIF(X.LT.0D0) THEN - PYANGL=-PI-PYANGL - ENDIF - ENDIF - - RETURN - END diff --git a/lpair_2diss/cdf/src/f.f b/lpair_2diss/cdf/src/f.f deleted file mode 100644 index 1000252..0000000 --- a/lpair_2diss/cdf/src/f.f +++ /dev/null @@ -1,202 +0,0 @@ - DOUBLE PRECISION function f(x) - IMPLICIT NONE - -*---- Local variables - DOUBLE PRECISION x,dj,pi - DOUBLE PRECISION peripp - DOUBLE PRECISION st3,wnvmass,yy - 1 ,w31min,w31max,w13,w132,dw13 - 1 ,w52min,w52max,w25,w252,dw25 - DOUBLE PRECISION pt6,pz6,pt7,pz7,eta6,eta7 - INTEGER i - -*---- Common blocks variables - DOUBLE PRECISION me,mu,ebeam,const,sq - DOUBLE PRECISION e,e1,e2,e3,e4,e5,p,p3,p4,p5,ct3,st4,ct4 - 1 ,ct5,st5,cp3,sp3,cp5,sp5 - DOUBLE PRECISION e6,e7,p6,p7,ct6,st6,ct7,st7,cp6,sp6,cp7,sp7,w - DOUBLE PRECISION xl,v1,v2,av - DOUBLE PRECISION s1,s2,t1,t2 - DOUBLE PRECISION w1,w2,w3,w4,w5,w31,w52,w12,tau,sl1 - DOUBLE PRECISION gram,d1,d2,d3,d4,d5,delta,g4,a1,a2 - DOUBLE PRECISION epsi,g5,g6,a5,a6,bb - DOUBLE PRECISION q1dq,q1dq2,w6 - INTEGER nn - DOUBLE PRECISION angcut,encut,etacut,mxcut - - COMMON/inpu/me,mu,ebeam,const,sq - COMMON/variab/e,e1,e2,e3,e4,e5,p,p3,p4,p5,ct3,st3,ct4,st4 - 1 ,ct5,st5,cp3,sp3,cp5,sp5 - COMMON/variad/e6,e7,p6,p7,ct6,st6,ct7,st7,cp6,sp6,cp7,sp7,w - COMMON/lplot/xl(10),v1(2),v2(2),av(10) - COMMON/extra/s1,s2,t1,t2 - COMMON/pickzz/w1,w2,w3,w4,w5,w31,w52,w12,tau,sl1 - COMMON/levi/gram,d1,d2,d3,d4,d5,delta,g4,a1,a2 - COMMON/civita/epsi,g5,g6,a5,a6,bb - COMMON/dotps/q1dq,q1dq2,w6 - COMMON/tell/nn - COMMON/cuts/angcut,encut,etacut,mxcut -* - INTEGER IPAR(20) - REAL*8 LPAR(20) - COMMON/DATAPAR/IPAR,LPAR -* - DIMENSION x(10) - data pi/3.141592459d+00/ - nn=nn+1 - -*---- proton form factors - - IF((ipar(5).EQ.8).OR.(ipar(5).EQ.9)) THEN - w31min = (me+0.135)**2 - w31max = (sq-me-2.*mu)**2 - yy = w31max/w31min - w132 = w31min*yy**x(8) - w13 = dsqrt(w132) - IF(ipar(10).EQ.0) THEN - dw13 = w132*dlog(yy) ! Vermaseren (paper) - ELSEIF(ipar(10).EQ.1) THEN - dw13 = w132*dlog(yy)/(me*me) ! Vermaseren (experimental) - ENDIF - w52min = (me+0.135)**2 - w52max = (sq-w13-2*mu)**2 - yy = w52max/w52min - w252 = w52min*yy**x(9) - w25 = dsqrt(w252) - IF(ipar(10).EQ.0) THEN - dw25 = w252*dlog(yy) ! Vermaseren (paper) - ELSEIF(ipar(10).EQ.1) THEN - dw25 = w252*dlog(yy)/(me*me) ! Vermaseren (experimental) - ENDIF - ENDIF - - IF(ipar(5).EQ.9) THEN -* inelastic-inelastic - IF((w13.gt.mxcut).or.(w25.gt.mxcut)) GOTO 30 - CALL gamgam(ebeam,me,me,w13,w25,mu,mu,0.D+00,sq,dj,0,x,1) - ELSEIF(ipar(5).EQ.8) THEN -* inelastic-elastic - IF(w13.gt.mxcut**2) GOTO 30 - CALL gamgam(ebeam,me,me,w13,me,mu,mu,0.D+00,sq,dj,0,x,1) - ELSEIF(ipar(5).EQ.7) THEN -* elastic-elastic - CALL gamgam(ebeam,me,me,me,me,mu,mu,0.0D+02,sq,dj,0,x,1) - ENDIF -* - IF(dj.EQ.0)GO TO 20 -* - IF(ipar(9).EQ.1) THEN -* -* * -------------------------------- * -* * ---- Bryan's analysis cuts ----- * -* * -------------------------------- * -* -* 1 ----- cos(theta) cuts -* IF ( dabs(ct6) .GT. angcut ) goto 30 -* IF ( dabs(ct7) .GT. angcut ) goto 30 -* -* 2 ----- rapidity cuts -* - pt6 = p6*st6 - pt7 = p7*st7 - pz6 = p6*ct6 - pz7 = p7*ct7 -* - eta6=dsign(dlog((dsqrt(pt6**2+pz6**2)+dabs(pz6))/pt6),pz6) - eta7=dsign(dlog((dsqrt(pt7**2+pz7**2)+dabs(pz7))/pt7),pz7) -* - IF (dabs(eta6).GT.etacut) goto 30 - IF (dabs(eta7).GT.etacut) goto 30 -* -* 3 ----- transverse momentum cuts -* - IF ( ( p6*st6.LT.lpar(7) ).OR.( p7*st7.LT.lpar(7) ) ) goto 30 -* -* 4 ----- invariant mass cuts -* - wnvmass = dsqrt( (e6+e7)**2 - (p6*st6*cp6 + p7*st7*cp7)**2 - & - (p6*st6*sp6 + p7*st7*sp7)**2 - & - ( p6*ct6 + p7*ct7)**2 ) - IF( (wnvmass.LT.lpar(8) ).OR.( wnvmass.GT.lpar(9) ) ) goto 30 -* - ELSEIF(ipar(9).EQ.0) THEN -* -* * ----------------------------------- * -* * ---- Vermaseren analysis cuts ----- * -* * ----------------------------------- * -* -* 1 --- invariant mass cut (UNUSED) -* IF ( w4 .LT. 9. ) goto 30 -* -* 2 --- energy cuts (UNUSED) -* IF ( e6 .LT. encut ) goto 30 -* IF ( e7 .LT. encut ) goto 30 -* -* 3 --- cos(theta) cuts (USED) - IF ( dabs(ct6) .GT. angcut ) goto 30 - IF ( dabs(ct7) .GT. angcut ) goto 30 -* -* 4 --- transverse momentum cuts (UNUSED) -* IF ( p6*st6.LT.0.4*dsqrt(w4) ) goto 30 -* IF ( p7*st7.LT.0.4*dsqrt(w4) ) goto 30 -* -* 5 --- transverse momentum cuts and cos(theta) cuts (USED) - IF ( ( p6*st6.LT.1.0 ).AND.( dabs(ct6).LT.0.75 ) ) goto 30 - IF ( ( p7*st7.LT.1.0 ).AND.( dabs(ct7).LT.0.75 ) ) goto 30 -* -* 6 --- longitudinal momentum cuts and cos(theta) cuts (USED) - IF ( ( abs(p6*ct6).LT.1.0 ).AND.( dabs(ct6).GT.0.75 ) ) goto 30 - IF ( ( abs(p7*ct7).LT.1.0 ).AND.( dabs(ct7).GT.0.75 ) ) goto 30 -* -* 7 --- tagging cut (UNUSED) -* ppcut = 0.5*(p3*st3)**2 + 0.5*(p5*st5)**2 - 0.25*(p4*st4)**2 -* IF ( ppcut .GT. 0.01 ) goto 30 -* - ENDIF - -* -* ------------------------------------ * -* ---- matrix element calculation ---- * -* ------------------------------------ * -* - IF(ipar(5).EQ.9) THEN - f=const*dj*peripp(2,2)*dw13*dw25 ! inelastic-inelastic p p - ELSEIF(ipar(5).EQ.8) THEN - f=const*dj*peripp(2,1)*dw13 ! inelastic-elastic p p - ELSEIF(ipar(5).EQ.7) THEN - IF(ipar(8).EQ.2212) THEN - f=const*dj*peripp(1,1) ! elastic-elastic p p - ELSEIF(ipar(8).EQ.11) THEN - f=const*dj*peripp(0,0) ! electron-positron - ENDIF - ENDIF -* - IF(f.LT.0)GO TO 20 -* -* ---- fill entries for histograms - do 2 i=1,7 - 2 xl(i)=x(i) - xl(1) = dlog10(-t1) - xl(2) = dlog10(-t2) - xl(3) = dsqrt(w4) - xl(4) = p6*st6 - xl(5) = p7*st7 - xl(6) = p4*st4 - v1(1) = xl(1) - v2(1) = xl(2) -* -* ---- fill ntuple entries and genz (move to accept.f) -* -c CALL pawfil1 -c CALL genzfil -* - RETURN - 20 CONTINUE -c PRINT *,'Matrix element is negative' - 30 f = 0. - do 3 i=1,7 - 3 xl(i)=-100. - v1(1) = 0. - v2(1) = 0. - RETURN - END diff --git a/lpair_2diss/cdf/src/fileini.f b/lpair_2diss/cdf/src/fileini.f deleted file mode 100644 index ba2b2a7..0000000 --- a/lpair_2diss/cdf/src/fileini.f +++ /dev/null @@ -1,95 +0,0 @@ - SUBROUTINE fileini -* - IMPLICIT none -* -* --- define data common -* - INTEGER IPAR(20) - REAL*8 LPAR(20) - COMMON/DATAPAR/IPAR,LPAR -* - INTEGER LUN - CHARACTER(len=32) file - LOGICAL fexst -* - LUN = 15 - CALL LUGIVE("MSTU(21)=1") -* -* LF workaround to pass the input card as an argument - IF (iargc().gt.0) then - CALL getarg(1,file) - ELSE - file='lpair.dat' - ENDIF - INQUIRE(file=file,exist=fexst) ! ensure the input card exists - IF (fexst.eqv..false.) THEN - PRINT *,'FILEINI: ERROR! Input card does not exist!' - STOP - ENDIF -* - OPEN(LUN,file=file,status='old') -* - READ(LUN,'(I10)') IPAR(1) ! event or cross-section calculation - READ(LUN,'(I10)') IPAR(2) ! paw histograms/ntuple - READ(LUN,'(I10)') IPAR(3) ! gnz histograms/ntuple - READ(LUN,'(I10)') IPAR(4) ! read 'ineemm.data' for graph - READ(LUN,'(I10)') IPAR(5) ! VEGAS dimensions - READ(LUN,'(I10)') IPAR(6) ! VEGAS points per iteration - READ(LUN,'(I10)') IPAR(7) ! VEGAS iterations - READ(LUN,'(I10)') IPAR(8) ! incoming particle type - READ(LUN,'(I10)') IPAR(9) ! vermaseren or caron cuts - READ(LUN,'(I10)') IPAR(10) ! vermaseren form factor selection - READ(LUN,'(I10)') IPAR(11) ! max # of events to GNZ output - READ(LUN,'(I10)') IPAR(12) ! GENERA: # of events to generate - READ(LUN,'(I10)') IPAR(13) ! TREAT: non-smooth or smooth F - READ(LUN,'(I10)') IPAR(14) ! SETGEN: points per bin - READ(LUN,'(I10)') IPAR(15) ! SETGEN: nbin - READ(LUN,'(I10)') IPAR(16) ! vector rotation flag - READ(LUN,'(I10)') IPAR(17) ! hepevt common block to ascii output -* - READ(LUN,'(D10.4)') LPAR(1) ! incoming particle mass (GeV) - READ(LUN,'(D10.4)') LPAR(2) ! outgoing particle mass (GeV) - READ(LUN,'(D10.4)') LPAR(3) ! beam energy (GeV) - READ(LUN,'(D10.4)') LPAR(4) ! maximum angle (rad) - READ(LUN,'(D10.4)') LPAR(5) ! maximum rapidity - READ(LUN,'(D10.4)') LPAR(6) ! energy cut (GeV) - READ(LUN,'(D10.4)') LPAR(7) ! minimum P_t - READ(LUN,'(D10.4)') LPAR(8) ! minimum invariant mass - READ(LUN,'(D10.4)') LPAR(9) ! maximum invariant mass - READ(LUN,'(D10.4)') LPAR(10) ! maximum MX -* - close(LUN) -* - PRINT*,'***** INPUT LPAIR PARAMETERS *****' - PRINT*,'IPAR(1): event generation ',IPAR(1) - PRINT*,'IPAR(2): paw ntuple ',IPAR(2) - PRINT*,'IPAR(3): gnz output ',IPAR(3) - PRINT*,'IPAR(4): lpair plot ',IPAR(4) - PRINT*,'IPAR(5): VEGAS dim ',IPAR(5) - PRINT*,'IPAR(6): VEGAS points ',IPAR(6) - PRINT*,'IPAR(7): VEGAS iterations ',IPAR(7) - PRINT*,'IPAR(8): beam particle ',IPAR(8) - PRINT*,'IPAR(9): cuts ',IPAR(9) - PRINT*,'IPAR(10): form factor ',IPAR(10) - PRINT*,'IPAR(11): max GNZ events ',IPAR(11) - PRINT*,'IPAR(12): GENERA events ',IPAR(12) - PRINT*,'IPAR(13): TREAT smooth ',IPAR(13) - PRINT*,'IPAR(14): SETGEN points/bin ',IPAR(14) - PRINT*,'IPAR(15): SETGEN nbin ',IPAR(15) - PRINT*,'IPAR(16): reflection flag ',IPAR(16) - PRINT*,'IPAR(17): hepevt to ascii ',IPAR(17) -* - PRINT*,'LPAR(1): incoming mass ',LPAR(1) - PRINT*,'LPAR(2): outgoing mass ',LPAR(2) - PRINT*,'LPAR(3): beam energy ',LPAR(3) - PRINT*,'LPAR(4): max angle ',LPAR(4) - PRINT*,'LPAR(5): max rapidity ',LPAR(5) - PRINT*,'LPAR(6): energy cut ',LPAR(6) - PRINT*,'LPAR(7): min P_t ',LPAR(7) - PRINT*,'LPAR(8): min invmass ',LPAR(8) - PRINT*,'LPAR(9): max invmass ',LPAR(9) - PRINT*,'LPAR(10): max dissoc.mass',LPAR(10) -* - RETURN - END - diff --git a/lpair_2diss/cdf/src/fragmentation.f b/lpair_2diss/cdf/src/fragmentation.f deleted file mode 100644 index 0d95b15..0000000 --- a/lpair_2diss/cdf/src/fragmentation.f +++ /dev/null @@ -1,449 +0,0 @@ -c Fragmentation algorithm -c Connects LPAIR output to Jetset for string fragmentation -c -c Authors : -c ... -c N. Schul (UCL, Louvain-la-Neuve) -c L. Forthomme (UCL, Louvain-la-Neuve), Feb 2014 - - SUBROUTINE FRAGMENTATION - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - -c Pair produced code - INTEGER IPAIR,NLHE - PARAMETER (IPAIR=24) - INTEGER L,NLEP - - INTEGER NPART,NLIMAX - PARAMETER (NLIMAX=13) - REAL*4 PL(4,NLIMAX),PMXDA(4),PMXDB(4) - REAL*4 I2MASS(NLIMAX) - DATA I2MASS/NLIMAX*-9999.9/ - -c LUND common - REAL*4 P(4000,5) - INTEGER N,K(4000,5) - COMMON/LUJETS/N,K,P - save /lujets/ - -c Parameters pi - REAL*4 PI2,PI - PARAMETER (PI2=2.0*3.14159265) - PARAMETER (PI=3.14159265) -c For LUJOIN - INTEGER JLPSF1(2),JLPSF2(2) - DATA JLPSF1/10,11/ - DATA JLPSF2/12,13/ - -c for MX - REAL*8 MX1,MX2,WX1,WX2,W1,W6,W3,W8 - INTEGER I2STAT(13),I2PART(13) - INTEGER I2MO1(13),I2DA1(13),I2DA2(13) - REAL*4 RANUDQ3,RANUDQ4 - COMMON/REMNTS/MX1,MX2 - -c Allow W+ -> l+ v only - COMMON/LUDAT3/MDME(8750,2) - SAVE /LUDAT3/ - -c HEPEVT common - PARAMETER (NMXHEP=10000) - COMMON/HEPEVT/NEVHEP,NHEP, - & ISTHEP(NMXHEP),IDHEP(NMXHEP), - & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP), - & PHEP(5,NMXHEP),VHEP(4,NMXHEP) - REAL PHEP,VHEP - -c Event common - LOGICAL ACCEPTED - INTEGER NDIM - DOUBLE PRECISION x(10) - COMMON/event/accepted,ndim,x - - INTEGER I,J - LOGICAL FRAGMENT(2) -! -! INCOMING p+_1 == 1 -! photon 1 == 2 -! DISSOCIATED p+_1 == 3 -! Quark/Diquark == 4&5 - -! -! INCOMING p+_2 == 6 -! photon 2 == 7 -! DISSOCIATED p+_2 == 8 -! Quark/Diquark == 9&10 - -***** PHEP common block content -* 1 proton (incoming, left) -* 2 proton (incoming,right) -* 3 proton (outgoing, left) -* 4 muon-pair (resonance product) -* 5 proton (outgoing,right) -* 6 muon (outgoing, left) -* 7 muon (outgoing,right) -* -* -* 1 ------x------------ 3 -* p \ p/q -* gam \ -* \_________ 6 -* | ell+- -* | 4 -* |_________ 7 -* / ell-+ -* gam / -* / -* 2 ------x------------ 5 -* p p/q -* -***** - - IF(NDIM.EQ.7) THEN - FRAGMENT(1)=.FALSE. - FRAGMENT(2)=.FALSE. - ELSEIF(NDIM.EQ.8) THEN - FRAGMENT(1)=.TRUE. - FRAGMENT(2)=.FALSE. - ELSEIF(NDIM.EQ.9) THEN - FRAGMENT(1)=.TRUE. - FRAGMENT(2)=.TRUE. - ELSE - GOTO 22 - ENDIF - -c PRINT *,'To fragment :',(FRAGMENT(I),I=1,2) - -c... READ the kinematics from the event - NFAIL=0 - 1 J=rand(0)*6561+1. - NFAIL=NFAIL+1 - IF(NFAIL.GT.9999) THEN - WRITE(*,*) 'SKIP Event' - RETURN - ENDIF - -***** PL (Lund) kinematic quantities mapping -* -* 1 ------x------------ 5 -* p \ p/q -* 3 \ gam -* \_________ 8 -* | ell+- -* | 6 -* |_________ 9 -* / ell-+ -* 4 / gam -* / -* 2 ------x------------ 7 -* p p/q -* -***** - - NPART=9 -c... Fill the Lund common block -C PARTICLE 1 = "PROTON1" <=================================== - PL(1,1)=PHEP(1,1) - PL(2,1)=PHEP(2,1) - PL(3,1)=PHEP(3,1) - PL(4,1)=PHEP(4,1) -C PARTICLE 2 = "PROTON2" <=================================== - PL(1,2)=PHEP(1,2) - PL(2,2)=PHEP(2,2) - PL(3,2)=PHEP(3,2) - PL(4,2)=PHEP(4,2) -C PARTICLE 5 = QUARK1 OUT <================================== - PL(1,5)=PHEP(1,3) - PL(2,5)=PHEP(2,3) - PL(3,5)=PHEP(3,3) - PL(4,5)=PHEP(4,3) -C PARTICLE 7 = QUARK2 OUT <================================== - PL(1,7)=PHEP(1,5) - PL(2,7)=PHEP(2,5) - PL(3,7)=PHEP(3,5) - PL(4,7)=PHEP(4,5) -C PARTICLE 3 = GAMMA1 - PL(1,3)=PHEP(1,1)-PHEP(1,3) - PL(2,3)=PHEP(2,1)-PHEP(2,3) - PL(3,3)=PHEP(3,1)-PHEP(3,3) - PL(4,3)=PHEP(4,1)-PHEP(4,3) -C PARTICLE 4 = GAMMA2 - PL(1,4)=PHEP(1,2)-PHEP(1,5) - PL(2,4)=PHEP(2,2)-PHEP(2,5) - PL(3,4)=PHEP(3,2)-PHEP(3,5) - PL(4,4)=PHEP(4,2)-PHEP(4,5) -C Particle 6 --> middle particle - PL(1,6)=PHEP(1,4) - PL(2,6)=PHEP(2,4) - PL(3,6)=PHEP(3,4) - PL(4,6)=PHEP(4,4) -CLF PARTICLE 8 = LEPTON1 - PL(1,8)=PHEP(1,6) - PL(2,8)=PHEP(2,6) - PL(3,8)=PHEP(3,6) - PL(4,8)=PHEP(4,6) -CLF PARTICLE 9 = LEPTON2 - PL(1,9)=PHEP(1,7) - PL(2,9)=PHEP(2,7) - PL(3,9)=PHEP(3,7) - PL(4,9)=PHEP(4,7) - -c DO 2000 I=1,7 -c PRINT *,'PHEP:',I,':',(PHEP(J,I),J=1,4) -c 2000 CONTINUE -c PRINT *,(PHEP(I,1)+PHEP(I,2),I=1,4) -c PRINT *,(PHEP(I,3)+PHEP(I,5)+PHEP(I,6)+PHEP(I,7),I=1,4) -c PRINT *,(PHEP(I,1)+PHEP(I,2)- -c & (PHEP(I,3)+PHEP(I,5)+PHEP(I,6)+PHEP(I,7)),I=1,4) -c PRINT *,'' -c PRINT *,'PHEP3=',(PHEP(I,3),I=1,4) -c PRINT *,'PHEP5=',(PHEP(I,5),I=1,4) -c PRINT *,(PHEP(I,6),I=1,4) -c PRINT *,(PHEP(I,7),I=1,4) -c PRINT *,'PL5=',(PL(I,7),I=1,4) -c PRINT *,'PL7=',(PL(I,7),I=1,4) -c PRINT *,PHEP(5,3),PHEP(5,5) - -c Default status for the outgoing protons is 1 ('stable') - I2STAT(5)=1 - I2STAT(7)=1 - -c... choose the quark content - - IF(FRAGMENT(1)) THEN -c... compute the MX value - WX1=(1.1449)*(102400/1.1449)**X(8) - MX1=DSQRT(WX1) -c smearing of the mass (N. Schul) -c WRITE(*,*) 'mx1, mx2=',MX1,MX2 - VARYMX1=rand(0)*(0.1*MX1) - MX1=MX1+VARYMX1 -c WRITE(*,*) 'corr mx1=',MX1 - -C====> INSERT THE MASS OF THE HADRONIC SYSTEM <================== - I2MASS(5)=SNGL(MX1) -C===> RANDOM SELECTION OF U , D AND DI QUARKS <================== - RANUDQ4=rand(0) - IF (RANUDQ4 .LT. 1.0/9.0) THEN - I2PART(10)=1 - I2PART(11)=2203 - ELSEIF (RANUDQ4 .LT. 5.0/9.0) THEN - I2PART(10)=2 - I2PART(11)=2101 - ELSE - I2PART(10)=2 - I2PART(11)=2103 - ENDIF - ULMQ4=ULMASS(I2PART(10)) - ULMDQ4=ULMASS(I2PART(11)) - I2STAT(5)=21 - ENDIF - - IF(FRAGMENT(2)) THEN -c... compute the MX value - WX2=(1.1449)*(102400/1.1449)**X(9) - MX2=DSQRT(WX2) -c smearing of the mass (N. Schul) -c WRITE(*,*) 'mx1, mx2=',MX1,MX2 - VARYMX2=rand(0)*(0.1*MX2) - MX2=MX2+VARYMX2 -c WRITE(*,*) 'corr mx2=',MX2 - -C====> INSERT THE MASS OF THE HADRONIC SYSTEM <================== - I2MASS(7)=SNGL(MX2) -C===> RANDOM SELECTION OF U , D AND DI QUARKS <================== - RANUDQ3=rand(0) - IF (RANUDQ3 .LT. 1.0/9.0) THEN - I2PART(12)=1 - I2PART(13)=2203 - ELSEIF (RANUDQ3 .LT. 5.0/9.0) THEN - I2PART(12)=2 - I2PART(13)=2101 - ELSE - I2PART(12)=2 - I2PART(13)=2103 - ENDIF - ULMQ3=ULMASS(I2PART(12)) - ULMDQ3=ULMASS(I2PART(13)) - I2STAT(7)=21 - ENDIF - -C... Set Lund code -* -* 1 : incoming proton 1 - I2STAT(1)=21 - I2PART(1)=2212 - I2MO1(1)=0 - I2DA1(1)=3 - I2DA2(1)=5 - -* 2 : incoming proton 2 - I2STAT(2)=21 - I2PART(2)=2212 - I2MO1(2)=0 - I2DA1(2)=4 - I2DA2(2)=7 - -* 3 : photon 1 - I2STAT(3)=11 - I2PART(3)=22 - I2MO1(3)=1 - I2DA1(3)=0 - I2DA2(3)=0 - -* 4 : photon 2 - I2STAT(4)=11 - I2PART(4)=22 - I2MO1(4)=2 - I2DA1(4)=6 - I2DA2(4)=0 - -* 5 : outgoing proton 1 - I2PART(5)=2212 - I2MO1(5)=1 - I2DA1(5)=0 - I2DA2(5)=0 - -* 6 : central system (mother : photon 2) -* I2STAT(6)=1 -* I2PART(6)=14 ! muon neutrino ?! - I2STAT(6)=11 - I2PART(6)=100 - I2MO1(6)=4 - I2DA1(6)=8 - I2DA2(6)=9 - -* 7 : outgoing proton 2 - I2PART(7)=2212 - I2MO1(7)=2 - I2DA1(7)=0 - I2DA2(7)=0 - -* 8 : muon 1 !!! need to check the charge - I2STAT(8)=1 - I2PART(8)=-13 - I2MO1(8)=6 - I2DA1(8)=0 - I2DA2(8)=0 - -* 9 : muon 2 !!! need to check the charge - I2STAT(9)=1 - I2PART(9)=13 - I2MO1(9)=6 - I2DA1(9)=0 - I2DA2(9)=0 - - IF(FRAGMENT(1)) THEN -* 10 : quark 1 - I2STAT(10)=1 - I2MO1(10)=5 - I2DA1(10)=0 - I2DA2(10)=0 - -* 11 : diquark 1 - I2STAT(11)=1 - I2MO1(11)=5 - I2DA1(11)=0 - I2DA2(11)=0 - -C==== > CHOOSE RANDOM DIRECTION IN MX FRAME <==================== - RANMXP1=PI2*rand(0) - RANMXT1=ACOS(2.0*rand(0)-1.0) - -C==== > COMPUTE MOMENTUM OF DECAY PARTICLE FROM MX2 <============ - PMXP1=DSQRT((MX1**2-ULMDQ4**2+ULMQ4**2)**2/ - & 4.0/MX1/MX1-ULMQ4**2) - - PMXDB(1)=SIN(RANMXT1)*COS(RANMXP1)*PMXP1 - PMXDB(2)=SIN(RANMXT1)*SIN(RANMXP1)*PMXP1 - PMXDB(3)=COS(RANMXT1)*PMXP1 - PMXDB(4)=SQRT(PMXP1**2+ULMDQ4**2) - CALL LORENB(I2MASS(5),PL(1,5),PMXDB(1),PL(1,11)) - - PMXDB(1)=-PMXDB(1) - PMXDB(2)=-PMXDB(2) - PMXDB(3)=-PMXDB(3) - PMXDB(4)=SQRT(PMXP1**2+ULMQ4**2) - CALL LORENB(I2MASS(5),PL(1,5),PMXDB(1),PL(1,10)) - -c We added 2 'particles' in the event (quark and diquark) - NPART=NPART+2 - - ENDIF - - IF(FRAGMENT(2)) THEN -* 12 : quark 2 - I2STAT(12)=1 - I2MO1(12)=7 - I2DA1(12)=0 - I2DA2(12)=0 - -* 13 : diquark 2 - I2STAT(13)=1 - I2MO1(13)=7 - I2DA1(13)=0 - I2DA2(13)=0 - -C==== > CHOOSE RANDOM DIRECTION IN MX FRAME <==================== - RANMXP2=PI2*rand(0) - RANMXT2=ACOS(2.0*rand(0)-1.0) - -C==== > COMPUTE MOMENTUM OF DECAY PARTICLE FROM MX1 <============ - PMXP2=DSQRT((MX2**2-ULMDQ3**2+ULMQ3**2)**2/ - & 4.0/MX2/MX2-ULMQ3**2) - - PMXDA(1)=SIN(RANMXT2)*COS(RANMXP2)*PMXP2 - PMXDA(2)=SIN(RANMXT2)*SIN(RANMXP2)*PMXP2 - PMXDA(3)=COS(RANMXT2)*PMXP2 - PMXDA(4)=SQRT(PMXP2**2+ULMDQ3**2) - CALL LORENB(I2MASS(7),PL(1,7),PMXDA(1),PL(1,13)) - - PMXDA(1)=-PMXDA(1) - PMXDA(2)=-PMXDA(2) - PMXDA(3)=-PMXDA(3) - PMXDA(4)=SQRT(PMXP2**2+ULMQ3**2) - CALL LORENB(I2MASS(7),PL(1,7),PMXDA(1),PL(1,12)) - -c We added 2 'particles' in the event (quark and diquark) - NPART=NPART+2 - - ENDIF -* - - -c DO 2001 I=1,NPART -c PRINT *,'PL:',I,':',(PL(J,I),J=1,4) -c 2001 CONTINUE - - CALL LUNSET(NPART) -C ====> FILLING THE LUND COMMON <============================ - DO 201 I=1,NPART -C SET MOTHER/DAUGHTER VALUES, MARKING PARTICLES AS DECAYED <= - CALL LUKSET(I,I2STAT(I),I2PART(I), - & I2MO1(I),I2DA1(I),I2DA2(I),0) -C SET PULS, ENERGY AND MASS OFF THE PARTICLES <============== - CALL LUPSET(I,PL(1,I),PL(2,I),PL(3,I),PL(4,I),I2MASS(I)) - 201 CONTINUE - - IF(FRAGMENT(1)) CALL LUJOIN(2,JLPSF1) - IF(FRAGMENT(2)) CALL LUJOIN(2,JLPSF2) - - CALL LUEXEC -c IF(K(16,2).EQ.91.AND.K(16,1).EQ.11) THEN -c WRITE(*,*) '-> System non-inelastic' -c GO TO 1 -c ENDIF -clf IF(K(17,2).EQ.2212.AND.K(17,1).EQ.1) THEN -clf WRITE(*,*) '-> System non-inelastic' -clf NFAIL=NFAIL+1 -clf GO TO 1 -clf ENDIF - -c CALL LULIST(2) - - CALL LHEFIL - RETURN - - 22 PRINT *,'ERROR! The number of dimensions is incorrect' - END - diff --git a/lpair_2diss/cdf/src/gamgam.f b/lpair_2diss/cdf/src/gamgam.f deleted file mode 100644 index 121090e..0000000 --- a/lpair_2diss/cdf/src/gamgam.f +++ /dev/null @@ -1,135 +0,0 @@ - SUBROUTINE gamgam(ebeam,v1,v2,v3,v5,v6,v7,vmin,vmax,dj,nopt,x,nm) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - COMMON/variab/e,e1,e2,e3,e4,e5,p,p3,p4,p5,ct3,st3,ct4,st4,ct5, - a st5,cp3,sp3,cp5,sp5 - COMMON/variac/al3,al4,be4,be5,de3,de5,pp3,pp4,pp5 - COMMON/variad/e6,e7,p6,p7,ct6,st6,ct7,st7,cp6,sp6,cp7,sp7,w - COMMON/pickzz/w1,w2,w3,w4,w5,w31,w52,w12,tau,sl1 - COMMON/dotps/q1dq,q1dq2,w6 - COMMON /extra/s1,s2,t1,t2 - COMMON/dotp/p12,p13,p14,p15,p23,p24,p25,p34,p35,p45,p1k2,p2k1 - COMMON/civita/epsi,g5,g6,a5,a6,bb - COMMON/ext/ctg,stg,cpg,spg - COMMON/angu/ctcm6,stcm6 - COMMON/qvec/qve(4) - DIMENSION x(7) - data pi/3.14159265358979d+00/,const/2.1868465d+10/ - w6=v6*v6 - w7=v7*v7 - wmin=v6+v7 - IF(wmin.LT.vmin)wmin=vmin - wmin=wmin*wmin - e=2.*ebeam - s=e*e - wmax=e-v3-v5 - IF(wmax.GT.vmax)wmax=vmax - wmax=wmax*wmax - xw=x(5) - CALL mapw2(w4,xw,wmin,wmax,dw) - v4=dsqrt(w4) - w=v4 - CALL orient(s,v1,v2,v3,v4,v5,dj,nopt,x) - IF(t1.GT.0.OR.t2.GT.0)dj=0. - IF(dj.EQ.0) RETURN - ecm6=(w4+w6-w7)/(2.*v4) - pcm6=dsqrt(ecm6*ecm6-w6) - dj=dj*dw*pcm6/(v4*const*s) - e3mp3=w3/(e3+p3) - e1mp1=w1/(e1+p) - eg=(w4+t1-t2)/(2.*v4) - pg=dsqrt(eg*eg-t1) - pgx=-pp3*cp3*ct4-st4*(de3-e1mp1+e3mp3+p3*al3) - pgy=-pp3*sp3 - pgz=v4*de3/(e4+p4)-e4*de3*al4/v4-pp3*cp3 - a *e4*st4/v4+e4*ct4/v4*(p3*al3+e3mp3-e1mp1) - pgp=dsqrt(pgx*pgx+pgy*pgy) - pgg=dsqrt(pgp*pgp+pgz*pgz) - IF(pgg.GT.pgp*0.9.AND.pgg.GT.pg)pg=pgg - stg=pgp/pg - cpg=pgx/pgp - spg=pgy/pgp - ctg=dsqrt(1.-stg*stg) - IF(pgz.LT.0)ctg=-ctg - xx6=x(6) - IF(nm.EQ.0) GO TO 1 - amap=.5*(w4-t1-t2) - bmap=.5*dsqrt(((w4-t1-t2)**2-4.*t1*t2)*(1.-4.*w6/w4)) - ymap=(amap+bmap)/(amap-bmap) - beta=ymap**(2.*xx6-1.) - xx6=(amap/bmap*(beta-1.)/(beta+1.)+1.)*0.5 - IF(xx6.GT.1.)xx6=1. - IF(xx6.LT.0.)xx6=0. - ctcm6=1.-2.*xx6 - ddd=(amap+bmap*ctcm6)*(amap-bmap*ctcm6)/amap/bmap*dlog(ymap) - dj=dj*ddd*0.5 - 1 ctcm6=1.-2.*xx6 - stcm6=2.*dsqrt(xx6*(1.-xx6)) - phicm6=2.*pi*x(7) - cpcm6=dcos(phicm6) - spcm6=dsin(phicm6) - pcm6x=pcm6*stcm6*cpcm6 - pcm6y=pcm6*stcm6*spcm6 - pcm6z=pcm6*ctcm6 - pc6z=ctg*pcm6z-stg*pcm6x - h1=stg*pcm6z+ctg*pcm6x - pc6x=cpg*h1-spg*pcm6y - qcx=2.*pc6x - qcz=2.*pc6z - p6y=cpg*pcm6y+spg*h1 - e6=(e4*ecm6+p4*pc6z)/v4 - h2=(e4*pc6z+p4*ecm6)/v4 - p6x=ct4*pc6x+st4*h2 - p6z=ct4*h2-st4*pc6x - qve(1)=p4*qcz/v4 - qve(3)=2.*p6y - hq=e4*qcz/v4 - qve(2)=ct4*qcx+st4*hq - qve(4)=ct4*hq-st4*qcx - p6=dsqrt(e6*e6-w6) - e7=e4-e6 - p7=dsqrt(e7*e7-w7) - p7x=pp4-p6x - p7y=-p6y - p7z=p4*ct4-p6z - pp6=dsqrt(p6x*p6x+p6y*p6y) - pp7=dsqrt(p7x*p7x+p7y*p7y) - ct6=p6z/p6 - st6=pp6/p6 - ct7=p7z/p7 - st7=pp7/p7 - cp6=p6x/pp6 - sp6=p6y/pp6 - cp7=p7x/pp7 - sp7=p7y/pp7 - q1dq=eg*(2.*ecm6-v4)-2.*pg*pcm6*ctcm6 - q1dq2=0.5*(w4-t1-t2) - bb=t1*t2+(w4*stcm6*stcm6+4.*w6*ctcm6*ctcm6)*pg*pg - q0=qve(1) - qx=qve(2) - qy=qve(3) - qz=qve(4) - c1=(qx*sp3-qy*cp3)*pp3 - c2=(qz*e1-q0*p)*pp3 - c3=(w31*e1*e1+2.*w1*de3*e1-w1*de3*de3+pp3*pp3*e1*e1) - a /(e3*p+p3*ct3*e1) - b1=(qx*sp5-qy*cp5)*pp5 - b2=(qz*e2+q0*p)*pp5 - b3=(w52*e2*e2+2.*w2*de5*e2-w2*de5*de5+pp5*pp5*e2*e2) - a /(e2*p5*ct5-e5*p) - r12=c2*sp3+qy*c3 - r13=-c2*cp3-qx*c3 - r22=b2*sp5+qy*b3 - r23=-b2*cp5-qx*b3 - epsi=p12*c1*b1+r12*r22+r13*r23 - g5=w1*c1*c1+r12*r12+r13*r13 - g6=w2*b1*b1+r22*r22+r23*r23 - a5=-(qx*cp3+qy*sp3)*pp3*p1k2-(e1*q0-p*qz)*(cp3*cp5+sp3*sp5) - a *pp3*pp5+(de5*qz+q0*(p+p5*ct5))*c3 - a6=-(qx*cp5+qy*sp5)*pp5*p2k1-(e2*q0+p*qz)*(cp3*cp5+sp3*sp5) - a *pp3*pp5+(de3*qz-q0*(p-p3*ct3))*b3 -C LF FIXME... introduced to filter out these negative-energy internal photon 1 events -c IF(E3.GT.E1) dj=0. -c IF(E5.Gt.E2) dj=0. -C LF FIXME - RETURN - END diff --git a/lpair_2diss/cdf/src/genera.f b/lpair_2diss/cdf/src/genera.f deleted file mode 100644 index b532006..0000000 --- a/lpair_2diss/cdf/src/genera.f +++ /dev/null @@ -1,149 +0,0 @@ - SUBROUTINE genera(f,ndim,nevent,nstrat,ntreat) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - DOUBLE PRECISION am,ami,ranf,y,treat,g,h,a,b,t,z,tf,tot - DOUBLE PRECISION ffmax,fmax - INTEGER mbin,max,m,ndim,ncall,mcall,nev,mev,nstrat,nn,j,n(10) - INTEGER k,jj,jjj,ncycle,ntreat,nm,mdum,nevent - EXTERNAL f - - LOGICAL accepted - INTEGER endim - DOUBLE PRECISION x(10) - COMMON/event/accepted,endim,x - - COMMON/maxi/mdum,mbin,ffmax,fmax(80000),nm(80000) - - endim = ndim - - accepted = .FALSE. - am = mbin - ami = 1.D0/am - max = mbin**ndim - nev = 0 - mev = 0 - ncall = 0 - mcall = 0 - tot = 0 !FIXME - m = 0 - IF ( nstrat .GT. 0 ) GO TO 10 - nn = 0 - 1 nn = nn+1 - j = ranf(0)*max+1 - y = ranf(0)*ffmax - nm(j) = nm(j) + 1 - IF ( y .GT. fmax(j) ) GO TO 1 - jj = j-1 - DO 2 k = 1,ndim - jjj = jj/mbin - n(k) = jj-jjj*mbin - x(k) = (ranf(0)+n(k))*ami - jj=jjj - 2 CONTINUE - IF ( ntreat .GT. 0 ) THEN - g = treat(f,x,ndim) - ELSE - g = f(x) - ENDIF - ncall = ncall+1 - IF ( y .GT. g ) GO TO 1 - CALL accept(1) - nev = nev+1 - IF ( nev .GE. nevent ) GO TO 8 - IF ( g .LE. fmax(j) ) GO TO 1 - 3 IF ( nm(j) .EQ. 1 ) GO TO 7 - a = nm(j)*(g-fmax(j))/ffmax - m = m+1 - t = a - 4 IF ( t .LT. 1 ) THEN - IF ( ranf(0) .GT. t ) GO TO 7 - t = 1 - ENDIF - t = t-1 - DO 6 k = 1,ndim - x(k) = (ranf(0)+n(k))*ami - 6 CONTINUE - IF ( ntreat .GT. 0 ) THEN - z = treat(f,x,ndim) - ELSE - z = f(x) - ENDIF - mcall = mcall+1 - ncall = ncall+1 - IF ( z .GE. fmax(j) ) THEN - CALL accept(1) - mev = mev+1 - nev = nev+1 - IF ( nev .GE. nevent ) GO TO 7 - IF ( z .GT. g ) THEN - b = nm(j)*(z-fmax(j))/ffmax - t = t+(b-a) - a = b - g = z - ENDIF - ENDIF - IF ( t .GT. 0 ) GO TO 4 - 7 fmax(j) = g - IF ( nstrat .GT. 0 ) GO TO 18 - IF ( g .GT. ffmax ) ffmax = g - IF ( nev .LT. nevent ) GO TO 1 - 8 CONTINUE -c PRINT 100,nev,ncall,nn -c PRINT 101,m,mev,mcall - accepted = .TRUE. - RETURN - - 10 ncycle = 0 - 11 ncycle = ncycle+1 - h = ffmax - tf = nstrat/ffmax - j = 0 - 12 jj = j - j = j+1 - DO 13 k = 1,ndim - jjj = jj/mbin - n(k) = jj-jjj*mbin - jj = jjj - 13 CONTINUE - tot = fmax(j)*tf - nm(j)= nm(j)+nstrat - g = fmax(j) - 14 IF ( tot .GE. 1. ) GO TO 15 - IF ( tot .LE. 0 ) GO TO 17 - IF ( ranf(0) .GT. tot ) GO TO 17 - 15 tot = tot-1. - DO 16 k = 1,ndim - x(k) = (ranf(0)+n(k))*ami - 16 CONTINUE - IF ( ntreat .GT. 0 ) THEN - z = treat(f,x,ndim) - ELSE - z = f(x) - ENDIF - ncall = ncall+1 - IF ( z .LT. ranf(0)*fmax(j) ) GO TO 14 - IF ( z .GT. g ) g = z - nev = nev+1 - CALL accept(1) - GO TO 14 - 17 IF ( g .GT. fmax(j) ) GO TO 3 - 18 IF ( g .GT. h ) h = g - IF ( j .LT. max ) GO TO 12 - CALL accept(0) - ffmax = h - IF ( nev .LT. nevent ) GO TO 11 - PRINT 102,nev,ncall,ncycle,nstrat - PRINT 101,m,mev,mcall - CALL accept(-1) - accepted = .TRUE. - RETURN - - 100 FORMAT(32h1subroutine genera has produced ,i10,8h events./ - 1 11h this took ,i10,19h function calls in ,i10,10h attempts./) - 101 FORMAT(1h0,i10,29h times a maximum was changed./ - 1 11h this gave ,i8,11h events in ,i9,7h calls.//) - 102 FORMAT(32h1subroutine genera has produced ,i10,8h events./ - 1 11h this took ,i10,16h function calls./ - 2 i10,11h cycles of ,i8,27h points per bin were needed, - 3 28h during stratified sampling.///) - - END diff --git a/lpair_2diss/cdf/src/generate.f b/lpair_2diss/cdf/src/generate.f deleted file mode 100644 index ff9044d..0000000 --- a/lpair_2diss/cdf/src/generate.f +++ /dev/null @@ -1,62 +0,0 @@ - SUBROUTINE generate(nevent) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - DOUBLE PRECISION me,mu,f,mxcut - LOGICAL accepted - COMMON/inpu/me,mu,ebeam,const,sq - COMMON/tell/nn - COMMON/ini/xxx,yyy - COMMON/outp/nout - COMMON/cuts/angcut,encut,etacut,mxcut - COMMON/event/accepted -* - INTEGER ndim,npoin,nprin,ntreat,nevent -* -* --- LPAIR data COMMON block -* - INTEGER IPAR(20) - REAL*8 LPAR(20) - COMMON/DATAPAR/IPAR,LPAR - DOUBLE PRECISION x(10) -* -* - EXTERNAL f -* - -* General definitions - ndim = ipar(5) - ntreat = ipar(13) - npoin= ipar(14) - nbin = ipar(15) - nprin = 1 - nstrat = 0 - n2dim = 7 - -* First we fetch the Vegas integration grid -c OPEN (15,file='dl2.vegas.grid',status='old') -c CALL restr(n2dim,15) -c CLOSE (15) - -* Setgen -c OPEN (16,file='dl2.lattice.1',status='unknown') - CALL setgen(f,ndim,npoin,nbin,nprin,ntreat) -c CALL save2(n2dim,16) -c CLOSE (16) - -* -c OPEN (15,file='dl2.vegas.grid',status='old') -c CALL restr(n2dim,15) -c CLOSE (15) - -c OPEN (16,file='dl2.lattice.1',status='old') -c CALL restr2(n2dim,16) -c CLOSE (16) - -* -c OPEN (17,file='dl2.lattice.2',status='unknown') - CALL genera(f,ndim,nevent,nstrat,ntreat) -c CALL save2(n2dim,17) -c CLOSE (17) - -* -* - END diff --git a/lpair_2diss/cdf/src/genzfil.f b/lpair_2diss/cdf/src/genzfil.f deleted file mode 100644 index efa2c0e..0000000 --- a/lpair_2diss/cdf/src/genzfil.f +++ /dev/null @@ -1,219 +0,0 @@ - subroutine genzfil -* - implicit double precision (a-h,o-z) - double precision me,mu -* -* --- HEPEVT common block - PARAMETER (NMXHEP=10000) - COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), - & JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP), - & VHEP(4,NMXHEP) - REAL PHEP,VHEP - INTEGER I,J -* -* --- LPAIR common blocks -* - common/inpu/me,mu,ebeam,const,sq - common/variab/e,e1,e2,e3,e4,e5,p,p3,p4,p5,ct3,st3,ct4,st4,ct5 - 1 ,st5,cp3,sp3,cp5,sp5 - common/variad/e6,e7,p6,p7,ct6,st6,ct7,st7,cp6,sp6,cp7,sp7,w - common/lplot/xl(10),v1(2),v2(2),av(10) - common/extra/s1,s2,t1,t2 - common/pickzz/w1,w2,w3,w4,w5,w31,w52,w12,tau,sl1 -* -* --- GENZ quantities common block -* - - -* -* --- LPAIR data common block -* - INTEGER IPAR(20) - REAL*8 LPAR(20) - COMMON/DATAPAR/IPAR,LPAR -* -* --- MYGENZ common block -* - common/mygenz/px3,py3,pz3,px4,py4,pz4,px5,py5,pz5, - + px6,py6,pz6,px7,py7,pz7 -* -* -c PRINT *,'Genzfil called' - IF(IPAR(3).EQ.0) RETURN -* - IF(NEVHEP.GE.IPAR(11)) RETURN ! max # of events to GNZ output -* -* ---- begin GENZ (LPAIR) -* -* ---- fill HEPEVT common block -* - NHEP = 7 ! elastic production - P1=SQRT(E1**2-LPAR(1)**2) - P2=SQRT(E2**2-LPAR(1)**2) -c P1=E1 -c P2=-E2 -c PRINT *,p1,p2 -* -* ---- store entries for: -* 1 proton (incoming, left) -* 2 proton (incoming,right) -* 3 proton (outgoing, left) -* 5 proton (outgoing,right) -* 4 muon-pair (resonance product) -* 6 muon (outgoing, left) -* 7 muon (outgoing,right) -* -* ---- initialize all HEPEVT entries to zero - do i=1,nhep - isthep(i)=0. - idhep(i)=0. - do j=1,2 - jmohep(j,i)=0. - jdahep(j,i)=0. - enddo - do j=1,5 - phep(j,i)=0. - enddo - do j=1,4 - vhep(j,i)=0. - enddo - enddo - -* -* ---- proton (incoming, 1) - isthep(1)=1. - idhep(1)=2212. - jmohep(1,1)=0. - jmohep(2,1)=0. - jdahep(1,1)=0. - jdahep(2,1)=0. - phep(1,1)=real(p1)*( 0.) - phep(2,1)=real(p1)*( 0.) - phep(3,1)=real(p1)*( 1.) - phep(4,1)=real(e1) - phep(5,1)=real(me) -* -* ---- proton (incoming, 2) - isthep(2)=1. - idhep(2)=2212. - jmohep(1,2)=0. - jmohep(2,2)=0. - jdahep(1,2)=0. - jdahep(2,2)=0. - phep(1,2)=real(p2)*( 0.) - phep(2,2)=real(p2)*( 0.) - phep(3,2)=real(p2)*(-1.) - phep(4,2)=real(e2) - phep(5,2)=real(me) -* -* ---- proton (outgoing, 3) - isthep(3)=1. - idhep(3)=2212. - jmohep(1,3)=1. - jmohep(2,3)=1. - jdahep(1,3)=0. - jdahep(2,3)=0. - phep(1,3)=real(px3) - phep(2,3)=real(py3) - phep(3,3)=real(pz3) - phep(4,3)=real(e3) - phep(5,3)=real(me) -* -* ---- proton (outgoing, 5) - isthep(5)=1. - idhep(5)=2212. - jmohep(1,5)=2. - jmohep(2,5)=2. - jdahep(1,5)=0. - jdahep(2,5)=0. - phep(1,5)=real(px5) - phep(2,5)=real(py5) - phep(3,5)=real(pz5) - phep(4,5)=real(e5) - phep(5,5)=real(me) -* -* ---- lepton pair (resonance, 4) - isthep(4)=2. - idhep(4)=93. - jmohep(1,4)=1. - jmohep(2,4)=2. - jdahep(1,4)=6. - jdahep(2,4)=7. - phep(1,4)=real(px4) - phep(2,4)=real(py4) - phep(3,4)=real(pz4) - phep(4,4)=real(e4) - phep(5,4)=real(sqrt(w4)) -* -* ---- muon - (outgoing, 6) - isthep(6)=1. - idhep(6)=13. - jmohep(1,6)=4. - jmohep(2,6)=4. - jdahep(1,6)=0. - jdahep(2,6)=0. - phep(1,6)=real(px6) - phep(2,6)=real(py6) - phep(3,6)=real(pz6) - phep(4,6)=real(e6) - phep(5,6)=real(mu) -* -* ---- muon + (outgoing, 7) - isthep(7)=1. - idhep(7)=-13. - jmohep(1,7)=4. - jmohep(2,7)=4. - jdahep(1,7)=0. - jdahep(2,7)=0. - phep(1,7)=real(px7) - phep(2,7)=real(py7) - phep(3,7)=real(pz7) - phep(4,7)=real(e7) - phep(5,7)=real(mu) -* -* -* ... increment counter of lepton pair events produced -* -c DO 2000 I=1,7 -c PRINT *,'PHEP:',I,':',(PHEP(J,I),J=1,4) -c 2000 CONTINUE - NEVHEP = NEVHEP + 1 -* -* ... print some diagnostics -* -c PRINT *, NEVHEP, NHEP -c DO JJ=1,NHEP -c PRINT 4000, JJ, ISTHEP(JJ),IDHEP(JJ), -c & (JMOHEP(I,JJ),I=1,2),(JDAHEP(I,JJ),I=1,2), -c & (PHEP(I,JJ),I=1,5), -c & (VHEP(I,JJ),I=1,4) -c ENDDO -* -* translate HEPEVT to GENZ -* -c CALL GNZFRHC(IRET) -* -c IF(IRET.NE.0) THEN -c WRITE(6,*) 'IRET = ',IRET,' on return from GNZFRHC. STOP' -c CALL GNZEND -c ENDIF -* -* write out event -* -c CALL GNZWRIT(IRET) -c IF(IRET.NE.0) THEN -c WRITE(6,*) 'GNZWRIT: ERROR ...EXIT GNZEND' -c CALL GNZEND -c ENDIF -* -* GENZ printing of first ten events -c IF(NEVHEP.LE.10) THEN -c CALL GNZPRIN(1,4) -c ENDIF -* -* --- end GENZ (LPAIR) -* - 4000 FORMAT(1I2,1I3,1I5,4I2,9E15.6) - - RETURN - END diff --git a/lpair_2diss/cdf/src/integrate.f b/lpair_2diss/cdf/src/integrate.f deleted file mode 100644 index 8bc7aba..0000000 --- a/lpair_2diss/cdf/src/integrate.f +++ /dev/null @@ -1,65 +0,0 @@ - SUBROUTINE integrate - IMPLICIT DOUBLE PRECISION (a-h,o-z) - DOUBLE PRECISION me,mu,f,mxcut - COMMON/inpu/me,mu,ebeam,const,sq - COMMON/tell/nn - COMMON/ini/xxx,yyy - COMMON/outp/nout - COMMON/cuts/angcut,encut,etacut,mxcut -* - INTEGER ndim,npoin,nprin,ntreat,nevent -* -* --- LPAIR data COMMON block -* - INTEGER IPAR(20) - REAL*8 LPAR(20) - COMMON/DATAPAR/IPAR,LPAR - DOUBLE PRECISION x(10) -* -* - EXTERNAL f -* - pi = dacos(-1.d+00) - nout=6 - - nn=0 -* -* ---- particle masses (GeV) - me = lpar(1) ! incoming particle - mu = lpar(2) ! outgoing particle -* -* ---- beam energy (GeV) - ebeam = lpar(3) - sq=2.*ebeam -* -* ---- angle cuts - angcut = dcos(pi*lpar(4)) -* -* ---- rapidity cuts - etacut = lpar(5) -* -* ---- energy cuts - encut = lpar(6) - - mxcut = lpar(10) -* -* ---- constant (convert GeV**2 to picobarns) - const = (19.732d+03)**2 -* -* ---- VEGAS integration -* - xx = ranf(1211) -c do 10 i=1,ipar(5) -c x(i) = 0.4 -c 10 continue -c xx = f(x) -c print *,'x=',(x(i),i=1,ipar(5)) -c print *,xx - - OPEN (15,file='dl2.vegas.grid',status='unknown') - CALL vegas(f,0.1d-03,ipar(5),ipar(6),ipar(7),0,ipar(4)) - CALL save(ipar(5),15) - CLOSE (15) -* -* - END diff --git a/lpair_2diss/cdf/src/lhe.f b/lpair_2diss/cdf/src/lhe.f deleted file mode 100644 index ada9efc..0000000 --- a/lpair_2diss/cdf/src/lhe.f +++ /dev/null @@ -1,96 +0,0 @@ -c LHE file composition -c -c Authors : -c ... -c N. Schul (UCL, Louvain-la-Neuve) -c L. Forthomme (UCL, Louvain-la-Neuve), Feb 2014 -c--------------------------------------------------------------------------- - - SUBROUTINE LHEBEG - IMPLICIT none - INTEGER nout,ilhef - COMMON/outp/nout,ilhef - - OPEN(ilhef,file='events.lhe', status='unknown') - WRITE(ilhef,1000) '' - - 1000 FORMAT((a)) - END - -c--------------------------------------------------------------------------- - - SUBROUTINE LHEHDR - IMPLICIT none - INTEGER nout,ilhef - COMMON/outp/nout,ilhef - - DOUBLE PRECISION xsec,err,s3,s4 - COMMON/result/xsec,err,s3,s4 - INTEGER ipar(20) - DOUBLE PRECISION lpar(20) - COMMON/datapar/ipar,lpar - - WRITE(ilhef,1000) '
Sample generated using LPAIR
' - WRITE(ilhef,1000) '' - WRITE(ilhef,1100) ipar(8),ipar(8),lpar(3),lpar(3), - + ' 0 0 10042 10042 2 1' - WRITE(ilhef,1200) xsec,err,' 0.2673112E-03 0' - WRITE(ilhef,1000) '' - - 1000 FORMAT((a)) - 1100 FORMAT(2I5, 2F12.1, (A)) - 1200 FORMAT(1P, 2E12.4, (A)) - - END - -c--------------------------------------------------------------------------- - - SUBROUTINE LHEEND - IMPLICIT none - INTEGER nout,ilhef - COMMON/outp/nout,ilhef - - WRITE(ilhef,1000) '' - CLOSE(ilhef) - - 1000 FORMAT((a)) - - END - -c--------------------------------------------------------------------------- - - SUBROUTINE LHEFIL - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - -c LUND common - REAL p(4000,5) - INTEGER n,k(4000,5) - COMMON/lujets/n,k,p - save /lujets/ - - INTEGER nout,ilhef - COMMON/outp/nout,ilhef - -c Event common - LOGICAL accepted - INTEGER ndim,leppdg - DOUBLE PRECISION x(10) - COMMON/event/accepted,ndim,x,leppdg - - INTEGER I,J - - WRITE(ilhef,*) '' - WRITE(ilhef,*) N,' 661 0.2983460E-04 0.9118800E+02', - & '0.7821702E-02 0.1300000E+00' - - DO 202 I=1,N -c WRITE(ilhef,5300) K(I,2),K(I,1),K(I,3),K(I,4),0,0, - WRITE(ilhef,5300) K(I,2),K(I,1),K(I,3),0,0,0, - & (P(I,J),J=1,5),' 0. 1.' - 202 CONTINUE - - WRITE(ilhef,*) '' - - 5300 FORMAT(1P,I8,5I6,5E18.10,A6) - END - diff --git a/lpair_2diss/cdf/src/lhe.f_bkp b/lpair_2diss/cdf/src/lhe.f_bkp deleted file mode 100644 index 0dc990b..0000000 --- a/lpair_2diss/cdf/src/lhe.f_bkp +++ /dev/null @@ -1,90 +0,0 @@ -c LHE file composition -c -c Authors : -c ... -c N. Schul (UCL, Louvain-la-Neuve) -c L. Forthomme (UCL, Louvain-la-Neuve), Feb 2014 - - SUBROUTINE LHEFIL - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - -c Pair produced code - INTEGER NLHE - INTEGER L,NLEP - -c LUND common - REAL*4 P(4000,5) - INTEGER N,K(4000,5) - COMMON/LUJETS/N,K,P - save /lujets/ - -c Event common - LOGICAL ACCEPTED - INTEGER NDIM - DOUBLE PRECISION x(10) - COMMON/event/accepted,ndim,x - - INTEGER I,J - - OPEN(22,file='events.out', status='unknown') - - NLHE=N !lf - -clf NLHE=0 -clf DO 203 I=1,N -clf IF(K(I,1).EQ.1.AND.K(I,2).EQ.2212.AND.I.LT.16) THEN -clf NLHE=NLHE+1 -clf ENDIF -clf IF(K(I,1).EQ.1.AND.I.GT.15) NLHE=NLHE+1 -clf IF(K(I,1).EQ.1.AND.I.GT.15.AND.K(I,2).EQ.12) NLHE=NLHE-1 -clf IF(K(I,1).EQ.1.AND.I.GT.15.AND.K(I,2).EQ.-12) NLHE=NLHE-1 -clf IF(K(I,1).EQ.1.AND.I.GT.15.AND.K(I,2).EQ.14) NLHE=NLHE-1 -clf IF(K(I,1).EQ.1.AND.I.GT.15.AND.K(I,2).EQ.-14) NLHE=NLHE-1 -clf IF(K(I,1).EQ.1.AND.I.GT.15.AND.K(I,2).EQ.16) NLHE=NLHE-1 -clf IF(K(I,1).EQ.1.AND.I.GT.15.AND.K(I,2).EQ.-16) NLHE=NLHE-1 -clf 203 CONTINUE - WRITE(22,*) '' - WRITE(22,*) NLHE,' 661 0.2983460E-04 0.9118800E+02', - & '0.7821702E-02 0.1300000E+00' - - DO 202 I=1,N - -clf IF(K(I,1).EQ.1.AND.K(I,2).EQ.2212.AND.I.LT.14) THEN -clf WRITE(22,*) '2212 1 1 2 0 0 0.0 0.0 ',P(I,4), ! -P(I,4) normally quoted -clf & P(I,4),P(I,5),' 0. 1' -clf ENDIF -clf IF(I.GT.13.AND.K(I,1).EQ.1) THEN -clf IF(K(I,2).NE.12.AND.K(I,2).NE.-12.AND.K(I,2).NE.14) THEN -clf IF(K(I,2).NE.-14.AND.K(I,2).NE.16. -clf & AND.K(I,2).NE.-16) THEN -clf WRITE(22,*) K(I,2),' 1 1 2 0 0', -clf & P(I,1),P(I,2),P(I,3), ! P(I,3) normally quoted -clf & P(I,4),P(I,5),' 0. 1' -clf ENDIF -clf ENDIF -clf ENDIF - WRITE(22,5300) K(I,2),K(I,1),K(I,3),K(I,4),0,0, - & (P(I,J),J=1,5),' 0. 1.' -clf WRITE(22,*) IDUP(I),ISTUP(I),MOTHUP(1,I), -clf & MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),(PUP(J,I),J=1,5), -clf & ' 0. 9.' - 202 CONTINUE -c FOR MUONS -clf WRITE(22,*) '13 1 1 2 0 0 ',PPXM1,PPYM1,PPZM1,PPEM1, -clf & ' 0.1057 0. 1' -clf WRITE(22,*) '-13 1 1 2 0 0 ',PPXM2,PPYM2,PPZM2,PPEM2, -clf & ' 0.1057 0. 1' - -c FOR TAUS -c WRITE(22,*) '15 1 1 2 0 0 ',PPXM1,PPYM1,PPZM1,PPEM1, -c & ' 1.77684 0. 1' -c WRITE(22,*) '-15 1 1 2 0 0 ',PPXM2,PPYM2,PPZM2,PPEM2, -c & ' 1.77684 0. 1' - - WRITE(22,*) '' - - CLOSE(22) - - 5300 FORMAT(1P,I8,5I5,5E18.10,A6) - END - diff --git a/lpair_2diss/cdf/src/lorenb.f b/lpair_2diss/cdf/src/lorenb.f deleted file mode 100644 index e82e2eb..0000000 --- a/lpair_2diss/cdf/src/lorenb.f +++ /dev/null @@ -1,35 +0,0 @@ -* -* $Id: lorenb.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $ -* -* $Log: lorenb.F,v $ -* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni -* Kernlib -* -* - SUBROUTINE LORENB (U,PS,PI,PF) -C -C CERN PROGLIB# U102 LORENB .VERSION KERNFOR 4.04 821124 -C ORIG. 20/08/75 L.PAPE -C - DOUBLE PRECISION PF4, FN - DIMENSION PS(4),PI(4),PF(4) - - IF (PS(4).EQ.U) GO TO 17 - PF4 = (PI(4)*PS(4)+PI(3)*PS(3)+PI(2)*PS(2)+PI(1)*PS(1)) / U - FN = (PF4+PI(4)) / (PS(4)+U) - PF(1)= PI(1) + FN*PS(1) - PF(2)= PI(2) + FN*PS(2) - PF(3)= PI(3) + FN*PS(3) - PF(4)= PF4 - GO TO 18 -C - 17 PF(1)= PI(1) - PF(2)= PI(2) - PF(3)= PI(3) - PF(4)= PI(4) -C - 18 CONTINUE -C - RETURN -C - END diff --git a/lpair_2diss/cdf/src/luset.f b/lpair_2diss/cdf/src/luset.f deleted file mode 100644 index ad6bcb2..0000000 --- a/lpair_2diss/cdf/src/luset.f +++ /dev/null @@ -1,80 +0,0 @@ -*-- Author : O. Duenger 14/11/91 -* - SUBROUTINE LUKSET(LINE,STATUS,PART,MOTH,DAUG1,DAUG2,NOFF) -*================================================================= - IMPLICIT NONE - INTEGER LINE,STATUS,PART,MOTH,DAUG1,DAUG2,NOFF -* -C---JETSET and GENOUT common - REAL*4 P(4000,5),V(4000,5) - INTEGER N,K(4000,5) - COMMON/LUJETS/N,K,P,V -* - IF (LINE .GT. N) THEN - WRITE(6,*)' LUKSET : LINE TOO BIG; LINE=',LINE,' N=',N - RETURN - ENDIF -* - IF (STATUS .NE. -9999) K(LINE,1)=STATUS - IF (PART .NE. -9999) K(LINE,2)=PART - IF (MOTH. NE.-9999 .AND. MOTH .NE.0) K(LINE,3)=MOTH +NOFF - IF (DAUG1.NE.-9999 .AND. DAUG1.NE.0) K(LINE,4)=DAUG1+NOFF - IF (DAUG2.NE.-9999 .AND. DAUG2.NE.0) K(LINE,5)=DAUG2+NOFF - END - - -*-- Author : O. Duenger 19/12/91 -* - SUBROUTINE LUNSET(LINE) -*================================================================= - IMPLICIT NONE - INTEGER LINE,I,II -* -C---JETSET and GENOUT common - REAL*4 P(4000,5),V(4000,5) - INTEGER N,K(4000,5) - COMMON/LUJETS/N,K,P,V -* - IF ((LINE .LT. 1) .OR. (LINE .GT. 4000)) THEN - WRITE(6,*) ' LUNSET : WRONG LINE, LINE =',LINE - RETURN - ENDIF -* - N=LINE -* - DO 100 I=1,5 - DO 200 II=1,N - V(II,I)=0.0 - 200 CONTINUE - 100 CONTINUE - END - -*-- Author : O. Duenger 19/12/91 -* - SUBROUTINE LUPSET(LINE,PX,PY,PZ,E,M) -*================================================================= - IMPLICIT NONE - INTEGER LINE - REAL PX,PY,PZ,E,M,ULMASS -* -C---JETSET and GENOUT common - REAL*4 P(4000,5),V(4000,5) - INTEGER N,K(4000,5) - COMMON/LUJETS/N,K,P,V -* - IF (LINE .GT. N) THEN - WRITE(6,*) ' LUPSET : TOO BIG LINE NUMBER, LINE =',LINE, - + ', N =',N - RETURN - ENDIF -* - P(LINE,1)=PX - P(LINE,2)=PY - P(LINE,3)=PZ - P(LINE,4)=E - IF (M .GE. -9998.0) THEN - P(LINE,5)=M - ELSE - P(LINE,5)=ULMASS(K(LINE,2)) - ENDIF - END diff --git a/lpair_2diss/cdf/src/orient.f b/lpair_2diss/cdf/src/orient.f deleted file mode 100644 index b0f8d5e..0000000 --- a/lpair_2diss/cdf/src/orient.f +++ /dev/null @@ -1,64 +0,0 @@ - SUBROUTINE orient(s,v1,v2,v3,v4,v5,dj,nopt,y) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - COMMON/variab/e,e1,e2,e3,e4,e5,p,p3,p4,p5,ct3,st3,ct4,st4, - a ct5,st5,cp3,sp3,cp5,sp5 - COMMON/variac/al3,al4,be4,be5,de3,de5,pp3,pp4,pp5 - COMMON/pickzz/w1,w2,w3,w4,w5,w31,w52,w12,tau,sl1 - COMMON/extra/s1,s2,t1,t2 - COMMON/levi/gram,dd1,dd2,dd3,dd4,dd5,delta,g4,sa1,sa2 - COMMON/dotp/p12,p13,p14,p15,p23,p24,p25,p34,p35,p45,q1,q2 - DIMENSION y(4) - CALL pickin(s,v1,v2,v3,v4,v5,dj,nopt,y) - IF(dj.EQ.0)GO TO 10 - e=dsqrt(s) - re=0.5/e - e1=re*(s+w12) - e2=re*(s-w12) - p=re*sl1 - de3=re*(s2-w3+w12) - de5=re*(s1-w5-w12) - e3=e1-de3 - IF(e3.gt.e1) GOTO 10 ! Laurent workaround - e4=de3+de5 - e5=e2-de5 - IF(e5.gt.e2) GOTO 10 ! Laurent workaround - IF(e4.LT.v4) GO TO 10 - p3=dsqrt(e3*e3-w3) - p4=dsqrt((e4-v4)*(e4+v4)) - IF(p4.EQ.0) GO TO 10 - p5=dsqrt(e5*e5-w5) - pp3=dsqrt(dd1/s)/p - pp5=dsqrt(dd3/s)/p - st3=pp3/p3 - st5=pp5/p5 - IF(st3.GT.1..OR.st5.GT.1.) GO TO 10 - ct3=dsqrt(1.-st3*st3) - ct5=dsqrt(1.-st5*st5) - IF(e1*e3.LT.p13)ct3=-ct3 - IF(e2*e5.GT.p25)ct5=-ct5 - al3=st3*st3/(1.+ct3) - be5=st5*st5/(1.-ct5) - IF(dd5.LT.0) GO TO 10 - pp4=dsqrt(dd5/s)/p - st4=pp4/p4 - IF(st4.GT.1.) GO TO 10 - ct4=dsqrt(1.-st4*st4) - IF(e1*e4.LT.p14)ct4=-ct4 - al4=1.-ct4 - be4=1.+ct4 - IF(ct4.LT.0)be4=st4*st4/al4 - IF(ct4.ge.0)al4=st4*st4/be4 - rr=dsqrt(-gram/s)/(p*pp4) - sp3=rr/pp3 - sp5=-rr/pp5 - IF(dabs(sp3).GT.1..OR.dabs(sp5).GT.1.) GO TO 10 - cp3=-dsqrt(1.-sp3*sp3) - cp5=-dsqrt(1.-sp5*sp5) - a1=pp3*cp3-pp5*cp5 - IF(dabs(pp4+pp3*cp3+cp5*pp5).LT.dabs(dabs(a1)-pp4)) GO TO 1 - IF(a1.LT.0)cp5=-cp5 - IF(a1.ge.0)cp3=-cp3 - 1 RETURN - 10 dj=0. - RETURN - END diff --git a/lpair_2diss/cdf/src/paw.f b/lpair_2diss/cdf/src/paw.f deleted file mode 100644 index b6f217d..0000000 --- a/lpair_2diss/cdf/src/paw.f +++ /dev/null @@ -1,228 +0,0 @@ - subroutine pawfil1 -* -* ---- LPAIR common blocks -* - implicit double precision (a-h,o-z) -* - double precision me,mu,mxcut - common/inpu/me,mu,ebeam,const,sq - common/variab/e,e1,e2,e3,e4,e5,p,p3,p4,p5,ct3,st3,ct4,st4,ct5 - 1 ,st5,cp3,sp3,cp5,sp5 - common/variac/al3,al4,be4,be5,de3,de5,pp3,pp4,pp5 - common/variad/e6,e7,p6,p7,ct6,st6,ct7,st7,cp6,sp6,cp7,sp7,w - common/lplot/xl(10),v1(2),v2(2),av(10) - common/extra/s1,s2,t1,t2 - common/pickzz/w1,w2,w3,w4,w5,w31,w52,w12,tau,sl1 - common/levi/gram,d1,d2,d3,d4,d5,delta,g4,a1,a2 - common/civita/epsi,g5,g6,a5,a6,bb - common/dotps/q1dq,q1dq2,w6 - common/tell/nn - common/cuts/angcut,encut,etacut,mxcut -* -* --- LPAIR data common block -* - INTEGER IPAR(20) - REAL*8 LPAR(20) - COMMON/DATAPAR/IPAR,LPAR -* -* --- MYGENZ common block -* - common/mygenz/px3,py3,pz3,px4,py4,pz4,px5,py5,pz5, - + px6,py6,pz6,px7,py7,pz7 - - REAL PT3,PT4,PT5,PT6,PT7 - - DIMENSION P12(4) - REAL PI,XTRA1(23) -* - PI = ACOS(-1.0) - DPI = DACOS(-1.0D00) -* -* ---- fill MYGENZ common ntuple entries (before reflection/rotation) -* - PX3 = PP3*CP3 - PY3 = PP3*SP3 - PZ3 = P3*CT3 - PT3 = SQRT(PX3**2+PY3**2) - PX5 = PP5*CP5 - PY5 = PP5*SP5 - PZ5 = P5*CT5 - PT5 = SQRT(PX5**2+PY5**2) - PX6 = PP6*CP6 - PY6 = PP6*SP6 - PZ6 = P6*CT6 - PT6 = SQRT(PX6**2+PY6**2) - PX7 = PP7*CP7 - PY7 = PP7*SP7 - PZ7 = P7*CT7 - PT7 = SQRT(PX7**2+PY7**2) -* - PX4 = PP4*CP4 - PY4 = 0. - PZ4 = P4*CT4 - PT4 = SQRT(PX4**2+PY4**2) -* - if(ipar(16).eq.0) goto 100 -* -***************************************************************** -* -* --- do we wish to random reflect/rotate? -* --- random reflection in x-z plane (VERMAS10) - - if(ranf(dummy) .ge. 0.5) then - sp3 = -sp3 - sp5 = -sp5 - sp6 = -sp6 - sp7 = -sp7 - endif -* --- random rotation around z-axis (VERMAS10) - - ranphi=2.0*acos(-1.)*ranf(dummy) - sinphi=sin(ranphi) - cosphi=cos(ranphi) - -* --- rotate, reflect and transform values (VERMAS10) - - PEMX=PP3*(CP3*COSPHI-SP3*SINPHI) - PEMY=PP3*(CP3*SINPHI+SP3*COSPHI) - PEMZ=P3*CT3 - PEPX=PP5*(CP5*COSPHI-SP5*SINPHI) - PEPY=PP5*(CP5*SINPHI+SP5*COSPHI) - PEPZ=P5*CT5 - PP6=P6*ST6 - PMMX=PP6*(CP6*COSPHI-SP6*SINPHI) - PMMY=PP6*(CP6*SINPHI+SP6*COSPHI) - PMMZ=P6*CT6 - PMPX=-PEMX-PEPX-PMMX - PMPY=-PEMY-PEPY-PMMY - PMPZ=-PEMZ-PEPZ-PMMZ -* - PRESX = PP4*(CP4*COSPHI) - PRESY = PP4*(CP4*SINPHI) - PRESZ = P4*CT4 -* - px3 = pemx - py3 = pemy - pz3 = pemz - pt3 = sqrt(px3**2+py3**2) - px5 = pepx - py5 = pepy - pz5 = pepz - pt5 = sqrt(px5**2+py5**2) - px6 = pmmx - py6 = pmmy - pz6 = pmmz - pt6 = sqrt(px6**2+py6**2) - px7 = pmpx - py7 = pmpy - pz7 = pmpz - pt7 = sqrt(px7**2+py7**2) -* - px4 = presx - py4 = presy - pz4 = presz - pt4 = sqrt(px4**2+py4**2) -* -c px3 = p3*st3*cp3 -c py3 = p3*st3*sp3 -c pz3 = p3*ct3 -c pt3 = p3*st3 -c px5 = p5*st5*cp5 -c py5 = p5*st5*sp5 -c pz5 = p5*ct5 -c pt5 = p5*st5 -c px6 = p6*st6*cp6 -c py6 = p6*st6*sp6 -c pz6 = p6*ct6 -c pt6 = p6*st6 -c px7 = p7*st7*cp7 -c py7 = p7*st7*sp7 -c pz7 = p7*ct7 -c pt7 = p7*st7 -* -***************************************************************** -* - 100 continue -* - IF(IPAR(2).EQ.0) RETURN -* - XTRA1(1) = real(dsign(dlog((dsqrt(pt6**2+pz6**2)+ - & dabs(pz6))/pt6),pz6)) - XTRA1(2) = real(dsign(dlog((dsqrt(pt7**2+pz7**2)+ - & dabs(pz7))/pt7),pz7)) - XTRA1(3) = real(dsqrt(w4)) - - XTRA1(4) = real(px6) - XTRA1(5) = real(py6) - XTRA1(6) = real(pz6) - XTRA1(7) = real(pt6) - XTRA1(8) = real(px7) - XTRA1(9) = real(py7) - XTRA1(10) = real(pz7) - XTRA1(11) = real(pt7) - XTRA1(12) = real(p4*st4) - -* ---- acoplanarity angle (deviation from PI) - - PHI6 = PYANGL(PX6,PY6) - PHI7 = PYANGL(PX7,PY7) - IF(PHI7.LT.0.0D0) THEN - PHI7 = PHI7 + 2.*DPI - ENDIF - IF(PHI6.LT.0.0D0) THEN - PHI6 = PHI6 + 2.*DPI - ENDIF - IF(PHI6.LT.PHI7) THEN - DPHI = PHI7 - PHI6 - ACOPL = DPI - DPHI - ELSEIF(PHI6.GT.PHI7) THEN - DPHI = PHI6 - PHI7 - ACOPL = DPHI - DPI - ENDIF - XTRA1(13) = real(phi6) - XTRA1(14) = real(phi7) - XTRA1(15) = real(acopl) - -* ---- coplanarity angle (transverse plane, 2D) - - P12(1) = PX6*PX7 - P12(2) = PY6*PY7 - P12(3) = PZ6*PZ7 - P12(4) = P12(1) + P12(2) - ARG = (P12(4)/(PT6*PT7)) - IF(ARG.LT.(-1.0D00)) ARG=-1.0D00 - THETOPN2 = (180.0D00/DPI)*DACOS(ARG) - -* ---- collinearity angle ((x,y,z) plane, 3D) - - P12(1) = PX6*PX7 - P12(2) = PY6*PY7 - P12(3) = PZ6*PZ7 - P12(4) = P12(1) + P12(2) + P12(3) - ARG = (P12(4)/(P6*P7)) - IF(ARG.LT.(-1.0D0)) ARG=-1.0D00 - THETOPN3 = (180.0D00/DPI)*DACOS(ARG) - - XTRA1(16) = REAL(THETOPN2) - XTRA1(17) = REAL(THETOPN3) - -* ---- calculate deflection of outgoing protons - - IF(PZ3.LT.0.) THEN - XTRA1(18) = PI - REAL(ATAN(PT3/DABS(PZ3))) - ELSE - XTRA1(18) = REAL(ATAN(PT3/PZ3)) - ENDIF - IF(PZ5.LT.0.) THEN - XTRA1(19) = PI - REAL(ATAN(PT5/DABS(PZ5))) - ELSE - XTRA1(19) = REAL(ATAN(PT5/PZ5)) - ENDIF -* - XTRA1(20) = PT3 - XTRA1(21) = PZ3 - XTRA1(22) = PT5 - XTRA1(23) = PZ5 -* - return - end diff --git a/lpair_2diss/cdf/src/peripp.f b/lpair_2diss/cdf/src/peripp.f deleted file mode 100644 index bbc8de0..0000000 --- a/lpair_2diss/cdf/src/peripp.f +++ /dev/null @@ -1,61 +0,0 @@ - DOUBLE PRECISION FUNCTION peripp(nup,ndown) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - COMMON/pickzz/w1,w2,w3,w4,w5,w31,w52,w12,tau,sl1 - COMMON/levi/gram,d1,d2,d3,d4,d5,delta,g4,a1,a2 - COMMON/civita/epsi,g5,g6,a5,a6,bb - COMMON/extra/s1,s2,t1,t2 - COMMON/dotps/q1dq,q1dq2,w6 - data rho/.585d+00/ - IF(nup.GT.0) GO TO 1 - u1=1. - u2=1. - GO TO 3 -1 IF(nup.GT.1) GO TO 2 - xt=1.-t1/.71 - xt=xt*xt - xu=2.79/xt - u1=xu*xu - tau=t1/(4.*w1) - u2=(1./(xt*xt)-xu*xu*tau)/(1.-tau) - GO TO 3 -2 x=t1/(t1-w3) - en=w31-t1 - tau=t1/(4.*w1) - rhot=rho-t1 - u1=(-.86926*rho*rho*w31/rhot/rhot-2.23422*w1*(1.-x)**4 - 1 /(x*(x*.96-1.26)+1.))/t1 - u2=(-tau*u1-.12549*w31*t1*rho/rhot/rhot*w31*w31/en/en/w1) - 1 /(1.-en*en/(4.*w1*t1)) -3 IF(ndown.GT.0) GO TO 4 - v1=1. - v2=1. - GO TO 6 -4 IF(ndown.GT.1) GO TO 5 - xt=1.-t2/.71 - xt=xt*xt - xu=2.79/xt - v1=xu*xu - tau=t2/(4.*w2) - v2=(1./(xt*xt)-xu*xu*tau)/(1.-tau) - GO TO 6 -5 x=t2/(t2-w5) - en=w52-t2 - tau=t2/(4.*w2) - rhot=rho-t2 - v1=(-.86926*rho*rho*w52/rhot/rhot-2.23422*w2*(1.-x)**4 - 1 /(x*(x*.96-1.26)+1.))/t2 - v2=(-tau*v1-.12549*w52*t2*rho/rhot/rhot*w52*w52/en/en/w2) - 1 /(1.-en*en/(4.*w2*t2)) -6 CONTINUE - qqq=q1dq*q1dq - qdq=4.*w6-w4 - t22=512.*(bb*(delta*delta-gram)-(epsi-delta*(qdq+q1dq2))**2 - a -a1*a6*a6-a2*a5*a5-a1*a2*qqq) - t12=128.*(-bb*(d2+g6)-2.*(t1+2.*w6)*(a2*qqq+a6*a6))*t1 - t21=128.*(-bb*(d4+g5)-2.*(t2+2.*w6)*(a1*qqq+a5*a5))*t2 - t11=64.*(bb*(qqq-g4-qdq*(t1+t2+2.*w6))-2.*(t1+2.*w6)*(t2+2.*w6) - a *qqq)*t1*t2 - peripp=(((u1*v1*t11+u2*v1*t21+u1*v2*t12+u2*v2*t22)/(t1*t2*bb)) - a /(t1*t2*bb))*.25 - RETURN - END diff --git a/lpair_2diss/cdf/src/pickin.f b/lpair_2diss/cdf/src/pickin.f deleted file mode 100644 index a23bbe8..0000000 --- a/lpair_2diss/cdf/src/pickin.f +++ /dev/null @@ -1,154 +0,0 @@ - SUBROUTINE pickin(s,v1,v2,v3,v4,v5,dj,nopt,y) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - DIMENSION y(4) - COMMON/pickzz/w1,w2,w3,w4,w5,d1,d2,d5,d7,sl1 - COMMON/extra/s1,s2,t1,t2 - COMMON/accura/acc3,acc4 - COMMON/levi/gram,dd1,dd2,dd3,dd4,dd5,delta,g4,sa1,sa2 - COMMON/dotp/p12,p13,p14,p15,p23,p24,p25,p34,p35,p45,p1k2,p2k1 - data pi/3.14159265358979d+00/ - x1=y(1) - x2=y(2) - x3=y(3) - w1=v1*v1 - w2=v2*v2 - w3=v3*v3 - w4=v4*v4 - w5=v5*v5 - sig=v4+v5 - sig1=sig*sig - sig2=sig1 - d1=w3-w1 - d2=w5-w2 - d5=w1-w2 - d6=w4-w5 - ss=s+d5 - rl1=ss*ss-4.*w1*s - IF(rl1.le.0) GO TO 20 - sl1=dsqrt(rl1) - IF(nopt.ne.0) GO TO 1 - smax=s+w3-2.*v3*dsqrt(s) - CALL maps2(s2,x3,sig1,smax,ds2) - sig1=s2 - 1 sp=s+w3-sig1 - d3=sig1-w2 - rl2=sp*sp-4.*s*w3 - IF(rl2.le.0) GO TO 20 - sl2=sqrt(rl2) - t1max=w1+w3-(ss*sp+sl1*sl2)/(2.*s) - t1min=(d1*d3+(d3-d1)*(d3*w1-d1*w2)/s)/t1max - CALL mapt1(t1,x1,t1min,t1max,dt1) - d4=w4-t1 - d8=t1-w2 - t13=t1-w1-w3 - sa1=-(t1-d1)*(t1-d1)*0.25+w1*t1 - IF(sa1.ge.0) GO TO 20 - sl3=dsqrt(-sa1) - IF(w1.EQ.0) GO TO 3 - sb=(s*(t1-d1)+d5*t13)/(2.*w1)+w3 - sd=sl1*sl3/w1 - se=(s*(t1*(s+t13-w2)-w2*d1)+w3*(d5*d8+w2*w3))/w1 - IF(dabs((sb-sd)/sd).LT.1.0) GO TO 2 - splus=sb-sd - s2max=se/splus - GO TO 4 - 2 s2max=sb+sd - splus=se/s2max - GO TO 4 - 3 s2max=(s*(t1*(s+d8-w3)-w2*w3)+w2*w3*(w2+w3-t1))/ss/t13 - splus=sig2 - 4 s2x=s2max - IF(nopt)5,6,7 - 5 IF(splus.GT.sig2)sig2=splus - IF(nopt.LT.-1)CALL maps2(s2,x3,sig2,s2max,ds2) - IF(nopt.EQ.-1)CALL mapla(s2,t1,w2,x3,sig2,s2max,ds2) - 6 s2x=s2 - 7 r1=s2x-d8 - r2=s2x-d6 - rl4=(r1*r1-4.*w2*s2x)*(r2*r2-4.*w5*s2x) - IF(rl4.le.0) GO TO 20 - sl4=dsqrt(rl4) - t2max=w2+w5-(r1*r2+sl4)/(2.*s2x) - t2min=(d2*d4+(d4-d2)*(d4*w2-d2*t1)/s2x)/t2max - CALL mapt2(t2,x2,t2min,t2max,dt2) - d7=t1-t2 - r3=d4-t2 - r4=d2-t2 - b=r3*r4-2.*(t1+w2)*t2 - c=t2*d6*d8+(d6-d8)*(d6*w2-d8*w5) - t25=t2-w2-w5 - sa2=-r4*r4*0.25+w2*t2 - IF(sa2.ge.0) GO TO 20 - sl6=2.*dsqrt(-sa2) - g4=-0.25*r3*r3+t1*t2 - IF(g4.ge.0) GO TO 20 - sl7=sqrt(-g4)*2. - sl5=sl6*sl7 - IF(dabs((sl5-b)/sl5).LT.1.0) GO TO 8 - s2p=(sl5-b)/(2.*t2) - s2min=c/(t2*s2p) - GO TO 9 - 8 s2min=(-sl5-b)/(2.*t2) - s2p=c/(t2*s2min) - 9 IF(nopt.GT.1)CALL maps2(s2,x3,s2min,s2max,ds2) - IF(nopt.EQ.1)CALL mapla(s2,t1,w2,x3,s2min,s2max,ds2) - ap=-(s2+d8)*(s2+d8)*0.25+s2*t1 - IF(w1.EQ.0) GO TO 10 - dd1=-w1*(s2-s2max)*(s2-splus)*0.25 - GO TO 11 - 10 dd1=ss*t13*(s2-s2max)*0.25 - 11 dd2=-t2*(s2-s2p)*(s2-s2min)*0.25 - yy4=dcos(pi*y(4)) - dd=dd1*dd2 - p12=0.5*(s-w1-w2) - st=s2-t1-w2 - delb=(2.*w2*r3+r4*st)*(4.*p12*t1-(t1-d1)*st)/(16.*ap) - IF(dd.le.0) GO TO 20 - delta=delb-yy4*st*dsqrt(dd)/(2.*ap) - s1=t2+w1+(2.*p12*r3-4.*delta)/st - IF(ap.ge.0) GO TO 20 - dj=ds2*dt1*dt2*pi*pi/(8.*sl1*dsqrt(-ap)) - gram=(1.-yy4)*(1.+yy4)*dd/ap - p13=-t13*0.5 - p14=(d7+s1-w3)*0.5 - p15=(s+t2-s1-w2)*0.5 - p23=(s+t1-s2-w1)*0.5 - p24=(s2-d7-w5)*0.5 - p25=-t25*0.5 - p34=(s1-w3-w4)*0.5 - p35=(s+w4-s1-s2)*0.5 - p45=(s2-w4-w5)*0.5 - p1k2=(s1-t2-w1)*0.5 - p2k1=st*0.5 - IF(w2.EQ.0) GO TO 14 - sbb=(s*(t2-d2)-d5*t25)/(2.*w2)+w5 - sdd=sl1*sl6/(2.*w2) - see=(s*(t2*(s+t25-w1)-w1*d2)+w5*(w1*w5-d5*(t2-w1)))/w2 - IF(sbb/sdd.LT.0) GO TO 12 - s1p=sbb+sdd - s1m=see/s1p - GO TO 13 - 12 s1m=sbb-sdd - s1p=see/s1m - 13 dd3=-w2*(s1p-s1)*(s1m-s1)*0.25 - GO TO 15 - 14 s1p=(s*(t2*(s-w5+t2-w1)-w1*w5)+w1*w5*(w1+w5-t2))/t25/(s-d5) - dd3=-t25*(s-d5)*(s1p-s1)*0.25 - 15 acc3=(s1p-s1)/(s1p+s1) - ssb=t2+w1-r3*(d1-t1)*0.5/t1 - ssd=sl3*sl7/t1 - sse=(t2-w1)*(w4-w3)+(t2-w4+d1)*((t2-w1)*w3-(w4-w3)*w1)/t1 - IF(ssb/ssd.LT.0) GO TO 16 - s1pp=ssb+ssd - s1pm=sse/s1pp - GO TO 17 - 16 s1pm=ssb-ssd - s1pp=sse/s1pm - 17 dd4=-t1*(s1-s1pp)*(s1-s1pm)*0.25 - acc4=(s1-s1pm)/(s1+s1pm) - dd5=dd1+dd3+((p12*(t1-d1)*0.5-w1*p2k1)*(p2k1*(t2-d2)-w2*r3) - a -delta*(2.*p12*p2k1-w2*(t1-d1)))/p2k1 - RETURN - 20 dj=0. - RETURN - END diff --git a/lpair_2diss/cdf/src/ranf.f b/lpair_2diss/cdf/src/ranf.f deleted file mode 100644 index 35b7a75..0000000 --- a/lpair_2diss/cdf/src/ranf.f +++ /dev/null @@ -1,155 +0,0 @@ - DOUBLE PRECISION FUNCTION ranf(dummy) - DOUBLE PRECISION rvec(100) - SAVE rvec,ncall,mcall - INTEGER dummy - DATA ncall,mcall/0,0/ - IF ( ncall .EQ. 0 ) THEN - IF ( dummy .NE. 0 ) CALL rcargo(dummy) - ncall = 1 - ENDIF - IF ( mcall .EQ. 0 ) THEN - CALL rcarry(rvec,100) - mcall = 100 - ENDIF - ranf = rvec(mcall) - mcall = mcall - 1 - END - - SUBROUTINE rcarry(rvec,lenv) -* -* This version is identical to that in CPC software library -* -* Add-and-carry random number generator proposed by -* Marsaglia and Zaman in SIAM J. Scientific and Statistical -* Computing, to appear probably 1990. -* modified with enhanced initialization by F. James, 1990 -* -* -* NB! Recently, F. James informed us that there is a slight mistake -* in this implementation on line 13 and suggested the following -* change: -* -* Original line: -* -* uni = seeds(i24) - seeds(j24) - carry -* -* Suggested modification: -* -* uni = seeds(j24) - seeds(i24) - carry -* -* We have also tested this new versionand the test results -* are available in the hep-lat preprint 9306008. -* -*!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -*!!! Calling sequences for rcarry: ++ -*!!! CALL rcarry (rvec, LEN) returns a vector rvec of LEN ++ -*!!! 32-bit random floating point numbers between ++ -*!!! zero and one. ++ -*!!! CALL rcargo(INT) initializes the generator from one ++ -*!!! 32-bit integer INT ++ -*!!! CALL RCARIN(ivec) restarts the generator from vector ++ -*!!! ivec of 25 32-bit integers (see rcarut) ++ -*!!! CALL rcarut(ivec) outputs the current values of the 25 ++ -*!!! 32-bit integer seeds, to be used for restarting ++ -*!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - IMPLICIT DOUBLE PRECISION (a-h,o-z) - DOUBLE PRECISION rvec(lenv) - DIMENSION seeds(24), iseeds(24), isdext(25) - PARAMETER (TWOP12=4096.D0) - PARAMETER (ITWO24=2**24, icons=2147483563) - SAVE notyet, i24, j24, carry, seeds, twom24 - LOGICAL notyet - DATA notyet/.TRUE./ - DATA i24,j24,carry/24,10,0.D0/ -C -C Default Initialization by Multiplicative Congruential - IF (notyet) THEN - notyet = .FALSE. - jseed = 314159265 -* WRITE(6,'(A,I12)') ' rcarry default initialization: ',jseed - twom24 = 1 - DO 25 i= 1, 24 - twom24 = twom24 * 0.5 - k = jseed/53668 - jseed = 40014*(jseed-k*53668) -k*12211 - IF ( jseed .LT. 0 ) jseed = jseed + icons - iseeds(i) = MOD(jseed,ITWO24) - 25 CONTINUE - DO 50 i= 1,24 - seeds(i) = iseeds(i)*twom24 - 50 CONTINUE - i24 = 24 - j24 = 10 - carry = 0. - IF (seeds(24) .LT. seeds(14)) carry = twom24 - ENDIF -C -C The Generator proper: "Subtract-with-borrow", -C as proposed by Marsaglia and Zaman, -C Florida State University, March, 1989 -C - DO 100 ivec= 1, lenv - uni = seeds(j24) - seeds(i24) - carry - IF (uni .LT. 0.) THEN - uni = uni + 1.0 - carry = twom24 - ELSE - carry = 0. - ENDIF - seeds(i24) = uni - i24 = i24 - 1 - IF ( i24 .EQ. 0 ) i24 = 24 - j24 = j24 - 1 - IF (j24 .EQ. 0) j24 = 24 - rvec(ivec) = uni - 100 CONTINUE - RETURN -C Entry to input and float integer seeds from previous run - ENTRY RCARIN(isdext) - twom24 = 1 - DO 195 i= 1, 24 - 195 twom24 = twom24 * 0.5D0 - WRITE(6,'(A)') ' FULL INITIALIZATION OF rcarry WITH 25 INTEGERS:' - WRITE(6,'(5X,5I12)') isdext - DO 200 i= 1, 24 - seeds(i) = isdext(i)*twom24 - 200 CONTINUE - carry = MOD(isdext(25),10)*twom24 - isd = isdext(25)/10 - i24 = MOD(isd,100) - isd = isd/100 - j24 = isd - RETURN -C Entry to ouput seeds as integers - ENTRY rcarut(isdext) - DO 300 i= 1, 24 - isdext(i) = seeds(i)*TWOP12*TWOP12 - 300 CONTINUE - icarry = 0 - IF (carry .GT. 0.) icarry = 1 - isdext(25) = 1000*j24 + 10*i24 + icarry - RETURN -C Entry to initialize from one integer - ENTRY rcargo(inseed) - jseed = inseed - notyet = .FALSE. -* WRITE(6,'(A,I12)') ' rcarry INITIALIZED FROM SEED ',inseed - twom24 = 1 - DO 325 i= 1, 24 - twom24 = twom24 * 0.5D0 - k = jseed/53668 - jseed = 40014*(jseed-k*53668) -k*12211 - IF ( jseed .LT. 0 ) jseed = jseed+icons - iseeds(i) = MOD(jseed,ITWO24) - 325 CONTINUE - DO 350 i= 1,24 - seeds(i) = iseeds(i)*twom24 - 350 CONTINUE - i24 = 24 - j24 = 10 - carry = 0. - IF ( seeds(24) .LT. seeds(14) ) carry = twom24 - RETURN -*###] rcarry: - END - diff --git a/lpair_2diss/cdf/src/save.f b/lpair_2diss/cdf/src/save.f deleted file mode 100644 index f118cc9..0000000 --- a/lpair_2diss/cdf/src/save.f +++ /dev/null @@ -1,30 +0,0 @@ - SUBROUTINE save(ndim,ntape) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - PARAMETER(MAXDIV=250) - COMMON/bveg2/ndo,it,si,si2,swgt,schi,xi(MAXDIV,10),scalls - + ,d(MAXDIV,10),di(MAXDIV,10),nxi(MAXDIV,10) -* -* stores vegas data (unit ntape) for later re-initialization -* - WRITE(ntape,200) ndo,it,si,si2,swgt,schi - WRITE(ntape,201) - + ((xi(i,j),i=1,ndo),j=1,ndim) - + ,((di(i,j),i=1,ndo),j=1,ndim) - RETURN - ENTRY restr(ndim,ntape) -* -* enters initialization data for vegas -* - READ(ntape,200) ndo,it,si,si2,swgt,schi - READ(ntape,201) - + ((xi(i,j),i=1,ndo),j=1,ndim) - + ,((di(i,j),i=1,ndo),j=1,ndim) -200 FORMAT(2i8,4D24.16) -201 FORMAT(5D24.16) -* WRITE(6,200) ndo,it,si,si2,swgt,schi -* WRITE(6,201) -* + ((xi(i,j),i=1,ndo),j=1,ndim) -* + ,((di(i,j),i=1,ndo),j=1,ndim) - - RETURN - END diff --git a/lpair_2diss/cdf/src/save2.f b/lpair_2diss/cdf/src/save2.f deleted file mode 100644 index a33205e..0000000 --- a/lpair_2diss/cdf/src/save2.f +++ /dev/null @@ -1,29 +0,0 @@ - SUBROUTINE save2(ndim,ntape) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - INTEGER nm - COMMON/maxi/mdum,mbin,ffmax,fmax(80000),nm(80000) - - max=mbin**ndim - - WRITE (ntape,100) mbin,ffmax - WRITE (ntape,101) (fmax(i),i=1,max) - WRITE (ntape,102) (nm(i),i=1,max) - - RETURN - - ENTRY restr2(ndim,ntape) - REWIND(ntape) - READ (ntape,100) mbin,ffmax - - max = mbin**ndim - - READ (ntape,101) (fmax(i),i=1,max) - READ (ntape,102) (nm(i),i=1,max) - - RETURN - -100 FORMAT(i10,D24.16) -101 FORMAT(5D24.16) -102 FORMAT(8i10) - - END diff --git a/lpair_2diss/cdf/src/setgen.f b/lpair_2diss/cdf/src/setgen.f deleted file mode 100644 index 2c08727..0000000 --- a/lpair_2diss/cdf/src/setgen.f +++ /dev/null @@ -1,119 +0,0 @@ - SUBROUTINE setgen(f,ndim,npoin,nbin,nprin,ntreat) - INTEGER i,j,k,m,mbin,mmax,ndim,npoin,nprin,ntreat,n(10),nm - INTEGER mdum,jj,jjj,nbin - DOUBLE PRECISION f,ffmax,sum,sum2,sum2p,fmax,x(10),fsum,fsum2,sigp - DOUBLE PRECISION av,av2,sig,sig2,eff1,eff2,DSQRT,ranf,treat,z,eff - EXTERNAL f - COMMON/maxi/mdum,mbin,ffmax,fmax(80000),nm(80000) - DOUBLE PRECISION maxar(11,100) - INTEGER kk,kkk - LOGICAL hassetgen - DATA hassetgen/.FALSE./ - SAVE hassetgen - -* -* One does not want to perform setgen twice -* (awfully time consuming...) -* - IF ( hassetgen ) RETURN - hassetgen = .TRUE. - - DO 50 i = 1,100 - DO 50 j = 1,11 - 50 maxar(j,i) = 0 - - mbin = nbin - ffmax = 0 - sum = 0 - sum2 = 0 - sum2p = 0 - mmax = mbin**ndim - IF ( nprin .GE. 2 ) PRINT 200,mbin,mmax,npoin - DO 5 j = 1,mmax - nm(j) = 0 - fmax(j) = 0 - 5 CONTINUE - DO 1 j = 1,mmax - jj = j-1 - DO 2 k=1,ndim - jjj = jj/mbin - n(k) = jj-jjj*mbin - jj = jjj - 2 CONTINUE - fsum = 0 - fsum2 = 0 - DO 3 m = 1,npoin - DO 4 k=1,ndim - x(k)=(ranf(0)+n(k))/mbin - 4 CONTINUE - IF ( ntreat .GT. 0 ) THEN - z = treat(f,x,ndim) -* PRINT *,m,(x(i),i=1,ndim),z - ELSE - z = f(x) - ENDIF - IF ( z .GT. fmax(j) ) fmax(j) = z - fsum = fsum+z - fsum2 = fsum2+z*z - - IF ( z .GT. maxar(ndim+1,100) ) THEN - DO 51 kk = 99,1,-1 - IF ( z .GT. maxar(ndim+1,kk) ) THEN - DO 52 kkk = 1,ndim+1 - 52 maxar(kkk,kk+1) = maxar(kkk,kk) - ELSE - GOTO 53 - ENDIF - 51 CONTINUE - 53 CONTINUE - maxar(ndim+1,kk+1) = z - DO 54 kkk = 1,ndim - 54 maxar(kkk,kk+1) = x(kkk) - ENDIF - - 3 CONTINUE - av = fsum/npoin - av2 = fsum2/npoin - sig2 = av2-av*av - sig = DSQRT(sig2) - sum = sum+av - sum2 = sum2+av2 - sum2p = sum2p+sig2 - IF ( fmax(j) .GT. ffmax ) ffmax = fmax(j) - eff = 10000 - IF ( fmax(j) .NE. 0 ) eff = fmax(j)/av - IF ( nprin .GE. 3 )PRINT 100,j,av,sig,fmax(j),eff, - + (n(i),i=1,ndim) - 1 CONTINUE - sum = sum/mmax - sum2 = sum2/mmax - sum2p = sum2p/mmax - sig = DSQRT(sum2-sum*sum) - sigp = DSQRT(sum2p) - eff1 = 0. - DO 6 j = 1,mmax - eff1 = eff1+fmax(j) - 6 CONTINUE - eff1 = eff1/(mmax*sum) - eff2 = ffmax/sum - IF ( nprin .GE. 1 ) PRINT 101,sum,sig,sigp,ffmax,eff1,eff2 - IF ( nprin .GE. 4 ) THEN - PRINT *,'The 100 highest function values are:' - DO 56 kk = 1,100 - PRINT 110,kk,maxar(ndim+1,kk),(maxar(kkk,kk),kkk=1,ndim) - 110 FORMAT(i4,g14.4,10f14.10) - 56 CONTINUE - ENDIF - RETURN - 100 FORMAT(i6,3x,g13.6,g12.4,g13.6,f8.2,3x,10i1) - 101 FORMAT(29h the average function value =,g14.6/ - 1 29h the overall std dev =,g14.4/ - 2 29h the average std dev =,g14.4/ - 3 29h the maximum function value =,g14.6/ - 4 29h the average inefficiency =,g14.3/ - 5 29h the overall inefficiency =,g14.3/) - 200 FORMAT(25h subroutine setgen uses a,i3,15h**ndim division/ - 1 17h this results in ,i7,6h cubes/ - 2 17h the program put ,i5,29h points in each cube to find - 3 ,30hstarting values for the maxima//) - END diff --git a/lpair_2diss/cdf/src/treat.f b/lpair_2diss/cdf/src/treat.f deleted file mode 100644 index a7580db..0000000 --- a/lpair_2diss/cdf/src/treat.f +++ /dev/null @@ -1,31 +0,0 @@ - DOUBLE PRECISION FUNCTION treat(f,x,ndim) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - EXTERNAL f - DOUBLE PRECISION x(10),z(10) - PARAMETER(MAXDIV=250) - COMMON/bveg2/ndo,it,si,si2,swgt,schi,xi(MAXDIV,10),scalls - + ,d(MAXDIV,10),di(MAXDIV,10),nxi(MAXDIV,10) - SAVE ncall,r - DATA ncall/0/ - IF ( ncall .EQ. 0 ) THEN - ncall = 1 - r = ndo - r = r**ndim - ENDIF - w = r - do 4 i = 1,ndim - xx = x(i)*ndo - j = xx - jj = j+1 - y = xx-j - IF ( j .GT. 0 ) THEN - dd = xi(jj,i)-xi(j,i) - ELSE - dd = xi(1,i) - ENDIF - z(i) = xi(jj,i)-dd*(1-y) - w = w*dd -4 CONTINUE - treat = w*f(z) - RETURN - END diff --git a/lpair_2diss/cdf/src/utils.f b/lpair_2diss/cdf/src/utils.f deleted file mode 100644 index 7204991..0000000 --- a/lpair_2diss/cdf/src/utils.f +++ /dev/null @@ -1,476 +0,0 @@ - SUBROUTINE maps2(s2,x,smin,smax,ds) - IMPLICIT DOUBLE PRECISION (a-z) - y=smax/smin - s2=smin*y**x - ds=s2*dlog(y) - RETURN - END - -*---------------------------------------------------------------------- - - SUBROUTINE mapla(x,y,z,u,xm,xp,d) - IMPLICIT DOUBLE PRECISION (a-z) - xmb=xm-y-z - xpb=xp-y-z - c=-4.*y*z - alp=dsqrt(xpb*xpb+c) - alm=dsqrt(xmb*xmb+c) - am=xmb+alm - ap=xpb+alp - yy=ap/am - zz=yy**u - x=y+z+(am*zz-c/(am*zz))*0.5 - ax=dsqrt((x-y-z)**2+c) - d=ax*dlog(yy) - RETURN - END - -*---------------------------------------------------------------------- - - SUBROUTINE inplot(now,ff,pdx) - IMPLICIT DOUBLE PRECISION ( a-h,o-z) - COMMON/lplot/xl(10),v1(2),v2(2),av(10) - DIMENSION zav(10),yav(10),zsv(10),ysv(10),ztv(10) - DIMENSION xlmax(10),xlmin(10),nlp(10),ltop(10),text(8,10),ll(10) - DIMENSION numb(12) - DIMENSION xls(42,10),yls(42,10),nlsn(42,10),mlsn(42,10),dls(10) - 1,xlav(10),xlsq(10),xlava(10),sxa(10),tlim(6),top(10),xltq(10) - DIMENSION nbin(41),nlog(41),slog(41),tlog(41),hv(12) - DIMENSION v1max(2),v1min(2),v2max(2),v2min(2),nv1(2) - 1,nv2(2),vtext(6,2) - DIMENSION vm(12,12,2),nvm(12,12,2),bin1(2),bin2(2),vol(2) - 1,wm(12,12,2),mvm(12,12,2) - COMMON/result/y,si,u,v - character*1 hmin,hplus,hblank,hstar,char(40) - save - data tlim/1.6d+00,2.5d+00,4.0d+00,6.666666667d+00,10.d+00, - +16.d+00/ - data hmin,hplus,hblank,hstar/'-','+',' ','*'/ - data mls,mav,ndmax/10,10,2/ - data ngraph/0/ - igraph=now - now=0 - kk=0 - itt=0 - IF(igraph.le.0) GO TO 800 - IF(igraph.ne.ngraph)read (12,810)nls - IF(igraph.ne.ngraph)PRINT 814,nls - IF(nls.LT.0) nls=0 - IF(nls.EQ.0) GO TO 802 - IF(nls.GT.mls) GO TO 807 - IF(igraph.ne.ngraph)PRINT 815 - do 801 i=1,nls - IF(igraph.ne.ngraph) - 1read (12,811)xlmin(i),xlmax(i),nlp(i),ltop(i),ll(i), - 2(text(j,i),j=1,8) - IF(igraph.ne.ngraph) PRINT 816,i,xlmin(i),xlmax(i) - 1,nlp(i),ltop(i),ll(i),(text(j,i),j=1,8) - IF(nlp(i).LT.1)nlp(i)=1 - IF(nlp(i).GT.40)nlp(i)=40 - dls(i)=(xlmax(i)-xlmin(i))/nlp(i) - nlps=nlp(i)+2 - do 300 j=1,nlps - yls(j,i)=0 -300 mlsn(j,i)=0 -801 CONTINUE -802 IF(igraph.ne.ngraph) read (12,810)ndd - IF(igraph.ne.ngraph) PRINT 817,ndd - IF(ndd.LT.0) ndd=0 - IF(ndd.EQ.0) GO TO 804 - IF(ndd.GT.ndmax) GO TO 807 - IF(igraph.ne.ngraph) PRINT 818 - do 803 i=1,ndd - IF(igraph.ne.ngraph) - 1read (12,812)v1min(i),v1max(i),nv1(i),v2min(i),v2max(i),nv2(i) - 1,(vtext(j,i),j=1,6) - IF(igraph.ne.ngraph) PRINT 819,i,v1min(i),v1max(i),nv1(i) - 1,v2min(i),v2max(i),nv2(i),(vtext(j,i),j=1,6) - IF(nv1(i).LT.1)nv1(i)=1 - IF(nv2(i).LT.1)nv2(i)=1 - IF(nv1(i).GT.10)nv1(i)=10 - IF(nv2(i).GT.10)nv2(i)=10 - bin1(i)=(v1max(i)-v1min(i))/nv1(i) - bin2(i)=(v2max(i)-v2min(i))/nv2(i) - vol(i)=bin1(i)*bin2(i) -803 CONTINUE - wtow=0. - do 805 i=1,ndd - do 805 j=1,12 - do 805 k=1,12 - wm(k,j,i)=0. -805 mvm(k,j,i)=0 -804 CONTINUE - IF(igraph.ne.ngraph)read (12,810)nave - IF(igraph.ne.ngraph)PRINT 820,nave - IF(nave.LT.0)nave=0 - IF(nave.GT.mav) GO TO 807 - do 11 i=1,mav - yav(i)=0. -11 ysv(i)=0. - kt=0 - GO TO 808 -800 nave=0 - nls=0 - ndd=0 - GO TO 808 -807 PRINT 813,mav,mls,ndmax - stop -808 ngraph=igraph - RETURN - entry replot(now,ff,pdx) - IF(nave.EQ.0) GO TO 49 - do 62 i=1,nave - zav(i)=0. - ztv(i)=0. -62 zsv(i)=0. -49 fsqa=0. - kt=kt+1 - IF(nls.EQ.0) GO TO 303 - do 302 i=1,nls - nlps=nlp(i)+2 - xlav(i)=0 - xltq(i)=0. - xlsq(i)=0 - do 302 j=1,nlps - xls(j,i)=0 -302 nlsn(j,i)=0 -303 CONTINUE - IF(ndd.EQ.0) GO TO 403 - do 402 i=1,ndd - n1=nv1(i)+2 - n2=nv2(i)+2 - do 402 i1=1,n1 - do 402 i2=1,n2 - vm(i1,i2,i)=0 -402 nvm(i1,i2,i)=0 -403 CONTINUE - RETURN - entry xplot(now,ff,pdx) - fsqa=fsqa+ff*ff/pdx - itt=itt+1 - IF(nls.EQ.0) GO TO 305 - do 304 i=1,nls - nlps=(xl(i)-xlmin(i))/dls(i)+1. - IF(nlps.LT.0)nlps=0 - IF(nlps.GT.nlp(i))nlps=nlp(i)+1 - nlps=nlps+1 - xls(nlps,i)=xls(nlps,i)+ff/dls(i) - nlsn(nlps,i)=nlsn(nlps,i)+1 - xlav(i)=xlav(i)+ff*xl(i) - xltq(i)=xltq(i)+ff*ff*xl(i)/pdx -304 xlsq(i)=xlsq(i)+(ff*xl(i))**2/pdx -305 CONTINUE - IF(ndd.EQ.0) GO TO 405 - do 404 i=1,ndd - i1=(v1(i)-v1min(i))/bin1(i)+2 - IF(i1.LT.1) i1=1 - IF(i1.GT.nv1(i)+2) i1=nv1(i)+2 - i2=(v2(i)-v2min(i))/bin2(i)+2 - IF(i2.LT.1) i2=1 - IF(i2.GT.nv2(i)+2) i2=nv2(i)+2 - vm(i1,i2,i)=vm(i1,i2,i)+ff/vol(i) -404 nvm(i1,i2,i)=nvm(i1,i2,i)+1 -405 CONTINUE - IF(nave.EQ.0) GO TO 99 - do 22 i=1,nave - zav(i)=zav(i)+av(i)*ff - ztv(i)=ztv(i)+ff*ff*av(i)/pdx -22 zsv(i)=zsv(i)+(av(i)*ff)**2/pdx -99 RETURN - entry plotit(now,ff,pdx) - IF(nls.EQ.0) GO TO 315 - IF(kk.GT.0) GO TO 307 - do 306 i=1,nls - nlps=nlp(i)+2 - do 306 j=1,nlps - mlsn(j,i)=nlsn(j,i) -306 yls(j,i)=xls(j,i) - GO TO 310 -307 vbef=vtot - vu=(v/u)**2 - do 309 i=1,nls - nlps=nlp(i)+2 - do 309 j=1,nlps - IF(nlsn(j,i).EQ.0) GO TO 309 - IF(mlsn(j,i).EQ.0) GO TO 308 - al1=vu/nlsn(j,i) - al2=vbef/mlsn(j,i) - mlsn(j,i)=mlsn(j,i)+nlsn(j,i) - yls(j,i)=(al2*xls(j,i)+al1*yls(j,i))/(al1+al2) - GO TO 309 -308 mlsn(j,i)=nlsn(j,i) - yls(j,i)=xls(j,i) -309 CONTINUE -310 CONTINUE - do 311 i=1,nls - sxf=xlsq(i)-xlav(i)*xlav(i) - sxt=xltq(i)-xlav(i)*u - sx2=xlsq(i)/xlav(i)**2+fsqa/u**2-2.*xltq(i)/(xlav(i)*u) - sx2=sx2*(xlav(i)/u)**2 - IF(kt.ne.1) GO TO 312 - xlava(i)=xlav(i)/u - sxa(i)=sx2 - GO TO 311 -312 xhelp=sx2+sxa(i) - IF(xhelp.EQ.0) GO TO 311 - xlava(i)=(xlav(i)*sxa(i)/u+xlava(i)*sx2)/xhelp - sxa(i)=sxa(i)*sx2/xhelp -311 CONTINUE - vtot=(si/y)**2 - IF(now.ne.2) GO TO 315 - do 341 i=1,nls - top(i)=0. - nlps=nlp(i)+1 - do 341 j=2,nlps - xls(j,i)=yls(j,i)/y - IF(xls(j,i).GT.top(i))top(i)=xls(j,i) -341 CONTINUE - do 342 i=1,nls - IF(ltop(i).le.0)ltop(i)=i - lto=ltop(i) - IF(top(i).GT.top(lto))top(lto)=top(i) -342 CONTINUE - ylog=0.5*dlog10(y*y) - do 314 i=1,nls - PRINT 321,i - nlps=nlp(i)+1 - lto=ltop(i) - top(i)=top(lto) - IF(top(i).EQ.0)top(i)=1. - an1=dlog10(top(i)) - n1=an1 - IF(n1.GT.an1)n1=n1-1 - z1=top(i)*10.**(-n1) - do 343 l=1,4 - IF(z1.LT.tlim(l)) GO TO 344 -343 CONTINUE - l=5 -344 IF(top(i).LT.1.6/(xlmax(i)-xlmin(i)))l=l+1 - topm=tlim(l)*10.**n1 - do 345 j=2,nlps - nbin(j)=xls(j,i)*40./topm+1.5 - IF(ll(i).LT.0)nbin(j)=0 - IF(xls(j,i).le.0) GO TO 346 - tlog(j)=dlog10(xls(j,i)) - slog(j)=tlog(j)+ylog - nlog(j)=(tlog(j)-n1)*8.+33.5 - IF(ll(i).GT.0)nlog(j)=0 - GO TO 345 -346 slog(j)=0 - tlog(j)=0 - nlog(j)=0 -345 CONTINUE - PRINT 322,(text(j,i),j=1,8) - n1p1=n1+1 - n1m4=n1-4 - PRINT 323,tlim(l),n1,n1p1,n1m4 - do 347 l=1,40 - char(l)=hmin - IF(nlog(l+1).EQ.41)char(l)=hplus - IF(nbin(l+1).EQ.41)char(l)=hstar -347 CONTINUE - xmin=xlmin(i) - xmax=xmin+dls(i) - PRINT 324,xmin,xmax,yls(2,i),slog(2),xls(2,i),tlog(2),mlsn(2,i) - 1,char -*********************** -* CALL pawfil2( i,real(xmin),real(xmax),real(xls(2,i))) -* CALL pawfil2(10+i,real(xmin),real(xmax),real(yls(2,i))) -*********************** - do 348 j=3,nlps - xmin=xmax - xmax=xmin+dls(i) - do 349 l=1,40 - char(l)=hblank - IF(nlog(l+1).EQ.43-j)char(l)=hplus - IF(nbin(l+1).EQ.43-j)char(l)=hstar -349 CONTINUE - PRINT 324,xmin,xmax,yls(j,i),slog(j),xls(j,i),tlog(j),mlsn(j,i) - 1,char -*********************** -* CALL pawfil2( i,real(xmin),real(xmax),real(xls(j,i))) -* CALL pawfil2(10+i,real(xmin),real(xmax),real(yls(j,i))) -*********************** -348 CONTINUE - nlps1=nlps+1 - IF(nlps.EQ.41) GO TO 352 - do 351 j=nlps1,41 - do 350 l=1,40 - char(l)=hblank - IF(nlog(l+1).EQ.43-j)char(l)=hplus - IF(nbin(l+1).EQ.43-j)char(l)=hstar -350 CONTINUE -351 PRINT 325,char -352 do 353 l=1,40 - char(l)=hmin - IF(nlog(l+1).EQ.1)char(l)=hplus - IF(nbin(l+1).EQ.1)char(l)=hstar -353 CONTINUE - PRINT 326,char - el1=yls(1,i)*dls(i) - el2=el1/y - PRINT 327,el1,el2,mlsn(1,i) - el1=yls(42,i)*dls(i) - el2=el1/y - PRINT 328,el1,el2,mlsn(nlps1,i) - sxsq=dsqrt(sxa(i)/itt) - PRINT 329,xlava(i),sxsq -314 CONTINUE -315 CONTINUE - IF(ndd.EQ.0) GO TO 409 - wbef=wtot - do 500 i=1,ndd - nx=nv1(i)+2 - ny=nv2(i)+2 - IF(kk.GT.0) GO TO 502 - do 501 j=1,nx - do 501 k=1,ny - wm(j,k,i)=vm(j,k,i) -501 mvm(j,k,i)=nvm(j,k,i) - GO TO 500 -502 vu=(v/u)**2 - do 503 j=1,nx - do 503 k=1,ny - IF(nvm(j,k,i).EQ.0) GO TO 503 - IF(mvm(j,k,i).EQ.0) GO TO 504 - al1=vu/nvm(j,k,i) - al2=vbef/mvm(j,k,i) - mvm(j,k,i)=mvm(j,k,i)+nvm(j,k,i) - wm(j,k,i)=(al2*vm(j,k,i)+al1*wm(j,k,i))/(al1+al2) - GO TO 503 -504 mvm(j,k,i)=nvm(j,k,i) - wm(j,k,i)=vm(j,k,i) -503 CONTINUE -500 CONTINUE - wtot=(si/y)**2 - IF(now.ne.2) GO TO 409 - do 408 i=1,ndd - PRINT 481,i,(vtext(j,i),j=1,6) - vvv=v2max(i) - mvv=nv1(i)+2 - nvv=nv2(i)+1 - size=vol(i)/y - do 406 i2=1,nvv - j2=nvv+2-i2 - do 410 i1=1,mvv -410 numb(i1)=1000.*wm(i1,j2,i)*size+.5 - PRINT 486,(numb(i1),i1=1,mvv) - PRINT 483,(wm(i1,j2,i),i1=1,mvv) - PRINT 486,(mvm(i1,j2,i),i1=1,mvv) - PRINT 484,vvv - vvv=vvv-bin2(i) - IF(dabs(vvv/bin2(i)).LT.1.e-10)vvv=0. -406 CONTINUE - do 411 i1=1,mvv -411 numb(i1)=1000.*wm(i1,1,i)*size+.5 - PRINT 486,(numb(i1),i1=1,mvv) - PRINT 483,(wm(i1,1,i),i1=1,mvv) - PRINT 486,(mvm(i1,1,i),i1=1,mvv) - PRINT 482 - mvv=mvv-1 - do 407 i1=1,mvv - hv(i1)=v1min(i)+(i1-1)*bin1(i) - IF(dabs(hv(i1)/bin1(i)).LT.1.d-10)hv(i1)=0. -407 CONTINUE - PRINT 485,(hv(i1),i1=1,mvv) -408 CONTINUE -409 CONTINUE - IF(nave.EQ.0) GO TO 23 - IF(now.EQ.2) PRINT 26 - do 24 i=1,nave - sxf=zsv(i)-zav(i)*zav(i) - sxt=zsv(i)/zav(i)**2+fsqa/u**2-2.*ztv(i)/(zav(i)*u) - sx2=sxt*(zav(i)/u)**2 - IF(kt.ne.1) GO TO 21 - yav(i)=zav(i)/u - ysv(i)=sx2 - GO TO 30 -21 xhelp=sx2+ysv(i) - IF(xhelp.EQ.0) GO TO 30 - yav(i)=(ysv(i)*zav(i)/u+yav(i)*sx2)/xhelp - ysv(i)=ysv(i)*sx2/xhelp -30 yssq=dsqrt(ysv(i)/itt) - IF(now.EQ.2)PRINT 27,i,yav(i),yssq -24 CONTINUE -23 now=1 - kk=kk+1 - RETURN -27 format(12x,i2,9x,d15.5,5x,d15.3) -26 format(1h1,10x,46hthe following are averages with error estimate/) -321 format(1h1,40x,40hsingle dIFferential cross-section number,i3///) -322 format(38h single dIFferential cross section of ,8a4/) -323 format(11x,6hlimits,9x,1hi,16x,19haccumulated results,15x,1hi,24x - 1,9hupper bin,6x,9hlower bin/26x,1hi,50x,20hi * linear plot, - 2f8.2,5h*10**,i3,8x,1h0/5x,5hlower,7x,5hupper,4x,1hi,5x,5hds/dx,4x - 3,56halog10 (ds/dx)/s alog10 points i + logarithmic plot,6x - 4,4h10**,i3,8x,4h10**,i3/2x,24(1h-),1hi,50(1h-),1hi) -324 format(d12.4,d12.4,3h i,2(d12.4,f8.2),i8,3h i,4x,1hi,40a1,1hi) -325 format(26x,1hi,50x,1hi,4x,1hi,40a1,1hi) -326 format(2x,24(1h-),1hi,50(1h-),1hi,4x,1hi,40a1,1hi) -327 format(7x,15htotal underflow,4x,1hi,d12.4,d20.4,i16,2x,1hi) -328 format(7x,15htotal overflow,4x,1hi,d12.4,d20.4,i16,2x,1hi) -329 format(//19x,21haccumulated average =,d12.5 - 1/19x,21hestimated error =,d12.5) -481 format(1h1,45x,40hdouble dIFferential cross-section number,i3/ - 1/60x,7hx-axis ,3a4/60x,7hy-axis ,3a4/) -482 format(20x,11(1hi,9x)) -483 format(11x,d9.3,11(1hi,d9.3)) -484 format(1x,d10.3, 9h---------,11(10hi---------)) -485 format(1h0,14x,11d10.3) -486 format(11x,i8,1x,11(1hi,i8,1x)) -810 format(i2) -811 format(2d12.4,3i2,8a4) -812 format(2(2d10.3,i4),6a4) -813 format(12h1***error***,10x,24htoo many plots requested// - 122x,20hthe upper limits are //19x,i2,9h averages//19x,i2,22h one d - 2mensional plots//19x,i2,22h two DIMENSIONal plots////22x,25h***exe - 3cution is halted*** ) -814 format(37h1number of single dIFferential cross - 1,20hsections requested =,i3/) -815 format(30h information on the data cards// - 13h i,10x,5hxlmin,12x,5hxlmax,7x, - 224hbins correllation type,19x,4htext/) -816 format(i3,2e17.4,i8,i9,i10,5x,8a4) -817 format(37h0number of double dIFferential cross - 1,20hsections requested =,i3/) -818 format(30h information on the data cards// - 13h i,8x,5hv1min,10x,5hv1max,4x,4hbins,8x,5hv2min - 2,10x,5hv2max,4x,4hbins,8x,6htext 1,8x,6htext 2/) -819 format(i3,2d15.3,i5,1x,2d15.3,i5,6x,3a4,2x,3a4) -820 format(31h0number of averages requested =,i3) - END - -*---------------------------------------------------------------------- - - SUBROUTINE mapw2(w2,x,w2min,w2max,dw) - IMPLICIT DOUBLE PRECISION (a-z) -* wmin=1./w2min -* wmax=1./w2max -* dw=wmin-wmax -* w2=1./(wmax+dw*x) -* dw=dw*w2*w2 - y = w2max/w2min - w2 = w2min*y**x - dw = w2*dlog(y) - RETURN - END - - SUBROUTINE mapt1(t,x,tmin,tmax,dt) - IMPLICIT DOUBLE PRECISION (a-z) - y=tmax/tmin - t=tmin*y**x - dt=-t*dlog(y) -* dt = tmin-tmax -* t = tmin - x*dt - RETURN - END - - SUBROUTINE mapt2(t,x,tmin,tmax,dt) - IMPLICIT DOUBLE PRECISION (a-h,o-z) - y=tmax/tmin - t=tmin*y**x - dt=-t*dlog(y) -* dt = tmin-tmax -* t = tmin - x*dt - RETURN - END diff --git a/lpair_2diss/cdf/src/vegas.f b/lpair_2diss/cdf/src/vegas.f deleted file mode 100644 index a3b3fed..0000000 --- a/lpair_2diss/cdf/src/vegas.f +++ /dev/null @@ -1,229 +0,0 @@ - SUBROUTINE vegas(fxn,bcc,ndim,ncall,itmx,nprn,igraph) - IMPLICIT DOUBLE PRECISION ( a-h,o-z ) - PARAMETER(MAXDIV=250) - COMMON/bveg2/ndo,it,si,si2,swgt,schi,xi(MAXDIV,10),scalls - + ,d(MAXDIV,10),di(MAXDIV,10),nxi(MAXDIV,10) - DOUBLE PRECISION xin(MAXDIV),r(MAXDIV),dx(10),dt(10) - INTEGER ia(10),kg(10) - DOUBLE PRECISION xl(10),xu(10),qran(10),x(10) - COMMON/result/s1,s2,s3,s4 - EXTERNAL fxn - DATA xl,xu/10*0.D0,10*1.D0/ - DATA ndmx/MAXDIV/,alph/1.5D0/,one/1.D0/,mds/1/ - ipr = 1 - IF ( nprn .GT. 0 ) ipr = 0 - ndo = 1 - DO 1 j=1,ndim -1 xi(1,j) = one - ENTRY vegas1(fxn,bcc,ndim,ncall,itmx,nprn,igraph) - now=igraph - IF ( igraph .GT. 0 ) CALL inplot(now,f1,w) - it = 0 - si = 0 - si2 = si - swgt = si - schi = si - scalls = si - ENTRY vegas2(fxn,bcc,ndim,ncall,itmx,nprn,igraph) - nd = ndmx - ng = 1 - IF ( mds .EQ. 0 ) GO TO 2 - ng = ( ncall*0.5D0 ) ** ( 1.D0/ndim ) - mds = 1 - IF ( (2*ng-ndmx) .LT. 0 ) GO TO 2 - mds = -1 - npg = ng/ndmx+1 - nd = ng/npg - ng = npg*nd -2 k = ng**ndim - npg = ncall/k - IF ( npg .LT. 2 ) npg = 2 - calls = npg*k - dxg = one/ng - dv2g = (dxg**(2*ndim))/npg/npg/(npg-one) - xnd = nd - ndm = nd-1 - dxg = dxg*xnd - xjac = one - DO 3 j = 1,ndim - dx(j) = xu(j)-xl(j) -3 xjac = xjac*dx(j) - IF ( nd .EQ. ndo ) GO TO 8 - rc = ndo/xnd - DO 7 j=1,ndim - k = 0 - xn = 0 - dr = xn - i = k -4 k = k+1 - dr = dr+one - xo = xn - xn = xi(k,j) -5 IF ( rc .GT. dr ) GO TO 4 - i = i+1 - dr = dr-rc - xin(i) = xn-(xn-xo)*dr - IF ( i .LT. ndm ) GO TO 5 - DO 6 i = 1,ndm -6 xi(i,j) = xin(i) -7 xi(nd,j) = one - ndo = nd - acc = bcc -8 IF ( ( nprn .NE. 0 ) .AND. ( nprn .NE. 10 ) ) PRINT 200 - + ,ndim,calls,it,itmx,acc,mds,nd - IF ( nprn .EQ. 10 ) PRINT 290,ndim,calls,itmx,acc,mds,nd - ENTRY vegas3(fxn,bcc,ndim,ncall,itmx,nprn,igraph) -9 it = it+1 - ti = 0 - tsi = ti - IF ( igraph .GT. 0 ) CALL replot(now,f1,w) - DO 10 j = 1,ndim - kg(j) = 1 - DO 10 i = 1,nd - nxi(i,j) = 0 - d(i,j) = ti -10 di(i,j) = ti -11 fb = 0 - f2b = fb - k = 0 -12 k = k+1 - DO 121 j = 1,ndim -121 qran(j) = ranf(0) - wgt = xjac - DO 15 j = 1,ndim - xn = (kg(j)-qran(j))*dxg+one - ia(j) = xn - iaj = ia(j) - iaj1 = iaj-1 - IF ( iaj .GT. 1 ) GO TO 13 - xo = xi(iaj,j) - rc = (xn-iaj)*xo - GO TO 14 -13 xo = xi(iaj,j)-xi(iaj1,j) - rc = xi(iaj1,j)+(xn-iaj)*xo -14 x(j) = xl(j)+rc*dx(j) -15 wgt = wgt*xo*xnd - f = fxn(x)*wgt - f1 = f/calls - w = wgt/calls - IF ( igraph .GT. 0 ) CALL xplot(now,f1,w) - f2 = f*f - fb = fb+f - f2b = f2b+f2 - DO 16 j=1,ndim - iaj = ia(j) - nxi(iaj,j) = nxi(iaj,j)+1 - di(iaj,j) = di(iaj,j)+f/calls - IF ( mds .GE. 0 ) d(iaj,j) = d(iaj,j)+f2 -16 CONTINUE - IF ( k .LT. npg ) GO TO 12 - f2b = f2b*npg - f2b = DSQRT(f2b) - f2b = (f2b-fb)*(f2b+fb) - ti = ti+fb - tsi = tsi+f2b - IF ( mds .GE. 0 ) GO TO 18 - DO 17 j = 1,ndim - iaj = ia(j) -17 d(iaj,j) = d(iaj,j)+f2b -18 k = ndim -19 kg(k) = MOD(kg(k),ng)+1 - IF ( kg(k) .NE. 1 ) GO TO 11 - k = k-1 - IF ( k .GT. 0 ) GO TO 19 - ti = ti/calls - tsi = tsi*dv2g - ti2 = ti*ti - wgt = ti2/tsi - si = si+ti*wgt - si2 = si2+ti2 - swgt= swgt+wgt - schi= schi+ti2*wgt - scalls = scalls+calls - avgi = si/swgt - sd = swgt*it/si2 - chi2a= 0 - IF ( it .GT. 1 ) chi2a = sd*(schi/swgt-avgi*avgi)/(it-1) - sd = one/sd - sd = DSQRT(sd) - IF ( nprn .EQ. 0 ) GO TO 21 - tsi = DSQRT(tsi) - IF ( nprn .NE. 10 ) PRINT 201,ipr,it,ti,tsi,avgi,sd,chi2a - IF ( nprn .EQ. 10 ) PRINT 203,it,ti,tsi,avgi,sd,chi2a - IF ( nprn .GE. 0 ) GO TO 21 - DO 20 j = 1,ndim - PRINT 202,j -20 PRINT 204,(xi(i,j),di(i,j),d(i,j),i=1,nd) -21 IF ( DABS(sd/avgi) .LE. DABS(acc) .OR. it .GE. itmx ) now = 2 - s1 = avgi - s2 = sd - s3 = ti - s4 = tsi - IF ( igraph .GT. 0 ) CALL plotit(now,f1,w) -* DO 23 j=1,ndim -* xo=d(1,j) -* xn=d(2,j) -* d(1,j)=(xo+xn)*0.5D0 -* dt(j)=d(1,j) -* DO 22 i=2,ndm -* d(i,j)=xo+xn -* xo=xn -* xn=d(i+1,j) -* d(i,j)=(d(i,j)+xn)/3 -*22 dt(j)=dt(j)+d(i,j) -* d(nd,j)=(xn+xo)/2 -*23 dt(j)=dt(j)+d(nd,j) -*-----this part of the vegas-algorithm is unstable -*-----it should be replaced by - DO 23 j = 1,ndim - dt(j) = 0 - DO 23 i = 1,nd - IF ( nxi(i,j) .GT. 0 ) d(i,j) = d(i,j)/nxi(i,j) - dt(j) = dt(j)+d(i,j) -23 CONTINUE - DO 28 j=1,ndim - rc = 0 - DO 24 i = 1,nd - r(i) = 0 - IF ( d(i,j) .LE. 0 ) GO TO 24 - xo = dt(j)/d(i,j) - r(i) = ((xo-one)/xo/dlog(xo))**alph -24 rc = rc+r(i) - rc = rc/xnd - k = 0 - xn = 0 - dr = xn - i = k -25 k = k+1 - dr = dr+r(k) - xo = xn - xn = xi(k,j) -26 IF ( rc .GT. dr ) GO TO 25 - i = i+1 - dr = dr-rc - xin(i) = xn-(xn-xo)*dr/r(k) - IF (i .LT. ndm ) GO TO 26 - DO 27 i = 1,ndm -27 xi(i,j) = xin(i) -28 xi(nd,j)= one - IF ( it .LT. itmx .AND. DABS(acc) .LT. DABS(sd/avgi) ) GO TO 9 -200 FORMAT(35h0input parameters for vegas ndim=,i3 - +,8h ncall=,f8.0/28x,5h it=,i5,8h itmx =,i5/28x - +,6h acc=,g9.3/28x,6h mds=,i3,6h nd=,i4//) -290 FORMAT(13h0vegas ndim=,i3,8h ncall=,f8.0,8h itmx =,i5 - +,6h acc=,g9.3,6h mds=,i3,6h nd=,i4) -201 FORMAT(/i1,20hintegration by vegas/13h0iteration no,i3, - +14h. integral =,g14.8/20x,10hstd dev =,g10.4/ - +34h accumulated results. integral =,g14.8/ - +24x,10hstd dev =,g10.4 / 24x,18hchi**2 per itn =,g10.4) -202 FORMAT(14h0data for axis,i2 / 7x,1hx,7x,10h delt i , - +2x,11h convce ,11x,1hx,7x,10h delt i ,2x,11h convce - +,11x,1hx,7x,10h delt i ,2x,11h convce /) -204 FORMAT(1x,3g12.4,5x,3g12.4,5x,3g12.4) -203 FORMAT(1h ,i3,g20.8,g12.4,g20.8,g12.4,g12.4) - s1 = avgi - s2 = sd - s3 = chi2a - RETURN - END - diff --git a/lpair_2diss/cdf/utils.h b/lpair_2diss/cdf/utils.h deleted file mode 100644 index 08e319d..0000000 --- a/lpair_2diss/cdf/utils.h +++ /dev/null @@ -1,35 +0,0 @@ -#ifndef _UTILS_H -#define _UTILS_H - -#include - -/** - * An object which enables to extract the processing time between two steps in - * this software's flow - */ -class Timer -{ - public: - inline Timer() { clock_gettime(CLOCK_REALTIME, &beg_); } - /** - * Get the time elapsed since the last @a reset call (or class construction) - * @return The elapsed time in seconds - */ - inline double elapsed() { - clock_gettime(CLOCK_REALTIME, &end_); - return end_.tv_sec -beg_.tv_sec+(end_.tv_nsec - beg_.tv_nsec)/1000000000.; - } - /** - * @brief Resets the clock counter - */ - inline void reset() { - clock_gettime(CLOCK_REALTIME, &beg_); - } - private: - /** @brief Timestamp marking the beginning of the counter */ - timespec beg_; - /** @brief Timestamp marking the end of the counter */ - timespec end_; -}; - -#endif diff --git a/lpair_2diss/cdf/xsect.cpp b/lpair_2diss/cdf/xsect.cpp deleted file mode 100644 index 147bce2..0000000 --- a/lpair_2diss/cdf/xsect.cpp +++ /dev/null @@ -1,57 +0,0 @@ -#include -#include - -using namespace std; - -extern "C" { - //void zduini_(); - //void zduevt_(int* iwant); - void fileini_(); - void integrate_(); - - extern struct { - int ipar[20]; - double lpar[20]; - } datapar_; - - extern struct { - double s1,s2,s3,s4; - } result_; - -} - -int main() { - - fileini_(); - - // Beam parameters - datapar_.ipar[4] = 7; - datapar_.lpar[2] = 6500.; - - // Outgoing leptons kinematics - datapar_.lpar[4] = 2.5; // eta cut - datapar_.lpar[5] = 0.; // energy cut - datapar_.lpar[6] = 0.; // pt cut - //integrate_(); - - //ofstream cs("tmp/xsec_lpair_elastic_vs_cm_energy.dat"); - //ofstream cs("tmp/xsec_lpair_doubleinelastic_8tev_noetacut.dat"); - ofstream cs("xsec_lpair_elastic_13tev_eta2p5cut.dat"); - //ofstream cs("xsec_lpair_singleinelastic_13tev_eta2p5cut.dat"); - //ofstream cs("xsec_lpair_doubleinelastic_13tev_eta2p5cut.dat"); - - for (int i=0; i<50; i++) { - //datapar_.lpar[6] = 0.+i*0.1; - datapar_.lpar[6] = 5.+i*0.5; - //datapar_.lpar[2] = (i+1)*(14000/50); - integrate_(); - - //cs << datapar_.lpar[2] << "\t" << result_.s1 << "\t" << result_.s2 << endl; - //std::cout << "sqrt(s) = " << datapar_.lpar[2] << " GeV : xsec = " << result_.s1 << ", error = " << result_.s2 << std::endl; - cs << datapar_.lpar[6] << "\t" << result_.s1 << "\t" << result_.s2 << endl; - cs.flush(); - std::cout << "pt> " << datapar_.lpar[6] << " GeV : xsec = " << result_.s1 << ", error = " << result_.s2 << std::endl; - } - - return 0; -} diff --git a/lpair_2diss/desy/ConvertLPairToLHE.C b/lpair_2diss/desy/ConvertLPairToLHE.C deleted file mode 100644 index 7e8235e..0000000 --- a/lpair_2diss/desy/ConvertLPairToLHE.C +++ /dev/null @@ -1,112 +0,0 @@ -#include "TFile.h" -#include "TTree.h" -#include -#include -using namespace std; - -void ConvertLPairToLHE() -{ - const Double_t energy = 6500; - const Int_t N = 200; // max number of particles in per event - const Int_t max_events = 2E5; - - TFile *f1 = TFile::Open("events.root"); - TTree *t1 = (TTree*) f1->Get("h4444"); - Double_t xsec, errxsec; - Double_t px[N],py[N],pz[N],en[N],m[N]; - Int_t partid[N], parent[N], daughter1[N], daughter2[N], ip, status[N]; - Double_t iz[N]; - - t1->SetBranchAddress("xsect",&xsec); - t1->SetBranchAddress("errxsect",&errxsec); - t1->SetBranchAddress("px",px); - t1->SetBranchAddress("py",py); - t1->SetBranchAddress("pz",pz); - t1->SetBranchAddress("E",en); - t1->SetBranchAddress("icode",partid); - t1->SetBranchAddress("m",m); - t1->SetBranchAddress("status",status); - t1->SetBranchAddress("parent",parent); - t1->SetBranchAddress("daughter1",daughter1); - t1->SetBranchAddress("daughter2",daughter2); -// t1->SetBranchAddress("iz",iz); - t1->SetBranchAddress("ip",&ip); - - ofstream output("events.lhe"); - //ofstream output("gammagammatautau.lpair_inelel_pt15_7tev.lhe"); - //ofstream output("gammagammatautau.lpair_inelel_tautau_pt25_8tev.lhe"); - //ofstream output("gammagammatautau.lpair_elel_tautau_pt40_7tev.lhe"); - - Int_t nevts = t1->GetEntries(); - if(nevts<1) { std::cout << "no event in the file\n"; return;} - - int first_event = 0; - - output << "" << endl; - output << "
" << endl; - output << "This file was created from the output of the LPAIR generator" << endl; - output << "
" << endl; - - t1->GetEntry(0); - cout << "xsect = " << xsec << " +/- " << errxsec << endl; - - output << "" << endl; - output << "2212 2212 " << energy << " " << energy << " 0 0 10042 10042 2 1" << endl; - output << xsec << " " << errxsec << " 0.26731120000E-03 0" << endl; - output << "" << endl; - - for(Int_t i = first_event;i < first_event+max_events;i++) { - t1->GetEntry(i); - if (i%10000==0) - cout << i << ", Npart = " << ip << endl; - - output << "" << endl; - output << ip-3 << " 0 0.2983460E-04 0.9118800E+02 0.7546772E-02 0.1300000E+00" << endl; - // cout << "there are " << ip << " particles in this event\n"; - - for(int j=0; j=11 && status[j]<=13)) status[j] = 3; // quarks content - else if (status[j]==11) status[j] = 2; // intermediate resonance - - //output << partid[j] << " 1 1 2 0 0 " << px[j] << " " << py[j] << " " << pz[j] << " " << en[j] << " " << m[j] << " 0. " << iz[j] << endl; - output << fixed << setw(6) << partid[j] << setw(4) - << status[j] << setw(4) - << parent[j] << " 0 0 0" << setw(14) - << px[j] << setw(14) - << py[j] << setw(14) - << pz[j] << setw(14) - << en[j] << setw(10) - << m[j] << " 0. " << setw(9) - << iz[j] << endl; - // output << "P "<< i*N+j << " " << partid[j] << " " << px[j] << " " << py[j] << " " << pz[j] << " " << en[j] << " 1 0 0 0 0" << endl; - } - - - output << "" << endl; - } - output << "" << endl; - output.close(); - - cout << "Converted " << max_events << " events" << endl; -} diff --git a/lpair_2diss/desy/Makefile b/lpair_2diss/desy/Makefile deleted file mode 100644 index e27398b..0000000 --- a/lpair_2diss/desy/Makefile +++ /dev/null @@ -1,59 +0,0 @@ -FF_FILES = $(wildcard source/*.f) -EX_FILES = $(wildcard external/*.f) -OBJ_DIR = obj -LIBRARY = -L/usr/lib64/cernlib/2006/lib #-lpdflib804 -OBJ_FILES = $(patsubst source/%.f,$(OBJ_DIR)/%.o,$(FF_FILES)) -EXT_FILES = $(patsubst external/%.f,$(OBJ_DIR)/%.o,$(EX_FILES)) -LIB_FILES = $(EXT_FILES) $(OBJ_FILES) -VPATH = source/ external/ - -############################################################################### - -FC = gfortran -FFLAGS = -g -w -CC = g++ -CFLAGS = -lgfortran -Wall -I$(RHEAD) -lrt -RFLAGS = $(shell root-config --cflags) -RLIBS = $(shell root-config --libs) -RHEAD = $(shell root-config --incdir) - -RM = /bin/rm -RMFLAGS = -rf - -.PHONY: all -all: lpair - -# -# Make the executable -# -lpair: $(OBJ_DIR)/main.opp $(LIB_FILES) $(OBJ_FILES) - @echo "Linking..." - @$(CC) $(CFLAGS) -o $@ $^ $(LIBRARY) $(RLIBS) - @echo "Done!" - -xsect: $(OBJ_DIR)/xsect.opp $(LIB_FILES) $(OBJ_FILES) - @echo "Linking $<..." - @$(CC) $(CFLAGS) -o $@ $^ $(LIBRARY) - @echo "Done!" - -nice: - @$(RM) $(RMFLAGS) *.o $(OBJ_DIR) - -clean: nice - @$(RM) $(RMFLAGS) lpair -# -# Make the objects -# -$(OBJ_DIR)/%.o: %.f - @echo "Building "$< - @$(FC) -c $(FFLAGS) $< -o $@ - -$(OBJ_DIR)/%.opp: %.cpp | $(OBJ_DIR) - @echo "Building "$< - @$(CC) $(CFLAGS) -c $(RFLAGS) $< -o $@ - -$(OBJ_FILES): | $(OBJ_DIR) -$(EXT_FILES): | $(OBJ_DIR) - -$(OBJ_DIR): - @mkdir -p $(OBJ_DIR) diff --git a/lpair_2diss/desy/README b/lpair_2diss/desy/README deleted file mode 100644 index caf163b..0000000 --- a/lpair_2diss/desy/README +++ /dev/null @@ -1,37 +0,0 @@ -------------------------------------------------------- -- LPAIR ("DESY" VERSION) - -- INSTALLATION INSTRUCTIONS - -- - -- August 2012-November 2013 - -- Laurent Forthomme - -- - -------------------------------------------------------- - - To build this version of LPAIR : - - * First of all ensure that you have a working instance of - CERNLIB installed on your computer with PDFLIB. - If not, go on - - http://www-zeuthen.desy.de/linear_collider/cernlib/new/ - - and fetch one of the provided versions (the last one - was released in 2006). - - * Compile LPAIR (ilpair-cms-pp.f) and its dependencies - (located in source/) : - - make - - * Once the compilation has been done, edit the configuration - file lpair.card to set the requested the process and kinematics. - - See http://www.desy.de/~heramc/programs/lpair/lpair.pdf - for the complete list of parameters to be provided. - Run LPAIR by typing - - ./lpair - - where the argument is facultative (if no argument is provided - the program will look for any default card named lpair.card in - the current directory). \ No newline at end of file diff --git a/lpair_2diss/desy/README_RUN_MCgem b/lpair_2diss/desy/README_RUN_MCgem deleted file mode 100644 index 9c4669c..0000000 --- a/lpair_2diss/desy/README_RUN_MCgem +++ /dev/null @@ -1,11 +0,0 @@ -to run lpair: - -sometimes a card with a filename other than "lpair.card" will not be recognized by the program. - -rename your card to follow "lpair.card" and simply run "./lpair" since the program uses the default card "lpair.card" as input. - -the output will be "events.root" - -run "root -q -b ConvertLPairToLHE.C" to convert "events.root" to "events.lhe". - -c'est tout. diff --git a/lpair_2diss/desy/convert.C b/lpair_2diss/desy/convert.C deleted file mode 100644 index d07d94a..0000000 --- a/lpair_2diss/desy/convert.C +++ /dev/null @@ -1,144 +0,0 @@ -#include "TFile.h" -#include "TTree.h" -#include -#include -#include -using namespace std; - -void convert() -{ - const Double_t energy = 6500; - const Int_t N = 200; // max number of particles in per event - const Int_t max_events = 2e5; - - TFile *f1 = TFile::Open("LPAIR_gammagammaEE_el-el_pt40.root"); - TTree *t1 = (TTree*) f1->Get("h4444"); - Double_t xsec, errxsec; - Double_t px[N],py[N],pz[N],en[N],m[N]; - Int_t partid[N], parent[N], daughter1[N], daughter2[N], ip, status[N]; - Double_t iz[N]; - stringstream ss; - Int_t np; - - t1->SetBranchAddress("xsect",&xsec); - t1->SetBranchAddress("errxsect",&errxsec); - t1->SetBranchAddress("px",px); - t1->SetBranchAddress("py",py); - t1->SetBranchAddress("pz",pz); - t1->SetBranchAddress("E",en); - t1->SetBranchAddress("icode",partid); - t1->SetBranchAddress("m",m); - t1->SetBranchAddress("status",status); - t1->SetBranchAddress("parent",parent); - t1->SetBranchAddress("daughter1",daughter1); - t1->SetBranchAddress("daughter2",daughter2); - //t1->SetBranchAddress("iz",iz); - t1->SetBranchAddress("ip",&ip); - - ofstream output("LPAIR_gammagammaEE_el-el_pt40.lhe"); - //ofstream output("gammagammatautau.lpair_inelel_pt15_7tev.lhe"); - //ofstream output("gammagammatautau.lpair_inelel_tautau_pt25_8tev.lhe"); - //ofstream output("gammagammatautau.lpair_elel_tautau_pt40_7tev.lhe"); - - Int_t nevts = t1->GetEntries(); - if(nevts<1) { std::cout << "no event in the file\n"; return;} - - int first_event = 0; - - output << "" << endl; - output << "
" << endl; - output << "This file was created from the output of the LPAIR generator" << endl; - output << "
" << endl; - - t1->GetEntry(0); - cout << "xsect = " << xsec << " +/- " << errxsec << endl; - - output << "" << endl; - output << "2212 2212 " << energy << " " << energy << " 0 0 10042 10042 2 1" << endl; - output << xsec << " " << errxsec << " 0.26731120000E-03 0" << endl; - output << "" << endl; - - for(Int_t i = first_event;i < first_event+max_events;i++) { - t1->GetEntry(i); - if (i%10000==0) cout << i << ", Npart = " << ip << endl; - - - /* - Event content : - (0) : incoming proton 1 (elastic, or dissociating) - (1) : incoming proton 2 (elastic only) - (2) : photon from proton 1 - (3) : photon from proton 2 - (4) : outgoing proton (or remnant) 1 - (5) : muon 1 - (6) : dimuon system - (7) : muon 2 - (8) : outgoing proton 2 - (9) : quark (from remnants) - (10) : diquark (from remnants) - */ - cout << "there are " << ip << " particles (" << ip-11 << " from remnants) in this event\n"; - - ss.str(""); - - for(int j=0; j" << endl; - output << np << " 0 0.298346E-04 0.91188E+02 0.7546772E-02 0.13E+00" << endl; - output << ss.str(); - output << "" << endl; - - /* - - if (partid[j]==2212 && status[j]==21) { - continue; - } - else if (partid[j]==22 && status[j]==21) { - if (j%2==0) iz[j] = 1.; - else iz[j] = -1.; // helicity - parent[j] = 0; - status[j] = -1; // incoming photon - } - else if (partid[j]==92) status[j] = 3; // string - else if ((partid[j]==1 || partid[j]==2 || partid[j]==2101 || partid[j]==2103 || partid[j]==2203) && (status[j]>=11 && status[j]<=13)) status[j] = 3; // quarks content - else if (status[j]==11) status[j] = 2; // intermediate resonance - - //output << partid[j] << " 1 1 2 0 0 " << px[j] << " " << py[j] << " " << pz[j] << " " << en[j] << " " << m[j] << " 0. " << iz[j] << endl; - output << partid[j] << " " - << status[j] << " " - << parent[j] << " 0 0 0 " - << px[j] << " " - << py[j] << " " - << pz[j] << " " - << en[j] << " " - << m[j] << " 0. " - << iz[j] << endl; - // output << "P "<< i*N+j << " " << partid[j] << " " << px[j] << " " << py[j] << " " << pz[j] << " " << en[j] << " 1 0 0 0 0" << endl; - }*/ - - } - output << "" << endl; - output.close(); - - cout << "Converted " << max_events << " events" << endl; -} diff --git a/lpair_2diss/desy/external/jetset7410.f b/lpair_2diss/desy/external/jetset7410.f deleted file mode 100644 index 4a2017e..0000000 --- a/lpair_2diss/desy/external/jetset7410.f +++ /dev/null @@ -1,11574 +0,0 @@ -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(I1,J)=V(IA,J) - 110 CONTINUE - K(IA,1)=K(IA,1)+10 - IF(K(I1,1).EQ.1) GOTO 120 - ENDIF - -C...Go to next parton in colour space. - IB=IA - IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5)) - &.NE.0) THEN - IA=MOD(K(IB,KCS),MSTU(5)) - K(IB,KCS)=K(IB,KCS)+MSTU(5)**2 - MREV=0 - ELSE - IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5),MSTU(5)) - & .EQ.0) KCS=9-KCS - IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5)) - K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2 - MREV=1 - ENDIF - IF(IA.LE.0.OR.IA.GT.N) THEN - CALL LUERRM(12,'(LUPREP:) colour rearrangement failed') - RETURN - ENDIF - IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5), - &MSTU(5)).EQ.IB) THEN - IF(MREV.EQ.1) KCS=9-KCS - IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS - K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2 - ELSE - IF(MREV.EQ.0) KCS=9-KCS - IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS - K(IA,KCS)=K(IA,KCS)+MSTU(5)**2 - ENDIF - IF(IA.NE.I) GOTO 100 - K(I1,1)=1 - 120 CONTINUE - 130 CONTINUE - N=I1 - IF(MSTJ(14).LT.0) RETURN - -C...Find lowest-mass colour singlet jet system, OK if above threshold. - IF(MSTJ(14).EQ.0) GOTO 320 - NS=N - 140 NSIN=N-NS - PDM=1.+PARJ(32) - IC=0 - DO 190 I=MAX(1,IP),NS - IF(K(I,1).NE.1.AND.K(I,1).NE.2) THEN - ELSEIF(K(I,1).EQ.2.AND.IC.EQ.0) THEN - NSIN=NSIN+1 - IC=I - DO 150 J=1,4 - DPS(J)=P(I,J) - 150 CONTINUE - MSTJ(93)=1 - DPS(5)=ULMASS(K(I,2)) - ELSEIF(K(I,1).EQ.2) THEN - DO 160 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 160 CONTINUE - ELSEIF(IC.NE.0.AND.KCHG(LUCOMP(K(I,2)),2).NE.0) THEN - DO 170 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 170 CONTINUE - MSTJ(93)=1 - DPS(5)=DPS(5)+ULMASS(K(I,2)) - PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))-DPS(5) - IF(PD.LT.PDM) THEN - PDM=PD - DO 180 J=1,5 - DPC(J)=DPS(J) - 180 CONTINUE - IC1=IC - IC2=I - ENDIF - IC=0 - ELSE - NSIN=NSIN+1 - ENDIF - 190 CONTINUE - IF(PDM.GE.PARJ(32)) GOTO 320 - -C...Fill small-mass system as cluster. - NSAV=N - PECM=SQRT(MAX(0D0,DPC(4)**2-DPC(1)**2-DPC(2)**2-DPC(3)**2)) - K(N+1,1)=11 - K(N+1,2)=91 - K(N+1,3)=IC1 - K(N+1,4)=N+2 - K(N+1,5)=N+3 - P(N+1,1)=DPC(1) - P(N+1,2)=DPC(2) - P(N+1,3)=DPC(3) - P(N+1,4)=DPC(4) - P(N+1,5)=PECM - -C...Form two particles from flavours of lowest-mass system, if feasible. - K(N+2,1)=1 - K(N+3,1)=1 - IF(MSTU(16).NE.2) THEN - K(N+2,3)=N+1 - K(N+3,3)=N+1 - ELSE - K(N+2,3)=IC1 - K(N+3,3)=IC2 - ENDIF - K(N+2,4)=0 - K(N+3,4)=0 - K(N+2,5)=0 - K(N+3,5)=0 - IF(IABS(K(IC1,2)).NE.21) THEN - KC1=LUCOMP(K(IC1,2)) - KC2=LUCOMP(K(IC2,2)) - IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 320 - KQ1=KCHG(KC1,2)*ISIGN(1,K(IC1,2)) - KQ2=KCHG(KC2,2)*ISIGN(1,K(IC2,2)) - IF(KQ1+KQ2.NE.0) GOTO 320 - 200 CALL LUKFDI(K(IC1,2),0,KFLN,K(N+2,2)) - CALL LUKFDI(K(IC2,2),-KFLN,KFLDMP,K(N+3,2)) - IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 200 - ELSE - IF(IABS(K(IC2,2)).NE.21) GOTO 320 - 210 CALL LUKFDI(1+INT((2.+PARJ(2))*RLU(0)),0,KFLN,KFDMP) - CALL LUKFDI(KFLN,0,KFLM,K(N+2,2)) - CALL LUKFDI(-KFLN,-KFLM,KFLDMP,K(N+3,2)) - IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 210 - ENDIF - P(N+2,5)=ULMASS(K(N+2,2)) - P(N+3,5)=ULMASS(K(N+3,2)) - IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM.AND.NSIN.EQ.1) GOTO 320 - IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) GOTO 260 - -C...Perform two-particle decay of jet system, if possible. - IF(PECM.GE.0.02*DPC(4)) THEN - PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2- - & (P(N+2,5)-P(N+3,5))**2))/(2.*PECM) - UE(3)=2.*RLU(0)-1. - PHI=PARU(2)*RLU(0) - UE(1)=SQRT(1.-UE(3)**2)*COS(PHI) - UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI) - DO 220 J=1,3 - P(N+2,J)=PA*UE(J) - P(N+3,J)=-PA*UE(J) - 220 CONTINUE - P(N+2,4)=SQRT(PA**2+P(N+2,5)**2) - P(N+3,4)=SQRT(PA**2+P(N+3,5)**2) - MSTU(33)=1 - CALL LUDBRB(N+2,N+3,0.,0.,DPC(1)/DPC(4),DPC(2)/DPC(4), - & DPC(3)/DPC(4)) - ELSE - NP=0 - DO 230 I=IC1,IC2 - IF(K(I,1).EQ.1.OR.K(I,1).EQ.2) NP=NP+1 - 230 CONTINUE - HA=P(IC1,4)*P(IC2,4)-P(IC1,1)*P(IC2,1)-P(IC1,2)*P(IC2,2)- - & P(IC1,3)*P(IC2,3) - IF(NP.GE.3.OR.HA.LE.1.25*P(IC1,5)*P(IC2,5)) GOTO 260 - HD1=0.5*(P(N+2,5)**2-P(IC1,5)**2) - HD2=0.5*(P(N+3,5)**2-P(IC2,5)**2) - HR=SQRT(MAX(0.,((HA-HD1-HD2)**2-(P(N+2,5)*P(N+3,5))**2)/ - & (HA**2-(P(IC1,5)*P(IC2,5))**2)))-1. - HC=P(IC1,5)**2+2.*HA+P(IC2,5)**2 - HK1=((P(IC2,5)**2+HA)*HR+HD1-HD2)/HC - HK2=((P(IC1,5)**2+HA)*HR+HD2-HD1)/HC - DO 240 J=1,4 - P(N+2,J)=(1.+HK1)*P(IC1,J)-HK2*P(IC2,J) - P(N+3,J)=(1.+HK2)*P(IC2,J)-HK1*P(IC1,J) - 240 CONTINUE - ENDIF - DO 250 J=1,4 - V(N+1,J)=V(IC1,J) - V(N+2,J)=V(IC1,J) - V(N+3,J)=V(IC2,J) - 250 CONTINUE - V(N+1,5)=0. - V(N+2,5)=0. - V(N+3,5)=0. - N=N+3 - GOTO 300 - -C...Else form one particle from the flavours available, if possible. - 260 K(N+1,5)=N+2 - IF(IABS(K(IC1,2)).GT.100.AND.IABS(K(IC2,2)).GT.100) THEN - GOTO 320 - ELSEIF(IABS(K(IC1,2)).NE.21) THEN - CALL LUKFDI(K(IC1,2),K(IC2,2),KFLDMP,K(N+2,2)) - ELSE - KFLN=1+INT((2.+PARJ(2))*RLU(0)) - CALL LUKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2)) - ENDIF - IF(K(N+2,2).EQ.0) GOTO 260 - P(N+2,5)=ULMASS(K(N+2,2)) - -C...Find parton/particle which combines to largest extra mass. - IR=0 - HA=0. - HSM=0. - DO 280 MCOMB=1,3 - IF(IR.NE.0) GOTO 280 - DO 270 I=MAX(1,IP),N - IF(K(I,1).LE.0.OR.K(I,1).GT.10.OR.(I.GE.IC1.AND.I.LE.IC2 - &.AND.K(I,1).GE.1.AND.K(I,1).LE.2)) GOTO 270 - IF(MCOMB.EQ.1) KCI=LUCOMP(K(I,2)) - IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 270 - IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 270 - IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100) - &GOTO 270 - HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3) - HSR=2.*HCR+PECM**2-P(N+2,5)**2-2.*P(N+2,5)*P(I,5) - IF(HSR.GT.HSM) THEN - IR=I - HA=HCR - HSM=HSR - ENDIF - 270 CONTINUE - 280 CONTINUE - -C...Shuffle energy and momentum to put new particle on mass shell. - IF(IR.NE.0) THEN - HB=PECM**2+HA - HC=P(N+2,5)**2+HA - HD=P(IR,5)**2+HA - HK2=0.5*(HB*SQRT(MAX(0.,((HB+HC)**2-4.*(HB+HD)*P(N+2,5)**2)/ - & (HA**2-(PECM*P(IR,5))**2)))-(HB+HC))/(HB+HD) - HK1=(0.5*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB - DO 290 J=1,4 - P(N+2,J)=(1.+HK1)*DPC(J)-HK2*P(IR,J) - P(IR,J)=(1.+HK2)*P(IR,J)-HK1*DPC(J) - V(N+1,J)=V(IC1,J) - V(N+2,J)=V(IC1,J) - 290 CONTINUE - V(N+1,5)=0. - V(N+2,5)=0. - N=N+2 - ELSE - CALL LUERRM(3,'(LUPREP:) no match for collapsing cluster') - RETURN - ENDIF - -C...Mark collapsed system and store daughter pointers. Iterate. - 300 DO 310 I=IC1,IC2 - IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.KCHG(LUCOMP(K(I,2)),2).NE.0) - &THEN - K(I,1)=K(I,1)+10 - IF(MSTU(16).NE.2) THEN - K(I,4)=NSAV+1 - K(I,5)=NSAV+1 - ELSE - K(I,4)=NSAV+2 - K(I,5)=N - ENDIF - ENDIF - 310 CONTINUE - IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 140 - -C...Check flavours and invariant masses in parton systems. - 320 NP=0 - KFN=0 - KQS=0 - NJU=0 - DO 330 J=1,5 - DPS(J)=0. - 330 CONTINUE - DO 360 I=MAX(1,IP),N - IF(K(I,1).EQ.41) NJU=NJU+1 - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360 - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 360 - KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.EQ.0) GOTO 360 - NP=NP+1 - IF(KQ.NE.2) THEN - KFN=KFN+1 - KQS=KQS+KQ - MSTJ(93)=1 - DPS(5)=DPS(5)+ULMASS(K(I,2)) - ENDIF - DO 340 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 340 CONTINUE - IF(K(I,1).EQ.1) THEN - NFERR=0 - IF(NJU.EQ.0.AND.NP.NE.1) THEN - IF(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0) NFERR=1 - ELSEIF(NJU.EQ.1) THEN - IF(KFN.NE.3.OR.IABS(KQS).NE.3) NFERR=1 - ELSEIF(NJU.EQ.2) THEN - IF(KFN.NE.4.OR.KQS.NE.0) NFERR=1 - ELSEIF(NJU.GE.3) THEN - NFERR=1 - ENDIF - IF(NFERR.EQ.1) CALL - & LUERRM(2,'(LUPREP:) unphysical flavour combination') - IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT. - & (0.9*PARJ(32)+DPS(5))**2) CALL LUERRM(3, - & '(LUPREP:) too small mass in jet system') - NP=0 - KFN=0 - KQS=0 - NJU=0 - DO 350 J=1,5 - DPS(J)=0. - 350 CONTINUE - ENDIF - 360 CONTINUE - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUSTRF(IP) -C...Purpose: to handle the fragmentation of an arbitrary colour singlet -C...jet system according to the Lund string fragmentation model. - IMPLICIT DOUBLE PRECISION(D) - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - DIMENSION DPS(5),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2), - &IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(3),PJU(5,5), - &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8) - -C...Function: four-product of two vectors. - FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3) - DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)- - &DP(I,3)*DP(J,3) - -C...Reset counters. Identify parton system. - MSTJ(91)=0 - NSAV=N - MSTU90=MSTU(90) - NP=0 - KQSUM=0 - DO 100 J=1,5 - DPS(J)=0D0 - 100 CONTINUE - MJU(1)=0 - MJU(2)=0 - I=IP-1 - 110 I=I+1 - IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN - CALL LUERRM(12,'(LUSTRF:) failed to reconstruct jet system') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110 - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.EQ.0) GOTO 110 - IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN - CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - -C...Take copy of partons to be considered. Check flavour sum. - NP=NP+1 - DO 120 J=1,5 - K(N+NP,J)=K(I,J) - P(N+NP,J)=P(I,J) - IF(J.NE.4) DPS(J)=DPS(J)+P(I,J) - 120 CONTINUE - DPS(4)=DPS(4)+SQRT(DBLE(P(I,1))**2+DBLE(P(I,2))**2+ - &DBLE(P(I,3))**2+DBLE(P(I,5))**2) - K(N+NP,3)=I - IF(KQ.NE.2) KQSUM=KQSUM+KQ - IF(K(I,1).EQ.41) THEN - KQSUM=KQSUM+2*KQ - IF(KQSUM.EQ.KQ) MJU(1)=N+NP - IF(KQSUM.NE.KQ) MJU(2)=N+NP - ENDIF - IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110 - IF(KQSUM.NE.0) THEN - CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination') - IF(MSTU(21).GE.1) RETURN - ENDIF - -C...Boost copied system to CM frame (for better numerical precision). - IF(ABS(DPS(3)).LT.0.99D0*DPS(4)) THEN - MBST=0 - MSTU(33)=1 - CALL LUDBRB(N+1,N+NP,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4), - & -DPS(3)/DPS(4)) - ELSE - MBST=1 - HHBZ=SQRT(MAX(1D-6,DPS(4)+DPS(3))/MAX(1D-6,DPS(4)-DPS(3))) - DO 130 I=N+1,N+NP - HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 - IF(P(I,3).GT.0.) THEN - HHPEZ=(P(I,4)+P(I,3))/HHBZ - P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) - ELSE - HHPEZ=(P(I,4)-P(I,3))*HHBZ - P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) - ENDIF - 130 CONTINUE - ENDIF - -C...Search for very nearby partons that may be recombined. - NTRYR=0 - PARU12=PARU(12) - PARU13=PARU(13) - MJU(3)=MJU(1) - MJU(4)=MJU(2) - NR=NP - 140 IF(NR.GE.3) THEN - PDRMIN=2.*PARU12 - DO 150 I=N+1,N+NR - IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 150 - I1=I+1 - IF(I.EQ.N+NR) I1=N+1 - IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 150 - IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21) - & GOTO 150 - IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21) GOTO 150 - PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+ - & P(I1,2)**2+P(I1,3)**2)) - PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3) - PDR=4.*(PAP-PVP)**2/MAX(1E-6,PARU13**2*PAP+2.*(PAP-PVP)) - IF(PDR.LT.PDRMIN) THEN - IR=I - PDRMIN=PDR - ENDIF - 150 CONTINUE - -C...Recombine very nearby partons to avoid machine precision problems. - IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN - DO 160 J=1,4 - P(N+1,J)=P(N+1,J)+P(N+NR,J) - 160 CONTINUE - P(N+1,5)=SQRT(MAX(0.,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - NR=NR-1 - GOTO 140 - ELSEIF(PDRMIN.LT.PARU12) THEN - DO 170 J=1,4 - P(IR,J)=P(IR,J)+P(IR+1,J) - 170 CONTINUE - P(IR,5)=SQRT(MAX(0.,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2- - & P(IR,3)**2)) - DO 190 I=IR+1,N+NR-1 - K(I,2)=K(I+1,2) - DO 180 J=1,5 - P(I,J)=P(I+1,J) - 180 CONTINUE - 190 CONTINUE - IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2) - NR=NR-1 - IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1 - IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1 - GOTO 140 - ENDIF - ENDIF - NTRYR=NTRYR+1 - -C...Reset particle counter. Skip ahead if no junctions are present; -C...this is usually the case! - NRS=MAX(5*NR+11,NP) - NTRY=0 - 200 NTRY=NTRY+1 - IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN - PARU12=4.*PARU12 - PARU13=2.*PARU13 - GOTO 140 - ELSEIF(NTRY.GT.100) THEN - CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - I=N+NRS - MSTU(90)=MSTU90 - IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 580 - DO 570 JT=1,2 - NJS(JT)=0 - IF(MJU(JT).EQ.0) GOTO 570 - JS=3-2*JT - -C...Find and sum up momentum on three sides of junction. Check flavours. - DO 220 IU=1,3 - IJU(IU)=0 - DO 210 J=1,5 - PJU(IU,J)=0. - 210 CONTINUE - 220 CONTINUE - IU=0 - DO 240 I1=N+1+(JT-1)*(NR-1),N+NR+(JT-1)*(1-NR),JS - IF(K(I1,2).NE.21.AND.IU.LE.2) THEN - IU=IU+1 - IJU(IU)=I1 - ENDIF - DO 230 J=1,4 - PJU(IU,J)=PJU(IU,J)+P(I1,J) - 230 CONTINUE - 240 CONTINUE - DO 250 IU=1,3 - PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) - 250 CONTINUE - IF(K(IJU(3),2)/100.NE.10*K(IJU(1),2)+K(IJU(2),2).AND. - &K(IJU(3),2)/100.NE.10*K(IJU(2),2)+K(IJU(1),2)) THEN - CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination') - IF(MSTU(21).GE.1) RETURN - ENDIF - -C...Calculate (approximate) boost to rest frame of junction. - T12=(PJU(1,1)*PJU(2,1)+PJU(1,2)*PJU(2,2)+PJU(1,3)*PJU(2,3))/ - &(PJU(1,5)*PJU(2,5)) - T13=(PJU(1,1)*PJU(3,1)+PJU(1,2)*PJU(3,2)+PJU(1,3)*PJU(3,3))/ - &(PJU(1,5)*PJU(3,5)) - T23=(PJU(2,1)*PJU(3,1)+PJU(2,2)*PJU(3,2)+PJU(2,3)*PJU(3,3))/ - &(PJU(2,5)*PJU(3,5)) - T11=SQRT((2./3.)*(1.-T12)*(1.-T13)/(1.-T23)) - T22=SQRT((2./3.)*(1.-T12)*(1.-T23)/(1.-T13)) - TSQ=SQRT((2.*T11*T22+T12-1.)*(1.+T12)) - T1F=(TSQ-T22*(1.+T12))/(1.-T12**2) - T2F=(TSQ-T11*(1.+T12))/(1.-T12**2) - DO 260 J=1,3 - TJU(J)=-(T1F*PJU(1,J)/PJU(1,5)+T2F*PJU(2,J)/PJU(2,5)) - 260 CONTINUE - TJU(4)=SQRT(1.+TJU(1)**2+TJU(2)**2+TJU(3)**2) - DO 270 IU=1,3 - PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)- - &TJU(3)*PJU(IU,3) - 270 CONTINUE - -C...Put junction at rest if motion could give inconsistencies. - IF(PJU(1,5)+PJU(2,5).GT.PJU(1,4)+PJU(2,4)) THEN - DO 280 J=1,3 - TJU(J)=0. - 280 CONTINUE - TJU(4)=1. - PJU(1,5)=PJU(1,4) - PJU(2,5)=PJU(2,4) - PJU(3,5)=PJU(3,4) - ENDIF - -C...Start preparing for fragmentation of two strings from junction. - ISTA=I - DO 550 IU=1,2 - NS=JS*(IJU(IU+1)-IJU(IU)) - -C...Junction strings: find longitudinal string directions. - DO 310 IS=1,NS - IS1=IJU(IU)+IS-1 - IS2=IJU(IU)+IS - DO 290 J=1,5 - DP(1,J)=0.5*P(IS1,J) - IF(IS.EQ.1) DP(1,J)=P(IS1,J) - DP(2,J)=0.5*P(IS2,J) - IF(IS.EQ.NS) DP(2,J)=-PJU(IU,J) - 290 CONTINUE - IF(IS.EQ.NS) DP(2,4)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) - IF(IS.EQ.NS) DP(2,5)=0. - DP(3,5)=DFOUR(1,1) - DP(4,5)=DFOUR(2,2) - DHKC=DFOUR(1,2) - IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN - DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) - DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) - DP(3,5)=0D0 - DP(4,5)=0D0 - DHKC=DFOUR(1,2) - ENDIF - DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) - DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.) - DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.) - IN1=N+NR+4*IS-3 - P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5)) - DO 300 J=1,4 - P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J) - P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J) - 300 CONTINUE - 310 CONTINUE - -C...Junction strings: initialize flavour, momentum and starting pos. - ISAV=I - MSTU91=MSTU(90) - 320 NTRY=NTRY+1 - IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN - PARU12=4.*PARU12 - PARU13=2.*PARU13 - GOTO 140 - ELSEIF(NTRY.GT.100) THEN - CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - I=ISAV - MSTU(90)=MSTU91 - IRANKJ=0 - IE(1)=K(N+1+(JT/2)*(NP-1),3) - IN(4)=N+NR+1 - IN(5)=IN(4)+1 - IN(6)=N+NR+4*NS+1 - DO 340 JQ=1,2 - DO 330 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4 - P(IN1,1)=2-JQ - P(IN1,2)=JQ-1 - P(IN1,3)=1. - 330 CONTINUE - 340 CONTINUE - KFL(1)=K(IJU(IU),2) - PX(1)=0. - PY(1)=0. - GAM(1)=0. - DO 350 J=1,5 - PJU(IU+3,J)=0. - 350 CONTINUE - -C...Junction strings: find initial transverse directions. - DO 360 J=1,4 - DP(1,J)=P(IN(4),J) - DP(2,J)=P(IN(4)+1,J) - DP(3,J)=0. - DP(4,J)=0. - 360 CONTINUE - DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) - DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) - DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) - DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) - DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) - IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. - DHC12=DFOUR(1,2) - DHCX1=DFOUR(3,1)/DHC12 - DHCX2=DFOUR(3,2)/DHC12 - DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) - DHCY1=DFOUR(4,1)/DHC12 - DHCY2=DFOUR(4,2)/DHC12 - DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 - DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) - DO 370 J=1,4 - DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) - P(IN(6),J)=DP(3,J) - P(IN(6)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- - &DHCYX*DP(3,J)) - 370 CONTINUE - -C...Junction strings: produce new particle, origin. - 380 I=I+1 - IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN - CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - IRANKJ=IRANKJ+1 - K(I,1)=1 - K(I,3)=IE(1) - K(I,4)=0 - K(I,5)=0 - -C...Junction strings: generate flavour, hadron, pT, z and Gamma. - 390 CALL LUKFDI(KFL(1),0,KFL(3),K(I,2)) - IF(K(I,2).EQ.0) GOTO 320 - IF(MSTJ(12).GE.3.AND.IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND. - &IABS(KFL(3)).GT.10) THEN - IF(RLU(0).GT.PARJ(19)) GOTO 390 - ENDIF - P(I,5)=ULMASS(K(I,2)) - CALL LUPTDI(KFL(1),PX(3),PY(3)) - PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2 - CALL LUZDIS(KFL(1),KFL(3),PR(1),Z) - IF(IABS(KFL(1)).GE.4.AND.IABS(KFL(1)).LE.8.AND. - &MSTU(90).LT.8) THEN - MSTU(90)=MSTU(90)+1 - MSTU(90+MSTU(90))=I - PARU(90+MSTU(90))=Z - ENDIF - GAM(3)=(1.-Z)*(GAM(1)+PR(1)/Z) - DO 400 J=1,3 - IN(J)=IN(3+J) - 400 CONTINUE - -C...Junction strings: stepping within or from 'low' string region easy. - IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* - &P(IN(1),5)**2.GE.PR(1)) THEN - P(IN(1)+2,4)=Z*P(IN(1)+2,3) - P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2) - DO 410 J=1,4 - P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J) - 410 CONTINUE - GOTO 500 - ELSEIF(IN(1)+1.EQ.IN(2)) THEN - P(IN(2)+2,4)=P(IN(2)+2,3) - P(IN(2)+2,1)=1. - IN(2)=IN(2)+4 - IF(IN(2).GT.N+NR+4*NS) GOTO 320 - IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0. - IN(1)=IN(1)+4 - ENDIF - ENDIF - -C...Junction strings: find new transverse directions. - 420 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR. - &IN(1).GT.IN(2)) GOTO 320 - IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN - DO 430 J=1,4 - DP(1,J)=P(IN(1),J) - DP(2,J)=P(IN(2),J) - DP(3,J)=0. - DP(4,J)=0. - 430 CONTINUE - DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) - DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) - DHC12=DFOUR(1,2) - IF(DHC12.LE.1E-2) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0. - IN(1)=IN(1)+4 - GOTO 420 - ENDIF - IN(3)=N+NR+4*NS+5 - DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) - DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) - DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) - IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. - DHCX1=DFOUR(3,1)/DHC12 - DHCX2=DFOUR(3,2)/DHC12 - DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) - DHCY1=DFOUR(4,1)/DHC12 - DHCY2=DFOUR(4,2)/DHC12 - DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 - DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) - DO 440 J=1,4 - DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) - P(IN(3),J)=DP(3,J) - P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- - & DHCYX*DP(3,J)) - 440 CONTINUE -C...Express pT with respect to new axes, if sensible. - PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3))) - PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1)) - IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN - PX(3)=PXP - PY(3)=PYP - ENDIF - ENDIF - -C...Junction strings: sum up known four-momentum, coefficients for m2. - DO 470 J=1,4 - DHG(J)=0. - P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+ - &PY(3)*P(IN(3)+1,J) - DO 450 IN1=IN(4),IN(1)-4,4 - P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) - 450 CONTINUE - DO 460 IN2=IN(5),IN(2)-4,4 - P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) - 460 CONTINUE - 470 CONTINUE - DHM(1)=FOUR(I,I) - DHM(2)=2.*FOUR(I,IN(1)) - DHM(3)=2.*FOUR(I,IN(2)) - DHM(4)=2.*FOUR(IN(1),IN(2)) - -C...Junction strings: find coefficients for Gamma expression. - DO 490 IN2=IN(1)+1,IN(2),4 - DO 480 IN1=IN(1),IN2-1,4 - DHC=2.*FOUR(IN1,IN2) - DHG(1)=DHG(1)+P(IN1+2,1)*P(IN2+2,1)*DHC - IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-P(IN2+2,1)*DHC - IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+P(IN1+2,1)*DHC - IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC - 480 CONTINUE - 490 CONTINUE - -C...Junction strings: solve (m2, Gamma) equation system for energies. - DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3) - IF(ABS(DHS1).LT.1E-4) GOTO 320 - DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(2)*DHG(3)-DHG(4)* - &(P(I,5)**2-DHM(1))+DHG(2)*DHM(3) - DHS3=DHM(2)*(GAM(3)-DHG(1))-DHG(2)*(P(I,5)**2-DHM(1)) - P(IN(2)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)- - &DHS2/DHS1) - IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0.) GOTO 320 - P(IN(1)+2,4)=(P(I,5)**2-DHM(1)-DHM(3)*P(IN(2)+2,4))/ - &(DHM(2)+DHM(4)*P(IN(2)+2,4)) - -C...Junction strings: step to new region if necessary. - IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN - P(IN(2)+2,4)=P(IN(2)+2,3) - P(IN(2)+2,1)=1. - IN(2)=IN(2)+4 - IF(IN(2).GT.N+NR+4*NS) GOTO 320 - IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0. - IN(1)=IN(1)+4 - ENDIF - GOTO 420 - ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0. - IN(1)=IN(1)+JS - GOTO 820 - ENDIF - -C...Junction strings: particle four-momentum, remainder, loop back. - 500 DO 510 J=1,4 - P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) - PJU(IU+3,J)=PJU(IU+3,J)+P(I,J) - 510 CONTINUE - IF(P(I,4).LT.P(I,5)) GOTO 320 - PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)- - &TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3) - IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN - KFL(1)=-KFL(3) - PX(1)=-PX(3) - PY(1)=-PY(3) - GAM(1)=GAM(3) - IF(IN(3).NE.IN(6)) THEN - DO 520 J=1,4 - P(IN(6),J)=P(IN(3),J) - P(IN(6)+1,J)=P(IN(3)+1,J) - 520 CONTINUE - ENDIF - DO 530 JQ=1,2 - IN(3+JQ)=IN(JQ) - P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) - P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4) - 530 CONTINUE - GOTO 380 - ENDIF - -C...Junction strings: save quantities left after each string. - IF(IABS(KFL(1)).GT.10) GOTO 320 - I=I-1 - KFJH(IU)=KFL(1) - DO 540 J=1,4 - PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J) - 540 CONTINUE - 550 CONTINUE - -C...Junction strings: put together to new effective string endpoint. - NJS(JT)=I-ISTA - KFJS(JT)=K(K(MJU(JT+2),3),2) - KFLS=2*INT(RLU(0)+3.*PARJ(4)/(1.+3.*PARJ(4)))+1 - IF(KFJH(1).EQ.KFJH(2)) KFLS=3 - IF(ISTA.NE.I) KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)), - &IABS(KFJH(2)))+100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+ - &KFLS,KFJH(1)) - DO 560 J=1,4 - PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J) - PJS(JT+2,J)=PJU(4,J)+PJU(5,J) - 560 CONTINUE - PJS(JT,5)=SQRT(MAX(0.,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2- - &PJS(JT,3)**2)) - 570 CONTINUE - -C...Open versus closed strings. Choose breakup region for latter. - 580 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN - NS=MJU(2)-MJU(1) - NB=MJU(1)-N - ELSEIF(MJU(1).NE.0) THEN - NS=N+NR-MJU(1) - NB=MJU(1)-N - ELSEIF(MJU(2).NE.0) THEN - NS=MJU(2)-N - NB=1 - ELSEIF(IABS(K(N+1,2)).NE.21) THEN - NS=NR-1 - NB=1 - ELSE - NS=NR+1 - W2SUM=0. - DO 590 IS=1,NR - P(N+NR+IS,1)=0.5*FOUR(N+IS,N+IS+1-NR*(IS/NR)) - W2SUM=W2SUM+P(N+NR+IS,1) - 590 CONTINUE - W2RAN=RLU(0)*W2SUM - NB=0 - 600 NB=NB+1 - W2SUM=W2SUM-P(N+NR+NB,1) - IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 600 - ENDIF - -C...Find longitudinal string directions (i.e. lightlike four-vectors). - DO 630 IS=1,NS - IS1=N+IS+NB-1-NR*((IS+NB-2)/NR) - IS2=N+IS+NB-NR*((IS+NB-1)/NR) - DO 610 J=1,5 - DP(1,J)=P(IS1,J) - IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5*DP(1,J) - IF(IS1.EQ.MJU(1)) DP(1,J)=PJS(1,J)-PJS(3,J) - DP(2,J)=P(IS2,J) - IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5*DP(2,J) - IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J) - 610 CONTINUE - DP(3,5)=DFOUR(1,1) - DP(4,5)=DFOUR(2,2) - DHKC=DFOUR(1,2) - IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN - DP(3,5)=DP(1,5)**2 - DP(4,5)=DP(2,5)**2 - DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2+DP(1,5)**2) - DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2+DP(2,5)**2) - DHKC=DFOUR(1,2) - ENDIF - DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) - DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.) - DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.) - IN1=N+NR+4*IS-3 - P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5)) - DO 620 J=1,4 - P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J) - P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J) - 620 CONTINUE - 630 CONTINUE - -C...Begin initialization: sum up energy, set starting position. - ISAV=I - MSTU91=MSTU(90) - 640 NTRY=NTRY+1 - IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN - PARU12=4.*PARU12 - PARU13=2.*PARU13 - GOTO 140 - ELSEIF(NTRY.GT.100) THEN - CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - I=ISAV - MSTU(90)=MSTU91 - DO 660 J=1,4 - P(N+NRS,J)=0. - DO 650 IS=1,NR - P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J) - 650 CONTINUE - 660 CONTINUE - DO 680 JT=1,2 - IRANK(JT)=0 - IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT) - IF(NS.GT.NR) IRANK(JT)=1 - IE(JT)=K(N+1+(JT/2)*(NP-1),3) - IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1) - IN(3*JT+2)=IN(3*JT+1)+1 - IN(3*JT+3)=N+NR+4*NS+2*JT-1 - DO 670 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4 - P(IN1,1)=2-JT - P(IN1,2)=JT-1 - P(IN1,3)=1. - 670 CONTINUE - 680 CONTINUE - -C...Initialize flavour and pT variables for open string. - IF(NS.LT.NR) THEN - PX(1)=0. - PY(1)=0. - IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL LUPTDI(0,PX(1),PY(1)) - PX(2)=-PX(1) - PY(2)=-PY(1) - DO 690 JT=1,2 - KFL(JT)=K(IE(JT),2) - IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT) - MSTJ(93)=1 - PMQ(JT)=ULMASS(KFL(JT)) - GAM(JT)=0. - 690 CONTINUE - -C...Closed string: random initial breakup flavour, pT and vertex. - ELSE - KFL(3)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) - CALL LUKFDI(KFL(3),0,KFL(1),KDUMP) - KFL(2)=-KFL(1) - IF(IABS(KFL(1)).GT.10.AND.RLU(0).GT.0.5) THEN - KFL(2)=-(KFL(1)+ISIGN(10000,KFL(1))) - ELSEIF(IABS(KFL(1)).GT.10) THEN - KFL(1)=-(KFL(2)+ISIGN(10000,KFL(2))) - ENDIF - CALL LUPTDI(KFL(1),PX(1),PY(1)) - PX(2)=-PX(1) - PY(2)=-PY(1) - PR3=MIN(25.,0.1*P(N+NR+1,5)**2) - 700 CALL LUZDIS(KFL(1),KFL(2),PR3,Z) - ZR=PR3/(Z*P(N+NR+1,5)**2) - IF(ZR.GE.1.) GOTO 700 - DO 710 JT=1,2 - MSTJ(93)=1 - PMQ(JT)=ULMASS(KFL(JT)) - GAM(JT)=PR3*(1.-Z)/Z - IN1=N+NR+3+4*(JT/2)*(NS-1) - P(IN1,JT)=1.-Z - P(IN1,3-JT)=JT-1 - P(IN1,3)=(2-JT)*(1.-Z)+(JT-1)*Z - P(IN1+1,JT)=ZR - P(IN1+1,3-JT)=2-JT - P(IN1+1,3)=(2-JT)*(1.-ZR)+(JT-1)*ZR - 710 CONTINUE - ENDIF - -C...Find initial transverse directions (i.e. spacelike four-vectors). - DO 750 JT=1,2 - IF(JT.EQ.1.OR.NS.EQ.NR-1) THEN - IN1=IN(3*JT+1) - IN3=IN(3*JT+3) - DO 720 J=1,4 - DP(1,J)=P(IN1,J) - DP(2,J)=P(IN1+1,J) - DP(3,J)=0. - DP(4,J)=0. - 720 CONTINUE - DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) - DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) - DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) - DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) - DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) - IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. - DHC12=DFOUR(1,2) - DHCX1=DFOUR(3,1)/DHC12 - DHCX2=DFOUR(3,2)/DHC12 - DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) - DHCY1=DFOUR(4,1)/DHC12 - DHCY2=DFOUR(4,2)/DHC12 - DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 - DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) - DO 730 J=1,4 - DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) - P(IN3,J)=DP(3,J) - P(IN3+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- - & DHCYX*DP(3,J)) - 730 CONTINUE - ELSE - DO 740 J=1,4 - P(IN3+2,J)=P(IN3,J) - P(IN3+3,J)=P(IN3+1,J) - 740 CONTINUE - ENDIF - 750 CONTINUE - -C...Remove energy used up in junction string fragmentation. - IF(MJU(1)+MJU(2).GT.0) THEN - DO 770 JT=1,2 - IF(NJS(JT).EQ.0) GOTO 770 - DO 760 J=1,4 - P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J) - 760 CONTINUE - 770 CONTINUE - ENDIF - -C...Produce new particle: side, origin. - 780 I=I+1 - IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN - CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - JT=1.5+RLU(0) - IF(IABS(KFL(3-JT)).GT.10) JT=3-JT - IF(IABS(KFL(3-JT)).GE.4.AND.IABS(KFL(3-JT)).LE.8) JT=3-JT - JR=3-JT - JS=3-2*JT - IRANK(JT)=IRANK(JT)+1 - K(I,1)=1 - K(I,3)=IE(JT) - K(I,4)=0 - K(I,5)=0 - -C...Generate flavour, hadron and pT. - 790 CALL LUKFDI(KFL(JT),0,KFL(3),K(I,2)) - IF(K(I,2).EQ.0) GOTO 640 - IF(MSTJ(12).GE.3.AND.IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND. - &IABS(KFL(3)).GT.10) THEN - IF(RLU(0).GT.PARJ(19)) GOTO 790 - ENDIF - P(I,5)=ULMASS(K(I,2)) - CALL LUPTDI(KFL(JT),PX(3),PY(3)) - PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2 - -C...Final hadrons for small invariant mass. - MSTJ(93)=1 - PMQ(3)=ULMASS(KFL(3)) - PARJST=PARJ(33) - IF(MSTJ(11).EQ.2) PARJST=PARJ(34) - WMIN=PARJST+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3) - IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN= - &WMIN-0.5*PARJ(36)*PMQ(3) - WREM2=FOUR(N+NRS,N+NRS) - IF(WREM2.LT.0.10) GOTO 640 - IF(WREM2.LT.MAX(WMIN*(1.+(2.*RLU(0)-1.)*PARJ(37)), - &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 940 - -C...Choose z, which gives Gamma. Shift z for heavy flavours. - CALL LUZDIS(KFL(JT),KFL(3),PR(JT),Z) - IF(IABS(KFL(JT)).GE.4.AND.IABS(KFL(JT)).LE.8.AND. - &MSTU(90).LT.8) THEN - MSTU(90)=MSTU(90)+1 - MSTU(90+MSTU(90))=I - PARU(90+MSTU(90))=Z - ENDIF - KFL1A=IABS(KFL(1)) - KFL2A=IABS(KFL(2)) - IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), - &MOD(KFL2A/1000,10)).GE.4) THEN - PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 - PW12=SQRT(MAX(0.,(WREM2-PR(1)-PR(2))**2-4.*PR(1)*PR(2))) - Z=(WREM2+PR(JT)-PR(JR)+PW12*(2.*Z-1.))/(2.*WREM2) - PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 - IF((1.-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 940 - ENDIF - GAM(3)=(1.-Z)*(GAM(JT)+PR(JT)/Z) - DO 800 J=1,3 - IN(J)=IN(3*JT+J) - 800 CONTINUE - -C...Stepping within or from 'low' string region easy. - IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* - &P(IN(1),5)**2.GE.PR(JT)) THEN - P(IN(JT)+2,4)=Z*P(IN(JT)+2,3) - P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2) - DO 810 J=1,4 - P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J) - 810 CONTINUE - GOTO 900 - ELSEIF(IN(1)+1.EQ.IN(2)) THEN - P(IN(JR)+2,4)=P(IN(JR)+2,3) - P(IN(JR)+2,JT)=1. - IN(JR)=IN(JR)+4*JS - IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640 - IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0. - IN(JT)=IN(JT)+4*JS - ENDIF - ENDIF - -C...Find new transverse directions (i.e. spacelike string vectors). - 820 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR. - &IN(1).GT.IN(2)) GOTO 640 - IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN - DO 830 J=1,4 - DP(1,J)=P(IN(1),J) - DP(2,J)=P(IN(2),J) - DP(3,J)=0. - DP(4,J)=0. - 830 CONTINUE - DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) - DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) - DHC12=DFOUR(1,2) - IF(DHC12.LE.1E-2) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0. - IN(JT)=IN(JT)+4*JS - GOTO 820 - ENDIF - IN(3)=N+NR+4*NS+5 - DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) - DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) - DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) - IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. - DHCX1=DFOUR(3,1)/DHC12 - DHCX2=DFOUR(3,2)/DHC12 - DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) - DHCY1=DFOUR(4,1)/DHC12 - DHCY2=DFOUR(4,2)/DHC12 - DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 - DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) - DO 840 J=1,4 - DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) - P(IN(3),J)=DP(3,J) - P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- - & DHCYX*DP(3,J)) - 840 CONTINUE -C...Express pT with respect to new axes, if sensible. - PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)* - & FOUR(IN(3*JT+3)+1,IN(3))) - PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)* - & FOUR(IN(3*JT+3)+1,IN(3)+1)) - IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN - PX(3)=PXP - PY(3)=PYP - ENDIF - ENDIF - -C...Sum up known four-momentum. Gives coefficients for m2 expression. - DO 870 J=1,4 - DHG(J)=0. - P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+ - &PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J) - DO 850 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS - P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) - 850 CONTINUE - DO 860 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS - P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) - 860 CONTINUE - 870 CONTINUE - DHM(1)=FOUR(I,I) - DHM(2)=2.*FOUR(I,IN(1)) - DHM(3)=2.*FOUR(I,IN(2)) - DHM(4)=2.*FOUR(IN(1),IN(2)) - -C...Find coefficients for Gamma expression. - DO 890 IN2=IN(1)+1,IN(2),4 - DO 880 IN1=IN(1),IN2-1,4 - DHC=2.*FOUR(IN1,IN2) - DHG(1)=DHG(1)+P(IN1+2,JT)*P(IN2+2,JT)*DHC - IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-JS*P(IN2+2,JT)*DHC - IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+JS*P(IN1+2,JT)*DHC - IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC - 880 CONTINUE - 890 CONTINUE - -C...Solve (m2, Gamma) equation system for energies taken. - DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1) - IF(ABS(DHS1).LT.1E-4) GOTO 640 - DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)* - &(P(I,5)**2-DHM(1))+DHG(JT+1)*DHM(JR+1) - DHS3=DHM(JT+1)*(GAM(3)-DHG(1))-DHG(JT+1)*(P(I,5)**2-DHM(1)) - P(IN(JR)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)- - &DHS2/DHS1) - IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0.) GOTO 640 - P(IN(JT)+2,4)=(P(I,5)**2-DHM(1)-DHM(JR+1)*P(IN(JR)+2,4))/ - &(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4)) - -C...Step to new region if necessary. - IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN - P(IN(JR)+2,4)=P(IN(JR)+2,3) - P(IN(JR)+2,JT)=1. - IN(JR)=IN(JR)+4*JS - IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640 - IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0. - IN(JT)=IN(JT)+4*JS - ENDIF - GOTO 820 - ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0. - IN(JT)=IN(JT)+4*JS - GOTO 820 - ENDIF - -C...Four-momentum of particle. Remaining quantities. Loop back. - 900 DO 910 J=1,4 - P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) - P(N+NRS,J)=P(N+NRS,J)-P(I,J) - 910 CONTINUE - IF(P(I,4).LT.P(I,5)) GOTO 640 - KFL(JT)=-KFL(3) - PMQ(JT)=PMQ(3) - PX(JT)=-PX(3) - PY(JT)=-PY(3) - GAM(JT)=GAM(3) - IF(IN(3).NE.IN(3*JT+3)) THEN - DO 920 J=1,4 - P(IN(3*JT+3),J)=P(IN(3),J) - P(IN(3*JT+3)+1,J)=P(IN(3)+1,J) - 920 CONTINUE - ENDIF - DO 930 JQ=1,2 - IN(3*JT+JQ)=IN(JQ) - P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) - P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4) - 930 CONTINUE - GOTO 780 - -C...Final hadron: side, flavour, hadron, mass. - 940 I=I+1 - K(I,1)=1 - K(I,3)=IE(JR) - K(I,4)=0 - K(I,5)=0 - CALL LUKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2)) - IF(K(I,2).EQ.0) GOTO 640 - P(I,5)=ULMASS(K(I,2)) - PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 - -C...Final two hadrons: find common setup of four-vectors. - JQ=1 - IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT.P(IN(7),3)* - &P(IN(8),3)*FOUR(IN(7),IN(8))) JQ=2 - DHC12=FOUR(IN(3*JQ+1),IN(3*JQ+2)) - DHR1=FOUR(N+NRS,IN(3*JQ+2))/DHC12 - DHR2=FOUR(N+NRS,IN(3*JQ+1))/DHC12 - IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN - PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ) - PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ) - PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS* - & PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2 - ENDIF - -C...Solve kinematics for final two hadrons, if possible. - WREM2=WREM2+(PX(1)+PX(2))**2+(PY(1)+PY(2))**2 - FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2) - IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1.) GOTO 200 - IF(FD.GE.1.) GOTO 640 - FA=WREM2+PR(JT)-PR(JR) - IF(MSTJ(11).NE.2) PREV=0.5*EXP(MAX(-50.,LOG(FD)*PARJ(38)* - &(PR(1)+PR(2))**2)) - IF(MSTJ(11).EQ.2) PREV=0.5*FD**PARJ(39) - FB=SIGN(SQRT(MAX(0.,FA**2-4.*WREM2*PR(JT))),JS*(RLU(0)-PREV)) - KFL1A=IABS(KFL(1)) - KFL2A=IABS(KFL(2)) - IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), - &MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0.,FA**2- - &4.*WREM2*PR(JT))),FLOAT(JS)) - DO 950 J=1,4 - P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))* - &P(IN(3*JQ+3)+1,J)+0.5*(DHR1*(FA+FB)*P(IN(3*JQ+1),J)+ - &DHR2*(FA-FB)*P(IN(3*JQ+2),J))/WREM2 - P(I,J)=P(N+NRS,J)-P(I-1,J) - 950 CONTINUE - IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 640 - -C...Mark jets as fragmented and give daughter pointers. - N=I-NRS+1 - DO 960 I=NSAV+1,NSAV+NP - IM=K(I,3) - K(IM,1)=K(IM,1)+10 - IF(MSTU(16).NE.2) THEN - K(IM,4)=NSAV+1 - K(IM,5)=NSAV+1 - ELSE - K(IM,4)=NSAV+2 - K(IM,5)=N - ENDIF - 960 CONTINUE - -C...Document string system. Move up particles. - NSAV=NSAV+1 - K(NSAV,1)=11 - K(NSAV,2)=92 - K(NSAV,3)=IP - K(NSAV,4)=NSAV+1 - K(NSAV,5)=N - DO 970 J=1,4 - P(NSAV,J)=DPS(J) - V(NSAV,J)=V(IP,J) - 970 CONTINUE - P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) - V(NSAV,5)=0. - DO 990 I=NSAV+1,N - DO 980 J=1,5 - K(I,J)=K(I+NRS-1,J) - P(I,J)=P(I+NRS-1,J) - V(I,J)=0. - 980 CONTINUE - 990 CONTINUE - MSTU91=MSTU(90) - DO 1000 IZ=MSTU90+1,MSTU91 - MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N - PARU9T(IZ)=PARU(90+IZ) - 1000 CONTINUE - MSTU(90)=MSTU90 - -C...Order particles in rank along the chain. Update mother pointer. - DO 1020 I=NSAV+1,N - DO 1010 J=1,5 - K(I-NSAV+N,J)=K(I,J) - P(I-NSAV+N,J)=P(I,J) - 1010 CONTINUE - 1020 CONTINUE - I1=NSAV - DO 1050 I=N+1,2*N-NSAV - IF(K(I,3).NE.IE(1)) GOTO 1050 - I1=I1+1 - DO 1030 J=1,5 - K(I1,J)=K(I,J) - P(I1,J)=P(I,J) - 1030 CONTINUE - IF(MSTU(16).NE.2) K(I1,3)=NSAV - DO 1040 IZ=MSTU90+1,MSTU91 - IF(MSTU9T(IZ).EQ.I) THEN - MSTU(90)=MSTU(90)+1 - MSTU(90+MSTU(90))=I1 - PARU(90+MSTU(90))=PARU9T(IZ) - ENDIF - 1040 CONTINUE - 1050 CONTINUE - DO 1080 I=2*N-NSAV,N+1,-1 - IF(K(I,3).EQ.IE(1)) GOTO 1080 - I1=I1+1 - DO 1060 J=1,5 - K(I1,J)=K(I,J) - P(I1,J)=P(I,J) - 1060 CONTINUE - IF(MSTU(16).NE.2) K(I1,3)=NSAV - DO 1070 IZ=MSTU90+1,MSTU91 - IF(MSTU9T(IZ).EQ.I) THEN - MSTU(90)=MSTU(90)+1 - MSTU(90+MSTU(90))=I1 - PARU(90+MSTU(90))=PARU9T(IZ) - ENDIF - 1070 CONTINUE - 1080 CONTINUE - -C...Boost back particle system. Set production vertices. - IF(MBST.EQ.0) THEN - MSTU(33)=1 - CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4), - & DPS(3)/DPS(4)) - ELSE - DO 1090 I=NSAV+1,N - HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 - IF(P(I,3).GT.0.) THEN - HHPEZ=(P(I,4)+P(I,3))*HHBZ - P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) - ELSE - HHPEZ=(P(I,4)-P(I,3))/HHBZ - P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) - ENDIF - 1090 CONTINUE - ENDIF - DO 1110 I=NSAV+1,N - DO 1100 J=1,4 - V(I,J)=V(IP,J) - 1100 CONTINUE - 1110 CONTINUE - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUINDF(IP) - -C...Purpose: to handle the fragmentation of a jet system (or a single -C...jet) according to independent fragmentation models. - IMPLICIT DOUBLE PRECISION(D) - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3), - &KFLO(2),PXO(2),PYO(2),WO(2) - -C...Reset counters. Identify parton system and take copy. Check flavour. - NSAV=N - MSTU90=MSTU(90) - NJET=0 - KQSUM=0 - DO 100 J=1,5 - DPS(J)=0. - 100 CONTINUE - I=IP-1 - 110 I=I+1 - IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN - CALL LUERRM(12,'(LUINDF:) failed to reconstruct jet system') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110 - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.EQ.0) GOTO 110 - NJET=NJET+1 - IF(KQ.NE.2) KQSUM=KQSUM+KQ - DO 120 J=1,5 - K(NSAV+NJET,J)=K(I,J) - P(NSAV+NJET,J)=P(I,J) - DPS(J)=DPS(J)+P(I,J) - 120 CONTINUE - K(NSAV+NJET,3)=I - IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND. - &K(I+1,1).EQ.2)) GOTO 110 - IF(NJET.NE.1.AND.KQSUM.NE.0) THEN - CALL LUERRM(12,'(LUINDF:) unphysical flavour combination') - IF(MSTU(21).GE.1) RETURN - ENDIF - -C...Boost copied system to CM frame. Find CM energy and sum flavours. - IF(NJET.NE.1) THEN - MSTU(33)=1 - CALL LUDBRB(NSAV+1,NSAV+NJET,0.,0.,-DPS(1)/DPS(4), - & -DPS(2)/DPS(4),-DPS(3)/DPS(4)) - ENDIF - PECM=0. - DO 130 J=1,3 - NFI(J)=0 - 130 CONTINUE - DO 140 I=NSAV+1,NSAV+NJET - PECM=PECM+P(I,4) - KFA=IABS(K(I,2)) - IF(KFA.LE.3) THEN - NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2)) - ELSEIF(KFA.GT.1000) THEN - KFLA=MOD(KFA/1000,10) - KFLB=MOD(KFA/100,10) - IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2)) - IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2)) - ENDIF - 140 CONTINUE - -C...Loop over attempts made. Reset counters. - NTRY=0 - 150 NTRY=NTRY+1 - IF(NTRY.GT.200) THEN - CALL LUERRM(14,'(LUINDF:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - N=NSAV+NJET - MSTU(90)=MSTU90 - DO 160 J=1,3 - NFL(J)=NFI(J) - IFET(J)=0 - KFLF(J)=0 - 160 CONTINUE - -C...Loop over jets to be fragmented. - DO 230 IP1=NSAV+1,NSAV+NJET - MSTJ(91)=0 - NSAV1=N - MSTU91=MSTU(90) - -C...Initial flavour and momentum values. Jet along +z axis. - KFLH=IABS(K(IP1,2)) - IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10) - KFLO(2)=0 - WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2) - -C...Initial values for quark or diquark jet. - 170 IF(IABS(K(IP1,2)).NE.21) THEN - NSTR=1 - KFLO(1)=K(IP1,2) - CALL LUPTDI(0,PXO(1),PYO(1)) - WO(1)=WF - -C...Initial values for gluon treated like random quark jet. - ELSEIF(MSTJ(2).LE.2) THEN - NSTR=1 - IF(MSTJ(2).EQ.2) MSTJ(91)=1 - KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) - CALL LUPTDI(0,PXO(1),PYO(1)) - WO(1)=WF - -C...Initial values for gluon treated like quark-antiquark jet pair, -C...sharing energy according to Altarelli-Parisi splitting function. - ELSE - NSTR=2 - IF(MSTJ(2).EQ.4) MSTJ(91)=1 - KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) - KFLO(2)=-KFLO(1) - CALL LUPTDI(0,PXO(1),PYO(1)) - PXO(2)=-PXO(1) - PYO(2)=-PYO(1) - WO(1)=WF*RLU(0)**(1./3.) - WO(2)=WF-WO(1) - ENDIF - -C...Initial values for rank, flavour, pT and W+. - DO 220 ISTR=1,NSTR - 180 I=N - MSTU(90)=MSTU91 - IRANK=0 - KFL1=KFLO(ISTR) - PX1=PXO(ISTR) - PY1=PYO(ISTR) - W=WO(ISTR) - -C...New hadron. Generate flavour and hadron species. - 190 I=I+1 - IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN - CALL LUERRM(11,'(LUINDF:) no more memory left in LUJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - IRANK=IRANK+1 - K(I,1)=1 - K(I,3)=IP1 - K(I,4)=0 - K(I,5)=0 - 200 CALL LUKFDI(KFL1,0,KFL2,K(I,2)) - IF(K(I,2).EQ.0) GOTO 180 - IF(MSTJ(12).GE.3.AND.IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND. - &IABS(KFL2).GT.10) THEN - IF(RLU(0).GT.PARJ(19)) GOTO 200 - ENDIF - -C...Find hadron mass. Generate four-momentum. - P(I,5)=ULMASS(K(I,2)) - CALL LUPTDI(KFL1,PX2,PY2) - P(I,1)=PX1+PX2 - P(I,2)=PY1+PY2 - PR=P(I,5)**2+P(I,1)**2+P(I,2)**2 - CALL LUZDIS(KFL1,KFL2,PR,Z) - MZSAV=0 - IF(IABS(KFL1).GE.4.AND.IABS(KFL1).LE.8.AND.MSTU(90).LT.8) THEN - MZSAV=1 - MSTU(90)=MSTU(90)+1 - MSTU(90+MSTU(90))=I - PARU(90+MSTU(90))=Z - ENDIF - P(I,3)=0.5*(Z*W-PR/MAX(1E-4,Z*W)) - P(I,4)=0.5*(Z*W+PR/MAX(1E-4,Z*W)) - IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND. - &P(I,3).LE.0.001) THEN - IF(W.GE.P(I,5)+0.5*PARJ(32)) GOTO 180 - P(I,3)=0.0001 - P(I,4)=SQRT(PR) - Z=P(I,4)/W - ENDIF - -C...Remaining flavour and momentum. - KFL1=-KFL2 - PX1=-PX2 - PY1=-PY2 - W=(1.-Z)*W - DO 210 J=1,5 - V(I,J)=0. - 210 CONTINUE - -C...Check if pL acceptable. Go back for new hadron if enough energy. - IF(MSTJ(3).GE.0.AND.P(I,3).LT.0.) THEN - I=I-1 - IF(MZSAV.EQ.1) MSTU(90)=MSTU(90)-1 - ENDIF - IF(W.GT.PARJ(31)) GOTO 190 - N=I - 220 CONTINUE - IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1*PARJ(32) - IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170 - -C...Rotate jet to new direction. - THE=ULANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2)) - PHI=ULANGL(P(IP1,1),P(IP1,2)) - MSTU(33)=1 - CALL LUDBRB(NSAV1+1,N,THE,PHI,0D0,0D0,0D0) - K(K(IP1,3),4)=NSAV1+1 - K(K(IP1,3),5)=N - -C...End of jet generation loop. Skip conservation in some cases. - 230 CONTINUE - IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 490 - IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150 - -C...Subtract off produced hadron flavours, finished if zero. - DO 240 I=NSAV+NJET+1,N - KFA=IABS(K(I,2)) - KFLA=MOD(KFA/1000,10) - KFLB=MOD(KFA/100,10) - KFLC=MOD(KFA/10,10) - IF(KFLA.EQ.0) THEN - IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB - IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB - ELSE - IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2)) - IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2)) - IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2)) - ENDIF - 240 CONTINUE - NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ - &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 - IF(NREQ.EQ.0) GOTO 320 - -C...Take away flavour of low-momentum particles until enough freedom. - NREM=0 - 250 IREM=0 - P2MIN=PECM**2 - DO 260 I=NSAV+NJET+1,N - P2=P(I,1)**2+P(I,2)**2+P(I,3)**2 - IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I - IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2 - 260 CONTINUE - IF(IREM.EQ.0) GOTO 150 - K(IREM,1)=7 - KFA=IABS(K(IREM,2)) - KFLA=MOD(KFA/1000,10) - KFLB=MOD(KFA/100,10) - KFLC=MOD(KFA/10,10) - IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8 - IF(K(IREM,1).EQ.8) GOTO 250 - IF(KFLA.EQ.0) THEN - ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB - IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN - IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN - ELSE - IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2)) - IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2)) - IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2)) - ENDIF - NREM=NREM+1 - NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ - &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 - IF(NREQ.GT.NREM) GOTO 250 - DO 270 I=NSAV+NJET+1,N - IF(K(I,1).EQ.8) K(I,1)=1 - 270 CONTINUE - -C...Find combination of existing and new flavours for hadron. - 280 NFET=2 - IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3 - IF(NREQ.LT.NREM) NFET=1 - IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0 - DO 290 J=1,NFET - IFET(J)=1+(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*RLU(0) - KFLF(J)=ISIGN(1,NFL(1)) - IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2)) - IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3)) - 290 CONTINUE - IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0)) - &GOTO 280 - IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR. - &IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3) - &.LT.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280 - IF(NFET.EQ.0) KFLF(1)=1+INT((2.+PARJ(2))*RLU(0)) - IF(NFET.EQ.0) KFLF(2)=-KFLF(1) - IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2.+PARJ(2))*RLU(0)),-KFLF(1)) - IF(NFET.LE.2) KFLF(3)=0 - IF(KFLF(3).NE.0) THEN - KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+ - & 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1)) - IF(KFLF(1).EQ.KFLF(3).OR.(1.+3.*PARJ(4))*RLU(0).GT.1.) - & KFLFC=KFLFC+ISIGN(2,KFLFC) - ELSE - KFLFC=KFLF(1) - ENDIF - CALL LUKFDI(KFLFC,KFLF(2),KFLDMP,KF) - IF(KF.EQ.0) GOTO 280 - DO 300 J=1,MAX(2,NFET) - NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J)) - 300 CONTINUE - -C...Store hadron at random among free positions. - NPOS=MIN(1+INT(RLU(0)*NREM),NREM) - DO 310 I=NSAV+NJET+1,N - IF(K(I,1).EQ.7) NPOS=NPOS-1 - IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310 - K(I,1)=1 - K(I,2)=KF - P(I,5)=ULMASS(K(I,2)) - P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) - 310 CONTINUE - NREM=NREM-1 - NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ - &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 - IF(NREM.GT.0) GOTO 280 - -C...Compensate for missing momentum in global scheme (3 options). - 320 IF(MOD(MSTJ(3),5).NE.0.AND.MOD(MSTJ(3),5).NE.4) THEN - DO 340 J=1,3 - PSI(J)=0. - DO 330 I=NSAV+NJET+1,N - PSI(J)=PSI(J)+P(I,J) - 330 CONTINUE - 340 CONTINUE - PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2 - PWS=0. - DO 350 I=NSAV+NJET+1,N - IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4) - IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ - & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) - IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1. - 350 CONTINUE - DO 370 I=NSAV+NJET+1,N - IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4) - IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ - & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) - IF(MOD(MSTJ(3),5).EQ.3) PW=1. - DO 360 J=1,3 - P(I,J)=P(I,J)-PSI(J)*PW/PWS - 360 CONTINUE - P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) - 370 CONTINUE - -C...Compensate for missing momentum withing each jet separately. - ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN - DO 390 I=N+1,N+NJET - K(I,1)=0 - DO 380 J=1,5 - P(I,J)=0. - 380 CONTINUE - 390 CONTINUE - DO 410 I=NSAV+NJET+1,N - IR1=K(I,3) - IR2=N+IR1-NSAV - K(IR2,1)=K(IR2,1)+1 - PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ - & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) - DO 400 J=1,3 - P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J) - 400 CONTINUE - P(IR2,4)=P(IR2,4)+P(I,4) - P(IR2,5)=P(IR2,5)+PLS - 410 CONTINUE - PSS=0. - DO 420 I=N+1,N+NJET - IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8*P(I,5)+0.2)) - 420 CONTINUE - DO 440 I=NSAV+NJET+1,N - IR1=K(I,3) - IR2=N+IR1-NSAV - PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ - & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) - DO 430 J=1,3 - P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1./(P(IR2,5)*PSS)-1.)*PLS* - & P(IR1,J) - 430 CONTINUE - P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) - 440 CONTINUE - ENDIF - -C...Scale momenta for energy conservation. - IF(MOD(MSTJ(3),5).NE.0) THEN - PMS=0. - PES=0. - PQS=0. - DO 450 I=NSAV+NJET+1,N - PMS=PMS+P(I,5) - PES=PES+P(I,4) - PQS=PQS+P(I,5)**2/P(I,4) - 450 CONTINUE - IF(PMS.GE.PECM) GOTO 150 - NECO=0 - 460 NECO=NECO+1 - PFAC=(PECM-PQS)/(PES-PQS) - PES=0. - PQS=0. - DO 480 I=NSAV+NJET+1,N - DO 470 J=1,3 - P(I,J)=PFAC*P(I,J) - 470 CONTINUE - P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) - PES=PES+P(I,4) - PQS=PQS+P(I,5)**2/P(I,4) - 480 CONTINUE - IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2E-6*PECM) GOTO 460 - ENDIF - -C...Origin of produced particles and parton daughter pointers. - 490 DO 500 I=NSAV+NJET+1,N - IF(MSTU(16).NE.2) K(I,3)=NSAV+1 - IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3) - 500 CONTINUE - DO 510 I=NSAV+1,NSAV+NJET - I1=K(I,3) - K(I1,1)=K(I1,1)+10 - IF(MSTU(16).NE.2) THEN - K(I1,4)=NSAV+1 - K(I1,5)=NSAV+1 - ELSE - K(I1,4)=K(I1,4)-NJET+1 - K(I1,5)=K(I1,5)-NJET+1 - IF(K(I1,5).LT.K(I1,4)) THEN - K(I1,4)=0 - K(I1,5)=0 - ENDIF - ENDIF - 510 CONTINUE - -C...Document independent fragmentation system. Remove copy of jets. - NSAV=NSAV+1 - K(NSAV,1)=11 - K(NSAV,2)=93 - K(NSAV,3)=IP - K(NSAV,4)=NSAV+1 - K(NSAV,5)=N-NJET+1 - DO 520 J=1,4 - P(NSAV,J)=DPS(J) - V(NSAV,J)=V(IP,J) - 520 CONTINUE - P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) - V(NSAV,5)=0. - DO 540 I=NSAV+NJET,N - DO 530 J=1,5 - K(I-NJET+1,J)=K(I,J) - P(I-NJET+1,J)=P(I,J) - V(I-NJET+1,J)=V(I,J) - 530 CONTINUE - 540 CONTINUE - N=N-NJET+1 - DO 550 IZ=MSTU90+1,MSTU(90) - MSTU(90+IZ)=MSTU(90+IZ)-NJET+1 - 550 CONTINUE - -C...Boost back particle system. Set production vertices. - IF(NJET.NE.1) CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4), - &DPS(2)/DPS(4),DPS(3)/DPS(4)) - DO 570 I=NSAV+1,N - DO 560 J=1,4 - V(I,J)=V(IP,J) - 560 CONTINUE - 570 CONTINUE - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUDECY(IP) - -C...Purpose: to handle the decay of unstable particles. - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ - DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3), - &WTCOR(10),PTAU(4),PCMTAU(4) - DOUBLE PRECISION DBETAU(3) - DATA WTCOR/2.,5.,15.,60.,250.,1500.,1.2E4,1.2E5,150.,16./ - -C...Functions: momentum in two-particle decays, four-product and -C...matrix element times phase space in weak decays. - PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A) - FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3) - HMEPS(HA)=((1.-HRQ-HA)**2+3.*HA*(1.+HRQ-HA))* - &SQRT((1.-HRQ-HA)**2-4.*HRQ*HA) - -C...Initial values. - NTRY=0 - NSAV=N - KFA=IABS(K(IP,2)) - KFS=ISIGN(1,K(IP,2)) - KC=LUCOMP(KFA) - MSTJ(92)=0 - -C...Choose lifetime and determine decay vertex. - IF(K(IP,1).EQ.5) THEN - V(IP,5)=0. - ELSEIF(K(IP,1).NE.4) THEN - V(IP,5)=-PMAS(KC,4)*LOG(RLU(0)) - ENDIF - DO 100 J=1,4 - VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5) - 100 CONTINUE - -C...Determine whether decay allowed or not. - MOUT=0 - IF(MSTJ(22).EQ.2) THEN - IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1 - ELSEIF(MSTJ(22).EQ.3) THEN - IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1 - ELSEIF(MSTJ(22).EQ.4) THEN - IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1 - IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1 - ENDIF - IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN - K(IP,1)=4 - RETURN - ENDIF - -C...Interface to external tau decay library (for tau polarization). - IF(KFA.EQ.15.AND.MSTJ(28).GE.1) THEN - -C...Starting values for pointers and momenta. - ITAU=IP - DO 110 J=1,4 - PTAU(J)=P(ITAU,J) - PCMTAU(J)=P(ITAU,J) - 110 CONTINUE - -C...Iterate to find position and code of mother of tau. - IMTAU=ITAU - 120 IMTAU=K(IMTAU,3) - - IF(IMTAU.EQ.0) THEN -C...If no known origin then impossible to do anything further. - KFORIG=0 - IORIG=0 - - ELSEIF(K(IMTAU,2).EQ.K(ITAU,2)) THEN -C...If tau -> tau + gamma then add gamma energy and loop. - IF(K(K(IMTAU,4),2).EQ.22) THEN - DO 130 J=1,4 - PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,4),J) - 130 CONTINUE - ELSEIF(K(K(IMTAU,5),2).EQ.22) THEN - DO 140 J=1,4 - PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,5),J) - 140 CONTINUE - ENDIF - GOTO 120 - - ELSEIF(IABS(K(IMTAU,2)).GT.100) THEN -C...If coming from weak decay of hadron then W is not stored in record, -C...but can be reconstructed by adding neutrino momentum. - KFORIG=-ISIGN(24,K(ITAU,2)) - IORIG=0 - DO 160 II=K(IMTAU,4),K(IMTAU,5) - IF(K(II,2)*ISIGN(1,K(ITAU,2)).EQ.-16) THEN - DO 150 J=1,4 - PCMTAU(J)=PCMTAU(J)+P(II,J) - 150 CONTINUE - ENDIF - 160 CONTINUE - - ELSE -C...If coming from resonance decay then find latest copy of this -C...resonance (may not completely agree). - KFORIG=K(IMTAU,2) - IORIG=IMTAU - DO 170 II=IMTAU+1,IP-1 - IF(K(II,2).EQ.KFORIG.AND.K(II,3).EQ.IORIG.AND. - & ABS(P(II,5)-P(IORIG,5)).LT.1E-5*P(IORIG,5)) IORIG=II - 170 CONTINUE - DO 180 J=1,4 - PCMTAU(J)=P(IORIG,J) - 180 CONTINUE - ENDIF - -C...Boost tau to rest frame of production process (where known) -C...and rotate it to sit along +z axis. - DO 190 J=1,3 - DBETAU(J)=PCMTAU(J)/PCMTAU(4) - 190 CONTINUE - IF(KFORIG.NE.0) CALL LUDBRB(ITAU,ITAU,0.,0.,-DBETAU(1), - & -DBETAU(2),-DBETAU(3)) - PHITAU=ULANGL(P(ITAU,1),P(ITAU,2)) - CALL LUDBRB(ITAU,ITAU,0.,-PHITAU,0D0,0D0,0D0) - THETAU=ULANGL(P(ITAU,3),P(ITAU,1)) - CALL LUDBRB(ITAU,ITAU,-THETAU,0.,0D0,0D0,0D0) - -C...Call tau decay routine (if meaningful) and fill extra info. - IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN - CALL LUTAUD(ITAU,IORIG,KFORIG,NDECAY) - DO 200 II=NSAV+1,NSAV+NDECAY - K(II,1)=1 - K(II,3)=IP - K(II,4)=0 - K(II,5)=0 - 200 CONTINUE - N=NSAV+NDECAY - ENDIF - -C...Boost back decay tau and decay products. - DO 210 J=1,4 - P(ITAU,J)=PTAU(J) - 210 CONTINUE - IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN - CALL LUDBRB(NSAV+1,N,THETAU,PHITAU,0D0,0D0,0D0) - IF(KFORIG.NE.0) CALL LUDBRB(NSAV+1,N,0.,0.,DBETAU(1), - & DBETAU(2),DBETAU(3)) - -C...Skip past ordinary tau decay treatment. - MMAT=0 - MBST=0 - ND=0 - GOTO 660 - ENDIF - ENDIF - -C...B-B~ mixing: flip sign of meson appropriately. - MMIX=0 - IF((KFA.EQ.511.OR.KFA.EQ.531).AND.MSTJ(26).GE.1) THEN - XBBMIX=PARJ(76) - IF(KFA.EQ.531) XBBMIX=PARJ(77) - IF(SIN(0.5*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.RLU(0)) MMIX=1 - IF(MMIX.EQ.1) KFS=-KFS - ENDIF - -C...Check existence of decay channels. Particle/antiparticle rules. - KCA=KC - IF(MDCY(KC,2).GT.0) THEN - MDMDCY=MDME(MDCY(KC,2),2) - IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY - ENDIF - IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN - CALL LUERRM(9,'(LUDECY:) no decay channel defined') - RETURN - ENDIF - IF(MOD(KFA/1000,10).EQ.0.AND.(KCA.EQ.85.OR.KCA.EQ.87)) KFS=-KFS - IF(KCHG(KC,3).EQ.0) THEN - KFSP=1 - KFSN=0 - IF(RLU(0).GT.0.5) KFS=-KFS - ELSEIF(KFS.GT.0) THEN - KFSP=1 - KFSN=0 - ELSE - KFSP=0 - KFSN=1 - ENDIF - -C...Sum branching ratios of allowed decay channels. - 220 NOPE=0 - BRSU=0. - DO 230 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1 - IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. - &KFSN*MDME(IDL,1).NE.3) GOTO 230 - IF(MDME(IDL,2).GT.100) GOTO 230 - NOPE=NOPE+1 - BRSU=BRSU+BRAT(IDL) - 230 CONTINUE - IF(NOPE.EQ.0) THEN - CALL LUERRM(2,'(LUDECY:) all decay channels closed by user') - RETURN - ENDIF - -C...Select decay channel among allowed ones. - 240 RBR=BRSU*RLU(0) - IDL=MDCY(KCA,2)-1 - 250 IDL=IDL+1 - IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. - &KFSN*MDME(IDL,1).NE.3) THEN - IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250 - ELSEIF(MDME(IDL,2).GT.100) THEN - IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250 - ELSE - IDC=IDL - RBR=RBR-BRAT(IDL) - IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0.) GOTO 250 - ENDIF - -C...Start readout of decay channel: matrix element, reset counters. - MMAT=MDME(IDC,2) - 260 NTRY=NTRY+1 - IF(NTRY.GT.1000) THEN - CALL LUERRM(14,'(LUDECY:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - I=N - NP=0 - NQ=0 - MBST=0 - IF(MMAT.GE.11.AND.MMAT.NE.46.AND.P(IP,4).GT.20.*P(IP,5)) MBST=1 - DO 270 J=1,4 - PV(1,J)=0. - IF(MBST.EQ.0) PV(1,J)=P(IP,J) - 270 CONTINUE - IF(MBST.EQ.1) PV(1,4)=P(IP,5) - PV(1,5)=P(IP,5) - PS=0. - PSQ=0. - MREM=0 - MHADDY=0 - IF(KFA.GT.80) MHADDY=1 - -C...Read out decay products. Convert to standard flavour code. - JTMAX=5 - IF(MDME(IDC+1,2).EQ.101) JTMAX=10 - DO 280 JT=1,JTMAX - IF(JT.LE.5) KP=KFDP(IDC,JT) - IF(JT.GE.6) KP=KFDP(IDC+1,JT-5) - IF(KP.EQ.0) GOTO 280 - KPA=IABS(KP) - KCP=LUCOMP(KPA) - IF(KPA.GT.80) MHADDY=1 - IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN - KFP=KP - ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN - KFP=KFS*KP - ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN - KFP=-KFS*MOD(KFA/10,10) - ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN - KFP=KFS*(100*MOD(KFA/10,100)+3) - ELSEIF(KPA.EQ.81) THEN - KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1) - ELSEIF(KP.EQ.82) THEN - CALL LUKFDI(-KFS*INT(1.+(2.+PARJ(2))*RLU(0)),0,KFP,KDUMP) - IF(KFP.EQ.0) GOTO 260 - MSTJ(93)=1 - IF(PV(1,5).LT.PARJ(32)+2.*ULMASS(KFP)) GOTO 260 - ELSEIF(KP.EQ.-82) THEN - KFP=-KFP - IF(IABS(KFP).GT.10) KFP=KFP+ISIGN(10000,KFP) - ENDIF - IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=LUCOMP(KFP) - -C...Add decay product to event record or to quark flavour list. - KFPA=IABS(KFP) - KQP=KCHG(KCP,2) - IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN - NQ=NQ+1 - KFLO(NQ)=KFP - MSTJ(93)=2 - PSQ=PSQ+ULMASS(KFLO(NQ)) - ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.48).AND.NP.EQ.3.AND. - &MOD(NQ,2).EQ.1) THEN - NQ=NQ-1 - PS=PS-P(I,5) - K(I,1)=1 - KFI=K(I,2) - CALL LUKFDI(KFP,KFI,KFLDMP,K(I,2)) - IF(K(I,2).EQ.0) GOTO 260 - MSTJ(93)=1 - P(I,5)=ULMASS(K(I,2)) - PS=PS+P(I,5) - ELSE - I=I+1 - NP=NP+1 - IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1 - IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1 - K(I,1)=1+MOD(NQ,2) - IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2 - IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1 - K(I,2)=KFP - K(I,3)=IP - K(I,4)=0 - K(I,5)=0 - P(I,5)=ULMASS(KFP) - IF(MMAT.EQ.45.AND.KFPA.EQ.89) P(I,5)=PARJ(32) - PS=PS+P(I,5) - ENDIF - 280 CONTINUE - -C...Check masses for resonance decays. - IF(MHADDY.EQ.0) THEN - IF(PS+PARJ(64).GT.PV(1,5)) GOTO 240 - ENDIF - -C...Choose decay multiplicity in phase space model. - 290 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN - PSP=PS - CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1)) - IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63) - 300 NTRY=NTRY+1 - IF(NTRY.GT.1000) THEN - CALL LUERRM(14,'(LUDECY:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(MMAT.LE.20) THEN - GAUSS=SQRT(-2.*CNDE*LOG(MAX(1E-10,RLU(0))))* - & SIN(PARU(2)*RLU(0)) - ND=0.5+0.5*NP+0.25*NQ+CNDE+GAUSS - IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 300 - IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 300 - IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 300 - IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 300 - ELSE - ND=MMAT-20 - ENDIF - -C...Form hadrons from flavour content. - DO 310 JT=1,4 - KFL1(JT)=KFLO(JT) - 310 CONTINUE - IF(ND.EQ.NP+NQ/2) GOTO 330 - DO 320 I=N+NP+1,N+ND-NQ/2 - JT=1+INT((NQ-1)*RLU(0)) - CALL LUKFDI(KFL1(JT),0,KFL2,K(I,2)) - IF(K(I,2).EQ.0) GOTO 300 - KFL1(JT)=-KFL2 - 320 CONTINUE - 330 JT=2 - JT2=3 - JT3=4 - IF(NQ.EQ.4.AND.RLU(0).LT.PARJ(66)) JT=4 - IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))* - & ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3 - IF(JT.EQ.3) JT2=2 - IF(JT.EQ.4) JT3=2 - CALL LUKFDI(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2)) - IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 300 - IF(NQ.EQ.4) CALL LUKFDI(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2)) - IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 300 - -C...Check that sum of decay product masses not too large. - PS=PSP - DO 340 I=N+NP+1,N+ND - K(I,1)=1 - K(I,3)=IP - K(I,4)=0 - K(I,5)=0 - P(I,5)=ULMASS(K(I,2)) - PS=PS+P(I,5) - 340 CONTINUE - IF(PS+PARJ(64).GT.PV(1,5)) GOTO 300 - -C...Rescale energy to subtract off spectator quark mass. - ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44.OR.MMAT.EQ.45) - &.AND.NP.GE.3) THEN - PS=PS-P(N+NP,5) - PQT=(P(N+NP,5)+PARJ(65))/PV(1,5) - DO 350 J=1,5 - P(N+NP,J)=PQT*PV(1,J) - PV(1,J)=(1.-PQT)*PV(1,J) - 350 CONTINUE - IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260 - ND=NP-1 - MREM=1 - -C...Phase space factors imposed in W decay. - ELSEIF(MMAT.EQ.46) THEN - MSTJ(93)=1 - PSMC=ULMASS(K(N+1,2)) - MSTJ(93)=1 - PSMC=PSMC+ULMASS(K(N+2,2)) - IF(MAX(PS,PSMC)+PARJ(32).GT.PV(1,5)) GOTO 240 - HR1=(P(N+1,5)/PV(1,5))**2 - HR2=(P(N+2,5)/PV(1,5))**2 - IF((1.-HR1-HR2)*(2.+HR1+HR2)*SQRT((1.-HR1-HR2)**2-4.*HR1*HR2) - & .LT.2.*RLU(0)) GOTO 240 - ND=NP - -C...Fully specified final state: check mass broadening effects. - ELSE - IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 260 - ND=NP - ENDIF - -C...Select W mass in decay Q -> W + q, without W propagator. - IF(MMAT.EQ.45.AND.MSTJ(25).LE.0) THEN - HLQ=(PARJ(32)/PV(1,5))**2 - HUQ=(1.-(P(N+2,5)+PARJ(64))/PV(1,5))**2 - HRQ=(P(N+2,5)/PV(1,5))**2 - 360 HW=HLQ+RLU(0)*(HUQ-HLQ) - IF(HMEPS(HW).LT.RLU(0)) GOTO 360 - P(N+1,5)=PV(1,5)*SQRT(HW) - -C...Ditto, including W propagator. Divide mass range into three regions. - ELSEIF(MMAT.EQ.45) THEN - HQW=(PV(1,5)/PMAS(24,1))**2 - HLW=(PARJ(32)/PMAS(24,1))**2 - HUW=((PV(1,5)-P(N+2,5)-PARJ(64))/PMAS(24,1))**2 - HRQ=(P(N+2,5)/PV(1,5))**2 - HG=PMAS(24,2)/PMAS(24,1) - HATL=ATAN((HLW-1.)/HG) - HM=MIN(1.,HUW-0.001) - HMV1=HMEPS(HM/HQW)/((HM-1.)**2+HG**2) - 370 HM=HM-HG - HMV2=HMEPS(HM/HQW)/((HM-1.)**2+HG**2) - IF(HMV2.GT.HMV1.AND.HM-HG.GT.HLW) THEN - HMV1=HMV2 - GOTO 370 - ENDIF - HMV=MIN(2.*HMV1,HMEPS(HM/HQW)/HG**2) - HM1=1.-SQRT(1./HMV-HG**2) - IF(HM1.GT.HLW.AND.HM1.LT.HM) THEN - HM=HM1 - ELSEIF(HMV2.LE.HMV1) THEN - HM=MAX(HLW,HM-MIN(0.1,1.-HM)) - ENDIF - HATM=ATAN((HM-1.)/HG) - HWT1=(HATM-HATL)/HG - HWT2=HMV*(MIN(1.,HUW)-HM) - HWT3=0. - IF(HUW.GT.1.) THEN - HATU=ATAN((HUW-1.)/HG) - HMP1=HMEPS(1./HQW) - HWT3=HMP1*HATU/HG - ENDIF - -C...Select mass region and W mass there. Accept according to weight. - 380 HREG=RLU(0)*(HWT1+HWT2+HWT3) - IF(HREG.LE.HWT1) THEN - HW=1.+HG*TAN(HATL+RLU(0)*(HATM-HATL)) - HACC=HMEPS(HW/HQW) - ELSEIF(HREG.LE.HWT1+HWT2) THEN - HW=HM+RLU(0)*(MIN(1.,HUW)-HM) - HACC=HMEPS(HW/HQW)/((HW-1.)**2+HG**2)/HMV - ELSE - HW=1.+HG*TAN(RLU(0)*HATU) - HACC=HMEPS(HW/HQW)/HMP1 - ENDIF - IF(HACC.LT.RLU(0)) GOTO 380 - P(N+1,5)=PMAS(24,1)*SQRT(HW) - ENDIF - -C...Determine position of grandmother, number of sisters, Q -> W sign. - NM=0 - KFAS=0 - MSGN=0 - IF(MMAT.EQ.3.OR.MMAT.EQ.46) THEN - IM=K(IP,3) - IF(IM.LT.0.OR.IM.GE.IP) IM=0 - IF(MMAT.EQ.46.AND.MSTJ(27).EQ.1) THEN - IM=0 - ELSEIF(MMAT.EQ.46.AND.MSTJ(27).GE.2.AND.IM.NE.0) THEN - IF(K(IM,2).EQ.94) THEN - IM=K(K(IM,3),3) - IF(IM.LT.0.OR.IM.GE.IP) IM=0 - ENDIF - ENDIF - IF(IM.NE.0) KFAM=IABS(K(IM,2)) - IF(IM.NE.0.AND.MMAT.EQ.3) THEN - DO 390 IL=MAX(IP-2,IM+1),MIN(IP+2,N) - IF(K(IL,3).EQ.IM) NM=NM+1 - IF(K(IL,3).EQ.IM.AND.IL.NE.IP) ISIS=IL - 390 CONTINUE - IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR. - & MOD(KFAM/1000,10).NE.0) NM=0 - IF(NM.EQ.2) THEN - KFAS=IABS(K(ISIS,2)) - IF((KFAS.LE.100.OR.MOD(KFAS,10).NE.1.OR. - & MOD(KFAS/1000,10).NE.0).AND.KFAS.NE.22) NM=0 - ENDIF - ELSEIF(IM.NE.0.AND.MMAT.EQ.46) THEN - MSGN=ISIGN(1,K(IM,2)*K(IP,2)) - IF(KFAM.GT.100.AND.MOD(KFAM/1000,10).EQ.0) MSGN= - & MSGN*(-1)**MOD(KFAM/100,10) - ENDIF - ENDIF - -C...Kinematics of one-particle decays. - IF(ND.EQ.1) THEN - DO 400 J=1,4 - P(N+1,J)=P(IP,J) - 400 CONTINUE - GOTO 660 - ENDIF - -C...Calculate maximum weight ND-particle decay. - PV(ND,5)=P(N+ND,5) - IF(ND.GE.3) THEN - WTMAX=1./WTCOR(ND-2) - PMAX=PV(1,5)-PS+P(N+ND,5) - PMIN=0. - DO 410 IL=ND-1,1,-1 - PMAX=PMAX+P(N+IL,5) - PMIN=PMIN+P(N+IL+1,5) - WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5)) - 410 CONTINUE - ENDIF - -C...Find virtual gamma mass in Dalitz decay. - 420 IF(ND.EQ.2) THEN - ELSEIF(MMAT.EQ.2) THEN - PMES=4.*PMAS(11,1)**2 - PMRHO2=PMAS(131,1)**2 - PGRHO2=PMAS(131,2)**2 - 430 PMST=PMES*(P(IP,5)**2/PMES)**RLU(0) - WT=(1+0.5*PMES/PMST)*SQRT(MAX(0.,1.-PMES/PMST))* - & (1.-PMST/P(IP,5)**2)**3*(1.+PGRHO2/PMRHO2)/ - & ((1.-PMST/PMRHO2)**2+PGRHO2/PMRHO2) - IF(WT.LT.RLU(0)) GOTO 430 - PV(2,5)=MAX(2.00001*PMAS(11,1),SQRT(PMST)) - -C...M-generator gives weight. If rejected, try again. - ELSE - 440 RORD(1)=1. - DO 470 IL1=2,ND-1 - RSAV=RLU(0) - DO 450 IL2=IL1-1,1,-1 - IF(RSAV.LE.RORD(IL2)) GOTO 460 - RORD(IL2+1)=RORD(IL2) - 450 CONTINUE - 460 RORD(IL2+1)=RSAV - 470 CONTINUE - RORD(ND)=0. - WT=1. - DO 480 IL=ND-1,1,-1 - PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS) - WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) - 480 CONTINUE - IF(WT.LT.RLU(0)*WTMAX) GOTO 440 - ENDIF - -C...Perform two-particle decays in respective CM frame. - 490 DO 510 IL=1,ND-1 - PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) - UE(3)=2.*RLU(0)-1. - PHI=PARU(2)*RLU(0) - UE(1)=SQRT(1.-UE(3)**2)*COS(PHI) - UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI) - DO 500 J=1,3 - P(N+IL,J)=PA*UE(J) - PV(IL+1,J)=-PA*UE(J) - 500 CONTINUE - P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2) - PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2) - 510 CONTINUE - -C...Lorentz transform decay products to lab frame. - DO 520 J=1,4 - P(N+ND,J)=PV(ND,J) - 520 CONTINUE - DO 560 IL=ND-1,1,-1 - DO 530 J=1,3 - BE(J)=PV(IL,J)/PV(IL,4) - 530 CONTINUE - GA=PV(IL,4)/PV(IL,5) - DO 550 I=N+IL,N+ND - BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) - DO 540 J=1,3 - P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) - 540 CONTINUE - P(I,4)=GA*(P(I,4)+BEP) - 550 CONTINUE - 560 CONTINUE - -C...Check that no infinite loop in matrix element weight. - NTRY=NTRY+1 - IF(NTRY.GT.800) GOTO 590 - -C...Matrix elements for omega and phi decays. - IF(MMAT.EQ.1) THEN - WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2 - & -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2 - & +2.*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3) - IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001).LT.RLU(0)) GOTO 420 - -C...Matrix elements for pi0 or eta Dalitz decay to gamma e+ e-. - ELSEIF(MMAT.EQ.2) THEN - FOUR12=FOUR(N+1,N+2) - FOUR13=FOUR(N+1,N+3) - WT=(PMST-0.5*PMES)*(FOUR12**2+FOUR13**2)+ - & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2) - IF(WT.LT.RLU(0)*0.25*PMST*(P(IP,5)**2-PMST)**2) GOTO 490 - -C...Matrix element for S0 -> S1 + V1 -> S1 + S2 + S3 (S scalar, -C...V vector), of form cos**2(theta02) in V1 rest frame, and for -C...S0 -> gamma + V1 -> gamma + S2 + S3, of form sin**2(theta02). - ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN - FOUR10=FOUR(IP,IM) - FOUR12=FOUR(IP,N+1) - FOUR02=FOUR(IM,N+1) - PMS1=P(IP,5)**2 - PMS0=P(IM,5)**2 - PMS2=P(N+1,5)**2 - IF(KFAS.NE.22) HNUM=(FOUR10*FOUR12-PMS1*FOUR02)**2 - IF(KFAS.EQ.22) HNUM=PMS1*(2.*FOUR10*FOUR12*FOUR02- - & PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2) - HNUM=MAX(1E-6*PMS1**2*PMS0*PMS2,HNUM) - HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2) - IF(HNUM.LT.RLU(0)*HDEN) GOTO 490 - -C...Matrix element for "onium" -> g + g + g or gamma + g + g. - ELSEIF(MMAT.EQ.4) THEN - HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 - HX2=2.*FOUR(IP,N+2)/P(IP,5)**2 - HX3=2.*FOUR(IP,N+3)/P(IP,5)**2 - WT=((1.-HX1)/(HX2*HX3))**2+((1.-HX2)/(HX1*HX3))**2+ - & ((1.-HX3)/(HX1*HX2))**2 - IF(WT.LT.2.*RLU(0)) GOTO 420 - IF(K(IP+1,2).EQ.22.AND.(1.-HX1)*P(IP,5)**2.LT.4.*PARJ(32)**2) - & GOTO 420 - -C...Effective matrix element for nu spectrum in tau -> nu + hadrons. - ELSEIF(MMAT.EQ.41) THEN - HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 - HXM=MIN(0.75,2.*(1.-PS/P(IP,5))) - IF(HX1*(3.-2.*HX1).LT.RLU(0)*HXM*(3.-2.*HXM)) GOTO 420 - -C...Matrix elements for weak decays (only semileptonic for c and b) - ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) - &.AND.ND.EQ.3) THEN - IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3) - IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3) - IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 420 - ELSEIF(MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) THEN - DO 580 J=1,4 - P(N+NP+1,J)=0. - DO 570 IS=N+3,N+NP - P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J) - 570 CONTINUE - 580 CONTINUE - IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1) - IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1) - IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 420 - -C...Angular distribution in W decay. - ELSEIF(MMAT.EQ.46.AND.MSGN.NE.0) THEN - IF(MSGN.GT.0) WT=FOUR(IM,N+1)*FOUR(N+2,IP+1) - IF(MSGN.LT.0) WT=FOUR(IM,N+2)*FOUR(N+1,IP+1) - IF(WT.LT.RLU(0)*P(IM,5)**4/WTCOR(10)) GOTO 490 - ENDIF - -C...Scale back energy and reattach spectator. - 590 IF(MREM.EQ.1) THEN - DO 600 J=1,5 - PV(1,J)=PV(1,J)/(1.-PQT) - 600 CONTINUE - ND=ND+1 - MREM=0 - ENDIF - -C...Low invariant mass for system with spectator quark gives particle, -C...not two jets. Readjust momenta accordingly. - IF((MMAT.EQ.31.OR.MMAT.EQ.45).AND.ND.EQ.3) THEN - MSTJ(93)=1 - PM2=ULMASS(K(N+2,2)) - MSTJ(93)=1 - PM3=ULMASS(K(N+3,2)) - IF(P(N+2,5)**2+P(N+3,5)**2+2.*FOUR(N+2,N+3).GE. - & (PARJ(32)+PM2+PM3)**2) GOTO 660 - K(N+2,1)=1 - KFTEMP=K(N+2,2) - CALL LUKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2)) - IF(K(N+2,2).EQ.0) GOTO 260 - P(N+2,5)=ULMASS(K(N+2,2)) - PS=P(N+1,5)+P(N+2,5) - PV(2,5)=P(N+2,5) - MMAT=0 - ND=2 - GOTO 490 - ELSEIF(MMAT.EQ.44) THEN - MSTJ(93)=1 - PM3=ULMASS(K(N+3,2)) - MSTJ(93)=1 - PM4=ULMASS(K(N+4,2)) - IF(P(N+3,5)**2+P(N+4,5)**2+2.*FOUR(N+3,N+4).GE. - & (PARJ(32)+PM3+PM4)**2) GOTO 630 - K(N+3,1)=1 - KFTEMP=K(N+3,2) - CALL LUKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2)) - IF(K(N+3,2).EQ.0) GOTO 260 - P(N+3,5)=ULMASS(K(N+3,2)) - DO 610 J=1,3 - P(N+3,J)=P(N+3,J)+P(N+4,J) - 610 CONTINUE - P(N+3,4)=SQRT(P(N+3,1)**2+P(N+3,2)**2+P(N+3,3)**2+P(N+3,5)**2) - HA=P(N+1,4)**2-P(N+2,4)**2 - HB=HA-(P(N+1,5)**2-P(N+2,5)**2) - HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+ - & (P(N+1,3)-P(N+2,3))**2 - HD=(PV(1,4)-P(N+3,4))**2 - HE=HA**2-2.*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2 - HF=HD*HC-HB**2 - HG=HD*HC-HA*HB - HH=(SQRT(HG**2+HE*HF)-HG)/(2.*HF) - DO 620 J=1,3 - PCOR=HH*(P(N+1,J)-P(N+2,J)) - P(N+1,J)=P(N+1,J)+PCOR - P(N+2,J)=P(N+2,J)-PCOR - 620 CONTINUE - P(N+1,4)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2+P(N+1,5)**2) - P(N+2,4)=SQRT(P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2+P(N+2,5)**2) - ND=ND-1 - ENDIF - -C...Check invariant mass of W jets. May give one particle or start over. - 630 IF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) - &.AND.IABS(K(N+1,2)).LT.10) THEN - PMR=SQRT(MAX(0.,P(N+1,5)**2+P(N+2,5)**2+2.*FOUR(N+1,N+2))) - MSTJ(93)=1 - PM1=ULMASS(K(N+1,2)) - MSTJ(93)=1 - PM2=ULMASS(K(N+2,2)) - IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 640 - KFLDUM=INT(1.5+RLU(0)) - CALL LUKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1) - CALL LUKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2) - IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 260 - PSM=ULMASS(KF1)+ULMASS(KF2) - IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.PMR.GT.PARJ(64)+PSM) GOTO 640 - IF(MMAT.GE.43.AND.PMR.GT.0.2*PARJ(32)+PSM) GOTO 640 - IF(MMAT.EQ.48) GOTO 420 - IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 260 - K(N+1,1)=1 - KFTEMP=K(N+1,2) - CALL LUKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2)) - IF(K(N+1,2).EQ.0) GOTO 260 - P(N+1,5)=ULMASS(K(N+1,2)) - K(N+2,2)=K(N+3,2) - P(N+2,5)=P(N+3,5) - PS=P(N+1,5)+P(N+2,5) - IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260 - PV(2,5)=P(N+3,5) - MMAT=0 - ND=2 - GOTO 490 - ENDIF - -C...Phase space decay of partons from W decay. - 640 IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.IABS(K(N+1,2)).LT.10) THEN - KFLO(1)=K(N+1,2) - KFLO(2)=K(N+2,2) - K(N+1,1)=K(N+3,1) - K(N+1,2)=K(N+3,2) - DO 650 J=1,5 - PV(1,J)=P(N+1,J)+P(N+2,J) - P(N+1,J)=P(N+3,J) - 650 CONTINUE - PV(1,5)=PMR - N=N+1 - NP=0 - NQ=2 - PS=0. - MSTJ(93)=2 - PSQ=ULMASS(KFLO(1)) - MSTJ(93)=2 - PSQ=PSQ+ULMASS(KFLO(2)) - MMAT=11 - GOTO 290 - ENDIF - -C...Boost back for rapidly moving particle. - 660 N=N+ND - IF(MBST.EQ.1) THEN - DO 670 J=1,3 - BE(J)=P(IP,J)/P(IP,4) - 670 CONTINUE - GA=P(IP,4)/P(IP,5) - DO 690 I=NSAV+1,N - BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) - DO 680 J=1,3 - P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) - 680 CONTINUE - P(I,4)=GA*(P(I,4)+BEP) - 690 CONTINUE - ENDIF - -C...Fill in position of decay vertex. - DO 710 I=NSAV+1,N - DO 700 J=1,4 - V(I,J)=VDCY(J) - 700 CONTINUE - V(I,5)=0. - 710 CONTINUE - -C...Set up for parton shower evolution from jets. - IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN - K(NSAV+1,1)=3 - K(NSAV+2,1)=3 - K(NSAV+3,1)=3 - K(NSAV+1,4)=MSTU(5)*(NSAV+2) - K(NSAV+1,5)=MSTU(5)*(NSAV+3) - K(NSAV+2,4)=MSTU(5)*(NSAV+3) - K(NSAV+2,5)=MSTU(5)*(NSAV+1) - K(NSAV+3,4)=MSTU(5)*(NSAV+1) - K(NSAV+3,5)=MSTU(5)*(NSAV+2) - MSTJ(92)=-(NSAV+1) - ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN - K(NSAV+2,1)=3 - K(NSAV+3,1)=3 - K(NSAV+2,4)=MSTU(5)*(NSAV+3) - K(NSAV+2,5)=MSTU(5)*(NSAV+3) - K(NSAV+3,4)=MSTU(5)*(NSAV+2) - K(NSAV+3,5)=MSTU(5)*(NSAV+2) - MSTJ(92)=NSAV+2 - ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46) - &.AND.IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN - K(NSAV+1,1)=3 - K(NSAV+2,1)=3 - K(NSAV+1,4)=MSTU(5)*(NSAV+2) - K(NSAV+1,5)=MSTU(5)*(NSAV+2) - K(NSAV+2,4)=MSTU(5)*(NSAV+1) - K(NSAV+2,5)=MSTU(5)*(NSAV+1) - MSTJ(92)=NSAV+1 - ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46) - &.AND.IABS(K(NSAV+1,2)).LE.20.AND.IABS(K(NSAV+2,2)).LE.20) THEN - MSTJ(92)=NSAV+1 - ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21) - &THEN - K(NSAV+1,1)=3 - K(NSAV+2,1)=3 - K(NSAV+3,1)=3 - KCP=LUCOMP(K(NSAV+1,2)) - KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2)) - JCON=4 - IF(KQP.LT.0) JCON=5 - K(NSAV+1,JCON)=MSTU(5)*(NSAV+2) - K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1) - K(NSAV+2,JCON)=MSTU(5)*(NSAV+3) - K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2) - MSTJ(92)=NSAV+1 - ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN - K(NSAV+1,1)=3 - K(NSAV+3,1)=3 - K(NSAV+1,4)=MSTU(5)*(NSAV+3) - K(NSAV+1,5)=MSTU(5)*(NSAV+3) - K(NSAV+3,4)=MSTU(5)*(NSAV+1) - K(NSAV+3,5)=MSTU(5)*(NSAV+1) - MSTJ(92)=NSAV+1 - -C...Set up for parton shower evolution in t -> W + b. - ELSEIF(MSTJ(27).GE.1.AND.MMAT.EQ.45.AND.ND.EQ.3) THEN - K(NSAV+2,1)=3 - K(NSAV+3,1)=3 - K(NSAV+2,4)=MSTU(5)*(NSAV+3) - K(NSAV+2,5)=MSTU(5)*(NSAV+3) - K(NSAV+3,4)=MSTU(5)*(NSAV+2) - K(NSAV+3,5)=MSTU(5)*(NSAV+2) - MSTJ(92)=NSAV+1 - ENDIF - -C...Mark decayed particle; special option for B-B~ mixing. - IF(K(IP,1).EQ.5) K(IP,1)=15 - IF(K(IP,1).LE.10) K(IP,1)=11 - IF(MMIX.EQ.1.AND.MSTJ(26).EQ.2.AND.K(IP,1).EQ.11) K(IP,1)=12 - K(IP,4)=NSAV+1 - K(IP,5)=N - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUKFDI(KFL1,KFL2,KFL3,KF) - -C...Purpose: to generate a new flavour pair and combine off a hadron. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUDAT1/,/LUDAT2/ - -C...Default flavour values. Input consistency checks. - KF1A=IABS(KFL1) - KF2A=IABS(KFL2) - KFL3=0 - KF=0 - IF(KF1A.EQ.0) RETURN - IF(KF2A.NE.0) THEN - IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN - IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN - IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN - ENDIF - -C...Check if tabulated flavour probabilities are to be used. - IF(MSTJ(15).EQ.1) THEN - KTAB1=-1 - IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A - KFL1A=MOD(KF1A/1000,10) - KFL1B=MOD(KF1A/100,10) - KFL1S=MOD(KF1A,10) - IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4) - & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2 - IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1 - IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A - KTAB2=0 - IF(KF2A.NE.0) THEN - KTAB2=-1 - IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A - KFL2A=MOD(KF2A/1000,10) - KFL2B=MOD(KF2A/100,10) - KFL2S=MOD(KF2A,10) - IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4) - & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2 - IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1 - ENDIF - IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 150 - ENDIF - -C...Parameters and breaking diquark parameter combinations. - 100 PAR2=PARJ(2) - PAR3=PARJ(3) - PAR4=3.*PARJ(4) - IF(MSTJ(12).GE.2) THEN - PAR3M=SQRT(PARJ(3)) - PAR4M=1./(3.*SQRT(PARJ(4))) - PARDM=PARJ(7)/(PARJ(7)+PAR3M*PARJ(6)) - PARS0=PARJ(5)*(2.+(1.+PAR2*PAR3M*PARJ(7))*(1.+PAR4M)) - PARS1=PARJ(7)*PARS0/(2.*PAR3M)+PARJ(5)*(PARJ(6)*(1.+PAR4M)+ - & PAR2*PAR3M*PARJ(6)*PARJ(7)) - PARS2=PARJ(5)*2.*PARJ(6)*PARJ(7)*(PAR2*PARJ(7)+(1.+PAR4M)/PAR3M) - PARSM=MAX(PARS0,PARS1,PARS2) - PAR4=PAR4*(1.+PARSM)/(1.+PARSM/(3.*PAR4M)) - ENDIF - -C...Choice of whether to generate meson or baryon. - 110 MBARY=0 - KFDA=0 - IF(KF1A.LE.10) THEN - IF(KF2A.EQ.0.AND.MSTJ(12).GE.1.AND.(1.+PARJ(1))*RLU(0).GT.1.) - & MBARY=1 - IF(KF2A.GT.10) MBARY=2 - IF(KF2A.GT.10.AND.KF2A.LE.10000) KFDA=KF2A - ELSE - MBARY=2 - IF(KF1A.LE.10000) KFDA=KF1A - ENDIF - -C...Possibility of process diquark -> meson + new diquark. - IF(KFDA.NE.0.AND.MSTJ(12).GE.2) THEN - KFLDA=MOD(KFDA/1000,10) - KFLDB=MOD(KFDA/100,10) - KFLDS=MOD(KFDA,10) - WTDQ=PARS0 - IF(MAX(KFLDA,KFLDB).EQ.3) WTDQ=PARS1 - IF(MIN(KFLDA,KFLDB).EQ.3) WTDQ=PARS2 - IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) - IF((1.+WTDQ)*RLU(0).GT.1.) MBARY=-1 - IF(MBARY.EQ.-1.AND.KF2A.NE.0) RETURN - ENDIF - -C...Flavour for meson, possibly with new flavour. - IF(MBARY.LE.0) THEN - KFS=ISIGN(1,KFL1) - IF(MBARY.EQ.0) THEN - IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),-KFL1) - KFLA=MAX(KF1A,KF2A+IABS(KFL3)) - KFLB=MIN(KF1A,KF2A+IABS(KFL3)) - IF(KFLA.NE.KF1A) KFS=-KFS - -C...Splitting of diquark into meson plus new diquark. - ELSE - KFL1A=MOD(KF1A/1000,10) - KFL1B=MOD(KF1A/100,10) - 120 KFL1D=KFL1A+INT(RLU(0)+0.5)*(KFL1B-KFL1A) - KFL1E=KFL1A+KFL1B-KFL1D - IF((KFL1D.EQ.3.AND.RLU(0).GT.PARDM).OR.(KFL1E.EQ.3.AND. - & RLU(0).LT.PARDM)) THEN - KFL1D=KFL1A+KFL1B-KFL1D - KFL1E=KFL1A+KFL1B-KFL1E - ENDIF - KFL3A=1+INT((2.+PAR2*PAR3M*PARJ(7))*RLU(0)) - IF((KFL1E.NE.KFL3A.AND.RLU(0).GT.(1.+PAR4M)/MAX(2.,1.+PAR4M)) - & .OR.(KFL1E.EQ.KFL3A.AND.RLU(0).GT.2./MAX(2.,1.+PAR4M))) - & GOTO 120 - KFLDS=3 - IF(KFL1E.NE.KFL3A) KFLDS=2*INT(RLU(0)+1./(1.+PAR4M))+1 - KFL3=ISIGN(10000+1000*MAX(KFL1E,KFL3A)+100*MIN(KFL1E,KFL3A)+ - & KFLDS,-KFL1) - KFLA=MAX(KFL1D,KFL3A) - KFLB=MIN(KFL1D,KFL3A) - IF(KFLA.NE.KFL1D) KFS=-KFS - ENDIF - -C...Form meson, with spin and flavour mixing for diagonal states. - IF(KFLA.LE.2) KMUL=INT(PARJ(11)+RLU(0)) - IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+RLU(0)) - IF(KFLA.GE.4) KMUL=INT(PARJ(13)+RLU(0)) - IF(KMUL.EQ.0.AND.PARJ(14).GT.0.) THEN - IF(RLU(0).LT.PARJ(14)) KMUL=2 - ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0.) THEN - RMUL=RLU(0) - IF(RMUL.LT.PARJ(15)) KMUL=3 - IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4 - IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5 - ENDIF - KFLS=3 - IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 - IF(KMUL.EQ.5) KFLS=5 - IF(KFLA.NE.KFLB) THEN - KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA - ELSE - RMIX=RLU(0) - IMIX=2*KFLA+10*KMUL - IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+ - & INT(RMIX+PARF(IMIX)))+KFLS - IF(KFLA.GE.4) KF=110*KFLA+KFLS - ENDIF - IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF) - IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF) - -C...Optional extra suppression of eta and eta'. - IF(KF.EQ.221) THEN - IF(RLU(0).GT.PARJ(25)) GOTO 110 - ELSEIF(KF.EQ.331) THEN - IF(RLU(0).GT.PARJ(26)) GOTO 110 - ENDIF - -C...Generate diquark flavour. - ELSE - 130 IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN - KFLA=KF1A - 140 KFLB=1+INT((2.+PAR2*PAR3)*RLU(0)) - KFLC=1+INT((2.+PAR2*PAR3)*RLU(0)) - KFLDS=1 - IF(KFLB.GE.KFLC) KFLDS=3 - IF(KFLDS.EQ.1.AND.PAR4*RLU(0).GT.1.) GOTO 140 - IF(KFLDS.EQ.3.AND.PAR4.LT.RLU(0)) GOTO 140 - KFL3=ISIGN(1000*MAX(KFLB,KFLC)+100*MIN(KFLB,KFLC)+KFLDS,KFL1) - -C...Take diquark flavour from input. - ELSEIF(KF1A.LE.10) THEN - KFLA=KF1A - KFLB=MOD(KF2A/1000,10) - KFLC=MOD(KF2A/100,10) - KFLDS=MOD(KF2A,10) - -C...Generate (or take from input) quark to go with diquark. - ELSE - IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),KFL1) - KFLA=KF2A+IABS(KFL3) - KFLB=MOD(KF1A/1000,10) - KFLC=MOD(KF1A/100,10) - KFLDS=MOD(KF1A,10) - ENDIF - -C...SU(6) factors for formation of baryon. Try again if fails. - KBARY=KFLDS - IF(KFLDS.EQ.3.AND.KFLB.NE.KFLC) KBARY=5 - IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC) KBARY=KBARY+1 - WT=PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY) - IF(MBARY.EQ.1.AND.MSTJ(12).GE.2) THEN - WTDQ=PARS0 - IF(MAX(KFLB,KFLC).EQ.3) WTDQ=PARS1 - IF(MIN(KFLB,KFLC).EQ.3) WTDQ=PARS2 - IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) - IF(KFLDS.EQ.1) WT=WT*(1.+WTDQ)/(1.+PARSM/(3.*PAR4M)) - IF(KFLDS.EQ.3) WT=WT*(1.+WTDQ)/(1.+PARSM) - ENDIF - IF(KF2A.EQ.0.AND.WT.LT.RLU(0)) GOTO 130 - -C...Form baryon. Distinguish Lambda- and Sigmalike baryons. - KFLD=MAX(KFLA,KFLB,KFLC) - KFLF=MIN(KFLA,KFLB,KFLC) - KFLE=KFLA+KFLB+KFLC-KFLD-KFLF - KFLS=2 - IF((PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY))*RLU(0).GT. - & PARF(60+KBARY)) KFLS=4 - KFLL=0 - IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF) THEN - IF(KFLDS.EQ.1.AND.KFLA.EQ.KFLD) KFLL=1 - IF(KFLDS.EQ.1.AND.KFLA.NE.KFLD) KFLL=INT(0.25+RLU(0)) - IF(KFLDS.EQ.3.AND.KFLA.NE.KFLD) KFLL=INT(0.75+RLU(0)) - ENDIF - IF(KFLL.EQ.0) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1) - IF(KFLL.EQ.1) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1) - ENDIF - RETURN - -C...Use tabulated probabilities to select new flavour and hadron. - 150 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN - KT3L=1 - KT3U=6 - ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN - KT3L=1 - KT3U=6 - ELSEIF(KTAB2.EQ.0) THEN - KT3L=1 - KT3U=22 - ELSE - KT3L=KTAB2 - KT3U=KTAB2 - ENDIF - RFL=0. - DO 170 KTS=0,2 - DO 160 KT3=KT3L,KT3U - RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3) - 160 CONTINUE - 170 CONTINUE - RFL=RLU(0)*RFL - DO 190 KTS=0,2 - KTABS=KTS - DO 180 KT3=KT3L,KT3U - KTAB3=KT3 - RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3) - IF(RFL.LE.0.) GOTO 200 - 180 CONTINUE - 190 CONTINUE - 200 CONTINUE - -C...Reconstruct flavour of produced quark/diquark. - IF(KTAB3.LE.6) THEN - KFL3A=KTAB3 - KFL3B=0 - KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13)) - ELSE - KFL3A=1 - IF(KTAB3.GE.8) KFL3A=2 - IF(KTAB3.GE.11) KFL3A=3 - IF(KTAB3.GE.16) KFL3A=4 - KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2 - KFL3=1000*KFL3A+100*KFL3B+1 - IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3= - & KFL3+2 - KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1)) - ENDIF - -C...Reconstruct meson code. - IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR. - &KFL3B.NE.0)) THEN - RFL=RLU(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ - & 25*KTABS)+PARF(145+80*KTAB1+25*KTABS)) - KF=110+2*KTABS+1 - IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1 - IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ - & 25*KTABS)) KF=330+2*KTABS+1 - ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN - KFLA=MAX(KTAB1,KTAB3) - KFLB=MIN(KTAB1,KTAB3) - KFS=ISIGN(1,KFL1) - IF(KFLA.NE.KF1A) KFS=-KFS - KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA - ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN - KFS=ISIGN(1,KFL1) - IF(KFL1A.EQ.KFL3A) THEN - KFLA=MAX(KFL1B,KFL3B) - KFLB=MIN(KFL1B,KFL3B) - IF(KFLA.NE.KFL1B) KFS=-KFS - ELSEIF(KFL1A.EQ.KFL3B) THEN - KFLA=KFL3A - KFLB=KFL1B - KFS=-KFS - ELSEIF(KFL1B.EQ.KFL3A) THEN - KFLA=KFL1A - KFLB=KFL3B - ELSEIF(KFL1B.EQ.KFL3B) THEN - KFLA=MAX(KFL1A,KFL3A) - KFLB=MIN(KFL1A,KFL3A) - IF(KFLA.NE.KFL1A) KFS=-KFS - ELSE - CALL LUERRM(2,'(LUKFDI:) no matching flavours for qq -> qq') - GOTO 100 - ENDIF - KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA - -C...Reconstruct baryon code. - ELSE - IF(KTAB1.GE.7) THEN - KFLA=KFL3A - KFLB=KFL1A - KFLC=KFL1B - ELSE - KFLA=KFL1A - KFLB=KFL3A - KFLC=KFL3B - ENDIF - KFLD=MAX(KFLA,KFLB,KFLC) - KFLF=MIN(KFLA,KFLB,KFLC) - KFLE=KFLA+KFLB+KFLC-KFLD-KFLF - IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1) - IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1) - ENDIF - -C...Check that constructed flavour code is an allowed one. - IF(KFL2.NE.0) KFL3=0 - KC=LUCOMP(KF) - IF(KC.EQ.0) THEN - CALL LUERRM(2,'(LUKFDI:) user-defined flavour probabilities '// - & 'failed') - GOTO 100 - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUPTDI(KFL,PX,PY) - -C...Purpose: to generate transverse momentum according to a Gaussian. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUDAT1/ - -C...Generate p_T and azimuthal angle, gives p_x and p_y. - KFLA=IABS(KFL) - PT=PARJ(21)*SQRT(-LOG(MAX(1E-10,RLU(0)))) - IF(PARJ(23).GT.RLU(0)) PT=PARJ(24)*PT - IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT - IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0. - PHI=PARU(2)*RLU(0) - PX=PT*COS(PHI) - PY=PT*SIN(PHI) - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUZDIS(KFL1,KFL2,PR,Z) - -C...Purpose: to generate the longitudinal splitting variable z. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUDAT1/,/LUDAT2/ - -C...Check if heavy flavour fragmentation. - KFLA=IABS(KFL1) - KFLB=IABS(KFL2) - KFLH=KFLA - IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10) - -C...Lund symmetric scaling function: determine parameters of shape. - IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3).OR. - &MSTJ(11).GE.4) THEN - FA=PARJ(41) - IF(MSTJ(91).EQ.1) FA=PARJ(43) - IF(KFLB.GE.10) FA=FA+PARJ(45) - FBB=PARJ(42) - IF(MSTJ(91).EQ.1) FBB=PARJ(44) - FB=FBB*PR - FC=1. - IF(KFLA.GE.10) FC=FC-PARJ(45) - IF(KFLB.GE.10) FC=FC+PARJ(45) - IF(MSTJ(11).GE.4.AND.KFLH.GE.4.AND.KFLH.LE.5) THEN - FRED=PARJ(46) - IF(MSTJ(11).EQ.5.AND.KFLH.EQ.5) FRED=PARJ(47) - FC=FC+FRED*FBB*PARF(100+KFLH)**2 - ELSEIF(MSTJ(11).GE.4.AND.KFLH.GE.6.AND.KFLH.LE.8) THEN - FRED=PARJ(46) - IF(MSTJ(11).EQ.5) FRED=PARJ(48) - FC=FC+FRED*FBB*PMAS(KFLH,1)**2 - ENDIF - MC=1 - IF(ABS(FC-1.).GT.0.01) MC=2 - -C...Determine position of maximum. Special cases for a = 0 or a = c. - IF(FA.LT.0.02) THEN - MA=1 - ZMAX=1. - IF(FC.GT.FB) ZMAX=FB/FC - ELSEIF(ABS(FC-FA).LT.0.01) THEN - MA=2 - ZMAX=FB/(FB+FC) - ELSE - MA=3 - ZMAX=0.5*(FB+FC-SQRT((FB-FC)**2+4.*FA*FB))/(FC-FA) - IF(ZMAX.GT.0.9999.AND.FB.GT.100.) ZMAX=MIN(ZMAX,1.-FA/FB) - ENDIF - -C...Subdivide z range if distribution very peaked near endpoint. - MMAX=2 - IF(ZMAX.LT.0.1) THEN - MMAX=1 - ZDIV=2.75*ZMAX - IF(MC.EQ.1) THEN - FINT=1.-LOG(ZDIV) - ELSE - ZDIVC=ZDIV**(1.-FC) - FINT=1.+(1.-1./ZDIVC)/(FC-1.) - ENDIF - ELSEIF(ZMAX.GT.0.85.AND.FB.GT.1.) THEN - MMAX=3 - FSCB=SQRT(4.+(FC/FB)**2) - ZDIV=FSCB-1./ZMAX-(FC/FB)*LOG(ZMAX*0.5*(FSCB+FC/FB)) - IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1.-ZMAX) - ZDIV=MIN(ZMAX,MAX(0.,ZDIV)) - FINT=1.+FB*(1.-ZDIV) - ENDIF - -C...Choice of z, preweighted for peaks at low or high z. - 100 Z=RLU(0) - FPRE=1. - IF(MMAX.EQ.1) THEN - IF(FINT*RLU(0).LE.1.) THEN - Z=ZDIV*Z - ELSEIF(MC.EQ.1) THEN - Z=ZDIV**Z - FPRE=ZDIV/Z - ELSE - Z=(ZDIVC+Z*(1.-ZDIVC))**(1./(1.-FC)) - FPRE=(ZDIV/Z)**FC - ENDIF - ELSEIF(MMAX.EQ.3) THEN - IF(FINT*RLU(0).LE.1.) THEN - Z=ZDIV+LOG(Z)/FB - FPRE=EXP(FB*(Z-ZDIV)) - ELSE - Z=ZDIV+Z*(1.-ZDIV) - ENDIF - ENDIF - -C...Weighting according to correct formula. - IF(Z.LE.0..OR.Z.GE.1.) GOTO 100 - FEXP=FC*LOG(ZMAX/Z)+FB*(1./ZMAX-1./Z) - IF(MA.GE.2) FEXP=FEXP+FA*LOG((1.-Z)/(1.-ZMAX)) - FVAL=EXP(MAX(-50.,MIN(50.,FEXP))) - IF(FVAL.LT.RLU(0)*FPRE) GOTO 100 - -C...Generate z according to Field-Feynman, SLAC, (1-z)**c OR z**c. - ELSE - FC=PARJ(50+MAX(1,KFLH)) - IF(MSTJ(91).EQ.1) FC=PARJ(59) - 110 Z=RLU(0) - IF(FC.GE.0..AND.FC.LE.1.) THEN - IF(FC.GT.RLU(0)) Z=1.-Z**(1./3.) - ELSEIF(FC.GT.-1.AND.FC.LT.0.) THEN - IF(-4.*FC*Z*(1.-Z)**2.LT.RLU(0)*((1.-Z)**2-FC*Z)**2) GOTO 110 - ELSE - IF(FC.GT.0.) Z=1.-Z**(1./FC) - IF(FC.LT.0.) Z=Z**(-1./FC) - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUSHOW(IP1,IP2,QMAX) - -C...Purpose: to generate timelike parton showers from given partons. - IMPLICIT DOUBLE PRECISION(D) - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - DIMENSION PMTH(5,50),PS(5),PMA(4),PMSD(4),IEP(4),IPA(4), - &KFLA(4),KFLD(4),KFL(4),ITRY(4),ISI(4),ISL(4),DP(4),DPT(5,4), - &KSH(0:40),KCII(2),NIIS(2),IIIS(2,2),THEIIS(2,2),PHIIIS(2,2), - &ISII(2) - -C...Initialization of cutoff masses etc. - IF(MSTJ(41).LE.0.OR.(MSTJ(41).EQ.1.AND.QMAX.LE.PARJ(82)).OR. - &QMAX.LE.MIN(PARJ(82),PARJ(83))) RETURN - DO 100 IFL=0,40 - KSH(IFL)=0 - 100 CONTINUE - KSH(21)=1 - PMTH(1,21)=ULMASS(21) - PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25*PARJ(82)**2) - PMTH(3,21)=2.*PMTH(2,21) - PMTH(4,21)=PMTH(3,21) - PMTH(5,21)=PMTH(3,21) - PMTH(1,22)=ULMASS(22) - PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25*PARJ(83)**2) - PMTH(3,22)=2.*PMTH(2,22) - PMTH(4,22)=PMTH(3,22) - PMTH(5,22)=PMTH(3,22) - PMQTH1=PARJ(82) - IF(MSTJ(41).GE.2) PMQTH1=MIN(PARJ(82),PARJ(83)) - PMQTH2=PMTH(2,21) - IF(MSTJ(41).GE.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22)) - DO 110 IFL=1,8 - KSH(IFL)=1 - PMTH(1,IFL)=ULMASS(IFL) - PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PMQTH1**2) - PMTH(3,IFL)=PMTH(2,IFL)+PMQTH2 - PMTH(4,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(82)**2)+PMTH(2,21) - PMTH(5,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(83)**2)+PMTH(2,22) - 110 CONTINUE - DO 120 IFL=11,17,2 - IF(MSTJ(41).GE.2) KSH(IFL)=1 - PMTH(1,IFL)=ULMASS(IFL) - PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(83)**2) - PMTH(3,IFL)=PMTH(2,IFL)+PMTH(2,22) - PMTH(4,IFL)=PMTH(3,IFL) - PMTH(5,IFL)=PMTH(3,IFL) - 120 CONTINUE - PT2MIN=MAX(0.5*PARJ(82),1.1*PARJ(81))**2 - ALAMS=PARJ(81)**2 - ALFM=LOG(PT2MIN/ALAMS) - -C...Store positions of shower initiating partons. - IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN - NPA=1 - IPA(1)=IP1 - ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)- - &MSTU(32))) THEN - NPA=2 - IPA(1)=IP1 - IPA(2)=IP2 - ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0 - &.AND.IP2.GE.-3) THEN - NPA=IABS(IP2) - DO 130 I=1,NPA - IPA(I)=IP1+I-1 - 130 CONTINUE - ELSE - CALL LUERRM(12, - & '(LUSHOW:) failed to reconstruct showering system') - IF(MSTU(21).GE.1) RETURN - ENDIF - -C...Check on phase space available for emission. - IREJ=0 - DO 140 J=1,5 - PS(J)=0. - 140 CONTINUE - PM=0. - DO 160 I=1,NPA - KFLA(I)=IABS(K(IPA(I),2)) - PMA(I)=P(IPA(I),5) -C...Special cutoff masses for t, l, h with variable masses. - IFLA=KFLA(I) - IF(KFLA(I).GE.6.AND.KFLA(I).LE.8) THEN - IFLA=37+KFLA(I)+ISIGN(2,K(IPA(I),2)) - PMTH(1,IFLA)=PMA(I) - PMTH(2,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PMQTH1**2) - PMTH(3,IFLA)=PMTH(2,IFLA)+PMQTH2 - PMTH(4,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PARJ(82)**2)+PMTH(2,21) - PMTH(5,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PARJ(83)**2)+PMTH(2,22) - ENDIF - IF(KFLA(I).LE.40) THEN - IF(KSH(KFLA(I)).EQ.1) PMA(I)=PMTH(3,IFLA) - ENDIF - PM=PM+PMA(I) - IF(KFLA(I).GT.40) THEN - IREJ=IREJ+1 - ELSE - IF(KSH(KFLA(I)).EQ.0.OR.PMA(I).GT.QMAX) IREJ=IREJ+1 - ENDIF - DO 150 J=1,4 - PS(J)=PS(J)+P(IPA(I),J) - 150 CONTINUE - 160 CONTINUE - IF(IREJ.EQ.NPA) RETURN - PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2)) - IF(NPA.EQ.1) PS(5)=PS(4) - IF(PS(5).LE.PM+PMQTH1) RETURN - -C...Check if 3-jet matrix elements to be used. - M3JC=0 - IF(NPA.EQ.2.AND.MSTJ(47).GE.1) THEN - IF(KFLA(1).GE.1.AND.KFLA(1).LE.8.AND.KFLA(2).GE.1.AND. - & KFLA(2).LE.8) M3JC=1 - IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR. - & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)) M3JC=1 - IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR. - & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)+1) M3JC=1 - IF((KFLA(1).EQ.12.OR.KFLA(1).EQ.14.OR.KFLA(1).EQ.16.OR. - & KFLA(1).EQ.18).AND.KFLA(2).EQ.KFLA(1)-1) M3JC=1 - IF(MSTJ(47).EQ.2.OR.MSTJ(47).EQ.4) M3JC=1 - M3JCM=0 - IF(M3JC.EQ.1.AND.MSTJ(47).GE.3.AND.KFLA(1).EQ.KFLA(2)) THEN - M3JCM=1 - QME=(2.*PMTH(1,KFLA(1))/PS(5))**2 - ENDIF - ENDIF - -C...Find if interference with initial state partons. - MIIS=0 - IF(MSTJ(50).GE.1.AND.MSTJ(50).LE.3.AND.NPA.EQ.2) MIIS=MSTJ(50) - IF(MIIS.NE.0) THEN - DO 180 I=1,2 - KCII(I)=0 - KCA=LUCOMP(KFLA(I)) - IF(KCA.NE.0) KCII(I)=KCHG(KCA,2)*ISIGN(1,K(IPA(I),2)) - NIIS(I)=0 - IF(KCII(I).NE.0) THEN - DO 170 J=1,2 - ICSI=MOD(K(IPA(I),3+J)/MSTU(5),MSTU(5)) - IF(ICSI.GT.0.AND.ICSI.NE.IPA(1).AND.ICSI.NE.IPA(2).AND. - & (KCII(I).EQ.(-1)**(J+1).OR.KCII(I).EQ.2)) THEN - NIIS(I)=NIIS(I)+1 - IIIS(I,NIIS(I))=ICSI - ENDIF - 170 CONTINUE - ENDIF - 180 CONTINUE - IF(NIIS(1)+NIIS(2).EQ.0) MIIS=0 - ENDIF - -C...Boost interfering initial partons to rest frame -C...and reconstruct their polar and azimuthal angles. - IF(MIIS.NE.0) THEN - DO 200 I=1,2 - DO 190 J=1,5 - K(N+I,J)=K(IPA(I),J) - P(N+I,J)=P(IPA(I),J) - V(N+I,J)=0. - 190 CONTINUE - 200 CONTINUE - DO 220 I=3,2+NIIS(1) - DO 210 J=1,5 - K(N+I,J)=K(IIIS(1,I-2),J) - P(N+I,J)=P(IIIS(1,I-2),J) - V(N+I,J)=0. - 210 CONTINUE - 220 CONTINUE - DO 240 I=3+NIIS(1),2+NIIS(1)+NIIS(2) - DO 230 J=1,5 - K(N+I,J)=K(IIIS(2,I-2-NIIS(1)),J) - P(N+I,J)=P(IIIS(2,I-2-NIIS(1)),J) - V(N+I,J)=0. - 230 CONTINUE - 240 CONTINUE - CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),0.,0.,-DBLE(PS(1)/PS(4)), - & -DBLE(PS(2)/PS(4)),-DBLE(PS(3)/PS(4))) - PHI=ULANGL(P(N+1,1),P(N+1,2)) - CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),0.,-PHI,0D0,0D0,0D0) - THE=ULANGL(P(N+1,3),P(N+1,1)) - CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),-THE,0.,0D0,0D0,0D0) - DO 250 I=3,2+NIIS(1) - THEIIS(1,I-2)=ULANGL(P(N+I,3),SQRT(P(N+I,1)**2+P(N+I,2)**2)) - PHIIIS(1,I-2)=ULANGL(P(N+I,1),P(N+I,2)) - 250 CONTINUE - DO 260 I=3+NIIS(1),2+NIIS(1)+NIIS(2) - THEIIS(2,I-2-NIIS(1))=PARU(1)-ULANGL(P(N+I,3), - & SQRT(P(N+I,1)**2+P(N+I,2)**2)) - PHIIIS(2,I-2-NIIS(1))=ULANGL(P(N+I,1),P(N+I,2)) - 260 CONTINUE - ENDIF - -C...Define imagined single initiator of shower for parton system. - NS=N - IF(N.GT.MSTU(4)-MSTU(32)-5) THEN - CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(NPA.GE.2) THEN - K(N+1,1)=11 - K(N+1,2)=21 - K(N+1,3)=0 - K(N+1,4)=0 - K(N+1,5)=0 - P(N+1,1)=0. - P(N+1,2)=0. - P(N+1,3)=0. - P(N+1,4)=PS(5) - P(N+1,5)=PS(5) - V(N+1,5)=PS(5)**2 - N=N+1 - ENDIF - -C...Loop over partons that may branch. - NEP=NPA - IM=NS - IF(NPA.EQ.1) IM=NS-1 - 270 IM=IM+1 - IF(N.GT.NS) THEN - IF(IM.GT.N) GOTO 510 - KFLM=IABS(K(IM,2)) - IF(KFLM.GT.40) GOTO 270 - IF(KSH(KFLM).EQ.0) GOTO 270 - IFLM=KFLM - IF(KFLM.GE.6.AND.KFLM.LE.8) IFLM=37+KFLM+ISIGN(2,K(IM,2)) - IF(P(IM,5).LT.PMTH(2,IFLM)) GOTO 270 - IGM=K(IM,3) - ELSE - IGM=-1 - ENDIF - IF(N+NEP.GT.MSTU(4)-MSTU(32)-5) THEN - CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - -C...Position of aunt (sister to branching parton). -C...Origin and flavour of daughters. - IAU=0 - IF(IGM.GT.0) THEN - IF(K(IM-1,3).EQ.IGM) IAU=IM-1 - IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1 - ENDIF - IF(IGM.GE.0) THEN - K(IM,4)=N+1 - DO 280 I=1,NEP - K(N+I,3)=IM - 280 CONTINUE - ELSE - K(N+1,3)=IPA(1) - ENDIF - IF(IGM.LE.0) THEN - DO 290 I=1,NEP - K(N+I,2)=K(IPA(I),2) - 290 CONTINUE - ELSEIF(KFLM.NE.21) THEN - K(N+1,2)=K(IM,2) - K(N+2,2)=K(IM,5) - ELSEIF(K(IM,5).EQ.21) THEN - K(N+1,2)=21 - K(N+2,2)=21 - ELSE - K(N+1,2)=K(IM,5) - K(N+2,2)=-K(IM,5) - ENDIF - -C...Reset flags on daughers and tries made. - DO 300 IP=1,NEP - K(N+IP,1)=3 - K(N+IP,4)=0 - K(N+IP,5)=0 - KFLD(IP)=IABS(K(N+IP,2)) - IF(KCHG(LUCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1 - ITRY(IP)=0 - ISL(IP)=0 - ISI(IP)=0 - IF(KFLD(IP).LE.40) THEN - IF(KSH(KFLD(IP)).EQ.1) ISI(IP)=1 - ENDIF - 300 CONTINUE - ISLM=0 - -C...Maximum virtuality of daughters. - IF(IGM.LE.0) THEN - DO 310 I=1,NPA - IF(NPA.GE.3) P(N+I,4)=(PS(4)*P(IPA(I),4)-PS(1)*P(IPA(I),1)- - & PS(2)*P(IPA(I),2)-PS(3)*P(IPA(I),3))/PS(5) - P(N+I,5)=MIN(QMAX,PS(5)) - IF(NPA.GE.3) P(N+I,5)=MIN(P(N+I,5),P(N+I,4)) - IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5) - 310 CONTINUE - ELSE - IF(MSTJ(43).LE.2) PEM=V(IM,2) - IF(MSTJ(43).GE.3) PEM=P(IM,4) - P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM) - P(N+2,5)=MIN(P(IM,5),(1.-V(IM,1))*PEM) - IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22) - ENDIF - DO 320 I=1,NEP - PMSD(I)=P(N+I,5) - IF(ISI(I).EQ.1) THEN - IFLD=KFLD(I) - IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ - & ISIGN(2,K(N+I,2)) - IF(P(N+I,5).LE.PMTH(3,IFLD)) P(N+I,5)=PMTH(1,IFLD) - ENDIF - V(N+I,5)=P(N+I,5)**2 - 320 CONTINUE - -C...Choose one of the daughters for evolution. - 330 INUM=0 - IF(NEP.EQ.1) INUM=1 - DO 340 I=1,NEP - IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I - 340 CONTINUE - DO 350 I=1,NEP - IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN - IFLD=KFLD(I) - IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ - & ISIGN(2,K(N+I,2)) - IF(P(N+I,5).GE.PMTH(2,IFLD)) INUM=I - ENDIF - 350 CONTINUE - IF(INUM.EQ.0) THEN - RMAX=0. - DO 360 I=1,NEP - IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN - RPM=P(N+I,5)/PMSD(I) - IFLD=KFLD(I) - IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ - & ISIGN(2,K(N+I,2)) - IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,IFLD)) THEN - RMAX=RPM - INUM=I - ENDIF - ENDIF - 360 CONTINUE - ENDIF - -C...Store information on choice of evolving daughter. - INUM=MAX(1,INUM) - IEP(1)=N+INUM - DO 370 I=2,NEP - IEP(I)=IEP(I-1)+1 - IF(IEP(I).GT.N+NEP) IEP(I)=N+1 - 370 CONTINUE - DO 380 I=1,NEP - KFL(I)=IABS(K(IEP(I),2)) - 380 CONTINUE - ITRY(INUM)=ITRY(INUM)+1 - IF(ITRY(INUM).GT.200) THEN - CALL LUERRM(14,'(LUSHOW:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - Z=0.5 - IF(KFL(1).GT.40) GOTO 430 - IF(KSH(KFL(1)).EQ.0) GOTO 430 - IFL=KFL(1) - IF(KFL(1).GE.6.AND.KFL(1).LE.8) IFL=37+KFL(1)+ - &ISIGN(2,K(IEP(1),2)) - IF(P(IEP(1),5).LT.PMTH(2,IFL)) GOTO 430 - -C...Select side for interference with initial state partons. - IF(MIIS.GE.1.AND.IEP(1).LE.NS+3) THEN - III=IEP(1)-NS-1 - ISII(III)=0 - IF(IABS(KCII(III)).EQ.1.AND.NIIS(III).EQ.1) THEN - ISII(III)=1 - ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.1) THEN - IF(RLU(0).GT.0.5) ISII(III)=1 - ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.2) THEN - ISII(III)=1 - IF(RLU(0).GT.0.5) ISII(III)=2 - ENDIF - ENDIF - -C...Calculate allowed z range. - IF(NEP.EQ.1) THEN - PMED=PS(4) - ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN - PMED=P(IM,5) - ELSE - IF(INUM.EQ.1) PMED=V(IM,1)*PEM - IF(INUM.EQ.2) PMED=(1.-V(IM,1))*PEM - ENDIF - IF(MOD(MSTJ(43),2).EQ.1) THEN - ZC=PMTH(2,21)/PMED - ZCE=PMTH(2,22)/PMED - ELSE - ZC=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,21)/PMED)**2))) - IF(ZC.LT.1E-4) ZC=(PMTH(2,21)/PMED)**2 - ZCE=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,22)/PMED)**2))) - IF(ZCE.LT.1E-4) ZCE=(PMTH(2,22)/PMED)**2 - ENDIF - ZC=MIN(ZC,0.491) - ZCE=MIN(ZCE,0.491) - IF((MSTJ(41).EQ.1.AND.ZC.GT.0.49).OR.(MSTJ(41).GE.2.AND. - &MIN(ZC,ZCE).GT.0.49)) THEN - P(IEP(1),5)=PMTH(1,IFL) - V(IEP(1),5)=P(IEP(1),5)**2 - GOTO 430 - ENDIF - -C...Integral of Altarelli-Parisi z kernel for QCD. - IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN - FBR=6.*LOG((1.-ZC)/ZC)+MSTJ(45)*(0.5-ZC) - ELSEIF(MSTJ(49).EQ.0) THEN - FBR=(8./3.)*LOG((1.-ZC)/ZC) - -C...Integral of Altarelli-Parisi z kernel for scalar gluon. - ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN - FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1.-2.*ZC) - ELSEIF(MSTJ(49).EQ.1) THEN - FBR=(1.-2.*ZC)/3. - IF(IGM.EQ.0.AND.M3JC.EQ.1) FBR=4.*FBR - -C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon. - ELSEIF(KFL(1).EQ.21) THEN - FBR=6.*MSTJ(45)*(0.5-ZC) - ELSE - FBR=2.*LOG((1.-ZC)/ZC) - ENDIF - -C...Reset QCD probability for lepton. - IF(KFL(1).GE.11.AND.KFL(1).LE.18) FBR=0. - -C...Integral of Altarelli-Parisi kernel for photon emission. - IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN - FBRE=(KCHG(KFL(1),1)/3.)**2*2.*LOG((1.-ZCE)/ZCE) - IF(MSTJ(41).EQ.10) FBRE=PARJ(84)*FBRE - ENDIF - -C...Inner veto algorithm starts. Find maximum mass for evolution. - 390 PMS=V(IEP(1),5) - IF(IGM.GE.0) THEN - PM2=0. - DO 400 I=2,NEP - PM=P(IEP(I),5) - IF(KFL(I).LE.40) THEN - IFLI=KFL(I) - IF(KFL(I).GE.6.AND.KFL(I).LE.8) IFLI=37+KFL(I)+ - & ISIGN(2,K(IEP(I),2)) - IF(KSH(KFL(I)).EQ.1) PM=PMTH(2,IFLI) - ENDIF - PM2=PM2+PM - 400 CONTINUE - PMS=MIN(PMS,(P(IM,5)-PM2)**2) - ENDIF - -C...Select mass for daughter in QCD evolution. - B0=27./6. - DO 410 IFF=4,MSTJ(45) - IF(PMS.GT.4.*PMTH(2,IFF)**2) B0=(33.-2.*IFF)/6. - 410 CONTINUE - IF(FBR.LT.1E-3) THEN - PMSQCD=0. - ELSEIF(MSTJ(44).LE.0) THEN - PMSQCD=PMS*EXP(MAX(-50.,LOG(RLU(0))*PARU(2)/(PARU(111)*FBR))) - ELSEIF(MSTJ(44).EQ.1) THEN - PMSQCD=4.*ALAMS*(0.25*PMS/ALAMS)**(RLU(0)**(B0/FBR)) - ELSE - PMSQCD=PMS*EXP(MAX(-50.,ALFM*B0*LOG(RLU(0))/FBR)) - ENDIF - IF(ZC.GT.0.49.OR.PMSQCD.LE.PMTH(4,IFL)**2) PMSQCD=PMTH(2,IFL)**2 - V(IEP(1),5)=PMSQCD - MCE=1 - -C...Select mass for daughter in QED evolution. - IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN - PMSQED=PMS*EXP(MAX(-50.,LOG(RLU(0))*PARU(2)/(PARU(101)*FBRE))) - IF(ZCE.GT.0.49.OR.PMSQED.LE.PMTH(5,IFL)**2) PMSQED= - & PMTH(2,IFL)**2 - IF(PMSQED.GT.PMSQCD) THEN - V(IEP(1),5)=PMSQED - MCE=2 - ENDIF - ENDIF - -C...Check whether daughter mass below cutoff. - P(IEP(1),5)=SQRT(V(IEP(1),5)) - IF(P(IEP(1),5).LE.PMTH(3,IFL)) THEN - P(IEP(1),5)=PMTH(1,IFL) - V(IEP(1),5)=P(IEP(1),5)**2 - GOTO 430 - ENDIF - -C...Select z value of branching: q -> qgamma. - IF(MCE.EQ.2) THEN - Z=1.-(1.-ZCE)*(ZCE/(1.-ZCE))**RLU(0) - IF(1.+Z**2.LT.2.*RLU(0)) GOTO 390 - K(IEP(1),5)=22 - -C...Select z value of branching: q -> qg, g -> gg, g -> qqbar. - ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN - Z=1.-(1.-ZC)*(ZC/(1.-ZC))**RLU(0) - IF(1.+Z**2.LT.2.*RLU(0)) GOTO 390 - K(IEP(1),5)=21 - ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*(0.5-ZC).LT.RLU(0)*FBR) THEN - Z=(1.-ZC)*(ZC/(1.-ZC))**RLU(0) - IF(RLU(0).GT.0.5) Z=1.-Z - IF((1.-Z*(1.-Z))**2.LT.RLU(0)) GOTO 390 - K(IEP(1),5)=21 - ELSEIF(MSTJ(49).NE.1) THEN - Z=ZC+(1.-2.*ZC)*RLU(0) - IF(Z**2+(1.-Z)**2.LT.RLU(0)) GOTO 390 - KFLB=1+INT(MSTJ(45)*RLU(0)) - PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) - IF(PMQ.GE.1.) GOTO 390 - PMQ0=4.*PMTH(2,21)**2/V(IEP(1),5) - IF(MOD(MSTJ(43),2).EQ.0.AND.(1.+0.5*PMQ)*SQRT(1.-PMQ).LT. - & RLU(0)*(1.+0.5*PMQ0)*SQRT(1.-PMQ0)) GOTO 390 - K(IEP(1),5)=KFLB - -C...Ditto for scalar gluon model. - ELSEIF(KFL(1).NE.21) THEN - Z=1.-SQRT(ZC**2+RLU(0)*(1.-2.*ZC)) - K(IEP(1),5)=21 - ELSEIF(RLU(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN - Z=ZC+(1.-2.*ZC)*RLU(0) - K(IEP(1),5)=21 - ELSE - Z=ZC+(1.-2.*ZC)*RLU(0) - KFLB=1+INT(MSTJ(45)*RLU(0)) - PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) - IF(PMQ.GE.1.) GOTO 390 - K(IEP(1),5)=KFLB - ENDIF - IF(MCE.EQ.1.AND.MSTJ(44).GE.2) THEN - IF(Z*(1.-Z)*V(IEP(1),5).LT.PT2MIN) GOTO 390 - IF(ALFM/LOG(V(IEP(1),5)*Z*(1.-Z)/ALAMS).LT.RLU(0)) GOTO 390 - ENDIF - -C...Check if z consistent with chosen m. - IF(KFL(1).EQ.21) THEN - KFLGD1=IABS(K(IEP(1),5)) - KFLGD2=KFLGD1 - ELSE - KFLGD1=KFL(1) - KFLGD2=IABS(K(IEP(1),5)) - ENDIF - IF(NEP.EQ.1) THEN - PED=PS(4) - ELSEIF(NEP.GE.3) THEN - PED=P(IEP(1),4) - ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN - PED=0.5*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5) - ELSE - IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM - IF(IEP(1).EQ.N+2) PED=(1.-V(IM,1))*PEM - ENDIF - IF(MOD(MSTJ(43),2).EQ.1) THEN - IFLGD1=KFLGD1 - IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFL - PMQTH3=0.5*PARJ(82) - IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) - PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(IEP(1),5) - PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(IEP(1),5) - ZD=SQRT(MAX(0.,(1.-V(IEP(1),5)/PED**2)*((1.-PMQ1-PMQ2)**2- - & 4.*PMQ1*PMQ2))) - ZH=1.+PMQ1-PMQ2 - ELSE - ZD=SQRT(MAX(0.,1.-V(IEP(1),5)/PED**2)) - ZH=1. - ENDIF - ZL=0.5*(ZH-ZD) - ZU=0.5*(ZH+ZD) - IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 390 - IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL* - &(1.-ZU))) - IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1.-ZL)/MAX(1E-10,1.-ZU)) - -C...Width suppression for q -> q + g. - IF(MSTJ(40).NE.0.AND.KFL(1).NE.21) THEN - IF(IGM.EQ.0) THEN - EGLU=0.5*PS(5)*(1.-Z)*(1.+V(IEP(1),5)/V(NS+1,5)) - ELSE - EGLU=PMED*(1.-Z) - ENDIF - CHI=PARJ(89)**2/(PARJ(89)**2+EGLU**2) - IF(MSTJ(40).EQ.1) THEN - IF(CHI.LT.RLU(0)) GOTO 390 - ELSEIF(MSTJ(40).EQ.2) THEN - IF(1.-CHI.LT.RLU(0)) GOTO 390 - ENDIF - ENDIF - -C...Three-jet matrix element correction. - IF(IGM.EQ.0.AND.M3JC.EQ.1) THEN - X1=Z*(1.+V(IEP(1),5)/V(NS+1,5)) - X2=1.-V(IEP(1),5)/V(NS+1,5) - X3=(1.-X1)+(1.-X2) - IF(MCE.EQ.2) THEN - KI1=K(IPA(INUM),2) - KI2=K(IPA(3-INUM),2) - QF1=KCHG(IABS(KI1),1)*ISIGN(1,KI1)/3. - QF2=KCHG(IABS(KI2),1)*ISIGN(1,KI2)/3. - WSHOW=QF1**2*(1.-X1)/X3*(1.+(X1/(2.-X2))**2)+ - & QF2**2*(1.-X2)/X3*(1.+(X2/(2.-X1))**2) - WME=(QF1*(1.-X1)/X3-QF2*(1.-X2)/X3)**2*(X1**2+X2**2) - ELSEIF(MSTJ(49).NE.1) THEN - WSHOW=1.+(1.-X1)/X3*(X1/(2.-X2))**2+ - & (1.-X2)/X3*(X2/(2.-X1))**2 - WME=X1**2+X2**2 - IF(M3JCM.EQ.1) WME=WME-QME*X3-0.5*QME**2- - & (0.5*QME+0.25*QME**2)*((1.-X2)/MAX(1E-7,1.-X1)+ - & (1.-X1)/MAX(1E-7,1.-X2)) - ELSE - WSHOW=4.*X3*((1.-X1)/(2.-X2)**2+(1.-X2)/(2.-X1)**2) - WME=X3**2 - IF(MSTJ(102).GE.2) WME=X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)* - & PARJ(171) - ENDIF - IF(WME.LT.RLU(0)*WSHOW) GOTO 390 - -C...Impose angular ordering by rejection of nonordered emission. - ELSEIF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2) THEN - MAOM=1 - ZM=V(IM,1) - IF(IEP(1).EQ.N+2) ZM=1.-V(IM,1) - THE2ID=Z*(1.-Z)*(ZM*P(IM,4))**2/V(IEP(1),5) - IAOM=IM - 420 IF(K(IAOM,5).EQ.22) THEN - IAOM=K(IAOM,3) - IF(K(IAOM,3).LE.NS) MAOM=0 - IF(MAOM.EQ.1) GOTO 420 - ENDIF - IF(MAOM.EQ.1) THEN - THE2IM=V(IAOM,1)*(1.-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5) - IF(THE2ID.LT.THE2IM) GOTO 390 - ENDIF - ENDIF - -C...Impose user-defined maximum angle at first branching. - IF(MSTJ(48).EQ.1) THEN - IF(NEP.EQ.1.AND.IM.EQ.NS) THEN - THE2ID=Z*(1.-Z)*PS(4)**2/V(IEP(1),5) - IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390 - ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN - THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) - IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390 - ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN - THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) - IF(THE2ID.LT.1./PARJ(86)**2) GOTO 390 - ENDIF - ENDIF - -C...Impose angular constraint in first branching from interference -C...with initial state partons. - IF(MIIS.GE.2.AND.IEP(1).LE.NS+3) THEN - THE2D=MAX((1.-Z)/Z,Z/(1.-Z))*V(IEP(1),5)/(0.5*P(IM,4))**2 - IF(IEP(1).EQ.NS+2.AND.ISII(1).GE.1) THEN - IF(THE2D.GT.THEIIS(1,ISII(1))**2) GOTO 390 - ELSEIF(IEP(1).EQ.NS+3.AND.ISII(2).GE.1) THEN - IF(THE2D.GT.THEIIS(2,ISII(2))**2) GOTO 390 - ENDIF - ENDIF - -C...End of inner veto algorithm. Check if only one leg evolved so far. - 430 V(IEP(1),1)=Z - ISL(1)=0 - ISL(2)=0 - IF(NEP.EQ.1) GOTO 460 - IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 330 - DO 440 I=1,NEP - IF(ITRY(I).EQ.0.AND.KFLD(I).LE.40) THEN - IF(KSH(KFLD(I)).EQ.1) THEN - IFLD=KFLD(I) - IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ - & ISIGN(2,K(N+I,2)) - IF(P(N+I,5).GE.PMTH(2,IFLD)) GOTO 330 - ENDIF - ENDIF - 440 CONTINUE - -C...Check if chosen multiplet m1,m2,z1,z2 is physical. - IF(NEP.EQ.3) THEN - PA1S=(P(N+1,4)+P(N+1,5))*(P(N+1,4)-P(N+1,5)) - PA2S=(P(N+2,4)+P(N+2,5))*(P(N+2,4)-P(N+2,5)) - PA3S=(P(N+3,4)+P(N+3,5))*(P(N+3,4)-P(N+3,5)) - PTS=0.25*(2.*PA1S*PA2S+2.*PA1S*PA3S+2.*PA2S*PA3S- - & PA1S**2-PA2S**2-PA3S**2)/PA1S - IF(PTS.LE.0.) GOTO 330 - ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN - DO 450 I1=N+1,N+2 - KFLDA=IABS(K(I1,2)) - IF(KFLDA.GT.40) GOTO 450 - IF(KSH(KFLDA).EQ.0) GOTO 450 - IFLDA=KFLDA - IF(KFLDA.GE.6.AND.KFLDA.LE.8) IFLDA=37+KFLDA+ - & ISIGN(2,K(I1,2)) - IF(P(I1,5).LT.PMTH(2,IFLDA)) GOTO 450 - IF(KFLDA.EQ.21) THEN - KFLGD1=IABS(K(I1,5)) - KFLGD2=KFLGD1 - ELSE - KFLGD1=KFLDA - KFLGD2=IABS(K(I1,5)) - ENDIF - I2=2*N+3-I1 - IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN - PED=0.5*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5) - ELSE - IF(I1.EQ.N+1) ZM=V(IM,1) - IF(I1.EQ.N+2) ZM=1.-V(IM,1) - PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2- - & 4.*V(N+1,5)*V(N+2,5)) - PED=PEM*(0.5*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/V(IM,5) - ENDIF - IF(MOD(MSTJ(43),2).EQ.1) THEN - PMQTH3=0.5*PARJ(82) - IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) - IFLGD1=KFLGD1 - IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFLDA - PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(I1,5) - PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(I1,5) - ZD=SQRT(MAX(0.,(1.-V(I1,5)/PED**2)*((1.-PMQ1-PMQ2)**2- - & 4.*PMQ1*PMQ2))) - ZH=1.+PMQ1-PMQ2 - ELSE - ZD=SQRT(MAX(0.,1.-V(I1,5)/PED**2)) - ZH=1. - ENDIF - ZL=0.5*(ZH-ZD) - ZU=0.5*(ZH+ZD) - IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(1)=1 - IF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(2)=1 - IF(KFLDA.EQ.21) V(I1,4)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*(1.-ZU))) - IF(KFLDA.NE.21) V(I1,4)=LOG((1.-ZL)/MAX(1E-10,1.-ZU)) - 450 CONTINUE - IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN - ISL(3-ISLM)=0 - ISLM=3-ISLM - ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN - ZDR1=MAX(0.,V(N+1,3)/MAX(1E-6,V(N+1,4))-1.) - ZDR2=MAX(0.,V(N+2,3)/MAX(1E-6,V(N+2,4))-1.) - IF(ZDR2.GT.RLU(0)*(ZDR1+ZDR2)) ISL(1)=0 - IF(ISL(1).EQ.1) ISL(2)=0 - IF(ISL(1).EQ.0) ISLM=1 - IF(ISL(2).EQ.0) ISLM=2 - ENDIF - IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 330 - ENDIF - IFLD1=KFLD(1) - IF(KFLD(1).GE.6.AND.KFLD(1).LE.8) IFLD1=37+KFLD(1)+ - &ISIGN(2,K(N+1,2)) - IFLD2=KFLD(2) - IF(KFLD(2).GE.6.AND.KFLD(2).LE.8) IFLD2=37+KFLD(2)+ - &ISIGN(2,K(N+2,2)) - IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE. - &PMTH(2,IFLD1).OR.P(N+2,5).GE.PMTH(2,IFLD2))) THEN - PMQ1=V(N+1,5)/V(IM,5) - PMQ2=V(N+2,5)/V(IM,5) - ZD=SQRT(MAX(0.,(1.-V(IM,5)/PEM**2)*((1.-PMQ1-PMQ2)**2- - & 4.*PMQ1*PMQ2))) - ZH=1.+PMQ1-PMQ2 - ZL=0.5*(ZH-ZD) - ZU=0.5*(ZH+ZD) - IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 330 - ENDIF - -C...Accepted branch. Construct four-momentum for initial partons. - 460 MAZIP=0 - MAZIC=0 - IF(NEP.EQ.1) THEN - P(N+1,1)=0. - P(N+1,2)=0. - P(N+1,3)=SQRT(MAX(0.,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)- - & P(N+1,5)))) - P(N+1,4)=P(IPA(1),4) - V(N+1,2)=P(N+1,4) - ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN - PED1=0.5*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5) - P(N+1,1)=0. - P(N+1,2)=0. - P(N+1,3)=SQRT(MAX(0.,(PED1+P(N+1,5))*(PED1-P(N+1,5)))) - P(N+1,4)=PED1 - P(N+2,1)=0. - P(N+2,2)=0. - P(N+2,3)=-P(N+1,3) - P(N+2,4)=P(IM,5)-PED1 - V(N+1,2)=P(N+1,4) - V(N+2,2)=P(N+2,4) - ELSEIF(NEP.EQ.3) THEN - P(N+1,1)=0. - P(N+1,2)=0. - P(N+1,3)=SQRT(MAX(0.,PA1S)) - P(N+2,1)=SQRT(PTS) - P(N+2,2)=0. - P(N+2,3)=0.5*(PA3S-PA2S-PA1S)/P(N+1,3) - P(N+3,1)=-P(N+2,1) - P(N+3,2)=0. - P(N+3,3)=-(P(N+1,3)+P(N+2,3)) - V(N+1,2)=P(N+1,4) - V(N+2,2)=P(N+2,4) - V(N+3,2)=P(N+3,4) - -C...Construct transverse momentum for ordinary branching in shower. - ELSE - ZM=V(IM,1) - PZM=SQRT(MAX(0.,(PEM+P(IM,5))*(PEM-P(IM,5)))) - PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4.*V(N+1,5)*V(N+2,5) - IF(PZM.LE.0.) THEN - PTS=0. - ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN - PTS=(PEM**2*(ZM*(1.-ZM)*V(IM,5)-(1.-ZM)*V(N+1,5)- - & ZM*V(N+2,5))-0.25*PMLS)/PZM**2 - ELSE - PTS=PMLS*(ZM*(1.-ZM)*PEM**2/V(IM,5)-0.25)/PZM**2 - ENDIF - PT=SQRT(MAX(0.,PTS)) - -C...Find coefficient of azimuthal asymmetry due to gluon polarization. - HAZIP=0. - IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21. - & AND.IAU.NE.0) THEN - IF(K(IGM,3).NE.0) MAZIP=1 - ZAU=V(IGM,1) - IF(IAU.EQ.IM+1) ZAU=1.-V(IGM,1) - IF(MAZIP.EQ.0) ZAU=0. - IF(K(IGM,2).NE.21) THEN - HAZIP=2.*ZAU/(1.+ZAU**2) - ELSE - HAZIP=(ZAU/(1.-ZAU*(1.-ZAU)))**2 - ENDIF - IF(K(N+1,2).NE.21) THEN - HAZIP=HAZIP*(-2.*ZM*(1.-ZM))/(1.-2.*ZM*(1.-ZM)) - ELSE - HAZIP=HAZIP*(ZM*(1.-ZM)/(1.-ZM*(1.-ZM)))**2 - ENDIF - ENDIF - -C...Find coefficient of azimuthal asymmetry due to soft gluon -C...interference. - HAZIC=0. - IF(MSTJ(49).NE.2.AND.MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR. - & K(N+2,2).EQ.21).AND.IAU.NE.0) THEN - IF(K(IGM,3).NE.0) MAZIC=N+1 - IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2 - IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND. - & ZM.GT.0.5) MAZIC=N+2 - IF(K(IAU,2).EQ.22) MAZIC=0 - ZS=ZM - IF(MAZIC.EQ.N+2) ZS=1.-ZM - ZGM=V(IGM,1) - IF(IAU.EQ.IM-1) ZGM=1.-V(IGM,1) - IF(MAZIC.EQ.0) ZGM=1. - IF(MAZIC.NE.0) HAZIC=(P(IM,5)/P(IGM,5))* - & SQRT((1.-ZS)*(1.-ZGM)/(ZS*ZGM)) - HAZIC=MIN(0.95,HAZIC) - ENDIF - ENDIF - -C...Construct kinematics for ordinary branching in shower. - 470 IF(NEP.EQ.2.AND.IGM.GT.0) THEN - IF(MOD(MSTJ(43),2).EQ.1) THEN - P(N+1,4)=PEM*V(IM,1) - ELSE - P(N+1,4)=PEM*(0.5*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+ - & SQRT(PMLS)*ZM)/V(IM,5) - ENDIF - PHI=PARU(2)*RLU(0) - P(N+1,1)=PT*COS(PHI) - P(N+1,2)=PT*SIN(PHI) - IF(PZM.GT.0.) THEN - P(N+1,3)=0.5*(V(N+2,5)-V(N+1,5)-V(IM,5)+2.*PEM*P(N+1,4))/PZM - ELSE - P(N+1,3)=0. - ENDIF - P(N+2,1)=-P(N+1,1) - P(N+2,2)=-P(N+1,2) - P(N+2,3)=PZM-P(N+1,3) - P(N+2,4)=PEM-P(N+1,4) - IF(MSTJ(43).LE.2) THEN - V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5) - V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5) - ENDIF - ENDIF - -C...Rotate and boost daughters. - IF(IGM.GT.0) THEN - IF(MSTJ(43).LE.2) THEN - BEX=P(IGM,1)/P(IGM,4) - BEY=P(IGM,2)/P(IGM,4) - BEZ=P(IGM,3)/P(IGM,4) - GA=P(IGM,4)/P(IGM,5) - GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1.+GA)- - & P(IM,4)) - ELSE - BEX=0. - BEY=0. - BEZ=0. - GA=1. - GABEP=0. - ENDIF - THE=ULANGL(P(IM,3)+GABEP*BEZ,SQRT((P(IM,1)+GABEP*BEX)**2+ - & (P(IM,2)+GABEP*BEY)**2)) - PHI=ULANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY) - DO 480 I=N+1,N+2 - DP(1)=COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+ - & SIN(THE)*COS(PHI)*P(I,3) - DP(2)=COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+ - & SIN(THE)*SIN(PHI)*P(I,3) - DP(3)=-SIN(THE)*P(I,1)+COS(THE)*P(I,3) - DP(4)=P(I,4) - DBP=BEX*DP(1)+BEY*DP(2)+BEZ*DP(3) - DGABP=GA*(GA*DBP/(1D0+GA)+DP(4)) - P(I,1)=DP(1)+DGABP*BEX - P(I,2)=DP(2)+DGABP*BEY - P(I,3)=DP(3)+DGABP*BEZ - P(I,4)=GA*(DP(4)+DBP) - 480 CONTINUE - ENDIF - -C...Weight with azimuthal distribution, if required. - IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN - DO 490 J=1,3 - DPT(1,J)=P(IM,J) - DPT(2,J)=P(IAU,J) - DPT(3,J)=P(N+1,J) - 490 CONTINUE - DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3) - DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3) - DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2 - DO 500 J=1,3 - DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/DPMM - DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/DPMM - 500 CONTINUE - DPT(4,4)=SQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2) - DPT(5,4)=SQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2) - IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1*PARJ(82)) THEN - CAD=(DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+ - & DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4)) - IF(MAZIP.NE.0) THEN - IF(1.+HAZIP*(2.*CAD**2-1.).LT.RLU(0)*(1.+ABS(HAZIP))) - & GOTO 470 - ENDIF - IF(MAZIC.NE.0) THEN - IF(MAZIC.EQ.N+2) CAD=-CAD - IF((1.-HAZIC)*(1.-HAZIC*CAD)/(1.+HAZIC**2-2.*HAZIC*CAD) - & .LT.RLU(0)) GOTO 470 - ENDIF - ENDIF - ENDIF - -C...Azimuthal anisotropy due to interference with initial state partons. - IF(MOD(MIIS,2).EQ.1.AND.IGM.EQ.NS+1.AND.(K(N+1,2).EQ.21.OR. - &K(N+2,2).EQ.21)) THEN - III=IM-NS-1 - IF(ISII(III).GE.1) THEN - IAZIID=N+1 - IF(K(N+1,2).NE.21) IAZIID=N+2 - IF(K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND. - & P(N+1,4).GT.P(N+2,4)) IAZIID=N+2 - THEIID=ULANGL(P(IAZIID,3),SQRT(P(IAZIID,1)**2+P(IAZIID,2)**2)) - IF(III.EQ.2) THEIID=PARU(1)-THEIID - PHIIID=ULANGL(P(IAZIID,1),P(IAZIID,2)) - HAZII=MIN(0.95,THEIID/THEIIS(III,ISII(III))) - CAD=COS(PHIIID-PHIIIS(III,ISII(III))) - PHIREL=ABS(PHIIID-PHIIIS(III,ISII(III))) - IF(PHIREL.GT.PARU(1)) PHIREL=PARU(2)-PHIREL - IF((1.-HAZII)*(1.-HAZII*CAD)/(1.+HAZII**2-2.*HAZII*CAD) - & .LT.RLU(0)) GOTO 470 - ENDIF - ENDIF - -C...Continue loop over partons that may branch, until none left. - IF(IGM.GE.0) K(IM,1)=14 - N=N+NEP - NEP=2 - IF(N.GT.MSTU(4)-MSTU(32)-5) THEN - CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS') - IF(MSTU(21).GE.1) N=NS - IF(MSTU(21).GE.1) RETURN - ENDIF - GOTO 270 - -C...Set information on imagined shower initiator. - 510 IF(NPA.GE.2) THEN - K(NS+1,1)=11 - K(NS+1,2)=94 - K(NS+1,3)=IP1 - IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2 - K(NS+1,4)=NS+2 - K(NS+1,5)=NS+1+NPA - IIM=1 - ELSE - IIM=0 - ENDIF - -C...Reconstruct string drawing information. - DO 520 I=NS+1+IIM,N - IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN - K(I,1)=1 - ELSEIF(K(I,1).LE.10.AND.IABS(K(I,2)).GE.11.AND. - &IABS(K(I,2)).LE.18) THEN - K(I,1)=1 - ELSEIF(K(I,1).LE.10) THEN - K(I,4)=MSTU(5)*(K(I,4)/MSTU(5)) - K(I,5)=MSTU(5)*(K(I,5)/MSTU(5)) - ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN - ID1=MOD(K(I,4),MSTU(5)) - IF(K(I,2).GE.1.AND.K(I,2).LE.8) ID1=MOD(K(I,4),MSTU(5))+1 - ID2=2*MOD(K(I,4),MSTU(5))+1-ID1 - K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 - K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2 - K(ID1,4)=K(ID1,4)+MSTU(5)*I - K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 - K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 - K(ID2,5)=K(ID2,5)+MSTU(5)*I - ELSE - ID1=MOD(K(I,4),MSTU(5)) - ID2=ID1+1 - K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 - K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1 - IF(IABS(K(I,2)).LE.10.OR.K(ID1,1).GE.11) THEN - K(ID1,4)=K(ID1,4)+MSTU(5)*I - K(ID1,5)=K(ID1,5)+MSTU(5)*I - ELSE - K(ID1,4)=0 - K(ID1,5)=0 - ENDIF - K(ID2,4)=0 - K(ID2,5)=0 - ENDIF - 520 CONTINUE - -C...Transformation from CM frame. - IF(NPA.GE.2) THEN - BEX=PS(1)/PS(4) - BEY=PS(2)/PS(4) - BEZ=PS(3)/PS(4) - GA=PS(4)/PS(5) - GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3)) - & /(1.+GA)-P(IPA(1),4)) - ELSE - BEX=0. - BEY=0. - BEZ=0. - GABEP=0. - ENDIF - THE=ULANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1) - &+GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2)) - PHI=ULANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY) - IF(NPA.EQ.3) THEN - CHI=ULANGL(COS(THE)*COS(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(THE)* - & SIN(PHI)*(P(IPA(2),2)+GABEP*BEY)-SIN(THE)*(P(IPA(2),3)+GABEP* - & BEZ),-SIN(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(PHI)*(P(IPA(2),2)+ - & GABEP*BEY)) - MSTU(33)=1 - CALL LUDBRB(NS+1,N,0.,CHI,0D0,0D0,0D0) - ENDIF - DBEX=DBLE(BEX) - DBEY=DBLE(BEY) - DBEZ=DBLE(BEZ) - MSTU(33)=1 - CALL LUDBRB(NS+1,N,THE,PHI,DBEX,DBEY,DBEZ) - -C...Decay vertex of shower. - DO 540 I=NS+1,N - DO 530 J=1,5 - V(I,J)=V(IP1,J) - 530 CONTINUE - 540 CONTINUE - -C...Delete trivial shower, else connect initiators. - IF(N.EQ.NS+NPA+IIM) THEN - N=NS - ELSE - DO 550 IP=1,NPA - K(IPA(IP),1)=14 - K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP - K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP - K(NS+IIM+IP,3)=IPA(IP) - IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1 - IF(K(NS+IIM+IP,1).NE.1) THEN - K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4) - K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5) - ENDIF - 550 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUBOEI(NSAV) - -C...Purpose: to modify event so as to approximately take into account -C...Bose-Einstein effects according to a simple phenomenological -C...parametrization. - IMPLICIT DOUBLE PRECISION(D) - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUJETS/,/LUDAT1/ - DIMENSION DPS(4),KFBE(9),NBE(0:9),BEI(100) - DATA KFBE/211,-211,111,321,-321,130,310,221,331/ - -C...Boost event to overall CM frame. Calculate CM energy. - IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN - DO 100 J=1,4 - DPS(J)=0. - 100 CONTINUE - DO 120 I=1,N - KFA=IABS(K(I,2)) - IF(K(I,1).LE.10.AND.((KFA.GT.10.AND.KFA.LE.20).OR.KFA.EQ.22).AND. - &K(I,3).GT.0) THEN - KFMA=IABS(K(K(I,3),2)) - IF(KFMA.GT.10.AND.KFMA.LE.80) K(I,1)=-K(I,1) - ELSEIF(KFA.EQ.22.AND.K(I,3).EQ.0) THEN - K(I,1)=-K(I,1) - ENDIF - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 - DO 110 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 110 CONTINUE - 120 CONTINUE - CALL LUDBRB(0,0,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4), - &-DPS(3)/DPS(4)) - PECM=0. - DO 130 I=1,N - IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4) - 130 CONTINUE - -C...Reserve copy of particles by species at end of record. - NBE(0)=N+MSTU(3) - DO 160 IBE=1,MIN(9,MSTJ(52)) - NBE(IBE)=NBE(IBE-1) - DO 150 I=NSAV+1,N - IF(K(I,2).NE.KFBE(IBE)) GOTO 150 - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 - IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN - CALL LUERRM(11,'(LUBOEI:) no more memory left in LUJETS') - RETURN - ENDIF - NBE(IBE)=NBE(IBE)+1 - K(NBE(IBE),1)=I - DO 140 J=1,3 - P(NBE(IBE),J)=0. - 140 CONTINUE - 150 CONTINUE - 160 CONTINUE - IF(NBE(MIN(9,MSTJ(52)))-NBE(0).LE.1) GOTO 280 - -C...Tabulate integral for subsequent momentum shift. - DO 220 IBE=1,MIN(9,MSTJ(52)) - IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 180 - IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)) - &.LE.1) GOTO 180 - IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5), - &NBE(7)-NBE(6)).LE.1) GOTO 180 - IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 180 - IF(IBE.EQ.1) PMHQ=2.*ULMASS(211) - IF(IBE.EQ.4) PMHQ=2.*ULMASS(321) - IF(IBE.EQ.8) PMHQ=2.*ULMASS(221) - IF(IBE.EQ.9) PMHQ=2.*ULMASS(331) - QDEL=0.1*MIN(PMHQ,PARJ(93)) - IF(MSTJ(51).EQ.1) THEN - NBIN=MIN(100,NINT(9.*PARJ(93)/QDEL)) - BEEX=EXP(0.5*QDEL/PARJ(93)) - BERT=EXP(-QDEL/PARJ(93)) - ELSE - NBIN=MIN(100,NINT(3.*PARJ(93)/QDEL)) - ENDIF - DO 170 IBIN=1,NBIN - QBIN=QDEL*(IBIN-0.5) - BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12.)/SQRT(QBIN**2+PMHQ**2) - IF(MSTJ(51).EQ.1) THEN - BEEX=BEEX*BERT - BEI(IBIN)=BEI(IBIN)*BEEX - ELSE - BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2) - ENDIF - IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1) - 170 CONTINUE - -C...Loop through particle pairs and find old relative momentum. - 180 DO 210 I1M=NBE(IBE-1)+1,NBE(IBE)-1 - I1=K(I1M,1) - DO 200 I2M=I1M+1,NBE(IBE) - I2=K(I2M,1) - Q2OLD=MAX(0.,(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+ - &P(I2,2))**2-(P(I1,3)+P(I2,3))**2-(P(I1,5)+P(I2,5))**2) - QOLD=SQRT(Q2OLD) - -C...Calculate new relative momentum. - IF(QOLD.LT.1E-3*QDEL) THEN - GOTO 200 - ELSEIF(QOLD.LE.QDEL) THEN - QMOV=QOLD/3. - ELSEIF(QOLD.LT.(NBIN-0.1)*QDEL) THEN - RBIN=QOLD/QDEL - IBIN=RBIN - RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1) - QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))* - & SQRT(Q2OLD+PMHQ**2)/Q2OLD - ELSE - QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD - ENDIF - Q2NEW=Q2OLD*(QOLD/(QOLD+3.*PARJ(92)*QMOV))**(2./3.) - -C...Calculate and save shift to be performed on three-momenta. - HC1=(P(I1,4)+P(I2,4))**2-(Q2OLD-Q2NEW) - HC2=(Q2OLD-Q2NEW)*(P(I1,4)-P(I2,4))**2 - HA=0.5*(1.-SQRT(HC1*Q2NEW/(HC1*Q2OLD-HC2))) - DO 190 J=1,3 - PD=HA*(P(I2,J)-P(I1,J)) - P(I1M,J)=P(I1M,J)+PD - P(I2M,J)=P(I2M,J)-PD - 190 CONTINUE - 200 CONTINUE - 210 CONTINUE - 220 CONTINUE - -C...Shift momenta and recalculate energies. - DO 240 IM=NBE(0)+1,NBE(MIN(9,MSTJ(52))) - I=K(IM,1) - DO 230 J=1,3 - P(I,J)=P(I,J)+P(IM,J) - 230 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - 240 CONTINUE - -C...Rescale all momenta for energy conservation. - PES=0. - PQS=0. - DO 250 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 250 - PES=PES+P(I,4) - PQS=PQS+P(I,5)**2/P(I,4) - 250 CONTINUE - FAC=(PECM-PQS)/(PES-PQS) - DO 270 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270 - DO 260 J=1,3 - P(I,J)=FAC*P(I,J) - 260 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - 270 CONTINUE - -C...Boost back to correct reference frame. - 280 CALL LUDBRB(0,0,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4)) - DO 290 I=1,N - IF(K(I,1).LT.0) K(I,1)=-K(I,1) - 290 CONTINUE - - RETURN - END - -C********************************************************************* - - FUNCTION ULMASS(KF) - -C...Purpose: to give the mass of a particle/parton. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUDAT1/,/LUDAT2/ - -C...Reset variables. Compressed code. - ULMASS=0. - KFA=IABS(KF) - KC=LUCOMP(KF) - IF(KC.EQ.0) RETURN - PARF(106)=PMAS(6,1) - PARF(107)=PMAS(7,1) - PARF(108)=PMAS(8,1) - -C...Guarantee use of constituent masses for internal checks. - IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND.KFA.LE.10) THEN - ULMASS=PARF(100+KFA) - IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(121)) - -C...Masses that can be read directly off table. - ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN - ULMASS=PMAS(KC,1) - -C...Find constituent partons and their masses. - ELSE - KFLA=MOD(KFA/1000,10) - KFLB=MOD(KFA/100,10) - KFLC=MOD(KFA/10,10) - KFLS=MOD(KFA,10) - KFLR=MOD(KFA/10000,10) - PMA=PARF(100+KFLA) - PMB=PARF(100+KFLB) - PMC=PARF(100+KFLC) - -C...Construct masses for various meson, diquark and baryon cases. - IF(KFLA.EQ.0.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN - IF(KFLS.EQ.1) PMSPL=-3./(PMB*PMC) - IF(KFLS.GE.3) PMSPL=1./(PMB*PMC) - ULMASS=PARF(111)+PMB+PMC+PARF(113)*PARF(101)**2*PMSPL - ELSEIF(KFLA.EQ.0) THEN - KMUL=2 - IF(KFLS.EQ.1) KMUL=3 - IF(KFLR.EQ.2) KMUL=4 - IF(KFLS.EQ.5) KMUL=5 - ULMASS=PARF(113+KMUL)+PMB+PMC - ELSEIF(KFLC.EQ.0) THEN - IF(KFLS.EQ.1) PMSPL=-3./(PMA*PMB) - IF(KFLS.EQ.3) PMSPL=1./(PMA*PMB) - ULMASS=2.*PARF(112)/3.+PMA+PMB+PARF(114)*PARF(101)**2*PMSPL - IF(MSTJ(93).EQ.1) ULMASS=PMA+PMB - IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(122)- - & 2.*PARF(112)/3.) - ELSE - IF(KFLS.EQ.2.AND.KFLA.EQ.KFLB) THEN - PMSPL=1./(PMA*PMB)-2./(PMA*PMC)-2./(PMB*PMC) - ELSEIF(KFLS.EQ.2.AND.KFLB.GE.KFLC) THEN - PMSPL=-2./(PMA*PMB)-2./(PMA*PMC)+1./(PMB*PMC) - ELSEIF(KFLS.EQ.2) THEN - PMSPL=-3./(PMB*PMC) - ELSE - PMSPL=1./(PMA*PMB)+1./(PMA*PMC)+1./(PMB*PMC) - ENDIF - ULMASS=PARF(112)+PMA+PMB+PMC+PARF(114)*PARF(101)**2*PMSPL - ENDIF - ENDIF - -C...Optional mass broadening according to truncated Breit-Wigner -C...(either in m or in m^2). - IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1E-4) THEN - IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN - ULMASS=ULMASS+0.5*PMAS(KC,2)*TAN((2.*RLU(0)-1.)* - & ATAN(2.*PMAS(KC,3)/PMAS(KC,2))) - ELSE - PM0=ULMASS - PMLOW=ATAN((MAX(0.,PM0-PMAS(KC,3))**2-PM0**2)/ - & (PM0*PMAS(KC,2))) - PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2))) - ULMASS=SQRT(MAX(0.,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+ - & (PMUPP-PMLOW)*RLU(0)))) - ENDIF - ENDIF - MSTJ(93)=0 - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUNAME(KF,CHAU) - -C...Purpose: to give the particle/parton name as a character string. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/LUDAT4/CHAF(500) - CHARACTER CHAF*8 - SAVE /LUDAT1/,/LUDAT2/,/LUDAT4/ - CHARACTER CHAU*16 - -C...Initial values. Charge. Subdivide code. - CHAU=' ' - KFA=IABS(KF) - KC=LUCOMP(KF) - IF(KC.EQ.0) RETURN - KQ=LUCHGE(KF) - KFLA=MOD(KFA/1000,10) - KFLB=MOD(KFA/100,10) - KFLC=MOD(KFA/10,10) - KFLS=MOD(KFA,10) - KFLR=MOD(KFA/10000,10) - -C...Read out root name and spin for simple particle. - IF(KFA.LE.100.OR.(KFA.GT.100.AND.KC.GT.100)) THEN - CHAU=CHAF(KC) - LEN=0 - DO 100 LEM=1,8 - IF(CHAU(LEM:LEM).NE.' ') LEN=LEM - 100 CONTINUE - -C...Construct root name for diquark. Add on spin. - ELSEIF(KFLC.EQ.0) THEN - CHAU(1:2)=CHAF(KFLA)(1:1)//CHAF(KFLB)(1:1) - IF(KFLS.EQ.1) CHAU(3:4)='_0' - IF(KFLS.EQ.3) CHAU(3:4)='_1' - LEN=4 - -C...Construct root name for heavy meson. Add on spin and heavy flavour. - ELSEIF(KFLA.EQ.0) THEN - IF(KFLB.EQ.5) CHAU(1:1)='B' - IF(KFLB.EQ.6) CHAU(1:1)='T' - IF(KFLB.EQ.7) CHAU(1:1)='L' - IF(KFLB.EQ.8) CHAU(1:1)='H' - LEN=1 - IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN - ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN - CHAU(2:2)='*' - LEN=2 - ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN - CHAU(2:3)='_1' - LEN=3 - ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN - CHAU(2:4)='*_0' - LEN=4 - ELSEIF(KFLR.EQ.2) THEN - CHAU(2:4)='*_1' - LEN=4 - ELSEIF(KFLS.EQ.5) THEN - CHAU(2:4)='*_2' - LEN=4 - ENDIF - IF(KFLC.GE.3.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN - CHAU(LEN+1:LEN+2)='_'//CHAF(KFLC)(1:1) - LEN=LEN+2 - ELSEIF(KFLC.GE.3) THEN - CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1) - LEN=LEN+1 - ENDIF - -C...Construct root name and spin for heavy baryon. - ELSE - IF(KFLB.LE.2.AND.KFLC.LE.2) THEN - CHAU='Sigma ' - IF(KFLC.GT.KFLB) CHAU='Lambda' - IF(KFLS.EQ.4) CHAU='Sigma*' - LEN=5 - IF(CHAU(6:6).NE.' ') LEN=6 - ELSEIF(KFLB.LE.2.OR.KFLC.LE.2) THEN - CHAU='Xi ' - IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Xi''' - IF(KFLS.EQ.4) CHAU='Xi*' - LEN=2 - IF(CHAU(3:3).NE.' ') LEN=3 - ELSE - CHAU='Omega ' - IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Omega''' - IF(KFLS.EQ.4) CHAU='Omega*' - LEN=5 - IF(CHAU(6:6).NE.' ') LEN=6 - ENDIF - -C...Add on heavy flavour content for heavy baryon. - CHAU(LEN+1:LEN+2)='_'//CHAF(KFLA)(1:1) - LEN=LEN+2 - IF(KFLB.GE.KFLC.AND.KFLC.GE.4) THEN - CHAU(LEN+1:LEN+2)=CHAF(KFLB)(1:1)//CHAF(KFLC)(1:1) - LEN=LEN+2 - ELSEIF(KFLB.GE.KFLC.AND.KFLB.GE.4) THEN - CHAU(LEN+1:LEN+1)=CHAF(KFLB)(1:1) - LEN=LEN+1 - ELSEIF(KFLC.GT.KFLB.AND.KFLB.GE.4) THEN - CHAU(LEN+1:LEN+2)=CHAF(KFLC)(1:1)//CHAF(KFLB)(1:1) - LEN=LEN+2 - ELSEIF(KFLC.GT.KFLB.AND.KFLC.GE.4) THEN - CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1) - LEN=LEN+1 - ENDIF - ENDIF - -C...Add on bar sign for antiparticle (where necessary). - IF(KF.GT.0.OR.LEN.EQ.0) THEN - ELSEIF(KFA.GT.10.AND.KFA.LE.40.AND.KQ.NE.0.AND.MOD(KQ,3).EQ.0) - &THEN - ELSEIF(KFA.EQ.89.OR.(KFA.GE.91.AND.KFA.LE.99)) THEN - ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KQ.NE.0) THEN - ELSEIF(MSTU(15).LE.1) THEN - CHAU(LEN+1:LEN+1)='~' - LEN=LEN+1 - ELSE - CHAU(LEN+1:LEN+3)='bar' - LEN=LEN+3 - ENDIF - -C...Add on charge where applicable (conventional cases skipped). - IF(KQ.EQ.6) CHAU(LEN+1:LEN+2)='++' - IF(KQ.EQ.-6) CHAU(LEN+1:LEN+2)='--' - IF(KQ.EQ.3) CHAU(LEN+1:LEN+1)='+' - IF(KQ.EQ.-3) CHAU(LEN+1:LEN+1)='-' - IF(KQ.EQ.0.AND.(KFA.LE.22.OR.LEN.EQ.0)) THEN - ELSEIF(KQ.EQ.0.AND.(KFA.GE.81.AND.KFA.LE.100)) THEN - ELSEIF(KFA.EQ.28.OR.KFA.EQ.29) THEN - ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KFLB.EQ.KFLC.AND. - &KFLB.NE.1) THEN - ELSEIF(KQ.EQ.0) THEN - CHAU(LEN+1:LEN+1)='0' - ENDIF - - RETURN - END - -C********************************************************************* - - FUNCTION LUCHGE(KF) - -C...Purpose: to give three times the charge for a particle/parton. - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUDAT2/ - -C...Initial values. Simple case of direct readout. - LUCHGE=0 - KFA=IABS(KF) - KC=LUCOMP(KFA) - IF(KC.EQ.0) THEN - ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN - LUCHGE=KCHG(KC,1) - -C...Construction from quark content for heavy meson, diquark, baryon. - ELSEIF(MOD(KFA/1000,10).EQ.0) THEN - LUCHGE=(KCHG(MOD(KFA/100,10),1)-KCHG(MOD(KFA/10,10),1))* - & (-1)**MOD(KFA/100,10) - ELSEIF(MOD(KFA/10,10).EQ.0) THEN - LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1) - ELSE - LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)+ - & KCHG(MOD(KFA/10,10),1) - ENDIF - -C...Add on correct sign. - LUCHGE=LUCHGE*ISIGN(1,KF) - - RETURN - END - -C********************************************************************* - - FUNCTION LUCOMP(KF) - -C...Purpose: to compress the standard KF codes for use in mass and decay -C...arrays; also to check whether a given code actually is defined. - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUDAT2/ - DIMENSION KFTAB(25),KCTAB(25) - DATA KFTAB/211,111,221,311,321,130,310,213,113,223, - &313,323,2112,2212,210,2110,2210,110,220,330,440,30443,30553,0,0/ - DATA KCTAB/101,111,112,102,103,221,222,121,131,132, - &122,123,332,333,281,282,283,284,285,286,287,231,235,0,0/ - -C...Starting values. - LUCOMP=0 - KFA=IABS(KF) - -C...Simple cases: direct translation or table. - IF(KFA.EQ.0.OR.KFA.GE.100000) THEN - RETURN - ELSEIF(KFA.LE.100) THEN - LUCOMP=KFA - IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) LUCOMP=0 - RETURN - ELSE - DO 100 IKF=1,23 - IF(KFA.EQ.KFTAB(IKF)) THEN - LUCOMP=KCTAB(IKF) - IF(KF.LT.0.AND.KCHG(LUCOMP,3).EQ.0) LUCOMP=0 - RETURN - ENDIF - 100 CONTINUE - ENDIF - -C...Subdivide KF code into constituent pieces. - KFLA=MOD(KFA/1000,10) - KFLB=MOD(KFA/100,10) - KFLC=MOD(KFA/10,10) - KFLS=MOD(KFA,10) - KFLR=MOD(KFA/10000,10) - -C...Mesons. - IF(KFA-10000*KFLR.LT.1000) THEN - IF(KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.0.OR.KFLC.EQ.9) THEN - ELSEIF(KFLB.LT.KFLC) THEN - ELSEIF(KF.LT.0.AND.KFLB.EQ.KFLC) THEN - ELSEIF(KFLB.EQ.KFLC) THEN - IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN - LUCOMP=110+KFLB - ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN - LUCOMP=130+KFLB - ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN - LUCOMP=150+KFLB - ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN - LUCOMP=170+KFLB - ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN - LUCOMP=190+KFLB - ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN - LUCOMP=210+KFLB - ENDIF - ELSEIF(KFLB.LE.5) THEN - IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN - LUCOMP=100+((KFLB-1)*(KFLB-2))/2+KFLC - ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN - LUCOMP=120+((KFLB-1)*(KFLB-2))/2+KFLC - ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN - LUCOMP=140+((KFLB-1)*(KFLB-2))/2+KFLC - ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN - LUCOMP=160+((KFLB-1)*(KFLB-2))/2+KFLC - ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN - LUCOMP=180+((KFLB-1)*(KFLB-2))/2+KFLC - ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN - LUCOMP=200+((KFLB-1)*(KFLB-2))/2+KFLC - ENDIF - ELSEIF((KFLS.EQ.1.AND.KFLR.LE.1).OR.(KFLS.EQ.3.AND.KFLR.LE.2) - & .OR.(KFLS.EQ.5.AND.KFLR.EQ.0)) THEN - LUCOMP=80+KFLB - ENDIF - -C...Diquarks. - ELSEIF((KFLR.EQ.0.OR.KFLR.EQ.1).AND.KFLC.EQ.0) THEN - IF(KFLS.NE.1.AND.KFLS.NE.3) THEN - ELSEIF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9) THEN - ELSEIF(KFLA.LT.KFLB) THEN - ELSEIF(KFLS.EQ.1.AND.KFLA.EQ.KFLB) THEN - ELSE - LUCOMP=90 - ENDIF - -C...Spin 1/2 baryons. - ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.2) THEN - IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN - ELSEIF(KFLA.LE.KFLC.OR.KFLA.LT.KFLB) THEN - ELSEIF(KFLA.GE.6.OR.KFLB.GE.4.OR.KFLC.GE.4) THEN - LUCOMP=80+KFLA - ELSEIF(KFLB.LT.KFLC) THEN - LUCOMP=300+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLC*(KFLC-1))/2+KFLB - ELSE - LUCOMP=330+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC - ENDIF - -C...Spin 3/2 baryons. - ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.4) THEN - IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN - ELSEIF(KFLA.LT.KFLB.OR.KFLB.LT.KFLC) THEN - ELSEIF(KFLA.GE.6.OR.KFLB.GE.4) THEN - LUCOMP=80+KFLA - ELSE - LUCOMP=360+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUERRM(MERR,CHMESS) - -C...Purpose: to inform user of errors in program execution. - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUJETS/,/LUDAT1/ - CHARACTER CHMESS*(*) - -C...Write first few warnings, then be silent. - IF(MERR.LE.10) THEN - MSTU(27)=MSTU(27)+1 - MSTU(28)=MERR - IF(MSTU(25).EQ.1.AND.MSTU(27).LE.MSTU(26)) WRITE(MSTU(11),5000) - & MERR,MSTU(31),CHMESS - -C...Write first few errors, then be silent or stop program. - ELSEIF(MERR.LE.20) THEN - MSTU(23)=MSTU(23)+1 - MSTU(24)=MERR-10 - IF(MSTU(21).GE.1.AND.MSTU(23).LE.MSTU(22)) WRITE(MSTU(11),5100) - & MERR-10,MSTU(31),CHMESS - IF(MSTU(21).GE.2.AND.MSTU(23).GT.MSTU(22)) THEN - WRITE(MSTU(11),5100) MERR-10,MSTU(31),CHMESS - WRITE(MSTU(11),5200) - IF(MERR.NE.17) CALL LULIST(2) - STOP - ENDIF - -C...Stop program in case of irreparable error. - ELSE - WRITE(MSTU(11),5300) MERR-20,MSTU(31),CHMESS - STOP - ENDIF - -C...Formats for output. - 5000 FORMAT(/5X,'Advisory warning type',I2,' given after',I6, - &' LUEXEC calls:'/5X,A) - 5100 FORMAT(/5X,'Error type',I2,' has occured after',I6, - &' LUEXEC calls:'/5X,A) - 5200 FORMAT(5X,'Execution will be stopped after listing of last ', - &'event!') - 5300 FORMAT(/5X,'Fatal error type',I2,' has occured after',I6, - &' LUEXEC calls:'/5X,A/5X,'Execution will now be stopped!') - - RETURN - END - -C********************************************************************* - - FUNCTION ULALEM(Q2) - -C...Purpose: to calculate the running alpha_electromagnetic. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUDAT1/ - -C...Calculate real part of photon vacuum polarization. -C...For leptons simplify by using asymptotic (Q^2 >> m^2) expressions. -C...For hadrons use parametrization of H. Burkhardt et al. -C...See R. Kleiss et al, CERN 89-08, vol. 3, pp. 129-131. - AEMPI=PARU(101)/(3.*PARU(1)) - IF(MSTU(101).LE.0.OR.Q2.LT.2E-6) THEN - RPIGG=0. - ELSEIF(MSTU(101).EQ.2.AND.Q2.LT.PARU(104)) THEN - RPIGG=0. - ELSEIF(MSTU(101).EQ.2) THEN - RPIGG=1.-PARU(101)/PARU(103) - ELSEIF(Q2.LT.0.09) THEN - RPIGG=AEMPI*(13.4916+LOG(Q2))+0.00835*LOG(1.+Q2) - ELSEIF(Q2.LT.9.) THEN - RPIGG=AEMPI*(16.3200+2.*LOG(Q2))+0.00238*LOG(1.+3.927*Q2) - ELSEIF(Q2.LT.1E4) THEN - RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00165+0.00299*LOG(1.+Q2) - ELSE - RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00221+0.00293*LOG(1.+Q2) - ENDIF - -C...Calculate running alpha_em. - ULALEM=PARU(101)/(1.-RPIGG) - PARU(108)=ULALEM - - RETURN - END - -C********************************************************************* - - FUNCTION ULALPS(Q2) - -C...Purpose: to give the value of alpha_strong. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUDAT1/,/LUDAT2/ - -C...Constant alpha_strong trivial. - IF(MSTU(111).LE.0) THEN - ULALPS=PARU(111) - MSTU(118)=MSTU(112) - PARU(117)=0. - PARU(118)=PARU(111) - RETURN - ENDIF - -C...Find effective Q2, number of flavours and Lambda. - Q2EFF=Q2 - IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114)) - NF=MSTU(112) - ALAM2=PARU(112)**2 - 100 IF(NF.GT.MAX(2,MSTU(113))) THEN - Q2THR=PARU(113)*PMAS(NF,1)**2 - IF(Q2EFF.LT.Q2THR) THEN - NF=NF-1 - ALAM2=ALAM2*(Q2THR/ALAM2)**(2./(33.-2.*NF)) - GOTO 100 - ENDIF - ENDIF - 110 IF(NF.LT.MIN(8,MSTU(114))) THEN - Q2THR=PARU(113)*PMAS(NF+1,1)**2 - IF(Q2EFF.GT.Q2THR) THEN - NF=NF+1 - ALAM2=ALAM2*(ALAM2/Q2THR)**(2./(33.-2.*NF)) - GOTO 110 - ENDIF - ENDIF - IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2 - PARU(117)=SQRT(ALAM2) - -C...Evaluate first or second order alpha_strong. - B0=(33.-2.*NF)/6. - ALGQ=LOG(MAX(1.0001,Q2EFF/ALAM2)) - IF(MSTU(111).EQ.1) THEN - ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)) - ELSE - B1=(153.-19.*NF)/6. - ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1.-B1*LOG(ALGQ)/ - & (B0**2*ALGQ))) - ENDIF - MSTU(118)=NF - PARU(118)=ULALPS - - RETURN - END - -C********************************************************************* - - FUNCTION ULANGL(X,Y) - -C...Purpose: to reconstruct an angle from given x and y coordinates. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUDAT1/ - - ULANGL=0. - R=SQRT(X**2+Y**2) - IF(R.LT.1E-20) RETURN - IF(ABS(X)/R.LT.0.8) THEN - ULANGL=SIGN(ACOS(X/R),Y) - ELSE - ULANGL=ASIN(Y/R) - IF(X.LT.0..AND.ULANGL.GE.0.) THEN - ULANGL=PARU(1)-ULANGL - ELSEIF(X.LT.0.) THEN - ULANGL=-PARU(1)-ULANGL - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - - FUNCTION RLU(IDUMMY) - -C...Purpose: to generate random numbers uniformly distributed between -C...0 and 1, excluding the endpoints. - COMMON/LUDATR/MRLU(6),RRLU(100) - SAVE /LUDATR/ - EQUIVALENCE (MRLU1,MRLU(1)),(MRLU2,MRLU(2)),(MRLU3,MRLU(3)), - &(MRLU4,MRLU(4)),(MRLU5,MRLU(5)),(MRLU6,MRLU(6)), - &(RRLU98,RRLU(98)),(RRLU99,RRLU(99)),(RRLU00,RRLU(100)) - -C...Initialize generation from given seed. - IF(MRLU2.EQ.0) THEN - IJ=MOD(MRLU1/30082,31329) - KL=MOD(MRLU1,30082) - I=MOD(IJ/177,177)+2 - J=MOD(IJ,177)+2 - K=MOD(KL/169,178)+1 - L=MOD(KL,169) - DO 110 II=1,97 - S=0. - T=0.5 - DO 100 JJ=1,24 - M=MOD(MOD(I*J,179)*K,179) - I=J - J=K - K=M - L=MOD(53*L+1,169) - IF(MOD(L*M,64).GE.32) S=S+T - T=0.5*T - 100 CONTINUE - RRLU(II)=S - 110 CONTINUE - TWOM24=1. - DO 120 I24=1,24 - TWOM24=0.5*TWOM24 - 120 CONTINUE - RRLU98=362436.*TWOM24 - RRLU99=7654321.*TWOM24 - RRLU00=16777213.*TWOM24 - MRLU2=1 - MRLU3=0 - MRLU4=97 - MRLU5=33 - ENDIF - -C...Generate next random number. - 130 RUNI=RRLU(MRLU4)-RRLU(MRLU5) - IF(RUNI.LT.0.) RUNI=RUNI+1. - RRLU(MRLU4)=RUNI - MRLU4=MRLU4-1 - IF(MRLU4.EQ.0) MRLU4=97 - MRLU5=MRLU5-1 - IF(MRLU5.EQ.0) MRLU5=97 - RRLU98=RRLU98-RRLU99 - IF(RRLU98.LT.0.) RRLU98=RRLU98+RRLU00 - RUNI=RUNI-RRLU98 - IF(RUNI.LT.0.) RUNI=RUNI+1. - IF(RUNI.LE.0.OR.RUNI.GE.1.) GOTO 130 - -C...Update counters. Random number to output. - MRLU3=MRLU3+1 - IF(MRLU3.EQ.1000000000) THEN - MRLU2=MRLU2+1 - MRLU3=0 - ENDIF - RLU=RUNI - - RETURN - END - -C********************************************************************* - - SUBROUTINE RLUGET(LFN,MOVE) - -C...Purpose: to dump the state of the random number generator on a file -C...for subsequent startup from this state onwards. - COMMON/LUDATR/MRLU(6),RRLU(100) - SAVE /LUDATR/ - CHARACTER CHERR*8 - -C...Backspace required number of records (or as many as there are). - IF(MOVE.LT.0) THEN - NBCK=MIN(MRLU(6),-MOVE) - DO 100 IBCK=1,NBCK - BACKSPACE(LFN,ERR=110,IOSTAT=IERR) - 100 CONTINUE - MRLU(6)=MRLU(6)-NBCK - ENDIF - -C...Unformatted write on unit LFN. - WRITE(LFN,ERR=110,IOSTAT=IERR) (MRLU(I1),I1=1,5), - &(RRLU(I2),I2=1,100) - MRLU(6)=MRLU(6)+1 - RETURN - -C...Write error. - 110 WRITE(CHERR,'(I8)') IERR - CALL LUERRM(18,'(RLUGET:) error when accessing file, IOSTAT ='// - &CHERR) - - RETURN - END - -C********************************************************************* - - SUBROUTINE RLUSET(LFN,MOVE) - -C...Purpose: to read a state of the random number generator from a file -C...for subsequent generation from this state onwards. - COMMON/LUDATR/MRLU(6),RRLU(100) - SAVE /LUDATR/ - CHARACTER CHERR*8 - -C...Backspace required number of records (or as many as there are). - IF(MOVE.LT.0) THEN - NBCK=MIN(MRLU(6),-MOVE) - DO 100 IBCK=1,NBCK - BACKSPACE(LFN,ERR=120,IOSTAT=IERR) - 100 CONTINUE - MRLU(6)=MRLU(6)-NBCK - ENDIF - -C...Unformatted read from unit LFN. - NFOR=1+MAX(0,MOVE) - DO 110 IFOR=1,NFOR - READ(LFN,ERR=120,IOSTAT=IERR) (MRLU(I1),I1=1,5), - &(RRLU(I2),I2=1,100) - 110 CONTINUE - MRLU(6)=MRLU(6)+NFOR - RETURN - -C...Write error. - 120 WRITE(CHERR,'(I8)') IERR - CALL LUERRM(18,'(RLUSET:) error when accessing file, IOSTAT ='// - &CHERR) - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ) - -C...Purpose: to perform rotations and boosts. - IMPLICIT DOUBLE PRECISION(D) - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUJETS/,/LUDAT1/ - DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4) - -C...Find range of rotation/boost. Convert boost to double precision. - IMIN=1 - IF(MSTU(1).GT.0) IMIN=MSTU(1) - IMAX=N - IF(MSTU(2).GT.0) IMAX=MSTU(2) - DBX=BEX - DBY=BEY - DBZ=BEZ - GOTO 120 - -C...Entry for specific range and double precision boost. - ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ) - IMIN=IMI - IF(IMIN.LE.0) IMIN=1 - IMAX=IMA - IF(IMAX.LE.0) IMAX=N - DBX=DBEX - DBY=DBEY - DBZ=DBEZ - -C...Optional resetting of V (when not set before.) - IF(MSTU(33).NE.0) THEN - DO 110 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4)) - DO 100 J=1,5 - V(I,J)=0. - 100 CONTINUE - 110 CONTINUE - MSTU(33)=0 - ENDIF - -C...Check range of rotation/boost. - 120 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN - CALL LUERRM(11,'(LUROBO:) range outside LUJETS memory') - RETURN - ENDIF - -C...Rotate, typically from z axis to direction (theta,phi). - IF(THE**2+PHI**2.GT.1E-20) THEN - ROT(1,1)=COS(THE)*COS(PHI) - ROT(1,2)=-SIN(PHI) - ROT(1,3)=SIN(THE)*COS(PHI) - ROT(2,1)=COS(THE)*SIN(PHI) - ROT(2,2)=COS(PHI) - ROT(2,3)=SIN(THE)*SIN(PHI) - ROT(3,1)=-SIN(THE) - ROT(3,2)=0. - ROT(3,3)=COS(THE) - DO 150 I=IMIN,IMAX - IF(K(I,1).LE.0) GOTO 150 - DO 130 J=1,3 - PR(J)=P(I,J) - VR(J)=V(I,J) - 130 CONTINUE - DO 140 J=1,3 - P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3) - V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3) - 140 CONTINUE - 150 CONTINUE - ENDIF - -C...Boost, typically from rest to momentum/energy=beta. - IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN - DB=SQRT(DBX**2+DBY**2+DBZ**2) - IF(DB.GT.0.99999999D0) THEN -C...Rescale boost vector if too close to unity. - CALL LUERRM(3,'(LUROBO:) boost vector too large') - DBX=DBX*(0.99999999D0/DB) - DBY=DBY*(0.99999999D0/DB) - DBZ=DBZ*(0.99999999D0/DB) - DB=0.99999999D0 - ENDIF - DGA=1D0/SQRT(1D0-DB**2) - DO 170 I=IMIN,IMAX - IF(K(I,1).LE.0) GOTO 170 - DO 160 J=1,4 - DP(J)=P(I,J) - DV(J)=V(I,J) - 160 CONTINUE - DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3) - DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4)) - P(I,1)=DP(1)+DGABP*DBX - P(I,2)=DP(2)+DGABP*DBY - P(I,3)=DP(3)+DGABP*DBZ - P(I,4)=DGA*(DP(4)+DBP) - DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3) - DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4)) - V(I,1)=DV(1)+DGABV*DBX - V(I,2)=DV(2)+DGABV*DBY - V(I,3)=DV(3)+DGABV*DBZ - V(I,4)=DGA*(DV(4)+DBV) - 170 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUEDIT(MEDIT) - -C...Purpose: to perform global manipulations on the event record, -C...in particular to exclude unstable or undetectable partons/particles. - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - DIMENSION NS(2),PTS(2),PLS(2) - -C...Remove unwanted partons/particles. - IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN - IMAX=N - IF(MSTU(2).GT.0) IMAX=MSTU(2) - I1=MAX(1,MSTU(1))-1 - DO 110 I=MAX(1,MSTU(1)),IMAX - IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110 - IF(MEDIT.EQ.1) THEN - IF(K(I,1).GT.10) GOTO 110 - ELSEIF(MEDIT.EQ.2) THEN - IF(K(I,1).GT.10) GOTO 110 - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18) - & GOTO 110 - ELSEIF(MEDIT.EQ.3) THEN - IF(K(I,1).GT.10) GOTO 110 - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - IF(KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) GOTO 110 - ELSEIF(MEDIT.EQ.5) THEN - IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110 - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110 - ENDIF - -C...Pack remaining partons/particles. Origin no longer known. - I1=I1+1 - DO 100 J=1,5 - K(I1,J)=K(I,J) - P(I1,J)=P(I,J) - V(I1,J)=V(I,J) - 100 CONTINUE - K(I1,3)=0 - 110 CONTINUE - IF(I1.LT.N) MSTU(3)=0 - IF(I1.LT.N) MSTU(70)=0 - N=I1 - -C...Selective removal of class of entries. New position of retained. - ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN - I1=0 - DO 120 I=1,N - K(I,3)=MOD(K(I,3),MSTU(5)) - IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120 - IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120 - IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR. - & K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120 - IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR. - & K(I,2).EQ.94)) GOTO 120 - IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120 - I1=I1+1 - K(I,3)=K(I,3)+MSTU(5)*I1 - 120 CONTINUE - -C...Find new event history information and replace old. - DO 140 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140 - ID=I - 130 IM=MOD(K(ID,3),MSTU(5)) - IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN - IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND. - & K(IM,2).NE.94) THEN - ID=IM - GOTO 130 - ENDIF - ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN - IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN - ID=IM - GOTO 130 - ENDIF - ENDIF - K(I,3)=MSTU(5)*(K(I,3)/MSTU(5)) - IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5) - IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN - IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)= - & K(K(I,4),3)/MSTU(5) - IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)= - & K(K(I,5),3)/MSTU(5) - ELSE - KCM=MOD(K(I,4)/MSTU(5),MSTU(5)) - IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) - KCD=MOD(K(I,4),MSTU(5)) - IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) - K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD - KCM=MOD(K(I,5)/MSTU(5),MSTU(5)) - IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) - KCD=MOD(K(I,5),MSTU(5)) - IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) - K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD - ENDIF - 140 CONTINUE - -C...Pack remaining entries. - I1=0 - MSTU90=MSTU(90) - MSTU(90)=0 - DO 170 I=1,N - IF(K(I,3)/MSTU(5).EQ.0) GOTO 170 - I1=I1+1 - DO 150 J=1,5 - K(I1,J)=K(I,J) - P(I1,J)=P(I,J) - V(I1,J)=V(I,J) - 150 CONTINUE - K(I1,3)=MOD(K(I1,3),MSTU(5)) - DO 160 IZ=1,MSTU90 - IF(I.EQ.MSTU(90+IZ)) THEN - MSTU(90)=MSTU(90)+1 - MSTU(90+MSTU(90))=I1 - PARU(90+MSTU(90))=PARU(90+IZ) - ENDIF - 160 CONTINUE - 170 CONTINUE - IF(I1.LT.N) MSTU(3)=0 - IF(I1.LT.N) MSTU(70)=0 - N=I1 - -C...Fill in some missing daughter pointers (lost in colour flow). - ELSEIF(MEDIT.EQ.16) THEN - DO 190 I=1,N - IF(K(I,1).LE.10.OR.K(I,1).GT.20) GOTO 190 - IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 190 -C...Find daughters who point to mother. - DO 180 I1=I+1,N - IF(K(I1,3).NE.I) THEN - ELSEIF(K(I,4).EQ.0) THEN - K(I,4)=I1 - ELSE - K(I,5)=I1 - ENDIF - 180 CONTINUE - IF(K(I,5).EQ.0) K(I,5)=K(I,4) - IF(K(I,4).NE.0) GOTO 190 -C...Find daughters who point to documentation version of mother. - IM=K(I,3) - IF(IM.LE.0.OR.IM.GE.I) GOTO 190 - IF(K(IM,1).LE.20.OR.K(IM,1).GT.30) GOTO 190 - IF(K(IM,2).NE.K(I,2).OR.ABS(P(IM,5)-P(I,5)).GT.1E-2) GOTO 190 - DO 182 I1=I+1,N - IF(K(I1,3).NE.IM) THEN - ELSEIF(K(I,4).EQ.0) THEN - K(I,4)=I1 - ELSE - K(I,5)=I1 - ENDIF - 182 CONTINUE - IF(K(I,5).EQ.0) K(I,5)=K(I,4) - IF(K(I,4).NE.0) GOTO 190 -C...Find daughters who point to documentation daughters who, -C...in their turn, point to documentation mother. - ID1=IM - ID2=IM - DO 184 I1=IM+1,I-1 - IF(K(I1,3).EQ.IM.AND.K(I1,1).GT.20.AND.K(I1,1).LE.30) THEN - ID2=I1 - IF(ID1.EQ.IM) ID1=I1 - ENDIF - 184 CONTINUE - DO 186 I1=I+1,N - IF(K(I1,3).NE.ID1.AND.K(I1,3).NE.ID2) THEN - ELSEIF(K(I,4).EQ.0) THEN - K(I,4)=I1 - ELSE - K(I,5)=I1 - ENDIF - 186 CONTINUE - IF(K(I,5).EQ.0) K(I,5)=K(I,4) - 190 CONTINUE - -C...Save top entries at bottom of LUJETS commonblock. - ELSEIF(MEDIT.EQ.21) THEN - IF(2*N.GE.MSTU(4)) THEN - CALL LUERRM(11,'(LUEDIT:) no more memory left in LUJETS') - RETURN - ENDIF - DO 210 I=1,N - DO 200 J=1,5 - K(MSTU(4)-I,J)=K(I,J) - P(MSTU(4)-I,J)=P(I,J) - V(MSTU(4)-I,J)=V(I,J) - 200 CONTINUE - 210 CONTINUE - MSTU(32)=N - -C...Restore bottom entries of commonblock LUJETS to top. - ELSEIF(MEDIT.EQ.22) THEN - DO 230 I=1,MSTU(32) - DO 220 J=1,5 - K(I,J)=K(MSTU(4)-I,J) - P(I,J)=P(MSTU(4)-I,J) - V(I,J)=V(MSTU(4)-I,J) - 220 CONTINUE - 230 CONTINUE - N=MSTU(32) - -C...Mark primary entries at top of commonblock LUJETS as untreated. - ELSEIF(MEDIT.EQ.23) THEN - I1=0 - DO 240 I=1,N - KH=K(I,3) - IF(KH.GE.1) THEN - IF(K(KH,1).GT.20) KH=0 - ENDIF - IF(KH.NE.0) GOTO 250 - I1=I1+1 - IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10 - 240 CONTINUE - 250 N=I1 - -C...Place largest axis along z axis and second largest in xy plane. - ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN - CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61),1), - & P(MSTU(61),2)),0D0,0D0,0D0) - CALL LUDBRB(1,N+MSTU(3),-ULANGL(P(MSTU(61),3), - & P(MSTU(61),1)),0.,0D0,0D0,0D0) - CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61)+1,1), - & P(MSTU(61)+1,2)),0D0,0D0,0D0) - IF(MEDIT.EQ.31) RETURN - -C...Rotate to put slim jet along +z axis. - DO 260 IS=1,2 - NS(IS)=0 - PTS(IS)=0. - PLS(IS)=0. - 260 CONTINUE - DO 270 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270 - IF(MSTU(41).GE.2) THEN - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. - & KC.EQ.18) GOTO 270 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) - & GOTO 270 - ENDIF - IS=2.-SIGN(0.5,P(I,3)) - NS(IS)=NS(IS)+1 - PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2) - 270 CONTINUE - IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2) - & CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0) - -C...Rotate to put second largest jet into -z,+x quadrant. - DO 280 I=1,N - IF(P(I,3).GE.0.) GOTO 280 - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 280 - IF(MSTU(41).GE.2) THEN - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. - & KC.EQ.18) GOTO 280 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) - & GOTO 280 - ENDIF - IS=2.-SIGN(0.5,P(I,1)) - PLS(IS)=PLS(IS)-P(I,3) - 280 CONTINUE - IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1), - & 0D0,0D0,0D0) - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LULIST(MLIST) - -C...Purpose: to give program heading, or list an event, or particle -C...data, or current parameter values. - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ - CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHDL(7)*4 - DIMENSION PS(6) - DATA CHDL/'(())',' ','()','!!','<>','==','(==)'/ - -C...Initialization printout: version number and date of last change. - IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN - CALL LULOGO - MSTU(12)=0 - IF(MLIST.EQ.0) RETURN - ENDIF - -C...List event data, including additional lines after N. - IF(MLIST.GE.1.AND.MLIST.LE.3) THEN - IF(MLIST.EQ.1) WRITE(MSTU(11),5100) - IF(MLIST.EQ.2) WRITE(MSTU(11),5200) - IF(MLIST.EQ.3) WRITE(MSTU(11),5300) - LMX=12 - IF(MLIST.GE.2) LMX=16 - ISTR=0 - IMAX=N - IF(MSTU(2).GT.0) IMAX=MSTU(2) - DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3))) - IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120 - -C...Get particle name, pad it and check it is not too long. - CALL LUNAME(K(I,2),CHAP) - LEN=0 - DO 100 LEM=1,16 - IF(CHAP(LEM:LEM).NE.' ') LEN=LEM - 100 CONTINUE - MDL=(K(I,1)+19)/10 - LDL=0 - IF(MDL.EQ.2.OR.MDL.GE.8) THEN - CHAC=CHAP - IF(LEN.GT.LMX) CHAC(LMX:LMX)='?' - ELSE - LDL=1 - IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2 - IF(LEN.EQ.0) THEN - CHAC=CHDL(MDL)(1:2*LDL)//' ' - ELSE - CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))// - & CHDL(MDL)(LDL+1:2*LDL)//' ' - IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?' - ENDIF - ENDIF - -C...Add information on string connection. - IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12) - & THEN - KC=LUCOMP(K(I,2)) - KCC=0 - IF(KC.NE.0) KCC=KCHG(KC,2) - IF(IABS(K(I,2)).EQ.39) THEN - IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X' - ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN - ISTR=1 - IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A' - ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN - IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I' - ELSEIF(KCC.NE.0) THEN - ISTR=0 - IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V' - ENDIF - ENDIF - -C...Write data for particle/jet. - IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN - WRITE(MSTU(11),5400) I,CHAC(1:12),(K(I,J1),J1=1,3), - & (P(I,J2),J2=1,5) - ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN - WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3), - & (P(I,J2),J2=1,5) - ELSEIF(MLIST.EQ.1) THEN - WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3), - & (P(I,J2),J2=1,5) - ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR. - & K(I,1).EQ.14)) THEN - WRITE(MSTU(11),5700) I,CHAC,(K(I,J1),J1=1,3), - & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000), - & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000), - & (P(I,J2),J2=1,5) - ELSE - WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5) - ENDIF - IF(MLIST.EQ.3) WRITE(MSTU(11),5900) (V(I,J),J=1,5) - -C...Insert extra separator lines specified by user. - IF(MSTU(70).GE.1) THEN - ISEP=0 - DO 110 J=1,MIN(10,MSTU(70)) - IF(I.EQ.MSTU(70+J)) ISEP=1 - 110 CONTINUE - IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),6000) - IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),6100) - ENDIF - 120 CONTINUE - -C...Sum of charges and momenta. - DO 130 J=1,6 - PS(J)=PLU(0,J) - 130 CONTINUE - IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN - WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5) - ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN - WRITE(MSTU(11),6300) PS(6),(PS(J),J=1,5) - ELSEIF(MLIST.EQ.1) THEN - WRITE(MSTU(11),6400) PS(6),(PS(J),J=1,5) - ELSE - WRITE(MSTU(11),6500) PS(6),(PS(J),J=1,5) - ENDIF - -C...Give simple list of KF codes defined in program. - ELSEIF(MLIST.EQ.11) THEN - WRITE(MSTU(11),6600) - DO 140 KF=1,40 - CALL LUNAME(KF,CHAP) - CALL LUNAME(-KF,CHAN) - IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP - IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - 140 CONTINUE - DO 170 KFLS=1,3,2 - DO 160 KFLA=1,8 - DO 150 KFLB=1,KFLA-(3-KFLS)/2 - KF=1000*KFLA+100*KFLB+KFLS - CALL LUNAME(KF,CHAP) - CALL LUNAME(-KF,CHAN) - WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - 150 CONTINUE - 160 CONTINUE - 170 CONTINUE - KF=130 - CALL LUNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - KF=310 - CALL LUNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - DO 200 KMUL=0,5 - KFLS=3 - IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 - IF(KMUL.EQ.5) KFLS=5 - KFLR=0 - IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1 - IF(KMUL.EQ.4) KFLR=2 - DO 190 KFLB=1,8 - DO 180 KFLC=1,KFLB-1 - KF=10000*KFLR+100*KFLB+10*KFLC+KFLS - CALL LUNAME(KF,CHAP) - CALL LUNAME(-KF,CHAN) - WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - 180 CONTINUE - KF=10000*KFLR+110*KFLB+KFLS - CALL LUNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - 190 CONTINUE - 200 CONTINUE - KF=30443 - CALL LUNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - KF=30553 - CALL LUNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - DO 240 KFLSP=1,3 - KFLS=2+2*(KFLSP/3) - DO 230 KFLA=1,8 - DO 220 KFLB=1,KFLA - DO 210 KFLC=1,KFLB - IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 210 - IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 210 - IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS - IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS - CALL LUNAME(KF,CHAP) - CALL LUNAME(-KF,CHAN) - WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - 210 CONTINUE - 220 CONTINUE - 230 CONTINUE - 240 CONTINUE - -C...List parton/particle data table. Check whether to be listed. - ELSEIF(MLIST.EQ.12) THEN - WRITE(MSTU(11),6800) - MSTJ24=MSTJ(24) - MSTJ(24)=0 - KFMAX=30553 - IF(MSTU(2).NE.0) KFMAX=MSTU(2) - DO 270 KF=MAX(1,MSTU(1)),KFMAX - KC=LUCOMP(KF) - IF(KC.EQ.0) GOTO 270 - IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 270 - IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10), - & MOD(KF/100,10)).GT.MSTU(14)) GOTO 270 - IF(MSTU(14).GT.0.AND.KF.GT.100.AND.KC.EQ.90) GOTO 270 - -C...Find particle name and mass. Print information. - CALL LUNAME(KF,CHAP) - IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 270 - CALL LUNAME(-KF,CHAN) - PM=ULMASS(KF) - WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2), - & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1) - -C...Particle decay: channel number, branching ration, matrix element, -C...decay products. - IF(KF.GT.100.AND.KC.LE.100) GOTO 270 - DO 260 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 - DO 250 J=1,5 - CALL LUNAME(KFDP(IDC,J),CHAD(J)) - 250 CONTINUE - WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC), - & (CHAD(J),J=1,5) - 260 CONTINUE - 270 CONTINUE - MSTJ(24)=MSTJ24 - -C...List parameter value table. - ELSEIF(MLIST.EQ.13) THEN - WRITE(MSTU(11),7100) - DO 280 I=1,200 - WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I) - 280 CONTINUE - ENDIF - -C...Format statements for output on unit MSTU(11) (by default 6). - 5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS', - &5X,'KF orig p_x p_y p_z E m'/) - 5200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet', - &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', - &' P(I,2) P(I,3) P(I,4) P(I,5)'/) - 5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j', - &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', - &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X, - &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/) - 5400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3) - 5500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2) - 5600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1) - 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5) - 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5) - 5900 FORMAT(66X,5(1X,F12.3)) - 6000 FORMAT(1X,78('=')) - 6100 FORMAT(1X,130('=')) - 6200 FORMAT(19X,'sum:',F6.2,5X,5F9.3) - 6300 FORMAT(19X,'sum:',F6.2,5X,5F9.2) - 6400 FORMAT(19X,'sum:',F6.2,5X,5F9.1) - 6500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:', - &5F13.5) - 6600 FORMAT(///20X,'List of KF codes in program'/) - 6700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16) - 6800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X, - &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X, - &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off', - &1X,'ME',3X,'Br.rat.',4X,'decay products') - 6900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5), - &2X,F12.5,3X,I2) - 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16) - 7100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)', - &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)') - 7200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5) - - RETURN - END - -C********************************************************************* - - SUBROUTINE LULOGO - -C...Purpose: to write logo for JETSET and PYTHIA programs. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - SAVE /LUDAT1/ - SAVE /PYPARS/ - CHARACTER MONTH(12)*3, LOGO(48)*32, REFER(22)*36, LINE*79, - &VERS*1, SUBV*3, DATE*2, YEAR*4 - -C...Data on months, logo, titles, and references. - DATA MONTH/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', - &'Oct','Nov','Dec'/ - DATA (LOGO(J),J=1,10)/ - &'PPP Y Y TTTTT H H III A ', - &'P P Y Y T H H I A A ', - &'PPP Y T HHHHH I AAAAA', - &'P Y T H H I A A', - &'P Y T H H III A A', - &'JJJJ EEEE TTTTT SSS EEEE TTTTT', - &' J E T S E T ', - &' J EEE T SSS EEE T ', - &'J J E T S E T ', - &' JJ EEEE T SSS EEEE T '/ - DATA (LOGO(J),J=11,29)/ - &' *......* ', - &' *:::!!:::::::::::* ', - &' *::::::!!::::::::::::::* ', - &' *::::::::!!::::::::::::::::* ', - &' *:::::::::!!:::::::::::::::::* ', - &' *:::::::::!!:::::::::::::::::* ', - &' *::::::::!!::::::::::::::::*! ', - &' *::::::!!::::::::::::::* !! ', - &' !! *:::!!:::::::::::* !! ', - &' !! !* -><- * !! ', - &' !! !! !! ', - &' !! !! !! ', - &' !! !! ', - &' !! ep !! ', - &' !! !! ', - &' !! pp !! ', - &' !! e+e- !! ', - &' !! !! ', - &' !! '/ - DATA (LOGO(J),J=30,48)/ - &'Welcome to the Lund Monte Carlo!', - &' ', - &' This is PYTHIA version x.xxx ', - &'Last date of change: xx xxx 199x', - &' ', - &' This is JETSET version x.xxx ', - &'Last date of change: xx xxx 199x', - &' ', - &' Main author: ', - &' Torbjorn Sjostrand ', - &' Dept. of theoretical physics 2 ', - &' University of Lund ', - &' Solvegatan 14A ', - &' S-223 62 Lund, Sweden ', - &' phone: +46 - 46 - 222 48 16 ', - &' E-mail: torbjorn@thep.lu.se ', - &' ', - &' Copyright Torbjorn Sjostrand ', - &' and CERN, Geneva 1993 '/ - DATA (REFER(J),J=1,6)/ - &'The latest program versions and docu', - &'mentation is found on WWW address ', - &'http://thep.lu.se/tf2/staff/torbjorn', - &'/Welcome.html ', - &' ', - &' '/ - DATA (REFER(J),J=7,22)/ - &'When you cite these programs, priori', - &'ty should always be given to the ', - &'latest published description. Curren', - &'tly this is ', - &'T. Sjostrand, Computer Physics Commu', - &'n. 82 (1994) 74. ', - &'The most recent long description (un', - &'published) is ', - &'T. Sjostrand, LU TP 95-20 and CERN-T', - &'H.7112/93 (revised August 1995). ', - &'Also remember that the programs, to ', - &'a large extent, represent original ', - &'physics research. Other publications', - &' of special relevance to your ', - &'studies may therefore deserve separa', - &'te mention. '/ - -C...Check if PYTHIA linked. - IF(MSTP(183)/10.NE.199) THEN - LOGO(32)=' Warning: PYTHIA is not loaded! ' - LOGO(33)='Did you remember to link PYDATA?' - ELSE - WRITE(VERS,'(I1)') MSTP(181) - LOGO(32)(26:26)=VERS - WRITE(SUBV,'(I3)') MSTP(182) - LOGO(32)(28:30)=SUBV - WRITE(DATE,'(I2)') MSTP(185) - LOGO(33)(22:23)=DATE - LOGO(33)(25:27)=MONTH(MSTP(184)) - WRITE(YEAR,'(I4)') MSTP(183) - LOGO(33)(29:32)=YEAR - ENDIF - -C...Check if JETSET linked. - IF(MSTU(183)/10.NE.199) THEN - LOGO(35)=' Error: JETSET is not loaded! ' - LOGO(36)='Did you remember to link LUDATA?' - ELSE - WRITE(VERS,'(I1)') MSTU(181) - LOGO(35)(26:26)=VERS - WRITE(SUBV,'(I3)') MSTU(182) - LOGO(35)(28:30)=SUBV - WRITE(DATE,'(I2)') MSTU(185) - LOGO(36)(22:23)=DATE - LOGO(36)(25:27)=MONTH(MSTU(184)) - WRITE(YEAR,'(I4)') MSTU(183) - LOGO(36)(29:32)=YEAR - ENDIF - -C...Loop over lines in header. Define page feed and side borders. - DO 100 ILIN=1,48 - LINE=' ' - IF(ILIN.EQ.1) THEN - LINE(1:1)='1' - ELSE - LINE(2:3)='**' - LINE(78:79)='**' - ENDIF - -C...Separator lines and logos. - IF(ILIN.EQ.2.OR.ILIN.EQ.3.OR.ILIN.EQ.47.OR.ILIN.EQ.48) THEN - LINE(4:77)='***********************************************'// - & '***************************' - ELSEIF(ILIN.GE.6.AND.ILIN.LE.10) THEN - LINE(6:37)=LOGO(ILIN-5) - LINE(44:75)=LOGO(ILIN) - ELSEIF(ILIN.GE.13.AND.ILIN.LE.31) THEN - LINE(6:37)=LOGO(ILIN-2) - LINE(44:75)=LOGO(ILIN+17) - ELSEIF(ILIN.GE.34.AND.ILIN.LE.44) THEN - LINE(5:40)=REFER(2*ILIN-67) - LINE(41:76)=REFER(2*ILIN-66) - ENDIF - -C...Write lines to appropriate unit. - IF(MSTU(183)/10.EQ.199) THEN - WRITE(MSTU(11),'(A79)') LINE - ELSE - WRITE(*,'(A79)') LINE - ENDIF - 100 CONTINUE - -C...Check that matching subversions are linked. - IF(MSTU(183)/10.EQ.199.AND.MSTP(183)/10.EQ.199) THEN - IF(MSTU(182).LT.MSTP(186)) WRITE(MSTU(11), - & '(/'' Warning: JETSET subversion too old for PYTHIA''/)') - IF(MSTP(182).LT.MSTU(186)) WRITE(MSTU(11), - & '(/'' Warning: PYTHIA subversion too old for JETSET''/)') - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUUPDA(MUPDA,LFN) - -C...Purpose: to facilitate the updating of particle and decay data. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) - COMMON/LUDAT4/CHAF(500) - CHARACTER CHAF*8 - SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/ - CHARACTER CHINL*80,CHKC*4,CHVAR(19)*9,CHLIN*72, - &CHBLK(20)*72,CHOLD*12,CHTMP*12,CHNEW*12,CHCOM*12 - DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','PMAS(I,1)', - &'PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)','MDCY(I,2)', - &'MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ','KFDP(I,1)', - &'KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)','CHAF(I) '/ - -C...Write information on file for editing. - IF(MSTU(12).GE.1) CALL LULIST(0) - IF(MUPDA.EQ.1) THEN - DO 110 KC=1,MSTU(6) - WRITE(LFN,5000) KC,CHAF(KC),(KCHG(KC,J1),J1=1,3), - & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) - DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 - WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), - & (KFDP(IDC,J),J=1,5) - 100 CONTINUE - 110 CONTINUE - -C...Reset variables and read information from edited file. - ELSEIF(MUPDA.EQ.2) THEN - DO 130 I=1,MSTU(7) - MDME(I,1)=1 - MDME(I,2)=0 - BRAT(I)=0. - DO 120 J=1,5 - KFDP(I,J)=0 - 120 CONTINUE - 130 CONTINUE - KC=0 - IDC=0 - NDC=0 - 140 READ(LFN,5200,END=150) CHINL - IF(CHINL(2:5).NE.' ') THEN - CHKC=CHINL(2:5) - IF(KC.NE.0) THEN - MDCY(KC,2)=0 - IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC - MDCY(KC,3)=NDC - ENDIF - READ(CHKC,5300) KC - IF(KC.LE.0.OR.KC.GT.MSTU(6)) CALL LUERRM(27, - & '(LUUPDA:) Read KC code illegal, KC ='//CHKC) - READ(CHINL,5000) KCR,CHAF(KC),(KCHG(KC,J1),J1=1,3), - & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) - NDC=0 - ELSE - IDC=IDC+1 - NDC=NDC+1 - IF(IDC.GE.MSTU(7)) CALL LUERRM(27, - & '(LUUPDA:) Decay data arrays full by KC ='//CHKC) - READ(CHINL,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), - & (KFDP(IDC,J),J=1,5) - ENDIF - GOTO 140 - 150 MDCY(KC,2)=0 - IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC - MDCY(KC,3)=NDC - -C...Perform possible tests that new information is consistent. - MSTJ24=MSTJ(24) - MSTJ(24)=0 - DO 180 KC=1,MSTU(6) - WRITE(CHKC,5300) KC - IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3), - & PMAS(KC,4)).LT.0..OR.MDCY(KC,3).LT.0) CALL LUERRM(17, - & '(LUUPDA:) Mass/width/life/(# channels) wrong for KC ='//CHKC) - BRSUM=0. - DO 170 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 - IF(MDME(IDC,2).GT.80) GOTO 170 - KQ=KCHG(KC,1) - PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64) - MERR=0 - DO 160 J=1,5 - KP=KFDP(IDC,J) - IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN - ELSEIF(LUCOMP(KP).EQ.0) THEN - MERR=3 - ELSE - KQ=KQ-LUCHGE(KP) - PMS=PMS-ULMASS(KP) - ENDIF - 160 CONTINUE - IF(KQ.NE.0) MERR=MAX(2,MERR) - IF(KFDP(IDC,2).NE.0.AND.(KC.LE.20.OR.KC.GT.40).AND. - & (KC.LE.80.OR.KC.GT.100).AND.MDME(IDC,2).NE.34.AND. - & MDME(IDC,2).NE.61.AND.PMS.LT.0.) MERR=MAX(1,MERR) - IF(MERR.EQ.3) CALL LUERRM(17, - & '(LUUPDA:) Unknown particle code in decay of KC ='//CHKC) - IF(MERR.EQ.2) CALL LUERRM(17, - & '(LUUPDA:) Charge not conserved in decay of KC ='//CHKC) - IF(MERR.EQ.1) CALL LUERRM(7, - & '(LUUPDA:) Kinematically unallowed decay of KC ='//CHKC) - BRSUM=BRSUM+BRAT(IDC) - 170 CONTINUE - WRITE(CHTMP,5500) BRSUM - IF(ABS(BRSUM).GT.0.0005.AND.ABS(BRSUM-1.).GT.0.0005) CALL - & LUERRM(7,'(LUUPDA:) Sum of branching ratios is '//CHTMP(5:12)// - & ' for KC ='//CHKC) - 180 CONTINUE - MSTJ(24)=MSTJ24 - -C...Initialize writing of DATA statements for inclusion in program. - ELSEIF(MUPDA.EQ.3) THEN - DO 250 IVAR=1,19 - NDIM=MSTU(6) - IF(IVAR.GE.11.AND.IVAR.LE.18) NDIM=MSTU(7) - NLIN=1 - CHLIN=' ' - CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I= 1, )/' - LLIN=35 - CHOLD='START' - -C...Loop through variables for conversion to characters. - DO 230 IDIM=1,NDIM - IF(IVAR.EQ.1) WRITE(CHTMP,5400) KCHG(IDIM,1) - IF(IVAR.EQ.2) WRITE(CHTMP,5400) KCHG(IDIM,2) - IF(IVAR.EQ.3) WRITE(CHTMP,5400) KCHG(IDIM,3) - IF(IVAR.EQ.4) WRITE(CHTMP,5500) PMAS(IDIM,1) - IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,2) - IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,3) - IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,4) - IF(IVAR.EQ.8) WRITE(CHTMP,5400) MDCY(IDIM,1) - IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,2) - IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,3) - IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDME(IDIM,1) - IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,2) - IF(IVAR.EQ.13) WRITE(CHTMP,5500) BRAT(IDIM) - IF(IVAR.EQ.14) WRITE(CHTMP,5400) KFDP(IDIM,1) - IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,2) - IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,3) - IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,4) - IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,5) - IF(IVAR.EQ.19) CHTMP=CHAF(IDIM) - -C...Length of variable, trailing decimal zeros, quotation marks. - LLOW=1 - LHIG=1 - DO 190 LL=1,12 - IF(CHTMP(13-LL:13-LL).NE.' ') LLOW=13-LL - IF(CHTMP(LL:LL).NE.' ') LHIG=LL - 190 CONTINUE - CHNEW=CHTMP(LLOW:LHIG)//' ' - LNEW=1+LHIG-LLOW - IF((IVAR.GE.4.AND.IVAR.LE.7).OR.IVAR.EQ.13) THEN - LNEW=LNEW+1 - 200 LNEW=LNEW-1 - IF(CHNEW(LNEW:LNEW).EQ.'0') GOTO 200 - IF(LNEW.EQ.1) CHNEW(1:2)='0.' - IF(LNEW.EQ.1) LNEW=2 - ELSEIF(IVAR.EQ.19) THEN - DO 210 LL=LNEW,1,-1 - IF(CHNEW(LL:LL).EQ.'''') THEN - CHTMP=CHNEW - CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11) - LNEW=LNEW+1 - ENDIF - 210 CONTINUE - CHTMP=CHNEW - CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//'''' - LNEW=LNEW+2 - ENDIF - -C...Form composite character string, often including repetition counter. - IF(CHNEW.NE.CHOLD) THEN - NRPT=1 - CHOLD=CHNEW - CHCOM=CHNEW - LCOM=LNEW - ELSE - LRPT=LNEW+1 - IF(NRPT.GE.2) LRPT=LNEW+3 - IF(NRPT.GE.10) LRPT=LNEW+4 - IF(NRPT.GE.100) LRPT=LNEW+5 - IF(NRPT.GE.1000) LRPT=LNEW+6 - LLIN=LLIN-LRPT - NRPT=NRPT+1 - WRITE(CHTMP,5400) NRPT - LRPT=1 - IF(NRPT.GE.10) LRPT=2 - IF(NRPT.GE.100) LRPT=3 - IF(NRPT.GE.1000) LRPT=4 - CHCOM(1:LRPT+1+LNEW)=CHTMP(13-LRPT:12)//'*'//CHNEW(1:LNEW) - LCOM=LRPT+1+LNEW - ENDIF - -C...Add characters to end of line, to new line (after storing old line), -C...or to new block of lines (after writing old block). - IF(LLIN+LCOM.LE.70) THEN - CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//',' - LLIN=LLIN+LCOM+1 - ELSEIF(NLIN.LE.19) THEN - CHLIN(LLIN+1:72)=' ' - CHBLK(NLIN)=CHLIN - NLIN=NLIN+1 - CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//',' - LLIN=6+LCOM+1 - ELSE - CHLIN(LLIN:72)='/'//' ' - CHBLK(NLIN)=CHLIN - WRITE(CHTMP,5400) IDIM-NRPT - CHBLK(1)(30:33)=CHTMP(9:12) - DO 220 ILIN=1,NLIN - WRITE(LFN,5600) CHBLK(ILIN) - 220 CONTINUE - NLIN=1 - CHLIN=' ' - CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)//',I= , )/'// - & CHCOM(1:LCOM)//',' - WRITE(CHTMP,5400) IDIM-NRPT+1 - CHLIN(25:28)=CHTMP(9:12) - LLIN=35+LCOM+1 - ENDIF - 230 CONTINUE - -C...Write final block of lines. - CHLIN(LLIN:72)='/'//' ' - CHBLK(NLIN)=CHLIN - WRITE(CHTMP,5400) NDIM - CHBLK(1)(30:33)=CHTMP(9:12) - DO 240 ILIN=1,NLIN - WRITE(LFN,5600) CHBLK(ILIN) - 240 CONTINUE - 250 CONTINUE - ENDIF - -C...Formats for reading and writing particle data. - 5000 FORMAT(1X,I4,2X,A8,3I3,3F12.5,2X,F12.5,I3) - 5100 FORMAT(5X,2I5,F12.5,5I8) - 5200 FORMAT(A80) - 5300 FORMAT(I4) - 5400 FORMAT(I12) - 5500 FORMAT(F12.5) - 5600 FORMAT(A72) - - RETURN - END - -C********************************************************************* - - FUNCTION KLU(I,J) - -C...Purpose: to provide various integer-valued event related data. - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - -C...Default value. For I=0 number of entries, number of stable entries -C...or 3 times total charge. - KLU=0 - IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN - ELSEIF(I.EQ.0.AND.J.EQ.1) THEN - KLU=N - ELSEIF(I.EQ.0.AND.(J.EQ.2.OR.J.EQ.6)) THEN - DO 100 I1=1,N - IF(J.EQ.2.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+1 - IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+ - & LUCHGE(K(I1,2)) - 100 CONTINUE - ELSEIF(I.EQ.0) THEN - -C...For I > 0 direct readout of K matrix or charge. - ELSEIF(J.LE.5) THEN - KLU=K(I,J) - ELSEIF(J.EQ.6) THEN - KLU=LUCHGE(K(I,2)) - -C...Status (existing/fragmented/decayed), parton/hadron separation. - ELSEIF(J.LE.8) THEN - IF(K(I,1).GE.1.AND.K(I,1).LE.10) KLU=1 - IF(J.EQ.8) KLU=KLU*K(I,2) - ELSEIF(J.LE.12) THEN - KFA=IABS(K(I,2)) - KC=LUCOMP(KFA) - KQ=0 - IF(KC.NE.0) KQ=KCHG(KC,2) - IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) KLU=K(I,2) - IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) KLU=K(I,2) - IF(J.EQ.11) KLU=KC - IF(J.EQ.12) KLU=KQ*ISIGN(1,K(I,2)) - -C...Heaviest flavour in hadron/diquark. - ELSEIF(J.EQ.13) THEN - KFA=IABS(K(I,2)) - KLU=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10) - IF(KFA.LT.10) KLU=KFA - IF(MOD(KFA/1000,10).NE.0) KLU=MOD(KFA/1000,10) - KLU=KLU*ISIGN(1,K(I,2)) - -C...Particle history: generation, ancestor, rank. - ELSEIF(J.LE.15) THEN - I2=I - I1=I - 110 KLU=KLU+1 - I2=I1 - I1=K(I1,3) - IF(I1.GT.0.AND.K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110 - IF(J.EQ.15) KLU=I2 - ELSEIF(J.EQ.16) THEN - KFA=IABS(K(I,2)) - IF(K(I,1).LE.20.AND.((KFA.GE.11.AND.KFA.LE.20).OR.KFA.EQ.22.OR. - & (KFA.GT.100.AND.MOD(KFA/10,10).NE.0))) THEN - I1=I - 120 I2=I1 - I1=K(I1,3) - IF(I1.GT.0) THEN - KFAM=IABS(K(I1,2)) - ILP=1 - IF(KFAM.NE.0.AND.KFAM.LE.10) ILP=0 - IF(KFAM.EQ.21.OR.KFAM.EQ.91.OR.KFAM.EQ.92.OR.KFAM.EQ.93) - & ILP=0 - IF(KFAM.GT.100.AND.MOD(KFAM/10,10).EQ.0) ILP=0 - IF(ILP.EQ.1) GOTO 120 - ENDIF - IF(K(I1,1).EQ.12) THEN - DO 130 I3=I1+1,I2 - IF(K(I3,3).EQ.K(I2,3).AND.K(I3,2).NE.91.AND.K(I3,2).NE.92 - & .AND.K(I3,2).NE.93) KLU=KLU+1 - 130 CONTINUE - ELSE - I3=I2 - 140 KLU=KLU+1 - I3=I3+1 - IF(I3.LT.N.AND.K(I3,3).EQ.K(I2,3)) GOTO 140 - ENDIF - ENDIF - -C...Particle coming from collapsing jet system or not. - ELSEIF(J.EQ.17) THEN - I1=I - 150 KLU=KLU+1 - I3=I1 - I1=K(I1,3) - I0=MAX(1,I1) - KC=LUCOMP(K(I0,2)) - IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN - IF(KLU.EQ.1) KLU=-1 - IF(KLU.GT.1) KLU=0 - RETURN - ENDIF - IF(KCHG(KC,2).EQ.0) GOTO 150 - IF(K(I1,1).NE.12) KLU=0 - IF(K(I1,1).NE.12) RETURN - I2=I1 - 160 I2=I2+1 - IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 160 - K3M=K(I3-1,3) - IF(K3M.GE.I1.AND.K3M.LE.I2) KLU=0 - K3P=K(I3+1,3) - IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) KLU=0 - -C...Number of decay products. Colour flow. - ELSEIF(J.EQ.18) THEN - IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) KLU=MAX(0,K(I,5)-K(I,4)+1) - IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) KLU=0 - ELSEIF(J.LE.22) THEN - IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN - IF(J.EQ.19) KLU=MOD(K(I,4)/MSTU(5),MSTU(5)) - IF(J.EQ.20) KLU=MOD(K(I,5)/MSTU(5),MSTU(5)) - IF(J.EQ.21) KLU=MOD(K(I,4),MSTU(5)) - IF(J.EQ.22) KLU=MOD(K(I,5),MSTU(5)) - ELSE - ENDIF - - RETURN - END - -C********************************************************************* - - FUNCTION PLU(I,J) - -C...Purpose: to provide various real-valued event related data. - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - DIMENSION PSUM(4) - -C...Set default value. For I = 0 sum of momenta or charges, -C...or invariant mass of system. - PLU=0. - IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN - ELSEIF(I.EQ.0.AND.J.LE.4) THEN - DO 100 I1=1,N - IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+P(I1,J) - 100 CONTINUE - ELSEIF(I.EQ.0.AND.J.EQ.5) THEN - DO 120 J1=1,4 - PSUM(J1)=0. - DO 110 I1=1,N - IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PSUM(J1)=PSUM(J1)+P(I1,J1) - 110 CONTINUE - 120 CONTINUE - PLU=SQRT(MAX(0.,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2)) - ELSEIF(I.EQ.0.AND.J.EQ.6) THEN - DO 130 I1=1,N - IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+LUCHGE(K(I1,2))/3. - 130 CONTINUE - ELSEIF(I.EQ.0) THEN - -C...Direct readout of P matrix. - ELSEIF(J.LE.5) THEN - PLU=P(I,J) - -C...Charge, total momentum, transverse momentum, transverse mass. - ELSEIF(J.LE.12) THEN - IF(J.EQ.6) PLU=LUCHGE(K(I,2))/3. - IF(J.EQ.7.OR.J.EQ.8) PLU=P(I,1)**2+P(I,2)**2+P(I,3)**2 - IF(J.EQ.9.OR.J.EQ.10) PLU=P(I,1)**2+P(I,2)**2 - IF(J.EQ.11.OR.J.EQ.12) PLU=P(I,5)**2+P(I,1)**2+P(I,2)**2 - IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PLU=SQRT(PLU) - -C...Theta and phi angle in radians or degrees. - ELSEIF(J.LE.16) THEN - IF(J.LE.14) PLU=ULANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) - IF(J.GE.15) PLU=ULANGL(P(I,1),P(I,2)) - IF(J.EQ.14.OR.J.EQ.16) PLU=PLU*180./PARU(1) - -C...True rapidity, rapidity with pion mass, pseudorapidity. - ELSEIF(J.LE.19) THEN - PMR=0. - IF(J.EQ.17) PMR=P(I,5) - IF(J.EQ.18) PMR=ULMASS(211) - PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2) - PLU=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), - & 1E20)),P(I,3)) - -C...Energy and momentum fractions (only to be used in CM frame). - ELSEIF(J.LE.25) THEN - IF(J.EQ.20) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21) - IF(J.EQ.21) PLU=2.*P(I,3)/PARU(21) - IF(J.EQ.22) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21) - IF(J.EQ.23) PLU=2.*P(I,4)/PARU(21) - IF(J.EQ.24) PLU=(P(I,4)+P(I,3))/PARU(21) - IF(J.EQ.25) PLU=(P(I,4)-P(I,3))/PARU(21) - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUSPHE(SPH,APL) - -C...Purpose: to perform sphericity tensor analysis to give sphericity, -C...aplanarity and the related event axes. - 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),SV(3,3) - -C...Calculate matrix to be diagonalized. - NP=0 - DO 110 J1=1,3 - DO 100 J2=J1,3 - SM(J1,J2)=0. - 100 CONTINUE - 110 CONTINUE - PS=0. - DO 140 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140 - IF(MSTU(41).GE.2) THEN - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. - & KC.EQ.18) GOTO 140 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) - & GOTO 140 - ENDIF - NP=NP+1 - PA=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) - PWT=1. - IF(ABS(PARU(41)-2.).GT.0.001) PWT=MAX(1E-10,PA)**(PARU(41)-2.) - DO 130 J1=1,3 - DO 120 J2=J1,3 - SM(J1,J2)=SM(J1,J2)+PWT*P(I,J1)*P(I,J2) - 120 CONTINUE - 130 CONTINUE - PS=PS+PWT*PA**2 - 140 CONTINUE - -C...Very low multiplicities (0 or 1) not considered. - IF(NP.LE.1) THEN - CALL LUERRM(8,'(LUSPHE:) too few particles for analysis') - SPH=-1. - APL=-1. - RETURN - ENDIF - DO 160 J1=1,3 - DO 150 J2=J1,3 - SM(J1,J2)=SM(J1,J2)/PS - 150 CONTINUE - 160 CONTINUE - -C...Find eigenvalues to matrix (third degree equation). - 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.) - P(N+1,4)=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP) - P(N+3,4)=1./3.+SQRT(-SQ)*MIN(2.*SP,-SQRT(3.*(1.-SP**2))-SP) - P(N+2,4)=1.-P(N+1,4)-P(N+3,4) - IF(P(N+2,4).LT.1E-5) THEN - CALL LUERRM(8,'(LUSPHE:) all particles back-to-back') - SPH=-1. - APL=-1. - RETURN - ENDIF - -C...Find first and last eigenvector by solving equation system. - DO 240 I=1,3,2 - DO 180 J1=1,3 - SV(J1,J1)=SM(J1,J1)-P(N+I,4) - DO 170 J2=J1+1,3 - SV(J1,J2)=SM(J1,J2) - SV(J2,J1)=SM(J1,J2) - 170 CONTINUE - 180 CONTINUE - SMAX=0. - DO 200 J1=1,3 - DO 190 J2=1,3 - IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 190 - JA=J1 - JB=J2 - SMAX=ABS(SV(J1,J2)) - 190 CONTINUE - 200 CONTINUE - SMAX=0. - DO 220 J3=JA+1,JA+2 - J1=J3-3*((J3-1)/3) - RL=SV(J1,JB)/SV(JA,JB) - DO 210 J2=1,3 - SV(J1,J2)=SV(J1,J2)-RL*SV(JA,J2) - IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 210 - JC=J1 - SMAX=ABS(SV(J1,J2)) - 210 CONTINUE - 220 CONTINUE - JB1=JB+1-3*(JB/3) - JB2=JB+2-3*((JB+1)/3) - P(N+I,JB1)=-SV(JC,JB2) - P(N+I,JB2)=SV(JC,JB1) - P(N+I,JB)=-(SV(JA,JB1)*P(N+I,JB1)+SV(JA,JB2)*P(N+I,JB2))/ - &SV(JA,JB) - PA=SQRT(P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2) - SGN=(-1.)**INT(RLU(0)+0.5) - DO 230 J=1,3 - P(N+I,J)=SGN*P(N+I,J)/PA - 230 CONTINUE - 240 CONTINUE - -C...Middle axis orthogonal to other two. Fill other codes. - SGN=(-1.)**INT(RLU(0)+0.5) - P(N+2,1)=SGN*(P(N+1,2)*P(N+3,3)-P(N+1,3)*P(N+3,2)) - P(N+2,2)=SGN*(P(N+1,3)*P(N+3,1)-P(N+1,1)*P(N+3,3)) - P(N+2,3)=SGN*(P(N+1,1)*P(N+3,2)-P(N+1,2)*P(N+3,1)) - DO 260 I=1,3 - K(N+I,1)=31 - K(N+I,2)=95 - K(N+I,3)=I - K(N+I,4)=0 - K(N+I,5)=0 - P(N+I,5)=0. - DO 250 J=1,5 - V(I,J)=0. - 250 CONTINUE - 260 CONTINUE - -C...Calculate sphericity and aplanarity. Select storing option. - SPH=1.5*(P(N+2,4)+P(N+3,4)) - APL=1.5*P(N+3,4) - MSTU(61)=N+1 - MSTU(62)=NP - IF(MSTU(43).LE.1) MSTU(3)=3 - IF(MSTU(43).GE.2) N=N+3 - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUTHRU(THR,OBL) - -C...Purpose: to perform thrust analysis to give thrust, oblateness -C...and the related event axes. - 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 TDI(3),TPR(3) - -C...Take copy of particles that are to be considered in thrust analysis. - NP=0 - PS=0. - DO 100 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 - 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 100 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) - & GOTO 100 - ENDIF - IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN - CALL LUERRM(11,'(LUTHRU:) no more memory left in LUJETS') - THR=-2. - OBL=-2. - RETURN - ENDIF - NP=NP+1 - K(N+NP,1)=23 - P(N+NP,1)=P(I,1) - P(N+NP,2)=P(I,2) - P(N+NP,3)=P(I,3) - P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) - P(N+NP,5)=1. - IF(ABS(PARU(42)-1.).GT.0.001) P(N+NP,5)=P(N+NP,4)**(PARU(42)-1.) - PS=PS+P(N+NP,4)*P(N+NP,5) - 100 CONTINUE - -C...Very low multiplicities (0 or 1) not considered. - IF(NP.LE.1) THEN - CALL LUERRM(8,'(LUTHRU:) too few particles for analysis') - THR=-1. - OBL=-1. - RETURN - ENDIF - -C...Loop over thrust and major. T axis along z direction in latter case. - DO 320 ILD=1,2 - IF(ILD.EQ.2) THEN - K(N+NP+1,1)=31 - PHI=ULANGL(P(N+NP+1,1),P(N+NP+1,2)) - MSTU(33)=1 - CALL LUDBRB(N+1,N+NP+1,0.,-PHI,0D0,0D0,0D0) - THE=ULANGL(P(N+NP+1,3),P(N+NP+1,1)) - CALL LUDBRB(N+1,N+NP+1,-THE,0.,0D0,0D0,0D0) - ENDIF - -C...Find and order particles with highest p (pT for major). - DO 110 ILF=N+NP+4,N+NP+MSTU(44)+4 - P(ILF,4)=0. - 110 CONTINUE - DO 160 I=N+1,N+NP - IF(ILD.EQ.2) P(I,4)=SQRT(P(I,1)**2+P(I,2)**2) - DO 130 ILF=N+NP+MSTU(44)+3,N+NP+4,-1 - IF(P(I,4).LE.P(ILF,4)) GOTO 140 - DO 120 J=1,5 - P(ILF+1,J)=P(ILF,J) - 120 CONTINUE - 130 CONTINUE - ILF=N+NP+3 - 140 DO 150 J=1,5 - P(ILF+1,J)=P(I,J) - 150 CONTINUE - 160 CONTINUE - -C...Find and order initial axes with highest thrust (major). - DO 170 ILG=N+NP+MSTU(44)+5,N+NP+MSTU(44)+15 - P(ILG,4)=0. - 170 CONTINUE - NC=2**(MIN(MSTU(44),NP)-1) - DO 250 ILC=1,NC - DO 180 J=1,3 - TDI(J)=0. - 180 CONTINUE - DO 200 ILF=1,MIN(MSTU(44),NP) - SGN=P(N+NP+ILF+3,5) - IF(2**ILF*((ILC+2**(ILF-1)-1)/2**ILF).GE.ILC) SGN=-SGN - DO 190 J=1,4-ILD - TDI(J)=TDI(J)+SGN*P(N+NP+ILF+3,J) - 190 CONTINUE - 200 CONTINUE - TDS=TDI(1)**2+TDI(2)**2+TDI(3)**2 - DO 220 ILG=N+NP+MSTU(44)+MIN(ILC,10)+4,N+NP+MSTU(44)+5,-1 - IF(TDS.LE.P(ILG,4)) GOTO 230 - DO 210 J=1,4 - P(ILG+1,J)=P(ILG,J) - 210 CONTINUE - 220 CONTINUE - ILG=N+NP+MSTU(44)+4 - 230 DO 240 J=1,3 - P(ILG+1,J)=TDI(J) - 240 CONTINUE - P(ILG+1,4)=TDS - 250 CONTINUE - -C...Iterate direction of axis until stable maximum. - P(N+NP+ILD,4)=0. - ILG=0 - 260 ILG=ILG+1 - THP=0. - 270 THPS=THP - DO 280 J=1,3 - IF(THP.LE.1E-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J) - IF(THP.GT.1E-10) TDI(J)=TPR(J) - TPR(J)=0. - 280 CONTINUE - DO 300 I=N+1,N+NP - SGN=SIGN(P(I,5),TDI(1)*P(I,1)+TDI(2)*P(I,2)+TDI(3)*P(I,3)) - DO 290 J=1,4-ILD - TPR(J)=TPR(J)+SGN*P(I,J) - 290 CONTINUE - 300 CONTINUE - THP=SQRT(TPR(1)**2+TPR(2)**2+TPR(3)**2)/PS - IF(THP.GE.THPS+PARU(48)) GOTO 270 - -C...Save good axis. Try new initial axis until a number of tries agree. - IF(THP.LT.P(N+NP+ILD,4)-PARU(48).AND.ILG.LT.MIN(10,NC)) GOTO 260 - IF(THP.GT.P(N+NP+ILD,4)+PARU(48)) THEN - IAGR=0 - SGN=(-1.)**INT(RLU(0)+0.5) - DO 310 J=1,3 - P(N+NP+ILD,J)=SGN*TPR(J)/(PS*THP) - 310 CONTINUE - P(N+NP+ILD,4)=THP - P(N+NP+ILD,5)=0. - ENDIF - IAGR=IAGR+1 - IF(IAGR.LT.MSTU(45).AND.ILG.LT.MIN(10,NC)) GOTO 260 - 320 CONTINUE - -C...Find minor axis and value by orthogonality. - SGN=(-1.)**INT(RLU(0)+0.5) - P(N+NP+3,1)=-SGN*P(N+NP+2,2) - P(N+NP+3,2)=SGN*P(N+NP+2,1) - P(N+NP+3,3)=0. - THP=0. - DO 330 I=N+1,N+NP - THP=THP+P(I,5)*ABS(P(N+NP+3,1)*P(I,1)+P(N+NP+3,2)*P(I,2)) - 330 CONTINUE - P(N+NP+3,4)=THP/PS - P(N+NP+3,5)=0. - -C...Fill axis information. Rotate back to original coordinate system. - DO 350 ILD=1,3 - K(N+ILD,1)=31 - K(N+ILD,2)=96 - K(N+ILD,3)=ILD - K(N+ILD,4)=0 - K(N+ILD,5)=0 - DO 340 J=1,5 - P(N+ILD,J)=P(N+NP+ILD,J) - V(N+ILD,J)=0. - 340 CONTINUE - 350 CONTINUE - CALL LUDBRB(N+1,N+3,THE,PHI,0D0,0D0,0D0) - -C...Calculate thrust and oblateness. Select storing option. - THR=P(N+1,4) - OBL=P(N+2,4)-P(N+3,4) - MSTU(61)=N+1 - MSTU(62)=NP - IF(MSTU(43).LE.1) MSTU(3)=3 - IF(MSTU(43).GE.2) N=N+3 - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUCLUS(NJET) - -C...Purpose: to subdivide the particle content of an event into -C...jets/clusters. - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - DIMENSION PS(5) - SAVE NSAV,NP,PS,PSS,RINIT,NPRE,NREM - -C...Functions: distance measure in pT, (pseudo)mass or Durham pT. - R2T(I1,I2)=(P(I1,5)*P(I2,5)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)- - &P(I1,3)*P(I2,3))*2.*P(I1,5)*P(I2,5)/(0.0001+P(I1,5)+P(I2,5))**2 - R2M(I1,I2)=2.*P(I1,4)*P(I2,4)*(1.-(P(I1,1)*P(I2,1)+P(I1,2)* - &P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5))) - R2D(I1,I2)=2.*MIN(P(I1,4),P(I2,4))**2*(1.-(P(I1,1)*P(I2,1)+ - &P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5))) - -C...If first time, reset. If reentering, skip preliminaries. - IF(MSTU(48).LE.0) THEN - NP=0 - DO 100 J=1,5 - PS(J)=0. - 100 CONTINUE - PSS=0. - ELSE - NJET=NSAV - IF(MSTU(43).GE.2) N=N-NJET - DO 110 I=N+1,N+NJET - P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) - 110 CONTINUE - IF(MSTU(46).LE.3.OR.MSTU(46).EQ.5) THEN - R2ACC=PARU(44)**2 - ELSE - R2ACC=PARU(45)*PS(5)**2 - ENDIF - NLOOP=0 - GOTO 300 - ENDIF - -C...Find which particles are to be considered in cluster search. - DO 140 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140 - IF(MSTU(41).GE.2) THEN - KC=LUCOMP(K(I,2)) - IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. - & KC.EQ.18) GOTO 140 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) - & GOTO 140 - ENDIF - IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN - CALL LUERRM(11,'(LUCLUS:) no more memory left in LUJETS') - NJET=-1 - RETURN - ENDIF - -C...Take copy of these particles, with space left for jets later on. - NP=NP+1 - K(N+NP,3)=I - DO 120 J=1,5 - P(N+NP,J)=P(I,J) - 120 CONTINUE - IF(MSTU(42).EQ.0) P(N+NP,5)=0. - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1) - P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - P(N+NP,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) - DO 130 J=1,4 - PS(J)=PS(J)+P(N+NP,J) - 130 CONTINUE - PSS=PSS+P(N+NP,5) - 140 CONTINUE - DO 160 I=N+1,N+NP - K(I+NP,3)=K(I,3) - DO 150 J=1,5 - P(I+NP,J)=P(I,J) - 150 CONTINUE - 160 CONTINUE - PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2)) - -C...Very low multiplicities not considered. - IF(NP.LT.MSTU(47)) THEN - CALL LUERRM(8,'(LUCLUS:) too few particles for analysis') - NJET=-1 - RETURN - ENDIF - -C...Find precluster configuration. If too few jets, make harder cuts. - NLOOP=0 - IF(MSTU(46).LE.3.OR.MSTU(46).EQ.5) THEN - R2ACC=PARU(44)**2 - ELSE - R2ACC=PARU(45)*PS(5)**2 - ENDIF - RINIT=1.25*PARU(43) - IF(NP.LE.MSTU(47)+2) RINIT=0. - 170 RINIT=0.8*RINIT - NPRE=0 - NREM=NP - DO 180 I=N+NP+1,N+2*NP - K(I,4)=0 - 180 CONTINUE - -C...Sum up small momentum region. Jet if enough absolute momentum. - IF(MSTU(46).LE.2) THEN - DO 190 J=1,4 - P(N+1,J)=0. - 190 CONTINUE - DO 210 I=N+NP+1,N+2*NP - IF(P(I,5).GT.2.*RINIT) GOTO 210 - NREM=NREM-1 - K(I,4)=1 - DO 200 J=1,4 - P(N+1,J)=P(N+1,J)+P(I,J) - 200 CONTINUE - 210 CONTINUE - P(N+1,5)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2) - IF(P(N+1,5).GT.2.*RINIT) NPRE=1 - IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170 - IF(NREM.EQ.0) GOTO 170 - ENDIF - -C...Find fastest remaining particle. - 220 NPRE=NPRE+1 - PMAX=0. - DO 230 I=N+NP+1,N+2*NP - IF(K(I,4).NE.0.OR.P(I,5).LE.PMAX) GOTO 230 - IMAX=I - PMAX=P(I,5) - 230 CONTINUE - DO 240 J=1,5 - P(N+NPRE,J)=P(IMAX,J) - 240 CONTINUE - NREM=NREM-1 - K(IMAX,4)=NPRE - -C...Sum up precluster around it according to pT separation. - IF(MSTU(46).LE.2) THEN - DO 260 I=N+NP+1,N+2*NP - IF(K(I,4).NE.0) GOTO 260 - R2=R2T(I,IMAX) - IF(R2.GT.RINIT**2) GOTO 260 - NREM=NREM-1 - K(I,4)=NPRE - DO 250 J=1,4 - P(N+NPRE,J)=P(N+NPRE,J)+P(I,J) - 250 CONTINUE - 260 CONTINUE - P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2) - -C...Sum up precluster around it according to mass or -C...Durham pT separation. - ELSE - 270 IMIN=0 - R2MIN=RINIT**2 - DO 280 I=N+NP+1,N+2*NP - IF(K(I,4).NE.0) GOTO 280 - IF(MSTU(46).LE.4) THEN - R2=R2M(I,N+NPRE) - ELSE - R2=R2D(I,N+NPRE) - ENDIF - IF(R2.GE.R2MIN) GOTO 280 - IMIN=I - R2MIN=R2 - 280 CONTINUE - IF(IMIN.NE.0) THEN - DO 290 J=1,4 - P(N+NPRE,J)=P(N+NPRE,J)+P(IMIN,J) - 290 CONTINUE - P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2) - NREM=NREM-1 - K(IMIN,4)=NPRE - GOTO 270 - ENDIF - ENDIF - -C...Check if more preclusters to be found. Start over if too few. - IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170 - IF(NREM.GT.0) GOTO 220 - NJET=NPRE - -C...Reassign all particles to nearest jet. Sum up new jet momenta. - 300 TSAV=0. - PSJT=0. - 310 IF(MSTU(46).LE.1) THEN - DO 330 I=N+1,N+NJET - DO 320 J=1,4 - V(I,J)=0. - 320 CONTINUE - 330 CONTINUE - DO 360 I=N+NP+1,N+2*NP - R2MIN=PSS**2 - DO 340 IJET=N+1,N+NJET - IF(P(IJET,5).LT.RINIT) GOTO 340 - R2=R2T(I,IJET) - IF(R2.GE.R2MIN) GOTO 340 - IMIN=IJET - R2MIN=R2 - 340 CONTINUE - K(I,4)=IMIN-N - DO 350 J=1,4 - V(IMIN,J)=V(IMIN,J)+P(I,J) - 350 CONTINUE - 360 CONTINUE - PSJT=0. - DO 380 I=N+1,N+NJET - DO 370 J=1,4 - P(I,J)=V(I,J) - 370 CONTINUE - P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) - PSJT=PSJT+P(I,5) - 380 CONTINUE - ENDIF - -C...Find two closest jets. - R2MIN=2.*MAX(R2ACC,PS(5)**2) - DO 400 ITRY1=N+1,N+NJET-1 - DO 390 ITRY2=ITRY1+1,N+NJET - IF(MSTU(46).LE.2) THEN - R2=R2T(ITRY1,ITRY2) - ELSEIF(MSTU(46).LE.4) THEN - R2=R2M(ITRY1,ITRY2) - ELSE - R2=R2D(ITRY1,ITRY2) - ENDIF - 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 - ELSEIF(IABS(K(IM,2)).GT.80.AND.IABS(K(IM,2)).LE.100) THEN - ELSEIF(IABS(K(IM,2)).GT.100.AND.MOD(IABS(K(IM,2))/10,10).NE.0) - & THEN - ELSE - GOTO 150 - ENDIF - ENDIF - 160 CONTINUE - NPCO=MAX(NP,1) - IF(NP.GE.6) NPCO=6 - IF(NP.GE.8) NPCO=7 - IF(NP.GE.11) NPCO=8 - IF(NP.GE.16) NPCO=9 - IF(NP.GE.26) NPCO=10 - NPIS(IKFIS,NPCO)=NPIS(IKFIS,NPCO)+1 - MSTU(62)=NP - -C...Write statistics on initial parton state. - ELSEIF(MTABU.EQ.12) THEN - FAC=1./MAX(1,NEVIS) - WRITE(MSTU(11),5000) NEVIS - DO 170 I=1,NKFIS - KFMN=KFIS(I,1) - IF(KFMN.EQ.0) KFMN=KFIS(I,2) - KFM1=(KFMN+1)/2 - IF(2*KFM1.EQ.KFMN) KFM1=-KFM1 - CALL LUNAME(KFM1,CHAU) - CHIS(1)=CHAU(1:12) - IF(CHAU(13:13).NE.' ') CHIS(1)(12:12)='?' - KFMX=KFIS(I,2) - IF(KFIS(I,1).EQ.0) KFMX=0 - KFM2=(KFMX+1)/2 - IF(2*KFM2.EQ.KFMX) KFM2=-KFM2 - CALL LUNAME(KFM2,CHAU) - CHIS(2)=CHAU(1:12) - IF(CHAU(13:13).NE.' ') CHIS(2)(12:12)='?' - WRITE(MSTU(11),5100) CHIS(1),CHIS(2),FAC*NPIS(I,0), - & (NPIS(I,J)/FLOAT(NPIS(I,0)),J=1,10) - 170 CONTINUE - -C...Copy statistics on initial parton state into /LUJETS/. - ELSEIF(MTABU.EQ.13) THEN - FAC=1./MAX(1,NEVIS) - DO 190 I=1,NKFIS - KFMN=KFIS(I,1) - IF(KFMN.EQ.0) KFMN=KFIS(I,2) - KFM1=(KFMN+1)/2 - IF(2*KFM1.EQ.KFMN) KFM1=-KFM1 - KFMX=KFIS(I,2) - IF(KFIS(I,1).EQ.0) KFMX=0 - KFM2=(KFMX+1)/2 - IF(2*KFM2.EQ.KFMX) KFM2=-KFM2 - K(I,1)=32 - K(I,2)=99 - K(I,3)=KFM1 - K(I,4)=KFM2 - K(I,5)=NPIS(I,0) - DO 180 J=1,5 - P(I,J)=FAC*NPIS(I,J) - V(I,J)=FAC*NPIS(I,J+5) - 180 CONTINUE - 190 CONTINUE - N=NKFIS - DO 200 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0. - V(N+1,J)=0. - 200 CONTINUE - K(N+1,1)=32 - K(N+1,2)=99 - K(N+1,5)=NEVIS - MSTU(3)=1 - -C...Reset statistics on number of particles/partons. - ELSEIF(MTABU.EQ.20) THEN - NEVFS=0 - NPRFS=0 - NFIFS=0 - NCHFS=0 - NKFFS=0 - -C...Identify whether particle/parton is primary or not. - ELSEIF(MTABU.EQ.21) THEN - NEVFS=NEVFS+1 - MSTU(62)=0 - DO 260 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,1).EQ.13) GOTO 260 - MSTU(62)=MSTU(62)+1 - KC=LUCOMP(K(I,2)) - MPRI=0 - IF(K(I,3).LE.0.OR.K(I,3).GT.N) THEN - MPRI=1 - ELSEIF(K(K(I,3),1).LE.0.OR.K(K(I,3),1).GT.20) THEN - MPRI=1 - ELSEIF(K(K(I,3),2).GE.91.AND.K(K(I,3),2).LE.93) THEN - MPRI=1 - ELSEIF(KC.EQ.0) THEN - ELSEIF(K(K(I,3),1).EQ.13) THEN - IM=K(K(I,3),3) - IF(IM.LE.0.OR.IM.GT.N) THEN - MPRI=1 - ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN - MPRI=1 - ENDIF - ELSEIF(KCHG(KC,2).EQ.0) THEN - KCM=LUCOMP(K(K(I,3),2)) - IF(KCM.NE.0) THEN - IF(KCHG(KCM,2).NE.0) MPRI=1 - ENDIF - ENDIF - IF(KC.NE.0.AND.MPRI.EQ.1) THEN - IF(KCHG(KC,2).EQ.0) NPRFS=NPRFS+1 - ENDIF - IF(K(I,1).LE.10) THEN - NFIFS=NFIFS+1 - IF(LUCHGE(K(I,2)).NE.0) NCHFS=NCHFS+1 - ENDIF - -C...Fill statistics on number of particles/partons in event. - KFA=IABS(K(I,2)) - KFS=3-ISIGN(1,K(I,2))-MPRI - DO 210 IP=1,NKFFS - IF(KFA.EQ.KFFS(IP)) THEN - IKFFS=-IP - GOTO 220 - ELSEIF(KFA.LT.KFFS(IP)) THEN - IKFFS=IP - GOTO 220 - ENDIF - 210 CONTINUE - IKFFS=NKFFS+1 - 220 IF(IKFFS.LT.0) THEN - IKFFS=-IKFFS - ELSE - IF(NKFFS.GE.400) RETURN - DO 240 IP=NKFFS,IKFFS,-1 - KFFS(IP+1)=KFFS(IP) - DO 230 J=1,4 - NPFS(IP+1,J)=NPFS(IP,J) - 230 CONTINUE - 240 CONTINUE - NKFFS=NKFFS+1 - KFFS(IKFFS)=KFA - DO 250 J=1,4 - NPFS(IKFFS,J)=0 - 250 CONTINUE - ENDIF - NPFS(IKFFS,KFS)=NPFS(IKFFS,KFS)+1 - 260 CONTINUE - -C...Write statistics on particle/parton composition of events. - ELSEIF(MTABU.EQ.22) THEN - FAC=1./MAX(1,NEVFS) - WRITE(MSTU(11),5200) NEVFS,FAC*NPRFS,FAC*NFIFS,FAC*NCHFS - DO 270 I=1,NKFFS - CALL LUNAME(KFFS(I),CHAU) - KC=LUCOMP(KFFS(I)) - MDCYF=0 - IF(KC.NE.0) MDCYF=MDCY(KC,1) - WRITE(MSTU(11),5300) KFFS(I),CHAU,MDCYF,(FAC*NPFS(I,J),J=1,4), - & FAC*(NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4)) - 270 CONTINUE - -C...Copy particle/parton composition information into /LUJETS/. - ELSEIF(MTABU.EQ.23) THEN - FAC=1./MAX(1,NEVFS) - DO 290 I=1,NKFFS - K(I,1)=32 - K(I,2)=99 - K(I,3)=KFFS(I) - K(I,4)=0 - K(I,5)=NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4) - DO 280 J=1,4 - P(I,J)=FAC*NPFS(I,J) - V(I,J)=0. - 280 CONTINUE - P(I,5)=FAC*K(I,5) - V(I,5)=0. - 290 CONTINUE - N=NKFFS - DO 300 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0. - V(N+1,J)=0. - 300 CONTINUE - K(N+1,1)=32 - K(N+1,2)=99 - K(N+1,5)=NEVFS - P(N+1,1)=FAC*NPRFS - P(N+1,2)=FAC*NFIFS - P(N+1,3)=FAC*NCHFS - MSTU(3)=1 - -C...Reset factorial moments statistics. - ELSEIF(MTABU.EQ.30) THEN - NEVFM=0 - NMUFM=0 - DO 330 IM=1,3 - DO 320 IB=1,10 - DO 310 IP=1,4 - FM1FM(IM,IB,IP)=0. - FM2FM(IM,IB,IP)=0. - 310 CONTINUE - 320 CONTINUE - 330 CONTINUE - -C...Find particles to include, with (pion,pseudo)rapidity and azimuth. - ELSEIF(MTABU.EQ.31) THEN - NEVFM=NEVFM+1 - NLOW=N+MSTU(3) - NUPP=NLOW - DO 410 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 410 - 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 410 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) - & GOTO 410 - ENDIF - PMR=0. - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=ULMASS(211) - IF(MSTU(42).GE.2) PMR=P(I,5) - PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2) - YETA=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), - & 1E20)),P(I,3)) - IF(ABS(YETA).GT.PARU(57)) GOTO 410 - PHI=ULANGL(P(I,1),P(I,2)) - IYETA=512.*(YETA+PARU(57))/(2.*PARU(57)) - IYETA=MAX(0,MIN(511,IYETA)) - IPHI=512.*(PHI+PARU(1))/PARU(2) - IPHI=MAX(0,MIN(511,IPHI)) - IYEP=0 - DO 340 IB=0,9 - IYEP=IYEP+4**IB*(2*MOD(IYETA/2**IB,2)+MOD(IPHI/2**IB,2)) - 340 CONTINUE - -C...Order particles in (pseudo)rapidity and/or azimuth. - IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN - CALL LUERRM(11,'(LUTABU:) no more memory left in LUJETS') - RETURN - ENDIF - NUPP=NUPP+1 - IF(NUPP.EQ.NLOW+1) THEN - K(NUPP,1)=IYETA - K(NUPP,2)=IPHI - K(NUPP,3)=IYEP - ELSE - DO 350 I1=NUPP-1,NLOW+1,-1 - IF(IYETA.GE.K(I1,1)) GOTO 360 - K(I1+1,1)=K(I1,1) - 350 CONTINUE - 360 K(I1+1,1)=IYETA - DO 370 I1=NUPP-1,NLOW+1,-1 - IF(IPHI.GE.K(I1,2)) GOTO 380 - K(I1+1,2)=K(I1,2) - 370 CONTINUE - 380 K(I1+1,2)=IPHI - DO 390 I1=NUPP-1,NLOW+1,-1 - IF(IYEP.GE.K(I1,3)) GOTO 400 - K(I1+1,3)=K(I1,3) - 390 CONTINUE - 400 K(I1+1,3)=IYEP - ENDIF - 410 CONTINUE - K(NUPP+1,1)=2**10 - K(NUPP+1,2)=2**10 - K(NUPP+1,3)=4**10 - -C...Calculate sum of factorial moments in event. - DO 480 IM=1,3 - DO 430 IB=1,10 - DO 420 IP=1,4 - FEVFM(IB,IP)=0. - 420 CONTINUE - 430 CONTINUE - DO 450 IB=1,10 - IF(IM.LE.2) IBIN=2**(10-IB) - IF(IM.EQ.3) IBIN=4**(10-IB) - IAGR=K(NLOW+1,IM)/IBIN - NAGR=1 - DO 440 I=NLOW+2,NUPP+1 - ICUT=K(I,IM)/IBIN - IF(ICUT.EQ.IAGR) THEN - NAGR=NAGR+1 - ELSE - IF(NAGR.EQ.1) THEN - ELSEIF(NAGR.EQ.2) THEN - FEVFM(IB,1)=FEVFM(IB,1)+2. - ELSEIF(NAGR.EQ.3) THEN - FEVFM(IB,1)=FEVFM(IB,1)+6. - FEVFM(IB,2)=FEVFM(IB,2)+6. - ELSEIF(NAGR.EQ.4) THEN - FEVFM(IB,1)=FEVFM(IB,1)+12. - FEVFM(IB,2)=FEVFM(IB,2)+24. - FEVFM(IB,3)=FEVFM(IB,3)+24. - ELSE - FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1.) - FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1.)*(NAGR-2.) - FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.) - FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.)* - & (NAGR-4.) - ENDIF - IAGR=ICUT - NAGR=1 - ENDIF - 440 CONTINUE - 450 CONTINUE - -C...Add results to total statistics. - DO 470 IB=10,1,-1 - DO 460 IP=1,4 - IF(FEVFM(1,IP).LT.0.5) THEN - FEVFM(IB,IP)=0. - ELSEIF(IM.LE.2) THEN - FEVFM(IB,IP)=2.**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) - ELSE - FEVFM(IB,IP)=4.**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) - ENDIF - FM1FM(IM,IB,IP)=FM1FM(IM,IB,IP)+FEVFM(IB,IP) - FM2FM(IM,IB,IP)=FM2FM(IM,IB,IP)+FEVFM(IB,IP)**2 - 460 CONTINUE - 470 CONTINUE - 480 CONTINUE - NMUFM=NMUFM+(NUPP-NLOW) - MSTU(62)=NUPP-NLOW - -C...Write accumulated statistics on factorial moments. - ELSEIF(MTABU.EQ.32) THEN - FAC=1./MAX(1,NEVFM) - IF(MSTU(42).LE.0) WRITE(MSTU(11),5400) NEVFM,'eta' - IF(MSTU(42).EQ.1) WRITE(MSTU(11),5400) NEVFM,'ypi' - IF(MSTU(42).GE.2) WRITE(MSTU(11),5400) NEVFM,'y ' - DO 510 IM=1,3 - WRITE(MSTU(11),5500) - DO 500 IB=1,10 - BYETA=2.*PARU(57) - IF(IM.NE.2) BYETA=BYETA/2**(IB-1) - BPHI=PARU(2) - IF(IM.NE.1) BPHI=BPHI/2**(IB-1) - IF(IM.LE.2) BNAVE=FAC*NMUFM/FLOAT(2**(IB-1)) - IF(IM.EQ.3) BNAVE=FAC*NMUFM/FLOAT(4**(IB-1)) - DO 490 IP=1,4 - FMOMA(IP)=FAC*FM1FM(IM,IB,IP) - FMOMS(IP)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-FMOMA(IP)**2))) - 490 CONTINUE - WRITE(MSTU(11),5600) BYETA,BPHI,BNAVE,(FMOMA(IP),FMOMS(IP), - & IP=1,4) - 500 CONTINUE - 510 CONTINUE - -C...Copy statistics on factorial moments into /LUJETS/. - ELSEIF(MTABU.EQ.33) THEN - FAC=1./MAX(1,NEVFM) - DO 540 IM=1,3 - DO 530 IB=1,10 - I=10*(IM-1)+IB - K(I,1)=32 - K(I,2)=99 - K(I,3)=1 - IF(IM.NE.2) K(I,3)=2**(IB-1) - K(I,4)=1 - IF(IM.NE.1) K(I,4)=2**(IB-1) - K(I,5)=0 - P(I,1)=2.*PARU(57)/K(I,3) - V(I,1)=PARU(2)/K(I,4) - DO 520 IP=1,4 - P(I,IP+1)=FAC*FM1FM(IM,IB,IP) - V(I,IP+1)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-P(I,IP+1)**2))) - 520 CONTINUE - 530 CONTINUE - 540 CONTINUE - N=30 - DO 550 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0. - V(N+1,J)=0. - 550 CONTINUE - K(N+1,1)=32 - K(N+1,2)=99 - K(N+1,5)=NEVFM - MSTU(3)=1 - -C...Reset statistics on Energy-Energy Correlation. - ELSEIF(MTABU.EQ.40) THEN - NEVEE=0 - DO 560 J=1,25 - FE1EC(J)=0. - FE2EC(J)=0. - FE1EC(51-J)=0. - FE2EC(51-J)=0. - FE1EA(J)=0. - FE2EA(J)=0. - 560 CONTINUE - -C...Find particles to include, with proper assumed mass. - ELSEIF(MTABU.EQ.41) THEN - NEVEE=NEVEE+1 - NLOW=N+MSTU(3) - NUPP=NLOW - ECM=0. - DO 570 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 570 - 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 570 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) - & GOTO 570 - ENDIF - PMR=0. - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=ULMASS(211) - IF(MSTU(42).GE.2) PMR=P(I,5) - IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN - CALL LUERRM(11,'(LUTABU:) no more memory left in LUJETS') - RETURN - ENDIF - NUPP=NUPP+1 - P(NUPP,1)=P(I,1) - P(NUPP,2)=P(I,2) - P(NUPP,3)=P(I,3) - P(NUPP,4)=SQRT(PMR**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - P(NUPP,5)=MAX(1E-10,SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)) - ECM=ECM+P(NUPP,4) - 570 CONTINUE - IF(NUPP.EQ.NLOW) RETURN - -C...Analyze Energy-Energy Correlation in event. - FAC=(2./ECM**2)*50./PARU(1) - DO 580 J=1,50 - FEVEE(J)=0. - 580 CONTINUE - DO 600 I1=NLOW+2,NUPP - DO 590 I2=NLOW+1,I1-1 - CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/ - & (P(I1,5)*P(I2,5)) - THE=ACOS(MAX(-1.,MIN(1.,CTHE))) - ITHE=MAX(1,MIN(50,1+INT(50.*THE/PARU(1)))) - FEVEE(ITHE)=FEVEE(ITHE)+FAC*P(I1,4)*P(I2,4) - 590 CONTINUE - 600 CONTINUE - DO 610 J=1,25 - FE1EC(J)=FE1EC(J)+FEVEE(J) - FE2EC(J)=FE2EC(J)+FEVEE(J)**2 - FE1EC(51-J)=FE1EC(51-J)+FEVEE(51-J) - FE2EC(51-J)=FE2EC(51-J)+FEVEE(51-J)**2 - FE1EA(J)=FE1EA(J)+(FEVEE(51-J)-FEVEE(J)) - FE2EA(J)=FE2EA(J)+(FEVEE(51-J)-FEVEE(J))**2 - 610 CONTINUE - MSTU(62)=NUPP-NLOW - -C...Write statistics on Energy-Energy Correlation. - ELSEIF(MTABU.EQ.42) THEN - FAC=1./MAX(1,NEVEE) - WRITE(MSTU(11),5700) NEVEE - DO 620 J=1,25 - FEEC1=FAC*FE1EC(J) - FEES1=SQRT(MAX(0.,FAC*(FAC*FE2EC(J)-FEEC1**2))) - FEEC2=FAC*FE1EC(51-J) - FEES2=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-J)-FEEC2**2))) - FEECA=FAC*FE1EA(J) - FEESA=SQRT(MAX(0.,FAC*(FAC*FE2EA(J)-FEECA**2))) - WRITE(MSTU(11),5800) 3.6*(J-1),3.6*J,FEEC1,FEES1,FEEC2,FEES2, - & FEECA,FEESA - 620 CONTINUE - -C...Copy statistics on Energy-Energy Correlation into /LUJETS/. - ELSEIF(MTABU.EQ.43) THEN - FAC=1./MAX(1,NEVEE) - DO 630 I=1,25 - K(I,1)=32 - K(I,2)=99 - K(I,3)=0 - K(I,4)=0 - K(I,5)=0 - P(I,1)=FAC*FE1EC(I) - V(I,1)=SQRT(MAX(0.,FAC*(FAC*FE2EC(I)-P(I,1)**2))) - P(I,2)=FAC*FE1EC(51-I) - V(I,2)=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-I)-P(I,2)**2))) - P(I,3)=FAC*FE1EA(I) - V(I,3)=SQRT(MAX(0.,FAC*(FAC*FE2EA(I)-P(I,3)**2))) - P(I,4)=PARU(1)*(I-1)/50. - P(I,5)=PARU(1)*I/50. - V(I,4)=3.6*(I-1) - V(I,5)=3.6*I - 630 CONTINUE - N=25 - DO 640 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0. - V(N+1,J)=0. - 640 CONTINUE - K(N+1,1)=32 - K(N+1,2)=99 - K(N+1,5)=NEVEE - MSTU(3)=1 - -C...Reset statistics on decay channels. - ELSEIF(MTABU.EQ.50) THEN - NEVDC=0 - NKFDC=0 - NREDC=0 - -C...Identify and order flavour content of final state. - ELSEIF(MTABU.EQ.51) THEN - NEVDC=NEVDC+1 - NDS=0 - DO 670 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GE.6) GOTO 670 - NDS=NDS+1 - IF(NDS.GT.8) THEN - NREDC=NREDC+1 - RETURN - ENDIF - KFM=2*IABS(K(I,2)) - IF(K(I,2).LT.0) KFM=KFM-1 - DO 650 IDS=NDS-1,1,-1 - IIN=IDS+1 - IF(KFM.LT.KFDM(IDS)) GOTO 660 - KFDM(IDS+1)=KFDM(IDS) - 650 CONTINUE - IIN=1 - 660 KFDM(IIN)=KFM - 670 CONTINUE - -C...Find whether old or new final state. - DO 690 IDC=1,NKFDC - IF(NDS.LT.KFDC(IDC,0)) THEN - IKFDC=IDC - GOTO 700 - ELSEIF(NDS.EQ.KFDC(IDC,0)) THEN - DO 680 I=1,NDS - IF(KFDM(I).LT.KFDC(IDC,I)) THEN - IKFDC=IDC - GOTO 700 - ELSEIF(KFDM(I).GT.KFDC(IDC,I)) THEN - GOTO 690 - ENDIF - 680 CONTINUE - IKFDC=-IDC - GOTO 700 - ENDIF - 690 CONTINUE - IKFDC=NKFDC+1 - 700 IF(IKFDC.LT.0) THEN - IKFDC=-IKFDC - ELSEIF(NKFDC.GE.200) THEN - NREDC=NREDC+1 - RETURN - ELSE - DO 720 IDC=NKFDC,IKFDC,-1 - NPDC(IDC+1)=NPDC(IDC) - DO 710 I=0,8 - KFDC(IDC+1,I)=KFDC(IDC,I) - 710 CONTINUE - 720 CONTINUE - NKFDC=NKFDC+1 - KFDC(IKFDC,0)=NDS - DO 730 I=1,NDS - KFDC(IKFDC,I)=KFDM(I) - 730 CONTINUE - NPDC(IKFDC)=0 - ENDIF - NPDC(IKFDC)=NPDC(IKFDC)+1 - -C...Write statistics on decay channels. - ELSEIF(MTABU.EQ.52) THEN - FAC=1./MAX(1,NEVDC) - WRITE(MSTU(11),5900) NEVDC - DO 750 IDC=1,NKFDC - DO 740 I=1,KFDC(IDC,0) - KFM=KFDC(IDC,I) - KF=(KFM+1)/2 - IF(2*KF.NE.KFM) KF=-KF - CALL LUNAME(KF,CHAU) - CHDC(I)=CHAU(1:12) - IF(CHAU(13:13).NE.' ') CHDC(I)(12:12)='?' - 740 CONTINUE - WRITE(MSTU(11),6000) FAC*NPDC(IDC),(CHDC(I),I=1,KFDC(IDC,0)) - 750 CONTINUE - IF(NREDC.NE.0) WRITE(MSTU(11),6100) FAC*NREDC - -C...Copy statistics on decay channels into /LUJETS/. - ELSEIF(MTABU.EQ.53) THEN - FAC=1./MAX(1,NEVDC) - DO 780 IDC=1,NKFDC - K(IDC,1)=32 - K(IDC,2)=99 - K(IDC,3)=0 - K(IDC,4)=0 - K(IDC,5)=KFDC(IDC,0) - DO 760 J=1,5 - P(IDC,J)=0. - V(IDC,J)=0. - 760 CONTINUE - DO 770 I=1,KFDC(IDC,0) - KFM=KFDC(IDC,I) - KF=(KFM+1)/2 - IF(2*KF.NE.KFM) KF=-KF - IF(I.LE.5) P(IDC,I)=KF - IF(I.GE.6) V(IDC,I-5)=KF - 770 CONTINUE - V(IDC,5)=FAC*NPDC(IDC) - 780 CONTINUE - N=NKFDC - DO 790 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0. - V(N+1,J)=0. - 790 CONTINUE - K(N+1,1)=32 - K(N+1,2)=99 - K(N+1,5)=NEVDC - V(N+1,5)=FAC*NREDC - MSTU(3)=1 - ENDIF - -C...Format statements for output on unit MSTU(11) (default 6). - 5000 FORMAT(///20X,'Event statistics - initial state'/ - &20X,'based on an analysis of ',I6,' events'// - &3X,'Main flavours after',8X,'Fraction',4X,'Subfractions ', - &'according to fragmenting system multiplicity'/ - &4X,'hard interaction',24X,'1',7X,'2',7X,'3',7X,'4',7X,'5', - &6X,'6-7',5X,'8-10',3X,'11-15',3X,'16-25',4X,'>25'/) - 5100 FORMAT(3X,A12,1X,A12,F10.5,1X,10F8.4) - 5200 FORMAT(///20X,'Event statistics - final state'/ - &20X,'based on an analysis of ',I7,' events'// - &5X,'Mean primary multiplicity =',F10.4/ - &5X,'Mean final multiplicity =',F10.4/ - &5X,'Mean charged multiplicity =',F10.4// - &5X,'Number of particles produced per event (directly and via ', - &'decays/branchings)'/ - &5X,'KF Particle/jet MDCY',10X,'Particles',13X,'Antiparticles', - &8X,'Total'/35X,'prim seco prim seco'/) - 5300 FORMAT(1X,I6,4X,A16,I2,5(1X,F11.6)) - 5400 FORMAT(///20X,'Factorial moments analysis of multiplicity'/ - &20X,'based on an analysis of ',I6,' events'// - &3X,'delta-',A3,' delta-phi /bin',10X,'',18X,'', - &18X,'',18X,''/35X,4(' value error ')) - 5500 FORMAT(10X) - 5600 FORMAT(2X,2F10.4,F12.4,4(F12.4,F10.4)) - 5700 FORMAT(///20X,'Energy-Energy Correlation and Asymmetry'/ - &20X,'based on an analysis of ',I6,' events'// - &2X,'theta range',8X,'EEC(theta)',8X,'EEC(180-theta)',7X, - &'EECA(theta)'/2X,'in degrees ',3(' value error')/) - 5800 FORMAT(2X,F4.1,' - ',F4.1,3(F11.4,F9.4)) - 5900 FORMAT(///20X,'Decay channel analysis - final state'/ - &20X,'based on an analysis of ',I6,' events'// - &2X,'Probability',10X,'Complete final state'/) - 6000 FORMAT(2X,F9.5,5X,8(A12,1X)) - 6100 FORMAT(2X,F9.5,5X,'into other channels (more than 8 particles ', - &'or table overflow)') - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUEEVT(KFL,ECM) - -C...Purpose: to handle the generation of an e+e- annihilation jet event. - IMPLICIT DOUBLE PRECISION(D) - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - -C...Check input parameters. - IF(MSTU(12).GE.1) CALL LULIST(0) - IF(KFL.LT.0.OR.KFL.GT.8) THEN - CALL LUERRM(16,'(LUEEVT:) called with unknown flavour code') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02*PARF(100+MAX(1,KFL)) - IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02*PMAS(KFL,1) - IF(ECM.LT.ECMMIN) THEN - CALL LUERRM(16,'(LUEEVT:) called with too small CM energy') - IF(MSTU(21).GE.1) RETURN - ENDIF - -C...Check consistency of MSTJ options set. - IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN - CALL LUERRM(6, - & '(LUEEVT:) MSTJ(109) value requires MSTJ(110) = 1') - MSTJ(110)=1 - ENDIF - IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN - CALL LUERRM(6, - & '(LUEEVT:) MSTJ(109) value requires MSTJ(111) = 0') - MSTJ(111)=0 - ENDIF - -C...Initialize alpha_strong and total cross-section. - MSTU(111)=MSTJ(108) - IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) - &MSTU(111)=1 - PARU(112)=PARJ(121) - IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) - IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE. - &PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL LUXTOT(KFL,ECM, - &XTOT) - IF(MSTJ(116).GE.3) MSTJ(116)=1 - PARJ(171)=0. - -C...Add initial e+e- to event record (documentation only). - NTRY=0 - 100 NTRY=NTRY+1 - IF(NTRY.GT.100) THEN - CALL LUERRM(14,'(LUEEVT:) caught in an infinite loop') - RETURN - ENDIF - MSTU(24)=0 - NC=0 - IF(MSTJ(115).GE.2) THEN - NC=NC+2 - CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.) - K(NC-1,1)=21 - CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.) - K(NC,1)=21 - ENDIF - -C...Radiative photon (in initial state). - MK=0 - ECMC=ECM - IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL LURADK(ECM,MK,PAK, - &THEK,PHIK,ALPK) - IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2.*PAK)) - IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN - NC=NC+1 - CALL LU1ENT(NC,22,PAK,THEK,PHIK) - K(NC,3)=MIN(MSTJ(115)/2,1) - ENDIF - -C...Virtual exchange boson (gamma or Z0). - IF(MSTJ(115).GE.3) THEN - NC=NC+1 - KF=22 - IF(MSTJ(102).EQ.2) KF=23 - MSTU10=MSTU(10) - MSTU(10)=1 - P(NC,5)=ECMC - CALL LU1ENT(NC,KF,ECMC,0.,0.) - K(NC,1)=21 - K(NC,3)=1 - MSTU(10)=MSTU10 - ENDIF - -C...Choice of flavour and jet configuration. - CALL LUXKFL(KFL,ECM,ECMC,KFLC) - IF(KFLC.EQ.0) GOTO 100 - CALL LUXJET(ECMC,NJET,CUT) - KFLN=21 - IF(NJET.EQ.4) CALL LUX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4, - &X12,X14) - IF(NJET.EQ.3) CALL LUX3JT(NJET,CUT,KFLC,ECMC,X1,X3) - IF(NJET.EQ.2) MSTJ(120)=1 - -C...Fill jet configuration and origin. - IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL LU2ENT(NC+1,KFLC,-KFLC,ECMC) - IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL LU2ENT(-(NC+1),KFLC,-KFLC, - &ECMC) - IF(NJET.EQ.3) CALL LU3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3) - IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL LU4ENT(NC+1,KFLC,KFLN,KFLN, - &-KFLC,ECMC,X1,X2,X4,X12,X14) - IF(NJET.EQ.4.AND.KFLN.NE.21) CALL LU4ENT(NC+1,KFLC,-KFLN,KFLN, - &-KFLC,ECMC,X1,X2,X4,X12,X14) - IF(MSTU(24).NE.0) GOTO 100 - DO 110 IP=NC+1,N - K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1) - 110 CONTINUE - -C...Angular orientation according to matrix element. - IF(MSTJ(106).EQ.1) THEN - CALL LUXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI) - CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0) - CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0) - ENDIF - -C...Rotation and boost from radiative photon. - IF(MK.EQ.1) THEN - DBEK=-PAK/(ECM-PAK) - NMIN=NC+1-MSTJ(115)/3 - CALL LUDBRB(NMIN,N,0.,-PHIK,0D0,0D0,0D0) - CALL LUDBRB(NMIN,N,ALPK,0.,DBEK*SIN(THEK),0D0,DBEK*COS(THEK)) - CALL LUDBRB(NMIN,N,0.,PHIK,0D0,0D0,0D0) - ENDIF - -C...Generate parton shower. Rearrange along strings and check. - IF(MSTJ(101).EQ.5) THEN - CALL LUSHOW(N-1,N,ECMC) - MSTJ14=MSTJ(14) - IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 - IF(MSTJ(105).GE.0) MSTU(28)=0 - CALL LUPREP(0) - MSTJ(14)=MSTJ14 - IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 - ENDIF - -C...Fragmentation/decay generation. Information for LUTABU. - IF(MSTJ(105).EQ.1) CALL LUEXEC - MSTU(161)=KFLC - MSTU(162)=-KFLC - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUXTOT(KFL,ECM,XTOT) - -C...Purpose: to calculate total cross-section, including initial -C...state radiation effects. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUDAT1/,/LUDAT2/ - -C...Status, (optimized) Q^2 scale, alpha_strong. - PARJ(151)=ECM - MSTJ(119)=10*MSTJ(102)+KFL - IF(MSTJ(111).EQ.0) THEN - Q2R=ECM**2 - ELSEIF(MSTU(111).EQ.0) THEN - PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/ - & ((33.-2.*MSTU(112))*PARU(111))))) - Q2R=PARJ(168)*ECM**2 - ELSE - PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM, - & (2.*PARU(112)/ECM)**2)) - Q2R=PARJ(168)*ECM**2 - ENDIF - ALSPI=ULALPS(Q2R)/PARU(1) - -C...QCD corrections factor in R. - IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN - RQCD=1. - ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN - RQCD=1.+ALSPI - ELSEIF(MSTJ(109).EQ.0) THEN - RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2 - IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.* - & LOG(PARJ(168))*ALSPI**2) - ELSEIF(IABS(MSTJ(101)).EQ.1) THEN - RQCD=1.+(3./4.)*ALSPI - ELSE - RQCD=1.+(3./4.)*ALSPI-(3./32.+0.519*MSTU(118))*ALSPI**2 - ENDIF - -C...Calculate Z0 width if default value not acceptable. - IF(MSTJ(102).GE.3) THEN - RVA=3.*(3.+(4.*PARU(102)-1.)**2)+6.*RQCD*(2.+(1.-8.*PARU(102)/ - & 3.)**2+(4.*PARU(102)/3.-1.)**2) - DO 100 KFLC=5,6 - VQ=1. - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*ULMASS(KFLC)/ - & ECM)**2)) - IF(KFLC.EQ.5) VF=4.*PARU(102)/3.-1. - IF(KFLC.EQ.6) VF=1.-8.*PARU(102)/3. - RVA=RVA+3.*RQCD*(0.5*VQ*(3.-VQ**2)*VF**2+VQ**3) - 100 CONTINUE - PARJ(124)=PARU(101)*PARJ(123)*RVA/(48.*PARU(102)*(1.-PARU(102))) - ENDIF - -C...Calculate propagator and related constants for QFD case. - POLL=1.-PARJ(131)*PARJ(132) - IF(MSTJ(102).GE.2) THEN - SFF=1./(16.*PARU(102)*(1.-PARU(102))) - SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) - SFI=SFW*(1.-(PARJ(123)/ECM)**2) - VE=4.*PARU(102)-1. - SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131)) - SF1W=SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131))) - HF1I=SFI*SF1I - HF1W=SFW*SF1W - ENDIF - -C...Loop over different flavours: charge, velocity. - RTOT=0. - RQQ=0. - RQV=0. - RVA=0. - DO 110 KFLC=1,MAX(MSTJ(104),KFL) - IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110 - MSTJ(93)=1 - PMQ=ULMASS(KFLC) - IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 110 - QF=KCHG(KFLC,1)/3. - VQ=1. - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1.-(2.*PMQ/ECM)**2) - -C...Calculate R and sum of charges for QED or QFD case. - RQQ=RQQ+3.*QF**2*POLL - IF(MSTJ(102).LE.1) THEN - RTOT=RTOT+3.*0.5*VQ*(3.-VQ**2)*QF**2*POLL - ELSE - VF=SIGN(1.,QF)-4.*QF*PARU(102) - RQV=RQV-6.*QF*VF*SF1I - RVA=RVA+3.*(VF**2+1.)*SF1W - RTOT=RTOT+3.*(0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+ - & VF**2*HF1W)+VQ**3*HF1W) - ENDIF - 110 CONTINUE - RSUM=RQQ - IF(MSTJ(102).GE.2) RSUM=RQQ+SFI*RQV+SFW*RVA - -C...Calculate cross-section, including QCD corrections. - PARJ(141)=RQQ - PARJ(142)=RTOT - PARJ(143)=RTOT*RQCD - PARJ(144)=PARJ(143) - PARJ(145)=PARJ(141)*86.8/ECM**2 - PARJ(146)=PARJ(142)*86.8/ECM**2 - PARJ(147)=PARJ(143)*86.8/ECM**2 - PARJ(148)=PARJ(147) - PARJ(157)=RSUM*RQCD - PARJ(158)=0. - PARJ(159)=0. - XTOT=PARJ(147) - IF(MSTJ(107).LE.0) RETURN - -C...Virtual cross-section. - XKL=PARJ(135) - XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2) - ALE=2.*LOG(ECM/ULMASS(11))-1. - SIGV=ALE/3.+2.*LOG(ECM**2/(ULMASS(13)*ULMASS(15)))/3.-4./3.+ - &1.526*LOG(ECM**2/0.932) - -C...Soft and hard radiative cross-section in QED case. - IF(MSTJ(102).LE.1) THEN - SIGV=1.5*ALE-0.5+PARU(1)**2/3.+2.*SIGV - SIGS=ALE*(2.*LOG(XKL)-LOG(1.-XKL)-XKL) - SIGH=ALE*(2.*LOG(XKU/XKL)-LOG((1.-XKU)/(1.-XKL))-(XKU-XKL)) - -C...Soft and hard radiative cross-section in QFD case. - ELSE - SZM=1.-(PARJ(123)/ECM)**2 - SZW=PARJ(123)*PARJ(124)/ECM**2 - PARJ(161)=-RQQ/RSUM - PARJ(162)=-(RQQ+RQV+RVA)/RSUM - PARJ(163)=(RQV*(1.-0.5*SZM-SFI)+RVA*(1.5-SZM-SFW))/RSUM - PARJ(164)=(RQV*SZW**2*(1.-2.*SFW)+RVA*(2.*SFI+SZW**2-4.+3.*SZM- - & SZM**2))/(SZW*RSUM) - SIGV=1.5*ALE-0.5+PARU(1)**2/3.+((2.*RQQ+SFI*RQV)/RSUM)*SIGV+ - & (SZW*SFW*RQV/RSUM)*PARU(1)*20./9. - SIGS=ALE*(2.*LOG(XKL)+PARJ(161)*LOG(1.-XKL)+PARJ(162)*XKL+ - & PARJ(163)*LOG(((XKL-SZM)**2+SZW**2)/(SZM**2+SZW**2))+ - & PARJ(164)*(ATAN((XKL-SZM)/SZW)-ATAN(-SZM/SZW))) - SIGH=ALE*(2.*LOG(XKU/XKL)+PARJ(161)*LOG((1.-XKU)/(1.-XKL))+ - & PARJ(162)*(XKU-XKL)+PARJ(163)*LOG(((XKU-SZM)**2+SZW**2)/ - & ((XKL-SZM)**2+SZW**2))+PARJ(164)*(ATAN((XKU-SZM)/SZW)- - & ATAN((XKL-SZM)/SZW))) - ENDIF - -C...Total cross-section and fraction of hard photon events. - PARJ(160)=SIGH/(PARU(1)/PARU(101)+SIGV+SIGS+SIGH) - PARJ(157)=RSUM*(1.+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD - PARJ(144)=PARJ(157) - PARJ(148)=PARJ(144)*86.8/ECM**2 - XTOT=PARJ(148) - - RETURN - END - -C********************************************************************* - - SUBROUTINE LURADK(ECM,MK,PAK,THEK,PHIK,ALPK) - -C...Purpose: to generate initial state photon radiation. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUDAT1/ - -C...Function: cumulative hard photon spectrum in QFD case. - FXK(XX)=2.*LOG(XX)+PARJ(161)*LOG(1.-XX)+PARJ(162)*XX+ - &PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW) - -C...Determine whether radiative photon or not. - MK=0 - PAK=0. - IF(PARJ(160).LT.RLU(0)) RETURN - MK=1 - -C...Photon energy range. Find photon momentum in QED case. - XKL=PARJ(135) - XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2) - IF(MSTJ(102).LE.1) THEN - 100 XK=1./(1.+(1./XKL-1.)*((1./XKU-1.)/(1./XKL-1.))**RLU(0)) - IF(1.+(1.-XK)**2.LT.2.*RLU(0)) GOTO 100 - -C...Ditto in QFD case, by numerical inversion of integrated spectrum. - ELSE - SZM=1.-(PARJ(123)/ECM)**2 - SZW=PARJ(123)*PARJ(124)/ECM**2 - FXKL=FXK(XKL) - FXKU=FXK(XKU) - FXKD=1E-4*(FXKU-FXKL) - FXKR=FXKL+RLU(0)*(FXKU-FXKL) - NXK=0 - 110 NXK=NXK+1 - XK=0.5*(XKL+XKU) - FXKV=FXK(XK) - IF(FXKV.GT.FXKR) THEN - XKU=XK - FXKU=FXKV - ELSE - XKL=XK - FXKL=FXKV - ENDIF - IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110 - XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL) - ENDIF - PAK=0.5*ECM*XK - -C...Photon polar and azimuthal angle. - PME=2.*(ULMASS(11)/ECM)**2 - 120 CTHM=PME*(2./PME)**RLU(0) - IF(1.-(XK**2*CTHM*(1.-0.5*CTHM)+2.*(1.-XK)*PME/MAX(PME, - &CTHM*(1.-0.5*CTHM)))/(1.+(1.-XK)**2).LT.RLU(0)) GOTO 120 - CTHE=1.-CTHM - IF(RLU(0).GT.0.5) CTHE=-CTHE - STHE=SQRT(MAX(0.,(CTHM-PME)*(2.-CTHM))) - THEK=ULANGL(CTHE,STHE) - PHIK=PARU(2)*RLU(0) - -C...Rotation angle for hadronic system. - SGN=1. - IF(0.5*(2.-XK*(1.-CTHE))**2/((2.-XK)**2+(XK*CTHE)**2).GT. - &RLU(0)) SGN=-1. - ALPK=ASIN(SGN*STHE*(XK-SGN*(2.*SQRT(1.-XK)-2.+XK)*CTHE)/ - &(2.-XK*(1.-SGN*CTHE))) - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUXKFL(KFL,ECM,ECMC,KFLC) - -C...Purpose: to select flavour for produced qqbar pair. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUDAT1/,/LUDAT2/ - -C...Calculate maximum weight in QED or QFD case. - IF(MSTJ(102).LE.1) THEN - RFMAX=4./9. - ELSE - POLL=1.-PARJ(131)*PARJ(132) - SFF=1./(16.*PARU(102)*(1.-PARU(102))) - SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) - SFI=SFW*(1.-(PARJ(123)/ECMC)**2) - VE=4.*PARU(102)-1. - HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) - HF1W=SFW*SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131))) - RFMAX=MAX(4./9.*POLL-4./3.*(1.-8.*PARU(102)/3.)*HF1I+ - & ((1.-8.*PARU(102)/3.)**2+1.)*HF1W,1./9.*POLL+2./3.* - & (-1.+4.*PARU(102)/3.)*HF1I+((-1.+4.*PARU(102)/3.)**2+1.)*HF1W) - ENDIF - -C...Choose flavour. Gives charge and velocity. - NTRY=0 - 100 NTRY=NTRY+1 - IF(NTRY.GT.100) THEN - CALL LUERRM(14,'(LUXKFL:) caught in an infinite loop') - KFLC=0 - RETURN - ENDIF - KFLC=KFL - IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*RLU(0)) - MSTJ(93)=1 - PMQ=ULMASS(KFLC) - IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 100 - QF=KCHG(KFLC,1)/3. - VQ=1. - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*PMQ/ECMC)**2)) - -C...Calculate weight in QED or QFD case. - IF(MSTJ(102).LE.1) THEN - RF=QF**2 - RFV=0.5*VQ*(3.-VQ**2)*QF**2 - ELSE - VF=SIGN(1.,QF)-4.*QF*PARU(102) - RF=QF**2*POLL-2.*QF*VF*HF1I+(VF**2+1.)*HF1W - RFV=0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+VF**2*HF1W)+ - & VQ**3*HF1W - IF(RFV.GT.0.) PARJ(171)=MIN(1.,VQ**3*HF1W/RFV) - ENDIF - -C...Weighting or new event (radiative photon). Cross-section update. - IF(KFL.LE.0.AND.RF.LT.RLU(0)*RFMAX) GOTO 100 - PARJ(158)=PARJ(158)+1. - IF(ECMC.LT.2.*PMQ+PARJ(127).OR.RFV.LT.RLU(0)*RF) KFLC=0 - IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100 - IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1. - PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158) - PARJ(148)=PARJ(144)*86.8/ECM**2 - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUXJET(ECM,NJET,CUT) - -C...Purpose: to select number of jets in matrix element approach. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUDAT1/ - DIMENSION ZHUT(5) - -C...Relative three-jet rate in Zhu second order parametrization. - DATA ZHUT/3.0922, 6.2291, 7.4782, 7.8440, 8.2560/ - -C...Trivial result for two-jets only, including parton shower. - IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN - CUT=0. - -C...QCD and Abelian vector gluon theory: Q^2 for jet rate and R. - ELSEIF(MSTJ(109).EQ.0.OR.MSTJ(109).EQ.2) THEN - CF=4./3. - IF(MSTJ(109).EQ.2) CF=1. - IF(MSTJ(111).EQ.0) THEN - Q2=ECM**2 - Q2R=ECM**2 - ELSEIF(MSTU(111).EQ.0) THEN - PARJ(169)=MIN(1.,PARJ(129)) - Q2=PARJ(169)*ECM**2 - PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/ - & ((33.-2.*MSTU(112))*PARU(111))))) - Q2R=PARJ(168)*ECM**2 - ELSE - PARJ(169)=MIN(1.,MAX(PARJ(129),(2.*PARU(112)/ECM)**2)) - Q2=PARJ(169)*ECM**2 - PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM, - & (2.*PARU(112)/ECM)**2)) - Q2R=PARJ(168)*ECM**2 - ENDIF - -C...alpha_strong for R and R itself. - ALSPI=(3./4.)*CF*ULALPS(Q2R)/PARU(1) - IF(IABS(MSTJ(101)).EQ.1) THEN - RQCD=1.+ALSPI - ELSEIF(MSTJ(109).EQ.0) THEN - RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2 - IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.* - & LOG(PARJ(168))*ALSPI**2) - ELSE - RQCD=1.+ALSPI-(3./32.+0.519*MSTU(118))*(4.*ALSPI/3.)**2 - ENDIF - -C...alpha_strong for jet rate. Initial value for y cut. - ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1) - CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2) - IF(IABS(MSTJ(101)).LE.1.OR.(MSTJ(109).EQ.0.AND.MSTJ(111).EQ.0)) - & CUT=MAX(CUT,EXP(-SQRT(0.75/ALSPI))/2.) - IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT)) - -C...Parametrization of first order three-jet cross-section. - 100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25) THEN - PARJ(152)=0. - ELSE - PARJ(152)=(2.*ALSPI/3.)*((3.-6.*CUT+2.*LOG(CUT))* - & LOG(CUT/(1.-2.*CUT))+(2.5+1.5*CUT-6.571)*(1.-3.*CUT)+ - & 5.833*(1.-3.*CUT)**2-3.894*(1.-3.*CUT)**3+ - & 1.342*(1.-3.*CUT)**4)/RQCD - IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2)) - & PARJ(152)=0. - ENDIF - -C...Parametrization of second order three-jet cross-section. - IF(IABS(MSTJ(101)).LE.1.OR.MSTJ(101).EQ.3.OR.MSTJ(109).EQ.2.OR. - & CUT.GE.0.25) THEN - PARJ(153)=0. - ELSEIF(MSTJ(110).LE.1) THEN - CT=LOG(1./CUT-2.) - PARJ(153)=ALSPI**2*CT**2*(2.419+0.5989*CT+0.6782*CT**2- - & 0.2661*CT**3+0.01159*CT**4)/RQCD - -C...Interpolation in second/first order ratio for Zhu parametrization. - ELSEIF(MSTJ(110).EQ.2) THEN - IZA=0 - DO 110 IY=1,5 - IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY - 110 CONTINUE - IF(IZA.NE.0) THEN - ZHURAT=ZHUT(IZA) - ELSE - IZ=100.*CUT - ZHURAT=ZHUT(IZ)+(100.*CUT-IZ)*(ZHUT(IZ+1)-ZHUT(IZ)) - ENDIF - PARJ(153)=ALSPI*PARJ(152)*ZHURAT - ENDIF - -C...Shift in second order three-jet cross-section with optimized Q^2. - IF(MSTJ(111).EQ.1.AND.IABS(MSTJ(101)).GE.2.AND.MSTJ(101).NE.3. - & AND.CUT.LT.0.25) PARJ(153)=PARJ(153)+(33.-2.*MSTU(112))/12.* - & LOG(PARJ(169))*ALSPI*PARJ(152) - -C...Parametrization of second order four-jet cross-section. - IF(IABS(MSTJ(101)).LE.1.OR.CUT.GE.0.125) THEN - PARJ(154)=0. - ELSE - CT=LOG(1./CUT-5.) - IF(CUT.LE.0.018) THEN - XQQGG=6.349-4.330*CT+0.8304*CT**2 - IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(3.035-2.091*CT+ - & 0.4059*CT**2) - XQQQQ=1.25*(-0.1080+0.01486*CT+0.009364*CT**2) - IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ - ELSE - XQQGG=-0.09773+0.2959*CT-0.2764*CT**2+0.08832*CT**3 - IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(-0.04079+0.1340*CT- - & 0.1326*CT**2+0.04365*CT**3) - XQQQQ=1.25*(0.003661-0.004888*CT-0.001081*CT**2+0.002093* - & CT**3) - IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ - ENDIF - PARJ(154)=ALSPI**2*CT**2*(XQQGG+XQQQQ)/RQCD - PARJ(155)=XQQQQ/(XQQGG+XQQQQ) - ENDIF - -C...If negative three-jet rate, change y' optimization parameter. - IF(MSTJ(111).EQ.1.AND.PARJ(152)+PARJ(153).LT.0..AND. - & PARJ(169).LT.0.99) THEN - PARJ(169)=MIN(1.,1.2*PARJ(169)) - Q2=PARJ(169)*ECM**2 - ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1) - GOTO 100 - ENDIF - -C...If too high cross-section, use harder cuts, or fail. - IF(PARJ(152)+PARJ(153)+PARJ(154).GE.1) THEN - IF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499.AND.MSTJ(111).EQ.1.AND. - & PARJ(169).LT.0.99) THEN - PARJ(169)=MIN(1.,1.2*PARJ(169)) - Q2=PARJ(169)*ECM**2 - ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1) - GOTO 100 - ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499) THEN - CALL LUERRM(26, - & '(LUXJET:) no allowed y cut value for Zhu parametrization') - ENDIF - CUT=0.26*(4.*CUT)**(PARJ(152)+PARJ(153)+PARJ(154))**(-1./3.) - IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT)) - GOTO 100 - ENDIF - -C...Scalar gluon (first order only). - ELSE - ALSPI=ULALPS(ECM**2)/PARU(1) - CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3./ALSPI)) - PARJ(152)=0. - IF(CUT.LT.0.25) PARJ(152)=(ALSPI/3.)*((1.-2.*CUT)* - & LOG((1.-2.*CUT)/CUT)+0.5*(9.*CUT**2-1.)) - PARJ(153)=0. - PARJ(154)=0. - ENDIF - -C...Select number of jets. - PARJ(150)=CUT - IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN - NJET=2 - ELSEIF(MSTJ(101).LE.0) THEN - NJET=MIN(4,2-MSTJ(101)) - ELSE - RNJ=RLU(0) - NJET=2 - IF(PARJ(152)+PARJ(153)+PARJ(154).GT.RNJ) NJET=3 - IF(PARJ(154).GT.RNJ) NJET=4 - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUX3JT(NJET,CUT,KFL,ECM,X1,X2) - -C...Purpose: to select the kinematical variables of three-jet events. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUDAT1/ - DIMENSION ZHUP(5,12) - -C...Coefficients of Zhu second order parametrization. - DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/ - & 18.29, 89.56, 4.541, -52.09, -109.8, 24.90, - & 11.63, 3.683, 17.50, 0.002440, -1.362, -0.3537, - & 11.42, 6.299, -22.55, -8.915, 59.25, -5.855, - & -32.85, -1.054, -16.90, 0.006489, -0.8156, 0.01095, - & 7.847, -3.964, -35.83, 1.178, 29.39, 0.2806, - & 47.82, -12.36, -56.72, 0.04054, -0.4365, 0.6062, - & 5.441, -56.89, -50.27, 15.13, 114.3, -18.19, - & 97.05, -1.890, -139.9, 0.08153, -0.4984, 0.9439, - & -17.65, 51.44, -58.32, 70.95, -255.7, -78.99, - & 476.9, 29.65, -239.3, 0.4745, -1.174, 6.081/ - -C...Dilogarithm of x for x<0.5 (x>0.5 obtained by analytic trick). - DILOG(X)=X+X**2/4.+X**3/9.+X**4/16.+X**5/25.+X**6/36.+X**7/49. - -C...Event type. Mass effect factors and other common constants. - MSTJ(120)=2 - MSTJ(121)=0 - PMQ=ULMASS(KFL) - QME=(2.*PMQ/ECM)**2 - IF(MSTJ(109).NE.1) THEN - CUTL=LOG(CUT) - CUTD=LOG(1./CUT-2.) - IF(MSTJ(109).EQ.0) THEN - CF=4./3. - CN=3. - TR=2. - WTMX=MIN(20.,37.-6.*CUTD) - IF(MSTJ(110).EQ.2) WTMX=2.*(7.5+80.*CUT) - ELSE - CF=1. - CN=0. - TR=12. - WTMX=0. - ENDIF - -C...Alpha_strong and effects of optimized Q^2 scale. Maximum weight. - ALS2PI=PARU(118)/PARU(2) - WTOPT=0. - IF(MSTJ(111).EQ.1) WTOPT=(33.-2.*MSTU(112))/6.*LOG(PARJ(169))* - & ALS2PI - WTMAX=MAX(0.,1.+WTOPT+ALS2PI*WTMX) - -C...Choose three-jet events in allowed region. - 100 NJET=3 - 110 Y13L=CUTL+CUTD*RLU(0) - Y23L=CUTL+CUTD*RLU(0) - Y13=EXP(Y13L) - Y23=EXP(Y23L) - Y12=1.-Y13-Y23 - IF(Y12.LE.CUT) GOTO 110 - IF(Y13**2+Y23**2+2.*Y12.LE.2.*RLU(0)) GOTO 110 - -C...Second order corrections. - IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN - Y12L=LOG(Y12) - Y13M=LOG(1.-Y13) - Y23M=LOG(1.-Y23) - Y12M=LOG(1.-Y12) - IF(Y13.LE.0.5) Y13I=DILOG(Y13) - IF(Y13.GE.0.5) Y13I=1.644934-Y13L*Y13M-DILOG(1.-Y13) - IF(Y23.LE.0.5) Y23I=DILOG(Y23) - IF(Y23.GE.0.5) Y23I=1.644934-Y23L*Y23M-DILOG(1.-Y23) - IF(Y12.LE.0.5) Y12I=DILOG(Y12) - IF(Y12.GE.0.5) Y12I=1.644934-Y12L*Y12M-DILOG(1.-Y12) - WT1=(Y13**2+Y23**2+2.*Y12)/(Y13*Y23) - WT2=CF*(-2.*(CUTL-Y12L)**2-3.*CUTL-1.+3.289868+ - & 2.*(2.*CUTL-Y12L)*CUT/Y12)+ - & CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2-11.*CUTL/6.+ - & 67./18.+1.644934-(2.*CUTL-Y12L)*CUT/Y12+(2.*CUTL-Y13L)* - & CUT/Y13+(2.*CUTL-Y23L)*CUT/Y23)+ - & TR*(2.*CUTL/3.-10./9.)+ - & CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+ - & Y13L*(4.*Y12**2+2.*Y12*Y13+4.*Y12*Y23+Y13*Y23)/(Y12+Y23)**2+ - & Y23L*(4.*Y12**2+2.*Y12*Y23+4.*Y12*Y13+Y13*Y23)/(Y12+Y13)**2)/ - & WT1+ - & CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+ - & (CN-2.*CF)*((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L* - & Y23M+1.644934-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)* - & (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934-Y12I-Y13I)/ - & (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))- - & 2.*Y12L*Y12**2/(Y13+Y23)**2-4.*Y12L*Y12/(Y13+Y23))/WT1- - & CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934-Y13I-Y23I) - IF(1.+WTOPT+ALS2PI*WT2.LE.0.) MSTJ(121)=1 - IF(1.+WTOPT+ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110 - PARJ(156)=(WTOPT+ALS2PI*WT2)/(1.+WTOPT+ALS2PI*WT2) - - ELSEIF(MSTJ(101).EQ.2.AND.MSTJ(110).EQ.2) THEN -C...Second order corrections; Zhu parametrization of ERT. - ZX=(Y23-Y13)**2 - ZY=1.-Y12 - IZA=0 - DO 120 IY=1,5 - IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY - 120 CONTINUE - IF(IZA.NE.0) THEN - IZ=IZA - WT2=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ - & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ - & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ - & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY - ELSE - IZ=100.*CUT - WTL=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ - & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ - & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ - & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY - IZ=IZ+1 - WTU=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ - & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ - & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ - & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY - WT2=WTL+(WTU-WTL)*(100.*CUT+1.-IZ) - ENDIF - IF(1.+WTOPT+2.*ALS2PI*WT2.LE.0.) MSTJ(121)=1 - IF(1.+WTOPT+2.*ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110 - PARJ(156)=(WTOPT+2.*ALS2PI*WT2)/(1.+WTOPT+2.*ALS2PI*WT2) - ENDIF - -C...Impose mass cuts (gives two jets). For fixed jet number new try. - X1=1.-Y23 - X2=1.-Y13 - X3=1.-Y12 - IF(4.*Y23*Y13*Y12/X3**2.LE.QME) NJET=2 - IF(MOD(MSTJ(103),4).GE.2.AND.IABS(MSTJ(101)).LE.1.AND.QME*X3+ - & 0.5*QME**2+(0.5*QME+0.25*QME**2)*((1.-X2)/(1.-X1)+ - & (1.-X1)/(1.-X2)).GT.(X1**2+X2**2)*RLU(0)) NJET=2 - IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 100 - -C...Scalar gluon model (first order only, no mass effects). - ELSE - 130 NJET=3 - 140 X3=SQRT(4.*CUT**2+RLU(0)*((1.-CUT)**2-4.*CUT**2)) - IF(LOG((X3-CUT)/CUT).LE.RLU(0)*LOG((1.-2.*CUT)/CUT)) GOTO 140 - YD=SIGN(2.*CUT*((X3-CUT)/CUT)**RLU(0)-X3,RLU(0)-0.5) - X1=1.-0.5*(X3+YD) - X2=1.-0.5*(X3-YD) - IF(4.*(1.-X1)*(1.-X2)*(1.-X3)/X3**2.LE.QME) NJET=2 - IF(MSTJ(102).GE.2) THEN - IF(X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)*PARJ(171).LT. - & X3**2*RLU(0)) NJET=2 - ENDIF - IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 130 - ENDIF - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUX4JT(NJET,CUT,KFL,ECM,KFLN,X1,X2,X4,X12,X14) - -C...Purpose: to select the kinematical variables of four-jet events. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUDAT1/ - DIMENSION WTA(4),WTB(4),WTC(4),WTD(4),WTE(4) - -C...Common constants. Colour factors for QCD and Abelian gluon theory. - PMQ=ULMASS(KFL) - QME=(2.*PMQ/ECM)**2 - CT=LOG(1./CUT-5.) - IF(MSTJ(109).EQ.0) THEN - CF=4./3. - CN=3. - TR=2.5 - ELSE - CF=1. - CN=0. - TR=15. - ENDIF - -C...Choice of process (qqbargg or qqbarqqbar). - 100 NJET=4 - IT=1 - IF(PARJ(155).GT.RLU(0)) IT=2 - IF(MSTJ(101).LE.-3) IT=-MSTJ(101)-2 - IF(IT.EQ.1) WTMX=0.7/CUT**2 - IF(IT.EQ.1.AND.MSTJ(109).EQ.2) WTMX=0.6/CUT**2 - IF(IT.EQ.2) WTMX=0.1125*CF*TR/CUT**2 - ID=1 - -C...Sample the five kinematical variables (for qqgg preweighted in y34). - 110 Y134=3.*CUT+(1.-6.*CUT)*RLU(0) - Y234=3.*CUT+(1.-6.*CUT)*RLU(0) - IF(IT.EQ.1) Y34=(1.-5.*CUT)*EXP(-CT*RLU(0)) - IF(IT.EQ.2) Y34=CUT+(1.-6.*CUT)*RLU(0) - IF(Y34.LE.Y134+Y234-1..OR.Y34.GE.Y134*Y234) GOTO 110 - VT=RLU(0) - CP=COS(PARU(1)*RLU(0)) - Y14=(Y134-Y34)*VT - Y13=Y134-Y14-Y34 - VB=Y34*(1.-Y134-Y234+Y34)/((Y134-Y34)*(Y234-Y34)) - Y24=0.5*(Y234-Y34)*(1.-4.*SQRT(MAX(0.,VT*(1.-VT)*VB*(1.-VB)))* - &CP-(1.-2.*VT)*(1.-2.*VB)) - Y23=Y234-Y34-Y24 - Y12=1.-Y134-Y23-Y24 - IF(MIN(Y12,Y13,Y14,Y23,Y24).LE.CUT) GOTO 110 - Y123=Y12+Y13+Y23 - Y124=Y12+Y14+Y24 - -C...Calculate matrix elements for qqgg or qqqq process. - IC=0 - WTTOT=0. - 120 IC=IC+1 - IF(IT.EQ.1) THEN - WTA(IC)=(Y12*Y34**2-Y13*Y24*Y34+Y14*Y23*Y34+3.*Y12*Y23*Y34+ - & 3.*Y12*Y14*Y34+4.*Y12**2*Y34-Y13*Y23*Y24+2.*Y12*Y23*Y24- - & Y13*Y14*Y24-2.*Y12*Y13*Y24+2.*Y12**2*Y24+Y14*Y23**2+2.*Y12* - & Y23**2+Y14**2*Y23+4.*Y12*Y14*Y23+4.*Y12**2*Y23+2.*Y12*Y14**2+ - & 2.*Y12*Y13*Y14+4.*Y12**2*Y14+2.*Y12**2*Y13+2.*Y12**3)/(2.*Y13* - & Y134*Y234*Y24)+(Y24*Y34+Y12*Y34+Y13*Y24-Y14*Y23+Y12*Y13)/(Y13* - & Y134**2)+2.*Y23*(1.-Y13)/(Y13*Y134*Y24)+Y34/(2.*Y13*Y24) - WTB(IC)=(Y12*Y24*Y34+Y12*Y14*Y34-Y13*Y24**2+Y13*Y14*Y24+2.*Y12* - & Y14*Y24)/(Y13*Y134*Y23*Y14)+Y12*(1.+Y34)*Y124/(Y134*Y234*Y14* - & Y24)-(2.*Y13*Y24+Y14**2+Y13*Y23+2.*Y12*Y13)/(Y13*Y134*Y14)+ - & Y12*Y123*Y124/(2.*Y13*Y14*Y23*Y24) - WTC(IC)=-(5.*Y12*Y34**2+2.*Y12*Y24*Y34+2.*Y12*Y23*Y34+2.*Y12* - & Y14*Y34+2.*Y12*Y13*Y34+4.*Y12**2*Y34-Y13*Y24**2+Y14*Y23*Y24+ - & Y13*Y23*Y24+Y13*Y14*Y24-Y12*Y14*Y24-Y13**2*Y24-3.*Y12*Y13*Y24- - & Y14*Y23**2-Y14**2*Y23+Y13*Y14*Y23-3.*Y12*Y14*Y23-Y12*Y13*Y23)/ - & (4.*Y134*Y234*Y34**2)+(3.*Y12*Y34**2-3.*Y13*Y24*Y34+3.*Y12*Y24* - & Y34+3.*Y14*Y23*Y34-Y13*Y24**2-Y12*Y23*Y34+6.*Y12*Y14*Y34+2.*Y12* - & Y13*Y34-2.*Y12**2*Y34+Y14*Y23*Y24-3.*Y13*Y23*Y24-2.*Y13*Y14* - & Y24+4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+3.*Y14*Y23**2+2.*Y14**2*Y23+ - & 2.*Y14**2*Y12+2.*Y12**2*Y14+6.*Y12*Y14*Y23-2.*Y12*Y13**2- - & 2.*Y12**2*Y13)/(4.*Y13*Y134*Y234*Y34) - WTC(IC)=WTC(IC)+(2.*Y12*Y34**2-2.*Y13*Y24*Y34+Y12*Y24*Y34+ - & 4.*Y13*Y23*Y34+4.*Y12*Y14*Y34+2.*Y12*Y13*Y34+2.*Y12**2*Y34- - & Y13*Y24**2+3.*Y14*Y23*Y24+4.*Y13*Y23*Y24-2.*Y13*Y14*Y24+ - & 4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+2.*Y14*Y23**2+4.*Y13*Y23**2+ - & 2.*Y13*Y14*Y23+2.*Y12*Y14*Y23+4.*Y12*Y13*Y23+2.*Y12*Y14**2+4.* - & Y12**2*Y13+4.*Y12*Y13*Y14+2.*Y12**2*Y14)/(4.*Y13*Y134*Y24*Y34)- - & (Y12*Y34**2-2.*Y14*Y24*Y34-2.*Y13*Y24*Y34-Y14*Y23*Y34+Y13*Y23* - & Y34+Y12*Y14*Y34+2.*Y12*Y13*Y34-2.*Y14**2*Y24-4.*Y13*Y14*Y24- - & 4.*Y13**2*Y24-Y14**2*Y23-Y13**2*Y23+Y12*Y13*Y14-Y12*Y13**2)/ - & (2.*Y13*Y34*Y134**2)+(Y12*Y34**2-4.*Y14*Y24*Y34-2.*Y13*Y24*Y34- - & 2.*Y14*Y23*Y34-4.*Y13*Y23*Y34-4.*Y12*Y14*Y34-4.*Y12*Y13*Y34- - & 2.*Y13*Y14*Y24+2.*Y13**2*Y24+2.*Y14**2*Y23-2.*Y13*Y14*Y23- - & Y12*Y14**2-6.*Y12*Y13*Y14-Y12*Y13**2)/(4.*Y34**2*Y134**2) - WTTOT=WTTOT+Y34*CF*(CF*WTA(IC)+(CF-0.5*CN)*WTB(IC)+CN*WTC(IC))/ - & 8. - ELSE - WTD(IC)=(Y13*Y23*Y34+Y12*Y23*Y34-Y12**2*Y34+Y13*Y23*Y24+2.*Y12* - & Y23*Y24-Y14*Y23**2+Y12*Y13*Y24+Y12*Y14*Y23+Y12*Y13*Y14)/(Y13**2* - & Y123**2)-(Y12*Y34**2-Y13*Y24*Y34+Y12*Y24*Y34-Y14*Y23*Y34-Y12* - & Y23*Y34-Y13*Y24**2+Y14*Y23*Y24-Y13*Y23*Y24-Y13**2*Y24+Y14* - & Y23**2)/(Y13**2*Y123*Y134)+(Y13*Y14*Y12+Y34*Y14*Y12-Y34**2*Y12+ - & Y13*Y14*Y24+2.*Y34*Y14*Y24-Y23*Y14**2+Y34*Y13*Y24+Y34*Y23*Y14+ - & Y34*Y13*Y23)/(Y13**2*Y134**2)-(Y34*Y12**2-Y13*Y24*Y12+Y34*Y24* - & Y12-Y23*Y14*Y12-Y34*Y14*Y12-Y13*Y24**2+Y23*Y14*Y24-Y13*Y14*Y24- - & Y13**2*Y24+Y23*Y14**2)/(Y13**2*Y134*Y123) - WTE(IC)=(Y12*Y34*(Y23-Y24+Y14+Y13)+Y13*Y24**2-Y14*Y23*Y24+Y13* - & Y23*Y24+Y13*Y14*Y24+Y13**2*Y24-Y14*Y23*(Y14+Y23+Y13))/(Y13*Y23* - & Y123*Y134)-Y12*(Y12*Y34-Y23*Y24-Y13*Y24-Y14*Y23-Y14*Y13)/(Y13* - & Y23*Y123**2)-(Y14+Y13)*(Y24+Y23)*Y34/(Y13*Y23*Y134*Y234)+ - & (Y12*Y34*(Y14-Y24+Y23+Y13)+Y13*Y24**2-Y23*Y14*Y24+Y13*Y14*Y24+ - & Y13*Y23*Y24+Y13**2*Y24-Y23*Y14*(Y14+Y23+Y13))/(Y13*Y14*Y134* - & Y123)-Y34*(Y34*Y12-Y14*Y24-Y13*Y24-Y23*Y14-Y23*Y13)/(Y13*Y14* - & Y134**2)-(Y23+Y13)*(Y24+Y14)*Y12/(Y13*Y14*Y123*Y124) - WTTOT=WTTOT+CF*(TR*WTD(IC)+(CF-0.5*CN)*WTE(IC))/16. - ENDIF - -C...Permutations of momenta in matrix element. Weighting. - 130 IF(IC.EQ.1.OR.IC.EQ.3.OR.ID.EQ.2.OR.ID.EQ.3) THEN - YSAV=Y13 - Y13=Y14 - Y14=YSAV - YSAV=Y23 - Y23=Y24 - Y24=YSAV - YSAV=Y123 - Y123=Y124 - Y124=YSAV - ENDIF - IF(IC.EQ.2.OR.IC.EQ.4.OR.ID.EQ.3.OR.ID.EQ.4) THEN - YSAV=Y13 - Y13=Y23 - Y23=YSAV - YSAV=Y14 - Y14=Y24 - Y24=YSAV - YSAV=Y134 - Y134=Y234 - Y234=YSAV - ENDIF - IF(IC.LE.3) GOTO 120 - IF(ID.EQ.1.AND.WTTOT.LT.RLU(0)*WTMX) GOTO 110 - IC=5 - -C...qqgg events: string configuration and event type. - IF(IT.EQ.1) THEN - IF(MSTJ(109).EQ.0.AND.ID.EQ.1) THEN - PARJ(156)=Y34*(2.*(WTA(1)+WTA(2)+WTA(3)+WTA(4))+4.*(WTC(1)+ - & WTC(2)+WTC(3)+WTC(4)))/(9.*WTTOT) - IF(WTA(2)+WTA(4)+2.*(WTC(2)+WTC(4)).GT.RLU(0)*(WTA(1)+WTA(2)+ - & WTA(3)+WTA(4)+2.*(WTC(1)+WTC(2)+WTC(3)+WTC(4)))) ID=2 - IF(ID.EQ.2) GOTO 130 - ELSEIF(MSTJ(109).EQ.2.AND.ID.EQ.1) THEN - PARJ(156)=Y34*(WTA(1)+WTA(2)+WTA(3)+WTA(4))/(8.*WTTOT) - IF(WTA(2)+WTA(4).GT.RLU(0)*(WTA(1)+WTA(2)+WTA(3)+WTA(4))) ID=2 - IF(ID.EQ.2) GOTO 130 - ENDIF - MSTJ(120)=3 - IF(MSTJ(109).EQ.0.AND.0.5*Y34*(WTC(1)+WTC(2)+WTC(3)+WTC(4)).GT. - & RLU(0)*WTTOT) MSTJ(120)=4 - KFLN=21 - -C...Mass cuts. Kinematical variables out. - IF(Y12.LE.CUT+QME) NJET=2 - IF(NJET.EQ.2) GOTO 150 - Q12=0.5*(1.-SQRT(1.-QME/Y12)) - X1=1.-(1.-Q12)*Y234-Q12*Y134 - X4=1.-(1.-Q12)*Y134-Q12*Y234 - X2=1.-Y124 - X12=(1.-Q12)*Y13+Q12*Y23 - X14=Y12-0.5*QME - IF(Y134*Y234/((1.-X1)*(1.-X4)).LE.RLU(0)) NJET=2 - -C...qqbarqqbar events: string configuration, choose new flavour. - ELSE - IF(ID.EQ.1) THEN - WTR=RLU(0)*(WTD(1)+WTD(2)+WTD(3)+WTD(4)) - IF(WTR.LT.WTD(2)+WTD(3)+WTD(4)) ID=2 - IF(WTR.LT.WTD(3)+WTD(4)) ID=3 - IF(WTR.LT.WTD(4)) ID=4 - IF(ID.GE.2) GOTO 130 - ENDIF - MSTJ(120)=5 - PARJ(156)=CF*TR*(WTD(1)+WTD(2)+WTD(3)+WTD(4))/(16.*WTTOT) - 140 KFLN=1+INT(5.*RLU(0)) - IF(KFLN.NE.KFL.AND.0.2*PARJ(156).LE.RLU(0)) GOTO 140 - IF(KFLN.EQ.KFL.AND.1.-0.8*PARJ(156).LE.RLU(0)) GOTO 140 - IF(KFLN.GT.MSTJ(104)) NJET=2 - PMQN=ULMASS(KFLN) - QMEN=(2.*PMQN/ECM)**2 - -C...Mass cuts. Kinematical variables out. - IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1*QMEN) NJET=2 - IF(NJET.EQ.2) GOTO 150 - Q24=0.5*(1.-SQRT(1.-QME/Y24)) - Q13=0.5*(1.-SQRT(1.-QMEN/Y13)) - X1=1.-(1.-Q24)*Y123-Q24*Y134 - X4=1.-(1.-Q24)*Y134-Q24*Y123 - X2=1.-(1.-Q13)*Y234-Q13*Y124 - X12=(1.-Q24)*((1.-Q13)*Y14+Q13*Y34)+Q24*((1.-Q13)*Y12+Q13*Y23) - X14=Y24-0.5*QME - X34=(1.-Q24)*((1.-Q13)*Y23+Q13*Y12)+Q24*((1.-Q13)*Y34+Q13*Y14) - IF(PMQ**2+PMQN**2+MIN(X12,X34)*ECM**2.LE. - & (PARJ(127)+PMQ+PMQN)**2) NJET=2 - IF(Y123*Y134/((1.-X1)*(1.-X4)).LE.RLU(0)) NJET=2 - ENDIF - 150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100 - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI) - -C...Purpose: to give the angular orientation of events. - 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...Charge. Factors depending on polarization for QED case. - QF=KCHG(KFL,1)/3. - POLL=1.-PARJ(131)*PARJ(132) - POLD=PARJ(132)-PARJ(131) - IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN - HF1=POLL - HF2=0. - HF3=PARJ(133)**2 - HF4=0. - -C...Factors depending on flavour, energy and polarization for QFD case. - ELSE - SFF=1./(16.*PARU(102)*(1.-PARU(102))) - SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) - SFI=SFW*(1.-(PARJ(123)/ECM)**2) - AE=-1. - VE=4.*PARU(102)-1. - AF=SIGN(1.,QF) - VF=AF-4.*QF*PARU(102) - HF1=QF**2*POLL-2.*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+ - & (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2.*VE*AE*POLD) - HF2=-2.*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2.*VF*AF*SFW*SFF**2* - & (2.*VE*AE*POLL-(VE**2+AE**2)*POLD) - HF3=PARJ(133)**2*(QF**2-2.*QF*VF*SFI*SFF*VE+(VF**2+AF**2)* - & SFW*SFF**2*(VE**2-AE**2)) - HF4=-PARJ(133)**2*2.*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)* - & SFF*AE - ENDIF - -C...Mass factor. Differential cross-sections for two-jet events. - SQ2=SQRT(2.) - QME=0. - IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND. - &MSTJ(109).NE.1) QME=(2.*ULMASS(KFL)/ECM)**2 - IF(NJET.EQ.2) THEN - SIGU=4.*SQRT(1.-QME) - SIGL=2.*QME*SQRT(1.-QME) - SIGT=0. - SIGI=0. - SIGA=0. - SIGP=4. - -C...Kinematical variables. Reduce four-jet event to three-jet one. - ELSE - IF(NJET.EQ.3) THEN - X1=2.*P(NC+1,4)/ECM - X2=2.*P(NC+3,4)/ECM - ELSE - ECMR=P(NC+1,4)+P(NC+4,4)+SQRT((P(NC+2,1)+P(NC+3,1))**2+ - & (P(NC+2,2)+P(NC+3,2))**2+(P(NC+2,3)+P(NC+3,3))**2) - X1=2.*P(NC+1,4)/ECMR - X2=2.*P(NC+4,4)/ECMR - ENDIF - -C...Differential cross-sections for three-jet (or reduced four-jet). - XQ=(1.-X1)/(1.-X2) - CT12=(X1*X2-2.*X1-2.*X2+2.+QME)/SQRT((X1**2-QME)*(X2**2-QME)) - ST12=SQRT(1.-CT12**2) - IF(MSTJ(109).NE.1) THEN - SIGU=2.*X1**2+X2**2*(1.+CT12**2)-QME*(3.+CT12**2-X1-X2)- - & QME*X1/XQ+0.5*QME*((X2**2-QME)*ST12**2-2.*X2)*XQ - SIGL=(X2*ST12)**2-QME*(3.-CT12**2-2.5*(X1+X2)+X1*X2+QME)+ - & 0.5*QME*(X1**2-X1-QME)/XQ+0.5*QME*((X2**2-QME)*CT12**2-X2)*XQ - SIGT=0.5*(X2**2-QME-0.5*QME*(X2**2-QME)/XQ)*ST12**2 - SIGI=((1.-0.5*QME*XQ)*(X2**2-QME)*ST12*CT12+QME*(1.-X1-X2+ - & 0.5*X1*X2+0.5*QME)*ST12/CT12)/SQ2 - SIGA=X2**2*ST12/SQ2 - SIGP=2.*(X1**2-X2**2*CT12) - -C...Differential cross-sect for scalar gluons (no mass effects). - ELSE - X3=2.-X1-X2 - XT=X2*ST12 - CT13=SQRT(MAX(0.,1.-(XT/X3)**2)) - SIGU=(1.-PARJ(171))*(X3**2-0.5*XT**2)+ - & PARJ(171)*(X3**2-0.5*XT**2-4.*(1.-X1)*(1.-X2)**2/X1) - SIGL=(1.-PARJ(171))*0.5*XT**2+ - & PARJ(171)*0.5*(1.-X1)**2*XT**2 - SIGT=(1.-PARJ(171))*0.25*XT**2+ - & PARJ(171)*0.25*XT**2*(1.-2.*X1) - SIGI=-(0.5/SQ2)*((1.-PARJ(171))*XT*X3*CT13+ - & PARJ(171)*XT*((1.-2.*X1)*X3*CT13-X1*(X1-X2))) - SIGA=(0.25/SQ2)*XT*(2.*(1.-X1)-X1*X3) - SIGP=X3**2-2.*(1.-X1)*(1.-X2)/X1 - ENDIF - ENDIF - -C...Upper bounds for differential cross-section. - HF1A=ABS(HF1) - HF2A=ABS(HF2) - HF3A=ABS(HF3) - HF4A=ABS(HF4) - SIGMAX=(2.*HF1A+HF3A+HF4A)*ABS(SIGU)+2.*(HF1A+HF3A+HF4A)* - &ABS(SIGL)+2.*(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGT)+2.*SQ2* - &(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGI)+4.*SQ2*HF2A*ABS(SIGA)+ - &2.*HF2A*ABS(SIGP) - -C...Generate angular orientation according to differential cross-sect. - 100 CHI=PARU(2)*RLU(0) - CTHE=2.*RLU(0)-1. - PHI=PARU(2)*RLU(0) - CCHI=COS(CHI) - SCHI=SIN(CHI) - C2CHI=COS(2.*CHI) - S2CHI=SIN(2.*CHI) - THE=ACOS(CTHE) - STHE=SIN(THE) - C2PHI=COS(2.*(PHI-PARJ(134))) - S2PHI=SIN(2.*(PHI-PARJ(134))) - SIG=((1.+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+ - &2.*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+ - &2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*C2CHI*C2PHI-2.*CTHE*S2CHI* - &S2PHI)*HF3-((1.+CTHE**2)*C2CHI*S2PHI+2.*CTHE*S2CHI*C2PHI)*HF4)* - &SIGT-2.*SQ2*(2.*STHE*CTHE*CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI- - &SCHI*S2PHI)*HF3+2.*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+ - &4.*SQ2*STHE*CCHI*HF2*SIGA+2.*CTHE*HF2*SIGP - IF(SIG.LT.SIGMAX*RLU(0)) GOTO 100 - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUONIA(KFL,ECM) - -C...Purpose: to generate Upsilon and toponium decays into three -C...gluons or two gluons and a photon. - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - -C...Printout. Check input parameters. - IF(MSTU(12).GE.1) CALL LULIST(0) - IF(KFL.LT.0.OR.KFL.GT.8) THEN - CALL LUERRM(16,'(LUONIA:) called with unknown flavour code') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN - CALL LUERRM(16,'(LUONIA:) called with too small CM energy') - IF(MSTU(21).GE.1) RETURN - ENDIF - -C...Initial e+e- and onium state (optional). - NC=0 - IF(MSTJ(115).GE.2) THEN - NC=NC+2 - CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.) - K(NC-1,1)=21 - CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.) - K(NC,1)=21 - ENDIF - KFLC=IABS(KFL) - IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN - NC=NC+1 - KF=110*KFLC+3 - MSTU10=MSTU(10) - MSTU(10)=1 - P(NC,5)=ECM - CALL LU1ENT(NC,KF,ECM,0.,0.) - K(NC,1)=21 - K(NC,3)=1 - MSTU(10)=MSTU10 - ENDIF - -C...Choose x1 and x2 according to matrix element. - NTRY=0 - 100 X1=RLU(0) - X2=RLU(0) - X3=2.-X1-X2 - IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+ - &((1.-X3)/(X1*X2))**2.LE.2.*RLU(0)) GOTO 100 - NTRY=NTRY+1 - NJET=3 - IF(MSTJ(101).LE.4) CALL LU3ENT(NC+1,21,21,21,ECM,X1,X3) - IF(MSTJ(101).GE.5) CALL LU3ENT(-(NC+1),21,21,21,ECM,X1,X3) - -C...Photon-gluon-gluon events. Small system modifications. Jet origin. - MSTU(111)=MSTJ(108) - IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) - &MSTU(111)=1 - PARU(112)=PARJ(121) - IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) - QF=0. - IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3. - RGAM=7.2*QF**2*PARU(101)/ULALPS(ECM**2) - MK=0 - ECMC=ECM - IF(RLU(0).GT.RGAM/(1.+RGAM)) THEN - IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125))) - & NJET=2 - IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LU2ENT(NC+1,21,21,ECM) - IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LU2ENT(-(NC+1),21,21,ECM) - ELSE - MK=1 - ECMC=SQRT(1.-X1)*ECM - IF(ECMC.LT.2.*PARJ(127)) GOTO 100 - K(NC+1,1)=1 - K(NC+1,2)=22 - K(NC+1,4)=0 - K(NC+1,5)=0 - IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3) - IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3) - IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2) - IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2) - NJET=2 - IF(ECMC.LT.4.*PARJ(127)) THEN - MSTU10=MSTU(10) - MSTU(10)=1 - P(NC+2,5)=ECMC - CALL LU1ENT(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.) - MSTU(10)=MSTU10 - NJET=0 - ENDIF - ENDIF - DO 110 IP=NC+1,N - K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1) - 110 CONTINUE - -C...Differential cross-sections. Upper limit for cross-section. - IF(MSTJ(106).EQ.1) THEN - SQ2=SQRT(2.) - HF1=1.-PARJ(131)*PARJ(132) - HF3=PARJ(133)**2 - CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3) - ST13=SQRT(1.-CT13**2) - SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2 - SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL - SIGT=0.5*SIGL - SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2 - SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+ - & 2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI) - -C...Angular orientation of event. - 120 CHI=PARU(2)*RLU(0) - CTHE=2.*RLU(0)-1. - PHI=PARU(2)*RLU(0) - CCHI=COS(CHI) - SCHI=SIN(CHI) - C2CHI=COS(2.*CHI) - S2CHI=SIN(2.*CHI) - THE=ACOS(CTHE) - STHE=SIN(THE) - C2PHI=COS(2.*(PHI-PARJ(134))) - S2PHI=SIN(2.*(PHI-PARJ(134))) - SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1- - & STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)* - & C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE* - & CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI - IF(SIG.LT.SIGMAX*RLU(0)) GOTO 120 - CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0) - CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0) - ENDIF - -C...Generate parton shower. Rearrange along strings and check. - IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN - CALL LUSHOW(NC+MK+1,-NJET,ECMC) - MSTJ14=MSTJ(14) - IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 - IF(MSTJ(105).GE.0) MSTU(28)=0 - CALL LUPREP(0) - MSTJ(14)=MSTJ14 - IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 - ENDIF - -C...Generate fragmentation. Information for LUTABU: - IF(MSTJ(105).EQ.1) CALL LUEXEC - MSTU(161)=110*KFLC+3 - MSTU(162)=0 - - RETURN - END - -C********************************************************************* - - SUBROUTINE LUHEPC(MCONV) - -C...Purpose: to convert JETSET event record contents to or from -C...the standard event record commonblock. -C...Note that HEPEVT is in double precision according to LEP 2 standard. - PARAMETER (NMXHEP=2000) - COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), - &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) - DOUBLE PRECISION PHEP,VHEP - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /HEPEVT/ - SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ - -C...Conversion from JETSET to standard, the easy part. - IF(MCONV.EQ.1) THEN - NEVHEP=0 - IF(N.GT.NMXHEP) CALL LUERRM(8, - & '(LUHEPC:) no more space in /HEPEVT/') - NHEP=MIN(N,NMXHEP) - DO 140 I=1,NHEP - ISTHEP(I)=0 - IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1 - IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2 - IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3 - IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1) - IDHEP(I)=K(I,2) - JMOHEP(1,I)=K(I,3) - JMOHEP(2,I)=0 - IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN - JDAHEP(1,I)=K(I,4) - JDAHEP(2,I)=K(I,5) - ELSE - JDAHEP(1,I)=0 - JDAHEP(2,I)=0 - ENDIF - DO 100 J=1,5 - PHEP(J,I)=P(I,J) - 100 CONTINUE - DO 110 J=1,4 - VHEP(J,I)=V(I,J) - 110 CONTINUE - -C...Check if new event (from pileup). - IF(I.EQ.1) THEN - INEW=1 - ELSE - IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I - ENDIF - -C...Fill in missing mother information. - IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN - IMO1=I-2 - IF(I.GE.INEW+3.AND.K(I-1,1).EQ.21.AND.K(I-1,3).EQ.0) - & IMO1=IMO1-1 - JMOHEP(1,I)=IMO1 - JMOHEP(2,I)=IMO1+1 - ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN - I1=K(I,3)-1 - 120 I1=I1+1 - IF(I1.GE.I) CALL LUERRM(8, - & '(LUHEPC:) translation of inconsistent event history') - IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120 - KC=LUCOMP(K(I1,2)) - IF(I1.LT.I.AND.KC.EQ.0) GOTO 120 - IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120 - JMOHEP(2,I)=I1 - ELSEIF(K(I,2).EQ.94) THEN - NJET=2 - IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3 - IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4 - JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5)) - IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)= - & MOD(K(I+1,4)/MSTU(5),MSTU(5)) - ENDIF - -C...Fill in missing daughter information. - IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN - DO 130 I1=JDAHEP(1,I),JDAHEP(2,I) - I2=MOD(K(I1,4)/MSTU(5),MSTU(5)) - JDAHEP(1,I2)=I - 130 CONTINUE - ENDIF - IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140 - I1=JMOHEP(1,I) - IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140 - IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140 - IF(JDAHEP(1,I1).EQ.0) THEN - JDAHEP(1,I1)=I - ELSE - JDAHEP(2,I1)=I - ENDIF - 140 CONTINUE - DO 150 I=1,NHEP - IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150 - IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I) - 150 CONTINUE - -C...Conversion from standard to JETSET, the easy part. - ELSE - IF(NHEP.GT.MSTU(4)) CALL LUERRM(8, - & '(LUHEPC:) no more space in /LUJETS/') - N=MIN(NHEP,MSTU(4)) - NKQ=0 - KQSUM=0 - DO 180 I=1,N - K(I,1)=0 - IF(ISTHEP(I).EQ.1) K(I,1)=1 - IF(ISTHEP(I).EQ.2) K(I,1)=11 - IF(ISTHEP(I).EQ.3) K(I,1)=21 - K(I,2)=IDHEP(I) - K(I,3)=JMOHEP(1,I) - K(I,4)=JDAHEP(1,I) - K(I,5)=JDAHEP(2,I) - DO 160 J=1,5 - P(I,J)=PHEP(J,I) - 160 CONTINUE - DO 170 J=1,4 - V(I,J)=VHEP(J,I) - 170 CONTINUE - V(I,5)=0. - IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN - I1=JDAHEP(1,I) - IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))* - & PHEP(5,I)/PHEP(4,I) - ENDIF - -C...Fill in missing information on colour connection in jet systems. - IF(ISTHEP(I).EQ.1) THEN - KC=LUCOMP(K(I,2)) - KQ=0 - IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.NE.0) NKQ=NKQ+1 - IF(KQ.NE.2) KQSUM=KQSUM+KQ - IF(KQ.NE.0.AND.KQSUM.NE.0) THEN - K(I,1)=2 - ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN - IF(K(I+1,2).EQ.21) K(I,1)=2 - ENDIF - ENDIF - 180 CONTINUE - IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LUERRM(8, - & '(LUHEPC:) input parton configuration not colour singlet') - ENDIF - - END - -C********************************************************************* - - SUBROUTINE LUTEST(MTEST) - -C...Purpose: to provide a simple program (disguised as subroutine) to -C...run at installation as a check that the program works as intended. - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUJETS/,/LUDAT1/ - DIMENSION PSUM(5),PINI(6),PFIN(6) - -C...Loop over events to be generated. - IF(MTEST.GE.1) CALL LUTABU(20) - NERR=0 - DO 180 IEV=1,600 - -C...Reset parameter values. Switch on some nonstandard features. - MSTJ(1)=1 - MSTJ(3)=0 - MSTJ(11)=1 - MSTJ(42)=2 - MSTJ(43)=4 - MSTJ(44)=2 - PARJ(17)=0.1 - PARJ(22)=1.5 - PARJ(43)=1. - PARJ(54)=-0.05 - MSTJ(101)=5 - MSTJ(104)=5 - MSTJ(105)=0 - MSTJ(107)=1 - IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3 - -C...Ten events each for some single jets configurations. - IF(IEV.LE.50) THEN - ITY=(IEV+9)/10 - MSTJ(3)=-1 - IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2 - IF(ITY.EQ.1) CALL LU1ENT(1,1,15.,0.,0.) - IF(ITY.EQ.2) CALL LU1ENT(1,3101,15.,0.,0.) - IF(ITY.EQ.3) CALL LU1ENT(1,-2203,15.,0.,0.) - IF(ITY.EQ.4) CALL LU1ENT(1,-4,30.,0.,0.) - IF(ITY.EQ.5) CALL LU1ENT(1,21,15.,0.,0.) - -C...Ten events each for some simple jet systems; string fragmentation. - ELSEIF(IEV.LE.130) THEN - ITY=(IEV-41)/10 - IF(ITY.EQ.1) CALL LU2ENT(1,1,-1,40.) - IF(ITY.EQ.2) CALL LU2ENT(1,4,-4,30.) - IF(ITY.EQ.3) CALL LU2ENT(1,2,2103,100.) - IF(ITY.EQ.4) CALL LU2ENT(1,21,21,40.) - IF(ITY.EQ.5) CALL LU3ENT(1,2101,21,-3203,30.,0.6,0.8) - IF(ITY.EQ.6) CALL LU3ENT(1,5,21,-5,40.,0.9,0.8) - IF(ITY.EQ.7) CALL LU3ENT(1,21,21,21,60.,0.7,0.5) - IF(ITY.EQ.8) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2) - -C...Seventy events with independent fragmentation and momentum cons. - ELSEIF(IEV.LE.200) THEN - ITY=1+(IEV-131)/16 - MSTJ(2)=1+MOD(IEV-131,4) - MSTJ(3)=1+MOD((IEV-131)/4,4) - IF(ITY.EQ.1) CALL LU2ENT(1,4,-5,40.) - IF(ITY.EQ.2) CALL LU3ENT(1,3,21,-3,40.,0.9,0.4) - IF(ITY.EQ.3) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2) - IF(ITY.GE.4) CALL LU4ENT(1,2,-3,3,-2,40.,0.4,0.64,0.6,0.12,0.2) - -C...A hundred events with random jets (check invariant mass). - ELSEIF(IEV.LE.300) THEN - 100 DO 110 J=1,5 - PSUM(J)=0. - 110 CONTINUE - NJET=2.+6.*RLU(0) - DO 130 I=1,NJET - KFL=21 - IF(I.EQ.1) KFL=INT(1.+4.*RLU(0)) - IF(I.EQ.NJET) KFL=-INT(1.+4.*RLU(0)) - EJET=5.+20.*RLU(0) - THETA=ACOS(2.*RLU(0)-1.) - PHI=6.2832*RLU(0) - IF(I.LT.NJET) CALL LU1ENT(-I,KFL,EJET,THETA,PHI) - IF(I.EQ.NJET) CALL LU1ENT(I,KFL,EJET,THETA,PHI) - IF(I.EQ.1.OR.I.EQ.NJET) MSTJ(93)=1 - IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+ULMASS(KFL) - DO 120 J=1,4 - PSUM(J)=PSUM(J)+P(I,J) - 120 CONTINUE - 130 CONTINUE - IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT. - & (PSUM(5)+PARJ(32))**2) GOTO 100 - -C...Fifty e+e- continuum events with matrix elements. - ELSEIF(IEV.LE.350) THEN - MSTJ(101)=2 - CALL LUEEVT(0,40.) - -C...Fifty e+e- continuum event with varying shower options. - ELSEIF(IEV.LE.400) THEN - MSTJ(42)=1+MOD(IEV,2) - MSTJ(43)=1+MOD(IEV/2,4) - MSTJ(44)=MOD(IEV/8,3) - CALL LUEEVT(0,90.) - -C...Fifty e+e- continuum events with coherent shower, including top. - ELSEIF(IEV.LE.450) THEN - MSTJ(104)=6 - CALL LUEEVT(0,500.) - -C...Fifty Upsilon decays to ggg or gammagg with coherent shower. - ELSEIF(IEV.LE.500) THEN - CALL LUONIA(5,9.46) - -C...One decay each for some heavy mesons. - ELSEIF(IEV.LE.560) THEN - ITY=IEV-501 - KFLS=2*(ITY/20)+1 - KFLB=8-MOD(ITY/5,4) - KFLC=KFLB-MOD(ITY,5) - CALL LU1ENT(1,100*KFLB+10*KFLC+KFLS,0.,0.,0.) - -C...One decay each for some heavy baryons. - ELSEIF(IEV.LE.600) THEN - ITY=IEV-561 - KFLS=2*(ITY/20)+2 - KFLA=8-MOD(ITY/5,4) - KFLB=KFLA-MOD(ITY,5) - KFLC=MAX(1,KFLB-1) - CALL LU1ENT(1,1000*KFLA+100*KFLB+10*KFLC+KFLS,0.,0.,0.) - ENDIF - -C...Generate event. Find total momentum, energy and charge. - DO 140 J=1,4 - PINI(J)=PLU(0,J) - 140 CONTINUE - PINI(6)=PLU(0,6) - CALL LUEXEC - DO 150 J=1,4 - PFIN(J)=PLU(0,J) - 150 CONTINUE - PFIN(6)=PLU(0,6) - -C...Check conservation of energy, momentum and charge; -C...usually exact, but only approximate for single jets. - MERR=0 - IF(IEV.LE.50) THEN - IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.4.) MERR=MERR+1 - EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3) - IF(EPZREM.LT.0..OR.EPZREM.GT.2.*PARJ(31)) MERR=MERR+1 - IF(ABS(PFIN(6)-PINI(6)).GT.2.1) MERR=MERR+1 - ELSE - DO 160 J=1,4 - IF(ABS(PFIN(J)-PINI(J)).GT.0.0001*PINI(4)) MERR=MERR+1 - 160 CONTINUE - IF(ABS(PFIN(6)-PINI(6)).GT.0.1) MERR=MERR+1 - ENDIF - IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), - &(PFIN(J),J=1,4),PFIN(6) - -C...Check that all KF codes are known ones, and that partons/particles -C...satisfy energy-momentum-mass relation. Store particle statistics. - DO 170 I=1,N - IF(K(I,1).GT.20) GOTO 170 - IF(LUCOMP(K(I,2)).EQ.0) THEN - WRITE(MSTU(11),5100) I - MERR=MERR+1 - ENDIF - PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 - IF(ABS(PD).GT.MAX(0.1,0.001*P(I,4)**2).OR.P(I,4).LT.0.) THEN - WRITE(MSTU(11),5200) I - MERR=MERR+1 - ENDIF - 170 CONTINUE - IF(MTEST.GE.1) CALL LUTABU(21) - -C...List all erroneous events and some normal ones. - IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN - CALL LULIST(2) - ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN - CALL LULIST(1) - ENDIF - -C...Stop execution if too many errors. - IF(MERR.NE.0) NERR=NERR+1 - IF(NERR.GE.10) THEN - WRITE(MSTU(11),5300) IEV - STOP - ENDIF - 180 CONTINUE - -C...Summarize result of run. - IF(MTEST.GE.1) CALL LUTABU(22) - IF(NERR.EQ.0) WRITE(MSTU(11),5400) - IF(NERR.GT.0) WRITE(MSTU(11),5500) NERR - -C...Reset commonblock variables changed during run. - MSTJ(2)=3 - PARJ(17)=0. - PARJ(22)=1. - PARJ(43)=0.5 - PARJ(54)=0. - MSTJ(105)=1 - MSTJ(107)=0 - -C...Format statements for output. - 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ', - &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X, - &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X, - &4(1X,F12.5),1X,F8.2) - 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code') - 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ', - &'kinematics') - 5300 FORMAT(/5X,'Ten errors experienced by event ',I3/ - &5X,'Something is seriously wrong! Execution stopped now!') - 5400 FORMAT(//5X,'End result of LUTEST: no errors detected.') - 5500 FORMAT(//5X,'End result of LUTEST:',I2,' errors detected.'/ - &5X,'This should not have happened!') - - RETURN - END - -C********************************************************************* - - BLOCK DATA LUDATA - -C...Purpose: to give default values to parameters and particle and -C...decay data. - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) - COMMON/LUDAT4/CHAF(500) - CHARACTER CHAF*8 - COMMON/LUDATR/MRLU(6),RRLU(100) - SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/ - -C...LUDAT1, containing status codes and most parameters. - DATA MSTU/ - & 0, 0, 0, 4000,10000, 500, 2000, 0, 0, 2, - 1 6, 1, 1, 0, 1, 1, 0, 0, 0, 0, - 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0, - 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0, - 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 7 30*0, - & 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1 1, 5, 3, 5, 0, 0, 0, 0, 0, 0, - 2 60*0, - 8 7, 410, 1997, 01, 20, 700, 0, 0, 0, 0, - 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ - DATA PARU/ - & 3.1415927, 6.2831854, 0.1973, 5.068, 0.3894, 2.568, 4*0., - 1 0.001, 0.09, 0.01, 0., 0., 0., 0., 0., 0., 0., - 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., - 3 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., - 4 2.0, 1.0, 0.25, 2.5, 0.05, 0., 0., 0.0001, 0., 0., - 5 2.5, 1.5, 7.0, 1.0, 0.5, 2.0, 3.2, 0., 0., 0., - 6 40*0., - & 0.00729735, 0.232, 0.007764, 1.0, 1.16639E-5, 0., 0., 0., - & 0., 0., - 1 0.20, 0.25, 1.0, 4.0, 10., 0., 0., 0., 0., 0., - 2 -0.693, -1.0, 0.387, 1.0, -0.08, -1.0, 1.0, 1.0, 1.0, 0., - 3 1.0, -1.0, 1.0, -1.0, 1.0, 0., 0., 0., 0., 0., - 4 5.0, 1.0, 1.0, 0., 1.0, 1.0, 0., 0., 0., 0., - 5 1.0, 0., 0., 0., 1000., 1.0, 1.0, 1.0, 1.0, 0., - 6 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., 0., 0., - 7 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., - 8 1.0, 1.0, 1.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0., - 9 0., 0., 0., 0., 1.0, 0., 0., 0., 0., 0./ - DATA MSTJ/ - & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 1 4, 2, 0, 1, 0, 0, 0, 0, 0, 0, - 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0, - 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 3, - 5 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 6 40*0, - & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2, - 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, - 2 80*0/ - DATA PARJ/ - & 0.10, 0.30, 0.40, 0.05, 0.50, 0.50, 0.50, 0., 0., 0., - 1 0.50, 0.60, 0.75, 0., 0., 0., 0., 1.0, 1.0, 0., - 2 0.36, 1.0, 0.01, 2.0, 1.0, 0.4, 0., 0., 0., 0., - 3 0.10, 1.0, 0.8, 1.5, 0., 2.0, 0.2, 2.5, 0.6, 0., - 4 0.3, 0.58, 0.5, 0.9, 0.5, 1.0, 1.0, 1.0, 0., 0., - 5 0.77,0.77,0.77,-0.05,-0.005,-0.00001,-0.00001,-0.00001,1.0,0., - 6 4.5, 0.7, 0., 0.003, 0.5, 0.5, 0., 0., 0., 0., - 7 10., 1000., 100., 1000., 0., 0.7, 10., 0., 0., 0., - 8 0.29, 1.0, 1.0, 0., 10., 10., 0., 0., 0., 0., - 9 0.02, 1.0, 0.2, 0., 0., 0., 0., 0., 0., 0., - & 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., - 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., - 2 1.0, 0.25,91.187,2.489, 0.01, 2.0, 1.0, 0.25,0.002, 0., - 3 0., 0., 0., 0., 0.01, 0.99, 0., 0., 0.2, 0., - 4 60*0./ - -C...LUDAT2, with particle data and flavour treatment parameters. - DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, - &-3,0,-3,6*0,3,9*0,3,2*0,3,0,-1,44*0,2,-1,2,-1,2,3,11*0,3,0,2*3,0, - &3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0, - &3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0, - &3,0,3,70*0,3,0,3,28*0,3,2*0,3,8*0,-3,8*0,3,0,-3,0,3,-3,3*0,3,6,0, - &3,5*0,-3,0,3,-3,0,-3,4*0,-3,0,3,6,-3,0,3,-3,0,-3,0,3,6,0,3,5*0, - &-3,0,3,-3,0,-3,114*0/ - DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,16*0,2,1,50*0,-1,410*0/ - DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,0,2*1, - &41*0,1,0,7*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1, - &10*0,10*1,70*0,3*1,22*0,1,5*0,1,0,2*1,6*0,1,0,2*1,6*0,2*1,0,5*1, - &0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/ - DATA (PMAS(I,1),I= 1, 500)/0.0099,0.0056,0.199,1.35,5.,160., - &2*250.,2*0.,0.00051,0.,0.1057,0.,1.777,0.,250.,5*0.,91.187,80.25, - &80.,6*0.,500.,900.,500.,3*300.,350.,200.,5000.,60*0.,0.1396, - &0.4977,0.4936,1.8693,1.8645,1.9688,5.2787,5.2786,5.47972,6.594, - &0.135,0.5475,0.9578,2.9788,9.4,320.,2*500.,2*0.,0.7669,0.8961, - &0.8916,2.0101,2.0071,2.11,2*5.325,5.5068,6.602,0.7683,0.782, - &1.0194,3.0969,9.4603,320.,2*500.,2*0.,1.232,2*1.29,2*2.424,2.536, - &2*5.73,5.97,7.3,1.232,1.17,1.4,3.46,9.875,320.,2*500.,2*0.,0.983, - &2*1.429,2*2.272,2.5,2*5.68,5.92,7.25,0.9827,1.,1.4,3.4151,9.8598, - &320.,2*500.,2*0.,1.26,2*1.402,2*2.372,2.56,2*5.78,6.02,7.3,1.26, - &1.282,1.42,3.5106,9.8919,320.,2*500.,2*0.,1.318,1.432,1.425, - &2*2.46,2.61,2*5.83,6.07,7.35,1.318,1.275,1.525,3.5562,9.9132, - &320.,2*500.,2*0.,2*0.4977,8*0.,3.686,3*0.,10.0233,70*0.,1.1156, - &5*0.,2.2849,0.,2.473,2.466,6*0.,5.641,0.,2*5.84,6*0.,0.9396, - &0.9383,0.,1.1974,1.1926,1.1894,1.3213,1.3149,0.,2.4525,2.4529, - &2.4527,2*2.55,2.73,4*0.,3*5.8,2*5.96,6.12,4*0.,1.234,1.233,1.232, - &1.231,1.3872,1.3837,1.3828,1.535,1.5318,1.6724,3*2.5,2*2.63,2.8, - &4*0.,3*5.81,2*5.97,6.13,114*0./ - DATA (PMAS(I,2),I= 1, 500)/22*0.,2.489,2.066,88*0.,0.0002, - &0.001,6*0.,0.149,0.0505,0.0498,7*0.,0.151,0.00843,0.0044,7*0., - &0.155,2*0.09,2*0.02,0.,4*0.05,0.155,0.36,0.08,2*0.01,5*0.,0.057, - &2*0.287,7*0.05,0.057,0.,0.25,0.014,6*0.,0.4,2*0.174,7*0.05,0.4, - &0.024,0.06,0.0009,6*0.,0.11,0.109,0.098,2*0.019,5*0.02,0.11, - &0.185,0.076,0.002,146*0.,4*0.12,0.0394,0.036,0.0358,0.0099, - &0.0091,131*0./ - DATA (PMAS(I,3),I= 1, 500)/22*0.,2*20.,88*0.,0.002,0.005,6*0., - &0.4,2*0.2,7*0.,0.4,0.1,0.015,7*0.,0.25,0.005,0.01,2*0.08,0., - &4*0.1,0.25,0.2,0.001,2*0.02,5*0.,0.05,2*0.4,6*0.1,2*0.05,0.,0.35, - &0.05,6*0.,3*0.3,2*0.1,0.03,4*0.1,0.3,0.05,0.02,0.001,6*0.,0.25, - &4*0.12,5*0.05,0.25,0.17,0.2,0.01,146*0.,4*0.14,0.04,2*0.035, - &2*0.05,131*0./ - DATA (PMAS(I,4),I= 1, 500)/12*0.,658650.,0.,0.0914,68*0.,0.1, - &0.387,15*0.,7804.,0.,3709.,0.32,0.1259,0.135,3*0.387,0.15,110*0., - &15500.,26.75,83*0.,78.88,5*0.,0.057,0.,0.025,0.09,6*0.,0.387,0., - &2*0.387,9*0.,44.3,0.,23.95,49.1,86.9,6*0.,0.13,9*0.,0.387,13*0., - &24.60001,130*0./ - DATA PARF/ - & 0.5, 0.25, 0.5, 0.25, 1., 0.5, 0., 0., 0., 0., - 1 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., - 2 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., - 3 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., - 4 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., - 5 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., - 6 0.75, 0.5, 0., 0.1667, 0.0833, 0.1667, 0., 0., 0., 0., - 7 0., 0., 1., 0.3333, 0.6667, 0.3333, 0., 0., 0., 0., - 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., - 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., - & 0.325, 0.325, 0.5, 1.6, 5.0, 0., 0., 0., 0., 0., - 1 0., 0.11, 0.16, 0.048, 0.50, 0.45, 0.55, 0.60, 0., 0., - 2 0.2, 0.1, 0., 0., 0., 0., 0., 0., 0., 0., - 3 1870*0./ - DATA ((VCKM(I,J),J=1,4),I=1,4)/ - 1 0.95113, 0.04884, 0.00003, 0.00000, - 2 0.04884, 0.94940, 0.00176, 0.00000, - 3 0.00003, 0.00176, 0.99821, 0.00000, - 4 0.00000, 0.00000, 0.00000, 1.00000/ - -C...LUDAT3, with particle decay parameters and data. - DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0,1, - &2*0,4*1,42*0,7*1,12*0,1,0,15*1,2*0,18*1,2*0,18*1,2*0,18*1,2*0, - &18*1,2*0,18*1,3*0,1,8*0,1,3*0,1,70*0,1,5*0,1,0,2*1,6*0,1,0,2*1, - &9*0,5*1,0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/ - DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,50,60,2*0,70,74,76, - &81,83,124,126,132,2*0,135,144,156,172,192,6*0,209,0,231,254,274, - &292,301,304,305,42*0,314,315,319,328,331,336,338,11*0,358,359, - &361,367,430,491,524,560,596,635,666,668,675,681,682,683,684,685, - &2*0,686,688,691,694,697,699,700,701,702,703,704,708,713,721,724, - &733,734,735,2*0,736,737,742,747,749,751,753,755,757,759,761,762, - &765,769,770,771,772,773,2*0,774,775,777,779,781,783,785,787,789, - &791,793,794,799,804,806,808,809,810,2*0,811,813,815,817,819,821, - &823,825,827,829,831,833,846,850,852,854,855,856,2*0,857,863,873, - &884,892,900,904,912,920,924,928,936,945,951,953,955,956,957,2*0, - &958,966,8*0,968,3*0,979,70*0,993,5*0,997,0,1073,1074,6*0,1075,0, - &1092,1093,9*0,1094,1096,1097,1100,1101,0,1103,1104,1105,1106, - &1107,1108,4*0,1109,1110,1111,1112,1113,1114,4*0,1115,1116,1119, - &1122,1123,1126,1129,1132,1134,1136,1140,1141,1142,1143,1145,1147, - &4*0,1148,1149,1150,1151,1152,1153,114*0/ - DATA (MDCY(I,3),I= 1, 500)/5*8,9,2*10,2*0,4,2,5,2,41,2,6,3,2*0, - &9,12,16,20,17,6*0,22,0,23,20,18,9,3,1,9,42*0,1,4,9,3,5,2,20,11*0, - &1,2,6,63,61,33,2*36,39,31,2,7,6,5*1,2*0,2,3*3,2,5*1,4,5,8,3,9, - &3*1,2*0,1,2*5,7*2,1,3,4,5*1,2*0,1,9*2,1,2*5,2*2,3*1,2*0,11*2,13, - &4,2*2,3*1,2*0,6,10,11,2*8,4,2*8,2*4,8,9,6,2*2,3*1,2*0,8,2,8*0,11, - &3*0,14,70*0,4,5*0,76,0,2*1,6*0,17,0,2*1,9*0,2,1,3,1,2,0,6*1,4*0, - &6*1,4*0,1,2*3,1,3*3,2*2,4,3*1,2*2,1,4*0,6*1,114*0/ - DATA (MDME(I,1),I= 1,2000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, - &7*1,-1,1,-1,8*1,2*-1,8*1,2*-1,61*1,-1,2*1,-1,6*1,2*-1,7*1,2*-1, - &3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,-1,6*1,2*-1, - &3*1,-1,11*1,2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,6*1, - &2*-1,3*1,-1,5*1,-1,8*1,2*-1,3*1,-1,9*1,-1,3*1,-1,9*1,2*-1,2*1,-1, - &16*1,-1,2*1,3*-1,1665*1/ - DATA (MDME(I,2),I= 1,2000)/75*102,42,6*102,2*42,2*0,7*41,2*0, - &24*41,6*102,45,29*102,8*32,8*0,16*32,4*0,8*32,4*0,32,4*0,8*32, - &14*0,16*32,7*0,8*32,4*0,32,7*0,8*32,4*0,32,5*0,4*32,5*0,3*32,0, - &6*32,3*0,12,2*42,2*11,9*42,2*45,31,2*45,2*33,31,2*45,20*46,7*0, - &24*42,41*0,16*42,46*0,10*42,20*0,2*13,14*42,16*0,48,3*13,16*42, - &16*0,48,3*13,16*42,19*0,48,3*13,2*42,0,2*11,28*42,0,2,4*0,2,8*0, - &12,32,86,87,88,3,0,2*3,0,2*3,0,2*3,0,3,6*0,3,3*0,1,0,3,2*0,2*3, - &3*0,1,4*0,12,3*0,4*32,2*4,86,87,88,33*0,12,32,86,87,88,31*0,12,0, - &32,86,87,88,40*0,12,0,32,86,87,88,95*0,12,0,32,86,87,88,2*0,4*42, - &6*0,12,11*0,4*32,2*4,9*0,14*42,52*0,10*13,2*84,3*42,8*0,48,3*13, - &2*42,2*85,14*0,84,5*0,85,886*0/ - DATA (BRAT(I) ,I= 1, 439)/75*0.,1.,6*0.,0.179,0.178,0.116, - &0.235,0.005,0.056,0.018,0.023,0.011,2*0.004,0.0067,0.014,2*0.002, - &2*0.001,0.0022,0.054,0.002,0.016,0.005,0.011,0.0101,5*0.006, - &0.002,2*0.001,5*0.002,6*0.,1.,29*0.,0.15394,0.11936,0.15394, - &0.11926,0.15254,3*0.,0.03368,0.06664,0.03368,0.06664,0.03368, - &0.06664,2*0.,0.3214,0.0165,2*0.,0.0165,0.3207,2*0.,0.00001, - &0.00059,6*0.,3*0.1081,3*0.,0.0003,0.048,0.8705,4*0.,0.0002, - &0.0603,0.,0.0199,0.0008,3*0.,0.143,0.111,0.143,0.111,0.143,0.085, - &2*0.,0.03,0.058,0.03,0.058,0.03,0.058,8*0.,0.25,0.01,2*0.,0.01, - &0.25,4*0.,0.24,5*0.,3*0.08,6*0.,0.01,0.08,0.82,5*0.,0.09,11*0., - &0.01,0.08,0.82,5*0.,0.09,9*0.,1.,6*0.,0.01,0.98,0.01,1.,4*0.215, - &2*0.,2*0.07,0.,1.,2*0.08,0.76,0.08,2*0.105,0.04,0.5,0.08,0.14, - &0.01,0.015,0.005,1.,3*0.,1.,4*0.,1.,0.25,0.01,2*0.,0.01,0.25, - &4*0.,0.24,5*0.,3*0.08,0.,1.,2*0.5,0.635,0.212,0.056,0.017,0.048, - &0.032,0.07,0.065,2*0.005,2*0.011,5*0.001,0.07,0.065,2*0.005, - &2*0.011,5*0.001,0.026,0.019,0.066,0.041,0.045,0.076,0.0073, - &2*0.0047,0.026,0.001,0.0006,0.0066,0.005,2*0.003,2*0.0006, - &2*0.001,0.006,0.005,0.012,0.0057,0.067,0.008,0.0022,0.027,0.004, - &0.019,0.012,0.002,0.009,0.0218,0.001,0.022,0.087,0.001,0.0019, - &0.0015,0.0028,0.034,0.027,2*0.002,2*0.004,2*0.002,0.034,0.027/ - DATA (BRAT(I) ,I= 440, 655)/2*0.002,2*0.004,2*0.002,0.0365, - &0.045,0.073,0.062,3*0.021,0.0061,0.015,0.025,0.0088,0.074,0.0109, - &0.0041,0.002,0.0035,0.0011,0.001,0.0027,2*0.0016,0.0018,0.011, - &0.0063,0.0052,0.018,0.016,0.0034,0.0036,0.0009,0.0006,0.015, - &0.0923,0.018,0.022,0.0077,0.009,0.0075,0.024,0.0085,0.067,0.0511, - &0.017,0.0004,0.0028,0.01,2*0.02,0.03,2*0.005,2*0.02,0.03,2*0.005, - &0.015,0.037,0.028,0.079,0.095,0.052,0.0078,4*0.001,0.028,0.033, - &0.026,0.05,0.01,4*0.005,0.25,0.0952,0.02,0.055,2*0.005,0.008, - &0.012,0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011, - &0.0055,0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,0.0004, - &0.0007,0.0008,0.0014,0.0019,0.0025,0.4291,0.08,0.07,0.02,0.015, - &0.005,0.02,0.055,2*0.005,0.008,0.012,0.02,0.055,2*0.005,0.008, - &0.012,0.01,0.03,0.0035,0.011,0.0055,0.0042,0.009,0.018,0.015, - &0.0185,0.0135,0.025,0.0004,0.0007,0.0008,0.0014,0.0019,0.0025, - &0.4291,0.08,0.07,0.02,0.015,0.005,0.02,0.055,2*0.005,0.008,0.012, - &0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011,0.0055, - &0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,2*0.0002,0.0007, - &2*0.0004,0.0014,0.001,0.0009,0.0025,0.4291,0.08,0.07,0.02,0.015, - &0.005,0.047,0.122,0.006,0.012,0.035,0.012,0.035,0.003,0.007,0.15, - &0.037,0.008,0.002,0.05,0.015,0.003,0.001,0.014,0.042,0.014,0.042/ - DATA (BRAT(I) ,I= 656, 931)/0.24,0.065,0.012,0.003,0.001,0.002, - &0.001,0.002,0.014,0.003,0.988,0.012,0.389,0.319,0.2367,0.049, - &0.005,0.001,0.0003,0.441,0.206,0.3,0.03,0.022,0.001,5*1.,0.99955, - &0.00045,0.665,0.333,0.002,0.666,0.333,0.001,0.65,0.3,0.05,0.56, - &0.44,5*1.,0.99912,0.00079,0.00005,0.00004,0.888,0.085,0.021, - &2*0.003,0.49,0.344,3*0.043,0.023,0.013,0.001,0.0627,0.0597, - &0.8776,3*0.027,0.015,0.045,0.015,0.045,0.77,0.029,4*1.,0.28,0.14, - &0.313,0.157,0.11,0.28,0.14,0.313,0.157,0.11,0.667,0.333,0.667, - &0.333,2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.333,0.334,0.333, - &4*0.25,6*1.,0.667,0.333,0.667,0.333,0.667,0.333,0.667,0.333, - &2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.52,0.26,0.11,2*0.055, - &0.62,0.31,0.035,2*0.0175,0.007,0.993,0.02,0.98,3*1.,2*0.5,0.667, - &0.333,0.667,0.333,0.667,0.333,0.667,0.333,2*0.5,0.667,0.333, - &0.667,0.333,6*0.5,3*0.12,0.097,0.043,4*0.095,4*0.03,4*0.25,0.273, - &0.727,0.35,0.65,3*1.,2*0.35,0.144,0.105,0.048,0.003,0.333,0.166, - &0.168,0.084,0.087,0.043,0.059,2*0.029,0.002,0.332,0.166,0.168, - &0.084,0.086,0.043,0.059,2*0.029,2*0.002,0.3,0.15,0.16,0.08,0.13, - &0.06,0.08,0.04,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,2*0.3, - &2*0.2,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,0.3,0.15,0.16,0.08, - &0.13,0.06,0.08,0.04,2*0.3,2*0.2,2*0.3,2*0.2,2*0.35,0.144,0.105/ - DATA (BRAT(I) ,I= 932,2000)/0.024,2*0.012,0.003,0.566,0.283, - &0.069,0.028,0.023,2*0.0115,0.005,0.003,0.356,2*0.178,0.28, - &2*0.004,0.135,0.865,0.22,0.78,3*1.,0.217,0.124,2*0.193,2*0.135, - &0.002,0.001,0.686,0.314,2*0.0083,0.1866,0.324,0.184,0.027,0.001, - &0.093,0.087,0.078,0.0028,3*0.014,0.008,0.024,0.008,0.024,0.425, - &0.02,0.185,0.088,0.043,0.067,0.066,0.641,0.357,2*0.001,0.018, - &2*0.005,0.003,0.002,2*0.006,0.018,2*0.005,0.003,0.002,2*0.006, - &0.0066,0.025,0.016,0.0088,2*0.005,0.0058,0.005,0.0055,4*0.004, - &2*0.002,2*0.004,0.003,0.002,2*0.003,3*0.002,2*0.001,0.002, - &2*0.001,2*0.002,0.0013,0.0018,5*0.001,4*0.003,2*0.005,2*0.002, - &2*0.001,2*0.002,2*0.001,0.2432,0.057,2*0.035,0.15,2*0.075,0.03, - &2*0.015,2*1.,2*0.105,0.04,0.0077,0.02,0.0235,0.0285,0.0435, - &0.0011,0.0022,0.0044,0.4291,0.08,0.07,0.02,0.015,0.005,2*1., - &0.999,0.001,1.,0.516,0.483,0.001,1.,0.995,0.005,13*1.,0.331, - &0.663,0.006,0.663,0.331,0.006,1.,0.88,2*0.06,0.88,2*0.06,0.88, - &2*0.06,0.667,2*0.333,0.667,0.676,0.234,0.085,0.005,3*1.,4*0.5, - &7*1.,847*0./ - DATA (KFDP(I,1),I= 1, 507)/21,22,23,4*-24,25,21,22,23,4*24,25, - &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23, - &4*24,25,37,21,22,23,4*-24,25,2*-37,21,22,23,4*24,25,2*37,22,23, - &-24,25,23,24,-12,22,23,-24,25,23,24,-12,-14,35*16,22,23,-24,25, - &23,24,-89,22,23,-24,25,-37,23,24,37,1,2,3,4,5,6,7,8,21,1,2,3,4,5, - &6,7,8,11,13,15,17,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1, - &4*-3,4*-5,4*-7,-11,-13,-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21, - &2*22,23,24,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,24,37,2*23,25, - &35,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,3*24,1,2,3,4,5,6,7,8,11, - &13,15,17,21,2*22,23,24,23,25,36,1,2,3,4,5,6,7,8,11,13,15,17,21, - &2*22,23,24,23,-1,-3,-5,-7,-11,-13,-15,-17,24,5,6,21,2,1,2,3,4,5, - &6,11,13,15,82,-11,-13,2*2,-12,-14,-16,2*-2,2*-4,-2,-4,2*89,37, - &2*-89,2*5,-37,2*89,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,-13,130, - &310,-13,3*211,12,14,11*-11,11*-13,-311,-313,-311,-313,-20313, - &2*-311,-313,-311,-313,2*111,2*221,2*331,2*113,2*223,2*333,-311, - &-313,2*-321,211,-311,-321,333,-311,-313,-321,211,2*-321,2*-311, - &-321,211,113,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311, - &-313,2*-311,-321,-10323,-321,-323,-321,-311,2*-313,211,111,333, - &3*-321,-311,-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211, - &-321,3*-311,211,113,321,-15,5*-11,5*-13,221,331,333,221,331,333/ - DATA (KFDP(I,1),I= 508, 924)/10221,211,213,211,213,321,323,321, - &323,2212,221,331,333,221,2*2,6*12,6*14,2*16,3*-411,3*-413,2*-411, - &2*-413,2*441,2*443,2*20443,2*2,2*4,2,4,6*12,6*14,2*16,3*-421, - &3*-423,2*-421,2*-423,2*441,2*443,2*20443,2*2,2*4,2,4,6*12,6*14, - &2*16,3*-431,3*-433,2*-431,2*-433,3*441,3*443,3*20443,2*2,2*4,2,4, - &16,2*4,2*12,2*14,2*16,4*2,4*4,2*-11,2*-13,2*-1,2*-3,2*-11,2*-13, - &2*-1,3*22,111,211,2*22,211,22,211,111,3*22,111,82,21,3*0,2*211, - &321,3*311,2*321,421,2*411,2*421,431,511,521,531,541,211,111,13, - &11,211,22,211,2*111,321,130,-213,113,213,211,22,111,11,13,82,11, - &13,15,1,2,3,4,21,22,3*0,223,321,311,323,313,2*311,321,313,323, - &321,423,2*413,2*423,413,523,2*513,2*523,2*513,523,223,213,113, - &-213,313,-313,323,-323,82,21,3*0,221,321,2*311,321,421,2*411,421, - &411,421,521,2*511,2*521,2*511,521,221,211,111,321,130,310,211, - &111,321,130,310,443,82,553,21,3*0,113,213,323,2*313,323,423, - &2*413,2*423,413,523,2*513,2*523,2*513,523,213,-213,10211,10111, - &-10211,2*221,213,2*113,-213,2*321,2*311,313,-313,323,-323,443,82, - &553,21,3*0,213,113,221,223,321,211,321,311,323,313,323,313,321, - &4*311,321,313,323,313,323,311,4*321,421,411,423,413,423,413,421, - &2*411,421,413,423,413,423,411,2*421,411,423,413,521,511,523,513, - &523,513,521,2*511,521,513,523,513,523,511,2*521,511,523,513,511/ - DATA (KFDP(I,1),I= 925,2000)/521,513,523,213,-213,221,223,321, - &130,310,111,211,111,2*211,321,130,310,221,111,321,130,310,221, - &211,111,443,82,553,21,3*0,111,211,-12,12,-14,14,211,111,211,111, - &11,13,82,4*443,10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553, - &10551,20553,555,2212,2*2112,-12,7*-11,7*-13,2*2224,2*2212,2*2214, - &2*3122,2*3212,2*3214,5*3222,4*3224,2*3322,3324,2*2224,7*2212, - &5*2214,2*2112,2*2114,2*3122,2*3212,2*3214,2*3222,2*3224,4*2,3, - &2*2,1,2*2,2*0,-12,-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4, - &2*0,2112,-12,3122,2212,2112,2212,3*3122,3*4122,4132,4232,0, - &3*5122,5132,5232,0,2112,2212,2*2112,2212,2112,2*2212,3122,3212, - &3112,3122,3222,3112,3122,3222,3212,3322,3312,3322,3312,3122,3322, - &3312,-12,3*4122,2*4132,2*4232,4332,3*5122,5132,5232,5332,847*0/ - DATA (KFDP(I,2),I= 1, 476)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4, - &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,5,3*7,2,4,6,8,7, - &4,6,3*8,1,3,5,7,8,5,7,2*11,12,11,12,2*11,2*13,14,13,14,13,11,13, - &-211,-213,-211,-213,-211,-213,3*-211,-321,-323,-321,-323,3*-321, - &4*-211,-213,-211,-213,-211,-213,-211,-213,-211,-213,6*-211,2*15, - &16,15,16,15,18,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21, - &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8, - &-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8, - &12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23, - &-24,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24, - &-37,22,25,2*36,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22, - &25,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25, - &36,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,25,2,4, - &6,8,12,14,16,18,25,-5,-6,21,11,-3,-4,-5,-6,-7,-8,-13,-15,-17,-82, - &12,14,-1,-3,11,13,15,1,4,3,4,1,3,5,3,5,6,4,21,22,4,7,5,2,4,6,8,2, - &4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,14,2*0,14,111,211,111,-11,-13, - &11*12,11*14,2*211,2*213,211,20213,2*321,2*323,211,213,211,213, - &211,213,211,213,211,213,211,213,3*211,213,211,2*321,8*211,2*113, - &2*211,8*12,8*14,2*211,2*213,2*111,221,2*113,223,333,20213,211, - &2*321,323,2*311,313,-211,111,113,2*211,321,2*211,311,321,310,211/ - DATA (KFDP(I,2),I= 477, 857)/-211,4*211,321,4*211,113,2*211,-321, - &16,5*12,5*14,3*211,3*213,211,2*111,2*113,2*-311,2*-313,-2112, - &3*321,323,2*-1,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,431, - &433,431,433,311,313,311,313,311,313,-1,-4,-3,-4,-1,-3,6*-11, - &6*-13,2*-15,211,213,20213,211,213,20213,431,433,431,433,321,323, - &321,323,321,323,-1,-4,-3,-4,-1,-3,6*-11,6*-13,2*-15,211,213, - &20213,211,213,20213,431,433,431,433,221,331,333,221,331,333,221, - &331,333,-1,-4,-3,-4,-1,-3,-15,-3,-1,2*-11,2*-13,2*-15,-1,-4,-3, - &-4,-3,-4,-1,-4,2*12,2*14,2,3,2,3,2*12,2*14,2,1,22,11,22,111,-211, - &211,11,-211,13,-211,111,113,223,22,111,-82,21,3*0,111,22,-211, - &111,22,211,111,22,211,111,22,111,6*22,-211,22,-13,-11,-211,111, - &-211,2*111,-321,310,211,111,2*-211,221,22,-11,-13,-82,-11,-13, - &-15,-1,-2,-3,-4,2*21,3*0,211,-213,113,-211,111,223,213,113,211, - &111,223,211,111,-211,111,321,311,-211,111,211,111,-321,-311,411, - &421,111,-211,111,211,-311,311,-321,321,-82,21,3*0,211,-211,111, - &211,111,211,111,-211,111,311,321,-211,111,211,111,-321,-311,411, - &421,111,-211,111,-321,130,310,-211,111,-321,130,310,22,-82,22,21, - &3*0,211,111,-211,111,211,111,211,111,-211,111,321,311,-211,111, - &211,111,-321,-311,411,421,-211,211,-211,111,2*211,111,-211,211, - &111,211,-321,2*-311,-321,-311,311,-321,321,22,-82,22,21,3*0,111/ - DATA (KFDP(I,2),I= 858,2000)/3*211,-311,22,-211,111,-211,111, - &-211,211,-213,113,223,221,211,111,211,111,2*211,213,113,223,221, - &22,211,111,211,111,4*211,-211,111,-211,111,-211,211,-211,211,321, - &311,321,311,-211,111,-211,111,-211,211,-211,2*211,111,211,111, - &4*211,-321,-311,-321,-311,411,421,411,421,-211,211,111,211,-321, - &130,310,22,-211,111,2*-211,-321,130,310,221,111,-321,130,310,221, - &-211,111,22,-82,22,21,3*0,111,-211,11,-11,13,-13,-211,111,-211, - &111,-11,-13,-82,211,111,221,111,4*22,-11,-13,-15,-1,-2,-3,-4, - &2*21,211,111,3*22,-211,111,22,11,7*12,7*14,-321,-323,-311,-313, - &-311,-313,211,213,211,213,211,213,111,221,331,113,223,111,221, - &113,223,321,323,321,-211,-213,111,221,331,113,223,333,10221,111, - &221,331,113,223,211,213,211,213,321,323,321,323,321,323,311,313, - &311,313,2*-1,-3,-1,2203,3201,3203,2203,2101,2103,2*0,11,13,15, - &-211,-213,-20213,-431,-433,3*3122,1,4,3,4,1,3,2*0,-211,11,22,111, - &211,22,-211,111,22,-211,111,211,2*22,0,-211,111,211,2*22,0, - &2*-211,111,22,111,211,22,211,2*-211,2*111,-211,2*211,111,211, - &-211,2*111,211,-321,-211,111,11,-211,111,211,111,22,111,2*22, - &-211,111,211,3*22,847*0/ - DATA (KFDP(I,3),I= 1, 944)/75*0,14,6*0,2*16,2*0,5*111,310,130, - &2*0,2*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221, - &2*113,221,113,2*213,-213,195*0,4*3,4*4,1,4,3,2*2,10*81,25*0,-211, - &3*111,-311,-313,-311,-321,-313,-323,111,221,331,113,223,-311, - &-313,-311,-321,-313,-323,111,221,331,113,223,22*0,111,113,2*211, - &-211,-311,211,111,3*211,-211,7*211,-321,-323,-311,-321,-313,-323, - &-211,-213,-321,-323,-311,-321,-313,-323,-211,-213,22*0,111,113, - &-311,2*-211,211,-211,310,-211,2*111,211,2*-211,-321,-211,2*211, - &-211,111,-211,2*211,0,221,331,333,321,311,221,331,333,321,311, - &20*0,3,0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413, - &-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,-421,-423, - &-10423,-10421,-20423,-425,-421,-423,-10423,-10421,-20423,-425, - &-421,-423,16*0,-4,-1,-4,-3,2*-2,-431,-433,-10433,-10431,-20433, - &-435,-431,-433,-10433,-10431,-20433,-435,-431,-433,19*0,-4,-1,-4, - &-3,2*-2,3*0,441,443,441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531, - &533,531,533,3,2,3,2,511,513,511,513,1,2,0,-11,0,2*111,-211,-11, - &11,-13,2*221,3*0,111,27*0,111,2*0,22,111,5*0,111,12*0,2*21,103*0, - &-211,2*111,-211,3*111,-211,111,211,14*0,111,6*0,111,-211,8*0,111, - &-211,9*0,111,-211,111,-211,4*0,111,-211,111,-211,8*0,111,-211, - &111,-211,4*0,111,-211,111,-211,11*0,-211,6*0,111,211,4*0,111/ - DATA (KFDP(I,3),I= 945,2000)/13*0,2*111,211,-211,211,-211,7*0, - &-211,111,13*0,2*21,-211,111,6*0,2212,3122,3212,3214,2112,2114, - &2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,8*0, - &3*4122,8*0,4,1,4,3,2*2,3*0,2112,43*0,3322,861*0/ - DATA (KFDP(I,4),I= 1,2000)/88*0,3*111,8*0,-211,0,-211,3*0,111, - &2*-211,0,111,0,2*111,113,221,111,-213,-211,211,195*0,13*81,41*0, - &111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111, - &-211,2*211,2*-211,2*0,-211,111,-211,111,4*0,-211,111,-211,111, - &34*0,111,-211,3*111,3*-211,2*111,3*-211,4*0,-321,-311,3*0,-321, - &-311,20*0,-3,31*0,6*1,30*0,6*2,33*0,6*3,9*0,8*4,4*0,4*-5,4*0, - &2*-5,7*0,-11,264*0,111,-211,4*0,111,57*0,-211,111,5*0,-211,111, - &52*0,2101,2103,2*2101,19*0,6*2101,909*0/ - DATA (KFDP(I,5),I= 1,2000)/90*0,111,16*0,111,7*0,111,0,2*111, - &303*0,-211,2*111,-211,111,-211,111,54*0,111,-211,3*111,-211,111, - &1510*0/ - -C...LUDAT4, with character strings. - DATA (CHAF(I) ,I= 1, 281)/'d','u','s','c','b','t','l','h', - &2*' ','e','nu_e','mu','nu_mu','tau','nu_tau','chi','nu_chi', - &2*' ','g','gamma','Z','W','H',2*' ','reggeon','pomeron',2*' ', - &'Z''','Z"','W''','H''','A','H','eta_tech','LQ_ue','R',40*' ', - &'specflav','rndmflav','phasespa','c-hadron','b-hadron', - &'t-hadron','l-hadron','h-hadron','Wvirt','diquark','cluster', - &'string','indep.','CMshower','SPHEaxis','THRUaxis','CLUSjet', - &'CELLjet','table',' ','pi',2*'K',2*'D','D_s',2*'B','B_s','B_c', - &'pi','eta','eta''','eta_c','eta_b','eta_t','eta_l','eta_h',2*' ', - &'rho',2*'K*',2*'D*','D*_s',2*'B*','B*_s','B*_c','rho','omega', - &'phi','J/psi','Upsilon','Theta','Theta_l','Theta_h',2*' ','b_1', - &2*'K_1',2*'D_1','D_1s',2*'B_1','B_1s','B_1c','b_1','h_1','h''_1', - &'h_1c','h_1b','h_1t','h_1l','h_1h',2*' ','a_0',2*'K*_0',2*'D*_0', - &'D*_0s',2*'B*_0','B*_0s','B*_0c','a_0','f_0','f''_0','chi_0c', - &'chi_0b','chi_0t','chi_0l','chi_0h',2*' ','a_1',2*'K*_1', - &2*'D*_1','D*_1s',2*'B*_1','B*_1s','B*_1c','a_1','f_1','f''_1', - &'chi_1c','chi_1b','chi_1t','chi_1l','chi_1h',2*' ','a_2', - &2*'K*_2',2*'D*_2','D*_2s',2*'B*_2','B*_2s','B*_2c','a_2','f_2', - &'f''_2','chi_2c','chi_2b','chi_2t','chi_2l','chi_2h',2*' ','K_L', - &'K_S',8*' ','psi''',3*' ','Upsilon''',45*' ','pi_diffr'/ - DATA (CHAF(I) ,I= 282, 500)/'n_diffr','p_diffr','rho_diff', - &'omega_di','phi_diff','J/psi_di',18*' ','Lambda',5*' ', - &'Lambda_c',' ',2*'Xi_c',6*' ','Lambda_b',' ',2*'Xi_b',6*' ','n', - &'p',' ',3*'Sigma',2*'Xi',' ',3*'Sigma_c',2*'Xi''_c','Omega_c', - &4*' ',3*'Sigma_b',2*'Xi''_b','Omega_b',4*' ',4*'Delta', - &3*'Sigma*',2*'Xi*','Omega',3*'Sigma*_c',2*'Xi*_c','Omega*_c', - &4*' ',3*'Sigma*_b',2*'Xi*_b','Omega*_b',114*' '/ - -C...LUDATR, with initial values for the random number generator. - DATA MRLU/19780503,0,0,97,33,0/ - - END - -C********************************************************************* - - SUBROUTINE LUTAUD(ITAU,IORIG,KFORIG,NDECAY) - -C...Dummy routine, to be replaced by user, to handle the decay of a -C...polarized tau lepton. -C...Input: -C...ITAU is the position where the decaying tau is stored in /LUJETS/. -C...IORIG is the position where the mother of the tau is stored; -C... is 0 when the mother is not stored. -C...KFORIG is the flavour of the mother of the tau; -C... is 0 when the mother is not known. -C...Note that IORIG=0 does not necessarily imply KFORIG=0; -C... e.g. in B hadron semileptonic decays the W propagator -C... is not explicitly stored but the W code is still unambiguous. -C...Output: -C...NDECAY is the number of decay products in the current tau decay. -C...These decay products should be added to the /LUJETS/ common block, -C...in positions N+1 through N+NDECAY. For each product I you must -C...give the flavour codes K(I,2) and the five-momenta P(I,1), P(I,2), -C...P(I,3), P(I,4) and P(I,5). The rest will be stored automatically. - - COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5) - COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /LUJETS/,/LUDAT1/ - -C...Stop program if this routine is ever called. -C...You should not copy these lines to your own routine. - NDECAY=ITAU+IORIG+KFORIG - WRITE(MSTU(11),5000) - IF(RLU(0).LT.10.) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link your LUTAUD routine ', - &'correctly.'/1X,'Dummy routine in JETSET file called instead.'/ - &1X,'Execution stopped!') - - - RETURN - END diff --git a/lpair_2diss/desy/external/utils.h b/lpair_2diss/desy/external/utils.h deleted file mode 100644 index 08e319d..0000000 --- a/lpair_2diss/desy/external/utils.h +++ /dev/null @@ -1,35 +0,0 @@ -#ifndef _UTILS_H -#define _UTILS_H - -#include - -/** - * An object which enables to extract the processing time between two steps in - * this software's flow - */ -class Timer -{ - public: - inline Timer() { clock_gettime(CLOCK_REALTIME, &beg_); } - /** - * Get the time elapsed since the last @a reset call (or class construction) - * @return The elapsed time in seconds - */ - inline double elapsed() { - clock_gettime(CLOCK_REALTIME, &end_); - return end_.tv_sec -beg_.tv_sec+(end_.tv_nsec - beg_.tv_nsec)/1000000000.; - } - /** - * @brief Resets the clock counter - */ - inline void reset() { - clock_gettime(CLOCK_REALTIME, &beg_); - } - private: - /** @brief Timestamp marking the beginning of the counter */ - timespec beg_; - /** @brief Timestamp marking the end of the counter */ - timespec end_; -}; - -#endif diff --git a/lpair_2diss/desy/ilpair-cms-pp.f b/lpair_2diss/desy/ilpair-cms-pp.f deleted file mode 100644 index 9ac8563..0000000 --- a/lpair_2diss/desy/ilpair-cms-pp.f +++ /dev/null @@ -1,148 +0,0 @@ -********************************************************** -* * -* LPAIR ver. 4.2 - KRAKOW / LOUVAIN-LA-NEUVE * -* * -* Monte Carlo generator to simulate * -* (p/e)(p/e)->(p/p*/e)l+l-(p/e) * -* processes in High Energy Physics * -* * -* Created 03 January 2005, last update November 2013 * -* Authors/Collaborators : * -* Jos Vermaseren * -* Dariusz Bocian * -* Janusz Chwastowski * -* Laurent Forthomme * -* * -********************************************************** -* - implicit none -* - integer ireturn,iev,i,in -* - integer pychge - integer n,k,npad - real p,v - common /pyjets/ N,K(4000,5),P(4000,5),V(4000,5) -* - double precision tmx - common /mykin/ tmx -* - double precision pairm,pm - common /gmulpm/ pairm -* -*----------------------------------------------------------------- -* - integer ip,icode,maxp - integer NEV,Nprt -* - double precision pi - double precision phi,charge - double precision etap,Pp,PTp,thp -* - real px,py,pz,E,m,Ptot,PT,Eta,fin,iz -* - parameter (NEV=2E5) ! nev - number of events to generate - parameter (Nprt=NEV/1) ! nprt - printing period - parameter (pi=3.14159265) - parameter (maxp=100) ! maxp - max number of particles in event -* - common /kine/ ip, - & icode(maxp), ! icode - particle code - & px(maxp),py(maxp),pz(maxp), ! px-z - 3-momentum - & E(maxp), ! E - energy - & m(maxp), ! m - mass - & Ptot(maxp), ! Ptot - momentum - & PT(maxp), ! PT - transverse momentum - & fin(maxp), ! fin - phi from generator - & iz(maxp), ! iz - the side indicator Left or Right - & Eta(maxp), ! Eta - pseudo-rapidity of the particle - & Charge(maxp) ! Charge- charge -* - integer ie,Ntot,Nch,Nn - real ET,MX - data ntot,nn,nch/0,0,0/ - common /event/ ie, - & Ntot, ! Ntot - total number particles in event - & Nch, ! Nch - number of charged particles in event - & Nn, ! Nn - number of neutral particles in event - & ET, ! ET - transversal energy - & MX ! MX - proton remnant mass - - real kchg,pmas,parf,vckm - COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) -* -C... Event loop. - ie=0 -* -* - call zduini - call prtlhe(1) -* - DO IEV=1,NEV - call zduevt(ireturn) -c IF(MOD(IEV,Nprt).EQ.0) print *,' Event nr = ',IEV -c call prtlhe(2) -* - ip=0 -* -! outgoing proton-like remnants invariant mass - MX=TMX -c print *,pairm,mx -* - DO I=1,N - IF(K(I,1).EQ.1) THEN ! all stable particles -* -! pseudorapidity calculation - etap=sign(log((sqrt(P(I,1)**2+P(I,2)**2+P(I,3)**2) - & +abs(P(I,3)))/SQRT(P(I,1)**2+P(I,2)**2)),P(I,3)) - -! particle production angle - thp=ATAN(SQRT(P(I,1)**2+P(I,2)**2)/ABS(P(I,3))) -! particle azimuthal angle - phi=atan2(P(I,2),P(I,1)) - IF(phi.LT.0) phi = phi+2*pi -! particle momentum - Pp=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) -! particle transverse momentum - PTp=SQRT(P(I,1)**2+P(I,2)**2) -* -*------------------------------------ -* - ip=ip+1 - icode(ip) = K(I,2) ! icode - particle code - px(ip) = P(I,1) ! px - x-component of momentum - py(ip) = P(I,2) ! py - y-component of momentum - pz(ip) = P(I,3) ! pz - z-component of momentum - E(ip) = P(I,4) ! E - Energy of particle - m(ip) = P(I,5) ! m - mass of particle - Ptot(ip) = Pp ! Ptot - momentum of particle - PT(ip) = PTp ! PT - transversal momentum of particle - fin(ip) = phi ! fin - phi from generator - iz(ip) = etap/abs(etap) ! iz - the side indicator Left or Right - Eta(ip) = etap ! Eta - pseudorapidity - Charge(ip)= PYCHGE(K(I,2))/3 ! Charge - if(abs(charge(ip)).eq.0) then - nn=nn+1 - else - nch=nch+1 - endif -c print *,charge(ip) -c write(*,1000) icode(ip),px(ip),py(ip),pz(ip),E(ip),m(ip) -c print *,icode(ip),px(ip),py(ip),pz(ip),E(ip),m(ip) -* - endif - 97 continue - enddo -* -*----------------------------------------------------------------- -* - 99 continue -* - enddo - call prtlhe(3) -* -*----------------------------------------------------------------- -* - 1000 format(i8,f12.6,f12.6,f12.6,f12.6,f12.6) -* - end diff --git a/lpair_2diss/desy/lpair.card b/lpair_2diss/desy/lpair.card deleted file mode 100644 index 3007ad3..0000000 --- a/lpair_2diss/desy/lpair.card +++ /dev/null @@ -1,16 +0,0 @@ -IEND 3 -NTRT 0 -NCVG 100000 -ITVG 10 -INPP 6500. -PMOD 11 -INPE 6500. -EMOD 2 -PAIR 11 -MCUT 2 -ECUT 0. -PTCT 0. -THMN 0. -THMX 180. -MXMX 2000. -NGEN 500000 diff --git a/lpair_2diss/desy/main.cpp b/lpair_2diss/desy/main.cpp deleted file mode 100644 index ecc9540..0000000 --- a/lpair_2diss/desy/main.cpp +++ /dev/null @@ -1,141 +0,0 @@ -#include - -#include "external/utils.h" -#include "TTree.h" -#include "TLorentzVector.h" - -using namespace std; -#define nd 10 - -extern "C" { - void zduini_(); - void zduevt_(int* iwant); - int luchge_(int&); - extern struct { - double inpe, inpp; - int intge, intgp, gpdf, spdf, pmod, emod, ipair, nquark; - } beam_; - extern struct { - int n, k[5][4000]; - float p[5][4000], v[5][4000]; - } lujets_; - extern struct { - double t1min,t1max; - double t2min,t2max; - double d3; - } photons_; - extern struct { - double s1,s2,t1,t2; - } extra_; - extern struct { - float s1,s2,s3,s4; - } vgres_; - extern struct { - int ndim,ncvg,itmx,nprn,igraph,npoin,nprin,ntreat,ibeg,iend,ngen; - } vegpar_; - extern struct { - double w,valtreat, x[nd], z[nd]; - } treatb_; - extern struct { - double u1,u2,v1,v2; - double t11,t12,t21,t22; - } peric_; - extern struct { - double tmx; - } mykin_; -} - -int main(int argc, char* argv[]) { - int one = 1; - - Timer tmr; - - //const int maxevts = 2.5e6; - //const int maxevts = 2.5e6; - const int maxevts = 2.e5; - //const int maxevts = 5; - const int maxpart = 1000; - - int npart; - double xsect, errxsect; - double px[maxpart], py[maxpart], pz[maxpart], E[maxpart], M[maxpart], charge[maxpart]; - int PID[maxpart], parentid[maxpart], daughterid1[maxpart], daughterid2[maxpart], status[maxpart], role[maxpart]; - float gen_time; - - TTree *t; - - zduini_(); - -cout << "zduini passed" << endl; - - if (vegpar_.iend<2) return 0; - - t = new TTree("h4444", "A TTree containing information from the events produced from LPAIR"); - - t->Branch("ip", &npart, "npart/I"); - t->Branch("xsect", &xsect, "xsect/D"); - t->Branch("errxsect", &errxsect, "errxsect/D"); - t->Branch("total_time", &gen_time, "total_time/F"); - t->Branch("px", px, "px[npart]/D"); - t->Branch("py", py, "py[npart]/D"); - t->Branch("pz", pz, "pz[npart]/D"); - t->Branch("charge", charge, "charge[npart]/D"); - t->Branch("icode", PID, "PID[npart]/I"); - t->Branch("parent", parentid, "parent[npart]/I"); - t->Branch("daughter1", daughterid1, "daughter1[npart]/I"); - t->Branch("daughter2", daughterid2, "daughter2[npart]/I"); - t->Branch("status", status, "status[npart]/I"); - t->Branch("role", role, "role[npart]/I"); - t->Branch("E", E, "E[npart]/D"); - t->Branch("m", M, "M[npart]/D"); - - xsect = vgres_.s1; - errxsect = vgres_.s2; - for (int i=0; i0) - cout << "[" << 100.*i/maxevts << "%] Generating event #" << i << " / " << maxevts << endl; - npart = 0; - for (int j=0; jFill(); - } - - TString filename = "events.root"; - if (argc>2) { filename = TString(argv[2]); } - t->SaveAs(filename); - - delete t; - - return 0; -} diff --git a/lpair_2diss/desy/source/arguments.f b/lpair_2diss/desy/source/arguments.f deleted file mode 100644 index 7789cc0..0000000 --- a/lpair_2diss/desy/source/arguments.f +++ /dev/null @@ -1,20 +0,0 @@ - function numarguments() ! get number of command line arguments using gfortran - implicit none - integer numarguments ! number of command line arguments - - print *, 'haha' - numarguments=command_argument_count() - - return - end - - subroutine getargument(arg,argt) ! get a command line argument using gfortran - implicit none - integer arg ! number of argument to get - character*(*) argt ! output - - call get_command_argument(arg,argt) - - return - end - diff --git a/lpair_2diss/desy/source/f.f b/lpair_2diss/desy/source/f.f deleted file mode 100644 index 582c274..0000000 --- a/lpair_2diss/desy/source/f.f +++ /dev/null @@ -1,277 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - FUNCTION F(X) - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) -C----> -C---- OUR MODIFICATION / ADDITION -C---- -*KEEP,INPU. - REAL*8 ME,MU,MP,MX,S,SQ,PE,PP,EE,EP,CONST,PI - COMMON /INPU/ME,MU,MP,MX,S,SQ,PE,PP,EE,EP,CONST,PI - REAL*8 TMX - COMMON /MYKIN/ TMX - -*KEEP,BEAM. - INTEGER INTGE,INTGP,GPDF,SPDF,PMOD,EMOD,IPAIR,NQUARK - REAL*8 INPE,INPP - COMMON /BEAM/ INPE,INPP,INTGE,INTGP,GPDF,SPDF,PMOD,EMOD, - & IPAIR,NQUARK - -*KEEP,CUTS. - INTEGER MODCUT - REAL*4 THMAX,THMIN,MXMN,MXMX,Q2MN,Q2MX - REAL*8 COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & QP2MIN,QP2MAX - COMMON /CUTS/COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & THMAX,THMIN,QP2MIN,QP2MAX,MODCUT,MXMN,MXMX,Q2MN,Q2MX - -*KEEP,XQCOM. - INTEGER IUSEDF - DOUBLE PRECISION XQ,EQ,PQ,MQ, - & QSCALE,XDENS(-6:2), - & PSEA,PVALD - COMMON /XQCOM/ XQ,EQ,PQ,MQ, - & QSCALE,XDENS, - & PSEA,PVALD,IUSEDF - -*KEEP,LTCOM. - REAL*8 GAMMA,BETGAM - COMMON /LTCOM/ GAMMA,BETGAM - -*KEEP,VEGPAR. - INTEGER NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - COMMON /VEGPAR/ NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - -*KEND. - COMMON /VARIAB/ E,E1,E2,E3,E4,E5,P,P3,P4,P5,CT3,ST3,CT4,ST4,CT5, - & ST5,CP3,SP3,CP5,SP5 - COMMON /VARIAD/ E6,E7,P6,P7,CT6,ST6,CT7,ST7,CP6,SP6,CP7,SP7,W - COMMON /EXTRA/ S1,S2,T1,T2 -C - REAL*8 WX,WXMIN,WXMAX,MX2,MD2 -C PARAMETER FOR PDFLIB <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - REAL*8 XMIN,XMAX,Q2MIN,Q2MAX - COMMON /W50513/ XMIN,XMAX,Q2MIN,Q2MAX - - REAL*8 MPI - PARAMETER(MPI=0.1396D0) - - LOGICAL LCUT,LMU1,LMU2 - - DIMENSION X(10) -C - REAL ULMASS -C - DATA NCALL/0/,NDETCT/0/,NMXCUT/0/,NQ2CUT/0/,NPDFC/0/ - DATA NEXTW/1/ -C - NCALL=NCALL+1 -C - IF (PMOD .GE. 100) THEN - IF (NQUARK.EQ.12) THEN - MQ=DBLE(ULMASS(2)) - ELSE - MQ=DBLE(ULMASS(NQUARK)) - ENDIF - XQMIN = 4.0 * MU * MU / (S - MP * MP) - XQMAX = (S - 2. * SQ * MP) / (S - MP * MP) - CALL MAPXQ(XQ,X(8),XQMIN,XQMAX,DXQ) - PQ = XQ * PP - EQ = DSQRT(PQ*PQ + MQ*MQ) - ETOT = EQ + EE - PTOT = PQ - PE -C - SSQ = DSQRT(MQ * MQ + ME * ME + 2. * (EE * EQ + PE * PQ)) -C -C COMPUTING MAT.EL. FOR Q E -> Q E MU MU <========================= - CALL GAMGAM(SSQ,MQ,ME,MQ,ME,MU,MU,0.D+00,SQ,DJ,0,X,1) -C - ELSEIF (PMOD .LE. 2) THEN - ETOT = EP + EE - PTOT = PP - PE - SSQ = DSQRT(MP * MP + ME * ME + 2. * (EE * EP + PE * PP)) -C -C COMPUTING MAT.EL. FOR P E -> P E MU MU <========================= - CALL GAMGAM(SSQ,MP,ME,MP,ME,MU,MU,0.D+00,SQ,DJ,0,X,1) -C - ELSEIF (PMOD .EQ. 11 .OR. PMOD .EQ. 12 .OR. PMOD .EQ. 13) THEN - ETOT = EP + EE - PTOT = PP - PE - SSQ = DSQRT(MP * MP + ME * ME + 2. * (EE * EP + PE * PP)) - WXMIN = DMAX1((MP + MPI)**2,MXMIN2) - WXMAX = DMIN1((SSQ - ME - 2*MU)**2,MXMAX2) - CALL MAPWX(WX,X(8),WXMIN,WXMAX,DWX) - MX=DSQRT(WX) - TMX=MX -c print *,'=====>',mx,x(8),mp,ssq,me,2*mu,mxmax2 -C -C COMPUTING MAT.EL. FOR P E -> X E MU MU <========================= - CALL GAMGAM(SSQ,MP,ME,MX,ME,MU,MU,0.D+00,SQ,DJ,0,X,1) -C - ELSE - WRITE(6,*) ' F(X) : WRONG PROTON MODE PMOD =',PMOD - STOP - ENDIF -c print *,dj - IF (DJ .EQ. 0D0) THEN - F=0D0 - RETURN - ENDIF -C -C PARAMETER FOR LORENTZ TRANSFORMATION <=========================== - GAMMA = ETOT / SSQ - BETGAM = PTOT / SSQ -C -C COMPUTING SOME KIN. PARAMETER ONLY FOR THE CUTS <========= -C -C COMPUTING PT, PZ AND E OF THE MUON PAIR <========= - PT6 = P6 * ST6 - PT7 = P7 * ST7 - PZ6 = BETGAM* E6 + GAMMA * P6 * CT6 - PZ7 = BETGAM* E7 + GAMMA * P7 * CT7 - E6LAB= GAMMA * E6 + BETGAM* P6 * CT6 - E7LAB= GAMMA * E7 + BETGAM* P7 * CT7 -C -C STANDART CUT - IF (MODCUT.EQ.2 .OR. MODCUT.EQ.3) THEN -C COMPUTING COT(THETA) OF MUON PAIR OR SINGLE MUON <============= - COTT6= PZ6/PT6 - COTT7= PZ7/PT7 -C -C CUT IN THETA, PT AND E OF THE MUON PAIR <===================== -c IF (NCALL .EQ. 1) -c & WRITE(6,*)'F : COTTH1 =',COTTH1,' COTTH2 =',COTTH2, -c & ' PTCUT =',PTCUT,' ECUT =',ECUT - LMU1 = (COTT6 .GE. COTTH1) .AND. (COTT6 .LE. COTTH2) .AND. - & (PT6 .GE. PTCUTMIN) .AND. (PT6 .LE. PTCUTMAX) .AND. - & (E6LAB .GE. ECUT) - LMU2 = (COTT7 .GE. COTTH1) .AND. (COTT7 .LE. COTTH2) .AND. - & (PT7 .GE. PTCUTMIN) .AND. (PT7 .LE. PTCUTMAX) .AND. - & (E7LAB .GE. ECUT ) - IF (MODCUT .EQ. 2) THEN - LCUT = LMU1 .AND. LMU2 - ELSE - LCUT = LMU1 .OR. LMU2 - ENDIF -C - ELSEIF (MODCUT .EQ. 1) THEN -C VERMASEREN HYPOTETICAL DETECTOR CUTS - COST6=PZ6/DSQRT(PZ6**2+PT6**2) - COST7=PZ7/DSQRT(PZ7**2+PT7**2) - LCUT=(((ABS(COST6) .LE. 0.75D0) .AND. (PT6 .GE. 1D0)) - & .OR. - & ((ABS(COST6) .LE. 0.95D0) .AND. (ABS(COST6) .GT. 0.75D0) - & .AND. (ABS(PZ6) .GT. 1D0))) - & .AND. - & (((ABS(COST7) .LE. 0.75D0) .AND. (PT7 .GE. 1D0)) - & .OR. - & ((ABS(COST7) .LE. 0.95D0) .AND. (ABS(COST7) .GT. 0.75D0) - & .AND. (ABS(PZ7) .GT. 1D0))) - ELSEIF (MODCUT .EQ. 0) THEN - LCUT=.TRUE. - ELSE - WRITE(6,*) ' F(X) : ILLEGAL CUT MODE ; MODCUT =',MODCUT - STOP - ENDIF - IF (LCUT) NDETCT=NDETCT+1 -CC - IF (PMOD .GE. 100) THEN - ENDIF -C -C CUT ON MASS OFF FINAL HADRONIC SYSTEM (MX) - IF ((PMOD .GT. 2) .AND. - & (MX*MX.LT.MXMIN2 .OR. MX*MX.GT.MXMAX2)) LCUT=.FALSE. - IF (LCUT) NMXCUT=NMXCUT+1 -c print *,'haha',t1,qp2min,qp2max -C -C CUT ON THE PROTON Q**2 (T1) - IF (T1.LT.QP2MAX .OR. T1.GT.QP2MIN) LCUT=.FALSE. -C - IF (LCUT) THEN - NQ2CUT=NQ2CUT+1 - IF (PMOD .GE. 100) THEN -C -C GET QUARK CONTENT OF THE PROTON AND WEIGHT THE FUNCTION <========== -C - QSCALE=-T1 - IF((QSCALE .LE. Q2MAX) .AND. (QSCALE .GE. Q2MIN).AND. - & ( XQ .LE. XMAX) .AND. ( XQ .GE. XMIN)) THEN - - NPDFC=NPDFC+1 -C -clf CALL PDF2PDG(XQ,DSQRT(QSCALE),XDENS) - IF (NQUARK.EQ.2 .AND. PMOD.EQ.103) THEN - FORMF = (XDENS(2)+XDENS(-2)*2D0)*4D0/9D0/XQ - PVALD=0.0D0 - PSEA=XDENS(-2)/(XDENS(2)*0.5D0+XDENS(-2)) - ELSEIF (NQUARK.EQ.1 .AND. PMOD.EQ.103) THEN - FORMF = (XDENS(1)+XDENS(-1)*2D0)/9D0/XQ - PVALD=1.0D0 - PSEA=XDENS(-1)/(XDENS(1)*0.5D0+XDENS(-1)) - ELSEIF (NQUARK.EQ.12 .AND. PMOD.EQ.103) THEN - FORMF = (XDENS(1)+XDENS(2)*4D0+XDENS(-1)*10D0)/9D0/XQ - PVALD=XDENS(1)/(XDENS(2)*4.0D0+XDENS(1)) - PSEA=XDENS(-1)*10.0D0 - & /(XDENS(2)*4.0D0+XDENS(1)+XDENS(-1)*10.0D0) - ELSEIF (NQUARK.EQ.2 .AND. PMOD.EQ.101) THEN - FORMF = XDENS(2)*4D0/9D0/XQ - PVALD=0.0D0 - PSEA=0.0D0 - ELSEIF (NQUARK.EQ.1 .AND. PMOD.EQ.101) THEN - FORMF = XDENS(1)/9D0/XQ - PVALD=1.0D0 - PSEA=0.0D0 - ELSEIF (NQUARK.EQ.12 .AND. PMOD.EQ.101) THEN - FORMF = (XDENS(1)+XDENS(2)*4D0)/9D0/XQ - PVALD=XDENS(1)/(XDENS(2)*4.0D0+XDENS(1)) - PSEA=0.0D0 - ELSEIF ((NQUARK.EQ.1 .OR. NQUARK.EQ.3 .OR. NQUARK.EQ.5) - & .AND. PMOD.EQ.102) THEN - FORMF = (XDENS(-NQUARK)*2D0)/9D0/XQ - PVALD=0.0D0 - PSEA=1.0D0 - ELSEIF ((NQUARK.EQ.2 .OR. NQUARK.EQ.4).AND. PMOD.EQ.102) - & THEN - FORMF = (XDENS(-NQUARK)*8D0)/9D0/XQ - PVALD=0.0D0 - PSEA=1.0D0 - ELSE - WRITE(6,*) 'F : WRONG QUARK NUMBER ; QPDF =',NQUARK, - & ' OR WRONG PROTON MODE FOR GIVEN QUARK NUMBER ;', - & ' PMOD =',PMOD,' PROGRAM STOPS !!!!!!' - STOP - ENDIF - ELSE - F=0D0 - RETURN - ENDIF -C - F = CONST * DJ * PERIPP(INTGP,INTGE) * DXQ * FORMF -C - ELSEIF (PMOD .LE. 2) THEN -C IF PMOD=2 : ONLY USE THE FORMFACTOR IN PRIPP - F = CONST * DJ * PERIPP(INTGP,INTGE) - ELSE -C IF PMOD=11 OR 12 -C ONLY USE THE FORMFACTOR IN PRIPP AND DWX - F = CONST * DJ * PERIPP(INTGP,INTGE) * DWX - ENDIF -C - ELSE - F=0D0 - ENDIF -C -C END CUT >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -C -* IF (NCALL .GE. NEXTW) THEN -* WRITE(6,*) ' F(X) : NUMBER OF CALLS IS ',NCALL, -* & ' CUTS SUCCEEDED :',NDETCT,NMXCUT,NQ2CUT,'(DET MX Q2)', -* & ' PDF CALLED :',NPDFC -* NEXTW=NEXTW*2 -* ENDIF -C -c print *,f - RETURN - END diff --git a/lpair_2diss/desy/source/gamgam.f b/lpair_2diss/desy/source/gamgam.f deleted file mode 100644 index 54ce456..0000000 --- a/lpair_2diss/desy/source/gamgam.f +++ /dev/null @@ -1,139 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE GAMGAM(SQRTS,V1,V2,V3,V5,V6,V7,VMIN,VMAX,DJ,NOPT,X,NM) - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - - COMMON /VARIAB/ E,E1,E2,E3,E4,E5,P,P3,P4,P5,CT3,ST3,CT4,ST4,CT5, - & ST5,CP3,SP3,CP5,SP5 - COMMON /VARIAC/ AL3,AL4,BE4,BE5,DE3,DE5,PP3,PP4,PP5 - COMMON /VARIAD/ E6,E7,P6,P7,CT6,ST6,CT7,ST7,CP6,SP6,CP7,SP7,W - COMMON /PICKZZ/ W1,W2,W3,W4,W5,W31,W52,W12,TAU,SL1 - COMMON /DOTPS/ Q1DQ,Q1DQ2,W6 - COMMON /DOTP/ P12,P13,P14,P15,P23,P24,P25,P34,P35,P45,P1K2,P2K1 - COMMON /CIVITA/ EPSI,G5,G6,A5,A6,BB - COMMON /EXTRA/ S1,S2,T1,T2 - COMMON /EXT/ CTG,STG,CPG,SPG - COMMON /ANGU/ CTCM6,STCM6 - COMMON /QVEC/ QVE(4) - - DIMENSION X(7) - - DATA PI/3.14159265358979D+00/,CONST/2.1868465D+10/ - - W6=V6*V6 - W7=V7*V7 - WMIN=V6+V7 - IF(WMIN.LT.VMIN)WMIN=VMIN - WMIN=WMIN*WMIN - E=SQRTS - S=E*E - WMAX=E-V3-V5 - IF(WMAX.GT.VMAX)WMAX=VMAX - WMAX=WMAX*WMAX - XW=X(5) - CALL MAPW2(W4,XW,WMIN,WMAX,DW) - V4=DSQRT(W4) - W=V4 - CALL ORIENT(S,V1,V2,V3,V4,V5,DJ,NOPT,X) - IF(T1.GT.0.OR.T2.GT.0)DJ=0. - IF(DJ.EQ.0) RETURN - ECM6=(W4+W6-W7)/(2.*V4) - PCM6=DSQRT(ECM6*ECM6-W6) - DJ=DJ*DW*PCM6/(V4*CONST*S) -C WRITE(6,*) ' E3MP3=W3/(E3+P3) :',W3,E3,P3 - E3MP3=W3/(E3+P3) - E1MP1=W1/(E1+P) - EG=(W4+T1-T2)/(2.*V4) - PG=DSQRT(EG*EG-T1) - PGX=-PP3*CP3*CT4-ST4*(DE3-E1MP1+E3MP3+P3*AL3) - PGY=-PP3*SP3 - PGZ=V4*DE3/(E4+P4)-E4*DE3*AL4/V4-PP3*CP3 - & *E4*ST4/V4+E4*CT4/V4*(P3*AL3+E3MP3-E1MP1) - PGP=DSQRT(PGX*PGX+PGY*PGY) - PGG=DSQRT(PGP*PGP+PGZ*PGZ) - IF(PGG.GT.PGP*0.9.AND.PGG.GT.PG)PG=PGG - STG=PGP/PG - CPG=PGX/PGP - SPG=PGY/PGP - CTG=DSQRT(1.-STG*STG) - IF(PGZ.LT.0)CTG=-CTG - XX6=X(6) - IF(NM.EQ.0)GO TO 1 - AMAP=.5*(W4-T1-T2) - BMAP=.5*DSQRT(((W4-T1-T2)**2-4.*T1*T2)*(1.-4.*W6/W4)) - YMAP=(AMAP+BMAP)/(AMAP-BMAP) - BETA=YMAP**(2.*XX6-1.) - XX6=(AMAP/BMAP*(BETA-1.)/(BETA+1.)+1.)*0.5 - IF(XX6.GT.1.)XX6=1. - IF(XX6.LT.0.)XX6=0. - CTCM6=1.-2.*XX6 - DDD=(AMAP+BMAP*CTCM6)*(AMAP-BMAP*CTCM6)/AMAP/BMAP*DLOG(YMAP) - DJ=DJ*DDD*0.5 -1 CTCM6=1.-2.*XX6 - STCM6=2.*DSQRT(XX6*(1.-XX6)) - PHICM6=2.*PI*X(7) - CPCM6=DCOS(PHICM6) - SPCM6=DSIN(PHICM6) - PCM6X=PCM6*STCM6*CPCM6 - PCM6Y=PCM6*STCM6*SPCM6 - PCM6Z=PCM6*CTCM6 - PC6Z=CTG*PCM6Z-STG*PCM6X - H1=STG*PCM6Z+CTG*PCM6X - PC6X=CPG*H1-SPG*PCM6Y - QCX=2.*PC6X - QCZ=2.*PC6Z - P6Y=CPG*PCM6Y+SPG*H1 - E6=(E4*ECM6+P4*PC6Z)/V4 - H2=(E4*PC6Z+P4*ECM6)/V4 - P6X=CT4*PC6X+ST4*H2 - P6Z=CT4*H2-ST4*PC6X - QVE(1)=P4*QCZ/V4 - QVE(3)=2.*P6Y - HQ=E4*QCZ/V4 - QVE(2)=CT4*QCX+ST4*HQ - QVE(4)=CT4*HQ-ST4*QCX - P6=DSQRT(E6*E6-W6) - E7=E4-E6 - P7=DSQRT(E7*E7-W7) - P7X=PP4-P6X - P7Y=-P6Y - P7Z=P4*CT4-P6Z - PP6=DSQRT(P6X*P6X+P6Y*P6Y) - PP7=DSQRT(P7X*P7X+P7Y*P7Y) - CT6=P6Z/P6 - ST6=PP6/P6 - CT7=P7Z/P7 - ST7=PP7/P7 - CP6=P6X/PP6 - SP6=P6Y/PP6 - CP7=P7X/PP7 - SP7=P7Y/PP7 - Q1DQ=EG*(2.*ECM6-V4)-2.*PG*PCM6*CTCM6 - Q1DQ2=0.5*(W4-T1-T2) - BB=T1*T2+(W4*STCM6*STCM6+4.*W6*CTCM6*CTCM6)*PG*PG - Q0=QVE(1) - QX=QVE(2) - QY=QVE(3) - QZ=QVE(4) - C1=(QX*SP3-QY*CP3)*PP3 - C2=(QZ*E1-Q0*P)*PP3 - C3=(W31*E1*E1+2.*W1*DE3*E1-W1*DE3*DE3+PP3*PP3*E1*E1) - & /(E3*P+P3*CT3*E1) - B1=(QX*SP5-QY*CP5)*PP5 - B2=(QZ*E2+Q0*P)*PP5 - B3=(W52*E2*E2+2.*W2*DE5*E2-W2*DE5*DE5+PP5*PP5*E2*E2) - & /(E2*P5*CT5-E5*P) - R12=C2*SP3+QY*C3 - R13=-C2*CP3-QX*C3 - R22=B2*SP5+QY*B3 - R23=-B2*CP5-QX*B3 - EPSI=P12*C1*B1+R12*R22+R13*R23 - G5=W1*C1*C1+R12*R12+R13*R13 - G6=W2*B1*B1+R22*R22+R23*R23 - A5=-(QX*CP3+QY*SP3)*PP3*P1K2-(E1*Q0-P*QZ)*(CP3*CP5+SP3*SP5) - & *PP3*PP5+(DE5*QZ+Q0*(P+P5*CT5))*C3 - A6=-(QX*CP5+QY*SP5)*PP5*P2K1-(E2*Q0+P*QZ)*(CP3*CP5+SP3*SP5) - & *PP3*PP5+(DE3*QZ-Q0*(P-P3*CT3))*B3 - - RETURN - END diff --git a/lpair_2diss/desy/source/gmubeg.f b/lpair_2diss/desy/source/gmubeg.f deleted file mode 100644 index 36ac7b2..0000000 --- a/lpair_2diss/desy/source/gmubeg.f +++ /dev/null @@ -1,216 +0,0 @@ -*-- Author : ZEUS Offline Group 18/08/94 - SUBROUTINE GMUBEG - - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) -C----> -C---- OUR MODIFICATION / ADDITION -C---- -*KEEP,INPU. - REAL*8 ME,MU,MP,MX,S,SQ,PE,PP,EE,EP,CONST,PI - COMMON /INPU/ME,MU,MP,MX,S,SQ,PE,PP,EE,EP,CONST,PI - -*KEEP,BEAM. - INTEGER INTGE,INTGP,GPDF,SPDF,PMOD,EMOD,IPAIR,NQUARK - REAL*8 INPE,INPP - COMMON /BEAM/ INPE,INPP,INTGE,INTGP,GPDF,SPDF,PMOD,EMOD, - & IPAIR,NQUARK - -*KEEP,VEGPAR. - INTEGER NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - COMMON /VEGPAR/ NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - -*KEEP,CUTS. - INTEGER MODCUT - REAL*4 THMAX,THMIN,MXMN,MXMX,Q2MN,Q2MX - REAL*8 COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & QP2MIN,QP2MAX - COMMON /CUTS/COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & THMAX,THMIN,QP2MIN,QP2MAX,MODCUT,MXMN,MXMX,Q2MN,Q2MX - -*KEEP,PARTIC. - INTEGER I2STAT(13),I2PART(13), - & I2MO1(13),I2DA1(13),I2DA2(13) - COMMON /PARTIC/ I2LINE,I2STAT,I2PART,I2MO1,I2DA1,I2DA2 -*KEEP,COMGNA. - INTEGER NGNA - COMMON /COMMUP/ NGNA -*KEND. -C PARAMETER FOR PDFLIB <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - REAL*8 XMIN,XMAX,Q2MIN,Q2MAX - COMMON /W50513/ XMIN,XMAX,Q2MIN,Q2MAX - -C----- MGVH 27 APR 96 ------- - CHARACTER*20 PARM(20) - DOUBLE PRECISION VAL(20) -C----------------------------- - - EXTERNAL F - double precision x(10),test - - REAL ULMASS - - DATA BCC/0.1D-03/ - - INTEGER M2STAT(9) - DATA M2STAT/ 21, 21, 21, 21, 1, 1, 21, 1, 1/ - INTEGER M2PART(9) - DATA M2PART/2212, 11, 22,22,2212, 0, 0, 0, 11/ - INTEGER M2MO1(9) - DATA M2MO1/ 0, 0, 1, 2, 1, 3, 3, 7, 2/ - INTEGER M2DA1(9) - DATA M2DA1/ 3, 4, 6, 0, 0, 0, 8, 0, 0/ - INTEGER M2DA2(9) - DATA M2DA2/ 5, 9, 7, 0, 0, 0, 0, 0, 0/ - -c---- Lund common for the masses - double precision kchg,pmas,parf,vckm - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - -C----- - QP2MIN=-DBLE(Q2MN) - QP2MAX=-DBLE(Q2MX) -C----- - IF (PMOD .EQ. 1) THEN - NDIM=7 - INTGP=1 - M2PART(1)=-11 - M2PART(5)=-11 - ELSEIF (PMOD .EQ. 2) THEN - NDIM=7 - INTGP=2 - ELSEIF (PMOD .EQ. 11 .OR. PMOD .EQ. 12 .OR. PMOD .EQ. 13) THEN - NDIM=8 - INTGP=PMOD-8 - MXMIN2=DBLE(MXMN)**2 - MXMAX2=DBLE(MXMX)**2 - M2STAT(5)=21 - ELSEIF (PMOD.GE.101 .AND. PMOD.LE.103) THEN - NDIM=8 - INTGP=1 - MXMIN2=DBLE(MXMN)**2 - MXMAX2=DBLE(MXMX)**2 - ELSE - WRITE(6,*) ' GMUBEG : WRONG PROTON MODE ; PMOD =',PMOD - STOP - ENDIF -C----- - IF (EMOD .EQ. 1) THEN - INTGE=1 - ELSEIF (EMOD .EQ. 2) THEN - INTGE=2 - M2PART(2)=2212 - M2PART(9)=2212 - ELSE - WRITE(6,*) ' GMUBEG : WRONG ELEKTRON MODE ; EMOD =',EMOD - STOP - ENDIF -C----- - DO 100 I=1,9 - I2STAT(I)=M2STAT(I) - I2PART(I)=M2PART(I) - I2MO1(I)=M2MO1(I) - I2DA1(I)=M2DA1(I) - I2DA2(I)=M2DA2(I) - 100 CONTINUE -C -C----- - IF (.NOT.(IPAIR.EQ.11 .OR. IPAIR.EQ.13 .OR. IPAIR.EQ.15)) THEN - WRITE(6,*) 'WRONG CODE FOR LEPTON PAIR, PAIR=',IPAIR, - & ' VALID ARE 11, 13 AND 15 ' - STOP - ENDIF -C----- - NGNA=0 -C----- - PI = DACOS(-1.D+00) - MU = ULMASS(IPAIR) -c WRITE(6,*) '*** THE LEPTON PAIR CODE IS ',IPAIR, -c & ' THE MASS IS ',MU,' ****************' - MP=ULMASS(I2PART(1)) - ME=ULMASS(I2PART(2)) -c print *,mu,mp,me -C----- - PE = INPE - PP = INPP - EE = DSQRT(PE*PE + ME*ME) - EP = DSQRT(PP*PP + MP*MP) - S = MP*MP + ME*ME + 2. * (EE*EP + PE*PP) - SQ = DSQRT(S) - PTOT = PP - PE - ETOT = EP + EE - CONST = (19.732D+03)**2 -C COMPUTING OF COTAN FOR THETA CUTS <==================== - COTTH1= 1D0 / DTAN(DBLE(THMAX)*PI/180D0) - COTTH2= 1D0 / DTAN(DBLE(THMIN)*PI/180D0) -c print *,'GMUBEG: ETA in range [', -c 1 -dlog(dtan(THMAX*PI/180.d0/2.d0)),':', -c 2 -dlog(dtan(THMIN*PI/180.d0/2.d0)),']' -C SETTING OF THE PROTON STRUCTURE FUNCTION <==================== - IF (PMOD .GE. 100) THEN -C----- MGVH 27 APR 96 ------- -Cxx CALL PDFSET('MODE',MPDF) - parm(1)= 'NPTYPE' - VAL(1) = 1 - PARM(2) = 'NGROUP' - VAL(2) = gpdf - PARM(3) = 'NSET' - VAL(3) = spdf -clf CALL PDFSET(PARM,VAL) -C----------------------------- - WRITE(6,'(/A,/A,I8,A,I8,A, - & /A,G13.4,A,G13.4,A,/A,G13.4,A,G13.4,A,/A)') - &'***************************************************************', - &'* PDFLIB GROUP :',gpdf ,' SET :',spdf ,' *', - &'* XMIN = ', XMIN ,' XMAX = ', XMAX ,' *', - &'* Q2MIN = ',Q2MIN ,' Q2MAX = ',Q2MAX ,' *', - &'***************************************************************' - ENDIF - IF (Q2MAX .EQ. 0.D0) Q2MAX=1.D20 -c===== -c print *,'=====================' -c print *,'Masses',MP,ME,' Interaction',INTGP,INTGE -c print *,'=====================' -c===== -C----- - IF (IBEG .EQ. 1) THEN -c PRINT *,'GMUBEG : ===> VEGAS IS OPERATIVE... ' - CALL VEGAS(F,BCC,NDIM,NCVG,ITMX,NPRN,IGRAPH) -c WRITE(6,*) -c & 'SORRY SAVING OF VEGAS-PARAMETER IS ONLY POSSIBLE'// -c & ' ON THE IBM' - ELSE - WRITE(6,*) - & 'SORRY READING OF VEGAS-PARAMETER IS ONLY POSSIBLE'// - & ' ON THE IBM' - STOP - ENDIF -C----- - IF (IBEG .GT. 2) THEN - PRINT *,'GMUBEG : ===> STORED SETGEN VARIABLES READ ...' - CALL RESTR2(NDIM) - CALL GMUPSG - ELSEIF (IEND .LT. 2) THEN -c WRITE(6,*) -c & ' GMUBEG : PROGRAM STOPS WITHOUT SETGEN FILE AND'// -c & ' EVENT GENERATION , IEND < 2 ' -c STOP - ELSE - PRINT *,'GMUBEG : ===> SETGEN IS OPERATIVE... ' - CALL SETGEN(F,NDIM,NPOIN,NPRIN,NTREAT) -c WRITE(6,*) -c & 'SORRY SAVING OF SETGEN-PARAMETER IS ONLY POSSIBLE'// -c & ' ON THE IBM' - ENDIF -C----- - IF (IEND .LT. 3) THEN -c WRITE(6,*) -c & ' GMUBEG : PROGRAM STOPS WITHOUT EVENT GENERATION ,'// -c & ' IEND < 3 ' -c STOP - ENDIF -C----- - RETURN - END diff --git a/lpair_2diss/desy/source/gmucha.f b/lpair_2diss/desy/source/gmucha.f deleted file mode 100644 index 088b815..0000000 --- a/lpair_2diss/desy/source/gmucha.f +++ /dev/null @@ -1,120 +0,0 @@ -*-- Author : ZEUS Offline Group 18/08/94 - - SUBROUTINE GMUCHA - -*********************************************************************** -* -* SUBROUTINE GMUCHA -* -* PURPOSE: Interpret the data cards to change the default parameters of MUPAIR. -* -* INPUT: Bos text bank GMUP -* -* OUTPUT: updated parameters in MUPAIR commons. -* -* CALLED BY: GMUPA -* -* AUTHOR: OLAF DUENGER CREATED AT: 91/12/12 -* -* CHANGED BY: AT: -* REASON: -* -************************************************************************ -* - implicit NONE -* -*KEEP,VEGPAR. - INTEGER NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - COMMON /VEGPAR/ NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - -*KEEP,BEAM. - INTEGER INTGE,INTGP,GPDF,SPDF,PMOD,EMOD,IPAIR,NQUARK - REAL*8 INPE,INPP - COMMON /BEAM/ INPE,INPP,INTGE,INTGP,GPDF,SPDF,PMOD,EMOD, - & IPAIR,NQUARK - -*KEEP,CUTS. - INTEGER MODCUT - REAL*4 THMAX,THMIN,MXMN,MXMX,Q2MN,Q2MX - REAL*8 COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & QP2MIN,QP2MAX - COMMON /CUTS/COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & THMAX,THMIN,QP2MIN,QP2MAX,MODCUT,MXMN,MXMX,Q2MN,Q2MX - -*KEND. -* -C* End of common -* -c intrinsic iargc,getarg -c external iargc,getarg -c integer iargc - integer numarguments - external numarguments - integer i,lun,maxln - character(len=32) file - character(len=6) key - double precision value - logical fexst -* -*-------- Read data cards and overwrite defaults: -* - lun=15 - maxln=20 - -c print *,'==>',numarguments() -c print *,'-->',iargc() -c if (iargc().gt.0) then -c call getarg(1,file) -c else - file='lpair.card' -c endif - -*---- Make sure the file exists - inquire(file=file,exist=fexst) - if (fexst.eqv..false.) then - print *,'GMUCHA: ERROR! Input card does not exist!' - stop - endif - -*---- Read the parameter card using key/value pairs -* - open(lun,file=file,status='old') - do i=1,maxln - read(lun,1000,end=10) key,value - if (trim(key).eq."IBEG") ibeg=value - if (trim(key).eq."IEND") iend=value - if (trim(key).eq."NGEN") ngen=value - if (trim(key).eq."NTRT") ntreat=value - if (trim(key).eq."PRVG") nprin=value - if (trim(key).eq."NCVG") ncvg=value - if (trim(key).eq."ITVG") itmx=value - if (trim(key).eq."NCSG") npoin=value - if (trim(key).eq."INPP") inpp=value - if (trim(key).eq."PMOD") pmod=value - if (trim(key).eq."GPDF") gpdf=value - if (trim(key).eq."SPDF") spdf=value - if (trim(key).eq."INPE") inpe=value - if (trim(key).eq."EMOD") emod=value - if (trim(key).eq."PAIR") ipair=value - if (trim(key).eq."QPDF") nquark=value - if (trim(key).eq."MCUT") modcut=value - if (trim(key).eq."THMX") thmax=value - if (trim(key).eq."THMN") thmin=value - if (trim(key).eq."ECUT") ecut=value - if (trim(key).eq."PTCT") ptcutmin=value - if (trim(key).eq."PTMX") ptcutmax=value - if (trim(key).eq."Q2MN") q2mn=value - if (trim(key).eq."Q2MX") q2mx=value - if (trim(key).eq."MXMN") mxmn=value - if (trim(key).eq."MXMX") mxmx=value - enddo - 10 continue - close(lun) -* -*-------- Return -* - 1000 format(a4,d9.0) - return - end diff --git a/lpair_2diss/desy/source/gmufil.f b/lpair_2diss/desy/source/gmufil.f deleted file mode 100644 index 751783d..0000000 --- a/lpair_2diss/desy/source/gmufil.f +++ /dev/null @@ -1,483 +0,0 @@ - SUBROUTINE GMUFIL -C -C THIS SUBROUTINE SHOULD FILL THE GTR-BANK -C - IMPLICIT none - - DOUBLE PRECISION ulmass - DOUBLE PRECISION ulmq,ulmdq - DOUBLE PRECISION pmxp,ranmxp,ranmxt - DOUBLE PRECISION gmuselx - INTEGER ncall,nextw,nfracs,nfrac3,nterm3,ninit,nfinal,npout - INTEGER ipq,ipdq,i2line - INTEGER i,j - - REAL*4 PI2 - PARAMETER (PI2=2.0*3.14159265) -*KEEP,INPU. - REAL*8 ME,MU,MP,MX,S,SQ,PE,PP,EE,EP,CONST,PI - COMMON /INPU/ME,MU,MP,MX,S,SQ,PE,PP,EE,EP,CONST,PI - save /inpu/ - -*KEND. - REAL*8 E,E1,E2,E3,E4,E5,P1, - & P3,P4,P5,CT3,ST3,CT4,ST4,CT5, - & ST5,CP3,SP3,CP5,SP5 - COMMON /VARIAB/E,E1,E2,E3,E4,E5,P1, - & P3,P4,P5,CT3,ST3,CT4,ST4,CT5, - & ST5,CP3,SP3,CP5,SP5 - REAL*8 E6,E7,P6,P7,CT6,ST6,CT7,ST7,CP6,SP6,CP7,SP7,W - COMMON /VARIAD/ E6,E7,P6,P7,CT6,ST6,CT7,ST7,CP6,SP6,CP7,SP7,W - REAL*8 S1,S2,T1,T2 - COMMON /EXTRA/ S1,S2,T1,T2 -*KEEP,LTCOM. - REAL*8 GAMMA,BETGAM - COMMON /LTCOM/ GAMMA,BETGAM - save /variab/,/variad/,/extra/ - -*KEEP,XQCOM. - INTEGER IUSEDF - DOUBLE PRECISION XQ,EQ,PQ,MQ, - & QSCALE,XDENS(-6:2), - & PSEA,PVALD - COMMON /XQCOM/ XQ,EQ,PQ,MQ, - & QSCALE,XDENS, - & PSEA,PVALD,IUSEDF - -*KEEP,BEAM. - INTEGER INTGE,INTGP,GPDF,SPDF,PMOD,EMOD,IPAIR,NQUARK - REAL*8 INPE,INPP - COMMON /BEAM/ INPE,INPP,INTGE,INTGP,GPDF,SPDF,PMOD,EMOD, - & IPAIR,NQUARK - save /beam/ - -*KEEP,KINVAR. - REAL*8 GMUX,GMUY,GMUW,GMUNU - COMMON /KINVAR/ GMUX,GMUY,GMUW,GMUNU - save /kinvar/ -*KEND. - INTEGER NLIMAX - PARAMETER (NLIMAX=13) - REAL*4 PL(4,NLIMAX),PMXDA(4) -C -C LUND COMMON <=================================================== - double precision kchg,pmas,parf,vckm - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - DOUBLE PRECISION P(4000,5),V(4000,5) - INTEGER N,K(4000,5), npad - COMMON/PYJETS/N, npad, K, P, V - save /pyjets/ -C - INTEGER NLINES - REAL*8 PLAB(4,9) - REAL*4 RANPHI,SINPHI,COSPHI,RANY,RANUDQ -C INFORMATION FOR JETSET PACKAGE <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - INTEGER njoin - PARAMETER(NJOIN=2) - INTEGER JLPSF(NJOIN),JLVAL(NJOIN),JLSEA1(NJOIN),JLSEA2(NJOIN) - DATA JLPSF/10,11/ - DATA JLVAL/2,7/ - DATA JLSEA1/4,9/ - DATA JLSEA2/2,3/ - LOGICAL LSEA,LVAL - save jlpsf,jlval,jlsea1,jlsea2 -*KEEP,PARTIC. - INTEGER I2STAT(13),I2PART(13), - & I2MO1(13),I2DA1(13),I2DA2(13) - COMMON /PARTIC/ I2LINE,I2STAT,I2PART,I2MO1,I2DA1,I2DA2 -*KEND. -C - real *8 pairm - common /gmulpm/ pairm - save /gmulpm/ -C - REAL*4 I2MASS(NLIMAX) - DATA I2MASS/NLIMAX*-9999.9/ -C - DATA NCALL/0/ - DATA NFRAC3/0/ - DATA NTERM3/0/ - DATA NEXTW/1/ - save ncall,nfrac3,nterm3,nextw - real ran2 - integer idum - data idum/-1/ -C - NFRACS=0 -C - NLINES=9 - NFINAL=0 - NINIT =0 -C -C LORENZ TRANFORMATION AND COMPUTING OF INTRMED PARTICLES <====== -C PARTICLE 1 = "PROTON" <================== - PLAB(1,1)=0.0 - PLAB(2,1)=0.0 - PLAB(3,1)=GAMMA*P1 + BETGAM*E1 - PLAB(4,1)=GAMMA*E1 + BETGAM*P1 -C PARTICLE 2 = ELEKTRON IN <================ - PLAB(1,2)=0.0 - PLAB(2,2)=0.0 - PLAB(3,2)= -GAMMA*P1 + BETGAM*E2 - PLAB(4,2)= GAMMA*E2 - BETGAM*P1 -C PARTICLE 9 = ELEKTRON OUT <=============== - PLAB(1,9)=P5*ST5*CP5 - PLAB(2,9)=P5*ST5*SP5 - PLAB(3,9)=GAMMA*CT5*P5 + BETGAM * E5 - PLAB(4,9)=GAMMA * E5 + BETGAM*CT5*P5 -c print *,'electron :', p5*p5-e5*e5,gamma,betgam -c print *,PLAB(4,9)**2-PLAB(3,9)**2-PLAB(2,9)**2-PLAB(1,9)**2 -C PARTICLE 4 = GAMMA_E <================== - PLAB(1,4)=PLAB(1,2)-PLAB(1,9) - PLAB(2,4)=PLAB(2,2)-PLAB(2,9) - PLAB(3,4)=PLAB(3,2)-PLAB(3,9) - PLAB(4,4)=PLAB(4,2)-PLAB(4,9) -C PARTICLE 5 = QUARK OUT <================== - PLAB(1,5)=P3*ST3*CP3 - PLAB(2,5)=P3*ST3*SP3 - PLAB(3,5)=GAMMA*CT3*P3 + BETGAM * E3 - PLAB(4,5)=GAMMA * E3 + BETGAM*CT3*P3 -C PARTICLE 3 = GAMMA_P <================== - PLAB(1,3)=PLAB(1,1)-PLAB(1,5) - PLAB(2,3)=PLAB(2,1)-PLAB(2,5) - PLAB(3,3)=PLAB(3,1)-PLAB(3,5) - PLAB(4,3)=PLAB(4,1)-PLAB(4,5) -C PARTICLE 6 = MUON1 <================== - PLAB(1,6)=P6*ST6*CP6 - PLAB(2,6)=P6*ST6*SP6 - PLAB(3,6)=GAMMA*CT6*P6 + BETGAM * E6 - PLAB(4,6)=GAMMA * E6 + BETGAM*CT6*P6 -C PARTICLE 7 = MUON1->2 <================== - PLAB(1,7)=PLAB(1,3)-PLAB(1,6) - PLAB(2,7)=PLAB(2,3)-PLAB(2,6) - PLAB(3,7)=PLAB(3,3)-PLAB(3,6) - PLAB(4,7)=PLAB(4,3)-PLAB(4,6) -C PARTICLE 8 = MUON2 <================== - PLAB(1,8)=P7*ST7*CP7 - PLAB(2,8)=P7*ST7*SP7 - PLAB(3,8)=GAMMA*CT7*P7 + BETGAM * E7 - PLAB(4,8)=GAMMA * E7 + BETGAM*CT7*P7 - -c----> Lepton pair mass - pairm=sqrt( - & ((PLAB(4,3)+PLAB(4,4))**2-(PLAB(3,3)+PLAB(3,4))**2) - & -((PLAB(1,3)+PLAB(1,4))**2+(PLAB(2,3)+PLAB(2,4))**2) - & ) -c print *,'Leptons pair mass =',pairm,'GeV' - -C====> SET KINEMATIC VARIABLES FOR GKI <============ - GMUX= -T2 /(EP*PLAB(4,4)-PP*PLAB(3,4))/2.0D0 - GMUY= (EP*PLAB(4,4)-PP*PLAB(3,4))/ - & (EE*PLAB(4,4)+PE*PLAB(3,4)) - GMUW = (EP+PLAB(4,4))**2 - (PP+PLAB(3,4))**2 -! gmuw =((EP-PP)+(PLAB(4,4)-PLAB(3,4)))* -! & ((EP+PP)+(PLAB(4,4)+PLAB(3,4))) - IF (GMUW .GE. 0) THEN - GMUW=SQRT(GMUW) - ELSE - WRITE(6,*) ' GMUFIL : NEGATIV W**2 COMPUTED : GENW**2 = ', GMUW - & ,' GENW IS SET TO 0 ' - print *,'plab(1)',(plab(j,1),j=1,4) - print *,'plab(9)',(plab(j,9),j=1,4) - print *,'gamma',gamma,betgam - print *,'p,e,s,c',p5,e5,st5,cp5 - GMUW=0.0 - ENDIF - GMUNU= GMUY*2.0*ULMASS(2212)/EP/EE -C===> RANDOM REFLECTION AT XZ-PLAIN <================== - IF (ran2(idum) .GE. 0.5) THEN - RANY=-1.0 - ELSE - RANY=1.0 - ENDIF -C===> RANDOM ROTATION AT Z-AXIS <===================== - RANPHI=PI2*ran2(idum) - SINPHI=SIN(RANPHI) - COSPHI=COS(RANPHI) -C====> ROTATE, REFELECT AND TRANSFORM TO REAL*4 VALUES <============= - DO 100 I=1,9 - PL(1,I) = SNGL(PLAB(1,I))*COSPHI + RANY*SNGL(PLAB(2,I))*SINPHI - PL(2,I) =-SNGL(PLAB(1,I))*SINPHI + RANY*SNGL(PLAB(2,I))*COSPHI - PL(3,I) = SNGL(PLAB(3,I)) - PL(4,I) = SNGL(PLAB(4,I)) -c print *,'Particle',I,'P=',(PL(j,I),j=1,4) - 100 CONTINUE - -c print *,'after rotation:' -c print *,PL(4,9)**2-PL(3,9)**2-PL(2,9)**2-PL(1,9)**2 -C===> RANDOM DISTRIBUTION OF LEPTON+ AND LEPTON- <=========== - IF (RAN2(idum) .LT. 0.5) THEN - I2PART(6) = IPAIR - I2PART(7) =-IPAIR - I2PART(8) =-IPAIR - ELSE - I2PART(6) =-IPAIR - I2PART(7) = IPAIR - I2PART(8) = IPAIR - ENDIF -C===> SELECTION OF HADRON MODE IN PARTON MODEL <================ - LVAL=.FALSE. - LSEA=.FALSE. - IF (PMOD .EQ. 101) THEN - LVAL=.TRUE. - ELSEIF (PMOD .EQ. 102) THEN - LSEA=.TRUE. - ELSEIF (PMOD .EQ. 103) THEN - IF (ran2(idum) .GT. PSEA) THEN - LVAL=.TRUE. - ELSE - LSEA=.TRUE. - ENDIF - ENDIF - -c print *,'LVAL=',LVAL,', LSEA=',LSEA -C===> add. Particles for Val.Quark scatering in Parton model <===== - IF (LVAL) THEN - NINIT =2 -C===> ADD INITIAL PROTON <==== - I2STAT(10)=21 - I2PART(10)=2212 - I2MO1(10)=0 - I2DA1(10)=2 - I2DA2(10)=3 -C====> CORRECT PART 1 <=== - I2MO1(1)=10 -C====> ADD DIQUARK <==== - I2STAT(11)=1 - I2MO1(11)=1 - I2DA1(11)=0 - I2DA2(11)=0 -C===> RANDOM SELECTION OF U AND D QUARKS <== - RANUDQ=ran2(idum) - IF (RANUDQ .LT. PVALD) THEN - I2PART(1)=1 - I2PART(11)=2203 - I2PART(5)=1 - ELSEIF (RANUDQ .LT. 0.5+0.5*PVALD) THEN - I2PART(1)=2 - I2PART(11)=2101 - I2PART(5)=2 - ELSE - I2PART(1)=2 - I2PART(11)=2103 - I2PART(5)=2 - ENDIF - IUSEDF=I2PART(1) -C==> SET MASSES <============= - I2MASS(1)=SNGL(MQ) - I2MASS(11)=ULMASS(I2PART(11)) - I2MASS(10)=ULMASS(2212) -C==> SET MOMENTA <============ - PL(1,10)=0.0 - PL(2,10)=0.0 - PL(3,10)=SNGL(PP) - PL(4,10)=SNGL(EP) - PL(1,11)=0.0 - PL(2,11)=0.0 - PL(3,11)=SNGL(PP-PQ) - PL(4,11)=PL(4,10)-PL(4,1) -C???> computed energy may be in conflict to mass !!!! ???????? -C -C===> add. Particles for SEA Quark scatering in Parton model <===== - ELSEIF (LSEA) THEN - NINIT =4 -C===> ADD INITIAL PROTON <==== - I2STAT(10)=21 - I2PART(10)=2212 - I2MO1(10)=0 - I2DA1(10)=2 - I2DA2(10)=5 -C====> ADD PART CODE FOR ADD PARTICLES <====== - DO 234 I=11,13 - I2DA1(I)=0 - I2DA2(I)=0 - I2MO1(I)=1 - I2STAT(I)=1 - 234 CONTINUE -C====> CORRECT PART 1<=== - I2MO1(1)=1 -C===> SET SCATTERED QUARK AND HIS ANTI QUARK <== - IF (NQUARK .NE. 12) THEN - I2PART(1)=NQUARK - ELSE - IF (ran2(idum) .LT. 0.2) THEN - I2PART(1)=1 - ELSE - I2PART(1)=2 - ENDIF - ENDIF - IUSEDF=I2PART(1) - IF (ran2(idum) .LE. 0.5) THEN - I2PART(12)=-I2PART(1) - ELSE - I2PART(12)=I2PART(1) - I2PART(1)=-I2PART(1) - ENDIF - I2PART(5)=I2PART(1) -C===> ADD QUARK AND DIQUARK FROM P <== - IF (I2PART(1) .LT. 0) THEN - IPQ=13 - IPDQ=11 - ELSE - IPQ=11 - IPDQ=13 - ENDIF - RANUDQ=ran2(idum) - IF (RANUDQ .LT. 1.0/3.0) THEN - I2PART(IPQ)=1 - I2PART(IPDQ)=2203 - ELSEIF (RANUDQ .LT. 2.0/3.0) THEN - I2PART(IPQ)=2 - I2PART(IPDQ)=2101 - ELSE - I2PART(IPQ)=2 - I2PART(IPDQ)=2103 - ENDIF -C==> SET MASSES <============= - I2MASS(1)=SNGL(MQ) - I2MASS(5)=SNGL(MQ) - I2MASS(12)=SNGL(MQ) - I2MASS(13)=ULMASS(I2PART(13)) - I2MASS(11)=ULMASS(I2PART(11)) - I2MASS(10)=ULMASS(2212) -C==> SET MOMENTA <============= - PL(1,10)=0.0 - PL(2,10)=0.0 - PL(3,10)=SNGL(PP) - PL(4,10)=SNGL(EP) - PL(1,12)=0.0 - PL(2,12)=0.0 -clf PL(3,12)=GMUSELX(-IABS(IUSEDF),QSCALE)*PP - PL(4,12)=SQRT(PL(3,12)**2+I2MASS(12)**2) - PL(1,IPQ)=0.0 - PL(2,IPQ)=0.0 -clf PL(3,IPQ)=GMUSELX(I2PART(IPQ),QSCALE)*PP - PL(4,IPQ)=SQRT(PL(3,IPQ)**2+I2MASS(IPQ)**2) - PL(1,IPDQ)=0.0 - PL(2,IPDQ)=0.0 - PL(3,IPDQ)=PL(3,10)-PL(3,1)-PL(3,IPQ)-PL(3,12) - PL(4,IPDQ)=PL(4,10)-PL(4,1)-PL(4,IPQ)-PL(4,12) - ENDIF -C -C FOR INELASTIC MODE WITH STRUCTURE FUNCTIONS BUILD <======== -C HADRONIC SYSTEM USING LUND SHOWER MC. -C - IF (PMOD.GE.10 .AND. PMOD.LE.99) THEN - NFINAL=2 -C====> INSERT THE MASS OF THE HADRONIC SYSTEM <================== - I2MASS(5)=SNGL(MX) -C===> RANDOM SELECTION OF U , D AND DI QUARKS <=========== - RANUDQ=ran2(idum) - IF (RANUDQ .LT. 1.0/9.0) THEN - I2PART(10)=1 - I2PART(11)=2203 - ELSEIF (RANUDQ .LT. 5.0/9.0) THEN - I2PART(10)=2 - I2PART(11)=2101 - ELSE - I2PART(10)=2 - I2PART(11)=2103 - ENDIF - ULMDQ=ULMASS(I2PART(11)) - ULMQ =ULMASS(I2PART(10)) -C====> SET OF LUND CODES <==================================== - I2MO1(10)=5 - I2DA1(10)=0 - I2DA2(10)=0 - I2STAT(10)=1 - I2MO1(11)=5 - I2DA1(11)=0 - I2DA2(11)=0 - I2STAT(11)=1 -C====> CHOOSE RANDOM DIRECTION IN MX FRAME <=================== - RANMXP=PI2*ran2(idum) - RANMXT=ACOS(2.0*ran2(idum)-1.0) -C====> COMPUTE MOMENTUM OF DECAY PARTICLE FROM MX <============= - PMXP=(MX**2-ULMDQ**2+ULMQ**2)**2/4.0/MX/MX - ULMQ**2 - if (pmxp.lt.0) return !FIXME FIXME FIXME FIXME !!!!!!!! - pmxp=dsqrt(pmxp) -c print *,ulmdq,ulmq,mx,pmxp, -c + (MX**2-ULMDQ**2+ULMQ**2)**2/4.0/MX/MX-ULMQ**2 -C=====> BUILD 4-VECTORS AND BOOST DECAY PARTICLES <=============== - PMXDA(1)=SIN(RANMXT)*COS(RANMXP)*PMXP - PMXDA(2)=SIN(RANMXT)*SIN(RANMXP)*PMXP - PMXDA(3)=COS(RANMXT)*PMXP - PMXDA(4)=SQRT(PMXP**2+ULMDQ**2) -c PRINT *,' GMUFIL : PMXDA BEFORE LB:',(PMXDA(I),I=1,4) - CALL LORENB(I2MASS(5),PL(1,5),PMXDA(1),PL(1,11)) -c PRINT *,' GMUFIL : PL(11) AFTER LB:',(PL(I,11),I=1,4) - PMXDA(1)=-PMXDA(1) - PMXDA(2)=-PMXDA(2) - PMXDA(3)=-PMXDA(3) - PMXDA(4)=SQRT(PMXP**2+ULMQ**2) -c PRINT *,' GMUFIL : PMXDA BEFORE LB:',(PMXDA(I),I=1,4) - CALL LORENB(I2MASS(5),PL(1,5),PMXDA(1),PL(1,10)) - ENDIF -C====> PREPARE THE LUND COMMON <================================ - 10 CONTINUE -c print *,'before lunset, NLINES=',NLINES,', NINIT=',NINIT, -c + ', NFINAL=',NFINAL - CALL LUNSET(NLINES+NINIT+NFINAL) -C ====> FILLING THE LUND COMMON <================================ - DO 200 I=1+NLINES,NINIT+NLINES -C SET MOTHER/DAUGHTER VALUES, MARKING PARTICLES AS DECAYED <======= - CALL LUKSET(I-NLINES,I2STAT(I),I2PART(I), - & I2MO1(I),I2DA1(I),I2DA2(I),0) -C SET PULS, ENERGY AND MASS OFF THE PARTICLES <================== - CALL LUPSET(I-NLINES,PL(1,I),PL(2,I),PL(3,I),PL(4,I),I2MASS(I)) - 200 CONTINUE - DO 201 I=1,NLINES+NFINAL -C SET MOTHER/DAUGHTER VALUES, MARKING PARTICLES AS DECAYED <======= - CALL LUKSET(I+NINIT,I2STAT(I),I2PART(I), - & I2MO1(I),I2DA1(I),I2DA2(I),NINIT) -C SET PULS, ENERGY AND MASS OF THE PARTICLES <================== - CALL LUPSET(I+NINIT,PL(1,I),PL(2,I),PL(3,I),PL(4,I),I2MASS(I)) -c IF(I.EQ.9) THEN -c PRINT *,I,I2MASS(I),(PL(J,I),J=1,4) -c ENDIF - 201 CONTINUE -C PUTTING QUARK AND DIQUARK TO A COLOR SINGLET <====================== - IF (LVAL) CALL LUJOIN(NJOIN,JLVAL) - IF (LSEA) THEN - CALL LUJOIN(NJOIN,JLSEA1) - CALL LUJOIN(NJOIN,JLSEA2) - ENDIF -c DO 1024, J=1,11 -c print *,'I=',J,'STATUS=',I2STAT(J) -c 1024 CONTINUE -c print *,'Before LUJOIN================================' -c CALL LULIST(2) - IF (PMOD.GE.10 .AND. PMOD.LE.99) CALL LUJOIN(NJOIN,JLPSF) -C EXECUTE LUND FRAGMENTATION PROGRAM <============================== -c print *,'Before LUEXEC================================' -c call LULIST(2) - CALL LUEXEC -c print *,'After LUEXEC================================' -clf CALL LUEXEC -C Check wether the Hadronic system is inelastic <=================== - IF (PMOD.GE.10 .AND. PMOD.LE.99) THEN - NPOUT=0 - DO 300 I=1,N - IF (K(I,1) .EQ. 1) NPOUT=NPOUT+1 ! History code (KH=1 = mother particle) - 300 CONTINUE - NFRAC3=NFRAC3+1 - NFRACS=NFRACS+1 - IF (NPOUT .EQ. 4 .AND. NFRACS .LE. 1000) GOTO 10 - IF (NFRACS .GT. 1000) NTERM3=NTERM3+1 - ENDIF - NCALL=NCALL+1 -c CALL LULIST(1) - IF (NCALL .GE. NEXTW) THEN - IF (PMOD.GE.10 .AND. PMOD.LE.99) THEN - WRITE(6,*) ' GMUFIL : NUMBER OF CALLS IS ',NCALL - & ,' PMOD 10-99: # FRAC TRY :',NFRAC3,' # FRAC TERM :' - & ,NTERM3 - ELSE -c WRITE(6,*) ' GMUFIL : NUMBER OF CALLS IS ',NCALL,' W',GMUW, -c & pairm - ENDIF - CALL LULIST(2) - NEXTW=NEXTW*2 - ENDIF -!- CALL LUHEPC(1) - END diff --git a/lpair_2diss/desy/source/gmugna.f b/lpair_2diss/desy/source/gmugna.f deleted file mode 100644 index 0e764c7..0000000 --- a/lpair_2diss/desy/source/gmugna.f +++ /dev/null @@ -1,158 +0,0 @@ -*-- Author : - SUBROUTINE GMUGNA -C -C MODIFICATION FROM VERMASERENS GENERA -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - EXTERNAL F -*KEEP,VEGPAR. - INTEGER NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - COMMON /VEGPAR/ NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - SAVE /vegpar/ - -*KEEP,COMGNA. - INTEGER NGNA - COMMON /COMMUP/ NGNA - SAVE /commup/ -*KEND. -C - COMMON/VGMAXI/MDUM,MBIN,FFMAX,FMAX(7000),NM(7000) - SAVE /vgmaxi/ - DIMENSION X(10),N(10) - SAVE x,n -C - SAVE WEIGHT,CORREC,J -C - SAVE CORRE2,FMDIFF,FMOLD,FMAX2 - real ran2 - integer idum - DATA j/0/ - data idum/-1/ -c -c -c - NGNA=NGNA+1 - IGNA = 0 -C - AMI=1.0D0/DBLE(MBIN) - MAX=MBIN**NDIM -C -C CORRECTION CYCLES ARE STARTED <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - IF (J .NE. 0) THEN -! print *,'gmugna: correction',j,correc,corre2 - 4 CONTINUE - IF (CORREC .LT. 1.0)THEN - IF(ran2(idum) .GE. CORREC) GOTO 7 - CORREC=-1.0 - ELSE - CORREC=CORREC-1.0 - ENDIF -C -C SEL X VALUES IN VEGAS BIN <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - DO 6 K=1,NDIM - X(K)=(ran2(idum)+N(K))*AMI -! if(x(k).lt.0.or.x(k).gt.1) then -! print *,'correction, X',x(k),k -! endif - 6 CONTINUE -C -C COMPUTE WEIGHT FOR X VALUES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - IF (NTREAT .GT. 0) WEIGHT=TREAT(F,X,NDIM) - IF (NTREAT .LE. 0) WEIGHT=F(X) -C -C PARAMETER FOR CORRECTION OF CORRECTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<< - IF(WEIGHT .GT. FMAX(J)) THEN - IF (WEIGHT .GT. FMAX2) FMAX2=WEIGHT - CORRE2=CORRE2-1.0 - CORREC=CORREC+1.0 - ENDIF -C -C ACCEPT EVENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - IF (WEIGHT .GE. FMDIFF*ran2(idum)+FMOLD) THEN -! print *,'gmugna: done',weight,' x',(x(ipr),ipr=1,NDIM) - RETURN - ENDIF - GOTO 4 -C -C CORRECTION IF TOO BIG WEIGHT IS FOUND WHILE CORRECTION <<<<<<<<<<<< - 7 CONTINUE - IF (FMAX2 .GT. FMAX(J)) THEN - FMOLD=FMAX(J) - FMAX(J)=FMAX2 - FMDIFF=FMAX2-FMOLD -! print *,'using CORRE2',corre2 - IF(FMAX2 .LE. FFMAX) THEN - CORREC=(NM(J)-1.0)*FMDIFF/FFMAX-CORRE2 - ELSE - FFMAX=FMAX2 - CORREC=(NM(J)-1.0)*FMDIFF/FFMAX*FMAX2/FFMAX-CORRE2 - ENDIF - CORRE2=0.0 - FMAX2=0.0 - GOTO 4 - ELSE -c print *,'Did not go to 4' - IGNA=1 - ENDIF - ENDIF -C -C NORMAL GENERATION CYCLE STARTS HERE !!!!!!! ******************* -C -! print *,'gmugna: generation',IGNA - -C SEL A VEGAS BIN AND REJECT IF FMAX IS TOO LITTLE <<<<<<<<<<<<<<<<<<<< - - 1 CONTINUE - J=ran2(idum)*MAX+1. - Y=ran2(idum)*FFMAX - NM(J)=NM(J)+1 - IF(Y.GT.FMAX(J)) GOTO 1 - -C -C SEL X VALUES IN THIS VEGAS BIN <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - JJ=J-1 - DO 2 K=1,NDIM - JJJ=JJ/MBIN - N(K)=JJ-JJJ*MBIN - X(K)=(ran2(idum)+N(K))*AMI -! if(x(k).lt.0.or.x(k).gt.1) then -! print *,'correction, X',x(k),k -! endif - JJ=JJJ - 2 CONTINUE -C -C GET WEIGHT FOR SEL X VALUES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - IF(NTREAT.GT.0) THEN - WEIGHT=TREAT(F,X,NDIM) - ELSE - WEIGHT=F(X) - ENDIF - -C REJECT IF WEIGHT IS TOO LOW <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - IF(Y .GT. WEIGHT)GO TO 1 - IF(WEIGHT .LE. FMAX(J)) THEN - J=0 -C -C INIT CORRECTION CYCLES IF WEIGHT IS HIGHER THEN FMAX OR FFMAX <<<<<< - ELSE IF(WEIGHT .LE. FFMAX) THEN - FMOLD=FMAX(J) - FMAX(J)=WEIGHT - FMDIFF=WEIGHT-FMOLD - CORREC=(NM(J)-1.0)*FMDIFF/FFMAX-1.0 -! print *,'need correction of FFMAX',weight,ffmax,correc - ELSE - FMOLD=FMAX(J) - FMAX(J)=WEIGHT - FMDIFF=WEIGHT-FMOLD - FFMAX=WEIGHT - CORREC=(NM(J)-1.0)*FMDIFF/FFMAX*WEIGHT/FFMAX-1.0 -! print *,'need correction of FMAX',j,weight,ffmax,correc - ENDIF -C -C RETURN WITH AN ACCEPTED EVENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -c print *,'gmugna: done',weight,' x',(x(ipr),ipr=1,NDIM) - - RETURN - END diff --git a/lpair_2diss/desy/source/gmuini.f b/lpair_2diss/desy/source/gmuini.f deleted file mode 100644 index 02ff56f..0000000 --- a/lpair_2diss/desy/source/gmuini.f +++ /dev/null @@ -1,91 +0,0 @@ -*-- Author : ZEUS Offline Group 18/08/94 - SUBROUTINE GMUINI - - Implicit NONE - -C #################################################################### -C # SET DEFAULT PARAMETERS OF THE GENERATOR. # -C #################################################################### - - Real PI - PARAMETER (PI=3.141592654) - -*KEEP,VEGPAR. - INTEGER NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - COMMON /VEGPAR/ NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - save /vegpar/ - -*KEEP,BEAM. - INTEGER INTGE,INTGP,GPDF,SPDF,PMOD,EMOD,IPAIR,NQUARK - REAL*8 INPE,INPP - COMMON /BEAM/ INPE,INPP,INTGE,INTGP,GPDF,SPDF,PMOD,EMOD, - & IPAIR,NQUARK - save /beam/ - -*KEEP,CUTS. - INTEGER MODCUT - REAL*4 THMAX,THMIN,MXMN,MXMX,Q2MN,Q2MX - REAL*8 COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & QP2MIN,QP2MAX - COMMON /CUTS/COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & THMAX,THMIN,QP2MIN,QP2MAX,MODCUT,MXMN,MXMX,Q2MN,Q2MX - save /cuts/ -*KEND. -* -* PULS OF INCOMING PROTON AND ELECTRON - INPE = 26.7D0 - INPP = 820.0D0 -* -* MODE OF INCOMING PROTON AND ELECTRON - EMOD = 1 - PMOD = 2 - NQUARK = 12 -* -* CODE OF THE PRODUCED LEPTON PAIR - Electron pair default - IPAIR = 11 -* -* START AND STOP POINT OF THE GENERATOR PROGRAMM (1-3 = WHOLE RUN) - IBEG = 1 - IEND = 3 - NGEN = 100 -* -* NUMBER OF CALLS PER VEGAS ITERRATION - NCVG = 14000 -* -* NUMBER OF VEGAS ITERRATIONS - ITMX = 10 -* -* VEGAS PRINT PARAMETER - NPRN = 1 - IGRAPH = 0 -* -* NUMBER CALL PER BIN IN SETGEN (NR. OF BINS IS 3**8=6561 OR 3**7=2187) - NPOIN = 100 -* -* VEGAS PRINT FLAG AND STRATEGY NUMBER - NPRIN = 1 - NTREAT = 1 -* -C MODCUT : MODE FOR CUT 0=NO; 1=VERMASEREN DET; 2=GIVEN PARAMETER <== - MODCUT = 2 -C THMIN,THMAX : MIN AND MAX THETA OF BOTH MUONS <==================== - THMIN = 5.0 - THMAX = 175.0 -C ECUT : MIN. ENERGY OF BOTH MUONS <============================ - ECUT = 1.0D0 -C PTCUT : MIN. AND MAX. TRANSVERS MOMENT OF BOTH MUONS <================== - PTCUTMIN = 0.5D0 - PTCUTMAX = 1.0D5 -C GPDF, SPDF : DEFAULT PDF GRV LO <====== - GPDF = 5 - SPDF = 4 -C MXMN, MXMX : GIVE THE LIMITS FOR THE MASS IM FINAL HADRONIC SYSTEM - MXMN = 1.070 - MXMX = 320.0 -C Q2MN, Q2MX : GIVE THE LIMITS FOR ABS(Q**2) AT THE PROTON SIDE - Q2MN = 0.0 - Q2MX = 1E5 - RETURN - END diff --git a/lpair_2diss/desy/source/gmulhe.f b/lpair_2diss/desy/source/gmulhe.f deleted file mode 100644 index 1a8cae5..0000000 --- a/lpair_2diss/desy/source/gmulhe.f +++ /dev/null @@ -1,70 +0,0 @@ - subroutine gmulhe - - implicit none - - integer i,j -* === Run common block - integer MAXPUP - parameter ( MAXPUP=100 ) - integer IDBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP, LPRUP - double precision EBMUP, XSECUP, XERRUP, XMAXUP - common/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - + IDWTUP, NPRUP, XSECUP(MAXPUP), XERRUP(MAXPUP), - + XMAXUP(MAXPUP), LPRUP(MAXPUP) - save /HEPRUP/ -* === Event information - integer MAXNUP - parameter ( MAXNUP=500 ) - integer NUP, IDPRUP, IDUP, ISTUP, MOTHUP, ICOLUP - double precision XWGTUP, SCALUP, AQEDUP, AQCDUP, - + PUP, VTIMUP, SPINUP - common/HEPEUP/ NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP, - + IDUP(MAXNUP), ISTUP(MAXNUP), MOTHUP(2,MAXNUP), - + ICOLUP(2,MAXNUP), PUP(5,MAXNUP), VTIMUP(MAXNUP), - + SPINUP(MAXNUP) - save /HEPEUP/ -* === Kinematic information from JETSET - integer n,k, npad - double precision p,v - common /pyjets/ N, npad, K(4000,5), P(4000,5), V(4000,5) -* === - integer MSTP, MSTI - double precision PARP, PARI - common/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - save /PYPARS/ -* -c integer nstable -* -* -c nstable = 0 -* -* === Event filling - NUP = N ! number of particle entries in the event - IDPRUP = 1 ! ID of the process for the event - XWGTUP = 1. ! event weight - SCALUP = -1. ! scale of the event in GeV, as used for calculation of PDFs - AQEDUP = -1. ! the QED coupling used for this event - AQCDUP = -1. ! the QCD coupling used for this event -* - do 10 i=1,N - IDUP(i) = K(i,2) ! particle ID according to Particle Data Group convention - ISTUP(i) = 0 ! status code - MOTHUP(1,i) = 0 ! index of first and last mother - MOTHUP(2,i) = 0 - ICOLUP(1,I) = 0 ! integer tag for the color flow line passing through the color of the - ! particle - ICOLUP(2,I) = 0 ! integer tag for the color flow line passing through the anti-color of - ! the particle - do 11 j=1,5 - PUP(j,i) = P(i,j) ! lab frame momentum (Px, Py, Pz, E, M) of particle in GeV - 11 continue - - VTIMUP(i) = 0. ! invariant lifetime c*tau (distance from production to decay) in mm - SPINUP(i) = 0. ! cosine of the angle between the spin-vector of particle I and the 3- - ! momentum of the decaying particle, specified in the lab frame - 10 continue -c print *,nstable -* -c call pylhef -* - end diff --git a/lpair_2diss/desy/source/gmupsg.f b/lpair_2diss/desy/source/gmupsg.f deleted file mode 100644 index d949b1c..0000000 --- a/lpair_2diss/desy/source/gmupsg.f +++ /dev/null @@ -1,132 +0,0 @@ -*-- Author : ZEUS Offline Group 18/08/94 - - SUBROUTINE GMUPSG - -*#********************************************************************** -*# -*# SUBROUTINE GMUPSG -*# -*# PURPOSE: GET ALL BEAM AND CUT PARAMETER FROM SETGEN INPUT FILE -*# -*# -*# INPUT: SETGEN FILE ; COMMON CUTS, BEAM, VEGPAR -*# -*# OUTPUT: -*# -*# CALLED BY: GMUBEG -*# -*# AUTHOR: OLAF DUENGER CREATED AT: 92/02/05 -*# -*# CHANGED BY: AT: -*# REASON: -*# -*#********************************************************************** - - IMPLICIT NONE - -*KEEP,VEGPAR. - INTEGER NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - COMMON /VEGPAR/ NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - -*KEEP,BEAM. - INTEGER INTGE,INTGP,GPDF,SPDF,PMOD,EMOD,IPAIR,NQUARK - REAL*8 INPE,INPP - COMMON /BEAM/ INPE,INPP,INTGE,INTGP,GPDF,SPDF,PMOD,EMOD, - & IPAIR,NQUARK - -*KEEP,CUTS. - INTEGER MODCUT - REAL*4 THMAX,THMIN,MXMN,MXMX,Q2MN,Q2MX - REAL*8 COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & QP2MIN,QP2MAX - COMMON /CUTS/COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & THMAX,THMIN,QP2MIN,QP2MAX,MODCUT,MXMN,MXMX,Q2MN,Q2MX - -*KEND. - - INTEGER LUN1,LUN2,LUN3,LUN4,LUN5 - COMMON/VGSAV/LUN1,LUN2,LUN3,LUN4,LUN5 - REAL EPSMAC,HINPE,HINPP,HTHMAX,HTHMIN,HECUT,HPTCUT - INTEGER HMPDF,HMCUT,HEMOD,HPMOD,HIPAIR,I - LOGICAL WRONG - -C---Determine the machine accuacy EPSMAC (D= 2.E-06) - EPSMAC = 0.5 - DO 33 I= 1, 100 - EPSMAC = EPSMAC * 0.5 - IF ((1.0+EPSMAC) .EQ. 1.0) GO TO 35 - 33 CONTINUE - EPSMAC = 1.0E-6 - 35 EPSMAC = 2.0 * EPSMAC - -C--- READ BEAM PARAMETER FROM SETGEN INPUT FILE - READ( LUN2,'(E16.3,E16.3,I2,I2,I2,I2)') - & HINPE,HINPP,HEMOD,HPMOD,HMPDF,HIPAIR - - WRONG=.FALSE. - -C----- CHECKING BEAM PARAMETER - IF (ABS(INPE-HINPE).GT. EPSMAC*(INPE+HINPE)) THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG INPE : FILE INPE =',HINPE - ENDIF - IF (ABS(INPP-HINPP).GT. EPSMAC*(INPP+HINPP)) THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG INPP : FILE INPP =',HINPP - ENDIF - IF (EMOD .NE. HEMOD) THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG EMOD : FILE EMOD =',HEMOD - ENDIF - IF (PMOD .NE. HPMOD) THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG PMOD : FILE PMOD =',HPMOD - ENDIF -* IF ((PMOD .GE. 100) .AND. (MPDF .NE. HMPDF)) THEN -* WRONG=.TRUE. -* WRITE(6,*)'SETGEN INPUT HAS WRONG MPDF : FILE MPDF =',HMPDF -* ENDIF - IF (IPAIR .NE. HIPAIR) THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG PAIR : FILE PAIR =',HIPAIR - ENDIF - -C--- READ CUT PARAMETER FROM SETGEN INPUT FILE - READ( LUN2,'(I1,E16.3,E16.3,E16.3,E16.3)') - & HMCUT,HTHMAX,HTHMIN,HECUT,HPTCUT - -C----- CHECKING CUT PARAMETER - IF (MODCUT .NE. HMCUT) THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG MCUT : FILE MCUT =',HMCUT - ENDIF - IF ((MODCUT .EQ. 2) .AND. - & (ABS(THMAX-HTHMAX).GT. EPSMAC*(THMAX+HTHMAX)))THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG THMX : FILE THMX =',HTHMAX - ENDIF - IF ((MODCUT .EQ. 2) .AND. - & (ABS(THMIN-HTHMIN).GT. EPSMAC*(THMIN+HTHMIN)))THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG THMN : FILE THMN =',HTHMIN - ENDIF - IF ((MODCUT .EQ. 2) .AND. - & (ABS(PTCUTMIN-HPTCUT).GT. EPSMAC*(PTCUTMIN+HPTCUT)))THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG PTCT : FILE PTCT =',HPTCUT - ENDIF - IF ((MODCUT .EQ. 2) .AND. - & (ABS(ECUT-HECUT).GT. EPSMAC*(ECUT+HECUT)))THEN - WRONG=.TRUE. - WRITE(6,*)'SETGEN INPUT HAS WRONG ECUT : FILE ECUT =',HECUT - ENDIF - - IF (WRONG) THEN - WRITE(6,*) - & 'SETGEN INPUT FILE HAS DIFFERENT PARAMETER; PROGRAM STOPS !!!' - STOP - ENDIF - - END diff --git a/lpair_2diss/desy/source/grv_lo.f b/lpair_2diss/desy/source/grv_lo.f deleted file mode 100644 index abc9b33..0000000 --- a/lpair_2diss/desy/source/grv_lo.f +++ /dev/null @@ -1,249 +0,0 @@ - subroutine grv95lo(xpart,q2part,uv,dv,us,ds,ss,wg) - - - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - - - - amulo=0.23 - - argulo=0.232*0.232 - - rat1 = q2part/argulo - - rat2 = amulo/argulo - - s=log(log(rat1)/log(rat2)) - - s2=s*s - - s3=s2*s - - s12=sqrt(s) - - x1=1.-xpart - - x12=sqrt(xpart) - - x32=x12*xpart - - alx=log(1./xpart) - -c - -c-----uvalence - -c - - auv=0.59-0.024*s - - buv=0.131+0.063*s - - anuv=2.284+0.802*s+0.055*s2 - - aduv=-0.449-0.138*s-0.076*s2 - - bduv=0.213+2.669*s-0.728*s2 - - cduv=8.854-9.135*s+1.979*s2 - - dduv=2.997+0.753*s-0.076*s2 - -c------- - - ucoff=anuv*xpart**auv - - uwna=1.+aduv*xpart**buv+bduv*xpart+cduv*x32 - - xuv1=x1**dduv - - uv=ucoff*uwna*xuv1 - -c - -c-----dvalence - -c - - adv=0.376 - - bdv=0.486+0.062*s - - andv=0.371+0.083*s+0.039*s2 - - addv=-0.509+3.31*s-1.248*s2 - - bddv=12.41-10.52*s+2.267*s2 - - cddv=6.373-6.208*s+1.418*s2 - - dddv=3.691+0.799*s-0.071*s2 - -c----- - - dcoff=andv*xpart**adv - - dwna=1.+addv*xpart**bdv+bddv*xpart+cddv*x32 - - xdv1=x1**dddv - - dv=dcoff*dwna*xdv1 - -c - -c-----asymmetric sea - -c - - adel=0.409-0.005*s - - bdel=0.799+0.071*s - - andel=0.082+0.014*s+0.008*s2 - - addel=-38.07+36.13*s-0.656*s2 - - bddel=90.31-74.15*s+7.645*s2 - - cddel=0. - - dddel=7.486+1.217*s-0.159*s2 - -c---------------------------------- - - asymc=andel*xpart**adel - - awndel=1.+addel*xpart**bdel+bddel*xpart - - awndel=awndel+cddel*x32 - - del=asymc*awndel*x1**dddel - -c - -c-----symmetric sea - -c - - alphs=1.451 - - bets=0.271 - - as=0.41-0.232*s - - bs=0.534-0.457*s - - ads=0.89-0.14*s - - bds=-0.981 - - cds=0.32+0.683*s - - dds=4.752+1.164*s+0.286*s2 - - eds=4.119+1.713*s - - edprs=0.682+2.978*s - -c ----- - - awn1=xpart**as - - awn2=ads+bds*xpart+cds*xpart*xpart - - aw1=awn1*awn2*alx**bs - - awn3=exp(-eds+sqrt(edprs*s**bets*alx)) - - ws=(aw1+s**alphs*awn3)*x1**dds - -c------ - -c-----strange sea - -c------ - - alphss=0.914 - - betss=0.577 - - ass=1.798-0.596*s - - adss=-5.548+3.669*s12-0.616*s - - bdss=18.92-16.73*s12+5.168*s - - ddss=6.379-0.35*s+0.142*s2 - - edss=3.981+1.638*s - - edprss=6.402 - -c--------------------------------- - - ssc=s**alphss/alx**ass - - awn=1.+adss*x12+bdss*xpart - - sdlo=exp(-edss+sqrt(edprss*s**betss*alx)) - - ss=ssc*awn*x1**ddss*sdlo - -c - -c-----note that strange sea=ss=s+sbar - -c - -c-----nonstrange sea - -c - - us=(ws-del)/2. - - ds=(ws+del)/2. - -c - -c-----gluons - -c - - alphg=0.524 - - betg=1.088 - - ag=1.742-0.930*s - - bg=-0.399*s2 - - adg=7.486-2.185*s - - bdg=16.69-22.74*s+5.779*s2 - - cdg=-25.59+29.71*s-7.296*s2 - - ddg=2.792+2.215*s+0.422*s2-0.104*s3 - - edg=0.807+2.005*s - - edprg=3.841+0.316*s - -c ----- - - awn1=xpart**ag - - awn2=adg+bdg*xpart+cdg*xpart*xpart - - aw1=awn1*awn2*alx**bg - - awn3=exp(-edg+sqrt(edprg*s**betg*alx)) - - wg=(aw1+s**alphg*awn3)*x1**ddg - - - - return - - end diff --git a/lpair_2diss/desy/source/lorenb.f b/lpair_2diss/desy/source/lorenb.f deleted file mode 100644 index e82e2eb..0000000 --- a/lpair_2diss/desy/source/lorenb.f +++ /dev/null @@ -1,35 +0,0 @@ -* -* $Id: lorenb.F,v 1.1.1.1 1996/02/15 17:49:49 mclareni Exp $ -* -* $Log: lorenb.F,v $ -* Revision 1.1.1.1 1996/02/15 17:49:49 mclareni -* Kernlib -* -* - SUBROUTINE LORENB (U,PS,PI,PF) -C -C CERN PROGLIB# U102 LORENB .VERSION KERNFOR 4.04 821124 -C ORIG. 20/08/75 L.PAPE -C - DOUBLE PRECISION PF4, FN - DIMENSION PS(4),PI(4),PF(4) - - IF (PS(4).EQ.U) GO TO 17 - PF4 = (PI(4)*PS(4)+PI(3)*PS(3)+PI(2)*PS(2)+PI(1)*PS(1)) / U - FN = (PF4+PI(4)) / (PS(4)+U) - PF(1)= PI(1) + FN*PS(1) - PF(2)= PI(2) + FN*PS(2) - PF(3)= PI(3) + FN*PS(3) - PF(4)= PF4 - GO TO 18 -C - 17 PF(1)= PI(1) - PF(2)= PI(2) - PF(3)= PI(3) - PF(4)= PI(4) -C - 18 CONTINUE -C - RETURN -C - END diff --git a/lpair_2diss/desy/source/lukset.f b/lpair_2diss/desy/source/lukset.f deleted file mode 100644 index 8507ce7..0000000 --- a/lpair_2diss/desy/source/lukset.f +++ /dev/null @@ -1,23 +0,0 @@ -*-- Author : O. Duenger 14/11/91 -* - SUBROUTINE LUKSET(LINE,STATUS,PART,MOTH,DAUG1,DAUG2,NOFF) -*================================================================= - IMPLICIT NONE - INTEGER LINE,STATUS,PART,MOTH,DAUG1,DAUG2,NOFF -* -C---JETSET and GENOUT common - REAL P(4000,5),V(4000,5) - INTEGER N,K(4000,5) - COMMON/LUJETS/N,K,P,V -* - IF (LINE .GT. N) THEN - WRITE(6,*)' LUKSET : LINE TOO BIG; LINE=',LINE,' N=',N - RETURN - ENDIF -* - IF (STATUS .NE. -9999) K(LINE,1)=STATUS - IF (PART .NE. -9999) K(LINE,2)=PART - IF (MOTH. NE.-9999 .AND. MOTH .NE.0) K(LINE,3)=MOTH +NOFF - IF (DAUG1.NE.-9999 .AND. DAUG1.NE.0) K(LINE,4)=DAUG1+NOFF - IF (DAUG2.NE.-9999 .AND. DAUG2.NE.0) K(LINE,5)=DAUG2+NOFF - END diff --git a/lpair_2diss/desy/source/lunset.f b/lpair_2diss/desy/source/lunset.f deleted file mode 100644 index 2a5043a..0000000 --- a/lpair_2diss/desy/source/lunset.f +++ /dev/null @@ -1,25 +0,0 @@ -*-- Author : O. Duenger 19/12/91 -* - SUBROUTINE LUNSET(LINE) -*================================================================= - IMPLICIT NONE - INTEGER LINE,I,II -* -C---JETSET and GENOUT common - REAL P(4000,5),V(4000,5) - INTEGER N,K(4000,5) - COMMON/LUJETS/N,K,P,V -* - IF ((LINE .LT. 1) .OR. (LINE .GT. 4000)) THEN - WRITE(6,*) ' LUNSET : WRONG LINE, LINE =',LINE - RETURN - ENDIF -* - N=LINE -* - DO 100 I=1,5 - DO 200 II=1,N - V(II,I)=0.0 - 200 CONTINUE - 100 CONTINUE - END diff --git a/lpair_2diss/desy/source/lupset.f b/lpair_2diss/desy/source/lupset.f deleted file mode 100644 index 8434451..0000000 --- a/lpair_2diss/desy/source/lupset.f +++ /dev/null @@ -1,32 +0,0 @@ -*-- Author : O. Duenger 19/12/91 -* - SUBROUTINE LUPSET(LINE,PX,PY,PZ,E,M) -*================================================================= - IMPLICIT NONE - INTEGER LINE - REAL*4 PX,PY,PZ,E,M - REAL ulmass -* -C---JETSET and GENOUT common - REAL P(4000,5),V(4000,5) - INTEGER N,K(4000,5) - COMMON/LUJETS/N,K,P,V -* - IF (LINE .GT. N) THEN - WRITE(6,*) ' LUPSET : TOO BIG LINE NUMBER, LINE =',LINE,', N =',N - RETURN - ENDIF -* - P(LINE,1)=PX - P(LINE,2)=PY - P(LINE,3)=PZ - P(LINE,4)=E - IF (M .GE. -9998.0) THEN - P(LINE,5)=M -c print *,'--> Setting the mass for the particle',LINE -c print *,' E**2-P**2=',E**2-PX**2-PY**2-PZ**2 -c print *,' M**2=',M**2 - ELSE - P(LINE,5)=ULMASS(K(LINE,2)) - ENDIF - END diff --git a/lpair_2diss/desy/source/maps.f b/lpair_2diss/desy/source/maps.f deleted file mode 100644 index ffaf6da..0000000 --- a/lpair_2diss/desy/source/maps.f +++ /dev/null @@ -1,95 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE MAPW2(W2,X,W2MIN,W2MAX,DW) - - IMPLICIT DOUBLE PRECISION (A-Z) - - Y = W2MAX/W2MIN - W2 = W2MIN*Y**X - DW = W2*DLOG(Y) - - RETURN - END - - - SUBROUTINE MAPXQ(W2,X,W2MIN,W2MAX,DW) - - IMPLICIT DOUBLE PRECISION (A-Z) - - Y = W2MAX/W2MIN - W2 = W2MIN*Y**X - DW = W2*DLOG(Y) - - RETURN - END - - - SUBROUTINE MAPWX(W2,X,W2MIN,W2MAX,DW) - - IMPLICIT DOUBLE PRECISION (A-Z) - - Y = W2MAX/W2MIN - W2 = W2MIN*Y**X - DW = W2*DLOG(Y) -c print *,w2min,w2max,x,sqrt(w2),sqrt(dw) - - RETURN - END - - - SUBROUTINE MAPT1(T,X,TMIN,TMAX,DT) - - IMPLICIT DOUBLE PRECISION (A-Z) - - Y = TMAX/TMIN - T = TMIN*Y**X - DT =-T*DLOG(Y) - -C WRITE(6,*) ' MAPT1 :',T,X,TMIN,TMAX,DT,' MAPT1 END' - - RETURN - END - - - SUBROUTINE MAPT2(T,X,TMIN,TMAX,DT) - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - - Y = TMAX/TMIN - T = TMIN*Y**X - DT =-T*DLOG(Y) - - RETURN - END - - - SUBROUTINE MAPS2(S2,X,SMIN,SMAX,DS) - - IMPLICIT DOUBLE PRECISION (A-Z) - - Y=SMAX/SMIN - S2=SMIN*Y**X - DS=S2*DLOG(Y) - - RETURN - END - - - SUBROUTINE MAPLA(X,Y,Z,U,XM,XP,D) - - IMPLICIT DOUBLE PRECISION (A-Z) - - XMB=XM-Y-Z - XPB=XP-Y-Z - C=-4.*Y*Z - ALP=DSQRT(XPB*XPB+C) - ALM=DSQRT(XMB*XMB+C) - AM=XMB+ALM - AP=XPB+ALP - YY=AP/AM - ZZ=YY**U - X=Y+Z+(AM*ZZ-C/(AM*ZZ))*0.5 - AX=DSQRT((X-Y-Z)**2+C) - D=AX*DLOG(YY) - - RETURN - END diff --git a/lpair_2diss/desy/source/orient.f b/lpair_2diss/desy/source/orient.f deleted file mode 100644 index 0944730..0000000 --- a/lpair_2diss/desy/source/orient.f +++ /dev/null @@ -1,90 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE ORIENT(S,V1,V2,V3,V4,V5,DJ,NOPT,Y) - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - - COMMON/VARIAB/ E,E1,E2,E3,E4,E5,P,P3,P4,P5,CT3,ST3,CT4,ST4,CT5, - & ST5,CP3,SP3,CP5,SP5 - COMMON/VARIAC/ AL3,AL4,BE4,BE5,DE3,DE5,PP3,PP4,PP5 - COMMON/PICKZZ/ W1,W2,W3,W4,W5,W31,W52,W12,TAU,SL1 - COMMON/EXTRA/ S1,S2,T1,T2 - COMMON/LEVI/ GRAM,DD1,DD2,DD3,DD4,DD5,DELTA,G4,SA1,SA2 - COMMON/DOTP/ P12,P13,P14,P15,P23,P24,P25,P34,P35,P45,P2K1,P2K2 - - DIMENSION Y(4) - - CALL PICKIN(S,V1,V2,V3,V4,V5,DJ,NOPT,Y) - IF(DJ.EQ.0)GO TO 10 - E = DSQRT(S) - RE = 0.5/E - E1 = RE*(S+W12) - E2 = RE*(S-W12) - P = RE*SL1 - DE3 = RE*(S2-W3+W12) - DE5 = RE*(S1-W5-W12) - E3 = E1-DE3 - E4 = DE3+DE5 - E5 = E2-DE5 -C FIXME FIXME FIXME Laurent workaround to avoid very unphysical events - IF(E3.GT.E1)GO TO 10 - IF(E5.GT.E2)GO TO 10 -C FIXME FIXME FIXME - IF(E4.LT.V4)GO TO 10 - P3 = DSQRT(E3*E3-W3) - P4 = DSQRT((E4-V4)*(E4+V4)) - IF(P4.EQ.0)GO TO 10 - P5 = DSQRT(E5*E5-W5) -C -C WRITE(6,*) DD1,S,P -C - PP3 = DSQRT(DD1/S)/P - PP5 = DSQRT(DD3/S)/P - ST3 = PP3/P3 - ST5 = PP5/P5 - if(dd3.ge.0) then - elseif(dd3.lt.0) then - else ! NaN - print *,'dd3',dd3 - endif - if(dd1.ge.0) then - elseif(dd1.lt.0) then - else ! NaN - print *,'dd1',dd1 - endif - IF(ST3.GT.1..OR.ST5.GT.1.)GO TO 10 - CT3 = DSQRT(1.-ST3*ST3) - CT5 = DSQRT(1.-ST5*ST5) - IF(E1*E3.LT.P13)CT3=-CT3 - IF(E2*E5.GT.P25)CT5=-CT5 - AL3 = ST3*ST3/(1.+CT3) - BE5 = ST5*ST5/(1.-CT5) - IF(DD5.LT.0)GO TO 10 - PP4 = DSQRT(DD5/S)/P - ST4 = PP4/P4 - IF(ST4.GT.1.)GO TO 10 - CT4 = DSQRT(1.-ST4*ST4) - IF(E1*E4.LT.P14)CT4 =-CT4 - AL4 = 1.-CT4 - BE4 = 1.+CT4 - IF(CT4.LT.0)BE4 = ST4*ST4/AL4 - IF(CT4.GE.0)AL4 = ST4*ST4/BE4 - RR = DSQRT(-GRAM/S)/(P*PP4) - SP3 = RR/PP3 - SP5 =-RR/PP5 - IF(DABS(SP3).GT.1..OR.DABS(SP5).GT.1.)GO TO 10 - CP3 =-DSQRT(1.-SP3*SP3) - CP5 =-DSQRT(1.-SP5*SP5) - A1 = PP3*CP3-PP5*CP5 - IF(DABS(PP4+PP3*CP3+CP5*PP5).LT.DABS(DABS(A1)-PP4))GO TO 1 - IF(A1.LT.0)CP5 =-CP5 - IF(A1.GE.0)CP3 =-CP3 - -1 RETURN - -10 DJ = 0. - - RETURN - END -C 13/02/92 202131749 MEMBER NAME EDITFILE (H1MUP) M - - diff --git a/lpair_2diss/desy/source/peripp.f b/lpair_2diss/desy/source/peripp.f deleted file mode 100644 index f8bf3c5..0000000 --- a/lpair_2diss/desy/source/peripp.f +++ /dev/null @@ -1,84 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - DOUBLE PRECISION FUNCTION PERIPP(NUP,NDOWN) -* - IMPLICIT DOUBLE PRECISION (A-H,O-Z) -* - COMMON /PICKZZ/ W1,W2,W3,W4,W5,W31,W52,W12,TAU,SL1 - COMMON /CIVITA/ EPSI,G5,G6,A5,A6,BB - COMMON /EXTRA/ S1,S2,T1,T2 - COMMON /DOTPS/ Q1DQ,Q1DQ2,W6 - COMMON /LEVI/ GRAM,D1,D2,D3,D4,D5,DELTA,G4,A1,A2 - COMMON /PERIC/ U1,U2,V1,V2,T11,T12,T21,T22 -* - DATA RHO /.585D+00/,Cc1/0.86926/,Cc2/2.23422/,Dd1/0.12549/ - DATA Cp/0.96/,Bp/0.63/ -! DATA RHO /1.05/, Cc1/0.6303/, Cc2/2.2049/, Dd1/0.0468/ -! DATA Cp/1.23/,Bp/0.61/ - - REAL*8 DUMMY,PSFW1,PSFW2,M1 - REAL*8 W1STRFUN,W2STRFUN - -c print *,'peripp','nup=',nup,'ndown=',ndown - IF(NUP.EQ.1) THEN - U1 = 1. - U2 = 1. - ELSEIF(NUP.EQ.2) THEN - XT = 1. - T1 / .71 - XT = XT * XT - XU = 2.79 / XT - U1 = XU * XU - TAU = T1 / (4.*W1) - U2 = (1./(XT*XT) - XU * XU * TAU) / (1.-TAU) - ELSEIF (NUP .EQ. 4) THEN - M1=DSQRT(W1) - CALL PSF(T1,W3,DUMMY,PSFW1,PSFW2) - U1=-PSFW1*2D0*M1/T1 - U2= PSFW2/2D0/M1 - ELSEIF (NUP .EQ. 5) THEN - M1=DSQRT(W1) - CALL W1W2F2(T1,W3,W1STRFUN,W2STRFUN) - U1=-W1STRFUN*2.*M1/T1 - U2= W2STRFUN/2./M1 - ELSE - X = T1 / (T1-W3) - EN = W31 - T1 - TAU = T1 / (4.*W1) - RHOT = RHO - T1 - U1 = (-Cc1*RHO*RHO*W31/RHOT/RHOT-Cc2*W1*(1.-X)**4 - & / (X*(X*Cp-2*Bp)+1.)) / T1 - U2 = (-TAU*U1-Dd1*W31*T1*RHO/RHOT/RHOT*W31*W31/EN/EN/W1) - & / (1.-EN*EN/(4.*W1*T1)) - ENDIF - IF(NDOWN.EQ.1) THEN - V1 = 1. - V2 = 1. - ELSEIF(NDOWN.EQ.2) THEN - XT = 1. - T2 / .71 - XT = XT * XT - XU = 2.79 / XT - V1 = XU * XU - TAU = T2 / (4.*W2) - V2 = (1./(XT*XT) - XU * XU * TAU) / (1.-TAU) - ELSE - X = T2 / (T2-W5) - EN = W52 - T2 - TAU = T2 / (4.*W2) - RHOT = RHO - T2 - V1 = (-Cc1*RHO*RHO*W52/RHOT/RHOT-Cc2*W2*(1.-X)**4 - & / (X*(X*Cp-2*Bp)+1.))/T2 - V2 = (-TAU*V1-Dd1*W52*T2*RHO/RHOT/RHOT*W52*W52/EN/EN/W2) - & / (1.-EN*EN/(4.*W2*T2)) - ENDIF - QQQ = Q1DQ * Q1DQ - QDQ = 4. * W6 - W4 - T22 = 512. * (BB*(DELTA*DELTA-GRAM)-(EPSI-DELTA*(QDQ+Q1DQ2))**2 - & -A1*A6*A6-A2*A5*A5-A1*A2*QQQ) - T12 = 128. * (-BB*(D2+G6)-2.*(T1+2.*W6)*(A2*QQQ+A6*A6))*T1 - T21 = 128. * (-BB*(D4+G5)-2.*(T2+2.*W6)*(A1*QQQ+A5*A5))*T2 - T11 = 64.*(BB*(QQQ-G4-QDQ*(T1+T2+2.*W6))-2.*(T1+2.*W6)*(T2+2.*W6) - & *QQQ)*T1*T2 - PERIPP = (((U1*V1*T11+U2*V1*T21+U1*V2*T12+U2*V2*T22)/(T1*T2*BB)) - & / (T1*T2*BB))*.25 - - RETURN - END diff --git a/lpair_2diss/desy/source/pickin.f b/lpair_2diss/desy/source/pickin.f deleted file mode 100644 index 6142ec8..0000000 --- a/lpair_2diss/desy/source/pickin.f +++ /dev/null @@ -1,213 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE PICKIN(S,V1,V2,V3,V4,V5,DJ,NOPT,Y) - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - -*KEEP,CUTS. - INTEGER MODCUT - REAL*4 THMAX,THMIN,MXMN,MXMX,Q2MN,Q2MX - REAL*8 COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & QP2MIN,QP2MAX - COMMON /CUTS/COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & THMAX,THMIN,QP2MIN,QP2MAX,MODCUT,MXMN,MXMX,Q2MN,Q2MX - -*KEND. - - COMMON/PICKZZ/ W1,W2,W3,W4,W5,D1,D2,D5,D7,SL1 - COMMON/EXTRA/ S1,S2,T1,T2 - COMMON/LEVI/ GRAM,DD1,DD2,DD3,DD4,DD5,DELTA,G4,SA1,SA2 - COMMON/DOTP/ P12,P13,P14,P15,P23,P24,P25,P34,P35,P45,P1K2,P2K1 - COMMON/ACCURA/ ACC3,ACC4 - COMMON/PHOTONS/ T1MIN,T1MAX,T2MIN,T2MAX,D3 - - DIMENSION Y(4) - - DATA PI/3.14159265358979D+00/ - - X1 = Y(1) - X2 = Y(2) - X3 = Y(3) - W1 = V1*V1 - W2 = V2*V2 - W3 = V3*V3 - W4 = V4*V4 - W5 = V5*V5 - SIG= V4+V5 - SIG1=SIG*SIG - SIG2=SIG1 - D1 = W3-W1 - D2 = W5-W2 - D5 = W1-W2 - D6 = W4-W5 - SS = S+D5 - RL1= SS*SS-4.*W1*S - IF(RL1.LE.0)GO TO 20 - SL1= DSQRT(RL1) - IF(NOPT.NE.0)GO TO 1 - SMAX=S+W3-2.*V3*DSQRT(S) - CALL MAPS2(S2,X3,SIG1,SMAX,DS2) - SIG1=S2 -1 SP =S+W3-SIG1 - D3 =SIG1-W2 - RL2 =SP*SP-4.*S*W3 - IF(RL2.LE.0)GO TO 20 - SL2 =SQRT(RL2) -c print *,'ss=',ss,'sp=',sp,'sl1=',sl1,'sl2=',sl2 - T1MAX=W1+W3-(SS*SP+SL1*SL2)/(2.*S) -c print *,w1,w3 -c print *,ss,sp,sl1,sl2 - T1MIN=(D1*D3+(D3-D1)*(D3*W1-D1*W2)/S)/T1MAX -c write(6,*) ' pickin : t1min =',t1min,' t1max =',t1max -c & ' qp2max =',qp2max,' qp2min =',qp2min, -c & ' d1 = ',d1,' d3 = ',d3,' w1 = ',w1,' w2 = ',w2, -c & ' s = ',s - IF (T1MAX.GT.QP2MIN .OR. T1MIN.LT.QP2MAX) GOTO 20 - IF (T1MAX .LT. QP2MAX) T1MAX=QP2MAX - IF (T1MIN .GT. QP2MIN) T1MIN=QP2MIN - CALL MAPT1(T1,X1,T1MIN,T1MAX,DT1) - D4 =W4-T1 - D8 =T1-W2 - T13 =T1-W1-W3 -C -C WRITE(6,*) T1,D1,W1 -C - SA1 =-(T1-D1)*(T1-D1)*0.25+W1*T1 -c print *,t1,d1,w1 - IF(SA1.GE.0)GO TO 20 - SL3 =DSQRT(-SA1) - IF(W1.EQ.0)GO TO 3 - SB =(S*(T1-D1)+D5*T13)/(2.*W1)+W3 - SD =SL1*SL3/W1 -C -C WRITE(6,*) S,T1,T13,W2,D1,W3,D5,D8,W1 -C - SE =(S*(T1*(S+T13-W2)-W2*D1)+W3*(D5*D8+W2*W3))/W1 - IF(DABS((SB-SD)/SD).LT.1.0)GO TO 2 - SPLUS=SB-SD - S2MAX=SE/SPLUS - GO TO 4 -2 S2MAX=SB+SD - SPLUS=SE/S2MAX - GO TO 4 -3 S2MAX=(S*(T1*(S+D8-W3)-W2*W3)+W2*W3*(W2+W3-T1))/SS/T13 - SPLUS=SIG2 -4 S2X=S2MAX -c print *,splus,s2max - IF(NOPT)5,6,7 -5 IF(SPLUS.GT.SIG2)SIG2=SPLUS - IF(NOPT.LT.-1)CALL MAPS2(S2,X3,SIG2,S2MAX,DS2) - IF(NOPT.EQ.-1)CALL MAPLA(S2,T1,W2,X3,SIG2,S2MAX,DS2) -6 S2X=S2 -7 R1=S2X-D8 - R2=S2X-D6 - RL4=(R1*R1-4.*W2*S2X)*(R2*R2-4.*W5*S2X) - IF(RL4.LE.0)GO TO 20 - SL4=DSQRT(RL4) - T2MAX=W2+W5-(R1*R2+SL4)/(2.*S2X) - T2MIN=(D2*D4+(D4-D2)*(D4*W2-D2*T1)/S2X)/T2MAX -c print *,d2,d4,w2,t1,s2x,t2max - CALL MAPT2(T2,X2,T2MIN,T2MAX,DT2) - D7=T1-T2 - R3=D4-T2 - R4=D2-T2 - B=R3*R4-2.*(T1+W2)*T2 - C=T2*D6*D8+(D6-D8)*(D6*W2-D8*W5) - T25=T2-W2-W5 -C -C WRITE(6,*) R4,W2,T2 -C - SA2=-R4*R4*0.25+W2*T2 - IF(SA2.GE.0)GO TO 20 - SL6=2.*DSQRT(-SA2) - G4=-0.25*R3*R3+T1*T2 - IF(G4.GE.0)GO TO 20 - SL7=SQRT(-G4)*2. - SL5=SL6*SL7 - IF(DABS((SL5-B)/SL5).LT.1.0)GO TO 8 - S2P=(SL5-B)/(2.*T2) - S2MIN=C/(T2*S2P) - GO TO 9 -8 S2MIN=(-SL5-B)/(2.*T2) - S2P=C/(T2*S2MIN) -9 IF(NOPT.GT.1)CALL MAPS2(S2,X3,S2MIN,S2MAX,DS2) - IF(NOPT.EQ.1)CALL MAPLA(S2,T1,W2,X3,S2MIN,S2MAX,DS2) - - AP=-(S2+D8)*(S2+D8)*0.25+S2*T1 - IF(W1.EQ.0)GO TO 10 - DD1=-W1*(S2-S2MAX)*(S2-SPLUS)*0.25 - GO TO 11 -10 DD1=SS*T13*(S2-S2MAX)*0.25 -11 DD2=-T2*(S2-S2P)*(S2-S2MIN)*0.25 - if(dd2.ge.0) then - elseif(dd2.lt.0) then - else ! NaN - print *,'pickin: dd2',dd2,t2,s2,s2p,s2,s2min - print *,'y',y - print *,'t2m',t2min,t2max - endif - YY4=DCOS(PI*Y(4)) - DD=DD1*DD2 - P12=0.5*(S-W1-W2) - ST=S2-T1-W2 - DELB=(2.*W2*R3+R4*ST)*(4.*P12*T1-(T1-D1)*ST)/(16.*AP) - IF(DD.LE.0)GO TO 20 - DELTA=DELB-YY4*ST*DSQRT(DD)/(2.*AP) - S1=T2+W1+(2.*P12*R3-4.*DELTA)/ST - IF(AP.GE.0)GO TO 20 -c print *,nopt,ds2 - DJ=DS2*DT1*DT2*PI*PI/(8.*SL1*DSQRT(-AP)) -c print *,dj,ds2,dt1,dt2,sl1,-ap - - GRAM=(1.-YY4)*(1.+YY4)*DD/AP - P13=-T13*0.5 - P14=(D7+S1-W3)*0.5 - P15=(S+T2-S1-W2)*0.5 - P23=(S+T1-S2-W1)*0.5 - P24=(S2-D7-W5)*0.5 - P25=-T25*0.5 - P34=(S1-W3-W4)*0.5 - P35=(S+W4-S1-S2)*0.5 - P45=(S2-W4-W5)*0.5 - P1K2=(S1-T2-W1)*0.5 - P2K1=ST*0.5 - IF(W2.EQ.0)GO TO 14 - SBB=(S*(T2-D2)-D5*T25)/(2.*W2)+W5 - SDD=SL1*SL6/(2.*W2) - SEE=(S*(T2*(S+T25-W1)-W1*D2)+W5*(W1*W5-D5*(T2-W1)))/W2 - IF(SBB/SDD.LT.0)GO TO 12 - S1P=SBB+SDD - S1M=SEE/S1P - GO TO 13 -12 S1M=SBB-SDD - S1P=SEE/S1M -13 DD3=-W2*(S1P-S1)*(S1M-S1)*0.25 - if(dd3.ge.0) then - elseif(dd3.lt.0) then - else ! NaN - print *,'pickin: dd3',dd3,w2,s1,s1p,s1m,s1 - print *,'y',y - endif - GO TO 15 -14 S1P=(S*(T2*(S-W5+T2-W1)-W1*W5)+W1*W5*(W1+W5-T2))/T25/(S-D5) - DD3=-T25*(S-D5)*(S1P-S1)*0.25 -15 ACC3=(S1P-S1)/(S1P+S1) - SSB=T2+W1-R3*(D1-T1)*0.5/T1 - SSD=SL3*SL7/T1 - SSE=(T2-W1)*(W4-W3)+(T2-W4+D1)*((T2-W1)*W3-(W4-W3)*W1)/T1 - IF(SSB/SSD.LT.0)GO TO 16 - S1PP=SSB+SSD - S1PM=SSE/S1PP - GO TO 17 -16 S1PM=SSB-SSD - S1PP=SSE/S1PM -17 DD4=-T1*(S1-S1PP)*(S1-S1PM)*0.25 - ACC4=(S1-S1PM)/(S1+S1PM) - DD5=DD1+DD3+((P12*(T1-D1)*0.5-W1*P2K1)*(P2K1*(T2-D2)-W2*R3) - & -DELTA*(2.*P12*P2K1-W2*(T1-D1)))/P2K1 - - RETURN - -20 DJ=0. - - RETURN - END diff --git a/lpair_2diss/desy/source/prtlhe.f b/lpair_2diss/desy/source/prtlhe.f deleted file mode 100644 index b0f546e..0000000 --- a/lpair_2diss/desy/source/prtlhe.f +++ /dev/null @@ -1,91 +0,0 @@ - subroutine prtlhe(mode) - - implicit none - - integer mode - integer i,j -* === Run common block - integer MAXPUP - parameter ( MAXPUP=100 ) - integer IDBMUP, PDFGUP, PDFSUP, IDWTUP, NPRUP, LPRUP - double precision EBMUP, XSECUP, XERRUP, XMAXUP - common/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - + IDWTUP, NPRUP, XSECUP(MAXPUP), XERRUP(MAXPUP), - + XMAXUP(MAXPUP), LPRUP(MAXPUP) - save /HEPRUP/ -* === Event information - integer MAXNUP - parameter ( MAXNUP=500 ) - integer NUP, IDPRUP, IDUP, ISTUP, MOTHUP, ICOLUP - double precision XWGTUP, SCALUP, AQEDUP, AQCDUP, - + PUP, VTIMUP, SPINUP - common/HEPEUP/ NUP, IDPRUP, XWGTUP, SCALUP, AQEDUP, AQCDUP, - + IDUP(MAXNUP), ISTUP(MAXNUP), MOTHUP(2,MAXNUP), - + ICOLUP(2,MAXNUP), PUP(5,MAXNUP), VTIMUP(MAXNUP), - + SPINUP(MAXNUP) - save /HEPEUP/ -* === Kinematic information from JETSET - integer n,k, npad - real p,v - common /pyjets/ N, npad, K(4000,5), P(4000,5), V(4000,5) -* -* === Input parameters - integer MODCUT - real*4 THMAX,THMIN,MXMN,MXMX,Q2MN,Q2MX - real*8 COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - + QP2MIN,QP2MAX - common/CUTS/ COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX, - + MXMIN2,MXMAX2, - + THMAX,THMIN,QP2MIN,QP2MAX,MODCUT,MXMN,MXMX, - + Q2MN,Q2MX - integer NDIM,NCVG,ITMX,NPRN,IGRAPH, - + NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - common/VEGPAR/ NDIM,NCVG,ITMX,NPRN,IGRAPH, - + NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - integer INTGE,INTGP,GPDF,SPDF,PMOD,EMOD,IPAIR,NQUARK - real*8 INPE,INPP - common/BEAM/ INPE,INPP,INTGE,INTGP,GPDF,SPDF,PMOD,EMOD, - + IPAIR,NQUARK -* === Configuration options - integer lhe - data lhe/10/ - logical init - data init/.false./ -* -* - if (init.eqv..false.) then - open(lhe,file='events.lhe',status='unknown') - init = .true. - endif -* - if (mode.eq.1) then ! header - write(lhe,'(A)') '' - write(lhe,'(A)') '' - elseif (mode.eq.2) then ! event - write(lhe,'(A)') '' - do 10,i=1,n -c print *,p(j,5) - if (VTIMUP(I).eq.0D0) then - write(lhe,5300) IDUP(I),ISTUP(I),MOTHUP(1,I),MOTHUP(2,I), - & ICOLUP(1,I),ICOLUP(2,I),(PUP(j,i),J=1,5), - & ' 0. 9.' - else - write(lhe,5400) IDUP(I),ISTUP(I),MOTHUP(1,I),MOTHUP(2,I), - & ICOLUP(1,I),ICOLUP(2,I),(PUP(j,i),J=1,5), - & VTIMUP(I),' 9.' - endif - 10 continue - write(lhe,'(A)') '' - elseif (mode.eq.3) then ! footer - write(lhe,'(A)') '' - else - print *, 'PrintLHE: Error: Unrecognized mode:', mode - endif -* - 5300 format(1p,i8,5i5,5e18.10,a6) - 5400 format(1p,i8,5i5,5e18.10,e12.4,a3) -* - end diff --git a/lpair_2diss/desy/source/prtpar.f b/lpair_2diss/desy/source/prtpar.f deleted file mode 100644 index 06fffa0..0000000 --- a/lpair_2diss/desy/source/prtpar.f +++ /dev/null @@ -1,51 +0,0 @@ - subroutine prtpar(file) - - implicit none -* -* === Input parameters - integer MODCUT - real*4 THMAX,THMIN,MXMN,MXMX,Q2MN,Q2MX - real*8 COTTH1,COTTH2,ECUT,PTCUT,MXMIN2,MXMAX2,QP2MIN,QP2MAX - common/CUTS/ COTTH1,COTTH2,ECUT,PTCUT,MXMIN2,MXMAX2, - + THMAX,THMIN,QP2MIN,QP2MAX,MODCUT,MXMN,MXMX, - + Q2MN,Q2MX - integer NDIM,NCVG,ITMX,NPRN,IGRAPH, - + NPOIN,NPRIN,NTREAT,IBEG,IEND - common/VEGPAR/ NDIM,NCVG,ITMX,NPRN,IGRAPH, - + NPOIN,NPRIN,NTREAT,IBEG,IEND - integer INTGE,INTGP,GPDF,SPDF,PMOD,EMOD,IPAIR,NQUARK - real*8 INPE,INPP - common/BEAM/ INPE,INPP,INTGE,INTGP,GPDF,SPDF,PMOD,EMOD, - + IPAIR,NQUARK - integer file -* - write(file,'(A)') 'Input parameters for this generation:' - write(file,1002) - write(file,1000) 'NTRT',ntreat - write(file,1000) 'NCVG',ncvg - write(file,1000) 'ITVG',itmx - write(file,1000) 'NCSG',npoin - write(file,1001) 'INPP',inpp - write(file,1000) 'PMOD',pmod - write(file,1001) 'INPE',inpe - write(file,1000) 'EMOD',emod - write(file,1000) 'GPDF',gpdf - write(file,1000) 'SPDF',spdf - write(file,1000) 'QPDF',nquark - write(file,1001) 'THMN',thmin - write(file,1001) 'THMX',thmax - write(file,1001) 'Q2MN',q2mn - write(file,1001) 'Q2MX',q2mx - write(file,1001) 'MXMN',mxmn - write(file,1001) 'MXMX',mxmx - write(file,1000) 'PAIR',ipair - write(file,1000) 'MCUT',modcut - write(file,1001) 'ECUT',ecut - write(file,1001) 'PTCT',ptcut - write(file,1002) -* - 1000 format((a),1x,i10) - 1001 format((a),1x,f10.2) - 1002 format(15('=')) -* - end diff --git a/lpair_2diss/desy/source/psf.f b/lpair_2diss/desy/source/psf.f deleted file mode 100644 index 4f904e2..0000000 --- a/lpair_2diss/desy/source/psf.f +++ /dev/null @@ -1,100 +0,0 @@ -*-- Author : O. Duenger 07/05/92 -********************************************************************* -* - SUBROUTINE PSF(Q2,MX2,SIGMAT,W1,W2) -* -* PROTON STRUCTURE FUNCTION COMPUTED FROM BREASSE ET. AL. -* -********************************************************************* - - IMPLICIT NONE - INTEGER NBIN,NCALL,NWRITE - REAL*8 Q2,MX,MX2,W1,W2,MP,MPI,NU2,PI,LOGQQ0,XBIN,DX,ALPHAF,GD2 - REAL*8 ABRASS(56),BBRASS(56),CBRASS(56) - REAL*8 SIGLOW,SIGHIG,SIGMAT,MUBARN - PARAMETER(MP=0.9383D0,MPI=0.1350D0,PI=3.1416D0) - PARAMETER(MUBARN=1D0/389.39D0,ALPHAF=1D0/137.04D0) - DATA NCALL/0/NWRITE/1/ - DATA ABRASS/5.045D0,5.126D0,5.390D0,5.621D0,5.913D0, - 1 5.955D0,6.139D0,6.178D0,6.125D0,5.999D0, - 2 5.769D0,5.622D0,5.431D0,5.288D0,5.175D0, - 3 5.131D0,5.003D0,5.065D0,5.045D0,5.078D0, - 4 5.145D0,5.156D0,5.234D0,5.298D0,5.371D0, - 5 5.457D0,5.543D0,5.519D0,5.465D0,5.384D0, - 6 5.341D0,5.320D0,5.275D0,5.290D0,5.330D0, - 7 5.375D0,5.428D0,5.478D0,5.443D0,5.390D0, - 8 5.333D0,5.296D0,5.223D0,5.159D0,5.146D0, - 9 5.143D0,5.125D0,5.158D0,5.159D0,5.178D0, - A 5.182D0,5.195D0,5.160D0,5.195D0,5.163D0, - B 5.172D0/ - DATA BBRASS/0.798D0,1.052D0,1.213D0,1.334D0,1.397D0, - 1 1.727D0,1.750D0,1.878D0,1.887D0,1.927D0, - 2 2.041D0,2.089D0,2.148D0,2.205D0,2.344D0, - 3 2.324D0,2.535D0,2.464D0,2.564D0,2.610D0, - 4 2.609D0,2.678D0,2.771D0,2.890D0,2.982D0, - 5 3.157D0,3.183D0,3.315D0,3.375D0,3.450D0, - 6 3.477D0,3.471D0,3.554D0,3.633D0,3.695D0, - 7 3.804D0,3.900D0,4.047D0,4.290D0,4.519D0, - 8 4.709D0,4.757D0,4.840D0,5.017D0,5.015D0, - 9 5.129D0,5.285D0,5.322D0,5.545D0,5.623D0, - A 5.775D0,5.894D0,6.138D0,6.151D0,6.301D0, - B 6.452D0/ - DATA CBRASS/ 0.043D0, 0.024D0, 0.000D0,-0.013D0,-0.023D0, - 1 -0.069D0,-0.060D0,-0.080D0,-0.065D0,-0.056D0, - 2 -0.065D0,-0.056D0,-0.043D0,-0.034D0,-0.054D0, - 3 -0.018D0,-0.046D0,-0.015D0,-0.029D0,-0.048D0, - 4 -0.032D0,-0.045D0,-0.084D0,-0.115D0,-0.105D0, - 5 -0.159D0,-0.164D0,-0.181D0,-0.203D0,-0.223D0, - 6 -0.245D0,-0.254D0,-0.239D0,-0.302D0,-0.299D0, - 7 -0.318D0,-0.383D0,-0.393D0,-0.466D0,-0.588D0, - 8 -0.622D0,-0.568D0,-0.574D0,-0.727D0,-0.665D0, - 9 -0.704D0,-0.856D0,-0.798D0,-1.048D0,-0.980D0, - A -1.021D0,-1.092D0,-1.313D0,-1.341D0,-1.266D0, - B -1.473D0/ - MX=DSQRT(MX2) -C - IF (MX .GE. MP+MPI .AND. MX .LT. 1.110D0) THEN - NBIN=0 - XBIN=MX-MP-MPI - DX=1.110D0-MP-MPI - ELSEIF (MX .GE. 1.110D0 .AND. MX .LT. 1.770D0) THEN - NBIN=(MX-1.110D0)/0.015D0+1 - XBIN=DMOD(MX-1.110D0,0.015D0) - DX=0.015D0 - ELSEIF (MX .GE. 1.770D0 .AND. MX .LT. 1.990D0) THEN - NBIN=(MX-1.770D0)/0.020D0+45 - XBIN=DMOD(MX-1.770D0,0.020D0) - DX=0.020D0 - ELSE - SIGMAT=0D0 - W1=0D0 - W2=0D0 - RETURN - ENDIF -C - NU2=((MX2-Q2-MP*MP)/2D0/MP)**2 - LOGQQ0=0.5D0*DLOG((NU2-Q2)/((MX2-MP*MP)/2D0/MP)**2) - GD2=1D0/(1-Q2/0.71D0)**4 -C - IF (NBIN .EQ. 0) THEN - SIGLOW=0D0 - ELSE - SIGLOW=DEXP(ABRASS(NBIN)+ - & BBRASS(NBIN)*LOGQQ0+ - & CBRASS(NBIN)*DABS(LOGQQ0)**3)*GD2 - ENDIF - SIGHIG=DEXP(ABRASS(NBIN+1)+ - & BBRASS(NBIN+1)*LOGQQ0+ - & CBRASS(NBIN+1)*DABS(LOGQQ0)**3)*GD2 -C - SIGMAT=SIGLOW+XBIN*(SIGHIG-SIGLOW)/DX - W1=(MX2-MP*MP)/(MP*8D0*PI*PI*ALPHAF)*MUBARN*SIGMAT - W2=W1*Q2/(Q2-NU2) -C - NCALL = NCALL+1 - IF (NCALL .GE. NWRITE) THEN - NWRITE=NWRITE*2 - WRITE(6,*) 'PSF: NUMBER OF CALLS IS ',NCALL - ENDIF -C - END diff --git a/lpair_2diss/desy/source/ran2.f b/lpair_2diss/desy/source/ran2.f deleted file mode 100644 index 2eb824c..0000000 --- a/lpair_2diss/desy/source/ran2.f +++ /dev/null @@ -1,33 +0,0 @@ - function ran2(idum) -c random numbers uniformly distributed between 0 and 1. -c (code by A.T. Service, Harvard-Smithsonian Center for Astrophysics; -c can be replaced by any other suitable generator for random numbers) - integer idum - common/ixtbl/ix1,ix2,ix3,rm1,rm2,r(99) - data ia1,ic1,m1/1279,351762,1664557/ - data ia2,ic2,m2/2011,221592,1048583/ - data ia3,ic3,m3/15551,6150,29101/ - - if(idum.ge.0) go to 2 - ix1=mod(-idum,m1) - ix1=mod(ia1*ix1+ic1,m1) - ix2=mod(ix1,m2) - ix1=mod(ia1*ix1+ic1,m1) - ix3=mod(ix1,m3) - rm1=1./float(m1) - rm2=1./float(m2) - do 1 j=1,99 - ix1=mod(ia1*ix1+ic1,m1) - ix2=mod(ia2*ix2+ic2,m2) - r(j)=(float(ix1)+float(ix2)*rm2)*rm1 - 1 continue - 2 ix1=mod(ia1*ix1+ic1,m1) - ix2=mod(ia2*ix2+ic2,m2) - ix3=mod(ia3*ix3+ic3,m3) - j=1+(99*ix3)/m3 - ran2=r(j) - r(j)=(float(ix1)+float(ix2)*rm2)*rm1 -c print *,'-->',ran2,idum - idum=ix1 - return - end diff --git a/lpair_2diss/desy/source/restr1.f b/lpair_2diss/desy/source/restr1.f deleted file mode 100644 index c0fb9de..0000000 --- a/lpair_2diss/desy/source/restr1.f +++ /dev/null @@ -1,24 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE RESTR1(NDIM) -C -C ENTERS INITIALIZATION DATA FOR VEGAS -C -C AUTHOR : J. VERMASEREN -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - COMMON/VGB2/NDO,IT,SI,SI2,SWGT,SCHI,XI(50,10),SCALLS - + ,D(50,10),DI(50,10) - COMMON/VGSAV/LUN1,LUN2,LUN3,LUN4,LUN5 -C -C - CALL VGDAT - REWIND LUN1 -C - READ(LUN1,200) NDO,IT,SI,SI2,SWGT,SCHI, - 1 ((XI(I,J),I=1,NDO),J=1,NDIM) - 2 ,((DI(I,J),I=1,NDO),J=1,NDIM) -C -200 FORMAT(2I8,4E16.10E2/(5E16.10E2)) -C - RETURN - END diff --git a/lpair_2diss/desy/source/restr2.f b/lpair_2diss/desy/source/restr2.f deleted file mode 100644 index adb2517..0000000 --- a/lpair_2diss/desy/source/restr2.f +++ /dev/null @@ -1,24 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE RESTR2(NDIM) -C -C AUTHOR : J. VERMASEREN -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - COMMON/VGMAXI/MDUM,MBIN,FFMAX,FMAX(7000),NM(7000) - COMMON/VGSAV/LUN1,LUN2,LUN3,LUN4,LUN5 -C -C - CALL VGDAT - REWIND LUN2 -C - READ(LUN2,100)MBIN,FFMAX - MAX=MBIN**NDIM - READ(LUN2,101)(FMAX(I),I=1,MAX) - READ(LUN2,102)(NM(I),I=1,MAX) -C -100 FORMAT(I10,E16.10E2) -101 FORMAT(5E16.10E2) -102 FORMAT(8I10) -C - RETURN - END diff --git a/lpair_2diss/desy/source/save1.f b/lpair_2diss/desy/source/save1.f deleted file mode 100644 index fff7570..0000000 --- a/lpair_2diss/desy/source/save1.f +++ /dev/null @@ -1,24 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE SAVE1(NDIM) -C -C STORES VEGAS DATA (UNIT 7) FOR LATER RE-INITIALIZATION -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - COMMON/VGB2/NDO,IT,SI,SI2,SWGT,SCHI,XI(50,10),SCALLS - + ,D(50,10),DI(50,10) - COMMON/VGSAV/LUN1,LUN2,LUN3,LUN4,LUN5 -C -C AUTHOR : J. VERMASEREN -C -C - CALL VGDAT - REWIND LUN1 -C - WRITE(LUN1,200) NDO,IT,SI,SI2,SWGT,SCHI, - 1 ((XI(I,J),I=1,NDO),J=1,NDIM) - 2 ,((DI(I,J),I=1,NDO),J=1,NDIM) -C -200 FORMAT(2I8,4E16.10E2/(5E16.10E2)) -C - RETURN - END diff --git a/lpair_2diss/desy/source/save2.f b/lpair_2diss/desy/source/save2.f deleted file mode 100644 index 295097e..0000000 --- a/lpair_2diss/desy/source/save2.f +++ /dev/null @@ -1,24 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE SAVE2(NDIM) -C -C AUTHOR :J. VERMASEREN -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - COMMON/VGMAXI/MDUM,MBIN,FFMAX,FMAX(7000),NM(7000) - COMMON/VGSAV/LUN1,LUN2,LUN3,LUN4,LUN5 -C -C - CALL VGDAT - REWIND LUN2 -C - MAX=MBIN**NDIM - WRITE(LUN2,100)MBIN,FFMAX - WRITE(LUN2,101)(FMAX(I),I=1,MAX) - WRITE(LUN2,102)(NM(I),I=1,MAX) -C -100 FORMAT(I10,E16.10E2) -101 FORMAT(5E16.10E2) -102 FORMAT(8I10) -C - RETURN - END diff --git a/lpair_2diss/desy/source/setgen.f b/lpair_2diss/desy/source/setgen.f deleted file mode 100644 index 1b74988..0000000 --- a/lpair_2diss/desy/source/setgen.f +++ /dev/null @@ -1,120 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE SETGEN(F,NDIM,NPOIN,NPRIN,NTREAT) -C -C AUTHOR : J. VERMASEREN -C -c IMPLICIT DOUBLE PRECISION (A-H,O-Z) - IMPLICIT none - - integer m,n,ndim,npoin,nprin,ntreat - double precision x,f,treat - external F - DIMENSION X(10),N(10) - - integer MDUM,MBIN,NM,max - double precision FFMAX,FMAX - COMMON/VGMAXI/MDUM,MBIN,FFMAX,FMAX(7000),NM(7000) - - integer NINP,NOUTP - COMMON/VGASIO/NINP,NOUTP - - integer j,jj,jjj,k,kj - double precision sum,sum2,sum2p,fsum,fsum2,sig,sig2,sigp - double precision eff,eff1,eff2 - double precision av,av2,z - real ran2 - integer idum - data idum/-1/ - DOUBLE PRECISION mus - data mus/0.1/ -C -C WRITE(6,*) ' =======> AFTER CALL NPOIN =',NPOIN -C - CALL VGDAT -C -c DO 43 J=1,10 -c DO 42 I=1,NDIM -c X(I)=mus*J -c 42 CONTINUE -c print *,X(1)!,TREAT(F,X,NDIM) -c Z = TREAT(F,X,NDIM) -c 43 CONTINUE -c stop - MBIN=3 - FFMAX=0. - SUM=0. - SUM2=0. - SUM2P=0. - MAX=MBIN**NDIM - print *,max - IF(NPRIN.GE.2)WRITE(NOUTP,200)MBIN,MAX,NPOIN - DO 5 J=1,MAX - NM(J)=0 - FMAX(J)=0. -5 CONTINUE - DO 1 J=1,MAX - JJ=J-1 - DO 2 K=1,NDIM - JJJ=JJ/MBIN - N(K)=JJ-JJJ*MBIN -c print *,'J=',K,'JJ=',JJ,'JJJ=',JJJ,'N=',N(K) - JJ=JJJ -2 CONTINUE - FSUM=0. - FSUM2=0. - DO 3 M=1,NPOIN - DO 4 K=1,NDIM - X(K)=(ran2(idum)+N(K))/MBIN -4 CONTINUE - IF(NTREAT.GT.0)Z=TREAT(F,X,NDIM) - IF(NTREAT.LE.0)Z=F(X) -c print *,Z - IF(Z.GT.FMAX(J))FMAX(J)=Z - FSUM=FSUM+Z - FSUM2=FSUM2+Z*Z -3 CONTINUE -C WRITE(6,*) ' =======> BEFOR DEVISION NPOIN =',NPOIN - AV=FSUM/NPOIN - AV2=FSUM2/NPOIN -c print *,'av=',av,'av2=',av2 - SIG2=AV2-AV*AV - SIG=SQRT(SIG2) - SUM=SUM+AV - SUM2=SUM2+AV2 - SUM2P=SUM2P+SIG2 - IF(FMAX(J).GT.FFMAX)FFMAX=FMAX(J) - EFF=10000. - IF(FMAX(J).NE.0)EFF=FMAX(J)/AV - IF(NPRIN.GE.3)WRITE(NOUTP,100)J,AV,SIG,FMAX(J),EFF, - + (N(KJ),KJ=1,NDIM) -c IF(NPRIN.GE.3)WRITE(NSGOUT,100)J,AV,SIG,FMAX(J),EFF, -c + (N(KJ),KJ=1,NDIM) -1 CONTINUE - SUM=SUM/MAX - SUM2=SUM2/MAX - SUM2P=SUM2P/MAX - SIG=SQRT(SUM2-SUM*SUM) - SIGP=SQRT(SUM2P) - EFF1=0. - DO 6 J=1,MAX - EFF1=EFF1+FMAX(J) -6 CONTINUE - EFF1=EFF1/(MAX*SUM) - EFF2=FFMAX/SUM - IF(NPRIN.GE.1)WRITE(NOUTP,101)SUM,SIG,SIGP,FFMAX,EFF1,EFF2 -C -100 FORMAT(I6,3X,G13.6,G12.4,G13.6,F8.2,3X,10I2) -101 FORMAT('SETGEN :'/ - + ' THE AVERAGE FUNCTION VALUE =',G14.6/ - + ' THE OVERALL STD DEV =',G14.4/ - + ' THE AVERAGE STD DEV =',G14.4/ - + ' THE MAXIMUM FUNCTION VALUE =',G14.6/ - + ' THE AVERAGE INEFFICIENCY =',G14.3/ - + ' THE OVERALL INEFFICIENCY =',G14.3/) -200 FORMAT('1SUBROUTINE SETGEN USES A',I3,'**NDIM DIVISION'/ - + ' THIS RESULTS IN ',I7,' CUBES'/ - + ' THE PROGRAM PUT ',I5,' POINTS IN EACH CUBE TO FIND', - + ' STARTING VALUES FOR THE MAXIMA'//) -C - RETURN - END diff --git a/lpair_2diss/desy/source/treat.f b/lpair_2diss/desy/source/treat.f deleted file mode 100644 index cf36e5b..0000000 --- a/lpair_2diss/desy/source/treat.f +++ /dev/null @@ -1,48 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - DOUBLE PRECISION FUNCTION TREAT(F,X,NDIM) -C -C AUTHOR : J. VERMASEREN -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - EXTERNAL F - DIMENSION X(10),Z(10),XIN(10) - COMMON/VGB2/NDO,IT,SI,SI2,SWGT,SCHI,XI(50,10),SCALLS - + ,D(50,10),DI(50,10) - save /vgb2/ - COMMON/TREATB/W,VALTREAT,XIN,Z - COMMON/VGASIO/NINP,NOUTP,NSGOUT -C -C - DATA NCALL/0/ - save ncall,r -C - IF(NCALL.EQ.0)THEN - NCALL=1 - R=NDO - R=R**NDIM - ENDIF - W=R - I=1 - DO 4 I=1,NDIM - XX=X(I)*NDO - J=XX - JJ=J+1 - Y=XX-J -c PRINT *,I,XX,J,JJ,Y - IF(J.LE.0)THEN - DD=XI(1,I) - ELSE - DD=XI(JJ,I)-XI(J,I) - ENDIF - Z(I)=XI(JJ,I)-DD*(1.-Y) -c print *,DD,z(i),y,w - XIN(I)=X(I) - W=W*DD -4 CONTINUE -c PRINT *,W,F(Z) -c if (F(Z).lt.0) print *,F(Z) - TREAT=W*F(Z) - VALTREAT=TREAT -C - RETURN - END diff --git a/lpair_2diss/desy/source/vegas.f b/lpair_2diss/desy/source/vegas.f deleted file mode 100644 index 3b44860..0000000 --- a/lpair_2diss/desy/source/vegas.f +++ /dev/null @@ -1,371 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE VEGAS(FXN,ACC,NDIM,NCALL,ITMX,NPRN,IGRAPH) -C -C SUBROUTINE PERFORMS N-DIMENSIONAL MONTE CARLO INTEG*N -C - BY G.P. LEPAGE SEPT 1976/ (REV) APR 1978 -C -C -FTN5 VERSION 21-8-1984 -C -C AUTHOR : G. P. LEPAGE -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - EXTERNAL FXN - DIMENSION XIN(50),R(50),DX(10),IA(10),KG(10),DT(10) - DIMENSION XL(10),XU(10),QRAN(10),X(10) - COMMON/VGASIO/NINP,NOUTP,NSGOUT - COMMON/VGB2/NDO,IT,SI,SI2,SWGT,SCHI,XI(50,10),SCALLS - + ,D(50,10),DI(50,10) - COMMON/VGRES/S1,S2,S3,S4 - REAL S1,S2,S3,S4 - real ran2 - integer idum -C -C - DATA XL,XU/10*0.,10*1./ - DATA NDMX/50/,ALPH/1.5/,ONE/1./,MDS/1/ - data idum/-1/ -C - CALL VGDAT - IF(ITMX.LE.0)THEN - WRITE(NOUTP,199)'VEGAS CALLED WITH AT MAX LESS EQUAL ZERO'// - + ' ITERATIONS. NO EXECUTION.' - RETURN - ENDIF - IF(NPRN.GT.0)THEN - IPR=0 - ELSE - IPR=1 - ENDIF - NDO=1 - DO 1 J=1,NDIM - XI(1,J)=ONE -1 CONTINUE -C - ENTRY VEGAS1(FXN,ACC,NDIM,NCALL,ITMX,NPRN,IGRAPH) -C...INITIALIZES CUMMULATIVE VARIABLES,BUT NOT GRID - CALL VGDAT - IF(ITMX.LE.0)THEN - WRITE(NOUTP,199)'VEGAS1 CALLED WITH AT MAX LESS EQUAL ZERO'// - + ' ITERATIONS. NO EXECUTION.' - RETURN - ENDIF -C - IT=0 - SI=0. - SI2=SI - SWGT=SI - SCHI=SI - SCALLS=SI -C - ENTRY VEGAS2(FXN,ACC,NDIM,NCALL,ITMX,NPRN,IGRAPH) -C...NO INITIALIZATION - CALL VGDAT - IF(ITMX.LE.0)THEN - WRITE(NOUTP,199)'VEGAS2 CALLED WITH AT MAX LESS EQUAL ZERO'// - + ' ITERATIONS. NO EXECUTION.' - RETURN - ENDIF - ND=NDMX - NG=1 - IF(MDS.NE.0)THEN - NG=(NCALL/2.)**(1./NDIM) - MDS=1 - IF((2*NG-NDMX).GE.0)THEN - MDS=-1 - NPG=NG/NDMX+1 - ND=NG/NPG - NG=NPG*ND - ENDIF - ENDIF -C - K=NG**NDIM - NPG=NCALL/K - IF(NPG.LT.2) NPG=2 - CALLS=NPG*K - DXG=ONE/NG - DV2G=DXG**(2*NDIM)/NPG/NPG/(NPG-ONE) - XND=ND - NDM=ND-1 - DXG=DXG*XND - XJAC=ONE -c print *,k,ng,calls,dxg,dv2g,xnd,ndm -c stop - DO 3 J=1,NDIM - DX(J)=XU(J)-XL(J) - XJAC=XJAC*DX(J) -c print *,j,xjac,dx(j) -3 CONTINUE -C -C REBIN PRESERVING BIN DENSITY -C - IF(ND.NE.NDO)THEN -c print *,'rebinning',nd,ndo - RC=NDO/XND - DO 7 J=1,NDIM - K=0 - XN=0. - DR=XN - I=K -4 K=K+1 - DR=DR+ONE - XO=XN - XN=XI(K,J) -5 IF(RC.GT.DR) GO TO 4 - I=I+1 - DR=DR-RC - XIN(I)=XN-(XN-XO)*DR -c print *,i,j,k,dr,xin(i) - IF(I.LT.NDM) GO TO 5 - DO 6 I=1,NDM - XI(I,J)=XIN(I) -c print *,i,j,xi(i,j) -6 CONTINUE - XI(ND,J)=ONE -7 CONTINUE - NDO=ND - ENDIF -c print *,nd,ndo,dr,xn -c stop -C - IF(NPRN.NE.0.AND.NPRN.NE.10)WRITE(NOUTP,200)NDIM,CALLS,IT,ITMX - + ,ACC,MDS,ND - IF(NPRN.EQ.10)WRITE(NOUTP,290)NDIM,CALLS,ITMX,ACC,MDS,ND -C - ENTRY VEGAS3(FXN,ACC,NDIM,NCALL,ITMX,NPRN,IGRAPH) -C - MAIN INTEGRATION LOOP - IF(ITMX.LE.0)THEN - WRITE(NOUTP,199)'VEGAS3 CALLED WITH AT MAX LESS EQUAL ZERO'// - + ' ITERATIONS. NO EXECUTION.' - RETURN - ENDIF -9 CONTINUE - IT=IT+1 - TI=0. - TSI=TI -C - DO 10 J=1,NDIM - KG(J)=1 - DO 10 I=1,ND - D(I,J)=TI - DI(I,J)=TI -10 CONTINUE -C -11 FB=0. - F2B=FB - K=0 -C -12 CONTINUE - K=K+1 - DO 121 J=1,NDIM - QRAN(J)=ran2(idum) -c QRAN(j) = 0.7 -121 CONTINUE - WGT=XJAC - DO 15 J=1,NDIM - XN=(KG(J)-QRAN(J))*DXG+ONE - IA(J)=XN - IAJ=IA(J) - IAJ1=IAJ-1 -c print *,xn,iaj,xo - IF(IAJ.LE.1)THEN - XO=XI(IAJ,J) - RC=(XN-IAJ)*XO - ELSE - XO=XI(IAJ,J)-XI(IAJ1,J) - RC=XI(IAJ1,J)+(XN-IAJ)*XO - ENDIF - X(J)=XL(J)+RC*DX(J) -c print *,j,x(j) -c stop - WGT=WGT*XO*XND -c print *,'-->',kg(j),iaj,xn -15 CONTINUE -C - F=FXN(X)*WGT -c print *,'passed!',k,f - F1=F/CALLS - W=WGT/CALLS -C - F2=F*F - FB=FB+F - F2B=F2B+F2 - DO 16 J=1,NDIM - IAJ=IA(J) - DI(IAJ,J)=DI(IAJ,J)+F/CALLS - IF(MDS.GE.0) D(IAJ,J)=D(IAJ,J)+F2 -c print *,iaj,D(iaj,j),Di(iaj,j) -16 CONTINUE -c print *,wgt,xo,f,f1,w,fb,f2b - IF(K.LT.NPG) GO TO 12 -C - F2B=F2B*NPG - F2B=DSQRT(F2B) - F2B=DABS((F2B-FB)*(F2B+FB)) - TI=TI+FB - TSI=TSI+F2B - IF(MDS.LT.0)THEN - DO 17 J=1,NDIM - IAJ=IA(J) - D(IAJ,J)=D(IAJ,J)+F2B -c print *,d(iaj,j),f2b -17 CONTINUE - ENDIF - - K=NDIM -19 KG(K)=MOD(KG(K),NG)+1 -c print *,kg(k),'--->',ng - IF(KG(K).NE.1) GO TO 11 - K=K-1 - IF(K.GT.0) GO TO 19 -c do 314 j=1,ndim -c do 315 i=1,ndm -c print *,'->',i,j,d(i,j) -c 315 continue -c 314 continue -c stop -C -C FINAL RESULTS FOR THIS ITERATION -C - TI=TI/CALLS - TSI=TSI*DV2G - TI2=TI*TI -c print *,ti,tsi,ti2 -c STOP - IF(TSI .EQ. 0.)THEN - WGT = 0. - ELSE - WGT=TI2/TSI - ENDIF - SI=SI+TI*WGT - SI2=SI2+TI2 - SWGT=SWGT+WGT - SCHI=SCHI+TI2*WGT - IF(SWGT .EQ. 0.)THEN - AVGI=TI - ELSE - AVGI=SI/SWGT - ENDIF - IF(SI2 .EQ. 0.)THEN - SD=TSI - ELSE - SD=SWGT*IT/SI2 - ENDIF - SCALLS=SCALLS+CALLS - CHI2A=0. - IF(IT.GT.1)CHI2A=SD*(SCHI/SWGT-AVGI*AVGI)/(IT-1) - IF(SD .NE. 0.)THEN - SD=ONE/SD - SD=DSQRT(SD) - ELSE - SD=TSI - ENDIF - IF(NPRN.NE.0)THEN - TSI=DSQRT(TSI) - IF(NPRN.NE.10)WRITE(NOUTP,201)IT,TI,TSI,AVGI,SD,CHI2A - IF(NPRN.EQ.10)WRITE(NOUTP,203)IT,TI,TSI,AVGI,SD,CHI2A - IF(NPRN.LT.0)THEN - DO 20 J=1,NDIM - WRITE(NOUTP,202)J - WRITE(NOUTP,204)(XI(I,J),DI(I,J),D(I,J),I=1,ND) -20 CONTINUE - ENDIF - ENDIF -C -C REFINE GRID -C -21 IF(SD .NE. 0.)THEN - REL = DABS(SD/AVGI) - ELSE - REL = 0. - ENDIF - IF(REL.LE.DABS(ACC).OR.IT.GE.ITMX)NOW=2 - S1=AVGI - S2=SD - S3=TI - S4=TSI -C - - DO 23 J=1,NDIM - XO=D(1,J) - XN=D(2,J) - D(1,J)=(XO+XN)/2. - DT(J)=D(1,J) - DO 22 I=2,NDM - D(I,J)=XO+XN - XO=XN - XN=D(I+1,J) - D(I,J)=(D(I,J)+XN)/3. - DT(J)=DT(J)+D(I,J) -c print *,'====>',i,xo,xn,dt(j),d(i,j) -22 CONTINUE - D(ND,J)=(XN+XO)/2. - DT(J)=DT(J)+D(ND,J) -23 CONTINUE -C - DO 28 J=1,NDIM - RC=0. - DO 24 I=1,ND - R(I)=0. - IF(D(I,J).GT.0.)THEN - XO=DT(J)/D(I,J) - R(I)=((XO-ONE)/XO/DLOG(XO))**ALPH - ENDIF -c print *,'-->',i,r(i),xo,dlog(xo) - RC=RC+R(I) -24 CONTINUE - RC=RC/XND -c print *,rc -c stop - K=0 - XN=0. - DR=XN - I=K -25 K=K+1 - DR=DR+R(K) - XO=XN - XN=XI(K,J) -c print *,'-->',k,dr,xo,xn -26 IF(RC.GT.DR) GO TO 25 - I=I+1 - DR=DR-RC - IF(DR .EQ. 0.)THEN - XIN(I)=XN - ELSE - XIN(I)=XN-(XN-XO)*DR/R(K) - ENDIF -c print *,i,xn,xo,dr,r(k) -c print *,i,xin(i),dr,rc,r(k),xn,xo -c print *,i,xin(i),dr,r(k) - IF(I.LT.NDM) GO TO 26 -c stop - DO 27 I=1,NDM - XI(I,J)=XIN(I) -27 CONTINUE - XI(ND,J)=ONE -28 CONTINUE -C -c print *,dabs(acc),rel - IF(IT.LT.ITMX.AND.DABS(ACC).LT.REL)GO TO 9 -C - S1=AVGI - S2=SD - S3=CHI2A - RETURN -C -199 FORMAT(A) -200 FORMAT('INPUT PARAMETERS FOR VEGAS NDIM=',I3 - +,' NCALL=',F8.0/28X,' IT=',I5,' ITMX =',I5/28X - +,' ACC=',D9.3/28X,' MDS=',I3,' ND=',I4//) -290 FORMAT('VEGAS NDIM=',I3,' NCALL=',F8.0,' ITMX =',I5 - + ,' ACC=',D9.3,' MDS=',I3,' ND=',I4) -201 FORMAT('INTEGRATION BY VEGAS'/'ITERATION NO',I3, - +'. INTEGRAL =',D14.8/20X,'STD DEV =',D10.4/ - +' ACCUMULATED RESULTS. INTEGRAL =',D14.8/ - +24X,'STD DEV =',D10.4 / 24X,'CHI**2 PER ITN =',D10.4) -202 FORMAT('DATA FOR AXIS',I2 / 7X,'X',7X,' DELT I ', - +2X,' CONVCE ',11X,'X',7X,' DELT I ',2X,' CONVCE ' - +,11X,'X',7X,' DELT I ',2X,' CONVCE '/) -204 FORMAT(1X,3D12.4,5X,3D12.4,5X,3D12.4) -203 FORMAT(1X,I3,D20.8,D12.4,D20.8,D12.4,D12.4) -C - END diff --git a/lpair_2diss/desy/source/vgdat.f b/lpair_2diss/desy/source/vgdat.f deleted file mode 100644 index 5be8731..0000000 --- a/lpair_2diss/desy/source/vgdat.f +++ /dev/null @@ -1,42 +0,0 @@ -*-- Author : O. Duenger 17/12/91 - SUBROUTINE VGDAT -C -C INITIAL SETTING OF THE IO CHANNELS -C ALL INPUT CHANNELS ARE SET TO 5 ( STANDARD INPUT ) FOR VEGAS AND INPL -C ALL OUTPUT CHANNELS ARE SET TO 6 ( STANDARD OUTPUT ) FOR VEGAS AND IN -C INPUT AND OUTPUT CHANNELS FOR SAVE AND RESTR ARE SET TO 7 -C INPUT AND OUTPUT CHANNELS FOR SAVE2 AND RESTR2 ARE SET TO 9 -C INPUT AND OUTPUT CHANNELS FOR VGSAVE AND VGRSTR ARE SET TO 8 -C INPUT AND OUTPUT CHANNELS FOR THE RANDOM NUMBER GENERATOR STATE IS SE -C AN ADDITIONAL IO CHANNEL IS SET TO 18 ( SO THIS CHANNEL IS RESERVED F -C ALSO ) -C -C AUTHOR : S. DE JONG -C - COMMON/VGASIO/NINP,NOUTP,NSGOUT - COMMON/VGPLIO/NIN,NOUT - COMMON/VGSAV/LUN1,LUN2,LUN3,LUN4,LUN5 -C - LOGICAL FIRST -C - DATA FIRST /.TRUE./ -C - IF(FIRST)THEN - FIRST=.FALSE. - NINP =5 - NIN =5 - NSGOUT =42 - NOUTP=6 - NOUT =6 - LUN1 =21 - LUN2 =22 - LUN3 =8 - LUN4 =17 - LUN5 =18 - OPEN(NSGOUT,file='test_setgen_lpair',status="replace", - + position="append",action="write") - ENDIF -C - RETURN -C - END diff --git a/lpair_2diss/desy/source/w1w2_f2.f b/lpair_2diss/desy/source/w1w2_f2.f deleted file mode 100644 index 0a61720..0000000 --- a/lpair_2diss/desy/source/w1w2_f2.f +++ /dev/null @@ -1,43 +0,0 @@ - subroutine W1W2f2(t1,MX,W1strfun,W2strfun) -c -c ================================================ -c program calculates W1 and W2 structure functions -c from the GRV95 LO parametrization -c ================================================ -c -c standard parameters -c - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - - COMMON /PICKZZ/ W1,W2,W3,W4,W5,W31,W52,W12,TAU,SL1 - - am_p = 0.93827203 - Q02 = 0.8 - - Q2 = -t1 - - x = Q2/(W3+Q2+am_p*am_p) - - amu2 = Q2+Q02 ! scale is shifted -C write(*,*) W3, x, amu2 - - call grv95lo(x,amu2,xuv,xdv,xus,xds,xss,xg) - - F2_aux = 4./9.*(xuv+2.*xus) - 2 + 1./9.*(xdv+2.*xds) - 3 + 1./9.*2.*xss - -c -c F2 corrected for low Q^2 behaviour -c - F2_corr = Q2/(Q2+Q02)*F2_aux - - F1 = F2_corr/(2.*x) ! Callan-Gross relation - -C write(*,*) F1, F2_corr - - W2strfun = 2.*am_p*x/Q2*F2_corr - W1strfun = F1/am_p - - end diff --git a/lpair_2diss/desy/source/zdstdt.f b/lpair_2diss/desy/source/zdstdt.f deleted file mode 100644 index 017a508..0000000 --- a/lpair_2diss/desy/source/zdstdt.f +++ /dev/null @@ -1,29 +0,0 @@ -*-- Author : - Block Data ZDSTDT -* ======================= -* -*.. Load GCUNIT with apropriate o/p unit: -* -*KEEP,GCUNIT. - COMMON/GCUNIT/LIN,LOUT,NUNITS,LUNITS(5) - INTEGER LIN,LOUT,NUNITS,LUNITS - COMMON/GCMAIL/CHMAIL - CHARACTER*132 CHMAIL -C -*KEEP,DISEED. -* -*.. Common to hold random number seeds: -* - Integer NDISSeed - Parameter (NDISSeed=2) -* - Integer DISSeed1, DISSeed2 ,LUNRAN ,IRND_CHAIN -* - Common /DISEED/ DISSeed1, DISSeed2 ,LUNRAN ,IRND_CHAIN -* -*KEND. -* - Data LOUT/6/ - DATA LUNRAN /10/ -* - End diff --git a/lpair_2diss/desy/source/zduevt.f b/lpair_2diss/desy/source/zduevt.f deleted file mode 100644 index b83e499..0000000 --- a/lpair_2diss/desy/source/zduevt.f +++ /dev/null @@ -1,34 +0,0 @@ -*-- Author : - SUBROUTINE ZDUEVT(IWANT) -* ======================== -* -*------------------------------------------------------------------------ -* -* ZDUEVT: Adminstrate event generation by LPair. -* ======= -* -*------------------------------------------------------------------------ -* - Implicit NONE -* - REAL*8 S1,S2,T1,T2 - COMMON /EXTRA/ S1,S2,T1,T2 -* - Integer IWant -* -* -*-------- Initialise -* -*.. Want the event is the default: - IWant = 1 -* -*-------- Generate the event: -* -*.. Generate the event with LPair: - Call GMUGNA -* -*.. Fill /LUJETS/ - Call GMUFIL - Call GMULHE -* - End diff --git a/lpair_2diss/desy/source/zduini.f b/lpair_2diss/desy/source/zduini.f deleted file mode 100644 index 2693384..0000000 --- a/lpair_2diss/desy/source/zduini.f +++ /dev/null @@ -1,123 +0,0 @@ -*-- Author : ZEUS Offline Group 17/08/94 - Subroutine ZDUINI -* ================= -* -*---------------------------------------------------------------------------- -* -* ZDUINI -* ====== -* -* Initialisation routine for ZDis for LPair lepton pair generator. -* -*--------------------------------------------------------------------------- -* - Implicit NONE -* -*KEEP,BEAM. - INTEGER INTGE,INTGP,GPDF,SPDF,PMOD,EMOD,IPAIR, - & NQUARK - REAL*8 INPE,INPP - COMMON /BEAM/ INPE,INPP,INTGE,INTGP,GPDF,SPDF,PMOD,EMOD, - & IPAIR,NQUARK - -*KEEP,CUTS. - INTEGER MODCUT - REAL*4 THMAX,THMIN,MXMN,MXMX,Q2MN,Q2MX - REAL*8 COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & QP2MIN,QP2MAX - COMMON /CUTS/COTTH1,COTTH2,ECUT,PTCUTMIN,PTCUTMAX,MXMIN2,MXMAX2, - & THMAX,THMIN,QP2MIN,QP2MAX,MODCUT,MXMN,MXMX,Q2MN,Q2MX - -*KEEP,VEGPAR. - INTEGER NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - COMMON /VEGPAR/ NDIM,NCVG,ITMX,NPRN,IGRAPH, - & NPOIN,NPRIN,NTREAT,IBEG,IEND,NGEN - -*KEND. -* -C* End of common -* - Integer JErr -* -*-------- Initialise -* -*.. No error so far: - JErr = 0 -* -*.. Header message: - Write (6, 9000) -* -*-------- Set up LPair: -* -*.. Set default parameters: - Call GMUINI - print*, 'passed gmuini' -* -*.. Let data cards over write the defaults: - Call GMUCHA - Write (6, 9010) IBEG, IEND, NGEN, NTreat, NPrin, NCVG, ITMX, - + NPoin, INPP, PMOD, GPDF, SPDF, INPE, EMOD, - + IPAIR, NQUARK, - + MODCUT, THMAX, THMIN, ECUT, PTCUTMIN, PTCUTMAX, - + Q2MN, Q2MX, - + MXMN, MXMX -* -*.. Initialise cross sections: - print*, 'passed gmucha' - WRITE(*,*) "Before GMUBEG" - Call GMUBEG - WRITE(*,*) "After GMUBEG" -* -*-------- No more - return -* -8900 Continue - Return -* -*-------- Formats -* -9000 Format('1'//// - + 8X, '**********************************************************'/ - + 8X, '* *'/ - + 8X, '* ZLPAIR. Interface to Vermaseren et al event generator.*'/ - + 8X, '* ======= *'/ - + 8X, '* *'/ - + 8X, '* ', -*KEEP,QFTITLE,N=30. - + 30HZLPAIR 1.00/03 02/02/95 19 -*KEND. - + ,' *'/ - + 8X, '**********************************************************'/ - + ) -* -9010 FORMAT(' Cut and parameter values used:'/ - + ' ------------------------------'// - + 8X, ' IBEG:', I8/ - + 8X, ' IEND:', I8/ - + 8X, ' NGen:', I8/ - + 8X, 'NTreat:', I8/ - + 8X, ' NPrin:', I8/ - + 8X, ' NCVG:', I8/ - + 8X, ' ITMX:', I8/ - + 8X, ' NPoin:', I8/ - + 8X, ' INPP:', G16.4/ - + 8X, ' PMOD:', I8/ - + 8X, ' GPDF:', I8/ - + 8X, ' SPDF:', I8/ - + 8X, ' INPE:', G16.4/ - + 8X, ' EMOD:', I8/ - + 8X, ' IPair:', I8/ - + 8X, 'NQuark:', I8/ - + 8X, 'ModCut:', I8/ - + 8X, ' ThMax:', G16.4/ - + 8X, ' ThMin:', G16.4/ - + 8X, ' ECut:', G16.4/ - + 8X, ' PTMin:', G16.4/ - + 8X, ' PTMax:', G16.4/ - + 8X, ' Q2MN:', G16.4/ - + 8X, ' Q2MX:', G16.4/ - + 8X, ' MXMN:', G16.4/ - + 8X, ' MXMX:', G16.4/ - + ) -* - End diff --git a/lpair_2diss/desy/xsect.cpp b/lpair_2diss/desy/xsect.cpp deleted file mode 100644 index 3f70c9e..0000000 --- a/lpair_2diss/desy/xsect.cpp +++ /dev/null @@ -1,77 +0,0 @@ -#include -#include -#include - -using namespace std; - -extern "C" { - //void zduini_(); - //void zduevt_(int* iwant); - void gmuini_(); - void gmucha_(); - void gmubeg_(); - - extern struct { - double inpe, inpp; - int intge, intgp, gpdf, spdf, pmod, emod, ipair, nquark; - } beam_; - - extern struct { - int ndim,ncvg,itmx,nprn,igraph,npoin,nprin,ntreat,ibeg,iend; - } vegpar_; - - extern struct { - float s1,s2,s3,s4; - } vgres_; - - extern struct { - double cotth1,cotth2,ecut,ptcutmin,ptcutmax,mxmin2,mxmax2; - float thmax,thmin; - double qp2min,qp2max; - int modcut; - float mxmn,mxmx,q2mn,q2mx; - } cuts_; -} - -double eta_to_theta(double eta) { - return 2*atan(exp(eta))/acos(-1.)*180.; -} - -int main() { - - gmuini_(); - gmucha_(); - - // Beam parameters - beam_.inpe = beam_.inpp = 3500.; - beam_.pmod = 11; - beam_.pmod = 2; - beam_.emod = 2; - - // Vegas parameters - vegpar_.iend = 1; - vegpar_.nprn = 0; - - // Outgoing leptons kinematics - cuts_.ecut = 0.; - cuts_.thmin = eta_to_theta(-5.); - cuts_.thmax = eta_to_theta( 5.); - cuts_.q2mx = 1.e5; - //cuts_.mxmx = 1000.; - cuts_.ptcutmin = 3.; - cout << "Theta in range [" << cuts_.thmin << ", " << cuts_.thmax << "]" << endl; - - cout << "modcut = " << cuts_.modcut << endl; - - ofstream cs("xsect_scan.dat"); - - for (int i=0; i<100; i++) { - cuts_.ptcutmin = 0.+i*0.5; - gmubeg_(); - - cs << cuts_.ptcutmin << "\t" << vgres_.s1 << "\t" << vgres_.s2 << endl; - std::cout << "Pt > " << cuts_.ptcutmin << " GeV : xsec = " << vgres_.s1 << ", error = " << vgres_.s2 << std::endl; - } - - return 0; -} diff --git a/run_fpmc.sh b/run_fpmc.sh deleted file mode 100755 index da3012a..0000000 --- a/run_fpmc.sh +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/sh - -# Step to run HepMC output. Similar steps for LHE output below. - -cd fpmc/ -source setup_lxplus.sh -./fpmc-hepmc \ - --cfg Datacards/dataExcJJ_CHIDe \ - --comenergy 13000 \ - --fileout data_dijets.hepmc \ - --nevents 100 - -# Proper parameters should be entered/reviewed in the input card - -#cd fpmc/ -#source setup_lxplus.sh -#./fpmc-lhe < Datacards/dataExcJJ_CHIDe diff --git a/run_sim.sh b/run_sim.sh deleted file mode 100755 index f186c78..0000000 --- a/run_sim.sh +++ /dev/null @@ -1,66 +0,0 @@ - -# Details here: https://twiki.cern.ch/twiki/bin/view/Sandbox/PpsCepStudies#FPMC - -# variable JOBNAME is been used for IO filenames from simulation and event sample used as input: -# -# $JOBNAME.hepmc: input event sample from FPMC -# $JOBNAME.py: config file for cmsRun -# $JOBNAME.root: output file from simulation - -CMSSW=CMSSW_8_0_1 -AREA=$PWD/$CMSSW/src/ -JOBNAME=data_dijets -NEVENTS=100 - -echo "Copying event sample" -cp fpmc/$JOBNAME.hepmc $AREA - -cd $AREA -echo "Setting up CMSSW environment" -eval `scramv1 runtime -sh` - -echo "Creating configuration file from cmsDriver" -cmsDriver.py \ - readHepMC_cff.py \ - -n $((NEVENTS)) \ - --fast \ - --conditions auto:run2_mc \ - --eventcontent AODSIM \ - -s GEN,SIM,RECOBEFMIX,DIGI:pdigi_valid,RECO \ - --beamspot Realistic50ns13TeVCollision \ - --datatier GEN-SIM-DIGI-RECO \ - --pileup NoPileUp \ - --era Run2_25ns \ - --customise FastSimulation/PPSFastSim/customise_FastSimCTPPS_cff.customise \ - --no_exec \ - --fileout="$JOBNAME".root \ - --python_filename="$JOBNAME".py - -# Replace input file: - -echo "Replacing input filename for hepMC format" -sed -i 's/file:.*.hepmc/file:'"$JOBNAME"'.hepmc/g' Configuration/Generator/python/readHepMC_cff.py - -# modify the resulting driver (in this examples, 'readHepMC_cff_py_GEN_SIM_RECOBEFMIX_DIGI_RECO.py') -# by adding the following line, with 'source' as the input HepMC sample: -# process.VtxSmeared.src = 'source' - -echo "Adding hepMC event sample for simulation" -sed '94iprocess.VtxSmeared.src = '"\"$JOBNAME"'.hepmc\"' "$JOBNAME".py > test.py -mv test.py $JOBNAME.py - -# filter has to be modified to include specific channels; for WW see: -# https://raw.githubusercontent.com/uerj-cms-cep-studies/tmp/master/inputHepMC.cc -echo "Fetching ED filter" -mkdir inputHepMC -cd inputHepMC -mkedfltr inputHepMC -cd .. - -# when ready, run: -echo "Compiling CMSSW area" -scram b -j 8 -# and: -echo "Running job" -cmsRun $JOBNAME.py -# or equivalent driver. diff --git a/setup_fpmc.sh b/setup_fpmc.sh deleted file mode 100755 index 00390d9..0000000 --- a/setup_fpmc.sh +++ /dev/null @@ -1,20 +0,0 @@ -# -# SHELL SCRIPT TO BUILD FPMC IN LXPLUS -# - -AREA=$PWD -echo "Setting local area at: $AREA" -echo 'Cloning git repository for FPMC' -git clone https://github.com/fpmc-hep/fpmc.git -cd $AREA/fpmc/ -echo 'Setting up LXPLUS interface' -source setup_lxplus.sh -echo 'Setting up build dir' -mkdir build -cd build -echo 'Running cmake setup' -cmake3 .. -echo 'Compiling...' -make -j8 -cd $AREA -echo 'Done.' diff --git a/setup_sim.sh b/setup_sim.sh deleted file mode 100755 index 42b5754..0000000 --- a/setup_sim.sh +++ /dev/null @@ -1,29 +0,0 @@ -# -# SHELL SCRIPT TO BUILD CTPPSFastSim IN LXPLUS -# - -# PARAMETERS: -CMSSW=CMSSW_8_0_24 # or later -echo "Setting up CMSSW environment $CMSSW" -ARCH=slc6_amd64_gcc493 -echo "Setting up scram arch $ARCH" - -# SETUP: -AREA=$PWD -SCRAM_ARCH=$ARCH -scram project $CMSSW -echo "Setting up scram area" -cd $CMSSW/src -echo "Activating CMSSW area" -eval `scramv1 runtime -sh` -echo "Cloning CT-PPS fast simulation modules" -git clone https://github.com/CTPPS/CTPPSFastSim.git -mv CTPPSFastSim/FastSimulation/ $AREA/$CMSSW/src -rm -rf CTPPSFastSim/ -mkdir -p Configuration/Generator/python -cd Configuration/Generator/python -echo "Fetching customized reader for hepMC inputs" -wget https://raw.githubusercontent.com/uerj-cms-cep-studies/tmp/master/readHepMC_cff.py -cd $AREA/$CMSSW/src -echo "Compiling CMSSW environemt" -scram b -j 8